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 )
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 = lookupLocatedTopBndrRn tycon `thenM` \ tycon' ->
492 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
493 rnContext data_doc context `thenM` \ context' ->
494 rn_derivs derivs `thenM` \ (derivs', deriv_fvs) ->
495 checkDupNames data_doc con_names `thenM_`
496 rnConDecls (unLoc tycon') condecls `thenM` \ condecls' ->
497 returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
498 tcdTyVars = tyvars', tcdCons = condecls',
499 tcdDerivs = derivs'},
500 delFVs (map hsLTyVarName tyvars') $
501 extractHsCtxtTyNames context' `plusFV`
502 plusFVs (map conDeclFVs condecls') `plusFV`
505 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
506 con_names = [ n | L _ (ConDecl n _ _ _) <- condecls ]
508 rn_derivs Nothing = returnM (Nothing, emptyFVs)
509 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
510 returnM (Just ds', extractHsTyNames_s ds')
512 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
513 = lookupLocatedTopBndrRn name `thenM` \ name' ->
514 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
515 rnHsTypeFVs syn_doc ty `thenM` \ (ty', fvs) ->
516 returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
518 delFVs (map hsLTyVarName tyvars') fvs)
520 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
522 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
523 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
525 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
527 -- Tyvars scope over superclass context and method signatures
528 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
529 rnContext cls_doc context `thenM` \ context' ->
530 rnFds cls_doc fds `thenM` \ fds' ->
531 renameSigs sigs `thenM` \ sigs' ->
532 returnM (tyvars', context', fds', sigs')
533 ) `thenM` \ (tyvars', context', fds', sigs') ->
535 -- Check the signatures
536 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
538 sig_rdr_names_w_locs = [op | L _ (Sig op _) <- sigs]
540 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
541 checkSigs okClsDclSig sigs' `thenM_`
542 -- Typechecker is responsible for checking that we only
543 -- give default-method bindings for things in this class.
544 -- The renamer *could* check this for class decls, but can't
545 -- for instance decls.
547 -- The newLocals call is tiresome: given a generic class decl
550 -- op {| x+y |} (Inl a) = ...
551 -- op {| x+y |} (Inr b) = ...
552 -- op {| a*b |} (a*b) = ...
553 -- we want to name both "x" tyvars with the same unique, so that they are
554 -- easy to group together in the typechecker.
555 extendTyVarEnvForMethodBinds tyvars' (
556 getLocalRdrEnv `thenM` \ name_env ->
558 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
559 gen_rdr_tyvars_w_locs =
560 [ tv | tv <- extractGenericPatTyVars mbinds,
561 not (unLoc tv `elemLocalRdrEnv` name_env) ]
563 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
564 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
565 rnMethodBinds (unLoc cname') gen_tyvars mbinds
566 ) `thenM` \ (mbinds', meth_fvs) ->
568 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
569 tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
570 delFVs (map hsLTyVarName tyvars') $
571 extractHsCtxtTyNames context' `plusFV`
572 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
573 hsSigsFVs sigs' `plusFV`
576 meth_doc = text "In the default-methods for class" <+> ppr cname
577 cls_doc = text "In the declaration for class" <+> ppr cname
578 sig_doc = text "In the signatures for class" <+> ppr cname
581 %*********************************************************
583 \subsection{Support code for type/data declarations}
585 %*********************************************************
588 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
589 rnConDecls tycon condecls
590 = -- Check that there's at least one condecl,
591 -- or else we're reading an interface file, or -fglasgow-exts
592 (if null condecls then
593 doptM Opt_GlasgowExts `thenM` \ glaExts ->
594 checkErr glaExts (emptyConDeclsErr tycon)
597 mappM (wrapLocM rnConDecl) condecls
599 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
600 rnConDecl (ConDecl name tvs cxt details)
601 = addLocM checkConName name `thenM_`
602 lookupLocatedTopBndrRn name `thenM` \ new_name ->
604 bindTyVarsRn doc tvs $ \ new_tyvars ->
605 rnContext doc cxt `thenM` \ new_context ->
606 rnConDetails doc details `thenM` \ new_details ->
607 returnM (ConDecl new_name new_tyvars new_context new_details)
609 doc = text "In the definition of data constructor" <+> quotes (ppr name)
611 rnConDetails doc (PrefixCon tys)
612 = mappM (rnLBangTy doc) tys `thenM` \ new_tys ->
613 returnM (PrefixCon new_tys)
615 rnConDetails doc (InfixCon ty1 ty2)
616 = rnLBangTy doc ty1 `thenM` \ new_ty1 ->
617 rnLBangTy doc ty2 `thenM` \ new_ty2 ->
618 returnM (InfixCon new_ty1 new_ty2)
620 rnConDetails doc (RecCon fields)
621 = checkDupNames doc field_names `thenM_`
622 mappM (rnField doc) fields `thenM` \ new_fields ->
623 returnM (RecCon new_fields)
625 field_names = [fld | (fld, _) <- fields]
627 rnField doc (name, ty)
628 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
629 rnLBangTy doc ty `thenM` \ new_ty ->
630 returnM (new_name, new_ty)
632 rnLBangTy doc = wrapLocM (rnBangTy doc)
634 rnBangTy doc (BangType s ty)
635 = rnLHsType doc ty `thenM` \ new_ty ->
636 returnM (BangType s new_ty)
638 -- This data decl will parse OK
640 -- treating "a" as the constructor.
641 -- It is really hard to make the parser spot this malformation.
642 -- So the renamer has to check that the constructor is legal
644 -- We can get an operator as the constructor, even in the prefix form:
645 -- data T = :% Int Int
646 -- from interface files, which always print in prefix form
648 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
651 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
653 emptyConDeclsErr tycon
654 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
655 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
659 %*********************************************************
661 \subsection{Support code to rename types}
663 %*********************************************************
666 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
669 = mappM (wrapLocM rn_fds) fds
672 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
673 rnHsTyVars doc tys2 `thenM` \ tys2' ->
674 returnM (tys1', tys2')
676 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
677 rnHsTyvar doc tyvar = lookupOccRn tyvar
681 %*********************************************************
685 %*********************************************************
688 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
689 rnSplice (HsSplice n expr)
690 = checkTH expr "splice" `thenM_`
691 getSrcSpanM `thenM` \ loc ->
692 newLocalsRn [L loc n] `thenM` \ [n'] ->
693 rnLExpr expr `thenM` \ (expr', fvs) ->
694 returnM (HsSplice n' expr', fvs)