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 )
42 import SrcLoc ( Located(..), unLoc, getLoc, noLoc )
43 import CmdLineOpts ( DynFlag(..) )
44 -- Warn of unused for-all'd tyvars
45 import Maybes ( seqMaybe )
46 import Maybe ( catMaybes, isNothing )
49 @rnSourceDecl@ `renames' declarations.
50 It simultaneously performs dependency analysis and precedence parsing.
51 It also does the following error checks:
54 Checks that tyvars are used properly. This includes checking
55 for undefined tyvars, and tyvars in contexts that are ambiguous.
56 (Some of this checking has now been moved to module @TcMonoType@,
57 since we don't have functional dependency information at this point.)
59 Checks that all variable occurences are defined.
61 Checks the @(..)@ etc constraints in the export list.
66 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
68 rnSrcDecls (HsGroup { hs_valds = [HsBindGroup binds sigs _],
69 hs_tyclds = tycl_decls,
70 hs_instds = inst_decls,
72 hs_depds = deprec_decls,
73 hs_fords = foreign_decls,
74 hs_defds = default_decls,
75 hs_ruleds = rule_decls })
77 = do { -- Deal with deprecations (returns only the extra deprecations)
78 deprecs <- rnSrcDeprecDecls deprec_decls ;
79 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
82 -- Deal with top-level fixity decls
83 -- (returns the total new fixity env)
84 fix_env <- rnSrcFixityDecls fix_decls ;
85 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
88 -- Rename other declarations
89 traceRn (text "Start rnmono") ;
90 (rn_val_decls, bind_dus) <- rnTopBinds binds sigs ;
91 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
93 -- You might think that we could build proper def/use information
94 -- for type and class declarations, but they can be involved
95 -- in mutual recursion across modules, and we only do the SCC
96 -- analysis for them in the type checker.
97 -- So we content ourselves with gathering uses only; that
98 -- means we'll only report a declaration as unused if it isn't
99 -- mentioned at all. Ah well.
100 (rn_tycl_decls, src_fvs1)
101 <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
102 (rn_inst_decls, src_fvs2)
103 <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
104 (rn_rule_decls, src_fvs3)
105 <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
106 (rn_foreign_decls, src_fvs4)
107 <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
108 (rn_default_decls, src_fvs5)
109 <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
112 rn_group = HsGroup { hs_valds = rn_val_decls,
113 hs_tyclds = rn_tycl_decls,
114 hs_instds = rn_inst_decls,
117 hs_fords = rn_foreign_decls,
118 hs_defds = rn_default_decls,
119 hs_ruleds = rn_rule_decls } ;
121 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3,
122 src_fvs4, src_fvs5] ;
123 src_dus = bind_dus `plusDU` usesOnly other_fvs
124 -- Note: src_dus will contain *uses* for locally-defined types
125 -- and classes, but no *defs* for them. (Because rnTyClDecl
126 -- returns only the uses.) This is a little
127 -- surprising but it doesn't actually matter at all.
130 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
131 traceRn (text "finish Dus" <+> ppr src_dus ) ;
132 tcg_env <- getGblEnv ;
133 return (tcg_env `addTcgDUs` src_dus, rn_group)
136 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
137 rnTyClDecls tycl_decls = do
138 (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
141 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
142 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
146 %*********************************************************
148 Source-code fixity declarations
150 %*********************************************************
153 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM FixityEnv
154 rnSrcFixityDecls fix_decls
155 = getGblEnv `thenM` \ gbl_env ->
156 foldlM rnFixityDecl (tcg_fix_env gbl_env)
157 fix_decls `thenM` \ fix_env ->
158 traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
161 rnFixityDecl :: FixityEnv -> LFixitySig RdrName -> RnM FixityEnv
162 rnFixityDecl fix_env (L loc (FixitySig rdr_name fixity))
164 -- GHC extension: look up both the tycon and data con
165 -- for con-like things
166 -- If neither are in scope, report an error; otherwise
167 -- add both to the fixity env
168 addLocM lookupTopFixSigNames rdr_name `thenM` \ names ->
170 addLocErr rdr_name unknownNameErr `thenM_`
173 foldlM add fix_env names
176 = case lookupNameEnv fix_env name of
177 Just (FixItem _ _ loc')
178 -> addLocErr rdr_name (dupFixityDecl loc') `thenM_`
180 Nothing -> returnM (extendNameEnv fix_env name fix_item)
182 fix_item = FixItem (rdrNameOcc (unLoc rdr_name)) fixity
185 pprFixEnv :: FixityEnv -> SDoc
187 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
190 dupFixityDecl loc rdr_name
191 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
192 ptext SLIT("also at ") <+> ppr loc
197 %*********************************************************
199 Source-code deprecations declarations
201 %*********************************************************
203 For deprecations, all we do is check that the names are in scope.
204 It's only imported deprecations, dealt with in RnIfaces, that we
205 gather them together.
208 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
212 rnSrcDeprecDecls decls
213 = mappM (addLocM rn_deprec) decls `thenM` \ pairs ->
214 returnM (DeprecSome (mkNameEnv (catMaybes pairs)))
216 rn_deprec (Deprecation rdr_name txt)
217 = lookupTopBndrRn rdr_name `thenM` \ name ->
218 returnM (Just (name, (rdrNameOcc rdr_name, txt)))
220 checkModDeprec :: Maybe DeprecTxt -> Deprecations
221 -- Check for a module deprecation; done once at top level
222 checkModDeprec Nothing = NoDeprecs
223 checkModDeprec (Just txt) = DeprecAll txt
226 %*********************************************************
228 \subsection{Source code declarations}
230 %*********************************************************
233 rnDefaultDecl (DefaultDecl tys)
234 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
235 returnM (DefaultDecl tys', fvs)
237 doc_str = text "In a `default' declaration"
240 %*********************************************************
244 %*********************************************************
246 These chaps are here, rather than in TcBinds, so that there
247 is just one hi-boot file (for RnSource). rnSrcDecls is part
248 of the loop too, and it must be defined in this module.
251 rnBindGroups :: [HsBindGroup RdrName] -> RnM ([HsBindGroup Name], DefUses)
252 -- This version assumes that the binders are already in scope
253 -- It's used only in 'mdo'
255 = returnM ([], emptyDUs)
256 rnBindGroups [HsBindGroup bind sigs _]
257 = rnBinds NotTopLevel bind sigs
258 rnBindGroups b@[HsIPBinds bind]
259 = do addErr (badIpBinds b)
260 returnM ([], emptyDUs)
262 = panic "rnBindGroups"
265 :: [HsBindGroup RdrName]
266 -> ([HsBindGroup Name] -> RnM (result, FreeVars))
267 -> RnM (result, FreeVars)
268 -- This version (a) assumes that the binding vars are not already in scope
269 -- (b) removes the binders from the free vars of the thing inside
270 -- The parser doesn't produce ThenBinds
271 rnBindGroupsAndThen [] thing_inside
273 rnBindGroupsAndThen [HsBindGroup bind sigs _] thing_inside
274 = rnBindsAndThen bind sigs $ \ groups -> thing_inside groups
275 rnBindGroupsAndThen [HsIPBinds binds] thing_inside
276 = rnIPBinds binds `thenM` \ (binds',fv_binds) ->
277 thing_inside [HsIPBinds binds'] `thenM` \ (thing, fvs_thing) ->
278 returnM (thing, fvs_thing `plusFV` fv_binds)
280 rnIPBinds [] = returnM ([], emptyFVs)
281 rnIPBinds (bind : binds)
282 = wrapLocFstM rnIPBind bind `thenM` \ (bind', fvBind) ->
283 rnIPBinds binds `thenM` \ (binds',fvBinds) ->
284 returnM (bind' : binds', fvBind `plusFV` fvBinds)
286 rnIPBind (IPBind n expr)
287 = newIPNameRn n `thenM` \ name ->
288 rnLExpr expr `thenM` \ (expr',fvExpr) ->
289 return (IPBind name expr', fvExpr)
292 = hang (ptext SLIT("Implicit-parameter bindings illegal in 'mdo':")) 4
297 %*********************************************************
299 \subsection{Foreign declarations}
301 %*********************************************************
304 rnHsForeignDecl (ForeignImport name ty spec isDeprec)
305 = lookupLocatedTopBndrRn name `thenM` \ name' ->
306 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
307 returnM (ForeignImport name' ty' spec isDeprec, fvs)
309 rnHsForeignDecl (ForeignExport name ty spec isDeprec)
310 = lookupLocatedOccRn name `thenM` \ name' ->
311 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
312 returnM (ForeignExport name' ty' spec isDeprec, fvs )
313 -- NB: a foreign export is an *occurrence site* for name, so
314 -- we add it to the free-variable list. It might, for example,
315 -- be imported from another module
317 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
321 %*********************************************************
323 \subsection{Instance declarations}
325 %*********************************************************
328 rnSrcInstDecl (InstDecl inst_ty mbinds uprags)
329 -- Used for both source and interface file decls
330 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
332 -- Rename the bindings
333 -- The typechecker (not the renamer) checks that all
334 -- the bindings are for the right class
336 meth_doc = text "In the bindings in an instance declaration"
337 meth_names = collectHsBindLocatedBinders mbinds
338 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
340 checkDupNames meth_doc meth_names `thenM_`
341 extendTyVarEnvForMethodBinds inst_tyvars (
342 -- (Slightly strangely) the forall-d tyvars scope over
343 -- the method bindings too
344 rnMethodBinds cls [] mbinds
345 ) `thenM` \ (mbinds', meth_fvs) ->
346 -- Rename the prags and signatures.
347 -- Note that the type variables are not in scope here,
348 -- so that instance Eq a => Eq (T a) where
349 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
352 -- But the (unqualified) method names are in scope
354 binders = collectHsBindBinders mbinds'
356 bindLocalNames binders (renameSigs uprags) `thenM` \ uprags' ->
357 checkSigs (okInstDclSig (mkNameSet binders)) uprags' `thenM_`
359 returnM (InstDecl inst_ty' mbinds' uprags',
360 meth_fvs `plusFV` hsSigsFVs uprags'
361 `plusFV` extractHsTyNames inst_ty')
364 For the method bindings in class and instance decls, we extend the
365 type variable environment iff -fglasgow-exts
368 extendTyVarEnvForMethodBinds tyvars thing_inside
369 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
370 if opt_GlasgowExts then
371 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
377 %*********************************************************
381 %*********************************************************
384 rnHsRuleDecl (HsRule rule_name act vars lhs rhs)
385 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
387 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
388 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
390 rnLExpr lhs `thenM` \ (lhs', fv_lhs) ->
391 rnLExpr rhs `thenM` \ (rhs', fv_rhs) ->
393 mb_bad = validRuleLhs ids lhs'
395 checkErr (isNothing mb_bad)
396 (badRuleLhsErr rule_name lhs' mb_bad) `thenM_`
398 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
400 mappM (addErr . badRuleVar rule_name) bad_vars `thenM_`
401 returnM (HsRule rule_name act vars' lhs' rhs',
402 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
404 doc = text "In the transformation rule" <+> ftext rule_name
406 get_var (RuleBndr v) = v
407 get_var (RuleBndrSig v _) = v
409 rn_var (RuleBndr (L loc v), id)
410 = returnM (RuleBndr (L loc id), emptyFVs)
411 rn_var (RuleBndrSig (L loc v) t, id)
412 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
413 returnM (RuleBndrSig (L loc id) t', fvs)
416 Check the shape of a transformation rule LHS. Currently
417 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
418 not one of the @forall@'d variables. We also restrict the form of the LHS so
419 that it may be plausibly matched. Basically you only get to write ordinary
420 applications. (E.g. a case expression is not allowed: too elaborate.)
422 NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
425 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
427 -- Just e => Not ok, and e is the offending expression
428 validRuleLhs foralls lhs
431 checkl (L loc e) = check e
433 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
434 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
435 check (HsVar v) | v `notElem` foralls = Nothing
436 check other = Just other -- Failure
438 checkl_e (L loc e) = check_e e
440 check_e (HsVar v) = Nothing
441 check_e (HsPar e) = checkl_e e
442 check_e (HsLit e) = Nothing
443 check_e (HsOverLit e) = Nothing
445 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
446 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
447 check_e (NegApp e _) = checkl_e e
448 check_e (ExplicitList _ es) = checkl_es es
449 check_e (ExplicitTuple es _) = checkl_es es
450 check_e other = Just other -- Fails
452 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
454 badRuleLhsErr name lhs (Just bad_e)
455 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
456 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
457 ptext SLIT("in left-hand side:") <+> ppr lhs])]
459 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
462 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
463 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
464 ptext SLIT("does not appear on left hand side")]
468 %*********************************************************
470 \subsection{Type, class and iface sig declarations}
472 %*********************************************************
474 @rnTyDecl@ uses the `global name function' to create a new type
475 declaration in which local names have been replaced by their original
476 names, reporting any unknown names.
478 Renaming type variables is a pain. Because they now contain uniques,
479 it is necessary to pass in an association list which maps a parsed
480 tyvar to its @Name@ representation.
481 In some cases (type signatures of values),
482 it is even necessary to go over the type first
483 in order to get the set of tyvars used by it, make an assoc list,
484 and then go over it again to rename the tyvars!
485 However, we can also do some scoping checks at the same time.
488 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
489 = lookupLocatedTopBndrRn name `thenM` \ name' ->
490 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
493 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
494 tcdTyVars = tyvars, tcdCons = condecls,
495 tcdKindSig = sig, tcdDerivs = derivs})
496 | is_vanilla -- Normal Haskell data type decl
497 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
498 -- data type is syntactically illegal
499 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
500 do { tycon' <- lookupLocatedTopBndrRn tycon
501 ; context' <- rnContext data_doc context
502 ; (derivs', deriv_fvs) <- rn_derivs derivs
503 ; checkDupNames data_doc con_names
504 ; condecls' <- rnConDecls (unLoc tycon') condecls
505 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
506 tcdTyVars = tyvars', tcdKindSig = Nothing, tcdCons = condecls',
507 tcdDerivs = derivs'},
508 delFVs (map hsLTyVarName tyvars') $
509 extractHsCtxtTyNames context' `plusFV`
510 plusFVs (map conDeclFVs condecls') `plusFV`
514 = ASSERT( null (unLoc context) )
515 do { tycon' <- lookupLocatedTopBndrRn tycon
516 ; tyvars' <- bindTyVarsRn data_doc tyvars
517 (\ tyvars' -> return tyvars')
518 -- For GADTs, the type variables in the declaration
519 -- do not scope over the constructor signatures
520 -- data T a where { T1 :: forall b. b-> b }
521 ; (derivs', deriv_fvs) <- rn_derivs derivs
522 ; checkDupNames data_doc con_names
523 ; condecls' <- rnConDecls (unLoc tycon') condecls
524 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
525 tcdTyVars = tyvars', tcdCons = condecls', tcdKindSig = sig,
526 tcdDerivs = derivs'},
527 plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
530 is_vanilla = case condecls of -- Yuk
532 L _ (ConDecl {}) : _ -> True
535 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
536 con_names = map con_names_helper condecls
538 con_names_helper (L _ (ConDecl n _ _ _)) = n
539 con_names_helper (L _ (GadtDecl n _)) = n
541 rn_derivs Nothing = returnM (Nothing, emptyFVs)
542 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
543 returnM (Just ds', extractHsTyNames_s ds')
545 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
546 = lookupLocatedTopBndrRn name `thenM` \ name' ->
547 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
548 rnHsTypeFVs syn_doc ty `thenM` \ (ty', fvs) ->
549 returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
551 delFVs (map hsLTyVarName tyvars') fvs)
553 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
555 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
556 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
558 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
560 -- Tyvars scope over superclass context and method signatures
561 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
562 rnContext cls_doc context `thenM` \ context' ->
563 rnFds cls_doc fds `thenM` \ fds' ->
564 renameSigs sigs `thenM` \ sigs' ->
565 returnM (tyvars', context', fds', sigs')
566 ) `thenM` \ (tyvars', context', fds', sigs') ->
568 -- Check the signatures
569 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
571 sig_rdr_names_w_locs = [op | L _ (Sig op _) <- sigs]
573 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
574 checkSigs okClsDclSig sigs' `thenM_`
575 -- Typechecker is responsible for checking that we only
576 -- give default-method bindings for things in this class.
577 -- The renamer *could* check this for class decls, but can't
578 -- for instance decls.
580 -- The newLocals call is tiresome: given a generic class decl
583 -- op {| x+y |} (Inl a) = ...
584 -- op {| x+y |} (Inr b) = ...
585 -- op {| a*b |} (a*b) = ...
586 -- we want to name both "x" tyvars with the same unique, so that they are
587 -- easy to group together in the typechecker.
588 extendTyVarEnvForMethodBinds tyvars' (
589 getLocalRdrEnv `thenM` \ name_env ->
591 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
592 gen_rdr_tyvars_w_locs =
593 [ tv | tv <- extractGenericPatTyVars mbinds,
594 not (unLoc tv `elemLocalRdrEnv` name_env) ]
596 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
597 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
598 rnMethodBinds (unLoc cname') gen_tyvars mbinds
599 ) `thenM` \ (mbinds', meth_fvs) ->
601 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
602 tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
603 delFVs (map hsLTyVarName tyvars') $
604 extractHsCtxtTyNames context' `plusFV`
605 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
606 hsSigsFVs sigs' `plusFV`
609 meth_doc = text "In the default-methods for class" <+> ppr cname
610 cls_doc = text "In the declaration for class" <+> ppr cname
611 sig_doc = text "In the signatures for class" <+> ppr cname
614 %*********************************************************
616 \subsection{Support code for type/data declarations}
618 %*********************************************************
621 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
622 rnConDecls tycon condecls
623 = -- Check that there's at least one condecl,
624 -- or else we're reading an interface file, or -fglasgow-exts
625 (if null condecls then
626 doptM Opt_GlasgowExts `thenM` \ glaExts ->
627 checkErr glaExts (emptyConDeclsErr tycon)
630 mappM (wrapLocM rnConDecl) condecls
632 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
633 rnConDecl (ConDecl name tvs cxt details)
634 = addLocM checkConName name `thenM_`
635 lookupLocatedTopBndrRn name `thenM` \ new_name ->
637 bindTyVarsRn doc tvs $ \ new_tyvars ->
638 rnContext doc cxt `thenM` \ new_context ->
639 rnConDetails doc details `thenM` \ new_details ->
640 returnM (ConDecl new_name new_tyvars new_context new_details)
642 doc = text "In the definition of data constructor" <+> quotes (ppr name)
644 rnConDecl (GadtDecl name ty)
645 = addLocM checkConName name `thenM_`
646 lookupLocatedTopBndrRn name `thenM` \ new_name ->
647 rnHsSigType doc ty `thenM` \ new_ty ->
648 returnM (GadtDecl new_name new_ty)
650 doc = text "In the definition of data constructor" <+> quotes (ppr name)
652 rnConDetails doc (PrefixCon tys)
653 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
654 returnM (PrefixCon new_tys)
656 rnConDetails doc (InfixCon ty1 ty2)
657 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
658 rnLHsType doc ty2 `thenM` \ new_ty2 ->
659 returnM (InfixCon new_ty1 new_ty2)
661 rnConDetails doc (RecCon fields)
662 = checkDupNames doc field_names `thenM_`
663 mappM (rnField doc) fields `thenM` \ new_fields ->
664 returnM (RecCon new_fields)
666 field_names = [fld | (fld, _) <- fields]
668 rnField doc (name, ty)
669 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
670 rnLHsType doc ty `thenM` \ new_ty ->
671 returnM (new_name, new_ty)
673 -- This data decl will parse OK
675 -- treating "a" as the constructor.
676 -- It is really hard to make the parser spot this malformation.
677 -- So the renamer has to check that the constructor is legal
679 -- We can get an operator as the constructor, even in the prefix form:
680 -- data T = :% Int Int
681 -- from interface files, which always print in prefix form
683 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
686 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
688 emptyConDeclsErr tycon
689 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
690 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
694 %*********************************************************
696 \subsection{Support code to rename types}
698 %*********************************************************
701 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
704 = mappM (wrapLocM rn_fds) fds
707 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
708 rnHsTyVars doc tys2 `thenM` \ tys2' ->
709 returnM (tys1', tys2')
711 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
712 rnHsTyvar doc tyvar = lookupOccRn tyvar
716 %*********************************************************
720 %*********************************************************
723 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
724 rnSplice (HsSplice n expr)
725 = checkTH expr "splice" `thenM_`
726 getSrcSpanM `thenM` \ loc ->
727 newLocalsRn [L loc n] `thenM` \ [n'] ->
728 rnLExpr expr `thenM` \ (expr', fvs) ->
729 returnM (HsSplice n' expr', fvs)