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(..), availsToNameSet )
34 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
37 import HscTypes ( Warnings(..), plusWarns )
38 import Class ( FunDep )
39 import Name ( Name, nameOccName )
47 import DynFlags ( DynFlag(..) )
48 import Maybe ( isNothing )
49 import BasicTypes ( Boxity(..) )
51 import ListSetOps (findDupsEq)
59 thenM :: Monad a => a b -> (b -> a c) -> a c
62 thenM_ :: Monad a => a b -> a c -> a c
65 returnM :: Monad m => a -> m a
68 mappM :: (Monad m) => (a -> m b) -> [a] -> m [b]
71 mappM_ :: (Monad m) => (a -> m b) -> [a] -> m ()
74 checkM :: Monad m => Bool -> m () -> m ()
78 @rnSourceDecl@ `renames' declarations.
79 It simultaneously performs dependency analysis and precedence parsing.
80 It also does the following error checks:
83 Checks that tyvars are used properly. This includes checking
84 for undefined tyvars, and tyvars in contexts that are ambiguous.
85 (Some of this checking has now been moved to module @TcMonoType@,
86 since we don't have functional dependency information at this point.)
88 Checks that all variable occurences are defined.
90 Checks the @(..)@ etc constraints in the export list.
95 -- Brings the binders of the group into scope in the appropriate places;
96 -- does NOT assume that anything is in scope already
97 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
98 -- Rename a HsGroup; used for normal source files *and* hs-boot files
99 rnSrcDecls group@(HsGroup {hs_valds = val_decls,
100 hs_tyclds = tycl_decls,
101 hs_instds = inst_decls,
102 hs_derivds = deriv_decls,
103 hs_fixds = fix_decls,
104 hs_warnds = warn_decls,
105 hs_fords = foreign_decls,
106 hs_defds = default_decls,
107 hs_ruleds = rule_decls,
110 -- (A) Process the fixity declarations, creating a mapping from
111 -- FastStrings to FixItems.
112 -- Also checks for duplcates.
113 local_fix_env <- makeMiniFixityEnv fix_decls;
115 -- (B) Bring top level binders (and their fixities) into scope,
116 -- *except* for the value bindings, which get brought in below.
117 -- However *do* include class ops, data constructors
118 -- And for hs-boot files *do* include the value signatures
119 tc_avails <- getLocalNonValBinders group ;
120 tc_envs <- extendGlobalRdrEnvRn tc_avails local_fix_env ;
121 setEnvs tc_envs $ do {
123 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
125 -- (C) Extract the mapping from data constructors to field names and
126 -- extend the record field env.
127 -- This depends on the data constructors and field names being in
128 -- scope from (B) above
129 inNewEnv (extendRecordFieldEnv tycl_decls) $ \ _ -> do {
131 -- (D) Rename the left-hand sides of the value bindings.
132 -- This depends on everything from (B) being in scope,
133 -- and on (C) for resolving record wild cards.
134 -- It uses the fixity env from (A) to bind fixities for view patterns.
135 new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
136 -- bind the LHSes (and their fixities) in the global rdr environment
137 let { val_binders = map unLoc $ collectHsValBinders new_lhs ;
138 val_bndr_set = mkNameSet val_binders ;
139 all_bndr_set = val_bndr_set `unionNameSets` availsToNameSet tc_avails ;
140 val_avails = map Avail val_binders
142 (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
143 setEnvs (tcg_env, tcl_env) $ do {
145 -- Now everything is in scope, as the remaining renaming assumes.
147 -- (E) Rename type and class decls
148 -- (note that value LHSes need to be in scope for default methods)
150 -- You might think that we could build proper def/use information
151 -- for type and class declarations, but they can be involved
152 -- in mutual recursion across modules, and we only do the SCC
153 -- analysis for them in the type checker.
154 -- So we content ourselves with gathering uses only; that
155 -- means we'll only report a declaration as unused if it isn't
156 -- mentioned at all. Ah well.
157 traceRn (text "Start rnTyClDecls") ;
158 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
160 -- (F) Rename Value declarations right-hand sides
161 traceRn (text "Start rnmono") ;
162 (rn_val_decls, bind_dus) <- rnTopBindsRHS val_bndr_set new_lhs ;
163 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
165 -- (G) Rename Fixity and deprecations
167 -- Rename fixity declarations and error if we try to
168 -- fix something from another module (duplicates were checked in (A))
169 rn_fix_decls <- rnSrcFixityDecls all_bndr_set fix_decls ;
171 -- Rename deprec decls;
172 -- check for duplicates and ensure that deprecated things are defined locally
173 -- at the moment, we don't keep these around past renaming
174 rn_warns <- rnSrcWarnDecls all_bndr_set warn_decls ;
176 -- (H) Rename Everything else
178 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
179 (rn_rule_decls, src_fvs3) <- setOptM Opt_ScopedTypeVariables $
180 rnList rnHsRuleDecl rule_decls ;
181 -- Inside RULES, scoped type variables are on
182 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
183 (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ;
184 (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ;
185 -- Haddock docs; no free vars
186 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
188 -- (I) Compute the results and return
189 let {rn_group = HsGroup { hs_valds = rn_val_decls,
190 hs_tyclds = rn_tycl_decls,
191 hs_instds = rn_inst_decls,
192 hs_derivds = rn_deriv_decls,
193 hs_fixds = rn_fix_decls,
194 hs_warnds = [], -- warns are returned in the tcg_env
195 -- (see below) not in the HsGroup
196 hs_fords = rn_foreign_decls,
197 hs_defds = rn_default_decls,
198 hs_ruleds = rn_rule_decls,
199 hs_docs = rn_docs } ;
201 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
202 src_fvs4, src_fvs5] ;
203 src_dus = bind_dus `plusDU` usesOnly other_fvs;
204 -- Note: src_dus will contain *uses* for locally-defined types
205 -- and classes, but no *defs* for them. (Because rnTyClDecl
206 -- returns only the uses.) This is a little
207 -- surprising but it doesn't actually matter at all.
209 final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
210 in -- we return the deprecs in the env, not in the HsGroup above
211 tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
214 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
215 traceRn (text "finish Dus" <+> ppr src_dus ) ;
216 return (final_tcg_env , rn_group)
219 -- some utils because we do this a bunch above
220 -- compute and install the new env
221 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
222 inNewEnv env cont = do e <- env
225 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
226 -- Used for external core
227 rnTyClDecls tycl_decls = do (decls', _fvs) <- rnList rnTyClDecl tycl_decls
230 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
231 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
233 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
234 rnList f xs = mapFvRn (wrapLocFstM f) xs
238 %*********************************************************
242 %*********************************************************
245 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
246 rnDocDecl (DocCommentNext doc) = do
247 rn_doc <- rnHsDoc doc
248 return (DocCommentNext rn_doc)
249 rnDocDecl (DocCommentPrev doc) = do
250 rn_doc <- rnHsDoc doc
251 return (DocCommentPrev rn_doc)
252 rnDocDecl (DocCommentNamed str doc) = do
253 rn_doc <- rnHsDoc doc
254 return (DocCommentNamed str rn_doc)
255 rnDocDecl (DocGroup lev doc) = do
256 rn_doc <- rnHsDoc doc
257 return (DocGroup lev rn_doc)
261 %*********************************************************
263 Source-code fixity declarations
265 %*********************************************************
268 rnSrcFixityDecls :: NameSet -> [LFixitySig RdrName] -> RnM [LFixitySig Name]
269 -- Rename the fixity decls, so we can put
270 -- the renamed decls in the renamed syntax tree
271 -- Errors if the thing being fixed is not defined locally.
273 -- The returned FixitySigs are not actually used for anything,
274 -- except perhaps the GHCi API
275 rnSrcFixityDecls bound_names fix_decls
276 = do fix_decls <- mapM rn_decl fix_decls
277 return (concat fix_decls)
279 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
280 -- GHC extension: look up both the tycon and data con
281 -- for con-like things; hence returning a list
282 -- If neither are in scope, report an error; otherwise
283 -- return a fixity sig for each (slightly odd)
284 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
285 = setSrcSpan name_loc $
286 -- this lookup will fail if the definition isn't local
287 do names <- lookupLocalDataTcNames bound_names what rdr_name
288 return [ L loc (FixitySig (L name_loc name) fixity)
290 what = ptext (sLit "fixity signature")
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 rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
309 rnSrcWarnDecls _bound_names []
312 rnSrcWarnDecls bound_names decls
313 = do { -- check for duplicates
314 ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups
315 ; mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
316 returnM (WarnSome ((concat pairs_s))) }
318 rn_deprec (Warning rdr_name txt)
319 -- ensures that the names are defined locally
320 = lookupLocalDataTcNames bound_names what rdr_name `thenM` \ names ->
321 returnM [(nameOccName name, txt) | name <- names]
323 what = ptext (sLit "deprecation")
325 -- look for duplicates among the OccNames;
326 -- we check that the names are defined above
327 -- invt: the lists returned by findDupsEq always have at least two elements
328 warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
329 (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
331 dupWarnDecl :: Located RdrName -> RdrName -> SDoc
332 -- Located RdrName -> DeprecDecl RdrName -> SDoc
333 dupWarnDecl (L loc _) rdr_name
334 = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
335 ptext (sLit "also at ") <+> ppr loc]
339 %*********************************************************
341 \subsection{Source code declarations}
343 %*********************************************************
346 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
347 rnDefaultDecl (DefaultDecl tys)
348 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
349 returnM (DefaultDecl tys', fvs)
351 doc_str = text "In a `default' declaration"
354 %*********************************************************
356 \subsection{Foreign declarations}
358 %*********************************************************
361 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
362 rnHsForeignDecl (ForeignImport name ty spec)
363 = lookupLocatedTopBndrRn name `thenM` \ name' ->
364 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
365 returnM (ForeignImport name' ty' spec, fvs)
367 rnHsForeignDecl (ForeignExport name ty spec)
368 = lookupLocatedOccRn name `thenM` \ name' ->
369 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
370 returnM (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
371 -- NB: a foreign export is an *occurrence site* for name, so
372 -- we add it to the free-variable list. It might, for example,
373 -- be imported from another module
375 fo_decl_msg :: Located RdrName -> SDoc
376 fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
380 %*********************************************************
382 \subsection{Instance declarations}
384 %*********************************************************
387 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
388 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
389 -- Used for both source and interface file decls
390 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
392 -- Rename the bindings
393 -- The typechecker (not the renamer) checks that all
394 -- the bindings are for the right class
396 meth_doc = text "In the bindings in an instance declaration"
397 meth_names = collectHsBindLocatedBinders mbinds
398 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
400 checkDupRdrNames meth_doc meth_names `thenM_`
401 -- Check that the same method is not given twice in the
402 -- same instance decl instance C T where
406 -- We must use checkDupRdrNames because the Name of the
407 -- method is the Name of the class selector, whose SrcSpan
408 -- points to the class declaration
410 extendTyVarEnvForMethodBinds inst_tyvars (
411 -- (Slightly strangely) the forall-d tyvars scope over
412 -- the method bindings too
413 rnMethodBinds cls (\_ -> []) -- No scoped tyvars
415 ) `thenM` \ (mbinds', meth_fvs) ->
416 -- Rename the associated types
417 -- The typechecker (not the renamer) checks that all
418 -- the declarations are for the right class
420 at_doc = text "In the associated types of an instance declaration"
421 at_names = map (head . tyClDeclNames . unLoc) ats
423 checkDupRdrNames at_doc at_names `thenM_`
424 -- See notes with checkDupRdrNames for methods, above
426 rnATInsts ats `thenM` \ (ats', at_fvs) ->
428 -- Rename the prags and signatures.
429 -- Note that the type variables are not in scope here,
430 -- so that instance Eq a => Eq (T a) where
431 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
434 -- But the (unqualified) method names are in scope
436 binders = collectHsBindBinders mbinds'
437 bndr_set = mkNameSet binders
439 bindLocalNames binders
440 (renameSigs (Just bndr_set) okInstDclSig uprags) `thenM` \ uprags' ->
442 returnM (InstDecl inst_ty' mbinds' uprags' ats',
443 meth_fvs `plusFV` at_fvs
444 `plusFV` hsSigsFVs uprags'
445 `plusFV` extractHsTyNames inst_ty')
446 -- We return the renamed associated data type declarations so
447 -- that they can be entered into the list of type declarations
448 -- for the binding group, but we also keep a copy in the instance.
449 -- The latter is needed for well-formedness checks in the type
450 -- checker (eg, to ensure that all ATs of the instance actually
451 -- receive a declaration).
452 -- NB: Even the copies in the instance declaration carry copies of
453 -- the instance context after renaming. This is a bit
454 -- strange, but should not matter (and it would be more work
455 -- to remove the context).
458 Renaming of the associated types in instances.
461 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
462 rnATInsts atDecls = rnList rnATInst atDecls
464 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
465 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
467 pprPanic "RnSource.rnATInsts: invalid AT instance"
468 (ppr (tcdName tydecl))
471 For the method bindings in class and instance decls, we extend the
472 type variable environment iff -fglasgow-exts
475 extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
476 -> RnM (Bag (LHsBind Name), FreeVars)
477 -> RnM (Bag (LHsBind Name), FreeVars)
478 extendTyVarEnvForMethodBinds tyvars thing_inside
479 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
481 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
486 %*********************************************************
488 \subsection{Stand-alone deriving declarations}
490 %*********************************************************
493 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
494 rnSrcDerivDecl (DerivDecl ty)
495 = do ty' <- rnLHsType (text "a deriving decl") ty
496 let fvs = extractHsTyNames ty'
497 return (DerivDecl ty', fvs)
500 %*********************************************************
504 %*********************************************************
507 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
508 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
509 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
510 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
511 do { (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
512 -- NB: The binders in a rule are always Ids
513 -- We don't (yet) support type variables
515 ; (lhs', fv_lhs') <- rnLExpr lhs
516 ; (rhs', fv_rhs') <- rnLExpr rhs
518 ; checkValidRule rule_name ids lhs' fv_lhs'
520 ; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
521 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
523 doc = text "In the transformation rule" <+> ftext rule_name
525 get_var (RuleBndr v) = v
526 get_var (RuleBndrSig v _) = v
528 rn_var (RuleBndr (L loc _), id)
529 = returnM (RuleBndr (L loc id), emptyFVs)
530 rn_var (RuleBndrSig (L loc _) t, id)
531 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
532 returnM (RuleBndrSig (L loc id) t', fvs)
534 badRuleVar :: FastString -> Name -> SDoc
536 = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
537 ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
538 ptext (sLit "does not appear on left hand side")]
541 Note [Rule LHS validity checking]
542 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
543 Check the shape of a transformation rule LHS. Currently we only allow
544 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
545 @forall@'d variables.
547 We used restrict the form of the 'ei' to prevent you writing rules
548 with LHSs with a complicated desugaring (and hence unlikely to match);
549 (e.g. a case expression is not allowed: too elaborate.)
551 But there are legitimate non-trivial args ei, like sections and
552 lambdas. So it seems simmpler not to check at all, and that is why
553 check_e is commented out.
556 checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
557 checkValidRule rule_name ids lhs' fv_lhs'
558 = do { -- Check for the form of the LHS
559 case (validRuleLhs ids lhs') of
561 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
563 -- Check that LHS vars are all bound
564 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
565 ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
567 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
569 -- Just e => Not ok, and e is the offending expression
570 validRuleLhs foralls lhs
573 checkl (L _ e) = check e
575 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
576 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
577 check (HsVar v) | v `notElem` foralls = Nothing
578 check other = Just other -- Failure
581 checkl_e (L _ _e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
583 {- Commented out; see Note [Rule LHS validity checking] above
584 check_e (HsVar v) = Nothing
585 check_e (HsPar e) = checkl_e e
586 check_e (HsLit e) = Nothing
587 check_e (HsOverLit e) = Nothing
589 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
590 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
591 check_e (NegApp e _) = checkl_e e
592 check_e (ExplicitList _ es) = checkl_es es
593 check_e (ExplicitTuple es _) = checkl_es es
594 check_e other = Just other -- Fails
596 checkl_es es = foldr (mplus . checkl_e) Nothing es
599 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
600 badRuleLhsErr name lhs bad_e
601 = sep [ptext (sLit "Rule") <+> ftext name <> colon,
602 nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
603 ptext (sLit "in left-hand side:") <+> ppr lhs])]
605 ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
609 %*********************************************************
611 \subsection{Type, class and iface sig declarations}
613 %*********************************************************
615 @rnTyDecl@ uses the `global name function' to create a new type
616 declaration in which local names have been replaced by their original
617 names, reporting any unknown names.
619 Renaming type variables is a pain. Because they now contain uniques,
620 it is necessary to pass in an association list which maps a parsed
621 tyvar to its @Name@ representation.
622 In some cases (type signatures of values),
623 it is even necessary to go over the type first
624 in order to get the set of tyvars used by it, make an assoc list,
625 and then go over it again to rename the tyvars!
626 However, we can also do some scoping checks at the same time.
629 rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
630 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
631 = lookupLocatedTopBndrRn name `thenM` \ name' ->
632 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
635 -- all flavours of type family declarations ("type family", "newtype fanily",
636 -- and "data family")
637 rnTyClDecl (tydecl@TyFamily {}) =
638 rnFamily tydecl bindTyVarsRn
640 -- "data", "newtype", "data instance, and "newtype instance" declarations
641 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
642 tcdLName = tycon, tcdTyVars = tyvars,
643 tcdTyPats = typatsMaybe, tcdCons = condecls,
644 tcdKindSig = sig, tcdDerivs = derivs})
645 | is_vanilla -- Normal Haskell data type decl
646 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
647 -- data type is syntactically illegal
648 do { tyvars <- pruneTyVars tydecl
649 ; bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
650 { tycon' <- if isFamInstDecl tydecl
651 then lookupLocatedOccRn tycon -- may be imported family
652 else lookupLocatedTopBndrRn tycon
653 ; context' <- rnContext data_doc context
654 ; typats' <- rnTyPats data_doc typatsMaybe
655 ; (derivs', deriv_fvs) <- rn_derivs derivs
656 ; condecls' <- rnConDecls (unLoc tycon') condecls
657 -- No need to check for duplicate constructor decls
658 -- since that is done by RnNames.extendGlobalRdrEnvRn
659 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
660 tcdLName = tycon', tcdTyVars = tyvars',
661 tcdTyPats = typats', tcdKindSig = Nothing,
662 tcdCons = condecls', tcdDerivs = derivs'},
663 delFVs (map hsLTyVarName tyvars') $
664 extractHsCtxtTyNames context' `plusFV`
665 plusFVs (map conDeclFVs condecls') `plusFV`
667 (if isFamInstDecl tydecl
668 then unitFV (unLoc tycon') -- type instance => use
673 = do { tycon' <- if isFamInstDecl tydecl
674 then lookupLocatedOccRn tycon -- may be imported family
675 else lookupLocatedTopBndrRn tycon
676 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
678 <- bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
679 { typats' <- rnTyPats data_doc typatsMaybe
680 ; return (tyvars', typats') }
681 -- For GADTs, the type variables in the declaration
682 -- do not scope over the constructor signatures
683 -- data T a where { T1 :: forall b. b-> b }
685 ; (derivs', deriv_fvs) <- rn_derivs derivs
686 ; condecls' <- rnConDecls (unLoc tycon') condecls
687 -- No need to check for duplicate constructor decls
688 -- since that is done by RnNames.extendGlobalRdrEnvRn
690 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
691 tcdLName = tycon', tcdTyVars = tyvars',
692 tcdTyPats = typats', tcdKindSig = sig,
693 tcdCons = condecls', tcdDerivs = derivs'},
694 plusFVs (map conDeclFVs condecls') `plusFV`
696 (if isFamInstDecl tydecl
697 then unitFV (unLoc tycon') -- type instance => use
701 is_vanilla = case condecls of -- Yuk
703 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
706 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
708 rn_derivs Nothing = returnM (Nothing, emptyFVs)
709 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
710 returnM (Just ds', extractHsTyNames_s ds')
712 -- "type" and "type instance" declarations
713 rnTyClDecl tydecl@(TySynonym {tcdLName = name,
714 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
715 = do { tyvars <- pruneTyVars tydecl
716 ; bindTyVarsRn syn_doc tyvars $ \ tyvars' -> do
717 { name' <- if isFamInstDecl tydecl
718 then lookupLocatedOccRn name -- may be imported family
719 else lookupLocatedTopBndrRn name
720 ; typats' <- rnTyPats syn_doc typatsMaybe
721 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
722 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
723 tcdTyPats = typats', tcdSynRhs = ty'},
724 delFVs (map hsLTyVarName tyvars') $
726 (if isFamInstDecl tydecl
727 then unitFV (unLoc name') -- type instance => use
731 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
733 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
734 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
735 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
736 = do { cname' <- lookupLocatedTopBndrRn cname
738 -- Tyvars scope over superclass context and method signatures
739 ; (tyvars', context', fds', ats', ats_fvs, sigs')
740 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
741 { context' <- rnContext cls_doc context
742 ; fds' <- rnFds cls_doc fds
743 ; (ats', ats_fvs) <- rnATs ats
744 ; sigs' <- renameSigs Nothing okClsDclSig sigs
745 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
747 -- No need to check for duplicate associated type decls
748 -- since that is done by RnNames.extendGlobalRdrEnvRn
750 -- Check the signatures
751 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
752 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
753 ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
754 -- Typechecker is responsible for checking that we only
755 -- give default-method bindings for things in this class.
756 -- The renamer *could* check this for class decls, but can't
757 -- for instance decls.
759 -- The newLocals call is tiresome: given a generic class decl
762 -- op {| x+y |} (Inl a) = ...
763 -- op {| x+y |} (Inr b) = ...
764 -- op {| a*b |} (a*b) = ...
765 -- we want to name both "x" tyvars with the same unique, so that they are
766 -- easy to group together in the typechecker.
767 ; (mbinds', meth_fvs)
768 <- extendTyVarEnvForMethodBinds tyvars' $ do
769 { name_env <- getLocalRdrEnv
770 ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
771 not (unLoc tv `elemLocalRdrEnv` name_env) ]
772 -- No need to check for duplicate method signatures
773 -- since that is done by RnNames.extendGlobalRdrEnvRn
774 -- and the methods are already in scope
775 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
776 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
779 ; docs' <- mapM (wrapLocM rnDocDecl) docs
781 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
782 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
783 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
785 delFVs (map hsLTyVarName tyvars') $
786 extractHsCtxtTyNames context' `plusFV`
787 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
788 hsSigsFVs sigs' `plusFV`
792 cls_doc = text "In the declaration for class" <+> ppr cname
793 sig_doc = text "In the signatures for class" <+> ppr cname
795 badGadtStupidTheta :: Located RdrName -> SDoc
797 = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
798 ptext (sLit "(You can put a context on each contructor, though.)")]
801 %*********************************************************
803 \subsection{Support code for type/data declarations}
805 %*********************************************************
808 -- Remove any duplicate type variables in family instances may have non-linear
809 -- left-hand sides. Complain if any, but the first occurence of a type
810 -- variable has a user-supplied kind signature.
812 pruneTyVars :: TyClDecl RdrName -> RnM [LHsTyVarBndr RdrName]
814 | isFamInstDecl tydecl
815 = do { let pruned_tyvars = nubBy eqLTyVar tyvars
816 ; assertNoSigsInRepeats tyvars
817 ; return pruned_tyvars
822 tyvars = tcdTyVars tydecl
824 assertNoSigsInRepeats [] = return ()
825 assertNoSigsInRepeats (tv:tvs)
826 = do { let offending_tvs = [ tv' | tv'@(L _ (KindedTyVar _ _)) <- tvs
828 ; checkErr (null offending_tvs) $
829 illegalKindSig (head offending_tvs)
830 ; assertNoSigsInRepeats tvs
834 = hsep [ptext (sLit "Repeat variable occurrence may not have a"),
835 ptext (sLit "kind signature:"), quotes (ppr tv)]
837 tv1 `eqLTyVar` tv2 = hsLTyVarLocName tv1 `eqLocated` hsLTyVarLocName tv2
839 -- Although, we are processing type patterns here, all type variables will
840 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
841 -- type declaration to which these patterns belong)
843 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
844 rnTyPats _ Nothing = return Nothing
845 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
847 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
848 rnConDecls _tycon condecls
849 = mappM (wrapLocM rnConDecl) condecls
851 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
852 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
853 = do { addLocM checkConName name
855 ; new_name <- lookupLocatedTopBndrRn name
856 ; name_env <- getLocalRdrEnv
858 -- For H98 syntax, the tvs are the existential ones
859 -- For GADT syntax, the tvs are all the quantified tyvars
860 -- Hence the 'filter' in the ResTyH98 case only
861 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
862 arg_tys = hsConDeclArgTys details
863 implicit_tvs = case res_ty of
864 ResTyH98 -> filter not_in_scope $
866 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
869 Implicit -> userHsTyVarBndrs implicit_tvs
871 ; mb_doc' <- rnMbLHsDoc mb_doc
873 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
874 { new_context <- rnContext doc cxt
875 ; new_details <- rnConDeclDetails doc details
876 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
877 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
879 doc = text "In the definition of data constructor" <+> quotes (ppr name)
880 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
883 -> HsConDetails (LHsType Name) [ConDeclField Name]
885 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
887 rnConResult _ details ResTyH98 = return (details, ResTyH98)
889 rnConResult doc details (ResTyGADT ty) = do
890 ty' <- rnHsSigType doc ty
891 let (arg_tys, res_ty) = splitHsFunType ty'
892 -- We can split it up, now the renamer has dealt with fixities
894 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
895 RecCon _ -> return (details, ResTyGADT ty')
896 InfixCon {} -> panic "rnConResult"
898 rnConDeclDetails :: SDoc
899 -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
900 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
901 rnConDeclDetails doc (PrefixCon tys)
902 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
903 returnM (PrefixCon new_tys)
905 rnConDeclDetails doc (InfixCon ty1 ty2)
906 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
907 rnLHsType doc ty2 `thenM` \ new_ty2 ->
908 returnM (InfixCon new_ty1 new_ty2)
910 rnConDeclDetails doc (RecCon fields)
911 = do { new_fields <- mappM (rnField doc) fields
912 -- No need to check for duplicate fields
913 -- since that is done by RnNames.extendGlobalRdrEnvRn
914 ; return (RecCon new_fields) }
916 rnField :: SDoc -> ConDeclField RdrName -> RnM (ConDeclField Name)
917 rnField doc (ConDeclField name ty haddock_doc)
918 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
919 rnLHsType doc ty `thenM` \ new_ty ->
920 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
921 returnM (ConDeclField new_name new_ty new_haddock_doc)
923 -- Rename family declarations
925 -- * This function is parametrised by the routine handling the index
926 -- variables. On the toplevel, these are defining occurences, whereas they
927 -- are usage occurences for associated types.
929 rnFamily :: TyClDecl RdrName
930 -> (SDoc -> [LHsTyVarBndr RdrName] ->
931 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
932 RnM (TyClDecl Name, FreeVars))
933 -> RnM (TyClDecl Name, FreeVars)
935 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
936 tcdLName = tycon, tcdTyVars = tyvars})
938 do { checkM (isDataFlavour flavour -- for synonyms,
939 || not (null tyvars)) $ addErr needOneIdx -- no. of indexes >= 1
940 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
941 ; tycon' <- lookupLocatedTopBndrRn tycon
942 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
943 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
947 isDataFlavour DataFamily = True
948 isDataFlavour _ = False
949 rnFamily d _ = pprPanic "rnFamily" (ppr d)
951 family_doc :: Located RdrName -> SDoc
952 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
955 needOneIdx = text "Type family declarations requires at least one type index"
957 -- Rename associated type declarations (in classes)
959 -- * This can be family declarations and (default) type instances
961 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
962 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
964 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
965 rn_at (tydecl@TySynonym {}) =
967 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
969 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
971 lookupIdxVars _ tyvars cont =
972 do { checkForDups tyvars;
973 ; tyvars' <- mappM lookupIdxVar tyvars
976 -- Type index variables must be class parameters, which are the only
977 -- type variables in scope at this point.
978 lookupIdxVar (L l tyvar) =
980 name' <- lookupOccRn (hsTyVarName tyvar)
981 return $ L l (replaceTyVarName tyvar name')
983 -- Type variable may only occur once.
985 checkForDups [] = return ()
986 checkForDups (L loc tv:ltvs) =
987 do { setSrcSpan loc $
988 when (hsTyVarName tv `ltvElem` ltvs) $
989 addErr (repeatedTyVar tv)
993 _ `ltvElem` [] = False
994 rdrName `ltvElem` (L _ tv:ltvs)
995 | rdrName == hsTyVarName tv = True
996 | otherwise = rdrName `ltvElem` ltvs
999 noPatterns = text "Default definition for an associated synonym cannot have"
1000 <+> text "type pattern"
1002 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
1003 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
1006 -- This data decl will parse OK
1008 -- treating "a" as the constructor.
1009 -- It is really hard to make the parser spot this malformation.
1010 -- So the renamer has to check that the constructor is legal
1012 -- We can get an operator as the constructor, even in the prefix form:
1013 -- data T = :% Int Int
1014 -- from interface files, which always print in prefix form
1016 checkConName :: RdrName -> TcRn ()
1017 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1019 badDataCon :: RdrName -> SDoc
1021 = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
1025 %*********************************************************
1027 \subsection{Support code for type/data declarations}
1029 %*********************************************************
1031 Get the mapping from constructors to fields for this module.
1032 It's convenient to do this after the data type decls have been renamed
1034 extendRecordFieldEnv :: [LTyClDecl RdrName] -> TcM TcGblEnv
1035 extendRecordFieldEnv decls
1036 = do { tcg_env <- getGblEnv
1037 ; field_env' <- foldrM get (tcg_field_env tcg_env) decls
1038 ; return (tcg_env { tcg_field_env = field_env' }) }
1040 -- we want to lookup:
1041 -- (a) a datatype constructor
1042 -- (b) a record field
1043 -- knowing that they're from this module.
1044 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1045 -- which keeps only the local ones.
1046 lookup x = do { x' <- lookupLocatedTopBndrRn x
1047 ; return $ unLoc x'}
1049 get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
1050 get _ env = return env
1052 get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds }))
1053 (RecFields env fld_set)
1054 = do { con' <- lookup con
1055 ; flds' <- mappM lookup (map cd_fld_name flds)
1056 ; let env' = extendNameEnv env con' flds'
1057 fld_set' = addListToNameSet fld_set flds'
1058 ; return $ (RecFields env' fld_set') }
1059 get_con _ env = return env
1062 %*********************************************************
1064 \subsection{Support code to rename types}
1066 %*********************************************************
1069 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1072 = mappM (wrapLocM rn_fds) fds
1075 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1076 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1077 returnM (tys1', tys2')
1079 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1080 rnHsTyVars doc tvs = mappM (rnHsTyVar doc) tvs
1082 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1083 rnHsTyVar _doc tyvar = lookupOccRn tyvar
1087 %*********************************************************
1091 %*********************************************************
1097 h = ...$(thing "f")...
1099 The splice can expand into literally anything, so when we do dependency
1100 analysis we must assume that it might mention 'f'. So we simply treat
1101 all locally-defined names as mentioned by any splice. This is terribly
1102 brutal, but I don't see what else to do. For example, it'll mean
1103 that every locally-defined thing will appear to be used, so no unused-binding
1104 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
1105 and that will crash the type checker because 'f' isn't in scope.
1107 Currently, I'm not treating a splice as also mentioning every import,
1108 which is a bit inconsistent -- but there are a lot of them. We might
1109 thereby get some bogus unused-import warnings, but we won't crash the
1110 type checker. Not very satisfactory really.
1113 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
1114 rnSplice (HsSplice n expr)
1115 = do { checkTH expr "splice"
1116 ; loc <- getSrcSpanM
1117 ; [n'] <- newLocalsRn [L loc n]
1118 ; (expr', fvs) <- rnLExpr expr
1120 -- Ugh! See Note [Splices] above
1121 ; lcl_rdr <- getLocalRdrEnv
1122 ; gbl_rdr <- getGlobalRdrEnv
1123 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
1125 lcl_names = mkNameSet (occEnvElts lcl_rdr)
1127 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
1129 checkTH :: Outputable a => a -> String -> RnM ()
1131 checkTH _ _ = returnM () -- OK
1133 checkTH e what -- Raise an error in a stage-1 compiler
1134 = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>
1135 ptext (sLit "illegal in a stage-1 compiler"),