2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
9 rnTyClDecls, checkModDeprec,
13 #include "HsVersions.h"
15 import {-# SOURCE #-} RnExpr( rnLExpr )
18 import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv, globalRdrEnvElts,
19 GlobalRdrElt(..), isLocalGRE )
20 import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
22 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
23 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, mkSigTvFn )
24 import RnEnv ( lookupLocalDataTcNames,
25 lookupLocatedTopBndrRn, lookupLocatedOccRn,
26 lookupOccRn, newLocalsRn,
27 bindLocatedLocalsFV, bindPatSigTyVarsFV,
28 bindTyVarsRn, extendTyVarEnvFVRn,
29 bindLocalNames, checkDupNames, mapFvRn
33 import HscTypes ( FixityEnv, FixItem(..),
34 Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
35 import Class ( FunDep )
36 import Name ( Name, nameOccName )
39 import OccName ( occEnvElts )
41 import SrcLoc ( Located(..), unLoc, noLoc )
42 import DynFlags ( DynFlag(..) )
43 import Maybes ( seqMaybe )
44 import Maybe ( isNothing )
45 import BasicTypes ( Boxity(..) )
48 @rnSourceDecl@ `renames' declarations.
49 It simultaneously performs dependency analysis and precedence parsing.
50 It also does the following error checks:
53 Checks that tyvars are used properly. This includes checking
54 for undefined tyvars, and tyvars in contexts that are ambiguous.
55 (Some of this checking has now been moved to module @TcMonoType@,
56 since we don't have functional dependency information at this point.)
58 Checks that all variable occurences are defined.
60 Checks the @(..)@ etc constraints in the export list.
65 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
67 rnSrcDecls (HsGroup { hs_valds = val_decls,
68 hs_tyclds = tycl_decls,
69 hs_instds = inst_decls,
71 hs_depds = deprec_decls,
72 hs_fords = foreign_decls,
73 hs_defds = default_decls,
74 hs_ruleds = rule_decls })
76 = do { -- Deal with deprecations (returns only the extra deprecations)
77 deprecs <- rnSrcDeprecDecls deprec_decls ;
78 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
81 -- Deal with top-level fixity decls
82 -- (returns the total new fixity env)
83 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
84 fix_env <- rnSrcFixityDeclsEnv rn_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 val_decls ;
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,
115 hs_fixds = rn_fix_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 [LFixitySig Name]
154 rnSrcFixityDecls fix_decls
155 = do fix_decls <- mapM rnFixityDecl fix_decls
156 return (concat fix_decls)
158 rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
159 rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
160 = setSrcSpan nameLoc $
161 -- GHC extension: look up both the tycon and data con
162 -- for con-like things
163 -- If neither are in scope, report an error; otherwise
164 -- add both to the fixity env
165 do names <- lookupLocalDataTcNames rdr_name
166 return [ L loc (FixitySig (L nameLoc name) fixity)
169 rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
170 rnSrcFixityDeclsEnv fix_decls
171 = getGblEnv `thenM` \ gbl_env ->
172 foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
173 fix_decls `thenM` \ fix_env ->
174 traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
177 rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
178 rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
179 = case lookupNameEnv fix_env name of
180 Just (FixItem _ _ loc')
181 -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
184 -> return (extendNameEnv fix_env name fix_item)
185 where fix_item = FixItem (nameOccName name) fixity nameLoc
187 pprFixEnv :: FixityEnv -> SDoc
189 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
192 dupFixityDecl loc rdr_name
193 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
194 ptext SLIT("also at ") <+> ppr loc
199 %*********************************************************
201 Source-code deprecations declarations
203 %*********************************************************
205 For deprecations, all we do is check that the names are in scope.
206 It's only imported deprecations, dealt with in RnIfaces, that we
207 gather them together.
210 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
214 rnSrcDeprecDecls decls
215 = mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
216 returnM (DeprecSome (mkNameEnv (concat pairs_s)))
218 rn_deprec (Deprecation rdr_name txt)
219 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
220 returnM [(name, (nameOccName name, txt)) | name <- names]
222 checkModDeprec :: Maybe DeprecTxt -> Deprecations
223 -- Check for a module deprecation; done once at top level
224 checkModDeprec Nothing = NoDeprecs
225 checkModDeprec (Just txt) = DeprecAll txt
228 %*********************************************************
230 \subsection{Source code declarations}
232 %*********************************************************
235 rnDefaultDecl (DefaultDecl tys)
236 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
237 returnM (DefaultDecl tys', fvs)
239 doc_str = text "In a `default' declaration"
242 %*********************************************************
244 \subsection{Foreign declarations}
246 %*********************************************************
249 rnHsForeignDecl (ForeignImport name ty spec)
250 = lookupLocatedTopBndrRn name `thenM` \ name' ->
251 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
252 returnM (ForeignImport name' ty' spec, fvs)
254 rnHsForeignDecl (ForeignExport name ty spec)
255 = lookupLocatedOccRn name `thenM` \ name' ->
256 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
257 returnM (ForeignExport name' ty' spec, fvs )
258 -- NB: a foreign export is an *occurrence site* for name, so
259 -- we add it to the free-variable list. It might, for example,
260 -- be imported from another module
262 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
266 %*********************************************************
268 \subsection{Instance declarations}
270 %*********************************************************
273 rnSrcInstDecl (InstDecl inst_ty mbinds uprags)
274 -- Used for both source and interface file decls
275 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
277 -- Rename the bindings
278 -- The typechecker (not the renamer) checks that all
279 -- the bindings are for the right class
281 meth_doc = text "In the bindings in an instance declaration"
282 meth_names = collectHsBindLocatedBinders mbinds
283 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
285 checkDupNames meth_doc meth_names `thenM_`
286 extendTyVarEnvForMethodBinds inst_tyvars (
287 -- (Slightly strangely) the forall-d tyvars scope over
288 -- the method bindings too
289 rnMethodBinds cls (\n->[]) -- No scoped tyvars
291 ) `thenM` \ (mbinds', meth_fvs) ->
292 -- Rename the prags and signatures.
293 -- Note that the type variables are not in scope here,
294 -- so that instance Eq a => Eq (T a) where
295 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
298 -- But the (unqualified) method names are in scope
300 binders = collectHsBindBinders mbinds'
301 ok_sig = okInstDclSig (mkNameSet binders)
303 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
305 returnM (InstDecl inst_ty' mbinds' uprags',
306 meth_fvs `plusFV` hsSigsFVs uprags'
307 `plusFV` extractHsTyNames inst_ty')
310 For the method bindings in class and instance decls, we extend the
311 type variable environment iff -fglasgow-exts
314 extendTyVarEnvForMethodBinds tyvars thing_inside
315 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
316 if opt_GlasgowExts then
317 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
323 %*********************************************************
327 %*********************************************************
330 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
331 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
333 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
334 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
336 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
337 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
339 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
341 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
342 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
344 doc = text "In the transformation rule" <+> ftext rule_name
346 get_var (RuleBndr v) = v
347 get_var (RuleBndrSig v _) = v
349 rn_var (RuleBndr (L loc v), id)
350 = returnM (RuleBndr (L loc id), emptyFVs)
351 rn_var (RuleBndrSig (L loc v) t, id)
352 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
353 returnM (RuleBndrSig (L loc id) t', fvs)
356 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
357 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
358 ptext SLIT("does not appear on left hand side")]
361 Note [Rule LHS validity checking]
362 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
363 Check the shape of a transformation rule LHS. Currently we only allow
364 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
365 @forall@'d variables.
367 We used restrict the form of the 'ei' to prevent you writing rules
368 with LHSs with a complicated desugaring (and hence unlikely to match);
369 (e.g. a case expression is not allowed: too elaborate.)
371 But there are legitimate non-trivial args ei, like sections and
372 lambdas. So it seems simmpler not to check at all, and that is why
373 check_e is commented out.
376 checkValidRule rule_name ids lhs' fv_lhs'
377 = do { -- Check for the form of the LHS
378 case (validRuleLhs ids lhs') of
380 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
382 -- Check that LHS vars are all bound
383 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
384 ; mappM (addErr . badRuleVar rule_name) bad_vars }
386 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
388 -- Just e => Not ok, and e is the offending expression
389 validRuleLhs foralls lhs
392 checkl (L loc e) = check e
394 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
395 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
396 check (HsVar v) | v `notElem` foralls = Nothing
397 check other = Just other -- Failure
400 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
402 {- Commented out; see Note [Rule LHS validity checking] above
403 check_e (HsVar v) = Nothing
404 check_e (HsPar e) = checkl_e e
405 check_e (HsLit e) = Nothing
406 check_e (HsOverLit e) = Nothing
408 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
409 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
410 check_e (NegApp e _) = checkl_e e
411 check_e (ExplicitList _ es) = checkl_es es
412 check_e (ExplicitTuple es _) = checkl_es es
413 check_e other = Just other -- Fails
415 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
418 badRuleLhsErr name lhs bad_e
419 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
420 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
421 ptext SLIT("in left-hand side:") <+> ppr lhs])]
423 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
427 %*********************************************************
429 \subsection{Type, class and iface sig declarations}
431 %*********************************************************
433 @rnTyDecl@ uses the `global name function' to create a new type
434 declaration in which local names have been replaced by their original
435 names, reporting any unknown names.
437 Renaming type variables is a pain. Because they now contain uniques,
438 it is necessary to pass in an association list which maps a parsed
439 tyvar to its @Name@ representation.
440 In some cases (type signatures of values),
441 it is even necessary to go over the type first
442 in order to get the set of tyvars used by it, make an assoc list,
443 and then go over it again to rename the tyvars!
444 However, we can also do some scoping checks at the same time.
447 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
448 = lookupLocatedTopBndrRn name `thenM` \ name' ->
449 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
452 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
453 tcdTyVars = tyvars, tcdCons = condecls,
454 tcdKindSig = sig, tcdDerivs = derivs})
455 | is_vanilla -- Normal Haskell data type decl
456 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
457 -- data type is syntactically illegal
458 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
459 do { tycon' <- lookupLocatedTopBndrRn tycon
460 ; context' <- rnContext data_doc context
461 ; (derivs', deriv_fvs) <- rn_derivs derivs
462 ; checkDupNames data_doc con_names
463 ; condecls' <- rnConDecls (unLoc tycon') condecls
464 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
465 tcdTyVars = tyvars', tcdKindSig = Nothing, tcdCons = condecls',
466 tcdDerivs = derivs'},
467 delFVs (map hsLTyVarName tyvars') $
468 extractHsCtxtTyNames context' `plusFV`
469 plusFVs (map conDeclFVs condecls') `plusFV`
473 = do { tycon' <- lookupLocatedTopBndrRn tycon
474 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
475 ; tyvars' <- bindTyVarsRn data_doc tyvars
476 (\ tyvars' -> return tyvars')
477 -- For GADTs, the type variables in the declaration
478 -- do not scope over the constructor signatures
479 -- data T a where { T1 :: forall b. b-> b }
480 ; (derivs', deriv_fvs) <- rn_derivs derivs
481 ; checkDupNames data_doc con_names
482 ; condecls' <- rnConDecls (unLoc tycon') condecls
483 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
484 tcdTyVars = tyvars', tcdCons = condecls', tcdKindSig = sig,
485 tcdDerivs = derivs'},
486 plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
489 is_vanilla = case condecls of -- Yuk
491 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
494 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
495 con_names = map con_names_helper condecls
497 con_names_helper (L _ c) = con_name c
499 rn_derivs Nothing = returnM (Nothing, emptyFVs)
500 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
501 returnM (Just ds', extractHsTyNames_s ds')
503 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
504 = lookupLocatedTopBndrRn name `thenM` \ name' ->
505 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
506 rnHsTypeFVs syn_doc ty `thenM` \ (ty', fvs) ->
507 returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
509 delFVs (map hsLTyVarName tyvars') fvs)
511 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
513 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
514 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
516 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
518 -- Tyvars scope over superclass context and method signatures
519 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
520 rnContext cls_doc context `thenM` \ context' ->
521 rnFds cls_doc fds `thenM` \ fds' ->
522 renameSigs okClsDclSig sigs `thenM` \ sigs' ->
523 returnM (tyvars', context', fds', sigs')
524 ) `thenM` \ (tyvars', context', fds', sigs') ->
526 -- Check the signatures
527 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
529 sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
531 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
532 -- Typechecker is responsible for checking that we only
533 -- give default-method bindings for things in this class.
534 -- The renamer *could* check this for class decls, but can't
535 -- for instance decls.
537 -- The newLocals call is tiresome: given a generic class decl
540 -- op {| x+y |} (Inl a) = ...
541 -- op {| x+y |} (Inr b) = ...
542 -- op {| a*b |} (a*b) = ...
543 -- we want to name both "x" tyvars with the same unique, so that they are
544 -- easy to group together in the typechecker.
545 extendTyVarEnvForMethodBinds tyvars' (
546 getLocalRdrEnv `thenM` \ name_env ->
548 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
549 gen_rdr_tyvars_w_locs =
550 [ tv | tv <- extractGenericPatTyVars mbinds,
551 not (unLoc tv `elemLocalRdrEnv` name_env) ]
553 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
554 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
555 rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
556 ) `thenM` \ (mbinds', meth_fvs) ->
558 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
559 tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
560 delFVs (map hsLTyVarName tyvars') $
561 extractHsCtxtTyNames context' `plusFV`
562 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
563 hsSigsFVs sigs' `plusFV`
566 meth_doc = text "In the default-methods for class" <+> ppr cname
567 cls_doc = text "In the declaration for class" <+> ppr cname
568 sig_doc = text "In the signatures for class" <+> ppr cname
570 badGadtStupidTheta tycon
571 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
572 ptext SLIT("(You can put a context on each contructor, though.)")]
575 %*********************************************************
577 \subsection{Support code for type/data declarations}
579 %*********************************************************
582 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
583 rnConDecls tycon condecls
584 = mappM (wrapLocM rnConDecl) condecls
586 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
587 rnConDecl (ConDecl name expl tvs cxt details res_ty)
588 = do { addLocM checkConName name
590 ; new_name <- lookupLocatedTopBndrRn name
591 ; name_env <- getLocalRdrEnv
593 -- For H98 syntax, the tvs are the existential ones
594 -- For GADT syntax, the tvs are all the quantified tyvars
595 -- Hence the 'filter' in the ResTyH98 case only
596 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
597 arg_tys = hsConArgs details
598 implicit_tvs = case res_ty of
599 ResTyH98 -> filter not_in_scope $
601 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
604 Implicit -> userHsTyVarBndrs implicit_tvs
606 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
607 { new_context <- rnContext doc cxt
608 ; new_details <- rnConDetails doc details
609 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
610 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty) }}
612 doc = text "In the definition of data constructor" <+> quotes (ppr name)
613 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
615 rnConResult _ details ResTyH98 = return (details, ResTyH98)
617 rnConResult doc details (ResTyGADT ty) = do
618 ty' <- rnHsSigType doc ty
619 let (arg_tys, res_ty) = splitHsFunType ty'
620 -- We can split it up, now the renamer has dealt with fixities
622 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
623 RecCon fields -> return (details, ResTyGADT ty')
624 InfixCon {} -> panic "rnConResult"
626 rnConDetails doc (PrefixCon tys)
627 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
628 returnM (PrefixCon new_tys)
630 rnConDetails doc (InfixCon ty1 ty2)
631 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
632 rnLHsType doc ty2 `thenM` \ new_ty2 ->
633 returnM (InfixCon new_ty1 new_ty2)
635 rnConDetails doc (RecCon fields)
636 = checkDupNames doc field_names `thenM_`
637 mappM (rnField doc) fields `thenM` \ new_fields ->
638 returnM (RecCon new_fields)
640 field_names = [fld | (fld, _) <- fields]
642 rnField doc (name, ty)
643 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
644 rnLHsType doc ty `thenM` \ new_ty ->
645 returnM (new_name, new_ty)
647 -- This data decl will parse OK
649 -- treating "a" as the constructor.
650 -- It is really hard to make the parser spot this malformation.
651 -- So the renamer has to check that the constructor is legal
653 -- We can get an operator as the constructor, even in the prefix form:
654 -- data T = :% Int Int
655 -- from interface files, which always print in prefix form
657 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
660 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
664 %*********************************************************
666 \subsection{Support code to rename types}
668 %*********************************************************
671 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
674 = mappM (wrapLocM rn_fds) fds
677 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
678 rnHsTyVars doc tys2 `thenM` \ tys2' ->
679 returnM (tys1', tys2')
681 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
682 rnHsTyvar doc tyvar = lookupOccRn tyvar
686 %*********************************************************
690 %*********************************************************
696 h = ...$(thing "f")...
698 The splice can expand into literally anything, so when we do dependency
699 analysis we must assume that it might mention 'f'. So we simply treat
700 all locally-defined names as mentioned by any splice. This is terribly
701 brutal, but I don't see what else to do. For example, it'll mean
702 that every locally-defined thing will appear to be used, so no unused-binding
703 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
704 and that will crash the type checker because 'f' isn't in scope.
706 Currently, I'm not treating a splice as also mentioning every import,
707 which is a bit inconsistent -- but there are a lot of them. We might
708 thereby get some bogus unused-import warnings, but we won't crash the
709 type checker. Not very satisfactory really.
712 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
713 rnSplice (HsSplice n expr)
714 = do { checkTH expr "splice"
716 ; [n'] <- newLocalsRn [L loc n]
717 ; (expr', fvs) <- rnLExpr expr
719 -- Ugh! See Note [Splices] above
720 ; lcl_rdr <- getLocalRdrEnv
721 ; gbl_rdr <- getGlobalRdrEnv
722 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
724 lcl_names = mkNameSet (occEnvElts lcl_rdr)
726 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
729 checkTH e what = returnM () -- OK
731 checkTH e what -- Raise an error in a stage-1 compiler
732 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
733 ptext SLIT("illegal in a stage-1 compiler"),