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 mb_bad = validRuleLhs ids lhs'
341 checkErr (isNothing mb_bad)
342 (badRuleLhsErr rule_name lhs' mb_bad) `thenM_`
344 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
346 mappM (addErr . badRuleVar rule_name) bad_vars `thenM_`
347 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
348 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
350 doc = text "In the transformation rule" <+> ftext rule_name
352 get_var (RuleBndr v) = v
353 get_var (RuleBndrSig v _) = v
355 rn_var (RuleBndr (L loc v), id)
356 = returnM (RuleBndr (L loc id), emptyFVs)
357 rn_var (RuleBndrSig (L loc v) t, id)
358 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
359 returnM (RuleBndrSig (L loc id) t', fvs)
362 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
363 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
364 ptext SLIT("does not appear on left hand side")]
367 Note [Rule LHS validity checking]
368 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
369 Check the shape of a transformation rule LHS. Currently we only allow
370 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
371 @forall@'d variables.
373 We used restrict the form of the 'ei' to prevent you writing rules
374 with LHSs with a complicated desugaring (and hence unlikely to match);
375 (e.g. a case expression is not allowed: too elaborate.)
377 But there are legitimate non-trivial args ei, like sections and
378 lambdas. So it seems simmpler not to check at all, and that is why
379 check_e is commented out.
382 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
384 -- Just e => Not ok, and e is the offending expression
385 validRuleLhs foralls lhs
388 checkl (L loc e) = check e
390 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
391 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
392 check (HsVar v) | v `notElem` foralls = Nothing
393 check other = Just other -- Failure
396 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
398 {- Commented out; see Note [Rule LHS validity checking] above
399 check_e (HsVar v) = Nothing
400 check_e (HsPar e) = checkl_e e
401 check_e (HsLit e) = Nothing
402 check_e (HsOverLit e) = Nothing
404 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
405 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
406 check_e (NegApp e _) = checkl_e e
407 check_e (ExplicitList _ es) = checkl_es es
408 check_e (ExplicitTuple es _) = checkl_es es
409 check_e other = Just other -- Fails
411 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
414 badRuleLhsErr name lhs (Just bad_e)
415 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
416 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
417 ptext SLIT("in left-hand side:") <+> ppr lhs])]
419 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
423 %*********************************************************
425 \subsection{Type, class and iface sig declarations}
427 %*********************************************************
429 @rnTyDecl@ uses the `global name function' to create a new type
430 declaration in which local names have been replaced by their original
431 names, reporting any unknown names.
433 Renaming type variables is a pain. Because they now contain uniques,
434 it is necessary to pass in an association list which maps a parsed
435 tyvar to its @Name@ representation.
436 In some cases (type signatures of values),
437 it is even necessary to go over the type first
438 in order to get the set of tyvars used by it, make an assoc list,
439 and then go over it again to rename the tyvars!
440 However, we can also do some scoping checks at the same time.
443 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
444 = lookupLocatedTopBndrRn name `thenM` \ name' ->
445 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
448 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
449 tcdTyVars = tyvars, tcdCons = condecls,
450 tcdKindSig = sig, tcdDerivs = derivs})
451 | is_vanilla -- Normal Haskell data type decl
452 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
453 -- data type is syntactically illegal
454 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
455 do { tycon' <- lookupLocatedTopBndrRn tycon
456 ; context' <- rnContext data_doc context
457 ; (derivs', deriv_fvs) <- rn_derivs derivs
458 ; checkDupNames data_doc con_names
459 ; condecls' <- rnConDecls (unLoc tycon') condecls
460 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
461 tcdTyVars = tyvars', tcdKindSig = Nothing, tcdCons = condecls',
462 tcdDerivs = derivs'},
463 delFVs (map hsLTyVarName tyvars') $
464 extractHsCtxtTyNames context' `plusFV`
465 plusFVs (map conDeclFVs condecls') `plusFV`
469 = do { tycon' <- lookupLocatedTopBndrRn tycon
470 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
471 ; tyvars' <- bindTyVarsRn data_doc tyvars
472 (\ tyvars' -> return tyvars')
473 -- For GADTs, the type variables in the declaration
474 -- do not scope over the constructor signatures
475 -- data T a where { T1 :: forall b. b-> b }
476 ; (derivs', deriv_fvs) <- rn_derivs derivs
477 ; checkDupNames data_doc con_names
478 ; condecls' <- rnConDecls (unLoc tycon') condecls
479 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
480 tcdTyVars = tyvars', tcdCons = condecls', tcdKindSig = sig,
481 tcdDerivs = derivs'},
482 plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
485 is_vanilla = case condecls of -- Yuk
487 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
490 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
491 con_names = map con_names_helper condecls
493 con_names_helper (L _ c) = con_name c
495 rn_derivs Nothing = returnM (Nothing, emptyFVs)
496 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
497 returnM (Just ds', extractHsTyNames_s ds')
499 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
500 = lookupLocatedTopBndrRn name `thenM` \ name' ->
501 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
502 rnHsTypeFVs syn_doc ty `thenM` \ (ty', fvs) ->
503 returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
505 delFVs (map hsLTyVarName tyvars') fvs)
507 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
509 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
510 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
512 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
514 -- Tyvars scope over superclass context and method signatures
515 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
516 rnContext cls_doc context `thenM` \ context' ->
517 rnFds cls_doc fds `thenM` \ fds' ->
518 renameSigs okClsDclSig sigs `thenM` \ sigs' ->
519 returnM (tyvars', context', fds', sigs')
520 ) `thenM` \ (tyvars', context', fds', sigs') ->
522 -- Check the signatures
523 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
525 sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
527 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
528 -- Typechecker is responsible for checking that we only
529 -- give default-method bindings for things in this class.
530 -- The renamer *could* check this for class decls, but can't
531 -- for instance decls.
533 -- The newLocals call is tiresome: given a generic class decl
536 -- op {| x+y |} (Inl a) = ...
537 -- op {| x+y |} (Inr b) = ...
538 -- op {| a*b |} (a*b) = ...
539 -- we want to name both "x" tyvars with the same unique, so that they are
540 -- easy to group together in the typechecker.
541 extendTyVarEnvForMethodBinds tyvars' (
542 getLocalRdrEnv `thenM` \ name_env ->
544 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
545 gen_rdr_tyvars_w_locs =
546 [ tv | tv <- extractGenericPatTyVars mbinds,
547 not (unLoc tv `elemLocalRdrEnv` name_env) ]
549 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
550 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
551 rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
552 ) `thenM` \ (mbinds', meth_fvs) ->
554 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
555 tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
556 delFVs (map hsLTyVarName tyvars') $
557 extractHsCtxtTyNames context' `plusFV`
558 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
559 hsSigsFVs sigs' `plusFV`
562 meth_doc = text "In the default-methods for class" <+> ppr cname
563 cls_doc = text "In the declaration for class" <+> ppr cname
564 sig_doc = text "In the signatures for class" <+> ppr cname
566 badGadtStupidTheta tycon
567 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
568 ptext SLIT("(You can put a context on each contructor, though.)")]
571 %*********************************************************
573 \subsection{Support code for type/data declarations}
575 %*********************************************************
578 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
579 rnConDecls tycon condecls
580 = mappM (wrapLocM rnConDecl) condecls
582 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
583 rnConDecl (ConDecl name expl tvs cxt details res_ty)
584 = do { addLocM checkConName name
586 ; new_name <- lookupLocatedTopBndrRn name
587 ; name_env <- getLocalRdrEnv
589 -- For H98 syntax, the tvs are the existential ones
590 -- For GADT syntax, the tvs are all the quantified tyvars
591 -- Hence the 'filter' in the ResTyH98 case only
592 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
593 arg_tys = hsConArgs details
594 implicit_tvs = case res_ty of
595 ResTyH98 -> filter not_in_scope $
597 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
600 Implicit -> userHsTyVarBndrs implicit_tvs
602 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
603 { new_context <- rnContext doc cxt
604 ; new_details <- rnConDetails doc details
605 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
606 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty) }}
608 doc = text "In the definition of data constructor" <+> quotes (ppr name)
609 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
611 rnConResult _ details ResTyH98 = return (details, ResTyH98)
613 rnConResult doc details (ResTyGADT ty) = do
614 ty' <- rnHsSigType doc ty
615 let (arg_tys, res_ty) = splitHsFunType ty'
616 -- We can split it up, now the renamer has dealt with fixities
618 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
619 RecCon fields -> return (details, ResTyGADT ty')
620 InfixCon {} -> panic "rnConResult"
622 rnConDetails doc (PrefixCon tys)
623 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
624 returnM (PrefixCon new_tys)
626 rnConDetails doc (InfixCon ty1 ty2)
627 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
628 rnLHsType doc ty2 `thenM` \ new_ty2 ->
629 returnM (InfixCon new_ty1 new_ty2)
631 rnConDetails doc (RecCon fields)
632 = checkDupNames doc field_names `thenM_`
633 mappM (rnField doc) fields `thenM` \ new_fields ->
634 returnM (RecCon new_fields)
636 field_names = [fld | (fld, _) <- fields]
638 rnField doc (name, ty)
639 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
640 rnLHsType doc ty `thenM` \ new_ty ->
641 returnM (new_name, new_ty)
643 -- This data decl will parse OK
645 -- treating "a" as the constructor.
646 -- It is really hard to make the parser spot this malformation.
647 -- So the renamer has to check that the constructor is legal
649 -- We can get an operator as the constructor, even in the prefix form:
650 -- data T = :% Int Int
651 -- from interface files, which always print in prefix form
653 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
656 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
660 %*********************************************************
662 \subsection{Support code to rename types}
664 %*********************************************************
667 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
670 = mappM (wrapLocM rn_fds) fds
673 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
674 rnHsTyVars doc tys2 `thenM` \ tys2' ->
675 returnM (tys1', tys2')
677 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
678 rnHsTyvar doc tyvar = lookupOccRn tyvar
682 %*********************************************************
686 %*********************************************************
692 h = ...$(thing "f")...
694 The splice can expand into literally anything, so when we do dependency
695 analysis we must assume that it might mention 'f'. So we simply treat
696 all locally-defined names as mentioned by any splice. This is terribly
697 brutal, but I don't see what else to do. For example, it'll mean
698 that every locally-defined thing will appear to be used, so no unused-binding
699 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
700 and that will crash the type checker because 'f' isn't in scope.
702 Currently, I'm not treating a splice as also mentioning every import,
703 which is a bit inconsistent -- but there are a lot of them. We might
704 thereby get some bogus unused-import warnings, but we won't crash the
705 type checker. Not very satisfactory really.
708 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
709 rnSplice (HsSplice n expr)
710 = do { checkTH expr "splice"
712 ; [n'] <- newLocalsRn [L loc n]
713 ; (expr', fvs) <- rnLExpr expr
715 -- Ugh! See Note [Splices] above
716 ; lcl_rdr <- getLocalRdrEnv
717 ; gbl_rdr <- getGlobalRdrEnv
718 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
720 lcl_names = mkNameSet (occEnvElts lcl_rdr)
722 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
725 checkTH e what = returnM () -- OK
727 checkTH e what -- Raise an error in a stage-1 compiler
728 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
729 ptext SLIT("illegal in a stage-1 compiler"),