2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and fix
10 -- any warnings in the module. See
11 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
15 rnSrcDecls, addTcgDUs,
20 #include "HsVersions.h"
22 import {-# SOURCE #-} RnExpr( rnLExpr )
25 import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv,
26 globalRdrEnvElts, GlobalRdrElt(..), isLocalGRE, rdrNameOcc )
27 import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
29 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
30 import RnBinds ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
32 import RnEnv ( lookupLocalDataTcNames,
33 lookupLocatedTopBndrRn, lookupLocatedOccRn,
34 lookupOccRn, newLocalsRn,
35 bindLocatedLocalsFV, bindPatSigTyVarsFV,
36 bindTyVarsRn, extendTyVarEnvFVRn,
37 bindLocalNames, checkDupRdrNames, mapFvRn, lookupGreLocalRn,
39 import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
40 import HscTypes ( GenAvailInfo(..) )
41 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
44 import HscTypes ( FixityEnv, FixItem(..), Deprecations(..), plusDeprecs )
45 import Class ( FunDep )
46 import Name ( Name, nameOccName )
53 import SrcLoc ( Located(..), unLoc, noLoc )
54 import DynFlags ( DynFlag(..) )
55 import Maybe ( isNothing )
56 import BasicTypes ( Boxity(..) )
58 import ListSetOps (findDupsEq, mkLookupFun)
65 thenM :: Monad a => a b -> (b -> a c) -> a c
68 thenM_ :: Monad a => a b -> a c -> a c
71 returnM :: Monad m => a -> m a
74 mappM :: (Monad m) => (a -> m b) -> [a] -> m [b]
77 mappM_ :: (Monad m) => (a -> m b) -> [a] -> m ()
80 checkM :: Monad m => Bool -> m () -> m ()
84 @rnSourceDecl@ `renames' declarations.
85 It simultaneously performs dependency analysis and precedence parsing.
86 It also does the following error checks:
89 Checks that tyvars are used properly. This includes checking
90 for undefined tyvars, and tyvars in contexts that are ambiguous.
91 (Some of this checking has now been moved to module @TcMonoType@,
92 since we don't have functional dependency information at this point.)
94 Checks that all variable occurences are defined.
96 Checks the @(..)@ etc constraints in the export list.
101 -- Brings the binders of the group into scope in the appropriate places;
102 -- does NOT assume that anything is in scope already
104 -- The Bool determines whether (True) names in the group shadow existing
105 -- Unquals in the global environment (used in Template Haskell) or
106 -- (False) whether duplicates are reported as an error
107 rnSrcDecls :: Bool -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
109 rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls,
110 hs_tyclds = tycl_decls,
111 hs_instds = inst_decls,
112 hs_derivds = deriv_decls,
113 hs_fixds = fix_decls,
114 hs_depds = deprec_decls,
115 hs_fords = foreign_decls,
116 hs_defds = default_decls,
117 hs_ruleds = rule_decls,
120 -- (A) Process the fixity declarations, creating a mapping from
121 -- FastStrings to FixItems.
122 -- Also checks for duplcates.
123 local_fix_env <- makeMiniFixityEnv fix_decls;
125 -- (B) Bring top level binders (and their fixities) into scope,
126 -- *except* for the value bindings, which get brought in below.
127 avails <- getLocalNonValBinders group ;
128 tc_envs <- extendGlobalRdrEnvRn shadowP avails local_fix_env ;
129 setEnvs tc_envs $ do {
131 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
133 -- (C) Extract the mapping from data constructors to field names and
134 -- extend the record field env.
135 -- This depends on the data constructors and field names being in
136 -- scope from (B) above
137 inNewEnv (extendRecordFieldEnv tycl_decls) $ \ _ -> do {
139 -- (D) Rename the left-hand sides of the value bindings.
140 -- This depends on everything from (B) being in scope,
141 -- and on (C) for resolving record wild cards.
142 -- It uses the fixity env from (A) to bind fixities for view patterns.
143 new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
144 -- bind the LHSes (and their fixities) in the global rdr environment
145 let { lhs_binders = map unLoc $ collectHsValBinders new_lhs;
146 lhs_avails = map Avail lhs_binders
148 (tcg_env, tcl_env) <- extendGlobalRdrEnvRn shadowP lhs_avails local_fix_env ;
149 setEnvs (tcg_env, tcl_env) $ do {
151 -- Now everything is in scope, as the remaining renaming assumes.
153 -- (E) Rename type and class decls
154 -- (note that value LHSes need to be in scope for default methods)
156 -- You might think that we could build proper def/use information
157 -- for type and class declarations, but they can be involved
158 -- in mutual recursion across modules, and we only do the SCC
159 -- analysis for them in the type checker.
160 -- So we content ourselves with gathering uses only; that
161 -- means we'll only report a declaration as unused if it isn't
162 -- mentioned at all. Ah well.
163 traceRn (text "Start rnTyClDecls") ;
164 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
166 -- (F) Rename Value declarations right-hand sides
167 traceRn (text "Start rnmono") ;
168 (rn_val_decls, bind_dus) <- rnTopBindsRHS lhs_binders new_lhs ;
169 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
171 -- (G) Rename Fixity and deprecations
173 -- rename fixity declarations and error if we try to
174 -- fix something from another module (duplicates were checked in (A))
175 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
176 -- rename deprec decls;
177 -- check for duplicates and ensure that deprecated things are defined locally
178 -- at the moment, we don't keep these around past renaming
179 rn_deprecs <- rnSrcDeprecDecls deprec_decls ;
181 -- (H) Rename Everything else
183 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
184 (rn_rule_decls, src_fvs3) <- rnList rnHsRuleDecl rule_decls ;
185 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
186 (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ;
187 (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ;
188 -- Haddock docs; no free vars
189 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
191 -- (I) Compute the results and return
192 let {rn_group = HsGroup { hs_valds = rn_val_decls,
193 hs_tyclds = rn_tycl_decls,
194 hs_instds = rn_inst_decls,
195 hs_derivds = rn_deriv_decls,
196 hs_fixds = rn_fix_decls,
197 hs_depds = [], -- deprecs are returned in the tcg_env (see below)
198 -- not in the HsGroup
199 hs_fords = rn_foreign_decls,
200 hs_defds = rn_default_decls,
201 hs_ruleds = rn_rule_decls,
202 hs_docs = rn_docs } ;
204 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
205 src_fvs4, src_fvs5] ;
206 src_dus = bind_dus `plusDU` usesOnly other_fvs;
207 -- Note: src_dus will contain *uses* for locally-defined types
208 -- and classes, but no *defs* for them. (Because rnTyClDecl
209 -- returns only the uses.) This is a little
210 -- surprising but it doesn't actually matter at all.
212 final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
213 in -- we return the deprecs in the env, not in the HsGroup above
214 tcg_env' { tcg_deprecs = tcg_deprecs tcg_env' `plusDeprecs` rn_deprecs };
217 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
218 traceRn (text "finish Dus" <+> ppr src_dus ) ;
219 return (final_tcg_env , rn_group)
222 -- some utils because we do this a bunch above
223 -- compute and install the new env
224 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
225 inNewEnv env cont = do e <- env
228 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
229 -- Used for external core
230 rnTyClDecls tycl_decls = do (decls', fvs) <- rnList rnTyClDecl tycl_decls
233 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
234 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
236 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
237 rnList f xs = mapFvRn (wrapLocFstM f) xs
241 %*********************************************************
245 %*********************************************************
248 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
249 rnDocDecl (DocCommentNext doc) = do
250 rn_doc <- rnHsDoc doc
251 return (DocCommentNext rn_doc)
252 rnDocDecl (DocCommentPrev doc) = do
253 rn_doc <- rnHsDoc doc
254 return (DocCommentPrev rn_doc)
255 rnDocDecl (DocCommentNamed str doc) = do
256 rn_doc <- rnHsDoc doc
257 return (DocCommentNamed str rn_doc)
258 rnDocDecl (DocGroup lev doc) = do
259 rn_doc <- rnHsDoc doc
260 return (DocGroup lev rn_doc)
264 %*********************************************************
266 Source-code fixity declarations
268 %*********************************************************
271 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
272 -- Rename the fixity decls, so we can put
273 -- the renamed decls in the renamed syntax tree
274 -- Errors if the thing being fixed is not defined locally.
275 rnSrcFixityDecls 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 -- add both to the fixity env
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 rdr_name
288 return [ L loc (FixitySig (L name_loc name) fixity)
293 %*********************************************************
295 Source-code deprecations declarations
297 %*********************************************************
299 Check that the deprecated names are defined, are defined locally, and
300 that there are no duplicate deprecations.
302 It's only imported deprecations, dealt with in RnIfaces, that we
303 gather them together.
306 -- checks that the deprecations are defined locally, and that there are no duplicates
307 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
311 rnSrcDeprecDecls decls
312 = do { -- check for duplicates
313 ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupDeprecDecl lrdr')) deprec_rdr_dups
314 ; mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
315 returnM (DeprecSome ((concat pairs_s))) }
317 rn_deprec (Deprecation rdr_name txt)
318 -- ensures that the names are defined locally
319 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
320 returnM [(nameOccName name, txt) | name <- names]
322 -- look for duplicates among the OccNames;
323 -- we check that the names are defined above
324 -- invt: the lists returned by findDupsEq always have at least two elements
325 deprec_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
326 (map (\ (L loc (Deprecation rdr_name _)) -> L loc rdr_name) decls)
328 dupDeprecDecl (L loc _) rdr_name
329 = vcat [ptext SLIT("Multiple deprecation declarations for") <+> quotes (ppr rdr_name),
330 ptext SLIT("also at ") <+> ppr loc]
334 %*********************************************************
336 \subsection{Source code declarations}
338 %*********************************************************
341 rnDefaultDecl (DefaultDecl tys)
342 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
343 returnM (DefaultDecl tys', fvs)
345 doc_str = text "In a `default' declaration"
348 %*********************************************************
350 \subsection{Foreign declarations}
352 %*********************************************************
355 rnHsForeignDecl (ForeignImport name ty spec)
356 = lookupLocatedTopBndrRn name `thenM` \ name' ->
357 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
358 returnM (ForeignImport name' ty' spec, fvs)
360 rnHsForeignDecl (ForeignExport name ty spec)
361 = lookupLocatedOccRn name `thenM` \ name' ->
362 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
363 returnM (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
364 -- NB: a foreign export is an *occurrence site* for name, so
365 -- we add it to the free-variable list. It might, for example,
366 -- be imported from another module
368 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
372 %*********************************************************
374 \subsection{Instance declarations}
376 %*********************************************************
379 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
380 -- Used for both source and interface file decls
381 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
383 -- Rename the bindings
384 -- The typechecker (not the renamer) checks that all
385 -- the bindings are for the right class
387 meth_doc = text "In the bindings in an instance declaration"
388 meth_names = collectHsBindLocatedBinders mbinds
389 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
391 checkDupRdrNames meth_doc meth_names `thenM_`
392 -- Check that the same method is not given twice in the
393 -- same instance decl instance C T where
397 -- We must use checkDupRdrNames because the Name of the
398 -- method is the Name of the class selector, whose SrcSpan
399 -- points to the class declaration
401 extendTyVarEnvForMethodBinds inst_tyvars (
402 -- (Slightly strangely) the forall-d tyvars scope over
403 -- the method bindings too
404 rnMethodBinds cls (\n->[]) -- No scoped tyvars
406 ) `thenM` \ (mbinds', meth_fvs) ->
407 -- Rename the associated types
408 -- The typechecker (not the renamer) checks that all
409 -- the declarations are for the right class
411 at_doc = text "In the associated types of an instance declaration"
412 at_names = map (head . tyClDeclNames . unLoc) ats
414 checkDupRdrNames at_doc at_names `thenM_`
415 -- See notes with checkDupRdrNames for methods, above
417 rnATInsts ats `thenM` \ (ats', at_fvs) ->
419 -- Rename the prags and signatures.
420 -- Note that the type variables are not in scope here,
421 -- so that instance Eq a => Eq (T a) where
422 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
425 -- But the (unqualified) method names are in scope
427 binders = collectHsBindBinders mbinds'
428 ok_sig = okInstDclSig (mkNameSet binders)
430 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
432 returnM (InstDecl inst_ty' mbinds' uprags' ats',
433 meth_fvs `plusFV` at_fvs
434 `plusFV` hsSigsFVs uprags'
435 `plusFV` extractHsTyNames inst_ty')
436 -- We return the renamed associated data type declarations so
437 -- that they can be entered into the list of type declarations
438 -- for the binding group, but we also keep a copy in the instance.
439 -- The latter is needed for well-formedness checks in the type
440 -- checker (eg, to ensure that all ATs of the instance actually
441 -- receive a declaration).
442 -- NB: Even the copies in the instance declaration carry copies of
443 -- the instance context after renaming. This is a bit
444 -- strange, but should not matter (and it would be more work
445 -- to remove the context).
448 Renaming of the associated types in instances.
451 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
452 rnATInsts atDecls = rnList rnATInst atDecls
454 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
455 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
457 pprPanic "RnSource.rnATInsts: invalid AT instance"
458 (ppr (tcdName tydecl))
461 For the method bindings in class and instance decls, we extend the
462 type variable environment iff -fglasgow-exts
465 extendTyVarEnvForMethodBinds tyvars thing_inside
466 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
468 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
473 %*********************************************************
475 \subsection{Stand-alone deriving declarations}
477 %*********************************************************
480 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
481 rnSrcDerivDecl (DerivDecl ty)
482 = do ty' <- rnLHsType (text "a deriving decl") ty
483 let fvs = extractHsTyNames ty'
484 return (DerivDecl ty', fvs)
487 %*********************************************************
491 %*********************************************************
494 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
495 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
497 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
498 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
500 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
501 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
503 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
505 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
506 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
508 doc = text "In the transformation rule" <+> ftext rule_name
510 get_var (RuleBndr v) = v
511 get_var (RuleBndrSig v _) = v
513 rn_var (RuleBndr (L loc v), id)
514 = returnM (RuleBndr (L loc id), emptyFVs)
515 rn_var (RuleBndrSig (L loc v) t, id)
516 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
517 returnM (RuleBndrSig (L loc id) t', fvs)
520 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
521 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
522 ptext SLIT("does not appear on left hand side")]
525 Note [Rule LHS validity checking]
526 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
527 Check the shape of a transformation rule LHS. Currently we only allow
528 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
529 @forall@'d variables.
531 We used restrict the form of the 'ei' to prevent you writing rules
532 with LHSs with a complicated desugaring (and hence unlikely to match);
533 (e.g. a case expression is not allowed: too elaborate.)
535 But there are legitimate non-trivial args ei, like sections and
536 lambdas. So it seems simmpler not to check at all, and that is why
537 check_e is commented out.
540 checkValidRule rule_name ids lhs' fv_lhs'
541 = do { -- Check for the form of the LHS
542 case (validRuleLhs ids lhs') of
544 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
546 -- Check that LHS vars are all bound
547 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
548 ; mappM (addErr . badRuleVar rule_name) bad_vars }
550 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
552 -- Just e => Not ok, and e is the offending expression
553 validRuleLhs foralls lhs
556 checkl (L loc e) = check e
558 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
559 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
560 check (HsVar v) | v `notElem` foralls = Nothing
561 check other = Just other -- Failure
564 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
566 {- Commented out; see Note [Rule LHS validity checking] above
567 check_e (HsVar v) = Nothing
568 check_e (HsPar e) = checkl_e e
569 check_e (HsLit e) = Nothing
570 check_e (HsOverLit e) = Nothing
572 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
573 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
574 check_e (NegApp e _) = checkl_e e
575 check_e (ExplicitList _ es) = checkl_es es
576 check_e (ExplicitTuple es _) = checkl_es es
577 check_e other = Just other -- Fails
579 checkl_es es = foldr (mplus . checkl_e) Nothing es
582 badRuleLhsErr name lhs bad_e
583 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
584 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
585 ptext SLIT("in left-hand side:") <+> ppr lhs])]
587 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
591 %*********************************************************
593 \subsection{Type, class and iface sig declarations}
595 %*********************************************************
597 @rnTyDecl@ uses the `global name function' to create a new type
598 declaration in which local names have been replaced by their original
599 names, reporting any unknown names.
601 Renaming type variables is a pain. Because they now contain uniques,
602 it is necessary to pass in an association list which maps a parsed
603 tyvar to its @Name@ representation.
604 In some cases (type signatures of values),
605 it is even necessary to go over the type first
606 in order to get the set of tyvars used by it, make an assoc list,
607 and then go over it again to rename the tyvars!
608 However, we can also do some scoping checks at the same time.
611 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
612 = lookupLocatedTopBndrRn name `thenM` \ name' ->
613 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
616 -- all flavours of type family declarations ("type family", "newtype fanily",
617 -- and "data family")
618 rnTyClDecl (tydecl@TyFamily {}) =
619 rnFamily tydecl bindTyVarsRn
621 -- "data", "newtype", "data instance, and "newtype instance" declarations
622 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
623 tcdLName = tycon, tcdTyVars = tyvars,
624 tcdTyPats = typatsMaybe, tcdCons = condecls,
625 tcdKindSig = sig, tcdDerivs = derivs})
626 | is_vanilla -- Normal Haskell data type decl
627 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
628 -- data type is syntactically illegal
629 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
630 do { tycon' <- if isFamInstDecl tydecl
631 then lookupLocatedOccRn tycon -- may be imported family
632 else lookupLocatedTopBndrRn tycon
633 ; context' <- rnContext data_doc context
634 ; typats' <- rnTyPats data_doc typatsMaybe
635 ; (derivs', deriv_fvs) <- rn_derivs derivs
636 ; condecls' <- rnConDecls (unLoc tycon') condecls
637 -- No need to check for duplicate constructor decls
638 -- since that is done by RnNames.extendGlobalRdrEnvRn
639 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
640 tcdLName = tycon', tcdTyVars = tyvars',
641 tcdTyPats = typats', tcdKindSig = Nothing,
642 tcdCons = condecls', tcdDerivs = derivs'},
643 delFVs (map hsLTyVarName tyvars') $
644 extractHsCtxtTyNames context' `plusFV`
645 plusFVs (map conDeclFVs condecls') `plusFV`
647 (if isFamInstDecl tydecl
648 then unitFV (unLoc tycon') -- type instance => use
653 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
654 do { tycon' <- if isFamInstDecl tydecl
655 then lookupLocatedOccRn tycon -- may be imported family
656 else lookupLocatedTopBndrRn tycon
657 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
658 ; tyvars' <- bindTyVarsRn data_doc tyvars
659 (\ tyvars' -> return tyvars')
660 -- For GADTs, the type variables in the declaration
661 -- do not scope over the constructor signatures
662 -- data T a where { T1 :: forall b. b-> b }
663 ; (derivs', deriv_fvs) <- rn_derivs derivs
664 ; condecls' <- rnConDecls (unLoc tycon') condecls
665 -- No need to check for duplicate constructor decls
666 -- since that is done by RnNames.extendGlobalRdrEnvRn
667 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
668 tcdLName = tycon', tcdTyVars = tyvars',
669 tcdTyPats = Nothing, tcdKindSig = sig,
670 tcdCons = condecls', tcdDerivs = derivs'},
671 plusFVs (map conDeclFVs condecls') `plusFV`
673 (if isFamInstDecl tydecl
674 then unitFV (unLoc tycon') -- type instance => use
678 is_vanilla = case condecls of -- Yuk
680 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
684 none (Just []) = True
687 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
688 con_names = map con_names_helper condecls
690 con_names_helper (L _ c) = con_name c
692 rn_derivs Nothing = returnM (Nothing, emptyFVs)
693 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
694 returnM (Just ds', extractHsTyNames_s ds')
696 -- "type" and "type instance" declarations
697 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
698 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
699 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
700 do { name' <- if isFamInstDecl tydecl
701 then lookupLocatedOccRn name -- may be imported family
702 else lookupLocatedTopBndrRn name
703 ; typats' <- rnTyPats syn_doc typatsMaybe
704 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
705 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
706 tcdTyPats = typats', tcdSynRhs = ty'},
707 delFVs (map hsLTyVarName tyvars') $
709 (if isFamInstDecl tydecl
710 then unitFV (unLoc name') -- type instance => use
714 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
716 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
717 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
718 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
719 = do { cname' <- lookupLocatedTopBndrRn cname
721 -- Tyvars scope over superclass context and method signatures
722 ; (tyvars', context', fds', ats', ats_fvs, sigs')
723 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
724 { context' <- rnContext cls_doc context
725 ; fds' <- rnFds cls_doc fds
726 ; (ats', ats_fvs) <- rnATs ats
727 ; sigs' <- renameSigs okClsDclSig sigs
728 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
730 -- No need to check for duplicate associated type decls
731 -- since that is done by RnNames.extendGlobalRdrEnvRn
733 -- Check the signatures
734 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
735 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
736 ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
737 -- Typechecker is responsible for checking that we only
738 -- give default-method bindings for things in this class.
739 -- The renamer *could* check this for class decls, but can't
740 -- for instance decls.
742 -- The newLocals call is tiresome: given a generic class decl
745 -- op {| x+y |} (Inl a) = ...
746 -- op {| x+y |} (Inr b) = ...
747 -- op {| a*b |} (a*b) = ...
748 -- we want to name both "x" tyvars with the same unique, so that they are
749 -- easy to group together in the typechecker.
750 ; (mbinds', meth_fvs)
751 <- extendTyVarEnvForMethodBinds tyvars' $ do
752 { name_env <- getLocalRdrEnv
753 ; let meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
754 gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
755 not (unLoc tv `elemLocalRdrEnv` name_env) ]
756 -- No need to check for duplicate method signatures
757 -- since that is done by RnNames.extendGlobalRdrEnvRn
758 -- and the methods are already in scope
759 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
760 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
763 ; docs' <- mapM (wrapLocM rnDocDecl) docs
765 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
766 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
767 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
769 delFVs (map hsLTyVarName tyvars') $
770 extractHsCtxtTyNames context' `plusFV`
771 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
772 hsSigsFVs sigs' `plusFV`
776 meth_doc = text "In the default-methods for class" <+> ppr cname
777 cls_doc = text "In the declaration for class" <+> ppr cname
778 sig_doc = text "In the signatures for class" <+> ppr cname
779 at_doc = text "In the associated types for class" <+> ppr cname
781 badGadtStupidTheta tycon
782 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
783 ptext SLIT("(You can put a context on each contructor, though.)")]
786 %*********************************************************
788 \subsection{Support code for type/data declarations}
790 %*********************************************************
793 -- Although, we are processing type patterns here, all type variables will
794 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
795 -- type declaration to which these patterns belong)
797 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
798 rnTyPats _ Nothing = return Nothing
799 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
801 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
802 rnConDecls tycon condecls
803 = mappM (wrapLocM rnConDecl) condecls
805 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
806 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
807 = do { addLocM checkConName name
809 ; new_name <- lookupLocatedTopBndrRn name
810 ; name_env <- getLocalRdrEnv
812 -- For H98 syntax, the tvs are the existential ones
813 -- For GADT syntax, the tvs are all the quantified tyvars
814 -- Hence the 'filter' in the ResTyH98 case only
815 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
816 arg_tys = hsConDeclArgTys details
817 implicit_tvs = case res_ty of
818 ResTyH98 -> filter not_in_scope $
820 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
823 Implicit -> userHsTyVarBndrs implicit_tvs
825 ; mb_doc' <- rnMbLHsDoc mb_doc
827 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
828 { new_context <- rnContext doc cxt
829 ; new_details <- rnConDeclDetails doc details
830 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
831 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
833 doc = text "In the definition of data constructor" <+> quotes (ppr name)
834 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
836 rnConResult _ details ResTyH98 = return (details, ResTyH98)
838 rnConResult doc details (ResTyGADT ty) = do
839 ty' <- rnHsSigType doc ty
840 let (arg_tys, res_ty) = splitHsFunType ty'
841 -- We can split it up, now the renamer has dealt with fixities
843 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
844 RecCon fields -> return (details, ResTyGADT ty')
845 InfixCon {} -> panic "rnConResult"
847 rnConDeclDetails doc (PrefixCon tys)
848 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
849 returnM (PrefixCon new_tys)
851 rnConDeclDetails doc (InfixCon ty1 ty2)
852 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
853 rnLHsType doc ty2 `thenM` \ new_ty2 ->
854 returnM (InfixCon new_ty1 new_ty2)
856 rnConDeclDetails doc (RecCon fields)
857 = do { new_fields <- mappM (rnField doc) fields
858 -- No need to check for duplicate fields
859 -- since that is done by RnNames.extendGlobalRdrEnvRn
860 ; return (RecCon new_fields) }
862 rnField doc (ConDeclField name ty haddock_doc)
863 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
864 rnLHsType doc ty `thenM` \ new_ty ->
865 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
866 returnM (ConDeclField new_name new_ty new_haddock_doc)
868 -- Rename family declarations
870 -- * This function is parametrised by the routine handling the index
871 -- variables. On the toplevel, these are defining occurences, whereas they
872 -- are usage occurences for associated types.
874 rnFamily :: TyClDecl RdrName
875 -> (SDoc -> [LHsTyVarBndr RdrName] ->
876 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
877 RnM (TyClDecl Name, FreeVars))
878 -> RnM (TyClDecl Name, FreeVars)
880 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
881 tcdLName = tycon, tcdTyVars = tyvars})
883 do { checkM (isDataFlavour flavour -- for synonyms,
884 || not (null tyvars)) $ addErr needOneIdx -- #indexes >= 1
885 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
886 ; tycon' <- lookupLocatedTopBndrRn tycon
887 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
888 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
892 isDataFlavour DataFamily = True
893 isDataFlavour _ = False
895 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
896 needOneIdx = text "Type family declarations requires at least one type index"
898 -- Rename associated type declarations (in classes)
900 -- * This can be family declarations and (default) type instances
902 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
903 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
905 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
906 rn_at (tydecl@TySynonym {}) =
908 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
910 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
912 lookupIdxVars _ tyvars cont =
913 do { checkForDups tyvars;
914 ; tyvars' <- mappM lookupIdxVar tyvars
917 -- Type index variables must be class parameters, which are the only
918 -- type variables in scope at this point.
919 lookupIdxVar (L l tyvar) =
921 name' <- lookupOccRn (hsTyVarName tyvar)
922 return $ L l (replaceTyVarName tyvar name')
924 -- Type variable may only occur once.
926 checkForDups [] = return ()
927 checkForDups (L loc tv:ltvs) =
928 do { setSrcSpan loc $
929 when (hsTyVarName tv `ltvElem` ltvs) $
930 addErr (repeatedTyVar tv)
934 rdrName `ltvElem` [] = False
935 rdrName `ltvElem` (L _ tv:ltvs)
936 | rdrName == hsTyVarName tv = True
937 | otherwise = rdrName `ltvElem` ltvs
939 noPatterns = text "Default definition for an associated synonym cannot have"
940 <+> text "type pattern"
942 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
945 -- This data decl will parse OK
947 -- treating "a" as the constructor.
948 -- It is really hard to make the parser spot this malformation.
949 -- So the renamer has to check that the constructor is legal
951 -- We can get an operator as the constructor, even in the prefix form:
952 -- data T = :% Int Int
953 -- from interface files, which always print in prefix form
955 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
958 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
962 %*********************************************************
964 \subsection{Support code for type/data declarations}
966 %*********************************************************
968 Get the mapping from constructors to fields for this module.
969 It's convenient to do this after the data type decls have been renamed
971 extendRecordFieldEnv :: [LTyClDecl RdrName] -> TcM TcGblEnv
972 extendRecordFieldEnv decls
973 = do { tcg_env <- getGblEnv
974 ; field_env' <- foldrM get (tcg_field_env tcg_env) decls
975 ; return (tcg_env { tcg_field_env = field_env' }) }
977 -- we want to lookup:
978 -- (a) a datatype constructor
979 -- (b) a record field
980 -- knowing that they're from this module.
981 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
982 -- which keeps only the local ones.
983 lookup x = do { x' <- lookupLocatedTopBndrRn x
986 get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
987 get other env = return env
989 get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
990 = do { con' <- lookup con
991 ; flds' <- mappM lookup (map cd_fld_name flds)
992 ; return $ extendNameEnv env con' flds' }
997 %*********************************************************
999 \subsection{Support code to rename types}
1001 %*********************************************************
1004 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1007 = mappM (wrapLocM rn_fds) fds
1010 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1011 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1012 returnM (tys1', tys2')
1014 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
1015 rnHsTyvar doc tyvar = lookupOccRn tyvar
1019 %*********************************************************
1023 %*********************************************************
1029 h = ...$(thing "f")...
1031 The splice can expand into literally anything, so when we do dependency
1032 analysis we must assume that it might mention 'f'. So we simply treat
1033 all locally-defined names as mentioned by any splice. This is terribly
1034 brutal, but I don't see what else to do. For example, it'll mean
1035 that every locally-defined thing will appear to be used, so no unused-binding
1036 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
1037 and that will crash the type checker because 'f' isn't in scope.
1039 Currently, I'm not treating a splice as also mentioning every import,
1040 which is a bit inconsistent -- but there are a lot of them. We might
1041 thereby get some bogus unused-import warnings, but we won't crash the
1042 type checker. Not very satisfactory really.
1045 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
1046 rnSplice (HsSplice n expr)
1047 = do { checkTH expr "splice"
1048 ; loc <- getSrcSpanM
1049 ; [n'] <- newLocalsRn [L loc n]
1050 ; (expr', fvs) <- rnLExpr expr
1052 -- Ugh! See Note [Splices] above
1053 ; lcl_rdr <- getLocalRdrEnv
1054 ; gbl_rdr <- getGlobalRdrEnv
1055 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
1057 lcl_names = mkNameSet (occEnvElts lcl_rdr)
1059 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
1062 checkTH e what = returnM () -- OK
1064 checkTH e what -- Raise an error in a stage-1 compiler
1065 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
1066 ptext SLIT("illegal in a stage-1 compiler"),