2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
9 rnTyClDecls, checkModDeprec,
10 rnBindGroups, rnBindGroupsAndThen, rnSplice
13 #include "HsVersions.h"
16 import RdrName ( RdrName, isRdrDataCon, rdrNameOcc, elemLocalRdrEnv )
17 import RdrHsSyn ( extractGenericPatTyVars )
19 import RnExpr ( rnLExpr, checkTH )
20 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
21 import RnBinds ( rnTopBinds, rnBinds, rnMethodBinds,
22 rnBindsAndThen, renameSigs, checkSigs )
23 import RnEnv ( lookupTopBndrRn, lookupTopFixSigNames,
24 lookupLocatedTopBndrRn, lookupLocatedOccRn,
25 lookupOccRn, newLocalsRn,
26 bindLocatedLocalsFV, bindPatSigTyVarsFV,
27 bindTyVarsRn, extendTyVarEnvFVRn,
28 bindLocalNames, newIPNameRn,
29 checkDupNames, mapFvRn,
34 import BasicTypes ( TopLevelFlag(..) )
35 import HscTypes ( FixityEnv, FixItem(..),
36 Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
37 import Class ( FunDep )
38 import Name ( Name, nameOccName )
42 import SrcLoc ( Located(..), unLoc, getLoc, noLoc )
43 import CmdLineOpts ( DynFlag(..) )
44 import Maybes ( seqMaybe )
45 import Maybe ( catMaybes, isNothing )
48 @rnSourceDecl@ `renames' declarations.
49 It simultaneously performs dependency analysis and precedence parsing.
50 It also does the following error checks:
53 Checks that tyvars are used properly. This includes checking
54 for undefined tyvars, and tyvars in contexts that are ambiguous.
55 (Some of this checking has now been moved to module @TcMonoType@,
56 since we don't have functional dependency information at this point.)
58 Checks that all variable occurences are defined.
60 Checks the @(..)@ etc constraints in the export list.
65 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
67 rnSrcDecls (HsGroup { hs_valds = [HsBindGroup binds sigs _],
68 hs_tyclds = tycl_decls,
69 hs_instds = inst_decls,
71 hs_depds = deprec_decls,
72 hs_fords = foreign_decls,
73 hs_defds = default_decls,
74 hs_ruleds = rule_decls })
76 = do { -- Deal with deprecations (returns only the extra deprecations)
77 deprecs <- rnSrcDeprecDecls deprec_decls ;
78 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
81 -- Deal with top-level fixity decls
82 -- (returns the total new fixity env)
83 fix_env <- rnSrcFixityDecls fix_decls ;
84 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
87 -- Rename other declarations
88 traceRn (text "Start rnmono") ;
89 (rn_val_decls, bind_dus) <- rnTopBinds binds sigs ;
90 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
92 -- You might think that we could build proper def/use information
93 -- for type and class declarations, but they can be involved
94 -- in mutual recursion across modules, and we only do the SCC
95 -- analysis for them in the type checker.
96 -- So we content ourselves with gathering uses only; that
97 -- means we'll only report a declaration as unused if it isn't
98 -- mentioned at all. Ah well.
99 (rn_tycl_decls, src_fvs1)
100 <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
101 (rn_inst_decls, src_fvs2)
102 <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
103 (rn_rule_decls, src_fvs3)
104 <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
105 (rn_foreign_decls, src_fvs4)
106 <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
107 (rn_default_decls, src_fvs5)
108 <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
111 rn_group = HsGroup { hs_valds = rn_val_decls,
112 hs_tyclds = rn_tycl_decls,
113 hs_instds = rn_inst_decls,
116 hs_fords = rn_foreign_decls,
117 hs_defds = rn_default_decls,
118 hs_ruleds = rn_rule_decls } ;
120 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3,
121 src_fvs4, src_fvs5] ;
122 src_dus = bind_dus `plusDU` usesOnly other_fvs
123 -- Note: src_dus will contain *uses* for locally-defined types
124 -- and classes, but no *defs* for them. (Because rnTyClDecl
125 -- returns only the uses.) This is a little
126 -- surprising but it doesn't actually matter at all.
129 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
130 traceRn (text "finish Dus" <+> ppr src_dus ) ;
131 tcg_env <- getGblEnv ;
132 return (tcg_env `addTcgDUs` src_dus, rn_group)
135 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
136 rnTyClDecls tycl_decls = do
137 (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
140 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
141 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
145 %*********************************************************
147 Source-code fixity declarations
149 %*********************************************************
152 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM FixityEnv
153 rnSrcFixityDecls fix_decls
154 = getGblEnv `thenM` \ gbl_env ->
155 foldlM rnFixityDecl (tcg_fix_env gbl_env)
156 fix_decls `thenM` \ fix_env ->
157 traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
160 rnFixityDecl :: FixityEnv -> LFixitySig RdrName -> RnM FixityEnv
161 rnFixityDecl fix_env (L loc (FixitySig rdr_name fixity))
163 -- GHC extension: look up both the tycon and data con
164 -- for con-like things
165 -- If neither are in scope, report an error; otherwise
166 -- add both to the fixity env
167 addLocM lookupTopFixSigNames rdr_name `thenM` \ names ->
169 addLocErr rdr_name unknownNameErr `thenM_`
172 foldlM add fix_env names
175 = case lookupNameEnv fix_env name of
176 Just (FixItem _ _ loc')
177 -> addLocErr rdr_name (dupFixityDecl loc') `thenM_`
179 Nothing -> returnM (extendNameEnv fix_env name fix_item)
181 fix_item = FixItem (nameOccName name) fixity (getLoc rdr_name)
183 pprFixEnv :: FixityEnv -> SDoc
185 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
188 dupFixityDecl loc rdr_name
189 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
190 ptext SLIT("also at ") <+> ppr loc
195 %*********************************************************
197 Source-code deprecations declarations
199 %*********************************************************
201 For deprecations, all we do is check that the names are in scope.
202 It's only imported deprecations, dealt with in RnIfaces, that we
203 gather them together.
206 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
210 rnSrcDeprecDecls decls
211 = mappM (addLocM rn_deprec) decls `thenM` \ pairs ->
212 returnM (DeprecSome (mkNameEnv (catMaybes pairs)))
214 rn_deprec (Deprecation rdr_name txt)
215 = lookupTopBndrRn rdr_name `thenM` \ name ->
216 returnM (Just (name, (rdrNameOcc rdr_name, txt)))
218 checkModDeprec :: Maybe DeprecTxt -> Deprecations
219 -- Check for a module deprecation; done once at top level
220 checkModDeprec Nothing = NoDeprecs
221 checkModDeprec (Just txt) = DeprecAll txt
224 %*********************************************************
226 \subsection{Source code declarations}
228 %*********************************************************
231 rnDefaultDecl (DefaultDecl tys)
232 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
233 returnM (DefaultDecl tys', fvs)
235 doc_str = text "In a `default' declaration"
238 %*********************************************************
242 %*********************************************************
244 These chaps are here, rather than in TcBinds, so that there
245 is just one hi-boot file (for RnSource). rnSrcDecls is part
246 of the loop too, and it must be defined in this module.
249 rnBindGroups :: [HsBindGroup RdrName] -> RnM ([HsBindGroup Name], DefUses)
250 -- This version assumes that the binders are already in scope
251 -- It's used only in 'mdo'
253 = returnM ([], emptyDUs)
254 rnBindGroups [HsBindGroup bind sigs _]
255 = rnBinds NotTopLevel bind sigs
256 rnBindGroups b@[HsIPBinds bind]
257 = do addErr (badIpBinds b)
258 returnM ([], emptyDUs)
260 = panic "rnBindGroups"
263 :: [HsBindGroup RdrName]
264 -> ([HsBindGroup Name] -> RnM (result, FreeVars))
265 -> RnM (result, FreeVars)
266 -- This version (a) assumes that the binding vars are not already in scope
267 -- (b) removes the binders from the free vars of the thing inside
268 -- The parser doesn't produce ThenBinds
269 rnBindGroupsAndThen [] thing_inside
271 rnBindGroupsAndThen [HsBindGroup bind sigs _] thing_inside
272 = rnBindsAndThen bind sigs $ \ groups -> thing_inside groups
273 rnBindGroupsAndThen [HsIPBinds binds] thing_inside
274 = rnIPBinds binds `thenM` \ (binds',fv_binds) ->
275 thing_inside [HsIPBinds binds'] `thenM` \ (thing, fvs_thing) ->
276 returnM (thing, fvs_thing `plusFV` fv_binds)
278 rnIPBinds [] = returnM ([], emptyFVs)
279 rnIPBinds (bind : binds)
280 = wrapLocFstM rnIPBind bind `thenM` \ (bind', fvBind) ->
281 rnIPBinds binds `thenM` \ (binds',fvBinds) ->
282 returnM (bind' : binds', fvBind `plusFV` fvBinds)
284 rnIPBind (IPBind n expr)
285 = newIPNameRn n `thenM` \ name ->
286 rnLExpr expr `thenM` \ (expr',fvExpr) ->
287 return (IPBind name expr', fvExpr)
290 = hang (ptext SLIT("Implicit-parameter bindings illegal in 'mdo':")) 4
295 %*********************************************************
297 \subsection{Foreign declarations}
299 %*********************************************************
302 rnHsForeignDecl (ForeignImport name ty spec isDeprec)
303 = lookupLocatedTopBndrRn name `thenM` \ name' ->
304 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
305 returnM (ForeignImport name' ty' spec isDeprec, fvs)
307 rnHsForeignDecl (ForeignExport name ty spec isDeprec)
308 = lookupLocatedOccRn name `thenM` \ name' ->
309 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
310 returnM (ForeignExport name' ty' spec isDeprec, fvs )
311 -- NB: a foreign export is an *occurrence site* for name, so
312 -- we add it to the free-variable list. It might, for example,
313 -- be imported from another module
315 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
319 %*********************************************************
321 \subsection{Instance declarations}
323 %*********************************************************
326 rnSrcInstDecl (InstDecl inst_ty mbinds uprags)
327 -- Used for both source and interface file decls
328 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
330 -- Rename the bindings
331 -- The typechecker (not the renamer) checks that all
332 -- the bindings are for the right class
334 meth_doc = text "In the bindings in an instance declaration"
335 meth_names = collectHsBindLocatedBinders mbinds
336 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
338 checkDupNames meth_doc meth_names `thenM_`
339 extendTyVarEnvForMethodBinds inst_tyvars (
340 -- (Slightly strangely) the forall-d tyvars scope over
341 -- the method bindings too
342 rnMethodBinds cls [] mbinds
343 ) `thenM` \ (mbinds', meth_fvs) ->
344 -- Rename the prags and signatures.
345 -- Note that the type variables are not in scope here,
346 -- so that instance Eq a => Eq (T a) where
347 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
350 -- But the (unqualified) method names are in scope
352 binders = collectHsBindBinders mbinds'
354 bindLocalNames binders (renameSigs uprags) `thenM` \ uprags' ->
355 checkSigs (okInstDclSig (mkNameSet binders)) uprags' `thenM_`
357 returnM (InstDecl inst_ty' mbinds' uprags',
358 meth_fvs `plusFV` hsSigsFVs uprags'
359 `plusFV` extractHsTyNames inst_ty')
362 For the method bindings in class and instance decls, we extend the
363 type variable environment iff -fglasgow-exts
366 extendTyVarEnvForMethodBinds tyvars thing_inside
367 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
368 if opt_GlasgowExts then
369 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
375 %*********************************************************
379 %*********************************************************
382 rnHsRuleDecl (HsRule rule_name act vars lhs rhs)
383 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
385 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
386 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
388 rnLExpr lhs `thenM` \ (lhs', fv_lhs) ->
389 rnLExpr rhs `thenM` \ (rhs', fv_rhs) ->
391 mb_bad = validRuleLhs ids lhs'
393 checkErr (isNothing mb_bad)
394 (badRuleLhsErr rule_name lhs' mb_bad) `thenM_`
396 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
398 mappM (addErr . badRuleVar rule_name) bad_vars `thenM_`
399 returnM (HsRule rule_name act vars' lhs' rhs',
400 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
402 doc = text "In the transformation rule" <+> ftext rule_name
404 get_var (RuleBndr v) = v
405 get_var (RuleBndrSig v _) = v
407 rn_var (RuleBndr (L loc v), id)
408 = returnM (RuleBndr (L loc id), emptyFVs)
409 rn_var (RuleBndrSig (L loc v) t, id)
410 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
411 returnM (RuleBndrSig (L loc id) t', fvs)
414 Check the shape of a transformation rule LHS. Currently
415 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
416 not one of the @forall@'d variables. We also restrict the form of the LHS so
417 that it may be plausibly matched. Basically you only get to write ordinary
418 applications. (E.g. a case expression is not allowed: too elaborate.)
420 NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
423 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
425 -- Just e => Not ok, and e is the offending expression
426 validRuleLhs foralls lhs
429 checkl (L loc e) = check e
431 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
432 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
433 check (HsVar v) | v `notElem` foralls = Nothing
434 check other = Just other -- Failure
436 checkl_e (L loc e) = check_e e
438 check_e (HsVar v) = Nothing
439 check_e (HsPar e) = checkl_e e
440 check_e (HsLit e) = Nothing
441 check_e (HsOverLit e) = Nothing
443 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
444 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
445 check_e (NegApp e _) = checkl_e e
446 check_e (ExplicitList _ es) = checkl_es es
447 check_e (ExplicitTuple es _) = checkl_es es
448 check_e other = Just other -- Fails
450 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
452 badRuleLhsErr name lhs (Just bad_e)
453 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
454 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
455 ptext SLIT("in left-hand side:") <+> ppr lhs])]
457 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
460 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
461 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
462 ptext SLIT("does not appear on left hand side")]
466 %*********************************************************
468 \subsection{Type, class and iface sig declarations}
470 %*********************************************************
472 @rnTyDecl@ uses the `global name function' to create a new type
473 declaration in which local names have been replaced by their original
474 names, reporting any unknown names.
476 Renaming type variables is a pain. Because they now contain uniques,
477 it is necessary to pass in an association list which maps a parsed
478 tyvar to its @Name@ representation.
479 In some cases (type signatures of values),
480 it is even necessary to go over the type first
481 in order to get the set of tyvars used by it, make an assoc list,
482 and then go over it again to rename the tyvars!
483 However, we can also do some scoping checks at the same time.
486 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
487 = lookupLocatedTopBndrRn name `thenM` \ name' ->
488 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
491 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
492 tcdTyVars = tyvars, tcdCons = condecls,
493 tcdKindSig = sig, tcdDerivs = derivs})
494 | is_vanilla -- Normal Haskell data type decl
495 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
496 -- data type is syntactically illegal
497 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
498 do { tycon' <- lookupLocatedTopBndrRn tycon
499 ; context' <- rnContext data_doc context
500 ; (derivs', deriv_fvs) <- rn_derivs derivs
501 ; checkDupNames data_doc con_names
502 ; condecls' <- rnConDecls (unLoc tycon') condecls
503 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
504 tcdTyVars = tyvars', tcdKindSig = Nothing, tcdCons = condecls',
505 tcdDerivs = derivs'},
506 delFVs (map hsLTyVarName tyvars') $
507 extractHsCtxtTyNames context' `plusFV`
508 plusFVs (map conDeclFVs condecls') `plusFV`
512 = ASSERT( null (unLoc context) )
513 do { tycon' <- lookupLocatedTopBndrRn tycon
514 ; tyvars' <- bindTyVarsRn data_doc tyvars
515 (\ tyvars' -> return tyvars')
516 -- For GADTs, the type variables in the declaration
517 -- do not scope over the constructor signatures
518 -- data T a where { T1 :: forall b. b-> b }
519 ; (derivs', deriv_fvs) <- rn_derivs derivs
520 ; checkDupNames data_doc con_names
521 ; condecls' <- rnConDecls (unLoc tycon') condecls
522 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
523 tcdTyVars = tyvars', tcdCons = condecls', tcdKindSig = sig,
524 tcdDerivs = derivs'},
525 plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
528 is_vanilla = case condecls of -- Yuk
530 L _ (ConDecl {}) : _ -> True
533 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
534 con_names = map con_names_helper condecls
536 con_names_helper (L _ (ConDecl n _ _ _)) = n
537 con_names_helper (L _ (GadtDecl n _)) = n
539 rn_derivs Nothing = returnM (Nothing, emptyFVs)
540 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
541 returnM (Just ds', extractHsTyNames_s ds')
543 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
544 = lookupLocatedTopBndrRn name `thenM` \ name' ->
545 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
546 rnHsTypeFVs syn_doc ty `thenM` \ (ty', fvs) ->
547 returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
549 delFVs (map hsLTyVarName tyvars') fvs)
551 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
553 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
554 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
556 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
558 -- Tyvars scope over superclass context and method signatures
559 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
560 rnContext cls_doc context `thenM` \ context' ->
561 rnFds cls_doc fds `thenM` \ fds' ->
562 renameSigs sigs `thenM` \ sigs' ->
563 returnM (tyvars', context', fds', sigs')
564 ) `thenM` \ (tyvars', context', fds', sigs') ->
566 -- Check the signatures
567 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
569 sig_rdr_names_w_locs = [op | L _ (Sig op _) <- sigs]
571 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
572 checkSigs okClsDclSig sigs' `thenM_`
573 -- Typechecker is responsible for checking that we only
574 -- give default-method bindings for things in this class.
575 -- The renamer *could* check this for class decls, but can't
576 -- for instance decls.
578 -- The newLocals call is tiresome: given a generic class decl
581 -- op {| x+y |} (Inl a) = ...
582 -- op {| x+y |} (Inr b) = ...
583 -- op {| a*b |} (a*b) = ...
584 -- we want to name both "x" tyvars with the same unique, so that they are
585 -- easy to group together in the typechecker.
586 extendTyVarEnvForMethodBinds tyvars' (
587 getLocalRdrEnv `thenM` \ name_env ->
589 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
590 gen_rdr_tyvars_w_locs =
591 [ tv | tv <- extractGenericPatTyVars mbinds,
592 not (unLoc tv `elemLocalRdrEnv` name_env) ]
594 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
595 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
596 rnMethodBinds (unLoc cname') gen_tyvars mbinds
597 ) `thenM` \ (mbinds', meth_fvs) ->
599 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
600 tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
601 delFVs (map hsLTyVarName tyvars') $
602 extractHsCtxtTyNames context' `plusFV`
603 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
604 hsSigsFVs sigs' `plusFV`
607 meth_doc = text "In the default-methods for class" <+> ppr cname
608 cls_doc = text "In the declaration for class" <+> ppr cname
609 sig_doc = text "In the signatures for class" <+> ppr cname
612 %*********************************************************
614 \subsection{Support code for type/data declarations}
616 %*********************************************************
619 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
620 rnConDecls tycon condecls
621 = mappM (wrapLocM rnConDecl) condecls
623 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
624 rnConDecl (ConDecl name tvs cxt details)
625 = addLocM checkConName name `thenM_`
626 lookupLocatedTopBndrRn name `thenM` \ new_name ->
628 bindTyVarsRn doc tvs $ \ new_tyvars ->
629 rnContext doc cxt `thenM` \ new_context ->
630 rnConDetails doc details `thenM` \ new_details ->
631 returnM (ConDecl new_name new_tyvars new_context new_details)
633 doc = text "In the definition of data constructor" <+> quotes (ppr name)
635 rnConDecl (GadtDecl name ty)
636 = addLocM checkConName name `thenM_`
637 lookupLocatedTopBndrRn name `thenM` \ new_name ->
638 rnHsSigType doc ty `thenM` \ new_ty ->
639 returnM (GadtDecl new_name new_ty)
641 doc = text "In the definition of data constructor" <+> quotes (ppr name)
643 rnConDetails doc (PrefixCon tys)
644 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
645 returnM (PrefixCon new_tys)
647 rnConDetails doc (InfixCon ty1 ty2)
648 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
649 rnLHsType doc ty2 `thenM` \ new_ty2 ->
650 returnM (InfixCon new_ty1 new_ty2)
652 rnConDetails doc (RecCon fields)
653 = checkDupNames doc field_names `thenM_`
654 mappM (rnField doc) fields `thenM` \ new_fields ->
655 returnM (RecCon new_fields)
657 field_names = [fld | (fld, _) <- fields]
659 rnField doc (name, ty)
660 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
661 rnLHsType doc ty `thenM` \ new_ty ->
662 returnM (new_name, new_ty)
664 -- This data decl will parse OK
666 -- treating "a" as the constructor.
667 -- It is really hard to make the parser spot this malformation.
668 -- So the renamer has to check that the constructor is legal
670 -- We can get an operator as the constructor, even in the prefix form:
671 -- data T = :% Int Int
672 -- from interface files, which always print in prefix form
674 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
677 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
681 %*********************************************************
683 \subsection{Support code to rename types}
685 %*********************************************************
688 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
691 = mappM (wrapLocM rn_fds) fds
694 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
695 rnHsTyVars doc tys2 `thenM` \ tys2' ->
696 returnM (tys1', tys2')
698 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
699 rnHsTyvar doc tyvar = lookupOccRn tyvar
703 %*********************************************************
707 %*********************************************************
710 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
711 rnSplice (HsSplice n expr)
712 = checkTH expr "splice" `thenM_`
713 getSrcSpanM `thenM` \ loc ->
714 newLocalsRn [L loc n] `thenM` \ [n'] ->
715 rnLExpr expr `thenM` \ (expr', fvs) ->
716 returnM (HsSplice n' expr', fvs)