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 )
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
98 -- The Bool determines whether (True) names in the group shadow existing
99 -- Unquals in the global environment (used in Template Haskell) or
100 -- (False) whether duplicates are reported as an error
101 rnSrcDecls :: Bool -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
103 rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls,
104 hs_tyclds = tycl_decls,
105 hs_instds = inst_decls,
106 hs_derivds = deriv_decls,
107 hs_fixds = fix_decls,
108 hs_warnds = warn_decls,
109 hs_fords = foreign_decls,
110 hs_defds = default_decls,
111 hs_ruleds = rule_decls,
114 -- (A) Process the fixity declarations, creating a mapping from
115 -- FastStrings to FixItems.
116 -- Also checks for duplcates.
117 local_fix_env <- makeMiniFixityEnv fix_decls;
119 -- (B) Bring top level binders (and their fixities) into scope,
120 -- *except* for the value bindings, which get brought in below.
121 avails <- getLocalNonValBinders group ;
122 tc_envs <- extendGlobalRdrEnvRn shadowP avails local_fix_env ;
123 setEnvs tc_envs $ do {
125 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
127 -- (C) Extract the mapping from data constructors to field names and
128 -- extend the record field env.
129 -- This depends on the data constructors and field names being in
130 -- scope from (B) above
131 inNewEnv (extendRecordFieldEnv tycl_decls) $ \ _ -> do {
133 -- (D) Rename the left-hand sides of the value bindings.
134 -- This depends on everything from (B) being in scope,
135 -- and on (C) for resolving record wild cards.
136 -- It uses the fixity env from (A) to bind fixities for view patterns.
137 new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
138 -- bind the LHSes (and their fixities) in the global rdr environment
139 let { lhs_binders = map unLoc $ collectHsValBinders new_lhs;
140 lhs_avails = map Avail lhs_binders
142 (tcg_env, tcl_env) <- extendGlobalRdrEnvRn shadowP lhs_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 lhs_binders 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 fix_decls ;
170 -- rename deprec decls;
171 -- check for duplicates and ensure that deprecated things are defined locally
172 -- at the moment, we don't keep these around past renaming
173 rn_warns <- rnSrcWarnDecls warn_decls ;
175 -- (H) Rename Everything else
177 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
178 (rn_rule_decls, src_fvs3) <- setOptM Opt_ScopedTypeVariables $
179 rnList rnHsRuleDecl rule_decls ;
180 -- Inside RULES, scoped type variables are on
181 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
182 (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ;
183 (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ;
184 -- Haddock docs; no free vars
185 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
187 -- (I) Compute the results and return
188 let {rn_group = HsGroup { hs_valds = rn_val_decls,
189 hs_tyclds = rn_tycl_decls,
190 hs_instds = rn_inst_decls,
191 hs_derivds = rn_deriv_decls,
192 hs_fixds = rn_fix_decls,
193 hs_warnds = [], -- warns are returned in the tcg_env
194 -- (see below) not in the HsGroup
195 hs_fords = rn_foreign_decls,
196 hs_defds = rn_default_decls,
197 hs_ruleds = rn_rule_decls,
198 hs_docs = rn_docs } ;
200 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
201 src_fvs4, src_fvs5] ;
202 src_dus = bind_dus `plusDU` usesOnly other_fvs;
203 -- Note: src_dus will contain *uses* for locally-defined types
204 -- and classes, but no *defs* for them. (Because rnTyClDecl
205 -- returns only the uses.) This is a little
206 -- surprising but it doesn't actually matter at all.
208 final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
209 in -- we return the deprecs in the env, not in the HsGroup above
210 tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
213 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
214 traceRn (text "finish Dus" <+> ppr src_dus ) ;
215 return (final_tcg_env , rn_group)
218 -- some utils because we do this a bunch above
219 -- compute and install the new env
220 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
221 inNewEnv env cont = do e <- env
224 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
225 -- Used for external core
226 rnTyClDecls tycl_decls = do (decls', _fvs) <- rnList rnTyClDecl tycl_decls
229 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
230 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
232 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
233 rnList f xs = mapFvRn (wrapLocFstM f) xs
237 %*********************************************************
241 %*********************************************************
244 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
245 rnDocDecl (DocCommentNext doc) = do
246 rn_doc <- rnHsDoc doc
247 return (DocCommentNext rn_doc)
248 rnDocDecl (DocCommentPrev doc) = do
249 rn_doc <- rnHsDoc doc
250 return (DocCommentPrev rn_doc)
251 rnDocDecl (DocCommentNamed str doc) = do
252 rn_doc <- rnHsDoc doc
253 return (DocCommentNamed str rn_doc)
254 rnDocDecl (DocGroup lev doc) = do
255 rn_doc <- rnHsDoc doc
256 return (DocGroup lev rn_doc)
260 %*********************************************************
262 Source-code fixity declarations
264 %*********************************************************
267 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
268 -- Rename the fixity decls, so we can put
269 -- the renamed decls in the renamed syntax tree
270 -- Errors if the thing being fixed is not defined locally.
272 -- The returned FixitySigs are not actually used for anything,
273 -- except perhaps the GHCi API
274 rnSrcFixityDecls fix_decls
275 = do fix_decls <- mapM rn_decl fix_decls
276 return (concat fix_decls)
278 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
279 -- GHC extension: look up both the tycon and data con
280 -- for con-like things; hence returning a list
281 -- If neither are in scope, report an error; otherwise
282 -- return a fixity sig for each (slightly odd)
283 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
284 = setSrcSpan name_loc $
285 -- this lookup will fail if the definition isn't local
286 do names <- lookupLocalDataTcNames rdr_name
287 return [ L loc (FixitySig (L name_loc name) fixity)
292 %*********************************************************
294 Source-code deprecations declarations
296 %*********************************************************
298 Check that the deprecated names are defined, are defined locally, and
299 that there are no duplicate deprecations.
301 It's only imported deprecations, dealt with in RnIfaces, that we
302 gather them together.
305 -- checks that the deprecations are defined locally, and that there are no duplicates
306 rnSrcWarnDecls :: [LWarnDecl RdrName] -> RnM Warnings
311 = do { -- check for duplicates
312 ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups
313 ; mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
314 returnM (WarnSome ((concat pairs_s))) }
316 rn_deprec (Warning rdr_name txt)
317 -- ensures that the names are defined locally
318 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
319 returnM [(nameOccName name, txt) | name <- names]
321 -- look for duplicates among the OccNames;
322 -- we check that the names are defined above
323 -- invt: the lists returned by findDupsEq always have at least two elements
324 warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
325 (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
327 dupWarnDecl :: Located RdrName -> RdrName -> SDoc
328 -- Located RdrName -> DeprecDecl RdrName -> SDoc
329 dupWarnDecl (L loc _) rdr_name
330 = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
331 ptext (sLit "also at ") <+> ppr loc]
335 %*********************************************************
337 \subsection{Source code declarations}
339 %*********************************************************
342 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
343 rnDefaultDecl (DefaultDecl tys)
344 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
345 returnM (DefaultDecl tys', fvs)
347 doc_str = text "In a `default' declaration"
350 %*********************************************************
352 \subsection{Foreign declarations}
354 %*********************************************************
357 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
358 rnHsForeignDecl (ForeignImport name ty spec)
359 = lookupLocatedTopBndrRn name `thenM` \ name' ->
360 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
361 returnM (ForeignImport name' ty' spec, fvs)
363 rnHsForeignDecl (ForeignExport name ty spec)
364 = lookupLocatedOccRn name `thenM` \ name' ->
365 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
366 returnM (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
367 -- NB: a foreign export is an *occurrence site* for name, so
368 -- we add it to the free-variable list. It might, for example,
369 -- be imported from another module
371 fo_decl_msg :: Located RdrName -> SDoc
372 fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
376 %*********************************************************
378 \subsection{Instance declarations}
380 %*********************************************************
383 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
384 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
385 -- Used for both source and interface file decls
386 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
388 -- Rename the bindings
389 -- The typechecker (not the renamer) checks that all
390 -- the bindings are for the right class
392 meth_doc = text "In the bindings in an instance declaration"
393 meth_names = collectHsBindLocatedBinders mbinds
394 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
396 checkDupRdrNames meth_doc meth_names `thenM_`
397 -- Check that the same method is not given twice in the
398 -- same instance decl instance C T where
402 -- We must use checkDupRdrNames because the Name of the
403 -- method is the Name of the class selector, whose SrcSpan
404 -- points to the class declaration
406 extendTyVarEnvForMethodBinds inst_tyvars (
407 -- (Slightly strangely) the forall-d tyvars scope over
408 -- the method bindings too
409 rnMethodBinds cls (\_ -> []) -- No scoped tyvars
411 ) `thenM` \ (mbinds', meth_fvs) ->
412 -- Rename the associated types
413 -- The typechecker (not the renamer) checks that all
414 -- the declarations are for the right class
416 at_doc = text "In the associated types of an instance declaration"
417 at_names = map (head . tyClDeclNames . unLoc) ats
419 checkDupRdrNames at_doc at_names `thenM_`
420 -- See notes with checkDupRdrNames for methods, above
422 rnATInsts ats `thenM` \ (ats', at_fvs) ->
424 -- Rename the prags and signatures.
425 -- Note that the type variables are not in scope here,
426 -- so that instance Eq a => Eq (T a) where
427 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
430 -- But the (unqualified) method names are in scope
432 binders = collectHsBindBinders mbinds'
433 bndr_set = mkNameSet binders
435 bindLocalNames binders
436 (renameSigs (Just bndr_set) okInstDclSig uprags) `thenM` \ uprags' ->
438 returnM (InstDecl inst_ty' mbinds' uprags' ats',
439 meth_fvs `plusFV` at_fvs
440 `plusFV` hsSigsFVs uprags'
441 `plusFV` extractHsTyNames inst_ty')
442 -- We return the renamed associated data type declarations so
443 -- that they can be entered into the list of type declarations
444 -- for the binding group, but we also keep a copy in the instance.
445 -- The latter is needed for well-formedness checks in the type
446 -- checker (eg, to ensure that all ATs of the instance actually
447 -- receive a declaration).
448 -- NB: Even the copies in the instance declaration carry copies of
449 -- the instance context after renaming. This is a bit
450 -- strange, but should not matter (and it would be more work
451 -- to remove the context).
454 Renaming of the associated types in instances.
457 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
458 rnATInsts atDecls = rnList rnATInst atDecls
460 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
461 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
463 pprPanic "RnSource.rnATInsts: invalid AT instance"
464 (ppr (tcdName tydecl))
467 For the method bindings in class and instance decls, we extend the
468 type variable environment iff -fglasgow-exts
471 extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
472 -> RnM (Bag (LHsBind Name), FreeVars)
473 -> RnM (Bag (LHsBind Name), FreeVars)
474 extendTyVarEnvForMethodBinds tyvars thing_inside
475 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
477 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
482 %*********************************************************
484 \subsection{Stand-alone deriving declarations}
486 %*********************************************************
489 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
490 rnSrcDerivDecl (DerivDecl ty)
491 = do ty' <- rnLHsType (text "a deriving decl") ty
492 let fvs = extractHsTyNames ty'
493 return (DerivDecl ty', fvs)
496 %*********************************************************
500 %*********************************************************
503 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
504 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
505 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
506 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
507 do { (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
508 -- NB: The binders in a rule are always Ids
509 -- We don't (yet) support type variables
511 ; (lhs', fv_lhs') <- rnLExpr lhs
512 ; (rhs', fv_rhs') <- rnLExpr rhs
514 ; checkValidRule rule_name ids lhs' fv_lhs'
516 ; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
517 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
519 doc = text "In the transformation rule" <+> ftext rule_name
521 get_var (RuleBndr v) = v
522 get_var (RuleBndrSig v _) = v
524 rn_var (RuleBndr (L loc _), id)
525 = returnM (RuleBndr (L loc id), emptyFVs)
526 rn_var (RuleBndrSig (L loc _) t, id)
527 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
528 returnM (RuleBndrSig (L loc id) t', fvs)
530 badRuleVar :: FastString -> Name -> SDoc
532 = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
533 ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
534 ptext (sLit "does not appear on left hand side")]
537 Note [Rule LHS validity checking]
538 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
539 Check the shape of a transformation rule LHS. Currently we only allow
540 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
541 @forall@'d variables.
543 We used restrict the form of the 'ei' to prevent you writing rules
544 with LHSs with a complicated desugaring (and hence unlikely to match);
545 (e.g. a case expression is not allowed: too elaborate.)
547 But there are legitimate non-trivial args ei, like sections and
548 lambdas. So it seems simmpler not to check at all, and that is why
549 check_e is commented out.
552 checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
553 checkValidRule rule_name ids lhs' fv_lhs'
554 = do { -- Check for the form of the LHS
555 case (validRuleLhs ids lhs') of
557 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
559 -- Check that LHS vars are all bound
560 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
561 ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
563 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
565 -- Just e => Not ok, and e is the offending expression
566 validRuleLhs foralls lhs
569 checkl (L _ e) = check e
571 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
572 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
573 check (HsVar v) | v `notElem` foralls = Nothing
574 check other = Just other -- Failure
577 checkl_e (L _ _e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
579 {- Commented out; see Note [Rule LHS validity checking] above
580 check_e (HsVar v) = Nothing
581 check_e (HsPar e) = checkl_e e
582 check_e (HsLit e) = Nothing
583 check_e (HsOverLit e) = Nothing
585 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
586 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
587 check_e (NegApp e _) = checkl_e e
588 check_e (ExplicitList _ es) = checkl_es es
589 check_e (ExplicitTuple es _) = checkl_es es
590 check_e other = Just other -- Fails
592 checkl_es es = foldr (mplus . checkl_e) Nothing es
595 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
596 badRuleLhsErr name lhs bad_e
597 = sep [ptext (sLit "Rule") <+> ftext name <> colon,
598 nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
599 ptext (sLit "in left-hand side:") <+> ppr lhs])]
601 ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
605 %*********************************************************
607 \subsection{Type, class and iface sig declarations}
609 %*********************************************************
611 @rnTyDecl@ uses the `global name function' to create a new type
612 declaration in which local names have been replaced by their original
613 names, reporting any unknown names.
615 Renaming type variables is a pain. Because they now contain uniques,
616 it is necessary to pass in an association list which maps a parsed
617 tyvar to its @Name@ representation.
618 In some cases (type signatures of values),
619 it is even necessary to go over the type first
620 in order to get the set of tyvars used by it, make an assoc list,
621 and then go over it again to rename the tyvars!
622 However, we can also do some scoping checks at the same time.
625 rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
626 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
627 = lookupLocatedTopBndrRn name `thenM` \ name' ->
628 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
631 -- all flavours of type family declarations ("type family", "newtype fanily",
632 -- and "data family")
633 rnTyClDecl (tydecl@TyFamily {}) =
634 rnFamily tydecl bindTyVarsRn
636 -- "data", "newtype", "data instance, and "newtype instance" declarations
637 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
638 tcdLName = tycon, tcdTyVars = tyvars,
639 tcdTyPats = typatsMaybe, tcdCons = condecls,
640 tcdKindSig = sig, tcdDerivs = derivs})
641 | is_vanilla -- Normal Haskell data type decl
642 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
643 -- data type is syntactically illegal
644 do { tyvars <- pruneTyVars tydecl
645 ; bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
646 { tycon' <- if isFamInstDecl tydecl
647 then lookupLocatedOccRn tycon -- may be imported family
648 else lookupLocatedTopBndrRn tycon
649 ; context' <- rnContext data_doc context
650 ; typats' <- rnTyPats data_doc typatsMaybe
651 ; (derivs', deriv_fvs) <- rn_derivs derivs
652 ; condecls' <- rnConDecls (unLoc tycon') condecls
653 -- No need to check for duplicate constructor decls
654 -- since that is done by RnNames.extendGlobalRdrEnvRn
655 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
656 tcdLName = tycon', tcdTyVars = tyvars',
657 tcdTyPats = typats', tcdKindSig = Nothing,
658 tcdCons = condecls', tcdDerivs = derivs'},
659 delFVs (map hsLTyVarName tyvars') $
660 extractHsCtxtTyNames context' `plusFV`
661 plusFVs (map conDeclFVs condecls') `plusFV`
663 (if isFamInstDecl tydecl
664 then unitFV (unLoc tycon') -- type instance => use
669 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
670 do { tycon' <- if isFamInstDecl tydecl
671 then lookupLocatedOccRn tycon -- may be imported family
672 else lookupLocatedTopBndrRn tycon
673 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
674 ; tyvars' <- bindTyVarsRn data_doc tyvars
675 (\ tyvars' -> return tyvars')
676 -- For GADTs, the type variables in the declaration
677 -- do not scope over the constructor signatures
678 -- data T a where { T1 :: forall b. b-> b }
679 ; (derivs', deriv_fvs) <- rn_derivs derivs
680 ; condecls' <- rnConDecls (unLoc tycon') condecls
681 -- No need to check for duplicate constructor decls
682 -- since that is done by RnNames.extendGlobalRdrEnvRn
683 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
684 tcdLName = tycon', tcdTyVars = tyvars',
685 tcdTyPats = Nothing, tcdKindSig = sig,
686 tcdCons = condecls', tcdDerivs = derivs'},
687 plusFVs (map conDeclFVs condecls') `plusFV`
689 (if isFamInstDecl tydecl
690 then unitFV (unLoc tycon') -- type instance => use
694 is_vanilla = case condecls of -- Yuk
696 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
700 none (Just []) = True
703 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
705 rn_derivs Nothing = returnM (Nothing, emptyFVs)
706 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
707 returnM (Just ds', extractHsTyNames_s ds')
709 -- "type" and "type instance" declarations
710 rnTyClDecl tydecl@(TySynonym {tcdLName = name,
711 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
712 = do { tyvars <- pruneTyVars tydecl
713 ; bindTyVarsRn syn_doc tyvars $ \ tyvars' -> do
714 { name' <- if isFamInstDecl tydecl
715 then lookupLocatedOccRn name -- may be imported family
716 else lookupLocatedTopBndrRn name
717 ; typats' <- rnTyPats syn_doc typatsMaybe
718 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
719 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
720 tcdTyPats = typats', tcdSynRhs = ty'},
721 delFVs (map hsLTyVarName tyvars') $
723 (if isFamInstDecl tydecl
724 then unitFV (unLoc name') -- type instance => use
728 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
730 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
731 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
732 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
733 = do { cname' <- lookupLocatedTopBndrRn cname
735 -- Tyvars scope over superclass context and method signatures
736 ; (tyvars', context', fds', ats', ats_fvs, sigs')
737 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
738 { context' <- rnContext cls_doc context
739 ; fds' <- rnFds cls_doc fds
740 ; (ats', ats_fvs) <- rnATs ats
741 ; sigs' <- renameSigs Nothing okClsDclSig sigs
742 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
744 -- No need to check for duplicate associated type decls
745 -- since that is done by RnNames.extendGlobalRdrEnvRn
747 -- Check the signatures
748 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
749 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
750 ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
751 -- Typechecker is responsible for checking that we only
752 -- give default-method bindings for things in this class.
753 -- The renamer *could* check this for class decls, but can't
754 -- for instance decls.
756 -- The newLocals call is tiresome: given a generic class decl
759 -- op {| x+y |} (Inl a) = ...
760 -- op {| x+y |} (Inr b) = ...
761 -- op {| a*b |} (a*b) = ...
762 -- we want to name both "x" tyvars with the same unique, so that they are
763 -- easy to group together in the typechecker.
764 ; (mbinds', meth_fvs)
765 <- extendTyVarEnvForMethodBinds tyvars' $ do
766 { name_env <- getLocalRdrEnv
767 ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
768 not (unLoc tv `elemLocalRdrEnv` name_env) ]
769 -- No need to check for duplicate method signatures
770 -- since that is done by RnNames.extendGlobalRdrEnvRn
771 -- and the methods are already in scope
772 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
773 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
776 ; docs' <- mapM (wrapLocM rnDocDecl) docs
778 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
779 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
780 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
782 delFVs (map hsLTyVarName tyvars') $
783 extractHsCtxtTyNames context' `plusFV`
784 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
785 hsSigsFVs sigs' `plusFV`
789 cls_doc = text "In the declaration for class" <+> ppr cname
790 sig_doc = text "In the signatures for class" <+> ppr cname
792 badGadtStupidTheta :: Located RdrName -> SDoc
794 = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
795 ptext (sLit "(You can put a context on each contructor, though.)")]
798 %*********************************************************
800 \subsection{Support code for type/data declarations}
802 %*********************************************************
805 -- Remove any duplicate type variables in family instances may have non-linear
806 -- left-hand sides. Complain if any, but the first occurence of a type
807 -- variable has a user-supplied kind signature.
809 pruneTyVars :: TyClDecl RdrName -> RnM [LHsTyVarBndr RdrName]
811 | isFamInstDecl tydecl
812 = do { let pruned_tyvars = nubBy eqLTyVar tyvars
813 ; assertNoSigsInRepeats tyvars
814 ; return pruned_tyvars
819 tyvars = tcdTyVars tydecl
821 assertNoSigsInRepeats [] = return ()
822 assertNoSigsInRepeats (tv:tvs)
823 = do { let offending_tvs = [ tv' | tv'@(L _ (KindedTyVar _ _)) <- tvs
825 ; checkErr (null offending_tvs) $
826 illegalKindSig (head offending_tvs)
827 ; assertNoSigsInRepeats tvs
831 = hsep [ptext (sLit "Repeat variable occurrence may not have a"),
832 ptext (sLit "kind signature:"), quotes (ppr tv)]
834 tv1 `eqLTyVar` tv2 = hsLTyVarLocName tv1 `eqLocated` hsLTyVarLocName tv2
836 -- Although, we are processing type patterns here, all type variables will
837 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
838 -- type declaration to which these patterns belong)
840 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
841 rnTyPats _ Nothing = return Nothing
842 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
844 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
845 rnConDecls _tycon condecls
846 = mappM (wrapLocM rnConDecl) condecls
848 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
849 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
850 = do { addLocM checkConName name
852 ; new_name <- lookupLocatedTopBndrRn name
853 ; name_env <- getLocalRdrEnv
855 -- For H98 syntax, the tvs are the existential ones
856 -- For GADT syntax, the tvs are all the quantified tyvars
857 -- Hence the 'filter' in the ResTyH98 case only
858 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
859 arg_tys = hsConDeclArgTys details
860 implicit_tvs = case res_ty of
861 ResTyH98 -> filter not_in_scope $
863 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
866 Implicit -> userHsTyVarBndrs implicit_tvs
868 ; mb_doc' <- rnMbLHsDoc mb_doc
870 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
871 { new_context <- rnContext doc cxt
872 ; new_details <- rnConDeclDetails doc details
873 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
874 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
876 doc = text "In the definition of data constructor" <+> quotes (ppr name)
877 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
880 -> HsConDetails (LHsType Name) [ConDeclField Name]
882 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
884 rnConResult _ details ResTyH98 = return (details, ResTyH98)
886 rnConResult doc details (ResTyGADT ty) = do
887 ty' <- rnHsSigType doc ty
888 let (arg_tys, res_ty) = splitHsFunType ty'
889 -- We can split it up, now the renamer has dealt with fixities
891 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
892 RecCon _ -> return (details, ResTyGADT ty')
893 InfixCon {} -> panic "rnConResult"
895 rnConDeclDetails :: SDoc
896 -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
897 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
898 rnConDeclDetails doc (PrefixCon tys)
899 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
900 returnM (PrefixCon new_tys)
902 rnConDeclDetails doc (InfixCon ty1 ty2)
903 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
904 rnLHsType doc ty2 `thenM` \ new_ty2 ->
905 returnM (InfixCon new_ty1 new_ty2)
907 rnConDeclDetails doc (RecCon fields)
908 = do { new_fields <- mappM (rnField doc) fields
909 -- No need to check for duplicate fields
910 -- since that is done by RnNames.extendGlobalRdrEnvRn
911 ; return (RecCon new_fields) }
913 rnField :: SDoc -> ConDeclField RdrName -> RnM (ConDeclField Name)
914 rnField doc (ConDeclField name ty haddock_doc)
915 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
916 rnLHsType doc ty `thenM` \ new_ty ->
917 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
918 returnM (ConDeclField new_name new_ty new_haddock_doc)
920 -- Rename family declarations
922 -- * This function is parametrised by the routine handling the index
923 -- variables. On the toplevel, these are defining occurences, whereas they
924 -- are usage occurences for associated types.
926 rnFamily :: TyClDecl RdrName
927 -> (SDoc -> [LHsTyVarBndr RdrName] ->
928 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
929 RnM (TyClDecl Name, FreeVars))
930 -> RnM (TyClDecl Name, FreeVars)
932 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
933 tcdLName = tycon, tcdTyVars = tyvars})
935 do { checkM (isDataFlavour flavour -- for synonyms,
936 || not (null tyvars)) $ addErr needOneIdx -- no. of indexes >= 1
937 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
938 ; tycon' <- lookupLocatedTopBndrRn tycon
939 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
940 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
944 isDataFlavour DataFamily = True
945 isDataFlavour _ = False
946 rnFamily d _ = pprPanic "rnFamily" (ppr d)
948 family_doc :: Located RdrName -> SDoc
949 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
952 needOneIdx = text "Type family declarations requires at least one type index"
954 -- Rename associated type declarations (in classes)
956 -- * This can be family declarations and (default) type instances
958 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
959 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
961 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
962 rn_at (tydecl@TySynonym {}) =
964 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
966 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
968 lookupIdxVars _ tyvars cont =
969 do { checkForDups tyvars;
970 ; tyvars' <- mappM lookupIdxVar tyvars
973 -- Type index variables must be class parameters, which are the only
974 -- type variables in scope at this point.
975 lookupIdxVar (L l tyvar) =
977 name' <- lookupOccRn (hsTyVarName tyvar)
978 return $ L l (replaceTyVarName tyvar name')
980 -- Type variable may only occur once.
982 checkForDups [] = return ()
983 checkForDups (L loc tv:ltvs) =
984 do { setSrcSpan loc $
985 when (hsTyVarName tv `ltvElem` ltvs) $
986 addErr (repeatedTyVar tv)
990 _ `ltvElem` [] = False
991 rdrName `ltvElem` (L _ tv:ltvs)
992 | rdrName == hsTyVarName tv = True
993 | otherwise = rdrName `ltvElem` ltvs
996 noPatterns = text "Default definition for an associated synonym cannot have"
997 <+> text "type pattern"
999 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
1000 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
1003 -- This data decl will parse OK
1005 -- treating "a" as the constructor.
1006 -- It is really hard to make the parser spot this malformation.
1007 -- So the renamer has to check that the constructor is legal
1009 -- We can get an operator as the constructor, even in the prefix form:
1010 -- data T = :% Int Int
1011 -- from interface files, which always print in prefix form
1013 checkConName :: RdrName -> TcRn ()
1014 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1016 badDataCon :: RdrName -> SDoc
1018 = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
1022 %*********************************************************
1024 \subsection{Support code for type/data declarations}
1026 %*********************************************************
1028 Get the mapping from constructors to fields for this module.
1029 It's convenient to do this after the data type decls have been renamed
1031 extendRecordFieldEnv :: [LTyClDecl RdrName] -> TcM TcGblEnv
1032 extendRecordFieldEnv decls
1033 = do { tcg_env <- getGblEnv
1034 ; field_env' <- foldrM get (tcg_field_env tcg_env) decls
1035 ; return (tcg_env { tcg_field_env = field_env' }) }
1037 -- we want to lookup:
1038 -- (a) a datatype constructor
1039 -- (b) a record field
1040 -- knowing that they're from this module.
1041 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1042 -- which keeps only the local ones.
1043 lookup x = do { x' <- lookupLocatedTopBndrRn x
1044 ; return $ unLoc x'}
1046 get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
1047 get _ env = return env
1049 get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
1050 = do { con' <- lookup con
1051 ; flds' <- mappM lookup (map cd_fld_name flds)
1052 ; return $ extendNameEnv env con' flds' }
1057 %*********************************************************
1059 \subsection{Support code to rename types}
1061 %*********************************************************
1064 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1067 = mappM (wrapLocM rn_fds) fds
1070 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1071 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1072 returnM (tys1', tys2')
1074 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1075 rnHsTyVars doc tvs = mappM (rnHsTyVar doc) tvs
1077 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1078 rnHsTyVar _doc tyvar = lookupOccRn tyvar
1082 %*********************************************************
1086 %*********************************************************
1092 h = ...$(thing "f")...
1094 The splice can expand into literally anything, so when we do dependency
1095 analysis we must assume that it might mention 'f'. So we simply treat
1096 all locally-defined names as mentioned by any splice. This is terribly
1097 brutal, but I don't see what else to do. For example, it'll mean
1098 that every locally-defined thing will appear to be used, so no unused-binding
1099 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
1100 and that will crash the type checker because 'f' isn't in scope.
1102 Currently, I'm not treating a splice as also mentioning every import,
1103 which is a bit inconsistent -- but there are a lot of them. We might
1104 thereby get some bogus unused-import warnings, but we won't crash the
1105 type checker. Not very satisfactory really.
1108 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
1109 rnSplice (HsSplice n expr)
1110 = do { checkTH expr "splice"
1111 ; loc <- getSrcSpanM
1112 ; [n'] <- newLocalsRn [L loc n]
1113 ; (expr', fvs) <- rnLExpr expr
1115 -- Ugh! See Note [Splices] above
1116 ; lcl_rdr <- getLocalRdrEnv
1117 ; gbl_rdr <- getGlobalRdrEnv
1118 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
1120 lcl_names = mkNameSet (occEnvElts lcl_rdr)
1122 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
1124 checkTH :: Outputable a => a -> String -> RnM ()
1126 checkTH _ _ = returnM () -- OK
1128 checkTH e what -- Raise an error in a stage-1 compiler
1129 = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>
1130 ptext (sLit "illegal in a stage-1 compiler"),