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, checkDupNames, mapFvRn, lookupGreLocalRn,
39 import RnNames (importsFromLocalDecls, extendRdrEnvRn)
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 )
52 import SrcLoc ( Located(..), unLoc, noLoc )
53 import DynFlags ( DynFlag(..) )
54 import Maybes ( seqMaybe )
55 import Maybe ( isNothing )
56 import Monad ( liftM, when )
57 import BasicTypes ( Boxity(..) )
59 import ListSetOps (findDupsEq, mkLookupFun)
62 @rnSourceDecl@ `renames' declarations.
63 It simultaneously performs dependency analysis and precedence parsing.
64 It also does the following error checks:
67 Checks that tyvars are used properly. This includes checking
68 for undefined tyvars, and tyvars in contexts that are ambiguous.
69 (Some of this checking has now been moved to module @TcMonoType@,
70 since we don't have functional dependency information at this point.)
72 Checks that all variable occurences are defined.
74 Checks the @(..)@ etc constraints in the export list.
79 -- brings the binders of the group into scope in the appropriate places;
80 -- does NOT assume that anything is in scope already
82 -- the Bool determines whether (True) names in the group shadow existing
83 -- Unquals in the global environment (used in Template Haskell) or
84 -- (False) whether duplicates are reported as an error
85 rnSrcDecls :: Bool -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
87 rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls,
88 hs_tyclds = tycl_decls,
89 hs_instds = inst_decls,
90 hs_derivds = deriv_decls,
92 hs_depds = deprec_decls,
93 hs_fords = foreign_decls,
94 hs_defds = default_decls,
95 hs_ruleds = rule_decls,
98 -- (A) Process the fixity declarations, creating a mapping from
99 -- FastStrings to FixItems.
100 -- Also checks for duplcates.
101 local_fix_env <- makeMiniFixityEnv fix_decls;
103 -- (B) Bring top level binders (and their fixities) into scope,
104 -- except for the value bindings, which get brought in below.
105 inNewEnv (importsFromLocalDecls shadowP group local_fix_env) $ \ tcg_env -> do {
107 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
109 -- (C) Extract the mapping from data constructors to field names and
110 -- extend the record field env.
111 -- This depends on the data constructors and field names being in
112 -- scope from (B) above
113 inNewEnv (extendRecordFieldEnv tycl_decls) $ \ tcg_env -> do {
115 -- (D) Rename the left-hand sides of the value bindings.
116 -- This depends on everything from (B) being in scope,
117 -- and on (C) for resolving record wild cards.
118 -- It uses the fixity env from (A) to bind fixities for view patterns.
119 new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
120 -- bind the LHSes (and their fixities) in the global rdr environment
121 let { lhs_binders = map unLoc $ collectHsValBinders new_lhs;
122 lhs_avails = map Avail lhs_binders
124 inNewEnv (extendRdrEnvRn shadowP (tcg_rdr_env tcg_env, tcg_fix_env tcg_env)
125 lhs_avails local_fix_env
126 >>= \ (new_rdr_env, new_fix_env) ->
127 return (tcg_env { tcg_rdr_env = new_rdr_env,
128 tcg_fix_env = new_fix_env
129 })) $ \tcg_env -> do {
131 -- Now everything is in scope, as the remaining renaming assumes.
133 -- (E) Rename type and class decls
134 -- (note that value LHSes need to be in scope for default methods)
136 -- You might think that we could build proper def/use information
137 -- for type and class declarations, but they can be involved
138 -- in mutual recursion across modules, and we only do the SCC
139 -- analysis for them in the type checker.
140 -- So we content ourselves with gathering uses only; that
141 -- means we'll only report a declaration as unused if it isn't
142 -- mentioned at all. Ah well.
143 traceRn (text "Start rnTyClDecls") ;
144 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
146 -- (F) Rename Value declarations right-hand sides
147 traceRn (text "Start rnmono") ;
148 (rn_val_decls, bind_dus) <- rnTopBindsRHS lhs_binders new_lhs ;
149 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
151 -- (G) Rename Fixity and deprecations
153 -- rename fixity declarations and error if we try to
154 -- fix something from another module (duplicates were checked in (A))
155 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
156 -- rename deprec decls;
157 -- check for duplicates and ensure that deprecated things are defined locally
158 -- at the moment, we don't keep these around past renaming
159 rn_deprecs <- rnSrcDeprecDecls deprec_decls ;
161 -- (H) Rename Everything else
163 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
164 (rn_rule_decls, src_fvs3) <- rnList rnHsRuleDecl rule_decls ;
165 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
166 (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ;
167 (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ;
168 -- Haddock docs; no free vars
169 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
171 -- (I) Compute the results and return
172 let {rn_group = HsGroup { hs_valds = rn_val_decls,
173 hs_tyclds = rn_tycl_decls,
174 hs_instds = rn_inst_decls,
175 hs_derivds = rn_deriv_decls,
176 hs_fixds = rn_fix_decls,
177 hs_depds = [], -- deprecs are returned in the tcg_env (see below)
178 -- not in the HsGroup
179 hs_fords = rn_foreign_decls,
180 hs_defds = rn_default_decls,
181 hs_ruleds = rn_rule_decls,
182 hs_docs = rn_docs } ;
184 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
185 src_fvs4, src_fvs5] ;
186 src_dus = bind_dus `plusDU` usesOnly other_fvs;
187 -- Note: src_dus will contain *uses* for locally-defined types
188 -- and classes, but no *defs* for them. (Because rnTyClDecl
189 -- returns only the uses.) This is a little
190 -- surprising but it doesn't actually matter at all.
192 final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
193 in -- we return the deprecs in the env, not in the HsGroup above
194 tcg_env' { tcg_deprecs = tcg_deprecs tcg_env' `plusDeprecs` rn_deprecs };
197 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
198 traceRn (text "finish Dus" <+> ppr src_dus ) ;
199 return (final_tcg_env , rn_group)
202 -- some utils because we do this a bunch above
203 -- compute and install the new env
204 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
205 inNewEnv env cont = do e <- env
208 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
209 -- Used for external core
210 rnTyClDecls tycl_decls = do (decls', fvs) <- rnList rnTyClDecl tycl_decls
213 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
214 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
216 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
217 rnList f xs = mapFvRn (wrapLocFstM f) xs
221 %*********************************************************
225 %*********************************************************
228 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
229 rnDocDecl (DocCommentNext doc) = do
230 rn_doc <- rnHsDoc doc
231 return (DocCommentNext rn_doc)
232 rnDocDecl (DocCommentPrev doc) = do
233 rn_doc <- rnHsDoc doc
234 return (DocCommentPrev rn_doc)
235 rnDocDecl (DocCommentNamed str doc) = do
236 rn_doc <- rnHsDoc doc
237 return (DocCommentNamed str rn_doc)
238 rnDocDecl (DocGroup lev doc) = do
239 rn_doc <- rnHsDoc doc
240 return (DocGroup lev rn_doc)
244 %*********************************************************
246 Source-code fixity declarations
248 %*********************************************************
251 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
252 -- Rename the fixity decls, so we can put
253 -- the renamed decls in the renamed syntax tree
254 -- Errors if the thing being fixed is not defined locally.
255 rnSrcFixityDecls fix_decls
256 = do fix_decls <- mapM rn_decl fix_decls
257 return (concat fix_decls)
259 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
260 -- GHC extension: look up both the tycon and data con
261 -- for con-like things; hence returning a list
262 -- If neither are in scope, report an error; otherwise
263 -- add both to the fixity env
264 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
265 = setSrcSpan name_loc $
266 -- this lookup will fail if the definition isn't local
267 do names <- lookupLocalDataTcNames rdr_name
268 return [ L loc (FixitySig (L name_loc name) fixity)
273 %*********************************************************
275 Source-code deprecations declarations
277 %*********************************************************
279 Check that the deprecated names are defined, are defined locally, and
280 that there are no duplicate deprecations.
282 It's only imported deprecations, dealt with in RnIfaces, that we
283 gather them together.
286 -- checks that the deprecations are defined locally, and that there are no duplicates
287 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
291 rnSrcDeprecDecls decls
292 = do { -- check for duplicates
293 ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupDeprecDecl lrdr')) deprec_rdr_dups
294 ; mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
295 returnM (DeprecSome ((concat pairs_s))) }
297 rn_deprec (Deprecation rdr_name txt)
298 -- ensures that the names are defined locally
299 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
300 returnM [(nameOccName name, txt) | name <- names]
302 -- look for duplicates among the OccNames;
303 -- we check that the names are defined above
304 -- invt: the lists returned by findDupsEq always have at least two elements
305 deprec_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
306 (map (\ (L loc (Deprecation rdr_name _)) -> L loc rdr_name) decls)
308 dupDeprecDecl (L loc _) rdr_name
309 = vcat [ptext SLIT("Multiple deprecation declarations for") <+> quotes (ppr rdr_name),
310 ptext SLIT("also at ") <+> ppr loc]
314 %*********************************************************
316 \subsection{Source code declarations}
318 %*********************************************************
321 rnDefaultDecl (DefaultDecl tys)
322 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
323 returnM (DefaultDecl tys', fvs)
325 doc_str = text "In a `default' declaration"
328 %*********************************************************
330 \subsection{Foreign declarations}
332 %*********************************************************
335 rnHsForeignDecl (ForeignImport name ty spec)
336 = lookupLocatedTopBndrRn name `thenM` \ name' ->
337 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
338 returnM (ForeignImport name' ty' spec, fvs)
340 rnHsForeignDecl (ForeignExport name ty spec)
341 = lookupLocatedOccRn name `thenM` \ name' ->
342 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
343 returnM (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
344 -- NB: a foreign export is an *occurrence site* for name, so
345 -- we add it to the free-variable list. It might, for example,
346 -- be imported from another module
348 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
352 %*********************************************************
354 \subsection{Instance declarations}
356 %*********************************************************
359 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
360 -- Used for both source and interface file decls
361 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
363 -- Rename the associated types
364 -- The typechecker (not the renamer) checks that all
365 -- the declarations are for the right class
367 at_doc = text "In the associated types of an instance declaration"
368 at_names = map (head . tyClDeclNames . unLoc) ats
370 checkDupNames at_doc at_names `thenM_`
371 rnATInsts ats `thenM` \ (ats', at_fvs) ->
373 -- Rename the bindings
374 -- The typechecker (not the renamer) checks that all
375 -- the bindings are for the right class
377 meth_doc = text "In the bindings in an instance declaration"
378 meth_names = collectHsBindLocatedBinders mbinds
379 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
381 checkDupNames meth_doc meth_names `thenM_`
382 extendTyVarEnvForMethodBinds inst_tyvars (
383 -- (Slightly strangely) the forall-d tyvars scope over
384 -- the method bindings too
385 rnMethodBinds cls (\n->[]) -- No scoped tyvars
387 ) `thenM` \ (mbinds', meth_fvs) ->
388 -- Rename the prags and signatures.
389 -- Note that the type variables are not in scope here,
390 -- so that instance Eq a => Eq (T a) where
391 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
394 -- But the (unqualified) method names are in scope
396 binders = collectHsBindBinders mbinds'
397 ok_sig = okInstDclSig (mkNameSet binders)
399 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
401 returnM (InstDecl inst_ty' mbinds' uprags' ats',
402 meth_fvs `plusFV` at_fvs
403 `plusFV` hsSigsFVs uprags'
404 `plusFV` extractHsTyNames inst_ty')
405 -- We return the renamed associated data type declarations so
406 -- that they can be entered into the list of type declarations
407 -- for the binding group, but we also keep a copy in the instance.
408 -- The latter is needed for well-formedness checks in the type
409 -- checker (eg, to ensure that all ATs of the instance actually
410 -- receive a declaration).
411 -- NB: Even the copies in the instance declaration carry copies of
412 -- the instance context after renaming. This is a bit
413 -- strange, but should not matter (and it would be more work
414 -- to remove the context).
417 Renaming of the associated types in instances.
420 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
421 rnATInsts atDecls = rnList rnATInst atDecls
423 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
424 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
426 pprPanic "RnSource.rnATInsts: invalid AT instance"
427 (ppr (tcdName tydecl))
430 For the method bindings in class and instance decls, we extend the
431 type variable environment iff -fglasgow-exts
434 extendTyVarEnvForMethodBinds tyvars thing_inside
435 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
437 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
442 %*********************************************************
444 \subsection{Stand-alone deriving declarations}
446 %*********************************************************
449 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
450 rnSrcDerivDecl (DerivDecl ty)
451 = do ty' <- rnLHsType (text "a deriving decl") ty
452 let fvs = extractHsTyNames ty'
453 return (DerivDecl ty', fvs)
456 %*********************************************************
460 %*********************************************************
463 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
464 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
466 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
467 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
469 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
470 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
472 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
474 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
475 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
477 doc = text "In the transformation rule" <+> ftext rule_name
479 get_var (RuleBndr v) = v
480 get_var (RuleBndrSig v _) = v
482 rn_var (RuleBndr (L loc v), id)
483 = returnM (RuleBndr (L loc id), emptyFVs)
484 rn_var (RuleBndrSig (L loc v) t, id)
485 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
486 returnM (RuleBndrSig (L loc id) t', fvs)
489 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
490 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
491 ptext SLIT("does not appear on left hand side")]
494 Note [Rule LHS validity checking]
495 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
496 Check the shape of a transformation rule LHS. Currently we only allow
497 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
498 @forall@'d variables.
500 We used restrict the form of the 'ei' to prevent you writing rules
501 with LHSs with a complicated desugaring (and hence unlikely to match);
502 (e.g. a case expression is not allowed: too elaborate.)
504 But there are legitimate non-trivial args ei, like sections and
505 lambdas. So it seems simmpler not to check at all, and that is why
506 check_e is commented out.
509 checkValidRule rule_name ids lhs' fv_lhs'
510 = do { -- Check for the form of the LHS
511 case (validRuleLhs ids lhs') of
513 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
515 -- Check that LHS vars are all bound
516 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
517 ; mappM (addErr . badRuleVar rule_name) bad_vars }
519 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
521 -- Just e => Not ok, and e is the offending expression
522 validRuleLhs foralls lhs
525 checkl (L loc e) = check e
527 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
528 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
529 check (HsVar v) | v `notElem` foralls = Nothing
530 check other = Just other -- Failure
533 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
535 {- Commented out; see Note [Rule LHS validity checking] above
536 check_e (HsVar v) = Nothing
537 check_e (HsPar e) = checkl_e e
538 check_e (HsLit e) = Nothing
539 check_e (HsOverLit e) = Nothing
541 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
542 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
543 check_e (NegApp e _) = checkl_e e
544 check_e (ExplicitList _ es) = checkl_es es
545 check_e (ExplicitTuple es _) = checkl_es es
546 check_e other = Just other -- Fails
548 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
551 badRuleLhsErr name lhs bad_e
552 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
553 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
554 ptext SLIT("in left-hand side:") <+> ppr lhs])]
556 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
560 %*********************************************************
562 \subsection{Type, class and iface sig declarations}
564 %*********************************************************
566 @rnTyDecl@ uses the `global name function' to create a new type
567 declaration in which local names have been replaced by their original
568 names, reporting any unknown names.
570 Renaming type variables is a pain. Because they now contain uniques,
571 it is necessary to pass in an association list which maps a parsed
572 tyvar to its @Name@ representation.
573 In some cases (type signatures of values),
574 it is even necessary to go over the type first
575 in order to get the set of tyvars used by it, make an assoc list,
576 and then go over it again to rename the tyvars!
577 However, we can also do some scoping checks at the same time.
580 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
581 = lookupLocatedTopBndrRn name `thenM` \ name' ->
582 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
585 -- all flavours of type family declarations ("type family", "newtype fanily",
586 -- and "data family")
587 rnTyClDecl (tydecl@TyFamily {}) =
588 rnFamily tydecl bindTyVarsRn
590 -- "data", "newtype", "data instance, and "newtype instance" declarations
591 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
592 tcdLName = tycon, tcdTyVars = tyvars,
593 tcdTyPats = typatsMaybe, tcdCons = condecls,
594 tcdKindSig = sig, tcdDerivs = derivs})
595 | is_vanilla -- Normal Haskell data type decl
596 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
597 -- data type is syntactically illegal
598 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
599 do { tycon' <- if isFamInstDecl tydecl
600 then lookupLocatedOccRn tycon -- may be imported family
601 else lookupLocatedTopBndrRn tycon
602 ; context' <- rnContext data_doc context
603 ; typats' <- rnTyPats data_doc typatsMaybe
604 ; (derivs', deriv_fvs) <- rn_derivs derivs
605 ; checkDupNames data_doc con_names
606 ; condecls' <- rnConDecls (unLoc tycon') condecls
607 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
608 tcdLName = tycon', tcdTyVars = tyvars',
609 tcdTyPats = typats', tcdKindSig = Nothing,
610 tcdCons = condecls', tcdDerivs = derivs'},
611 delFVs (map hsLTyVarName tyvars') $
612 extractHsCtxtTyNames context' `plusFV`
613 plusFVs (map conDeclFVs condecls') `plusFV`
615 (if isFamInstDecl tydecl
616 then unitFV (unLoc tycon') -- type instance => use
621 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
622 do { tycon' <- if isFamInstDecl tydecl
623 then lookupLocatedOccRn tycon -- may be imported family
624 else lookupLocatedTopBndrRn tycon
625 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
626 ; tyvars' <- bindTyVarsRn data_doc tyvars
627 (\ tyvars' -> return tyvars')
628 -- For GADTs, the type variables in the declaration
629 -- do not scope over the constructor signatures
630 -- data T a where { T1 :: forall b. b-> b }
631 ; (derivs', deriv_fvs) <- rn_derivs derivs
632 ; checkDupNames data_doc con_names
633 ; condecls' <- rnConDecls (unLoc tycon') condecls
634 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
635 tcdLName = tycon', tcdTyVars = tyvars',
636 tcdTyPats = Nothing, tcdKindSig = sig,
637 tcdCons = condecls', tcdDerivs = derivs'},
638 plusFVs (map conDeclFVs condecls') `plusFV`
640 (if isFamInstDecl tydecl
641 then unitFV (unLoc tycon') -- type instance => use
645 is_vanilla = case condecls of -- Yuk
647 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
651 none (Just []) = True
654 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
655 con_names = map con_names_helper condecls
657 con_names_helper (L _ c) = con_name c
659 rn_derivs Nothing = returnM (Nothing, emptyFVs)
660 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
661 returnM (Just ds', extractHsTyNames_s ds')
663 -- "type" and "type instance" declarations
664 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
665 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
666 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
667 do { name' <- if isFamInstDecl tydecl
668 then lookupLocatedOccRn name -- may be imported family
669 else lookupLocatedTopBndrRn name
670 ; typats' <- rnTyPats syn_doc typatsMaybe
671 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
672 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
673 tcdTyPats = typats', tcdSynRhs = ty'},
674 delFVs (map hsLTyVarName tyvars') $
676 (if isFamInstDecl tydecl
677 then unitFV (unLoc name') -- type instance => use
681 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
683 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
684 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
685 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
686 = do { cname' <- lookupLocatedTopBndrRn cname
688 -- Tyvars scope over superclass context and method signatures
689 ; (tyvars', context', fds', ats', ats_fvs, sigs')
690 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
691 { context' <- rnContext cls_doc context
692 ; fds' <- rnFds cls_doc fds
693 ; (ats', ats_fvs) <- rnATs ats
694 ; sigs' <- renameSigs okClsDclSig sigs
695 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
697 -- Check for duplicates among the associated types
698 ; let at_rdr_names_w_locs = [tcdLName ty | L _ ty <- ats]
699 ; checkDupNames at_doc at_rdr_names_w_locs
701 -- Check the signatures
702 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
703 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
704 ; checkDupNames sig_doc sig_rdr_names_w_locs
705 -- Typechecker is responsible for checking that we only
706 -- give default-method bindings for things in this class.
707 -- The renamer *could* check this for class decls, but can't
708 -- for instance decls.
710 -- The newLocals call is tiresome: given a generic class decl
713 -- op {| x+y |} (Inl a) = ...
714 -- op {| x+y |} (Inr b) = ...
715 -- op {| a*b |} (a*b) = ...
716 -- we want to name both "x" tyvars with the same unique, so that they are
717 -- easy to group together in the typechecker.
718 ; (mbinds', meth_fvs)
719 <- extendTyVarEnvForMethodBinds tyvars' $ do
720 { name_env <- getLocalRdrEnv
721 ; let meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
722 gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
723 not (unLoc tv `elemLocalRdrEnv` name_env) ]
724 ; checkDupNames meth_doc meth_rdr_names_w_locs
725 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
726 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
729 ; docs' <- mapM (wrapLocM rnDocDecl) docs
731 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
732 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
733 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
735 delFVs (map hsLTyVarName tyvars') $
736 extractHsCtxtTyNames context' `plusFV`
737 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
738 hsSigsFVs sigs' `plusFV`
742 meth_doc = text "In the default-methods for class" <+> ppr cname
743 cls_doc = text "In the declaration for class" <+> ppr cname
744 sig_doc = text "In the signatures for class" <+> ppr cname
745 at_doc = text "In the associated types for class" <+> ppr cname
747 badGadtStupidTheta tycon
748 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
749 ptext SLIT("(You can put a context on each contructor, though.)")]
752 %*********************************************************
754 \subsection{Support code for type/data declarations}
756 %*********************************************************
759 -- Although, we are processing type patterns here, all type variables will
760 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
761 -- type declaration to which these patterns belong)
763 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
764 rnTyPats _ Nothing = return Nothing
765 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
767 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
768 rnConDecls tycon condecls
769 = mappM (wrapLocM rnConDecl) condecls
771 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
772 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
773 = do { addLocM checkConName name
775 ; new_name <- lookupLocatedTopBndrRn name
776 ; name_env <- getLocalRdrEnv
778 -- For H98 syntax, the tvs are the existential ones
779 -- For GADT syntax, the tvs are all the quantified tyvars
780 -- Hence the 'filter' in the ResTyH98 case only
781 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
782 arg_tys = hsConDeclArgTys details
783 implicit_tvs = case res_ty of
784 ResTyH98 -> filter not_in_scope $
786 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
789 Implicit -> userHsTyVarBndrs implicit_tvs
791 ; mb_doc' <- rnMbLHsDoc mb_doc
793 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
794 { new_context <- rnContext doc cxt
795 ; new_details <- rnConDeclDetails doc details
796 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
797 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
799 doc = text "In the definition of data constructor" <+> quotes (ppr name)
800 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
802 rnConResult _ details ResTyH98 = return (details, ResTyH98)
804 rnConResult doc details (ResTyGADT ty) = do
805 ty' <- rnHsSigType doc ty
806 let (arg_tys, res_ty) = splitHsFunType ty'
807 -- We can split it up, now the renamer has dealt with fixities
809 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
810 RecCon fields -> return (details, ResTyGADT ty')
811 InfixCon {} -> panic "rnConResult"
813 rnConDeclDetails doc (PrefixCon tys)
814 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
815 returnM (PrefixCon new_tys)
817 rnConDeclDetails doc (InfixCon ty1 ty2)
818 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
819 rnLHsType doc ty2 `thenM` \ new_ty2 ->
820 returnM (InfixCon new_ty1 new_ty2)
822 rnConDeclDetails doc (RecCon fields)
823 = do { checkDupNames doc (map cd_fld_name fields)
824 ; new_fields <- mappM (rnField doc) fields
825 ; return (RecCon new_fields) }
827 rnField doc (ConDeclField name ty haddock_doc)
828 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
829 rnLHsType doc ty `thenM` \ new_ty ->
830 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
831 returnM (ConDeclField new_name new_ty new_haddock_doc)
833 -- Rename family declarations
835 -- * This function is parametrised by the routine handling the index
836 -- variables. On the toplevel, these are defining occurences, whereas they
837 -- are usage occurences for associated types.
839 rnFamily :: TyClDecl RdrName
840 -> (SDoc -> [LHsTyVarBndr RdrName] ->
841 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
842 RnM (TyClDecl Name, FreeVars))
843 -> RnM (TyClDecl Name, FreeVars)
845 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
846 tcdLName = tycon, tcdTyVars = tyvars})
848 do { checkM (isDataFlavour flavour -- for synonyms,
849 || not (null tyvars)) $ addErr needOneIdx -- #indexes >= 1
850 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
851 ; tycon' <- lookupLocatedTopBndrRn tycon
852 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
853 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
857 isDataFlavour DataFamily = True
858 isDataFlavour _ = False
860 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
861 needOneIdx = text "Type family declarations requires at least one type index"
863 -- Rename associated type declarations (in classes)
865 -- * This can be family declarations and (default) type instances
867 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
868 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
870 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
871 rn_at (tydecl@TySynonym {}) =
873 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
875 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
877 lookupIdxVars _ tyvars cont =
878 do { checkForDups tyvars;
879 ; tyvars' <- mappM lookupIdxVar tyvars
882 -- Type index variables must be class parameters, which are the only
883 -- type variables in scope at this point.
884 lookupIdxVar (L l tyvar) =
886 name' <- lookupOccRn (hsTyVarName tyvar)
887 return $ L l (replaceTyVarName tyvar name')
889 -- Type variable may only occur once.
891 checkForDups [] = return ()
892 checkForDups (L loc tv:ltvs) =
893 do { setSrcSpan loc $
894 when (hsTyVarName tv `ltvElem` ltvs) $
895 addErr (repeatedTyVar tv)
899 rdrName `ltvElem` [] = False
900 rdrName `ltvElem` (L _ tv:ltvs)
901 | rdrName == hsTyVarName tv = True
902 | otherwise = rdrName `ltvElem` ltvs
904 noPatterns = text "Default definition for an associated synonym cannot have"
905 <+> text "type pattern"
907 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
910 -- This data decl will parse OK
912 -- treating "a" as the constructor.
913 -- It is really hard to make the parser spot this malformation.
914 -- So the renamer has to check that the constructor is legal
916 -- We can get an operator as the constructor, even in the prefix form:
917 -- data T = :% Int Int
918 -- from interface files, which always print in prefix form
920 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
923 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
927 %*********************************************************
929 \subsection{Support code for type/data declarations}
931 %*********************************************************
933 Get the mapping from constructors to fields for this module.
934 It's convenient to do this after the data type decls have been renamed
936 extendRecordFieldEnv :: [LTyClDecl RdrName] -> TcM TcGblEnv
937 extendRecordFieldEnv decls
938 = do { tcg_env <- getGblEnv
939 ; field_env' <- foldrM get (tcg_field_env tcg_env) decls
940 ; return (tcg_env { tcg_field_env = field_env' }) }
942 -- we want to lookup:
943 -- (a) a datatype constructor
944 -- (b) a record field
945 -- knowing that they're from this module.
946 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
947 -- which keeps only the local ones.
948 lookup x = do { x' <- lookupLocatedTopBndrRn x
951 get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
952 get other env = return env
954 get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
955 = do { con' <- lookup con
956 ; flds' <- mappM lookup (map cd_fld_name flds)
957 ; return $ extendNameEnv env con' flds' }
962 %*********************************************************
964 \subsection{Support code to rename types}
966 %*********************************************************
969 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
972 = mappM (wrapLocM rn_fds) fds
975 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
976 rnHsTyVars doc tys2 `thenM` \ tys2' ->
977 returnM (tys1', tys2')
979 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
980 rnHsTyvar doc tyvar = lookupOccRn tyvar
984 %*********************************************************
988 %*********************************************************
994 h = ...$(thing "f")...
996 The splice can expand into literally anything, so when we do dependency
997 analysis we must assume that it might mention 'f'. So we simply treat
998 all locally-defined names as mentioned by any splice. This is terribly
999 brutal, but I don't see what else to do. For example, it'll mean
1000 that every locally-defined thing will appear to be used, so no unused-binding
1001 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
1002 and that will crash the type checker because 'f' isn't in scope.
1004 Currently, I'm not treating a splice as also mentioning every import,
1005 which is a bit inconsistent -- but there are a lot of them. We might
1006 thereby get some bogus unused-import warnings, but we won't crash the
1007 type checker. Not very satisfactory really.
1010 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
1011 rnSplice (HsSplice n expr)
1012 = do { checkTH expr "splice"
1013 ; loc <- getSrcSpanM
1014 ; [n'] <- newLocalsRn [L loc n]
1015 ; (expr', fvs) <- rnLExpr expr
1017 -- Ugh! See Note [Splices] above
1018 ; lcl_rdr <- getLocalRdrEnv
1019 ; gbl_rdr <- getGlobalRdrEnv
1020 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
1022 lcl_names = mkNameSet (occEnvElts lcl_rdr)
1024 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
1027 checkTH e what = returnM () -- OK
1029 checkTH e what -- Raise an error in a stage-1 compiler
1030 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
1031 ptext SLIT("illegal in a stage-1 compiler"),