2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
13 #include "HsVersions.h"
15 import {-# SOURCE #-} RnExpr( rnLExpr )
18 import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv,
19 globalRdrEnvElts, GlobalRdrElt(..), isLocalGRE, rdrNameOcc )
20 import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
22 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
23 import RnBinds ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
25 import RnEnv ( lookupLocalDataTcNames,
26 lookupLocatedTopBndrRn, lookupLocatedOccRn,
27 lookupOccRn, newLocalsRn,
28 bindLocatedLocalsFV, bindPatSigTyVarsFV,
29 bindTyVarsRn, extendTyVarEnvFVRn,
30 bindLocalNames, checkDupRdrNames, mapFvRn,
32 import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
33 import HscTypes ( GenAvailInfo(..) )
34 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
37 import HscTypes ( Deprecations(..), plusDeprecs )
38 import Class ( FunDep )
39 import Name ( Name, nameOccName )
46 import SrcLoc ( Located(..), unLoc, noLoc )
47 import DynFlags ( DynFlag(..) )
48 import Maybe ( isNothing )
49 import BasicTypes ( Boxity(..) )
51 import ListSetOps (findDupsEq)
58 thenM :: Monad a => a b -> (b -> a c) -> a c
61 thenM_ :: Monad a => a b -> a c -> a c
64 returnM :: Monad m => a -> m a
67 mappM :: (Monad m) => (a -> m b) -> [a] -> m [b]
70 mappM_ :: (Monad m) => (a -> m b) -> [a] -> m ()
73 checkM :: Monad m => Bool -> m () -> m ()
77 @rnSourceDecl@ `renames' declarations.
78 It simultaneously performs dependency analysis and precedence parsing.
79 It also does the following error checks:
82 Checks that tyvars are used properly. This includes checking
83 for undefined tyvars, and tyvars in contexts that are ambiguous.
84 (Some of this checking has now been moved to module @TcMonoType@,
85 since we don't have functional dependency information at this point.)
87 Checks that all variable occurences are defined.
89 Checks the @(..)@ etc constraints in the export list.
94 -- Brings the binders of the group into scope in the appropriate places;
95 -- does NOT assume that anything is in scope already
97 -- The Bool determines whether (True) names in the group shadow existing
98 -- Unquals in the global environment (used in Template Haskell) or
99 -- (False) whether duplicates are reported as an error
100 rnSrcDecls :: Bool -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
102 rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls,
103 hs_tyclds = tycl_decls,
104 hs_instds = inst_decls,
105 hs_derivds = deriv_decls,
106 hs_fixds = fix_decls,
107 hs_depds = deprec_decls,
108 hs_fords = foreign_decls,
109 hs_defds = default_decls,
110 hs_ruleds = rule_decls,
113 -- (A) Process the fixity declarations, creating a mapping from
114 -- FastStrings to FixItems.
115 -- Also checks for duplcates.
116 local_fix_env <- makeMiniFixityEnv fix_decls;
118 -- (B) Bring top level binders (and their fixities) into scope,
119 -- *except* for the value bindings, which get brought in below.
120 avails <- getLocalNonValBinders group ;
121 tc_envs <- extendGlobalRdrEnvRn shadowP avails local_fix_env ;
122 setEnvs tc_envs $ do {
124 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
126 -- (C) Extract the mapping from data constructors to field names and
127 -- extend the record field env.
128 -- This depends on the data constructors and field names being in
129 -- scope from (B) above
130 inNewEnv (extendRecordFieldEnv tycl_decls) $ \ _ -> do {
132 -- (D) Rename the left-hand sides of the value bindings.
133 -- This depends on everything from (B) being in scope,
134 -- and on (C) for resolving record wild cards.
135 -- It uses the fixity env from (A) to bind fixities for view patterns.
136 new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
137 -- bind the LHSes (and their fixities) in the global rdr environment
138 let { lhs_binders = map unLoc $ collectHsValBinders new_lhs;
139 lhs_avails = map Avail lhs_binders
141 (tcg_env, tcl_env) <- extendGlobalRdrEnvRn shadowP lhs_avails local_fix_env ;
142 setEnvs (tcg_env, tcl_env) $ do {
144 -- Now everything is in scope, as the remaining renaming assumes.
146 -- (E) Rename type and class decls
147 -- (note that value LHSes need to be in scope for default methods)
149 -- You might think that we could build proper def/use information
150 -- for type and class declarations, but they can be involved
151 -- in mutual recursion across modules, and we only do the SCC
152 -- analysis for them in the type checker.
153 -- So we content ourselves with gathering uses only; that
154 -- means we'll only report a declaration as unused if it isn't
155 -- mentioned at all. Ah well.
156 traceRn (text "Start rnTyClDecls") ;
157 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
159 -- (F) Rename Value declarations right-hand sides
160 traceRn (text "Start rnmono") ;
161 (rn_val_decls, bind_dus) <- rnTopBindsRHS lhs_binders new_lhs ;
162 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
164 -- (G) Rename Fixity and deprecations
166 -- rename fixity declarations and error if we try to
167 -- fix something from another module (duplicates were checked in (A))
168 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
169 -- rename deprec decls;
170 -- check for duplicates and ensure that deprecated things are defined locally
171 -- at the moment, we don't keep these around past renaming
172 rn_deprecs <- rnSrcDeprecDecls deprec_decls ;
174 -- (H) Rename Everything else
176 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
177 (rn_rule_decls, src_fvs3) <- rnList rnHsRuleDecl rule_decls ;
178 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
179 (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ;
180 (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ;
181 -- Haddock docs; no free vars
182 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
184 -- (I) Compute the results and return
185 let {rn_group = HsGroup { hs_valds = rn_val_decls,
186 hs_tyclds = rn_tycl_decls,
187 hs_instds = rn_inst_decls,
188 hs_derivds = rn_deriv_decls,
189 hs_fixds = rn_fix_decls,
190 hs_depds = [], -- deprecs are returned in the tcg_env
191 -- (see below) not in the HsGroup
192 hs_fords = rn_foreign_decls,
193 hs_defds = rn_default_decls,
194 hs_ruleds = rn_rule_decls,
195 hs_docs = rn_docs } ;
197 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
198 src_fvs4, src_fvs5] ;
199 src_dus = bind_dus `plusDU` usesOnly other_fvs;
200 -- Note: src_dus will contain *uses* for locally-defined types
201 -- and classes, but no *defs* for them. (Because rnTyClDecl
202 -- returns only the uses.) This is a little
203 -- surprising but it doesn't actually matter at all.
205 final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
206 in -- we return the deprecs in the env, not in the HsGroup above
207 tcg_env' { tcg_deprecs = tcg_deprecs tcg_env' `plusDeprecs` rn_deprecs };
210 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
211 traceRn (text "finish Dus" <+> ppr src_dus ) ;
212 return (final_tcg_env , rn_group)
215 -- some utils because we do this a bunch above
216 -- compute and install the new env
217 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
218 inNewEnv env cont = do e <- env
221 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
222 -- Used for external core
223 rnTyClDecls tycl_decls = do (decls', _fvs) <- rnList rnTyClDecl tycl_decls
226 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
227 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
229 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
230 rnList f xs = mapFvRn (wrapLocFstM f) xs
234 %*********************************************************
238 %*********************************************************
241 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
242 rnDocDecl (DocCommentNext doc) = do
243 rn_doc <- rnHsDoc doc
244 return (DocCommentNext rn_doc)
245 rnDocDecl (DocCommentPrev doc) = do
246 rn_doc <- rnHsDoc doc
247 return (DocCommentPrev rn_doc)
248 rnDocDecl (DocCommentNamed str doc) = do
249 rn_doc <- rnHsDoc doc
250 return (DocCommentNamed str rn_doc)
251 rnDocDecl (DocGroup lev doc) = do
252 rn_doc <- rnHsDoc doc
253 return (DocGroup lev rn_doc)
257 %*********************************************************
259 Source-code fixity declarations
261 %*********************************************************
264 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
265 -- Rename the fixity decls, so we can put
266 -- the renamed decls in the renamed syntax tree
267 -- Errors if the thing being fixed is not defined locally.
269 -- The returned FixitySigs are not actually used for anything,
270 -- except perhaps the GHCi API
271 rnSrcFixityDecls fix_decls
272 = do fix_decls <- mapM rn_decl fix_decls
273 return (concat fix_decls)
275 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
276 -- GHC extension: look up both the tycon and data con
277 -- for con-like things; hence returning a list
278 -- If neither are in scope, report an error; otherwise
279 -- return a fixity sig for each (slightly odd)
280 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
281 = setSrcSpan name_loc $
282 -- this lookup will fail if the definition isn't local
283 do names <- lookupLocalDataTcNames rdr_name
284 return [ L loc (FixitySig (L name_loc name) fixity)
289 %*********************************************************
291 Source-code deprecations declarations
293 %*********************************************************
295 Check that the deprecated names are defined, are defined locally, and
296 that there are no duplicate deprecations.
298 It's only imported deprecations, dealt with in RnIfaces, that we
299 gather them together.
302 -- checks that the deprecations are defined locally, and that there are no duplicates
303 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
307 rnSrcDeprecDecls decls
308 = do { -- check for duplicates
309 ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupDeprecDecl lrdr')) deprec_rdr_dups
310 ; mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
311 returnM (DeprecSome ((concat pairs_s))) }
313 rn_deprec (Deprecation rdr_name txt)
314 -- ensures that the names are defined locally
315 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
316 returnM [(nameOccName name, txt) | name <- names]
318 -- look for duplicates among the OccNames;
319 -- we check that the names are defined above
320 -- invt: the lists returned by findDupsEq always have at least two elements
321 deprec_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
322 (map (\ (L loc (Deprecation rdr_name _)) -> L loc rdr_name) decls)
324 dupDeprecDecl :: Located RdrName -> RdrName -> SDoc
325 -- Located RdrName -> DeprecDecl RdrName -> SDoc
326 dupDeprecDecl (L loc _) rdr_name
327 = vcat [ptext (sLit "Multiple deprecation declarations for") <+> quotes (ppr rdr_name),
328 ptext (sLit "also at ") <+> ppr loc]
332 %*********************************************************
334 \subsection{Source code declarations}
336 %*********************************************************
339 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
340 rnDefaultDecl (DefaultDecl tys)
341 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
342 returnM (DefaultDecl tys', fvs)
344 doc_str = text "In a `default' declaration"
347 %*********************************************************
349 \subsection{Foreign declarations}
351 %*********************************************************
354 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
355 rnHsForeignDecl (ForeignImport name ty spec)
356 = lookupLocatedTopBndrRn name `thenM` \ name' ->
357 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
358 returnM (ForeignImport name' ty' spec, fvs)
360 rnHsForeignDecl (ForeignExport name ty spec)
361 = lookupLocatedOccRn name `thenM` \ name' ->
362 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
363 returnM (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
364 -- NB: a foreign export is an *occurrence site* for name, so
365 -- we add it to the free-variable list. It might, for example,
366 -- be imported from another module
368 fo_decl_msg :: Located RdrName -> SDoc
369 fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
373 %*********************************************************
375 \subsection{Instance declarations}
377 %*********************************************************
380 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
381 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
382 -- Used for both source and interface file decls
383 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
385 -- Rename the bindings
386 -- The typechecker (not the renamer) checks that all
387 -- the bindings are for the right class
389 meth_doc = text "In the bindings in an instance declaration"
390 meth_names = collectHsBindLocatedBinders mbinds
391 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
393 checkDupRdrNames meth_doc meth_names `thenM_`
394 -- Check that the same method is not given twice in the
395 -- same instance decl instance C T where
399 -- We must use checkDupRdrNames because the Name of the
400 -- method is the Name of the class selector, whose SrcSpan
401 -- points to the class declaration
403 extendTyVarEnvForMethodBinds inst_tyvars (
404 -- (Slightly strangely) the forall-d tyvars scope over
405 -- the method bindings too
406 rnMethodBinds cls (\_ -> []) -- No scoped tyvars
408 ) `thenM` \ (mbinds', meth_fvs) ->
409 -- Rename the associated types
410 -- The typechecker (not the renamer) checks that all
411 -- the declarations are for the right class
413 at_doc = text "In the associated types of an instance declaration"
414 at_names = map (head . tyClDeclNames . unLoc) ats
416 checkDupRdrNames at_doc at_names `thenM_`
417 -- See notes with checkDupRdrNames for methods, above
419 rnATInsts ats `thenM` \ (ats', at_fvs) ->
421 -- Rename the prags and signatures.
422 -- Note that the type variables are not in scope here,
423 -- so that instance Eq a => Eq (T a) where
424 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
427 -- But the (unqualified) method names are in scope
429 binders = collectHsBindBinders mbinds'
430 ok_sig = okInstDclSig (mkNameSet binders)
432 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
434 returnM (InstDecl inst_ty' mbinds' uprags' ats',
435 meth_fvs `plusFV` at_fvs
436 `plusFV` hsSigsFVs uprags'
437 `plusFV` extractHsTyNames inst_ty')
438 -- We return the renamed associated data type declarations so
439 -- that they can be entered into the list of type declarations
440 -- for the binding group, but we also keep a copy in the instance.
441 -- The latter is needed for well-formedness checks in the type
442 -- checker (eg, to ensure that all ATs of the instance actually
443 -- receive a declaration).
444 -- NB: Even the copies in the instance declaration carry copies of
445 -- the instance context after renaming. This is a bit
446 -- strange, but should not matter (and it would be more work
447 -- to remove the context).
450 Renaming of the associated types in instances.
453 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
454 rnATInsts atDecls = rnList rnATInst atDecls
456 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
457 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
459 pprPanic "RnSource.rnATInsts: invalid AT instance"
460 (ppr (tcdName tydecl))
463 For the method bindings in class and instance decls, we extend the
464 type variable environment iff -fglasgow-exts
467 extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
468 -> RnM (Bag (LHsBind Name), FreeVars)
469 -> RnM (Bag (LHsBind Name), FreeVars)
470 extendTyVarEnvForMethodBinds tyvars thing_inside
471 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
473 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
478 %*********************************************************
480 \subsection{Stand-alone deriving declarations}
482 %*********************************************************
485 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
486 rnSrcDerivDecl (DerivDecl ty)
487 = do ty' <- rnLHsType (text "a deriving decl") ty
488 let fvs = extractHsTyNames ty'
489 return (DerivDecl ty', fvs)
492 %*********************************************************
496 %*********************************************************
499 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
500 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
501 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
503 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
504 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
506 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
507 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
509 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
511 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
512 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
514 doc = text "In the transformation rule" <+> ftext rule_name
516 get_var (RuleBndr v) = v
517 get_var (RuleBndrSig v _) = v
519 rn_var (RuleBndr (L loc _), id)
520 = returnM (RuleBndr (L loc id), emptyFVs)
521 rn_var (RuleBndrSig (L loc _) t, id)
522 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
523 returnM (RuleBndrSig (L loc id) t', fvs)
525 badRuleVar :: FastString -> Name -> SDoc
527 = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
528 ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
529 ptext (sLit "does not appear on left hand side")]
532 Note [Rule LHS validity checking]
533 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
534 Check the shape of a transformation rule LHS. Currently we only allow
535 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
536 @forall@'d variables.
538 We used restrict the form of the 'ei' to prevent you writing rules
539 with LHSs with a complicated desugaring (and hence unlikely to match);
540 (e.g. a case expression is not allowed: too elaborate.)
542 But there are legitimate non-trivial args ei, like sections and
543 lambdas. So it seems simmpler not to check at all, and that is why
544 check_e is commented out.
547 checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
548 checkValidRule rule_name ids lhs' fv_lhs'
549 = do { -- Check for the form of the LHS
550 case (validRuleLhs ids lhs') of
552 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
554 -- Check that LHS vars are all bound
555 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
556 ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
558 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
560 -- Just e => Not ok, and e is the offending expression
561 validRuleLhs foralls lhs
564 checkl (L _ e) = check e
566 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
567 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
568 check (HsVar v) | v `notElem` foralls = Nothing
569 check other = Just other -- Failure
572 checkl_e (L _ _e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
574 {- Commented out; see Note [Rule LHS validity checking] above
575 check_e (HsVar v) = Nothing
576 check_e (HsPar e) = checkl_e e
577 check_e (HsLit e) = Nothing
578 check_e (HsOverLit e) = Nothing
580 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
581 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
582 check_e (NegApp e _) = checkl_e e
583 check_e (ExplicitList _ es) = checkl_es es
584 check_e (ExplicitTuple es _) = checkl_es es
585 check_e other = Just other -- Fails
587 checkl_es es = foldr (mplus . checkl_e) Nothing es
590 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
591 badRuleLhsErr name lhs bad_e
592 = sep [ptext (sLit "Rule") <+> ftext name <> colon,
593 nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
594 ptext (sLit "in left-hand side:") <+> ppr lhs])]
596 ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
600 %*********************************************************
602 \subsection{Type, class and iface sig declarations}
604 %*********************************************************
606 @rnTyDecl@ uses the `global name function' to create a new type
607 declaration in which local names have been replaced by their original
608 names, reporting any unknown names.
610 Renaming type variables is a pain. Because they now contain uniques,
611 it is necessary to pass in an association list which maps a parsed
612 tyvar to its @Name@ representation.
613 In some cases (type signatures of values),
614 it is even necessary to go over the type first
615 in order to get the set of tyvars used by it, make an assoc list,
616 and then go over it again to rename the tyvars!
617 However, we can also do some scoping checks at the same time.
620 rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
621 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
622 = lookupLocatedTopBndrRn name `thenM` \ name' ->
623 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
626 -- all flavours of type family declarations ("type family", "newtype fanily",
627 -- and "data family")
628 rnTyClDecl (tydecl@TyFamily {}) =
629 rnFamily tydecl bindTyVarsRn
631 -- "data", "newtype", "data instance, and "newtype instance" declarations
632 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
633 tcdLName = tycon, tcdTyVars = tyvars,
634 tcdTyPats = typatsMaybe, tcdCons = condecls,
635 tcdKindSig = sig, tcdDerivs = derivs})
636 | is_vanilla -- Normal Haskell data type decl
637 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
638 -- data type is syntactically illegal
639 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
640 do { tycon' <- if isFamInstDecl tydecl
641 then lookupLocatedOccRn tycon -- may be imported family
642 else lookupLocatedTopBndrRn tycon
643 ; context' <- rnContext data_doc context
644 ; typats' <- rnTyPats data_doc typatsMaybe
645 ; (derivs', deriv_fvs) <- rn_derivs derivs
646 ; condecls' <- rnConDecls (unLoc tycon') condecls
647 -- No need to check for duplicate constructor decls
648 -- since that is done by RnNames.extendGlobalRdrEnvRn
649 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
650 tcdLName = tycon', tcdTyVars = tyvars',
651 tcdTyPats = typats', tcdKindSig = Nothing,
652 tcdCons = condecls', tcdDerivs = derivs'},
653 delFVs (map hsLTyVarName tyvars') $
654 extractHsCtxtTyNames context' `plusFV`
655 plusFVs (map conDeclFVs condecls') `plusFV`
657 (if isFamInstDecl tydecl
658 then unitFV (unLoc tycon') -- type instance => use
663 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
664 do { tycon' <- if isFamInstDecl tydecl
665 then lookupLocatedOccRn tycon -- may be imported family
666 else lookupLocatedTopBndrRn tycon
667 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
668 ; tyvars' <- bindTyVarsRn data_doc tyvars
669 (\ tyvars' -> return tyvars')
670 -- For GADTs, the type variables in the declaration
671 -- do not scope over the constructor signatures
672 -- data T a where { T1 :: forall b. b-> b }
673 ; (derivs', deriv_fvs) <- rn_derivs derivs
674 ; condecls' <- rnConDecls (unLoc tycon') condecls
675 -- No need to check for duplicate constructor decls
676 -- since that is done by RnNames.extendGlobalRdrEnvRn
677 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
678 tcdLName = tycon', tcdTyVars = tyvars',
679 tcdTyPats = Nothing, tcdKindSig = sig,
680 tcdCons = condecls', tcdDerivs = derivs'},
681 plusFVs (map conDeclFVs condecls') `plusFV`
683 (if isFamInstDecl tydecl
684 then unitFV (unLoc tycon') -- type instance => use
688 is_vanilla = case condecls of -- Yuk
690 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
694 none (Just []) = True
697 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
699 rn_derivs Nothing = returnM (Nothing, emptyFVs)
700 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
701 returnM (Just ds', extractHsTyNames_s ds')
703 -- "type" and "type instance" declarations
704 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
705 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
706 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
707 do { name' <- if isFamInstDecl tydecl
708 then lookupLocatedOccRn name -- may be imported family
709 else lookupLocatedTopBndrRn name
710 ; typats' <- rnTyPats syn_doc typatsMaybe
711 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
712 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
713 tcdTyPats = typats', tcdSynRhs = ty'},
714 delFVs (map hsLTyVarName tyvars') $
716 (if isFamInstDecl tydecl
717 then unitFV (unLoc name') -- type instance => use
721 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
723 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
724 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
725 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
726 = do { cname' <- lookupLocatedTopBndrRn cname
728 -- Tyvars scope over superclass context and method signatures
729 ; (tyvars', context', fds', ats', ats_fvs, sigs')
730 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
731 { context' <- rnContext cls_doc context
732 ; fds' <- rnFds cls_doc fds
733 ; (ats', ats_fvs) <- rnATs ats
734 ; sigs' <- renameSigs okClsDclSig sigs
735 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
737 -- No need to check for duplicate associated type decls
738 -- since that is done by RnNames.extendGlobalRdrEnvRn
740 -- Check the signatures
741 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
742 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
743 ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
744 -- Typechecker is responsible for checking that we only
745 -- give default-method bindings for things in this class.
746 -- The renamer *could* check this for class decls, but can't
747 -- for instance decls.
749 -- The newLocals call is tiresome: given a generic class decl
752 -- op {| x+y |} (Inl a) = ...
753 -- op {| x+y |} (Inr b) = ...
754 -- op {| a*b |} (a*b) = ...
755 -- we want to name both "x" tyvars with the same unique, so that they are
756 -- easy to group together in the typechecker.
757 ; (mbinds', meth_fvs)
758 <- extendTyVarEnvForMethodBinds tyvars' $ do
759 { name_env <- getLocalRdrEnv
760 ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
761 not (unLoc tv `elemLocalRdrEnv` name_env) ]
762 -- No need to check for duplicate method signatures
763 -- since that is done by RnNames.extendGlobalRdrEnvRn
764 -- and the methods are already in scope
765 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
766 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
769 ; docs' <- mapM (wrapLocM rnDocDecl) docs
771 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
772 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
773 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
775 delFVs (map hsLTyVarName tyvars') $
776 extractHsCtxtTyNames context' `plusFV`
777 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
778 hsSigsFVs sigs' `plusFV`
782 cls_doc = text "In the declaration for class" <+> ppr cname
783 sig_doc = text "In the signatures for class" <+> ppr cname
785 badGadtStupidTheta :: Located RdrName -> SDoc
787 = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
788 ptext (sLit "(You can put a context on each contructor, though.)")]
791 %*********************************************************
793 \subsection{Support code for type/data declarations}
795 %*********************************************************
798 -- Although, we are processing type patterns here, all type variables will
799 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
800 -- type declaration to which these patterns belong)
802 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
803 rnTyPats _ Nothing = return Nothing
804 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
806 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
807 rnConDecls _tycon condecls
808 = mappM (wrapLocM rnConDecl) condecls
810 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
811 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
812 = do { addLocM checkConName name
814 ; new_name <- lookupLocatedTopBndrRn name
815 ; name_env <- getLocalRdrEnv
817 -- For H98 syntax, the tvs are the existential ones
818 -- For GADT syntax, the tvs are all the quantified tyvars
819 -- Hence the 'filter' in the ResTyH98 case only
820 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
821 arg_tys = hsConDeclArgTys details
822 implicit_tvs = case res_ty of
823 ResTyH98 -> filter not_in_scope $
825 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
828 Implicit -> userHsTyVarBndrs implicit_tvs
830 ; mb_doc' <- rnMbLHsDoc mb_doc
832 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
833 { new_context <- rnContext doc cxt
834 ; new_details <- rnConDeclDetails doc details
835 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
836 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
838 doc = text "In the definition of data constructor" <+> quotes (ppr name)
839 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
842 -> HsConDetails (LHsType Name) [ConDeclField Name]
844 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
846 rnConResult _ details ResTyH98 = return (details, ResTyH98)
848 rnConResult doc details (ResTyGADT ty) = do
849 ty' <- rnHsSigType doc ty
850 let (arg_tys, res_ty) = splitHsFunType ty'
851 -- We can split it up, now the renamer has dealt with fixities
853 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
854 RecCon _ -> return (details, ResTyGADT ty')
855 InfixCon {} -> panic "rnConResult"
857 rnConDeclDetails :: SDoc
858 -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
859 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
860 rnConDeclDetails doc (PrefixCon tys)
861 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
862 returnM (PrefixCon new_tys)
864 rnConDeclDetails doc (InfixCon ty1 ty2)
865 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
866 rnLHsType doc ty2 `thenM` \ new_ty2 ->
867 returnM (InfixCon new_ty1 new_ty2)
869 rnConDeclDetails doc (RecCon fields)
870 = do { new_fields <- mappM (rnField doc) fields
871 -- No need to check for duplicate fields
872 -- since that is done by RnNames.extendGlobalRdrEnvRn
873 ; return (RecCon new_fields) }
875 rnField :: SDoc -> ConDeclField RdrName -> RnM (ConDeclField Name)
876 rnField doc (ConDeclField name ty haddock_doc)
877 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
878 rnLHsType doc ty `thenM` \ new_ty ->
879 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
880 returnM (ConDeclField new_name new_ty new_haddock_doc)
882 -- Rename family declarations
884 -- * This function is parametrised by the routine handling the index
885 -- variables. On the toplevel, these are defining occurences, whereas they
886 -- are usage occurences for associated types.
888 rnFamily :: TyClDecl RdrName
889 -> (SDoc -> [LHsTyVarBndr RdrName] ->
890 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
891 RnM (TyClDecl Name, FreeVars))
892 -> RnM (TyClDecl Name, FreeVars)
894 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
895 tcdLName = tycon, tcdTyVars = tyvars})
897 do { checkM (isDataFlavour flavour -- for synonyms,
898 || not (null tyvars)) $ addErr needOneIdx -- #indexes >= 1
899 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
900 ; tycon' <- lookupLocatedTopBndrRn tycon
901 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
902 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
906 isDataFlavour DataFamily = True
907 isDataFlavour _ = False
908 rnFamily d _ = pprPanic "rnFamily" (ppr d)
910 family_doc :: Located RdrName -> SDoc
911 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
914 needOneIdx = text "Type family declarations requires at least one type index"
916 -- Rename associated type declarations (in classes)
918 -- * This can be family declarations and (default) type instances
920 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
921 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
923 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
924 rn_at (tydecl@TySynonym {}) =
926 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
928 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
930 lookupIdxVars _ tyvars cont =
931 do { checkForDups tyvars;
932 ; tyvars' <- mappM lookupIdxVar tyvars
935 -- Type index variables must be class parameters, which are the only
936 -- type variables in scope at this point.
937 lookupIdxVar (L l tyvar) =
939 name' <- lookupOccRn (hsTyVarName tyvar)
940 return $ L l (replaceTyVarName tyvar name')
942 -- Type variable may only occur once.
944 checkForDups [] = return ()
945 checkForDups (L loc tv:ltvs) =
946 do { setSrcSpan loc $
947 when (hsTyVarName tv `ltvElem` ltvs) $
948 addErr (repeatedTyVar tv)
952 _ `ltvElem` [] = False
953 rdrName `ltvElem` (L _ tv:ltvs)
954 | rdrName == hsTyVarName tv = True
955 | otherwise = rdrName `ltvElem` ltvs
958 noPatterns = text "Default definition for an associated synonym cannot have"
959 <+> text "type pattern"
961 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
962 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
965 -- This data decl will parse OK
967 -- treating "a" as the constructor.
968 -- It is really hard to make the parser spot this malformation.
969 -- So the renamer has to check that the constructor is legal
971 -- We can get an operator as the constructor, even in the prefix form:
972 -- data T = :% Int Int
973 -- from interface files, which always print in prefix form
975 checkConName :: RdrName -> TcRn ()
976 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
978 badDataCon :: RdrName -> SDoc
980 = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
984 %*********************************************************
986 \subsection{Support code for type/data declarations}
988 %*********************************************************
990 Get the mapping from constructors to fields for this module.
991 It's convenient to do this after the data type decls have been renamed
993 extendRecordFieldEnv :: [LTyClDecl RdrName] -> TcM TcGblEnv
994 extendRecordFieldEnv decls
995 = do { tcg_env <- getGblEnv
996 ; field_env' <- foldrM get (tcg_field_env tcg_env) decls
997 ; return (tcg_env { tcg_field_env = field_env' }) }
999 -- we want to lookup:
1000 -- (a) a datatype constructor
1001 -- (b) a record field
1002 -- knowing that they're from this module.
1003 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1004 -- which keeps only the local ones.
1005 lookup x = do { x' <- lookupLocatedTopBndrRn x
1006 ; return $ unLoc x'}
1008 get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
1009 get _ env = return env
1011 get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
1012 = do { con' <- lookup con
1013 ; flds' <- mappM lookup (map cd_fld_name flds)
1014 ; return $ extendNameEnv env con' flds' }
1019 %*********************************************************
1021 \subsection{Support code to rename types}
1023 %*********************************************************
1026 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1029 = mappM (wrapLocM rn_fds) fds
1032 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1033 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1034 returnM (tys1', tys2')
1036 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1037 rnHsTyVars doc tvs = mappM (rnHsTyVar doc) tvs
1039 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1040 rnHsTyVar _doc tyvar = lookupOccRn tyvar
1044 %*********************************************************
1048 %*********************************************************
1054 h = ...$(thing "f")...
1056 The splice can expand into literally anything, so when we do dependency
1057 analysis we must assume that it might mention 'f'. So we simply treat
1058 all locally-defined names as mentioned by any splice. This is terribly
1059 brutal, but I don't see what else to do. For example, it'll mean
1060 that every locally-defined thing will appear to be used, so no unused-binding
1061 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
1062 and that will crash the type checker because 'f' isn't in scope.
1064 Currently, I'm not treating a splice as also mentioning every import,
1065 which is a bit inconsistent -- but there are a lot of them. We might
1066 thereby get some bogus unused-import warnings, but we won't crash the
1067 type checker. Not very satisfactory really.
1070 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
1071 rnSplice (HsSplice n expr)
1072 = do { checkTH expr "splice"
1073 ; loc <- getSrcSpanM
1074 ; [n'] <- newLocalsRn [L loc n]
1075 ; (expr', fvs) <- rnLExpr expr
1077 -- Ugh! See Note [Splices] above
1078 ; lcl_rdr <- getLocalRdrEnv
1079 ; gbl_rdr <- getGlobalRdrEnv
1080 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
1082 lcl_names = mkNameSet (occEnvElts lcl_rdr)
1084 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
1086 checkTH :: Outputable a => a -> String -> RnM ()
1088 checkTH _ _ = returnM () -- OK
1090 checkTH e what -- Raise an error in a stage-1 compiler
1091 = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>
1092 ptext (sLit "illegal in a stage-1 compiler"),