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,
490 tcdKindSig = sig, tcdDerivs = derivs})
491 | is_vanilla -- Normal Haskell data type decl
492 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
493 -- data type is syntactically illegal
494 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
495 do { tycon' <- lookupLocatedTopBndrRn tycon
496 ; context' <- rnContext data_doc context
497 ; (derivs', deriv_fvs) <- rn_derivs derivs
498 ; checkDupNames data_doc con_names
499 ; condecls' <- rnConDecls (unLoc tycon') condecls
500 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
501 tcdTyVars = tyvars', tcdKindSig = Nothing, tcdCons = condecls',
502 tcdDerivs = derivs'},
503 delFVs (map hsLTyVarName tyvars') $
504 extractHsCtxtTyNames context' `plusFV`
505 plusFVs (map conDeclFVs condecls') `plusFV`
509 = ASSERT( null (unLoc context) )
510 do { tycon' <- lookupLocatedTopBndrRn tycon
511 ; tyvars' <- bindTyVarsRn data_doc tyvars
512 (\ tyvars' -> return tyvars')
513 -- For GADTs, the type variables in the declaration
514 -- do not scope over the constructor signatures
515 -- data T a where { T1 :: forall b. b-> b }
516 ; (derivs', deriv_fvs) <- rn_derivs derivs
517 ; checkDupNames data_doc con_names
518 ; condecls' <- rnConDecls (unLoc tycon') condecls
519 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
520 tcdTyVars = tyvars', tcdCons = condecls', tcdKindSig = sig,
521 tcdDerivs = derivs'},
522 plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
525 is_vanilla = case condecls of -- Yuk
527 L _ (ConDecl {}) : _ -> True
530 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
531 con_names = map con_names_helper condecls
533 con_names_helper (L _ (ConDecl n _ _ _)) = n
534 con_names_helper (L _ (GadtDecl n _)) = n
536 rn_derivs Nothing = returnM (Nothing, emptyFVs)
537 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
538 returnM (Just ds', extractHsTyNames_s ds')
540 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
541 = lookupLocatedTopBndrRn name `thenM` \ name' ->
542 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
543 rnHsTypeFVs syn_doc ty `thenM` \ (ty', fvs) ->
544 returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
546 delFVs (map hsLTyVarName tyvars') fvs)
548 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
550 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
551 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
553 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
555 -- Tyvars scope over superclass context and method signatures
556 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
557 rnContext cls_doc context `thenM` \ context' ->
558 rnFds cls_doc fds `thenM` \ fds' ->
559 renameSigs sigs `thenM` \ sigs' ->
560 returnM (tyvars', context', fds', sigs')
561 ) `thenM` \ (tyvars', context', fds', sigs') ->
563 -- Check the signatures
564 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
566 sig_rdr_names_w_locs = [op | L _ (Sig op _) <- sigs]
568 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
569 checkSigs okClsDclSig sigs' `thenM_`
570 -- Typechecker is responsible for checking that we only
571 -- give default-method bindings for things in this class.
572 -- The renamer *could* check this for class decls, but can't
573 -- for instance decls.
575 -- The newLocals call is tiresome: given a generic class decl
578 -- op {| x+y |} (Inl a) = ...
579 -- op {| x+y |} (Inr b) = ...
580 -- op {| a*b |} (a*b) = ...
581 -- we want to name both "x" tyvars with the same unique, so that they are
582 -- easy to group together in the typechecker.
583 extendTyVarEnvForMethodBinds tyvars' (
584 getLocalRdrEnv `thenM` \ name_env ->
586 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
587 gen_rdr_tyvars_w_locs =
588 [ tv | tv <- extractGenericPatTyVars mbinds,
589 not (unLoc tv `elemLocalRdrEnv` name_env) ]
591 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
592 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
593 rnMethodBinds (unLoc cname') gen_tyvars mbinds
594 ) `thenM` \ (mbinds', meth_fvs) ->
596 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
597 tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
598 delFVs (map hsLTyVarName tyvars') $
599 extractHsCtxtTyNames context' `plusFV`
600 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
601 hsSigsFVs sigs' `plusFV`
604 meth_doc = text "In the default-methods for class" <+> ppr cname
605 cls_doc = text "In the declaration for class" <+> ppr cname
606 sig_doc = text "In the signatures for class" <+> ppr cname
609 %*********************************************************
611 \subsection{Support code for type/data declarations}
613 %*********************************************************
616 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
617 rnConDecls tycon condecls
618 = -- Check that there's at least one condecl,
619 -- or else we're reading an interface file, or -fglasgow-exts
620 (if null condecls then
621 doptM Opt_GlasgowExts `thenM` \ glaExts ->
622 checkErr glaExts (emptyConDeclsErr tycon)
625 mappM (wrapLocM rnConDecl) condecls
627 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
628 rnConDecl (ConDecl name tvs cxt details)
629 = addLocM checkConName name `thenM_`
630 lookupLocatedTopBndrRn name `thenM` \ new_name ->
632 bindTyVarsRn doc tvs $ \ new_tyvars ->
633 rnContext doc cxt `thenM` \ new_context ->
634 rnConDetails doc details `thenM` \ new_details ->
635 returnM (ConDecl new_name new_tyvars new_context new_details)
637 doc = text "In the definition of data constructor" <+> quotes (ppr name)
639 rnConDecl (GadtDecl name ty)
640 = addLocM checkConName name `thenM_`
641 lookupLocatedTopBndrRn name `thenM` \ new_name ->
642 rnHsSigType doc ty `thenM` \ new_ty ->
643 returnM (GadtDecl new_name new_ty)
645 doc = text "In the definition of data constructor" <+> quotes (ppr name)
647 rnConDetails doc (PrefixCon tys)
648 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
649 returnM (PrefixCon new_tys)
651 rnConDetails doc (InfixCon ty1 ty2)
652 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
653 rnLHsType doc ty2 `thenM` \ new_ty2 ->
654 returnM (InfixCon new_ty1 new_ty2)
656 rnConDetails doc (RecCon fields)
657 = checkDupNames doc field_names `thenM_`
658 mappM (rnField doc) fields `thenM` \ new_fields ->
659 returnM (RecCon new_fields)
661 field_names = [fld | (fld, _) <- fields]
663 rnField doc (name, ty)
664 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
665 rnLHsType doc ty `thenM` \ new_ty ->
666 returnM (new_name, new_ty)
668 -- This data decl will parse OK
670 -- treating "a" as the constructor.
671 -- It is really hard to make the parser spot this malformation.
672 -- So the renamer has to check that the constructor is legal
674 -- We can get an operator as the constructor, even in the prefix form:
675 -- data T = :% Int Int
676 -- from interface files, which always print in prefix form
678 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
681 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
683 emptyConDeclsErr tycon
684 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
685 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
689 %*********************************************************
691 \subsection{Support code to rename types}
693 %*********************************************************
696 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
699 = mappM (wrapLocM rn_fds) fds
702 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
703 rnHsTyVars doc tys2 `thenM` \ tys2' ->
704 returnM (tys1', tys2')
706 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
707 rnHsTyvar doc tyvar = lookupOccRn tyvar
711 %*********************************************************
715 %*********************************************************
718 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
719 rnSplice (HsSplice n expr)
720 = checkTH expr "splice" `thenM_`
721 getSrcSpanM `thenM` \ loc ->
722 newLocalsRn [L loc n] `thenM` \ [n'] ->
723 rnLExpr expr `thenM` \ (expr', fvs) ->
724 returnM (HsSplice n' expr', fvs)