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
126 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
127 tcg_env <- getGblEnv ;
128 return (tcg_env `addTcgDUs` src_dus, rn_group)
131 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
132 rnTyClDecls tycl_decls = do
133 (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
136 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
137 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
141 %*********************************************************
143 Source-code fixity declarations
145 %*********************************************************
148 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM FixityEnv
149 rnSrcFixityDecls fix_decls
150 = getGblEnv `thenM` \ gbl_env ->
151 foldlM rnFixityDecl (tcg_fix_env gbl_env)
152 fix_decls `thenM` \ fix_env ->
153 traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
156 rnFixityDecl :: FixityEnv -> LFixitySig RdrName -> RnM FixityEnv
157 rnFixityDecl fix_env (L loc (FixitySig rdr_name fixity))
159 -- GHC extension: look up both the tycon and data con
160 -- for con-like things
161 -- If neither are in scope, report an error; otherwise
162 -- add both to the fixity env
163 addLocM lookupTopFixSigNames rdr_name `thenM` \ names ->
165 addLocErr rdr_name unknownNameErr `thenM_`
168 foldlM add fix_env names
171 = case lookupNameEnv fix_env name of
172 Just (FixItem _ _ loc')
173 -> addLocErr rdr_name (dupFixityDecl loc') `thenM_`
175 Nothing -> returnM (extendNameEnv fix_env name fix_item)
177 fix_item = FixItem (rdrNameOcc (unLoc rdr_name)) fixity
180 pprFixEnv :: FixityEnv -> SDoc
182 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
185 dupFixityDecl loc rdr_name
186 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
187 ptext SLIT("also at ") <+> ppr loc
192 %*********************************************************
194 Source-code deprecations declarations
196 %*********************************************************
198 For deprecations, all we do is check that the names are in scope.
199 It's only imported deprecations, dealt with in RnIfaces, that we
200 gather them together.
203 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
207 rnSrcDeprecDecls decls
208 = mappM (addLocM rn_deprec) decls `thenM` \ pairs ->
209 returnM (DeprecSome (mkNameEnv (catMaybes pairs)))
211 rn_deprec (Deprecation rdr_name txt)
212 = lookupTopBndrRn rdr_name `thenM` \ name ->
213 returnM (Just (name, (rdrNameOcc rdr_name, txt)))
215 checkModDeprec :: Maybe DeprecTxt -> Deprecations
216 -- Check for a module deprecation; done once at top level
217 checkModDeprec Nothing = NoDeprecs
218 checkModDeprec (Just txt) = DeprecAll txt
221 %*********************************************************
223 \subsection{Source code declarations}
225 %*********************************************************
228 rnDefaultDecl (DefaultDecl tys)
229 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
230 returnM (DefaultDecl tys', fvs)
232 doc_str = text "In a `default' declaration"
235 %*********************************************************
239 %*********************************************************
241 These chaps are here, rather than in TcBinds, so that there
242 is just one hi-boot file (for RnSource). rnSrcDecls is part
243 of the loop too, and it must be defined in this module.
246 rnBindGroups :: [HsBindGroup RdrName] -> RnM ([HsBindGroup Name], DefUses)
247 -- This version assumes that the binders are already in scope
248 -- It's used only in 'mdo'
250 = returnM ([], emptyDUs)
251 rnBindGroups [HsBindGroup bind sigs _]
252 = rnBinds NotTopLevel bind sigs
253 rnBindGroups b@[HsIPBinds bind]
254 = do addErr (badIpBinds b)
255 returnM ([], emptyDUs)
257 = panic "rnBindGroups"
260 :: [HsBindGroup RdrName]
261 -> ([HsBindGroup Name] -> RnM (result, FreeVars))
262 -> RnM (result, FreeVars)
263 -- This version (a) assumes that the binding vars are not already in scope
264 -- (b) removes the binders from the free vars of the thing inside
265 -- The parser doesn't produce ThenBinds
266 rnBindGroupsAndThen [] thing_inside
268 rnBindGroupsAndThen [HsBindGroup bind sigs _] thing_inside
269 = rnBindsAndThen bind sigs $ \ groups -> thing_inside groups
270 rnBindGroupsAndThen [HsIPBinds binds] thing_inside
271 = rnIPBinds binds `thenM` \ (binds',fv_binds) ->
272 thing_inside [HsIPBinds binds'] `thenM` \ (thing, fvs_thing) ->
273 returnM (thing, fvs_thing `plusFV` fv_binds)
275 rnIPBinds [] = returnM ([], emptyFVs)
276 rnIPBinds (bind : binds)
277 = wrapLocFstM rnIPBind bind `thenM` \ (bind', fvBind) ->
278 rnIPBinds binds `thenM` \ (binds',fvBinds) ->
279 returnM (bind' : binds', fvBind `plusFV` fvBinds)
281 rnIPBind (IPBind n expr)
282 = newIPNameRn n `thenM` \ name ->
283 rnLExpr expr `thenM` \ (expr',fvExpr) ->
284 return (IPBind name expr', fvExpr)
287 = hang (ptext SLIT("Implicit-parameter bindings illegal in 'mdo':")) 4
292 %*********************************************************
294 \subsection{Foreign declarations}
296 %*********************************************************
299 rnHsForeignDecl (ForeignImport name ty spec isDeprec)
300 = lookupLocatedTopBndrRn name `thenM` \ name' ->
301 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
302 returnM (ForeignImport name' ty' spec isDeprec, fvs)
304 rnHsForeignDecl (ForeignExport name ty spec isDeprec)
305 = lookupLocatedOccRn name `thenM` \ name' ->
306 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
307 returnM (ForeignExport name' ty' spec isDeprec, fvs )
308 -- NB: a foreign export is an *occurrence site* for name, so
309 -- we add it to the free-variable list. It might, for example,
310 -- be imported from another module
312 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
316 %*********************************************************
318 \subsection{Instance declarations}
320 %*********************************************************
323 rnSrcInstDecl (InstDecl inst_ty mbinds uprags)
324 -- Used for both source and interface file decls
325 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
327 -- Rename the bindings
328 -- The typechecker (not the renamer) checks that all
329 -- the bindings are for the right class
331 meth_doc = text "In the bindings in an instance declaration"
332 meth_names = collectHsBindLocatedBinders mbinds
333 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
335 checkDupNames meth_doc meth_names `thenM_`
336 extendTyVarEnvForMethodBinds inst_tyvars (
337 -- (Slightly strangely) the forall-d tyvars scope over
338 -- the method bindings too
339 rnMethodBinds cls [] mbinds
340 ) `thenM` \ (mbinds', meth_fvs) ->
341 -- Rename the prags and signatures.
342 -- Note that the type variables are not in scope here,
343 -- so that instance Eq a => Eq (T a) where
344 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
347 -- But the (unqualified) method names are in scope
349 binders = collectHsBindBinders mbinds'
351 bindLocalNames binders (renameSigs uprags) `thenM` \ uprags' ->
352 checkSigs (okInstDclSig (mkNameSet binders)) uprags' `thenM_`
354 returnM (InstDecl inst_ty' mbinds' uprags',
355 meth_fvs `plusFV` hsSigsFVs uprags'
356 `plusFV` extractHsTyNames inst_ty')
359 For the method bindings in class and instance decls, we extend the
360 type variable environment iff -fglasgow-exts
363 extendTyVarEnvForMethodBinds tyvars thing_inside
364 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
365 if opt_GlasgowExts then
366 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
372 %*********************************************************
376 %*********************************************************
379 rnHsRuleDecl (HsRule rule_name act vars lhs rhs)
380 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
382 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
383 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
385 rnLExpr lhs `thenM` \ (lhs', fv_lhs) ->
386 rnLExpr rhs `thenM` \ (rhs', fv_rhs) ->
388 mb_bad = validRuleLhs ids lhs'
390 checkErr (isNothing mb_bad)
391 (badRuleLhsErr rule_name lhs' mb_bad) `thenM_`
393 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
395 mappM (addErr . badRuleVar rule_name) bad_vars `thenM_`
396 returnM (HsRule rule_name act vars' lhs' rhs',
397 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
399 doc = text "In the transformation rule" <+> ftext rule_name
401 get_var (RuleBndr v) = v
402 get_var (RuleBndrSig v _) = v
404 rn_var (RuleBndr (L loc v), id)
405 = returnM (RuleBndr (L loc id), emptyFVs)
406 rn_var (RuleBndrSig (L loc v) t, id)
407 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
408 returnM (RuleBndrSig (L loc id) t', fvs)
411 Check the shape of a transformation rule LHS. Currently
412 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
413 not one of the @forall@'d variables. We also restrict the form of the LHS so
414 that it may be plausibly matched. Basically you only get to write ordinary
415 applications. (E.g. a case expression is not allowed: too elaborate.)
417 NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
420 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
422 -- Just e => Not ok, and e is the offending expression
423 validRuleLhs foralls lhs
426 checkl (L loc e) = check e
428 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
429 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
430 check (HsVar v) | v `notElem` foralls = Nothing
431 check other = Just other -- Failure
433 checkl_e (L loc e) = check_e e
435 check_e (HsVar v) = Nothing
436 check_e (HsPar e) = checkl_e e
437 check_e (HsLit e) = Nothing
438 check_e (HsOverLit e) = Nothing
440 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
441 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
442 check_e (NegApp e _) = checkl_e e
443 check_e (ExplicitList _ es) = checkl_es es
444 check_e (ExplicitTuple es _) = checkl_es es
445 check_e other = Just other -- Fails
447 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
449 badRuleLhsErr name lhs (Just bad_e)
450 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
451 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
452 ptext SLIT("in left-hand side:") <+> ppr lhs])]
454 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
457 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
458 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
459 ptext SLIT("does not appear on left hand side")]
463 %*********************************************************
465 \subsection{Type, class and iface sig declarations}
467 %*********************************************************
469 @rnTyDecl@ uses the `global name function' to create a new type
470 declaration in which local names have been replaced by their original
471 names, reporting any unknown names.
473 Renaming type variables is a pain. Because they now contain uniques,
474 it is necessary to pass in an association list which maps a parsed
475 tyvar to its @Name@ representation.
476 In some cases (type signatures of values),
477 it is even necessary to go over the type first
478 in order to get the set of tyvars used by it, make an assoc list,
479 and then go over it again to rename the tyvars!
480 However, we can also do some scoping checks at the same time.
483 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
484 = lookupLocatedTopBndrRn name `thenM` \ name' ->
485 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
488 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
489 tcdTyVars = tyvars, tcdCons = condecls,
491 | is_vanilla -- Normal Haskell data type decl
492 = bindTyVarsRn data_doc tyvars $ \ tyvars' ->
493 do { tycon' <- lookupLocatedTopBndrRn tycon
494 ; context' <- rnContext data_doc context
495 ; (derivs', deriv_fvs) <- rn_derivs derivs
496 ; checkDupNames data_doc con_names
497 ; condecls' <- rnConDecls (unLoc tycon') condecls
498 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
499 tcdTyVars = tyvars', tcdCons = condecls',
500 tcdDerivs = derivs'},
501 delFVs (map hsLTyVarName tyvars') $
502 extractHsCtxtTyNames context' `plusFV`
503 plusFVs (map conDeclFVs condecls') `plusFV`
507 = ASSERT( null (unLoc context) )
508 do { tycon' <- lookupLocatedTopBndrRn tycon
509 ; tyvars' <- bindTyVarsRn data_doc tyvars
510 (\ tyvars' -> return tyvars')
511 -- For GADTs, the type variables in the declaration
512 -- do not scope over the constructor signatures
513 -- data T a where { T1 :: forall b. b-> b }
514 ; (derivs', deriv_fvs) <- rn_derivs derivs
515 ; checkDupNames data_doc con_names
516 ; condecls' <- rnConDecls (unLoc tycon') condecls
517 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
518 tcdTyVars = tyvars', tcdCons = condecls',
519 tcdDerivs = derivs'},
520 plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
523 is_vanilla = case condecls of -- Yuk
525 L _ (ConDecl {}) : _ -> True
528 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
529 con_names = map con_names_helper condecls
531 con_names_helper (L _ (ConDecl n _ _ _)) = n
532 con_names_helper (L _ (GadtDecl n _)) = n
534 rn_derivs Nothing = returnM (Nothing, emptyFVs)
535 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
536 returnM (Just ds', extractHsTyNames_s ds')
538 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
539 = lookupLocatedTopBndrRn name `thenM` \ name' ->
540 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
541 rnHsTypeFVs syn_doc ty `thenM` \ (ty', fvs) ->
542 returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
544 delFVs (map hsLTyVarName tyvars') fvs)
546 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
548 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
549 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
551 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
553 -- Tyvars scope over superclass context and method signatures
554 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
555 rnContext cls_doc context `thenM` \ context' ->
556 rnFds cls_doc fds `thenM` \ fds' ->
557 renameSigs sigs `thenM` \ sigs' ->
558 returnM (tyvars', context', fds', sigs')
559 ) `thenM` \ (tyvars', context', fds', sigs') ->
561 -- Check the signatures
562 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
564 sig_rdr_names_w_locs = [op | L _ (Sig op _) <- sigs]
566 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
567 checkSigs okClsDclSig sigs' `thenM_`
568 -- Typechecker is responsible for checking that we only
569 -- give default-method bindings for things in this class.
570 -- The renamer *could* check this for class decls, but can't
571 -- for instance decls.
573 -- The newLocals call is tiresome: given a generic class decl
576 -- op {| x+y |} (Inl a) = ...
577 -- op {| x+y |} (Inr b) = ...
578 -- op {| a*b |} (a*b) = ...
579 -- we want to name both "x" tyvars with the same unique, so that they are
580 -- easy to group together in the typechecker.
581 extendTyVarEnvForMethodBinds tyvars' (
582 getLocalRdrEnv `thenM` \ name_env ->
584 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
585 gen_rdr_tyvars_w_locs =
586 [ tv | tv <- extractGenericPatTyVars mbinds,
587 not (unLoc tv `elemLocalRdrEnv` name_env) ]
589 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
590 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
591 rnMethodBinds (unLoc cname') gen_tyvars mbinds
592 ) `thenM` \ (mbinds', meth_fvs) ->
594 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
595 tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
596 delFVs (map hsLTyVarName tyvars') $
597 extractHsCtxtTyNames context' `plusFV`
598 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
599 hsSigsFVs sigs' `plusFV`
602 meth_doc = text "In the default-methods for class" <+> ppr cname
603 cls_doc = text "In the declaration for class" <+> ppr cname
604 sig_doc = text "In the signatures for class" <+> ppr cname
607 %*********************************************************
609 \subsection{Support code for type/data declarations}
611 %*********************************************************
614 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
615 rnConDecls tycon condecls
616 = -- Check that there's at least one condecl,
617 -- or else we're reading an interface file, or -fglasgow-exts
618 (if null condecls then
619 doptM Opt_GlasgowExts `thenM` \ glaExts ->
620 checkErr glaExts (emptyConDeclsErr tycon)
623 mappM (wrapLocM rnConDecl) condecls
625 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
626 rnConDecl (ConDecl name tvs cxt details)
627 = addLocM checkConName name `thenM_`
628 lookupLocatedTopBndrRn name `thenM` \ new_name ->
630 bindTyVarsRn doc tvs $ \ new_tyvars ->
631 rnContext doc cxt `thenM` \ new_context ->
632 rnConDetails doc details `thenM` \ new_details ->
633 returnM (ConDecl new_name new_tyvars new_context new_details)
635 doc = text "In the definition of data constructor" <+> quotes (ppr name)
637 rnConDecl (GadtDecl name ty)
638 = addLocM checkConName name `thenM_`
639 lookupLocatedTopBndrRn name `thenM` \ new_name ->
640 rnHsSigType doc ty `thenM` \ new_ty ->
641 returnM (GadtDecl new_name new_ty)
643 doc = text "In the definition of data constructor" <+> quotes (ppr name)
645 rnConDetails doc (PrefixCon tys)
646 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
647 returnM (PrefixCon new_tys)
649 rnConDetails doc (InfixCon ty1 ty2)
650 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
651 rnLHsType doc ty2 `thenM` \ new_ty2 ->
652 returnM (InfixCon new_ty1 new_ty2)
654 rnConDetails doc (RecCon fields)
655 = checkDupNames doc field_names `thenM_`
656 mappM (rnField doc) fields `thenM` \ new_fields ->
657 returnM (RecCon new_fields)
659 field_names = [fld | (fld, _) <- fields]
661 rnField doc (name, ty)
662 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
663 rnLHsType doc ty `thenM` \ new_ty ->
664 returnM (new_name, new_ty)
666 -- This data decl will parse OK
668 -- treating "a" as the constructor.
669 -- It is really hard to make the parser spot this malformation.
670 -- So the renamer has to check that the constructor is legal
672 -- We can get an operator as the constructor, even in the prefix form:
673 -- data T = :% Int Int
674 -- from interface files, which always print in prefix form
676 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
679 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
681 emptyConDeclsErr tycon
682 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
683 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
687 %*********************************************************
689 \subsection{Support code to rename types}
691 %*********************************************************
694 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
697 = mappM (wrapLocM rn_fds) fds
700 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
701 rnHsTyVars doc tys2 `thenM` \ tys2' ->
702 returnM (tys1', tys2')
704 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
705 rnHsTyvar doc tyvar = lookupOccRn tyvar
709 %*********************************************************
713 %*********************************************************
716 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
717 rnSplice (HsSplice n expr)
718 = checkTH expr "splice" `thenM_`
719 getSrcSpanM `thenM` \ loc ->
720 newLocalsRn [L loc n] `thenM` \ [n'] ->
721 rnLExpr expr `thenM` \ (expr', fvs) ->
722 returnM (HsSplice n' expr', fvs)