2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
13 #include "HsVersions.h"
15 import {-# SOURCE #-} RnExpr( rnLExpr )
18 import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv,
19 globalRdrEnvElts, GlobalRdrElt(..), isLocalGRE, rdrNameOcc )
20 import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
22 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
23 import RnBinds ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
25 import RnEnv ( lookupLocalDataTcNames,
26 lookupLocatedTopBndrRn, lookupLocatedOccRn,
27 lookupOccRn, newLocalsRn,
28 bindLocatedLocalsFV, bindPatSigTyVarsFV,
29 bindTyVarsRn, extendTyVarEnvFVRn,
30 bindLocalNames, checkDupRdrNames, mapFvRn,
32 import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
33 import HscTypes ( GenAvailInfo(..) )
34 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
37 import HscTypes ( Warnings(..), plusWarns )
38 import Class ( FunDep )
39 import Name ( Name, nameOccName )
47 import DynFlags ( DynFlag(..) )
48 import Maybe ( isNothing )
49 import BasicTypes ( Boxity(..) )
51 import ListSetOps (findDupsEq)
59 thenM :: Monad a => a b -> (b -> a c) -> a c
62 thenM_ :: Monad a => a b -> a c -> a c
65 returnM :: Monad m => a -> m a
68 mappM :: (Monad m) => (a -> m b) -> [a] -> m [b]
71 mappM_ :: (Monad m) => (a -> m b) -> [a] -> m ()
74 checkM :: Monad m => Bool -> m () -> m ()
78 @rnSourceDecl@ `renames' declarations.
79 It simultaneously performs dependency analysis and precedence parsing.
80 It also does the following error checks:
83 Checks that tyvars are used properly. This includes checking
84 for undefined tyvars, and tyvars in contexts that are ambiguous.
85 (Some of this checking has now been moved to module @TcMonoType@,
86 since we don't have functional dependency information at this point.)
88 Checks that all variable occurences are defined.
90 Checks the @(..)@ etc constraints in the export list.
95 -- Brings the binders of the group into scope in the appropriate places;
96 -- does NOT assume that anything is in scope already
97 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
98 rnSrcDecls group@(HsGroup {hs_valds = val_decls,
99 hs_tyclds = tycl_decls,
100 hs_instds = inst_decls,
101 hs_derivds = deriv_decls,
102 hs_fixds = fix_decls,
103 hs_warnds = warn_decls,
104 hs_fords = foreign_decls,
105 hs_defds = default_decls,
106 hs_ruleds = rule_decls,
109 -- (A) Process the fixity declarations, creating a mapping from
110 -- FastStrings to FixItems.
111 -- Also checks for duplcates.
112 local_fix_env <- makeMiniFixityEnv fix_decls;
114 -- (B) Bring top level binders (and their fixities) into scope,
115 -- *except* for the value bindings, which get brought in below.
116 avails <- getLocalNonValBinders group ;
117 tc_envs <- extendGlobalRdrEnvRn avails local_fix_env ;
118 setEnvs tc_envs $ do {
120 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
122 -- (C) Extract the mapping from data constructors to field names and
123 -- extend the record field env.
124 -- This depends on the data constructors and field names being in
125 -- scope from (B) above
126 inNewEnv (extendRecordFieldEnv tycl_decls) $ \ _ -> do {
128 -- (D) Rename the left-hand sides of the value bindings.
129 -- This depends on everything from (B) being in scope,
130 -- and on (C) for resolving record wild cards.
131 -- It uses the fixity env from (A) to bind fixities for view patterns.
132 new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
133 -- bind the LHSes (and their fixities) in the global rdr environment
134 let { lhs_binders = map unLoc $ collectHsValBinders new_lhs;
135 lhs_avails = map Avail lhs_binders
137 (tcg_env, tcl_env) <- extendGlobalRdrEnvRn lhs_avails local_fix_env ;
138 setEnvs (tcg_env, tcl_env) $ do {
140 -- Now everything is in scope, as the remaining renaming assumes.
142 -- (E) Rename type and class decls
143 -- (note that value LHSes need to be in scope for default methods)
145 -- You might think that we could build proper def/use information
146 -- for type and class declarations, but they can be involved
147 -- in mutual recursion across modules, and we only do the SCC
148 -- analysis for them in the type checker.
149 -- So we content ourselves with gathering uses only; that
150 -- means we'll only report a declaration as unused if it isn't
151 -- mentioned at all. Ah well.
152 traceRn (text "Start rnTyClDecls") ;
153 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
155 -- (F) Rename Value declarations right-hand sides
156 traceRn (text "Start rnmono") ;
157 (rn_val_decls, bind_dus) <- rnTopBindsRHS lhs_binders new_lhs ;
158 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
160 -- (G) Rename Fixity and deprecations
162 -- rename fixity declarations and error if we try to
163 -- fix something from another module (duplicates were checked in (A))
164 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
165 -- rename deprec decls;
166 -- check for duplicates and ensure that deprecated things are defined locally
167 -- at the moment, we don't keep these around past renaming
168 rn_warns <- rnSrcWarnDecls warn_decls ;
170 -- (H) Rename Everything else
172 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
173 (rn_rule_decls, src_fvs3) <- setOptM Opt_ScopedTypeVariables $
174 rnList rnHsRuleDecl rule_decls ;
175 -- Inside RULES, scoped type variables are on
176 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
177 (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ;
178 (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ;
179 -- Haddock docs; no free vars
180 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
182 -- (I) Compute the results and return
183 let {rn_group = HsGroup { hs_valds = rn_val_decls,
184 hs_tyclds = rn_tycl_decls,
185 hs_instds = rn_inst_decls,
186 hs_derivds = rn_deriv_decls,
187 hs_fixds = rn_fix_decls,
188 hs_warnds = [], -- warns are returned in the tcg_env
189 -- (see below) not in the HsGroup
190 hs_fords = rn_foreign_decls,
191 hs_defds = rn_default_decls,
192 hs_ruleds = rn_rule_decls,
193 hs_docs = rn_docs } ;
195 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
196 src_fvs4, src_fvs5] ;
197 src_dus = bind_dus `plusDU` usesOnly other_fvs;
198 -- Note: src_dus will contain *uses* for locally-defined types
199 -- and classes, but no *defs* for them. (Because rnTyClDecl
200 -- returns only the uses.) This is a little
201 -- surprising but it doesn't actually matter at all.
203 final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
204 in -- we return the deprecs in the env, not in the HsGroup above
205 tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
208 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
209 traceRn (text "finish Dus" <+> ppr src_dus ) ;
210 return (final_tcg_env , rn_group)
213 -- some utils because we do this a bunch above
214 -- compute and install the new env
215 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
216 inNewEnv env cont = do e <- env
219 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
220 -- Used for external core
221 rnTyClDecls tycl_decls = do (decls', _fvs) <- rnList rnTyClDecl tycl_decls
224 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
225 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
227 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
228 rnList f xs = mapFvRn (wrapLocFstM f) xs
232 %*********************************************************
236 %*********************************************************
239 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
240 rnDocDecl (DocCommentNext doc) = do
241 rn_doc <- rnHsDoc doc
242 return (DocCommentNext rn_doc)
243 rnDocDecl (DocCommentPrev doc) = do
244 rn_doc <- rnHsDoc doc
245 return (DocCommentPrev rn_doc)
246 rnDocDecl (DocCommentNamed str doc) = do
247 rn_doc <- rnHsDoc doc
248 return (DocCommentNamed str rn_doc)
249 rnDocDecl (DocGroup lev doc) = do
250 rn_doc <- rnHsDoc doc
251 return (DocGroup lev rn_doc)
255 %*********************************************************
257 Source-code fixity declarations
259 %*********************************************************
262 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
263 -- Rename the fixity decls, so we can put
264 -- the renamed decls in the renamed syntax tree
265 -- Errors if the thing being fixed is not defined locally.
267 -- The returned FixitySigs are not actually used for anything,
268 -- except perhaps the GHCi API
269 rnSrcFixityDecls fix_decls
270 = do fix_decls <- mapM rn_decl fix_decls
271 return (concat fix_decls)
273 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
274 -- GHC extension: look up both the tycon and data con
275 -- for con-like things; hence returning a list
276 -- If neither are in scope, report an error; otherwise
277 -- return a fixity sig for each (slightly odd)
278 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
279 = setSrcSpan name_loc $
280 -- this lookup will fail if the definition isn't local
281 do names <- lookupLocalDataTcNames rdr_name
282 return [ L loc (FixitySig (L name_loc name) fixity)
287 %*********************************************************
289 Source-code deprecations declarations
291 %*********************************************************
293 Check that the deprecated names are defined, are defined locally, and
294 that there are no duplicate deprecations.
296 It's only imported deprecations, dealt with in RnIfaces, that we
297 gather them together.
300 -- checks that the deprecations are defined locally, and that there are no duplicates
301 rnSrcWarnDecls :: [LWarnDecl RdrName] -> RnM Warnings
306 = do { -- check for duplicates
307 ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups
308 ; mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
309 returnM (WarnSome ((concat pairs_s))) }
311 rn_deprec (Warning rdr_name txt)
312 -- ensures that the names are defined locally
313 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
314 returnM [(nameOccName name, txt) | name <- names]
316 -- look for duplicates among the OccNames;
317 -- we check that the names are defined above
318 -- invt: the lists returned by findDupsEq always have at least two elements
319 warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
320 (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
322 dupWarnDecl :: Located RdrName -> RdrName -> SDoc
323 -- Located RdrName -> DeprecDecl RdrName -> SDoc
324 dupWarnDecl (L loc _) rdr_name
325 = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
326 ptext (sLit "also at ") <+> ppr loc]
330 %*********************************************************
332 \subsection{Source code declarations}
334 %*********************************************************
337 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
338 rnDefaultDecl (DefaultDecl tys)
339 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
340 returnM (DefaultDecl tys', fvs)
342 doc_str = text "In a `default' declaration"
345 %*********************************************************
347 \subsection{Foreign declarations}
349 %*********************************************************
352 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
353 rnHsForeignDecl (ForeignImport name ty spec)
354 = lookupLocatedTopBndrRn name `thenM` \ name' ->
355 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
356 returnM (ForeignImport name' ty' spec, fvs)
358 rnHsForeignDecl (ForeignExport name ty spec)
359 = lookupLocatedOccRn name `thenM` \ name' ->
360 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
361 returnM (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
362 -- NB: a foreign export is an *occurrence site* for name, so
363 -- we add it to the free-variable list. It might, for example,
364 -- be imported from another module
366 fo_decl_msg :: Located RdrName -> SDoc
367 fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
371 %*********************************************************
373 \subsection{Instance declarations}
375 %*********************************************************
378 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
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 (\_ -> []) -- 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 bndr_set = mkNameSet binders
430 bindLocalNames binders
431 (renameSigs (Just bndr_set) okInstDclSig uprags) `thenM` \ uprags' ->
433 returnM (InstDecl inst_ty' mbinds' uprags' ats',
434 meth_fvs `plusFV` at_fvs
435 `plusFV` hsSigsFVs uprags'
436 `plusFV` extractHsTyNames inst_ty')
437 -- We return the renamed associated data type declarations so
438 -- that they can be entered into the list of type declarations
439 -- for the binding group, but we also keep a copy in the instance.
440 -- The latter is needed for well-formedness checks in the type
441 -- checker (eg, to ensure that all ATs of the instance actually
442 -- receive a declaration).
443 -- NB: Even the copies in the instance declaration carry copies of
444 -- the instance context after renaming. This is a bit
445 -- strange, but should not matter (and it would be more work
446 -- to remove the context).
449 Renaming of the associated types in instances.
452 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
453 rnATInsts atDecls = rnList rnATInst atDecls
455 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
456 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
458 pprPanic "RnSource.rnATInsts: invalid AT instance"
459 (ppr (tcdName tydecl))
462 For the method bindings in class and instance decls, we extend the
463 type variable environment iff -fglasgow-exts
466 extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
467 -> RnM (Bag (LHsBind Name), FreeVars)
468 -> RnM (Bag (LHsBind Name), FreeVars)
469 extendTyVarEnvForMethodBinds tyvars thing_inside
470 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
472 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
477 %*********************************************************
479 \subsection{Stand-alone deriving declarations}
481 %*********************************************************
484 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
485 rnSrcDerivDecl (DerivDecl ty)
486 = do ty' <- rnLHsType (text "a deriving decl") ty
487 let fvs = extractHsTyNames ty'
488 return (DerivDecl ty', fvs)
491 %*********************************************************
495 %*********************************************************
498 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
499 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
500 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
501 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
502 do { (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
503 -- NB: The binders in a rule are always Ids
504 -- We don't (yet) support type variables
506 ; (lhs', fv_lhs') <- rnLExpr lhs
507 ; (rhs', fv_rhs') <- rnLExpr rhs
509 ; checkValidRule rule_name ids lhs' fv_lhs'
511 ; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
512 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
514 doc = text "In the transformation rule" <+> ftext rule_name
516 get_var (RuleBndr v) = v
517 get_var (RuleBndrSig v _) = v
519 rn_var (RuleBndr (L loc _), id)
520 = returnM (RuleBndr (L loc id), emptyFVs)
521 rn_var (RuleBndrSig (L loc _) t, id)
522 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
523 returnM (RuleBndrSig (L loc id) t', fvs)
525 badRuleVar :: FastString -> Name -> SDoc
527 = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
528 ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
529 ptext (sLit "does not appear on left hand side")]
532 Note [Rule LHS validity checking]
533 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
534 Check the shape of a transformation rule LHS. Currently we only allow
535 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
536 @forall@'d variables.
538 We used restrict the form of the 'ei' to prevent you writing rules
539 with LHSs with a complicated desugaring (and hence unlikely to match);
540 (e.g. a case expression is not allowed: too elaborate.)
542 But there are legitimate non-trivial args ei, like sections and
543 lambdas. So it seems simmpler not to check at all, and that is why
544 check_e is commented out.
547 checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
548 checkValidRule rule_name ids lhs' fv_lhs'
549 = do { -- Check for the form of the LHS
550 case (validRuleLhs ids lhs') of
552 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
554 -- Check that LHS vars are all bound
555 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
556 ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
558 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
560 -- Just e => Not ok, and e is the offending expression
561 validRuleLhs foralls lhs
564 checkl (L _ e) = check e
566 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
567 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
568 check (HsVar v) | v `notElem` foralls = Nothing
569 check other = Just other -- Failure
572 checkl_e (L _ _e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
574 {- Commented out; see Note [Rule LHS validity checking] above
575 check_e (HsVar v) = Nothing
576 check_e (HsPar e) = checkl_e e
577 check_e (HsLit e) = Nothing
578 check_e (HsOverLit e) = Nothing
580 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
581 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
582 check_e (NegApp e _) = checkl_e e
583 check_e (ExplicitList _ es) = checkl_es es
584 check_e (ExplicitTuple es _) = checkl_es es
585 check_e other = Just other -- Fails
587 checkl_es es = foldr (mplus . checkl_e) Nothing es
590 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
591 badRuleLhsErr name lhs bad_e
592 = sep [ptext (sLit "Rule") <+> ftext name <> colon,
593 nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
594 ptext (sLit "in left-hand side:") <+> ppr lhs])]
596 ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
600 %*********************************************************
602 \subsection{Type, class and iface sig declarations}
604 %*********************************************************
606 @rnTyDecl@ uses the `global name function' to create a new type
607 declaration in which local names have been replaced by their original
608 names, reporting any unknown names.
610 Renaming type variables is a pain. Because they now contain uniques,
611 it is necessary to pass in an association list which maps a parsed
612 tyvar to its @Name@ representation.
613 In some cases (type signatures of values),
614 it is even necessary to go over the type first
615 in order to get the set of tyvars used by it, make an assoc list,
616 and then go over it again to rename the tyvars!
617 However, we can also do some scoping checks at the same time.
620 rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
621 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
622 = lookupLocatedTopBndrRn name `thenM` \ name' ->
623 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
626 -- all flavours of type family declarations ("type family", "newtype fanily",
627 -- and "data family")
628 rnTyClDecl (tydecl@TyFamily {}) =
629 rnFamily tydecl bindTyVarsRn
631 -- "data", "newtype", "data instance, and "newtype instance" declarations
632 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
633 tcdLName = tycon, tcdTyVars = tyvars,
634 tcdTyPats = typatsMaybe, tcdCons = condecls,
635 tcdKindSig = sig, tcdDerivs = derivs})
636 | is_vanilla -- Normal Haskell data type decl
637 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
638 -- data type is syntactically illegal
639 do { tyvars <- pruneTyVars tydecl
640 ; bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
641 { tycon' <- if isFamInstDecl tydecl
642 then lookupLocatedOccRn tycon -- may be imported family
643 else lookupLocatedTopBndrRn tycon
644 ; context' <- rnContext data_doc context
645 ; typats' <- rnTyPats data_doc typatsMaybe
646 ; (derivs', deriv_fvs) <- rn_derivs derivs
647 ; condecls' <- rnConDecls (unLoc tycon') condecls
648 -- No need to check for duplicate constructor decls
649 -- since that is done by RnNames.extendGlobalRdrEnvRn
650 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
651 tcdLName = tycon', tcdTyVars = tyvars',
652 tcdTyPats = typats', tcdKindSig = Nothing,
653 tcdCons = condecls', tcdDerivs = derivs'},
654 delFVs (map hsLTyVarName tyvars') $
655 extractHsCtxtTyNames context' `plusFV`
656 plusFVs (map conDeclFVs condecls') `plusFV`
658 (if isFamInstDecl tydecl
659 then unitFV (unLoc tycon') -- type instance => use
664 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
665 do { tycon' <- if isFamInstDecl tydecl
666 then lookupLocatedOccRn tycon -- may be imported family
667 else lookupLocatedTopBndrRn tycon
668 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
669 ; tyvars' <- bindTyVarsRn data_doc tyvars
670 (\ tyvars' -> return tyvars')
671 -- For GADTs, the type variables in the declaration
672 -- do not scope over the constructor signatures
673 -- data T a where { T1 :: forall b. b-> b }
674 ; (derivs', deriv_fvs) <- rn_derivs derivs
675 ; condecls' <- rnConDecls (unLoc tycon') condecls
676 -- No need to check for duplicate constructor decls
677 -- since that is done by RnNames.extendGlobalRdrEnvRn
678 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
679 tcdLName = tycon', tcdTyVars = tyvars',
680 tcdTyPats = Nothing, tcdKindSig = sig,
681 tcdCons = condecls', tcdDerivs = derivs'},
682 plusFVs (map conDeclFVs condecls') `plusFV`
684 (if isFamInstDecl tydecl
685 then unitFV (unLoc tycon') -- type instance => use
689 is_vanilla = case condecls of -- Yuk
691 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
695 none (Just []) = True
698 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
700 rn_derivs Nothing = returnM (Nothing, emptyFVs)
701 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
702 returnM (Just ds', extractHsTyNames_s ds')
704 -- "type" and "type instance" declarations
705 rnTyClDecl tydecl@(TySynonym {tcdLName = name,
706 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
707 = do { tyvars <- pruneTyVars tydecl
708 ; bindTyVarsRn syn_doc tyvars $ \ tyvars' -> do
709 { name' <- if isFamInstDecl tydecl
710 then lookupLocatedOccRn name -- may be imported family
711 else lookupLocatedTopBndrRn name
712 ; typats' <- rnTyPats syn_doc typatsMaybe
713 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
714 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
715 tcdTyPats = typats', tcdSynRhs = ty'},
716 delFVs (map hsLTyVarName tyvars') $
718 (if isFamInstDecl tydecl
719 then unitFV (unLoc name') -- type instance => use
723 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
725 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
726 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
727 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
728 = do { cname' <- lookupLocatedTopBndrRn cname
730 -- Tyvars scope over superclass context and method signatures
731 ; (tyvars', context', fds', ats', ats_fvs, sigs')
732 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
733 { context' <- rnContext cls_doc context
734 ; fds' <- rnFds cls_doc fds
735 ; (ats', ats_fvs) <- rnATs ats
736 ; sigs' <- renameSigs Nothing okClsDclSig sigs
737 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
739 -- No need to check for duplicate associated type decls
740 -- since that is done by RnNames.extendGlobalRdrEnvRn
742 -- Check the signatures
743 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
744 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
745 ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
746 -- Typechecker is responsible for checking that we only
747 -- give default-method bindings for things in this class.
748 -- The renamer *could* check this for class decls, but can't
749 -- for instance decls.
751 -- The newLocals call is tiresome: given a generic class decl
754 -- op {| x+y |} (Inl a) = ...
755 -- op {| x+y |} (Inr b) = ...
756 -- op {| a*b |} (a*b) = ...
757 -- we want to name both "x" tyvars with the same unique, so that they are
758 -- easy to group together in the typechecker.
759 ; (mbinds', meth_fvs)
760 <- extendTyVarEnvForMethodBinds tyvars' $ do
761 { name_env <- getLocalRdrEnv
762 ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
763 not (unLoc tv `elemLocalRdrEnv` name_env) ]
764 -- No need to check for duplicate method signatures
765 -- since that is done by RnNames.extendGlobalRdrEnvRn
766 -- and the methods are already in scope
767 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
768 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
771 ; docs' <- mapM (wrapLocM rnDocDecl) docs
773 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
774 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
775 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
777 delFVs (map hsLTyVarName tyvars') $
778 extractHsCtxtTyNames context' `plusFV`
779 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
780 hsSigsFVs sigs' `plusFV`
784 cls_doc = text "In the declaration for class" <+> ppr cname
785 sig_doc = text "In the signatures for class" <+> ppr cname
787 badGadtStupidTheta :: Located RdrName -> SDoc
789 = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
790 ptext (sLit "(You can put a context on each contructor, though.)")]
793 %*********************************************************
795 \subsection{Support code for type/data declarations}
797 %*********************************************************
800 -- Remove any duplicate type variables in family instances may have non-linear
801 -- left-hand sides. Complain if any, but the first occurence of a type
802 -- variable has a user-supplied kind signature.
804 pruneTyVars :: TyClDecl RdrName -> RnM [LHsTyVarBndr RdrName]
806 | isFamInstDecl tydecl
807 = do { let pruned_tyvars = nubBy eqLTyVar tyvars
808 ; assertNoSigsInRepeats tyvars
809 ; return pruned_tyvars
814 tyvars = tcdTyVars tydecl
816 assertNoSigsInRepeats [] = return ()
817 assertNoSigsInRepeats (tv:tvs)
818 = do { let offending_tvs = [ tv' | tv'@(L _ (KindedTyVar _ _)) <- tvs
820 ; checkErr (null offending_tvs) $
821 illegalKindSig (head offending_tvs)
822 ; assertNoSigsInRepeats tvs
826 = hsep [ptext (sLit "Repeat variable occurrence may not have a"),
827 ptext (sLit "kind signature:"), quotes (ppr tv)]
829 tv1 `eqLTyVar` tv2 = hsLTyVarLocName tv1 `eqLocated` hsLTyVarLocName tv2
831 -- Although, we are processing type patterns here, all type variables will
832 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
833 -- type declaration to which these patterns belong)
835 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
836 rnTyPats _ Nothing = return Nothing
837 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
839 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
840 rnConDecls _tycon condecls
841 = mappM (wrapLocM rnConDecl) condecls
843 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
844 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
845 = do { addLocM checkConName name
847 ; new_name <- lookupLocatedTopBndrRn name
848 ; name_env <- getLocalRdrEnv
850 -- For H98 syntax, the tvs are the existential ones
851 -- For GADT syntax, the tvs are all the quantified tyvars
852 -- Hence the 'filter' in the ResTyH98 case only
853 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
854 arg_tys = hsConDeclArgTys details
855 implicit_tvs = case res_ty of
856 ResTyH98 -> filter not_in_scope $
858 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
861 Implicit -> userHsTyVarBndrs implicit_tvs
863 ; mb_doc' <- rnMbLHsDoc mb_doc
865 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
866 { new_context <- rnContext doc cxt
867 ; new_details <- rnConDeclDetails doc details
868 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
869 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
871 doc = text "In the definition of data constructor" <+> quotes (ppr name)
872 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
875 -> HsConDetails (LHsType Name) [ConDeclField Name]
877 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
879 rnConResult _ details ResTyH98 = return (details, ResTyH98)
881 rnConResult doc details (ResTyGADT ty) = do
882 ty' <- rnHsSigType doc ty
883 let (arg_tys, res_ty) = splitHsFunType ty'
884 -- We can split it up, now the renamer has dealt with fixities
886 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
887 RecCon _ -> return (details, ResTyGADT ty')
888 InfixCon {} -> panic "rnConResult"
890 rnConDeclDetails :: SDoc
891 -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
892 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
893 rnConDeclDetails doc (PrefixCon tys)
894 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
895 returnM (PrefixCon new_tys)
897 rnConDeclDetails doc (InfixCon ty1 ty2)
898 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
899 rnLHsType doc ty2 `thenM` \ new_ty2 ->
900 returnM (InfixCon new_ty1 new_ty2)
902 rnConDeclDetails doc (RecCon fields)
903 = do { new_fields <- mappM (rnField doc) fields
904 -- No need to check for duplicate fields
905 -- since that is done by RnNames.extendGlobalRdrEnvRn
906 ; return (RecCon new_fields) }
908 rnField :: SDoc -> ConDeclField RdrName -> RnM (ConDeclField Name)
909 rnField doc (ConDeclField name ty haddock_doc)
910 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
911 rnLHsType doc ty `thenM` \ new_ty ->
912 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
913 returnM (ConDeclField new_name new_ty new_haddock_doc)
915 -- Rename family declarations
917 -- * This function is parametrised by the routine handling the index
918 -- variables. On the toplevel, these are defining occurences, whereas they
919 -- are usage occurences for associated types.
921 rnFamily :: TyClDecl RdrName
922 -> (SDoc -> [LHsTyVarBndr RdrName] ->
923 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
924 RnM (TyClDecl Name, FreeVars))
925 -> RnM (TyClDecl Name, FreeVars)
927 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
928 tcdLName = tycon, tcdTyVars = tyvars})
930 do { checkM (isDataFlavour flavour -- for synonyms,
931 || not (null tyvars)) $ addErr needOneIdx -- no. of indexes >= 1
932 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
933 ; tycon' <- lookupLocatedTopBndrRn tycon
934 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
935 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
939 isDataFlavour DataFamily = True
940 isDataFlavour _ = False
941 rnFamily d _ = pprPanic "rnFamily" (ppr d)
943 family_doc :: Located RdrName -> SDoc
944 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
947 needOneIdx = text "Type family declarations requires at least one type index"
949 -- Rename associated type declarations (in classes)
951 -- * This can be family declarations and (default) type instances
953 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
954 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
956 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
957 rn_at (tydecl@TySynonym {}) =
959 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
961 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
963 lookupIdxVars _ tyvars cont =
964 do { checkForDups tyvars;
965 ; tyvars' <- mappM lookupIdxVar tyvars
968 -- Type index variables must be class parameters, which are the only
969 -- type variables in scope at this point.
970 lookupIdxVar (L l tyvar) =
972 name' <- lookupOccRn (hsTyVarName tyvar)
973 return $ L l (replaceTyVarName tyvar name')
975 -- Type variable may only occur once.
977 checkForDups [] = return ()
978 checkForDups (L loc tv:ltvs) =
979 do { setSrcSpan loc $
980 when (hsTyVarName tv `ltvElem` ltvs) $
981 addErr (repeatedTyVar tv)
985 _ `ltvElem` [] = False
986 rdrName `ltvElem` (L _ tv:ltvs)
987 | rdrName == hsTyVarName tv = True
988 | otherwise = rdrName `ltvElem` ltvs
991 noPatterns = text "Default definition for an associated synonym cannot have"
992 <+> text "type pattern"
994 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
995 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
998 -- This data decl will parse OK
1000 -- treating "a" as the constructor.
1001 -- It is really hard to make the parser spot this malformation.
1002 -- So the renamer has to check that the constructor is legal
1004 -- We can get an operator as the constructor, even in the prefix form:
1005 -- data T = :% Int Int
1006 -- from interface files, which always print in prefix form
1008 checkConName :: RdrName -> TcRn ()
1009 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1011 badDataCon :: RdrName -> SDoc
1013 = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
1017 %*********************************************************
1019 \subsection{Support code for type/data declarations}
1021 %*********************************************************
1023 Get the mapping from constructors to fields for this module.
1024 It's convenient to do this after the data type decls have been renamed
1026 extendRecordFieldEnv :: [LTyClDecl RdrName] -> TcM TcGblEnv
1027 extendRecordFieldEnv decls
1028 = do { tcg_env <- getGblEnv
1029 ; field_env' <- foldrM get (tcg_field_env tcg_env) decls
1030 ; return (tcg_env { tcg_field_env = field_env' }) }
1032 -- we want to lookup:
1033 -- (a) a datatype constructor
1034 -- (b) a record field
1035 -- knowing that they're from this module.
1036 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1037 -- which keeps only the local ones.
1038 lookup x = do { x' <- lookupLocatedTopBndrRn x
1039 ; return $ unLoc x'}
1041 get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
1042 get _ env = return env
1044 get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
1045 = do { con' <- lookup con
1046 ; flds' <- mappM lookup (map cd_fld_name flds)
1047 ; return $ extendNameEnv env con' flds' }
1052 %*********************************************************
1054 \subsection{Support code to rename types}
1056 %*********************************************************
1059 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1062 = mappM (wrapLocM rn_fds) fds
1065 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1066 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1067 returnM (tys1', tys2')
1069 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1070 rnHsTyVars doc tvs = mappM (rnHsTyVar doc) tvs
1072 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1073 rnHsTyVar _doc tyvar = lookupOccRn tyvar
1077 %*********************************************************
1081 %*********************************************************
1087 h = ...$(thing "f")...
1089 The splice can expand into literally anything, so when we do dependency
1090 analysis we must assume that it might mention 'f'. So we simply treat
1091 all locally-defined names as mentioned by any splice. This is terribly
1092 brutal, but I don't see what else to do. For example, it'll mean
1093 that every locally-defined thing will appear to be used, so no unused-binding
1094 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
1095 and that will crash the type checker because 'f' isn't in scope.
1097 Currently, I'm not treating a splice as also mentioning every import,
1098 which is a bit inconsistent -- but there are a lot of them. We might
1099 thereby get some bogus unused-import warnings, but we won't crash the
1100 type checker. Not very satisfactory really.
1103 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
1104 rnSplice (HsSplice n expr)
1105 = do { checkTH expr "splice"
1106 ; loc <- getSrcSpanM
1107 ; [n'] <- newLocalsRn [L loc n]
1108 ; (expr', fvs) <- rnLExpr expr
1110 -- Ugh! See Note [Splices] above
1111 ; lcl_rdr <- getLocalRdrEnv
1112 ; gbl_rdr <- getGlobalRdrEnv
1113 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
1115 lcl_names = mkNameSet (occEnvElts lcl_rdr)
1117 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
1119 checkTH :: Outputable a => a -> String -> RnM ()
1121 checkTH _ _ = returnM () -- OK
1123 checkTH e what -- Raise an error in a stage-1 compiler
1124 = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>
1125 ptext (sLit "illegal in a stage-1 compiler"),