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 ( Warnings(..), plusWarns )
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_warnds = warn_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_warns <- rnSrcWarnDecls warn_decls ;
174 -- (H) Rename Everything else
176 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
177 (rn_rule_decls, src_fvs3) <- setOptM Opt_ScopedTypeVariables $
178 rnList rnHsRuleDecl rule_decls ;
179 -- Inside RULES, scoped type variables are on
180 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
181 (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ;
182 (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ;
183 -- Haddock docs; no free vars
184 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
186 -- (I) Compute the results and return
187 let {rn_group = HsGroup { hs_valds = rn_val_decls,
188 hs_tyclds = rn_tycl_decls,
189 hs_instds = rn_inst_decls,
190 hs_derivds = rn_deriv_decls,
191 hs_fixds = rn_fix_decls,
192 hs_warnds = [], -- warns are returned in the tcg_env
193 -- (see below) not in the HsGroup
194 hs_fords = rn_foreign_decls,
195 hs_defds = rn_default_decls,
196 hs_ruleds = rn_rule_decls,
197 hs_docs = rn_docs } ;
199 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
200 src_fvs4, src_fvs5] ;
201 src_dus = bind_dus `plusDU` usesOnly other_fvs;
202 -- Note: src_dus will contain *uses* for locally-defined types
203 -- and classes, but no *defs* for them. (Because rnTyClDecl
204 -- returns only the uses.) This is a little
205 -- surprising but it doesn't actually matter at all.
207 final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
208 in -- we return the deprecs in the env, not in the HsGroup above
209 tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
212 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
213 traceRn (text "finish Dus" <+> ppr src_dus ) ;
214 return (final_tcg_env , rn_group)
217 -- some utils because we do this a bunch above
218 -- compute and install the new env
219 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
220 inNewEnv env cont = do e <- env
223 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
224 -- Used for external core
225 rnTyClDecls tycl_decls = do (decls', _fvs) <- rnList rnTyClDecl tycl_decls
228 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
229 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
231 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
232 rnList f xs = mapFvRn (wrapLocFstM f) xs
236 %*********************************************************
240 %*********************************************************
243 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
244 rnDocDecl (DocCommentNext doc) = do
245 rn_doc <- rnHsDoc doc
246 return (DocCommentNext rn_doc)
247 rnDocDecl (DocCommentPrev doc) = do
248 rn_doc <- rnHsDoc doc
249 return (DocCommentPrev rn_doc)
250 rnDocDecl (DocCommentNamed str doc) = do
251 rn_doc <- rnHsDoc doc
252 return (DocCommentNamed str rn_doc)
253 rnDocDecl (DocGroup lev doc) = do
254 rn_doc <- rnHsDoc doc
255 return (DocGroup lev rn_doc)
259 %*********************************************************
261 Source-code fixity declarations
263 %*********************************************************
266 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
267 -- Rename the fixity decls, so we can put
268 -- the renamed decls in the renamed syntax tree
269 -- Errors if the thing being fixed is not defined locally.
271 -- The returned FixitySigs are not actually used for anything,
272 -- except perhaps the GHCi API
273 rnSrcFixityDecls fix_decls
274 = do fix_decls <- mapM rn_decl fix_decls
275 return (concat fix_decls)
277 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
278 -- GHC extension: look up both the tycon and data con
279 -- for con-like things; hence returning a list
280 -- If neither are in scope, report an error; otherwise
281 -- return a fixity sig for each (slightly odd)
282 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
283 = setSrcSpan name_loc $
284 -- this lookup will fail if the definition isn't local
285 do names <- lookupLocalDataTcNames rdr_name
286 return [ L loc (FixitySig (L name_loc name) fixity)
291 %*********************************************************
293 Source-code deprecations declarations
295 %*********************************************************
297 Check that the deprecated names are defined, are defined locally, and
298 that there are no duplicate deprecations.
300 It's only imported deprecations, dealt with in RnIfaces, that we
301 gather them together.
304 -- checks that the deprecations are defined locally, and that there are no duplicates
305 rnSrcWarnDecls :: [LWarnDecl RdrName] -> RnM Warnings
310 = do { -- check for duplicates
311 ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups
312 ; mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
313 returnM (WarnSome ((concat pairs_s))) }
315 rn_deprec (Warning rdr_name txt)
316 -- ensures that the names are defined locally
317 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
318 returnM [(nameOccName name, txt) | name <- names]
320 -- look for duplicates among the OccNames;
321 -- we check that the names are defined above
322 -- invt: the lists returned by findDupsEq always have at least two elements
323 warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
324 (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
326 dupWarnDecl :: Located RdrName -> RdrName -> SDoc
327 -- Located RdrName -> DeprecDecl RdrName -> SDoc
328 dupWarnDecl (L loc _) rdr_name
329 = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
330 ptext (sLit "also at ") <+> ppr loc]
334 %*********************************************************
336 \subsection{Source code declarations}
338 %*********************************************************
341 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
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 :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
357 rnHsForeignDecl (ForeignImport name ty spec)
358 = lookupLocatedTopBndrRn name `thenM` \ name' ->
359 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
360 returnM (ForeignImport name' ty' spec, fvs)
362 rnHsForeignDecl (ForeignExport name ty spec)
363 = lookupLocatedOccRn name `thenM` \ name' ->
364 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
365 returnM (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
366 -- NB: a foreign export is an *occurrence site* for name, so
367 -- we add it to the free-variable list. It might, for example,
368 -- be imported from another module
370 fo_decl_msg :: Located RdrName -> SDoc
371 fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
375 %*********************************************************
377 \subsection{Instance declarations}
379 %*********************************************************
382 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
383 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
384 -- Used for both source and interface file decls
385 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
387 -- Rename the bindings
388 -- The typechecker (not the renamer) checks that all
389 -- the bindings are for the right class
391 meth_doc = text "In the bindings in an instance declaration"
392 meth_names = collectHsBindLocatedBinders mbinds
393 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
395 checkDupRdrNames meth_doc meth_names `thenM_`
396 -- Check that the same method is not given twice in the
397 -- same instance decl instance C T where
401 -- We must use checkDupRdrNames because the Name of the
402 -- method is the Name of the class selector, whose SrcSpan
403 -- points to the class declaration
405 extendTyVarEnvForMethodBinds inst_tyvars (
406 -- (Slightly strangely) the forall-d tyvars scope over
407 -- the method bindings too
408 rnMethodBinds cls (\_ -> []) -- No scoped tyvars
410 ) `thenM` \ (mbinds', meth_fvs) ->
411 -- Rename the associated types
412 -- The typechecker (not the renamer) checks that all
413 -- the declarations are for the right class
415 at_doc = text "In the associated types of an instance declaration"
416 at_names = map (head . tyClDeclNames . unLoc) ats
418 checkDupRdrNames at_doc at_names `thenM_`
419 -- See notes with checkDupRdrNames for methods, above
421 rnATInsts ats `thenM` \ (ats', at_fvs) ->
423 -- Rename the prags and signatures.
424 -- Note that the type variables are not in scope here,
425 -- so that instance Eq a => Eq (T a) where
426 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
429 -- But the (unqualified) method names are in scope
431 binders = collectHsBindBinders mbinds'
432 bndr_set = mkNameSet binders
434 bindLocalNames binders
435 (renameSigs (Just bndr_set) okInstDclSig uprags) `thenM` \ uprags' ->
437 returnM (InstDecl inst_ty' mbinds' uprags' ats',
438 meth_fvs `plusFV` at_fvs
439 `plusFV` hsSigsFVs uprags'
440 `plusFV` extractHsTyNames inst_ty')
441 -- We return the renamed associated data type declarations so
442 -- that they can be entered into the list of type declarations
443 -- for the binding group, but we also keep a copy in the instance.
444 -- The latter is needed for well-formedness checks in the type
445 -- checker (eg, to ensure that all ATs of the instance actually
446 -- receive a declaration).
447 -- NB: Even the copies in the instance declaration carry copies of
448 -- the instance context after renaming. This is a bit
449 -- strange, but should not matter (and it would be more work
450 -- to remove the context).
453 Renaming of the associated types in instances.
456 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
457 rnATInsts atDecls = rnList rnATInst atDecls
459 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
460 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
462 pprPanic "RnSource.rnATInsts: invalid AT instance"
463 (ppr (tcdName tydecl))
466 For the method bindings in class and instance decls, we extend the
467 type variable environment iff -fglasgow-exts
470 extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
471 -> RnM (Bag (LHsBind Name), FreeVars)
472 -> RnM (Bag (LHsBind Name), FreeVars)
473 extendTyVarEnvForMethodBinds tyvars thing_inside
474 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
476 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
481 %*********************************************************
483 \subsection{Stand-alone deriving declarations}
485 %*********************************************************
488 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
489 rnSrcDerivDecl (DerivDecl ty)
490 = do ty' <- rnLHsType (text "a deriving decl") ty
491 let fvs = extractHsTyNames ty'
492 return (DerivDecl ty', fvs)
495 %*********************************************************
499 %*********************************************************
502 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
503 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
504 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
505 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
506 do { (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
507 -- NB: The binders in a rule are always Ids
508 -- We don't (yet) support type variables
510 ; (lhs', fv_lhs') <- rnLExpr lhs
511 ; (rhs', fv_rhs') <- rnLExpr rhs
513 ; checkValidRule rule_name ids lhs' fv_lhs'
515 ; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
516 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
518 doc = text "In the transformation rule" <+> ftext rule_name
520 get_var (RuleBndr v) = v
521 get_var (RuleBndrSig v _) = v
523 rn_var (RuleBndr (L loc _), id)
524 = returnM (RuleBndr (L loc id), emptyFVs)
525 rn_var (RuleBndrSig (L loc _) t, id)
526 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
527 returnM (RuleBndrSig (L loc id) t', fvs)
529 badRuleVar :: FastString -> Name -> SDoc
531 = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
532 ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
533 ptext (sLit "does not appear on left hand side")]
536 Note [Rule LHS validity checking]
537 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
538 Check the shape of a transformation rule LHS. Currently we only allow
539 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
540 @forall@'d variables.
542 We used restrict the form of the 'ei' to prevent you writing rules
543 with LHSs with a complicated desugaring (and hence unlikely to match);
544 (e.g. a case expression is not allowed: too elaborate.)
546 But there are legitimate non-trivial args ei, like sections and
547 lambdas. So it seems simmpler not to check at all, and that is why
548 check_e is commented out.
551 checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
552 checkValidRule rule_name ids lhs' fv_lhs'
553 = do { -- Check for the form of the LHS
554 case (validRuleLhs ids lhs') of
556 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
558 -- Check that LHS vars are all bound
559 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
560 ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
562 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
564 -- Just e => Not ok, and e is the offending expression
565 validRuleLhs foralls lhs
568 checkl (L _ e) = check e
570 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
571 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
572 check (HsVar v) | v `notElem` foralls = Nothing
573 check other = Just other -- Failure
576 checkl_e (L _ _e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
578 {- Commented out; see Note [Rule LHS validity checking] above
579 check_e (HsVar v) = Nothing
580 check_e (HsPar e) = checkl_e e
581 check_e (HsLit e) = Nothing
582 check_e (HsOverLit e) = Nothing
584 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
585 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
586 check_e (NegApp e _) = checkl_e e
587 check_e (ExplicitList _ es) = checkl_es es
588 check_e (ExplicitTuple es _) = checkl_es es
589 check_e other = Just other -- Fails
591 checkl_es es = foldr (mplus . checkl_e) Nothing es
594 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
595 badRuleLhsErr name lhs bad_e
596 = sep [ptext (sLit "Rule") <+> ftext name <> colon,
597 nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
598 ptext (sLit "in left-hand side:") <+> ppr lhs])]
600 ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
604 %*********************************************************
606 \subsection{Type, class and iface sig declarations}
608 %*********************************************************
610 @rnTyDecl@ uses the `global name function' to create a new type
611 declaration in which local names have been replaced by their original
612 names, reporting any unknown names.
614 Renaming type variables is a pain. Because they now contain uniques,
615 it is necessary to pass in an association list which maps a parsed
616 tyvar to its @Name@ representation.
617 In some cases (type signatures of values),
618 it is even necessary to go over the type first
619 in order to get the set of tyvars used by it, make an assoc list,
620 and then go over it again to rename the tyvars!
621 However, we can also do some scoping checks at the same time.
624 rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
625 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
626 = lookupLocatedTopBndrRn name `thenM` \ name' ->
627 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
630 -- all flavours of type family declarations ("type family", "newtype fanily",
631 -- and "data family")
632 rnTyClDecl (tydecl@TyFamily {}) =
633 rnFamily tydecl bindTyVarsRn
635 -- "data", "newtype", "data instance, and "newtype instance" declarations
636 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
637 tcdLName = tycon, tcdTyVars = tyvars,
638 tcdTyPats = typatsMaybe, tcdCons = condecls,
639 tcdKindSig = sig, tcdDerivs = derivs})
640 | is_vanilla -- Normal Haskell data type decl
641 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
642 -- data type is syntactically illegal
643 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
644 do { tycon' <- if isFamInstDecl tydecl
645 then lookupLocatedOccRn tycon -- may be imported family
646 else lookupLocatedTopBndrRn tycon
647 ; context' <- rnContext data_doc context
648 ; typats' <- rnTyPats data_doc typatsMaybe
649 ; (derivs', deriv_fvs) <- rn_derivs derivs
650 ; condecls' <- rnConDecls (unLoc tycon') condecls
651 -- No need to check for duplicate constructor decls
652 -- since that is done by RnNames.extendGlobalRdrEnvRn
653 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
654 tcdLName = tycon', tcdTyVars = tyvars',
655 tcdTyPats = typats', tcdKindSig = Nothing,
656 tcdCons = condecls', tcdDerivs = derivs'},
657 delFVs (map hsLTyVarName tyvars') $
658 extractHsCtxtTyNames context' `plusFV`
659 plusFVs (map conDeclFVs condecls') `plusFV`
661 (if isFamInstDecl tydecl
662 then unitFV (unLoc tycon') -- type instance => use
667 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
668 do { tycon' <- if isFamInstDecl tydecl
669 then lookupLocatedOccRn tycon -- may be imported family
670 else lookupLocatedTopBndrRn tycon
671 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
672 ; tyvars' <- bindTyVarsRn data_doc tyvars
673 (\ tyvars' -> return tyvars')
674 -- For GADTs, the type variables in the declaration
675 -- do not scope over the constructor signatures
676 -- data T a where { T1 :: forall b. b-> b }
677 ; (derivs', deriv_fvs) <- rn_derivs derivs
678 ; condecls' <- rnConDecls (unLoc tycon') condecls
679 -- No need to check for duplicate constructor decls
680 -- since that is done by RnNames.extendGlobalRdrEnvRn
681 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
682 tcdLName = tycon', tcdTyVars = tyvars',
683 tcdTyPats = Nothing, tcdKindSig = sig,
684 tcdCons = condecls', tcdDerivs = derivs'},
685 plusFVs (map conDeclFVs condecls') `plusFV`
687 (if isFamInstDecl tydecl
688 then unitFV (unLoc tycon') -- type instance => use
692 is_vanilla = case condecls of -- Yuk
694 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
698 none (Just []) = True
701 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
703 rn_derivs Nothing = returnM (Nothing, emptyFVs)
704 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
705 returnM (Just ds', extractHsTyNames_s ds')
707 -- "type" and "type instance" declarations
708 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
709 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
710 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
711 do { name' <- if isFamInstDecl tydecl
712 then lookupLocatedOccRn name -- may be imported family
713 else lookupLocatedTopBndrRn name
714 ; typats' <- rnTyPats syn_doc typatsMaybe
715 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
716 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
717 tcdTyPats = typats', tcdSynRhs = ty'},
718 delFVs (map hsLTyVarName tyvars') $
720 (if isFamInstDecl tydecl
721 then unitFV (unLoc name') -- type instance => use
725 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
727 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
728 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
729 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
730 = do { cname' <- lookupLocatedTopBndrRn cname
732 -- Tyvars scope over superclass context and method signatures
733 ; (tyvars', context', fds', ats', ats_fvs, sigs')
734 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
735 { context' <- rnContext cls_doc context
736 ; fds' <- rnFds cls_doc fds
737 ; (ats', ats_fvs) <- rnATs ats
738 ; sigs' <- renameSigs Nothing okClsDclSig sigs
739 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
741 -- No need to check for duplicate associated type decls
742 -- since that is done by RnNames.extendGlobalRdrEnvRn
744 -- Check the signatures
745 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
746 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
747 ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
748 -- Typechecker is responsible for checking that we only
749 -- give default-method bindings for things in this class.
750 -- The renamer *could* check this for class decls, but can't
751 -- for instance decls.
753 -- The newLocals call is tiresome: given a generic class decl
756 -- op {| x+y |} (Inl a) = ...
757 -- op {| x+y |} (Inr b) = ...
758 -- op {| a*b |} (a*b) = ...
759 -- we want to name both "x" tyvars with the same unique, so that they are
760 -- easy to group together in the typechecker.
761 ; (mbinds', meth_fvs)
762 <- extendTyVarEnvForMethodBinds tyvars' $ do
763 { name_env <- getLocalRdrEnv
764 ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
765 not (unLoc tv `elemLocalRdrEnv` name_env) ]
766 -- No need to check for duplicate method signatures
767 -- since that is done by RnNames.extendGlobalRdrEnvRn
768 -- and the methods are already in scope
769 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
770 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
773 ; docs' <- mapM (wrapLocM rnDocDecl) docs
775 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
776 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
777 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
779 delFVs (map hsLTyVarName tyvars') $
780 extractHsCtxtTyNames context' `plusFV`
781 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
782 hsSigsFVs sigs' `plusFV`
786 cls_doc = text "In the declaration for class" <+> ppr cname
787 sig_doc = text "In the signatures for class" <+> ppr cname
789 badGadtStupidTheta :: Located RdrName -> SDoc
791 = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
792 ptext (sLit "(You can put a context on each contructor, though.)")]
795 %*********************************************************
797 \subsection{Support code for type/data declarations}
799 %*********************************************************
802 -- Although, we are processing type patterns here, all type variables will
803 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
804 -- type declaration to which these patterns belong)
806 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
807 rnTyPats _ Nothing = return Nothing
808 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
810 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
811 rnConDecls _tycon condecls
812 = mappM (wrapLocM rnConDecl) condecls
814 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
815 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
816 = do { addLocM checkConName name
818 ; new_name <- lookupLocatedTopBndrRn name
819 ; name_env <- getLocalRdrEnv
821 -- For H98 syntax, the tvs are the existential ones
822 -- For GADT syntax, the tvs are all the quantified tyvars
823 -- Hence the 'filter' in the ResTyH98 case only
824 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
825 arg_tys = hsConDeclArgTys details
826 implicit_tvs = case res_ty of
827 ResTyH98 -> filter not_in_scope $
829 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
832 Implicit -> userHsTyVarBndrs implicit_tvs
834 ; mb_doc' <- rnMbLHsDoc mb_doc
836 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
837 { new_context <- rnContext doc cxt
838 ; new_details <- rnConDeclDetails doc details
839 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
840 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
842 doc = text "In the definition of data constructor" <+> quotes (ppr name)
843 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
846 -> HsConDetails (LHsType Name) [ConDeclField Name]
848 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
850 rnConResult _ details ResTyH98 = return (details, ResTyH98)
852 rnConResult doc details (ResTyGADT ty) = do
853 ty' <- rnHsSigType doc ty
854 let (arg_tys, res_ty) = splitHsFunType ty'
855 -- We can split it up, now the renamer has dealt with fixities
857 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
858 RecCon _ -> return (details, ResTyGADT ty')
859 InfixCon {} -> panic "rnConResult"
861 rnConDeclDetails :: SDoc
862 -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
863 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
864 rnConDeclDetails doc (PrefixCon tys)
865 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
866 returnM (PrefixCon new_tys)
868 rnConDeclDetails doc (InfixCon ty1 ty2)
869 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
870 rnLHsType doc ty2 `thenM` \ new_ty2 ->
871 returnM (InfixCon new_ty1 new_ty2)
873 rnConDeclDetails doc (RecCon fields)
874 = do { new_fields <- mappM (rnField doc) fields
875 -- No need to check for duplicate fields
876 -- since that is done by RnNames.extendGlobalRdrEnvRn
877 ; return (RecCon new_fields) }
879 rnField :: SDoc -> ConDeclField RdrName -> RnM (ConDeclField Name)
880 rnField doc (ConDeclField name ty haddock_doc)
881 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
882 rnLHsType doc ty `thenM` \ new_ty ->
883 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
884 returnM (ConDeclField new_name new_ty new_haddock_doc)
886 -- Rename family declarations
888 -- * This function is parametrised by the routine handling the index
889 -- variables. On the toplevel, these are defining occurences, whereas they
890 -- are usage occurences for associated types.
892 rnFamily :: TyClDecl RdrName
893 -> (SDoc -> [LHsTyVarBndr RdrName] ->
894 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
895 RnM (TyClDecl Name, FreeVars))
896 -> RnM (TyClDecl Name, FreeVars)
898 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
899 tcdLName = tycon, tcdTyVars = tyvars})
901 do { checkM (isDataFlavour flavour -- for synonyms,
902 || not (null tyvars)) $ addErr needOneIdx -- no. of indexes >= 1
903 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
904 ; tycon' <- lookupLocatedTopBndrRn tycon
905 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
906 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
910 isDataFlavour DataFamily = True
911 isDataFlavour _ = False
912 rnFamily d _ = pprPanic "rnFamily" (ppr d)
914 family_doc :: Located RdrName -> SDoc
915 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
918 needOneIdx = text "Type family declarations requires at least one type index"
920 -- Rename associated type declarations (in classes)
922 -- * This can be family declarations and (default) type instances
924 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
925 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
927 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
928 rn_at (tydecl@TySynonym {}) =
930 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
932 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
934 lookupIdxVars _ tyvars cont =
935 do { checkForDups tyvars;
936 ; tyvars' <- mappM lookupIdxVar tyvars
939 -- Type index variables must be class parameters, which are the only
940 -- type variables in scope at this point.
941 lookupIdxVar (L l tyvar) =
943 name' <- lookupOccRn (hsTyVarName tyvar)
944 return $ L l (replaceTyVarName tyvar name')
946 -- Type variable may only occur once.
948 checkForDups [] = return ()
949 checkForDups (L loc tv:ltvs) =
950 do { setSrcSpan loc $
951 when (hsTyVarName tv `ltvElem` ltvs) $
952 addErr (repeatedTyVar tv)
956 _ `ltvElem` [] = False
957 rdrName `ltvElem` (L _ tv:ltvs)
958 | rdrName == hsTyVarName tv = True
959 | otherwise = rdrName `ltvElem` ltvs
962 noPatterns = text "Default definition for an associated synonym cannot have"
963 <+> text "type pattern"
965 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
966 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
969 -- This data decl will parse OK
971 -- treating "a" as the constructor.
972 -- It is really hard to make the parser spot this malformation.
973 -- So the renamer has to check that the constructor is legal
975 -- We can get an operator as the constructor, even in the prefix form:
976 -- data T = :% Int Int
977 -- from interface files, which always print in prefix form
979 checkConName :: RdrName -> TcRn ()
980 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
982 badDataCon :: RdrName -> SDoc
984 = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
988 %*********************************************************
990 \subsection{Support code for type/data declarations}
992 %*********************************************************
994 Get the mapping from constructors to fields for this module.
995 It's convenient to do this after the data type decls have been renamed
997 extendRecordFieldEnv :: [LTyClDecl RdrName] -> TcM TcGblEnv
998 extendRecordFieldEnv decls
999 = do { tcg_env <- getGblEnv
1000 ; field_env' <- foldrM get (tcg_field_env tcg_env) decls
1001 ; return (tcg_env { tcg_field_env = field_env' }) }
1003 -- we want to lookup:
1004 -- (a) a datatype constructor
1005 -- (b) a record field
1006 -- knowing that they're from this module.
1007 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1008 -- which keeps only the local ones.
1009 lookup x = do { x' <- lookupLocatedTopBndrRn x
1010 ; return $ unLoc x'}
1012 get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
1013 get _ env = return env
1015 get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
1016 = do { con' <- lookup con
1017 ; flds' <- mappM lookup (map cd_fld_name flds)
1018 ; return $ extendNameEnv env con' flds' }
1023 %*********************************************************
1025 \subsection{Support code to rename types}
1027 %*********************************************************
1030 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1033 = mappM (wrapLocM rn_fds) fds
1036 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1037 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1038 returnM (tys1', tys2')
1040 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1041 rnHsTyVars doc tvs = mappM (rnHsTyVar doc) tvs
1043 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1044 rnHsTyVar _doc tyvar = lookupOccRn tyvar
1048 %*********************************************************
1052 %*********************************************************
1058 h = ...$(thing "f")...
1060 The splice can expand into literally anything, so when we do dependency
1061 analysis we must assume that it might mention 'f'. So we simply treat
1062 all locally-defined names as mentioned by any splice. This is terribly
1063 brutal, but I don't see what else to do. For example, it'll mean
1064 that every locally-defined thing will appear to be used, so no unused-binding
1065 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
1066 and that will crash the type checker because 'f' isn't in scope.
1068 Currently, I'm not treating a splice as also mentioning every import,
1069 which is a bit inconsistent -- but there are a lot of them. We might
1070 thereby get some bogus unused-import warnings, but we won't crash the
1071 type checker. Not very satisfactory really.
1074 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
1075 rnSplice (HsSplice n expr)
1076 = do { checkTH expr "splice"
1077 ; loc <- getSrcSpanM
1078 ; [n'] <- newLocalsRn [L loc n]
1079 ; (expr', fvs) <- rnLExpr expr
1081 -- Ugh! See Note [Splices] above
1082 ; lcl_rdr <- getLocalRdrEnv
1083 ; gbl_rdr <- getGlobalRdrEnv
1084 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
1086 lcl_names = mkNameSet (occEnvElts lcl_rdr)
1088 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
1090 checkTH :: Outputable a => a -> String -> RnM ()
1092 checkTH _ _ = returnM () -- OK
1094 checkTH e what -- Raise an error in a stage-1 compiler
1095 = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>
1096 ptext (sLit "illegal in a stage-1 compiler"),