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
198 -- (see below) 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.
276 -- The returned FixitySigs are not actually used for anything,
277 -- except perhaps the GHCi API
278 rnSrcFixityDecls fix_decls
279 = do fix_decls <- mapM rn_decl fix_decls
280 return (concat fix_decls)
282 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
283 -- GHC extension: look up both the tycon and data con
284 -- for con-like things; hence returning a list
285 -- If neither are in scope, report an error; otherwise
286 -- return a fixity sig for each (slightly odd)
287 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
288 = setSrcSpan name_loc $
289 -- this lookup will fail if the definition isn't local
290 do names <- lookupLocalDataTcNames rdr_name
291 return [ L loc (FixitySig (L name_loc name) fixity)
296 %*********************************************************
298 Source-code deprecations declarations
300 %*********************************************************
302 Check that the deprecated names are defined, are defined locally, and
303 that there are no duplicate deprecations.
305 It's only imported deprecations, dealt with in RnIfaces, that we
306 gather them together.
309 -- checks that the deprecations are defined locally, and that there are no duplicates
310 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
314 rnSrcDeprecDecls decls
315 = do { -- check for duplicates
316 ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupDeprecDecl lrdr')) deprec_rdr_dups
317 ; mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
318 returnM (DeprecSome ((concat pairs_s))) }
320 rn_deprec (Deprecation rdr_name txt)
321 -- ensures that the names are defined locally
322 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
323 returnM [(nameOccName name, txt) | name <- names]
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 deprec_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
329 (map (\ (L loc (Deprecation rdr_name _)) -> L loc rdr_name) decls)
331 dupDeprecDecl (L loc _) rdr_name
332 = vcat [ptext SLIT("Multiple deprecation declarations for") <+> quotes (ppr rdr_name),
333 ptext SLIT("also at ") <+> ppr loc]
337 %*********************************************************
339 \subsection{Source code declarations}
341 %*********************************************************
344 rnDefaultDecl (DefaultDecl tys)
345 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
346 returnM (DefaultDecl tys', fvs)
348 doc_str = text "In a `default' declaration"
351 %*********************************************************
353 \subsection{Foreign declarations}
355 %*********************************************************
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 name = ptext SLIT("In the foreign declaration for") <+> ppr name
375 %*********************************************************
377 \subsection{Instance declarations}
379 %*********************************************************
382 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
383 -- Used for both source and interface file decls
384 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
386 -- Rename the bindings
387 -- The typechecker (not the renamer) checks that all
388 -- the bindings are for the right class
390 meth_doc = text "In the bindings in an instance declaration"
391 meth_names = collectHsBindLocatedBinders mbinds
392 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
394 checkDupRdrNames meth_doc meth_names `thenM_`
395 -- Check that the same method is not given twice in the
396 -- same instance decl instance C T where
400 -- We must use checkDupRdrNames because the Name of the
401 -- method is the Name of the class selector, whose SrcSpan
402 -- points to the class declaration
404 extendTyVarEnvForMethodBinds inst_tyvars (
405 -- (Slightly strangely) the forall-d tyvars scope over
406 -- the method bindings too
407 rnMethodBinds cls (\n->[]) -- No scoped tyvars
409 ) `thenM` \ (mbinds', meth_fvs) ->
410 -- Rename the associated types
411 -- The typechecker (not the renamer) checks that all
412 -- the declarations are for the right class
414 at_doc = text "In the associated types of an instance declaration"
415 at_names = map (head . tyClDeclNames . unLoc) ats
417 checkDupRdrNames at_doc at_names `thenM_`
418 -- See notes with checkDupRdrNames for methods, above
420 rnATInsts ats `thenM` \ (ats', at_fvs) ->
422 -- Rename the prags and signatures.
423 -- Note that the type variables are not in scope here,
424 -- so that instance Eq a => Eq (T a) where
425 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
428 -- But the (unqualified) method names are in scope
430 binders = collectHsBindBinders mbinds'
431 ok_sig = okInstDclSig (mkNameSet binders)
433 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
435 returnM (InstDecl inst_ty' mbinds' uprags' ats',
436 meth_fvs `plusFV` at_fvs
437 `plusFV` hsSigsFVs uprags'
438 `plusFV` extractHsTyNames inst_ty')
439 -- We return the renamed associated data type declarations so
440 -- that they can be entered into the list of type declarations
441 -- for the binding group, but we also keep a copy in the instance.
442 -- The latter is needed for well-formedness checks in the type
443 -- checker (eg, to ensure that all ATs of the instance actually
444 -- receive a declaration).
445 -- NB: Even the copies in the instance declaration carry copies of
446 -- the instance context after renaming. This is a bit
447 -- strange, but should not matter (and it would be more work
448 -- to remove the context).
451 Renaming of the associated types in instances.
454 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
455 rnATInsts atDecls = rnList rnATInst atDecls
457 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
458 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
460 pprPanic "RnSource.rnATInsts: invalid AT instance"
461 (ppr (tcdName tydecl))
464 For the method bindings in class and instance decls, we extend the
465 type variable environment iff -fglasgow-exts
468 extendTyVarEnvForMethodBinds tyvars thing_inside
469 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
471 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
476 %*********************************************************
478 \subsection{Stand-alone deriving declarations}
480 %*********************************************************
483 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
484 rnSrcDerivDecl (DerivDecl ty)
485 = do ty' <- rnLHsType (text "a deriving decl") ty
486 let fvs = extractHsTyNames ty'
487 return (DerivDecl ty', fvs)
490 %*********************************************************
494 %*********************************************************
497 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
498 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
500 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
501 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
503 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
504 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
506 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
508 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
509 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
511 doc = text "In the transformation rule" <+> ftext rule_name
513 get_var (RuleBndr v) = v
514 get_var (RuleBndrSig v _) = v
516 rn_var (RuleBndr (L loc v), id)
517 = returnM (RuleBndr (L loc id), emptyFVs)
518 rn_var (RuleBndrSig (L loc v) t, id)
519 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
520 returnM (RuleBndrSig (L loc id) t', fvs)
523 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
524 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
525 ptext SLIT("does not appear on left hand side")]
528 Note [Rule LHS validity checking]
529 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
530 Check the shape of a transformation rule LHS. Currently we only allow
531 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
532 @forall@'d variables.
534 We used restrict the form of the 'ei' to prevent you writing rules
535 with LHSs with a complicated desugaring (and hence unlikely to match);
536 (e.g. a case expression is not allowed: too elaborate.)
538 But there are legitimate non-trivial args ei, like sections and
539 lambdas. So it seems simmpler not to check at all, and that is why
540 check_e is commented out.
543 checkValidRule rule_name ids lhs' fv_lhs'
544 = do { -- Check for the form of the LHS
545 case (validRuleLhs ids lhs') of
547 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
549 -- Check that LHS vars are all bound
550 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
551 ; mappM (addErr . badRuleVar rule_name) bad_vars }
553 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
555 -- Just e => Not ok, and e is the offending expression
556 validRuleLhs foralls lhs
559 checkl (L loc e) = check e
561 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
562 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
563 check (HsVar v) | v `notElem` foralls = Nothing
564 check other = Just other -- Failure
567 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
569 {- Commented out; see Note [Rule LHS validity checking] above
570 check_e (HsVar v) = Nothing
571 check_e (HsPar e) = checkl_e e
572 check_e (HsLit e) = Nothing
573 check_e (HsOverLit e) = Nothing
575 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
576 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
577 check_e (NegApp e _) = checkl_e e
578 check_e (ExplicitList _ es) = checkl_es es
579 check_e (ExplicitTuple es _) = checkl_es es
580 check_e other = Just other -- Fails
582 checkl_es es = foldr (mplus . checkl_e) Nothing es
585 badRuleLhsErr name lhs bad_e
586 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
587 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
588 ptext SLIT("in left-hand side:") <+> ppr lhs])]
590 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
594 %*********************************************************
596 \subsection{Type, class and iface sig declarations}
598 %*********************************************************
600 @rnTyDecl@ uses the `global name function' to create a new type
601 declaration in which local names have been replaced by their original
602 names, reporting any unknown names.
604 Renaming type variables is a pain. Because they now contain uniques,
605 it is necessary to pass in an association list which maps a parsed
606 tyvar to its @Name@ representation.
607 In some cases (type signatures of values),
608 it is even necessary to go over the type first
609 in order to get the set of tyvars used by it, make an assoc list,
610 and then go over it again to rename the tyvars!
611 However, we can also do some scoping checks at the same time.
614 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
615 = lookupLocatedTopBndrRn name `thenM` \ name' ->
616 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
619 -- all flavours of type family declarations ("type family", "newtype fanily",
620 -- and "data family")
621 rnTyClDecl (tydecl@TyFamily {}) =
622 rnFamily tydecl bindTyVarsRn
624 -- "data", "newtype", "data instance, and "newtype instance" declarations
625 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
626 tcdLName = tycon, tcdTyVars = tyvars,
627 tcdTyPats = typatsMaybe, tcdCons = condecls,
628 tcdKindSig = sig, tcdDerivs = derivs})
629 | is_vanilla -- Normal Haskell data type decl
630 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
631 -- data type is syntactically illegal
632 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
633 do { tycon' <- if isFamInstDecl tydecl
634 then lookupLocatedOccRn tycon -- may be imported family
635 else lookupLocatedTopBndrRn tycon
636 ; context' <- rnContext data_doc context
637 ; typats' <- rnTyPats data_doc typatsMaybe
638 ; (derivs', deriv_fvs) <- rn_derivs derivs
639 ; condecls' <- rnConDecls (unLoc tycon') condecls
640 -- No need to check for duplicate constructor decls
641 -- since that is done by RnNames.extendGlobalRdrEnvRn
642 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
643 tcdLName = tycon', tcdTyVars = tyvars',
644 tcdTyPats = typats', tcdKindSig = Nothing,
645 tcdCons = condecls', tcdDerivs = derivs'},
646 delFVs (map hsLTyVarName tyvars') $
647 extractHsCtxtTyNames context' `plusFV`
648 plusFVs (map conDeclFVs condecls') `plusFV`
650 (if isFamInstDecl tydecl
651 then unitFV (unLoc tycon') -- type instance => use
656 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
657 do { tycon' <- if isFamInstDecl tydecl
658 then lookupLocatedOccRn tycon -- may be imported family
659 else lookupLocatedTopBndrRn tycon
660 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
661 ; tyvars' <- bindTyVarsRn data_doc tyvars
662 (\ tyvars' -> return tyvars')
663 -- For GADTs, the type variables in the declaration
664 -- do not scope over the constructor signatures
665 -- data T a where { T1 :: forall b. b-> b }
666 ; (derivs', deriv_fvs) <- rn_derivs derivs
667 ; condecls' <- rnConDecls (unLoc tycon') condecls
668 -- No need to check for duplicate constructor decls
669 -- since that is done by RnNames.extendGlobalRdrEnvRn
670 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
671 tcdLName = tycon', tcdTyVars = tyvars',
672 tcdTyPats = Nothing, tcdKindSig = sig,
673 tcdCons = condecls', tcdDerivs = derivs'},
674 plusFVs (map conDeclFVs condecls') `plusFV`
676 (if isFamInstDecl tydecl
677 then unitFV (unLoc tycon') -- type instance => use
681 is_vanilla = case condecls of -- Yuk
683 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
687 none (Just []) = True
690 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
691 con_names = map con_names_helper condecls
693 con_names_helper (L _ c) = con_name c
695 rn_derivs Nothing = returnM (Nothing, emptyFVs)
696 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
697 returnM (Just ds', extractHsTyNames_s ds')
699 -- "type" and "type instance" declarations
700 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
701 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
702 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
703 do { name' <- if isFamInstDecl tydecl
704 then lookupLocatedOccRn name -- may be imported family
705 else lookupLocatedTopBndrRn name
706 ; typats' <- rnTyPats syn_doc typatsMaybe
707 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
708 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
709 tcdTyPats = typats', tcdSynRhs = ty'},
710 delFVs (map hsLTyVarName tyvars') $
712 (if isFamInstDecl tydecl
713 then unitFV (unLoc name') -- type instance => use
717 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
719 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
720 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
721 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
722 = do { cname' <- lookupLocatedTopBndrRn cname
724 -- Tyvars scope over superclass context and method signatures
725 ; (tyvars', context', fds', ats', ats_fvs, sigs')
726 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
727 { context' <- rnContext cls_doc context
728 ; fds' <- rnFds cls_doc fds
729 ; (ats', ats_fvs) <- rnATs ats
730 ; sigs' <- renameSigs okClsDclSig sigs
731 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
733 -- No need to check for duplicate associated type decls
734 -- since that is done by RnNames.extendGlobalRdrEnvRn
736 -- Check the signatures
737 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
738 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
739 ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
740 -- Typechecker is responsible for checking that we only
741 -- give default-method bindings for things in this class.
742 -- The renamer *could* check this for class decls, but can't
743 -- for instance decls.
745 -- The newLocals call is tiresome: given a generic class decl
748 -- op {| x+y |} (Inl a) = ...
749 -- op {| x+y |} (Inr b) = ...
750 -- op {| a*b |} (a*b) = ...
751 -- we want to name both "x" tyvars with the same unique, so that they are
752 -- easy to group together in the typechecker.
753 ; (mbinds', meth_fvs)
754 <- extendTyVarEnvForMethodBinds tyvars' $ do
755 { name_env <- getLocalRdrEnv
756 ; let meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
757 gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
758 not (unLoc tv `elemLocalRdrEnv` name_env) ]
759 -- No need to check for duplicate method signatures
760 -- since that is done by RnNames.extendGlobalRdrEnvRn
761 -- and the methods are already in scope
762 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
763 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
766 ; docs' <- mapM (wrapLocM rnDocDecl) docs
768 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
769 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
770 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
772 delFVs (map hsLTyVarName tyvars') $
773 extractHsCtxtTyNames context' `plusFV`
774 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
775 hsSigsFVs sigs' `plusFV`
779 meth_doc = text "In the default-methods for class" <+> ppr cname
780 cls_doc = text "In the declaration for class" <+> ppr cname
781 sig_doc = text "In the signatures for class" <+> ppr cname
782 at_doc = text "In the associated types for class" <+> ppr cname
784 badGadtStupidTheta tycon
785 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
786 ptext SLIT("(You can put a context on each contructor, though.)")]
789 %*********************************************************
791 \subsection{Support code for type/data declarations}
793 %*********************************************************
796 -- Although, we are processing type patterns here, all type variables will
797 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
798 -- type declaration to which these patterns belong)
800 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
801 rnTyPats _ Nothing = return Nothing
802 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
804 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
805 rnConDecls tycon condecls
806 = mappM (wrapLocM rnConDecl) condecls
808 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
809 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
810 = do { addLocM checkConName name
812 ; new_name <- lookupLocatedTopBndrRn name
813 ; name_env <- getLocalRdrEnv
815 -- For H98 syntax, the tvs are the existential ones
816 -- For GADT syntax, the tvs are all the quantified tyvars
817 -- Hence the 'filter' in the ResTyH98 case only
818 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
819 arg_tys = hsConDeclArgTys details
820 implicit_tvs = case res_ty of
821 ResTyH98 -> filter not_in_scope $
823 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
826 Implicit -> userHsTyVarBndrs implicit_tvs
828 ; mb_doc' <- rnMbLHsDoc mb_doc
830 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
831 { new_context <- rnContext doc cxt
832 ; new_details <- rnConDeclDetails doc details
833 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
834 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
836 doc = text "In the definition of data constructor" <+> quotes (ppr name)
837 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
839 rnConResult _ details ResTyH98 = return (details, ResTyH98)
841 rnConResult doc details (ResTyGADT ty) = do
842 ty' <- rnHsSigType doc ty
843 let (arg_tys, res_ty) = splitHsFunType ty'
844 -- We can split it up, now the renamer has dealt with fixities
846 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
847 RecCon fields -> return (details, ResTyGADT ty')
848 InfixCon {} -> panic "rnConResult"
850 rnConDeclDetails doc (PrefixCon tys)
851 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
852 returnM (PrefixCon new_tys)
854 rnConDeclDetails doc (InfixCon ty1 ty2)
855 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
856 rnLHsType doc ty2 `thenM` \ new_ty2 ->
857 returnM (InfixCon new_ty1 new_ty2)
859 rnConDeclDetails doc (RecCon fields)
860 = do { new_fields <- mappM (rnField doc) fields
861 -- No need to check for duplicate fields
862 -- since that is done by RnNames.extendGlobalRdrEnvRn
863 ; return (RecCon new_fields) }
865 rnField doc (ConDeclField name ty haddock_doc)
866 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
867 rnLHsType doc ty `thenM` \ new_ty ->
868 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
869 returnM (ConDeclField new_name new_ty new_haddock_doc)
871 -- Rename family declarations
873 -- * This function is parametrised by the routine handling the index
874 -- variables. On the toplevel, these are defining occurences, whereas they
875 -- are usage occurences for associated types.
877 rnFamily :: TyClDecl RdrName
878 -> (SDoc -> [LHsTyVarBndr RdrName] ->
879 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
880 RnM (TyClDecl Name, FreeVars))
881 -> RnM (TyClDecl Name, FreeVars)
883 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
884 tcdLName = tycon, tcdTyVars = tyvars})
886 do { checkM (isDataFlavour flavour -- for synonyms,
887 || not (null tyvars)) $ addErr needOneIdx -- #indexes >= 1
888 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
889 ; tycon' <- lookupLocatedTopBndrRn tycon
890 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
891 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
895 isDataFlavour DataFamily = True
896 isDataFlavour _ = False
898 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
899 needOneIdx = text "Type family declarations requires at least one type index"
901 -- Rename associated type declarations (in classes)
903 -- * This can be family declarations and (default) type instances
905 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
906 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
908 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
909 rn_at (tydecl@TySynonym {}) =
911 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
913 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
915 lookupIdxVars _ tyvars cont =
916 do { checkForDups tyvars;
917 ; tyvars' <- mappM lookupIdxVar tyvars
920 -- Type index variables must be class parameters, which are the only
921 -- type variables in scope at this point.
922 lookupIdxVar (L l tyvar) =
924 name' <- lookupOccRn (hsTyVarName tyvar)
925 return $ L l (replaceTyVarName tyvar name')
927 -- Type variable may only occur once.
929 checkForDups [] = return ()
930 checkForDups (L loc tv:ltvs) =
931 do { setSrcSpan loc $
932 when (hsTyVarName tv `ltvElem` ltvs) $
933 addErr (repeatedTyVar tv)
937 rdrName `ltvElem` [] = False
938 rdrName `ltvElem` (L _ tv:ltvs)
939 | rdrName == hsTyVarName tv = True
940 | otherwise = rdrName `ltvElem` ltvs
942 noPatterns = text "Default definition for an associated synonym cannot have"
943 <+> text "type pattern"
945 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
948 -- This data decl will parse OK
950 -- treating "a" as the constructor.
951 -- It is really hard to make the parser spot this malformation.
952 -- So the renamer has to check that the constructor is legal
954 -- We can get an operator as the constructor, even in the prefix form:
955 -- data T = :% Int Int
956 -- from interface files, which always print in prefix form
958 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
961 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
965 %*********************************************************
967 \subsection{Support code for type/data declarations}
969 %*********************************************************
971 Get the mapping from constructors to fields for this module.
972 It's convenient to do this after the data type decls have been renamed
974 extendRecordFieldEnv :: [LTyClDecl RdrName] -> TcM TcGblEnv
975 extendRecordFieldEnv decls
976 = do { tcg_env <- getGblEnv
977 ; field_env' <- foldrM get (tcg_field_env tcg_env) decls
978 ; return (tcg_env { tcg_field_env = field_env' }) }
980 -- we want to lookup:
981 -- (a) a datatype constructor
982 -- (b) a record field
983 -- knowing that they're from this module.
984 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
985 -- which keeps only the local ones.
986 lookup x = do { x' <- lookupLocatedTopBndrRn x
989 get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
990 get other env = return env
992 get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
993 = do { con' <- lookup con
994 ; flds' <- mappM lookup (map cd_fld_name flds)
995 ; return $ extendNameEnv env con' flds' }
1000 %*********************************************************
1002 \subsection{Support code to rename types}
1004 %*********************************************************
1007 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1010 = mappM (wrapLocM rn_fds) fds
1013 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1014 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1015 returnM (tys1', tys2')
1017 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
1018 rnHsTyvar doc tyvar = lookupOccRn tyvar
1022 %*********************************************************
1026 %*********************************************************
1032 h = ...$(thing "f")...
1034 The splice can expand into literally anything, so when we do dependency
1035 analysis we must assume that it might mention 'f'. So we simply treat
1036 all locally-defined names as mentioned by any splice. This is terribly
1037 brutal, but I don't see what else to do. For example, it'll mean
1038 that every locally-defined thing will appear to be used, so no unused-binding
1039 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
1040 and that will crash the type checker because 'f' isn't in scope.
1042 Currently, I'm not treating a splice as also mentioning every import,
1043 which is a bit inconsistent -- but there are a lot of them. We might
1044 thereby get some bogus unused-import warnings, but we won't crash the
1045 type checker. Not very satisfactory really.
1048 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
1049 rnSplice (HsSplice n expr)
1050 = do { checkTH expr "splice"
1051 ; loc <- getSrcSpanM
1052 ; [n'] <- newLocalsRn [L loc n]
1053 ; (expr', fvs) <- rnLExpr expr
1055 -- Ugh! See Note [Splices] above
1056 ; lcl_rdr <- getLocalRdrEnv
1057 ; gbl_rdr <- getGlobalRdrEnv
1058 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
1060 lcl_names = mkNameSet (occEnvElts lcl_rdr)
1062 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
1065 checkTH e what = returnM () -- OK
1067 checkTH e what -- Raise an error in a stage-1 compiler
1068 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
1069 ptext SLIT("illegal in a stage-1 compiler"),