2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and fix
10 -- any warnings in the module. See
11 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
15 rnSrcDecls, addTcgDUs,
20 #include "HsVersions.h"
22 import {-# SOURCE #-} RnExpr( rnLExpr )
25 import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv,
26 globalRdrEnvElts, GlobalRdrElt(..), isLocalGRE, rdrNameOcc )
27 import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
29 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
30 import RnBinds ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
32 import RnEnv ( lookupLocalDataTcNames,
33 lookupLocatedTopBndrRn, lookupLocatedOccRn,
34 lookupOccRn, newLocalsRn,
35 bindLocatedLocalsFV, bindPatSigTyVarsFV,
36 bindTyVarsRn, extendTyVarEnvFVRn,
37 bindLocalNames, checkDupRdrNames, mapFvRn, lookupGreLocalRn,
39 import RnNames (importsFromLocalDecls, extendRdrEnvRn)
40 import HscTypes (GenAvailInfo(..))
41 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
44 import HscTypes ( FixityEnv, FixItem(..), Deprecations(..), plusDeprecs )
45 import Class ( FunDep )
46 import Name ( Name, nameOccName )
52 import SrcLoc ( Located(..), unLoc, noLoc )
53 import DynFlags ( DynFlag(..) )
54 import Maybe ( isNothing )
55 import BasicTypes ( Boxity(..) )
57 import ListSetOps (findDupsEq, mkLookupFun)
64 thenM :: Monad a => a b -> (b -> a c) -> a c
67 thenM_ :: Monad a => a b -> a c -> a c
70 returnM :: Monad m => a -> m a
73 mappM :: (Monad m) => (a -> m b) -> [a] -> m [b]
76 mappM_ :: (Monad m) => (a -> m b) -> [a] -> m ()
79 checkM :: Monad m => Bool -> m () -> m ()
83 @rnSourceDecl@ `renames' declarations.
84 It simultaneously performs dependency analysis and precedence parsing.
85 It also does the following error checks:
88 Checks that tyvars are used properly. This includes checking
89 for undefined tyvars, and tyvars in contexts that are ambiguous.
90 (Some of this checking has now been moved to module @TcMonoType@,
91 since we don't have functional dependency information at this point.)
93 Checks that all variable occurences are defined.
95 Checks the @(..)@ etc constraints in the export list.
100 -- brings the binders of the group into scope in the appropriate places;
101 -- does NOT assume that anything is in scope already
103 -- the Bool determines whether (True) names in the group shadow existing
104 -- Unquals in the global environment (used in Template Haskell) or
105 -- (False) whether duplicates are reported as an error
106 rnSrcDecls :: Bool -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
108 rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls,
109 hs_tyclds = tycl_decls,
110 hs_instds = inst_decls,
111 hs_derivds = deriv_decls,
112 hs_fixds = fix_decls,
113 hs_depds = deprec_decls,
114 hs_fords = foreign_decls,
115 hs_defds = default_decls,
116 hs_ruleds = rule_decls,
119 -- (A) Process the fixity declarations, creating a mapping from
120 -- FastStrings to FixItems.
121 -- Also checks for duplcates.
122 local_fix_env <- makeMiniFixityEnv fix_decls;
124 -- (B) Bring top level binders (and their fixities) into scope,
125 -- except for the value bindings, which get brought in below.
126 inNewEnv (importsFromLocalDecls shadowP group local_fix_env) $ \ tcg_env -> do {
128 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
130 -- (C) Extract the mapping from data constructors to field names and
131 -- extend the record field env.
132 -- This depends on the data constructors and field names being in
133 -- scope from (B) above
134 inNewEnv (extendRecordFieldEnv tycl_decls) $ \ tcg_env -> do {
136 -- (D) Rename the left-hand sides of the value bindings.
137 -- This depends on everything from (B) being in scope,
138 -- and on (C) for resolving record wild cards.
139 -- It uses the fixity env from (A) to bind fixities for view patterns.
140 new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
141 -- bind the LHSes (and their fixities) in the global rdr environment
142 let { lhs_binders = map unLoc $ collectHsValBinders new_lhs;
143 lhs_avails = map Avail lhs_binders
145 inNewEnv (extendRdrEnvRn shadowP (tcg_rdr_env tcg_env, tcg_fix_env tcg_env)
146 lhs_avails local_fix_env
147 >>= \ (new_rdr_env, new_fix_env) ->
148 return (tcg_env { tcg_rdr_env = new_rdr_env,
149 tcg_fix_env = new_fix_env
150 })) $ \tcg_env -> do {
152 -- Now everything is in scope, as the remaining renaming assumes.
154 -- (E) Rename type and class decls
155 -- (note that value LHSes need to be in scope for default methods)
157 -- You might think that we could build proper def/use information
158 -- for type and class declarations, but they can be involved
159 -- in mutual recursion across modules, and we only do the SCC
160 -- analysis for them in the type checker.
161 -- So we content ourselves with gathering uses only; that
162 -- means we'll only report a declaration as unused if it isn't
163 -- mentioned at all. Ah well.
164 traceRn (text "Start rnTyClDecls") ;
165 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
167 -- (F) Rename Value declarations right-hand sides
168 traceRn (text "Start rnmono") ;
169 (rn_val_decls, bind_dus) <- rnTopBindsRHS lhs_binders new_lhs ;
170 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
172 -- (G) Rename Fixity and deprecations
174 -- rename fixity declarations and error if we try to
175 -- fix something from another module (duplicates were checked in (A))
176 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
177 -- rename deprec decls;
178 -- check for duplicates and ensure that deprecated things are defined locally
179 -- at the moment, we don't keep these around past renaming
180 rn_deprecs <- rnSrcDeprecDecls deprec_decls ;
182 -- (H) Rename Everything else
184 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
185 (rn_rule_decls, src_fvs3) <- rnList rnHsRuleDecl rule_decls ;
186 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
187 (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ;
188 (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ;
189 -- Haddock docs; no free vars
190 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
192 -- (I) Compute the results and return
193 let {rn_group = HsGroup { hs_valds = rn_val_decls,
194 hs_tyclds = rn_tycl_decls,
195 hs_instds = rn_inst_decls,
196 hs_derivds = rn_deriv_decls,
197 hs_fixds = rn_fix_decls,
198 hs_depds = [], -- deprecs are returned in the tcg_env (see below)
199 -- not in the HsGroup
200 hs_fords = rn_foreign_decls,
201 hs_defds = rn_default_decls,
202 hs_ruleds = rn_rule_decls,
203 hs_docs = rn_docs } ;
205 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
206 src_fvs4, src_fvs5] ;
207 src_dus = bind_dus `plusDU` usesOnly other_fvs;
208 -- Note: src_dus will contain *uses* for locally-defined types
209 -- and classes, but no *defs* for them. (Because rnTyClDecl
210 -- returns only the uses.) This is a little
211 -- surprising but it doesn't actually matter at all.
213 final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
214 in -- we return the deprecs in the env, not in the HsGroup above
215 tcg_env' { tcg_deprecs = tcg_deprecs tcg_env' `plusDeprecs` rn_deprecs };
218 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
219 traceRn (text "finish Dus" <+> ppr src_dus ) ;
220 return (final_tcg_env , rn_group)
223 -- some utils because we do this a bunch above
224 -- compute and install the new env
225 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
226 inNewEnv env cont = do e <- env
229 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
230 -- Used for external core
231 rnTyClDecls tycl_decls = do (decls', fvs) <- rnList rnTyClDecl tycl_decls
234 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
235 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
237 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
238 rnList f xs = mapFvRn (wrapLocFstM f) xs
242 %*********************************************************
246 %*********************************************************
249 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
250 rnDocDecl (DocCommentNext doc) = do
251 rn_doc <- rnHsDoc doc
252 return (DocCommentNext rn_doc)
253 rnDocDecl (DocCommentPrev doc) = do
254 rn_doc <- rnHsDoc doc
255 return (DocCommentPrev rn_doc)
256 rnDocDecl (DocCommentNamed str doc) = do
257 rn_doc <- rnHsDoc doc
258 return (DocCommentNamed str rn_doc)
259 rnDocDecl (DocGroup lev doc) = do
260 rn_doc <- rnHsDoc doc
261 return (DocGroup lev rn_doc)
265 %*********************************************************
267 Source-code fixity declarations
269 %*********************************************************
272 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
273 -- Rename the fixity decls, so we can put
274 -- the renamed decls in the renamed syntax tree
275 -- Errors if the thing being fixed is not defined locally.
276 rnSrcFixityDecls fix_decls
277 = do fix_decls <- mapM rn_decl fix_decls
278 return (concat fix_decls)
280 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
281 -- GHC extension: look up both the tycon and data con
282 -- for con-like things; hence returning a list
283 -- If neither are in scope, report an error; otherwise
284 -- add both to the fixity env
285 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
286 = setSrcSpan name_loc $
287 -- this lookup will fail if the definition isn't local
288 do names <- lookupLocalDataTcNames rdr_name
289 return [ L loc (FixitySig (L name_loc name) fixity)
294 %*********************************************************
296 Source-code deprecations declarations
298 %*********************************************************
300 Check that the deprecated names are defined, are defined locally, and
301 that there are no duplicate deprecations.
303 It's only imported deprecations, dealt with in RnIfaces, that we
304 gather them together.
307 -- checks that the deprecations are defined locally, and that there are no duplicates
308 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
312 rnSrcDeprecDecls decls
313 = do { -- check for duplicates
314 ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupDeprecDecl lrdr')) deprec_rdr_dups
315 ; mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
316 returnM (DeprecSome ((concat pairs_s))) }
318 rn_deprec (Deprecation rdr_name txt)
319 -- ensures that the names are defined locally
320 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
321 returnM [(nameOccName name, txt) | name <- names]
323 -- look for duplicates among the OccNames;
324 -- we check that the names are defined above
325 -- invt: the lists returned by findDupsEq always have at least two elements
326 deprec_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
327 (map (\ (L loc (Deprecation rdr_name _)) -> L loc rdr_name) decls)
329 dupDeprecDecl (L loc _) rdr_name
330 = vcat [ptext SLIT("Multiple deprecation declarations for") <+> quotes (ppr rdr_name),
331 ptext SLIT("also at ") <+> ppr loc]
335 %*********************************************************
337 \subsection{Source code declarations}
339 %*********************************************************
342 rnDefaultDecl (DefaultDecl tys)
343 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
344 returnM (DefaultDecl tys', fvs)
346 doc_str = text "In a `default' declaration"
349 %*********************************************************
351 \subsection{Foreign declarations}
353 %*********************************************************
356 rnHsForeignDecl (ForeignImport name ty spec)
357 = lookupLocatedTopBndrRn name `thenM` \ name' ->
358 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
359 returnM (ForeignImport name' ty' spec, fvs)
361 rnHsForeignDecl (ForeignExport name ty spec)
362 = lookupLocatedOccRn name `thenM` \ name' ->
363 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
364 returnM (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
365 -- NB: a foreign export is an *occurrence site* for name, so
366 -- we add it to the free-variable list. It might, for example,
367 -- be imported from another module
369 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
373 %*********************************************************
375 \subsection{Instance declarations}
377 %*********************************************************
380 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
381 -- Used for both source and interface file decls
382 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
384 -- Rename the bindings
385 -- The typechecker (not the renamer) checks that all
386 -- the bindings are for the right class
388 meth_doc = text "In the bindings in an instance declaration"
389 meth_names = collectHsBindLocatedBinders mbinds
390 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
392 checkDupRdrNames meth_doc meth_names `thenM_`
393 -- Check that the same method is not given twice in the
394 -- same instance decl instance C T where
398 -- We must use checkDupRdrNames because the Name of the
399 -- method is the Name of the class selector, whose SrcSpan
400 -- points to the class declaration
402 extendTyVarEnvForMethodBinds inst_tyvars (
403 -- (Slightly strangely) the forall-d tyvars scope over
404 -- the method bindings too
405 rnMethodBinds cls (\n->[]) -- No scoped tyvars
407 ) `thenM` \ (mbinds', meth_fvs) ->
408 -- Rename the associated types
409 -- The typechecker (not the renamer) checks that all
410 -- the declarations are for the right class
412 at_doc = text "In the associated types of an instance declaration"
413 at_names = map (head . tyClDeclNames . unLoc) ats
415 checkDupRdrNames at_doc at_names `thenM_`
416 -- See notes with checkDupRdrNames for methods, above
418 rnATInsts ats `thenM` \ (ats', at_fvs) ->
420 -- Rename the prags and signatures.
421 -- Note that the type variables are not in scope here,
422 -- so that instance Eq a => Eq (T a) where
423 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
426 -- But the (unqualified) method names are in scope
428 binders = collectHsBindBinders mbinds'
429 ok_sig = okInstDclSig (mkNameSet binders)
431 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
433 returnM (InstDecl inst_ty' mbinds' uprags' ats',
434 meth_fvs `plusFV` at_fvs
435 `plusFV` hsSigsFVs uprags'
436 `plusFV` extractHsTyNames inst_ty')
437 -- We return the renamed associated data type declarations so
438 -- that they can be entered into the list of type declarations
439 -- for the binding group, but we also keep a copy in the instance.
440 -- The latter is needed for well-formedness checks in the type
441 -- checker (eg, to ensure that all ATs of the instance actually
442 -- receive a declaration).
443 -- NB: Even the copies in the instance declaration carry copies of
444 -- the instance context after renaming. This is a bit
445 -- strange, but should not matter (and it would be more work
446 -- to remove the context).
449 Renaming of the associated types in instances.
452 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
453 rnATInsts atDecls = rnList rnATInst atDecls
455 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
456 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
458 pprPanic "RnSource.rnATInsts: invalid AT instance"
459 (ppr (tcdName tydecl))
462 For the method bindings in class and instance decls, we extend the
463 type variable environment iff -fglasgow-exts
466 extendTyVarEnvForMethodBinds tyvars thing_inside
467 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
469 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
474 %*********************************************************
476 \subsection{Stand-alone deriving declarations}
478 %*********************************************************
481 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
482 rnSrcDerivDecl (DerivDecl ty)
483 = do ty' <- rnLHsType (text "a deriving decl") ty
484 let fvs = extractHsTyNames ty'
485 return (DerivDecl ty', fvs)
488 %*********************************************************
492 %*********************************************************
495 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
496 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
498 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
499 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
501 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
502 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
504 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
506 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
507 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
509 doc = text "In the transformation rule" <+> ftext rule_name
511 get_var (RuleBndr v) = v
512 get_var (RuleBndrSig v _) = v
514 rn_var (RuleBndr (L loc v), id)
515 = returnM (RuleBndr (L loc id), emptyFVs)
516 rn_var (RuleBndrSig (L loc v) t, id)
517 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
518 returnM (RuleBndrSig (L loc id) t', fvs)
521 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
522 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
523 ptext SLIT("does not appear on left hand side")]
526 Note [Rule LHS validity checking]
527 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
528 Check the shape of a transformation rule LHS. Currently we only allow
529 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
530 @forall@'d variables.
532 We used restrict the form of the 'ei' to prevent you writing rules
533 with LHSs with a complicated desugaring (and hence unlikely to match);
534 (e.g. a case expression is not allowed: too elaborate.)
536 But there are legitimate non-trivial args ei, like sections and
537 lambdas. So it seems simmpler not to check at all, and that is why
538 check_e is commented out.
541 checkValidRule rule_name ids lhs' fv_lhs'
542 = do { -- Check for the form of the LHS
543 case (validRuleLhs ids lhs') of
545 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
547 -- Check that LHS vars are all bound
548 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
549 ; mappM (addErr . badRuleVar rule_name) bad_vars }
551 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
553 -- Just e => Not ok, and e is the offending expression
554 validRuleLhs foralls lhs
557 checkl (L loc e) = check e
559 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
560 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
561 check (HsVar v) | v `notElem` foralls = Nothing
562 check other = Just other -- Failure
565 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
567 {- Commented out; see Note [Rule LHS validity checking] above
568 check_e (HsVar v) = Nothing
569 check_e (HsPar e) = checkl_e e
570 check_e (HsLit e) = Nothing
571 check_e (HsOverLit e) = Nothing
573 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
574 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
575 check_e (NegApp e _) = checkl_e e
576 check_e (ExplicitList _ es) = checkl_es es
577 check_e (ExplicitTuple es _) = checkl_es es
578 check_e other = Just other -- Fails
580 checkl_es es = foldr (mplus . checkl_e) Nothing es
583 badRuleLhsErr name lhs bad_e
584 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
585 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
586 ptext SLIT("in left-hand side:") <+> ppr lhs])]
588 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
592 %*********************************************************
594 \subsection{Type, class and iface sig declarations}
596 %*********************************************************
598 @rnTyDecl@ uses the `global name function' to create a new type
599 declaration in which local names have been replaced by their original
600 names, reporting any unknown names.
602 Renaming type variables is a pain. Because they now contain uniques,
603 it is necessary to pass in an association list which maps a parsed
604 tyvar to its @Name@ representation.
605 In some cases (type signatures of values),
606 it is even necessary to go over the type first
607 in order to get the set of tyvars used by it, make an assoc list,
608 and then go over it again to rename the tyvars!
609 However, we can also do some scoping checks at the same time.
612 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
613 = lookupLocatedTopBndrRn name `thenM` \ name' ->
614 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
617 -- all flavours of type family declarations ("type family", "newtype fanily",
618 -- and "data family")
619 rnTyClDecl (tydecl@TyFamily {}) =
620 rnFamily tydecl bindTyVarsRn
622 -- "data", "newtype", "data instance, and "newtype instance" declarations
623 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
624 tcdLName = tycon, tcdTyVars = tyvars,
625 tcdTyPats = typatsMaybe, tcdCons = condecls,
626 tcdKindSig = sig, tcdDerivs = derivs})
627 | is_vanilla -- Normal Haskell data type decl
628 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
629 -- data type is syntactically illegal
630 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
631 do { tycon' <- if isFamInstDecl tydecl
632 then lookupLocatedOccRn tycon -- may be imported family
633 else lookupLocatedTopBndrRn tycon
634 ; context' <- rnContext data_doc context
635 ; typats' <- rnTyPats data_doc typatsMaybe
636 ; (derivs', deriv_fvs) <- rn_derivs derivs
637 ; condecls' <- rnConDecls (unLoc tycon') condecls
638 -- No need to check for duplicate constructor decls
639 -- since that is done by RnNames.extendRdrEnvRn
640 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
641 tcdLName = tycon', tcdTyVars = tyvars',
642 tcdTyPats = typats', tcdKindSig = Nothing,
643 tcdCons = condecls', tcdDerivs = derivs'},
644 delFVs (map hsLTyVarName tyvars') $
645 extractHsCtxtTyNames context' `plusFV`
646 plusFVs (map conDeclFVs condecls') `plusFV`
648 (if isFamInstDecl tydecl
649 then unitFV (unLoc tycon') -- type instance => use
654 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
655 do { tycon' <- if isFamInstDecl tydecl
656 then lookupLocatedOccRn tycon -- may be imported family
657 else lookupLocatedTopBndrRn tycon
658 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
659 ; tyvars' <- bindTyVarsRn data_doc tyvars
660 (\ tyvars' -> return tyvars')
661 -- For GADTs, the type variables in the declaration
662 -- do not scope over the constructor signatures
663 -- data T a where { T1 :: forall b. b-> b }
664 ; (derivs', deriv_fvs) <- rn_derivs derivs
665 ; condecls' <- rnConDecls (unLoc tycon') condecls
666 -- No need to check for duplicate constructor decls
667 -- since that is done by RnNames.extendRdrEnvRn
668 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
669 tcdLName = tycon', tcdTyVars = tyvars',
670 tcdTyPats = Nothing, tcdKindSig = sig,
671 tcdCons = condecls', tcdDerivs = derivs'},
672 plusFVs (map conDeclFVs condecls') `plusFV`
674 (if isFamInstDecl tydecl
675 then unitFV (unLoc tycon') -- type instance => use
679 is_vanilla = case condecls of -- Yuk
681 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
685 none (Just []) = True
688 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
689 con_names = map con_names_helper condecls
691 con_names_helper (L _ c) = con_name c
693 rn_derivs Nothing = returnM (Nothing, emptyFVs)
694 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
695 returnM (Just ds', extractHsTyNames_s ds')
697 -- "type" and "type instance" declarations
698 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
699 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
700 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
701 do { name' <- if isFamInstDecl tydecl
702 then lookupLocatedOccRn name -- may be imported family
703 else lookupLocatedTopBndrRn name
704 ; typats' <- rnTyPats syn_doc typatsMaybe
705 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
706 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
707 tcdTyPats = typats', tcdSynRhs = ty'},
708 delFVs (map hsLTyVarName tyvars') $
710 (if isFamInstDecl tydecl
711 then unitFV (unLoc name') -- type instance => use
715 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
717 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
718 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
719 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
720 = do { cname' <- lookupLocatedTopBndrRn cname
722 -- Tyvars scope over superclass context and method signatures
723 ; (tyvars', context', fds', ats', ats_fvs, sigs')
724 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
725 { context' <- rnContext cls_doc context
726 ; fds' <- rnFds cls_doc fds
727 ; (ats', ats_fvs) <- rnATs ats
728 ; sigs' <- renameSigs okClsDclSig sigs
729 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
731 -- No need to check for duplicate associated type decls
732 -- since that is done by RnNames.extendRdrEnvRn
734 -- Check the signatures
735 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
736 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
737 ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
738 -- Typechecker is responsible for checking that we only
739 -- give default-method bindings for things in this class.
740 -- The renamer *could* check this for class decls, but can't
741 -- for instance decls.
743 -- The newLocals call is tiresome: given a generic class decl
746 -- op {| x+y |} (Inl a) = ...
747 -- op {| x+y |} (Inr b) = ...
748 -- op {| a*b |} (a*b) = ...
749 -- we want to name both "x" tyvars with the same unique, so that they are
750 -- easy to group together in the typechecker.
751 ; (mbinds', meth_fvs)
752 <- extendTyVarEnvForMethodBinds tyvars' $ do
753 { name_env <- getLocalRdrEnv
754 ; let meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
755 gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
756 not (unLoc tv `elemLocalRdrEnv` name_env) ]
757 -- No need to check for duplicate method signatures
758 -- since that is done by RnNames.extendRdrEnvRn
759 -- and the methods are already in scope
760 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
761 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
764 ; docs' <- mapM (wrapLocM rnDocDecl) docs
766 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
767 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
768 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
770 delFVs (map hsLTyVarName tyvars') $
771 extractHsCtxtTyNames context' `plusFV`
772 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
773 hsSigsFVs sigs' `plusFV`
777 meth_doc = text "In the default-methods for class" <+> ppr cname
778 cls_doc = text "In the declaration for class" <+> ppr cname
779 sig_doc = text "In the signatures for class" <+> ppr cname
780 at_doc = text "In the associated types for class" <+> ppr cname
782 badGadtStupidTheta tycon
783 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
784 ptext SLIT("(You can put a context on each contructor, though.)")]
787 %*********************************************************
789 \subsection{Support code for type/data declarations}
791 %*********************************************************
794 -- Although, we are processing type patterns here, all type variables will
795 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
796 -- type declaration to which these patterns belong)
798 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
799 rnTyPats _ Nothing = return Nothing
800 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
802 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
803 rnConDecls tycon condecls
804 = mappM (wrapLocM rnConDecl) condecls
806 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
807 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
808 = do { addLocM checkConName name
810 ; new_name <- lookupLocatedTopBndrRn name
811 ; name_env <- getLocalRdrEnv
813 -- For H98 syntax, the tvs are the existential ones
814 -- For GADT syntax, the tvs are all the quantified tyvars
815 -- Hence the 'filter' in the ResTyH98 case only
816 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
817 arg_tys = hsConDeclArgTys details
818 implicit_tvs = case res_ty of
819 ResTyH98 -> filter not_in_scope $
821 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
824 Implicit -> userHsTyVarBndrs implicit_tvs
826 ; mb_doc' <- rnMbLHsDoc mb_doc
828 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
829 { new_context <- rnContext doc cxt
830 ; new_details <- rnConDeclDetails doc details
831 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
832 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
834 doc = text "In the definition of data constructor" <+> quotes (ppr name)
835 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
837 rnConResult _ details ResTyH98 = return (details, ResTyH98)
839 rnConResult doc details (ResTyGADT ty) = do
840 ty' <- rnHsSigType doc ty
841 let (arg_tys, res_ty) = splitHsFunType ty'
842 -- We can split it up, now the renamer has dealt with fixities
844 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
845 RecCon fields -> return (details, ResTyGADT ty')
846 InfixCon {} -> panic "rnConResult"
848 rnConDeclDetails doc (PrefixCon tys)
849 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
850 returnM (PrefixCon new_tys)
852 rnConDeclDetails doc (InfixCon ty1 ty2)
853 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
854 rnLHsType doc ty2 `thenM` \ new_ty2 ->
855 returnM (InfixCon new_ty1 new_ty2)
857 rnConDeclDetails doc (RecCon fields)
858 = do { new_fields <- mappM (rnField doc) fields
859 -- No need to check for duplicate fields
860 -- since that is done by RnNames.extendRdrEnvRn
861 ; return (RecCon new_fields) }
863 rnField doc (ConDeclField name ty haddock_doc)
864 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
865 rnLHsType doc ty `thenM` \ new_ty ->
866 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
867 returnM (ConDeclField new_name new_ty new_haddock_doc)
869 -- Rename family declarations
871 -- * This function is parametrised by the routine handling the index
872 -- variables. On the toplevel, these are defining occurences, whereas they
873 -- are usage occurences for associated types.
875 rnFamily :: TyClDecl RdrName
876 -> (SDoc -> [LHsTyVarBndr RdrName] ->
877 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
878 RnM (TyClDecl Name, FreeVars))
879 -> RnM (TyClDecl Name, FreeVars)
881 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
882 tcdLName = tycon, tcdTyVars = tyvars})
884 do { checkM (isDataFlavour flavour -- for synonyms,
885 || not (null tyvars)) $ addErr needOneIdx -- #indexes >= 1
886 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
887 ; tycon' <- lookupLocatedTopBndrRn tycon
888 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
889 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
893 isDataFlavour DataFamily = True
894 isDataFlavour _ = False
896 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
897 needOneIdx = text "Type family declarations requires at least one type index"
899 -- Rename associated type declarations (in classes)
901 -- * This can be family declarations and (default) type instances
903 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
904 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
906 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
907 rn_at (tydecl@TySynonym {}) =
909 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
911 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
913 lookupIdxVars _ tyvars cont =
914 do { checkForDups tyvars;
915 ; tyvars' <- mappM lookupIdxVar tyvars
918 -- Type index variables must be class parameters, which are the only
919 -- type variables in scope at this point.
920 lookupIdxVar (L l tyvar) =
922 name' <- lookupOccRn (hsTyVarName tyvar)
923 return $ L l (replaceTyVarName tyvar name')
925 -- Type variable may only occur once.
927 checkForDups [] = return ()
928 checkForDups (L loc tv:ltvs) =
929 do { setSrcSpan loc $
930 when (hsTyVarName tv `ltvElem` ltvs) $
931 addErr (repeatedTyVar tv)
935 rdrName `ltvElem` [] = False
936 rdrName `ltvElem` (L _ tv:ltvs)
937 | rdrName == hsTyVarName tv = True
938 | otherwise = rdrName `ltvElem` ltvs
940 noPatterns = text "Default definition for an associated synonym cannot have"
941 <+> text "type pattern"
943 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
946 -- This data decl will parse OK
948 -- treating "a" as the constructor.
949 -- It is really hard to make the parser spot this malformation.
950 -- So the renamer has to check that the constructor is legal
952 -- We can get an operator as the constructor, even in the prefix form:
953 -- data T = :% Int Int
954 -- from interface files, which always print in prefix form
956 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
959 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
963 %*********************************************************
965 \subsection{Support code for type/data declarations}
967 %*********************************************************
969 Get the mapping from constructors to fields for this module.
970 It's convenient to do this after the data type decls have been renamed
972 extendRecordFieldEnv :: [LTyClDecl RdrName] -> TcM TcGblEnv
973 extendRecordFieldEnv decls
974 = do { tcg_env <- getGblEnv
975 ; field_env' <- foldrM get (tcg_field_env tcg_env) decls
976 ; return (tcg_env { tcg_field_env = field_env' }) }
978 -- we want to lookup:
979 -- (a) a datatype constructor
980 -- (b) a record field
981 -- knowing that they're from this module.
982 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
983 -- which keeps only the local ones.
984 lookup x = do { x' <- lookupLocatedTopBndrRn x
987 get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
988 get other env = return env
990 get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
991 = do { con' <- lookup con
992 ; flds' <- mappM lookup (map cd_fld_name flds)
993 ; return $ extendNameEnv env con' flds' }
998 %*********************************************************
1000 \subsection{Support code to rename types}
1002 %*********************************************************
1005 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1008 = mappM (wrapLocM rn_fds) fds
1011 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1012 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1013 returnM (tys1', tys2')
1015 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
1016 rnHsTyvar doc tyvar = lookupOccRn tyvar
1020 %*********************************************************
1024 %*********************************************************
1030 h = ...$(thing "f")...
1032 The splice can expand into literally anything, so when we do dependency
1033 analysis we must assume that it might mention 'f'. So we simply treat
1034 all locally-defined names as mentioned by any splice. This is terribly
1035 brutal, but I don't see what else to do. For example, it'll mean
1036 that every locally-defined thing will appear to be used, so no unused-binding
1037 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
1038 and that will crash the type checker because 'f' isn't in scope.
1040 Currently, I'm not treating a splice as also mentioning every import,
1041 which is a bit inconsistent -- but there are a lot of them. We might
1042 thereby get some bogus unused-import warnings, but we won't crash the
1043 type checker. Not very satisfactory really.
1046 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
1047 rnSplice (HsSplice n expr)
1048 = do { checkTH expr "splice"
1049 ; loc <- getSrcSpanM
1050 ; [n'] <- newLocalsRn [L loc n]
1051 ; (expr', fvs) <- rnLExpr expr
1053 -- Ugh! See Note [Splices] above
1054 ; lcl_rdr <- getLocalRdrEnv
1055 ; gbl_rdr <- getGlobalRdrEnv
1056 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
1058 lcl_names = mkNameSet (occEnvElts lcl_rdr)
1060 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
1063 checkTH e what = returnM () -- OK
1065 checkTH e what -- Raise an error in a stage-1 compiler
1066 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
1067 ptext SLIT("illegal in a stage-1 compiler"),