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, lookupLocatedOccRn,
26 lookupTopBndrRn, lookupLocatedTopBndrRn,
27 lookupOccRn, newLocalsRn,
28 bindLocatedLocalsFV, bindPatSigTyVarsFV,
29 bindTyVarsRn, extendTyVarEnvFVRn,
30 bindLocalNames, checkDupRdrNames, mapFvRn,
32 import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
33 import HscTypes ( GenAvailInfo(..), availsToNameSet )
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 -- Rename a HsGroup; used for normal source files *and* hs-boot files
99 rnSrcDecls group@(HsGroup {hs_valds = val_decls,
100 hs_tyclds = tycl_decls,
101 hs_instds = inst_decls,
102 hs_derivds = deriv_decls,
103 hs_fixds = fix_decls,
104 hs_warnds = warn_decls,
105 hs_annds = ann_decls,
106 hs_fords = foreign_decls,
107 hs_defds = default_decls,
108 hs_ruleds = rule_decls,
111 -- (A) Process the fixity declarations, creating a mapping from
112 -- FastStrings to FixItems.
113 -- Also checks for duplcates.
114 local_fix_env <- makeMiniFixityEnv fix_decls;
116 -- (B) Bring top level binders (and their fixities) into scope,
117 -- *except* for the value bindings, which get brought in below.
118 -- However *do* include class ops, data constructors
119 -- And for hs-boot files *do* include the value signatures
120 tc_avails <- getLocalNonValBinders group ;
121 tc_envs <- extendGlobalRdrEnvRn tc_avails local_fix_env ;
122 setEnvs tc_envs $ do {
124 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
126 -- (C) Extract the mapping from data constructors to field names and
127 -- extend the record field env.
128 -- This depends on the data constructors and field names being in
129 -- scope from (B) above
130 inNewEnv (extendRecordFieldEnv tycl_decls) $ \ _ -> do {
132 -- (D) Rename the left-hand sides of the value bindings.
133 -- This depends on everything from (B) being in scope,
134 -- and on (C) for resolving record wild cards.
135 -- It uses the fixity env from (A) to bind fixities for view patterns.
136 new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
137 -- bind the LHSes (and their fixities) in the global rdr environment
138 let { val_binders = map unLoc $ collectHsValBinders new_lhs ;
139 val_bndr_set = mkNameSet val_binders ;
140 all_bndr_set = val_bndr_set `unionNameSets` availsToNameSet tc_avails ;
141 val_avails = map Avail val_binders
143 (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
144 setEnvs (tcg_env, tcl_env) $ do {
146 -- Now everything is in scope, as the remaining renaming assumes.
148 -- (E) Rename type and class decls
149 -- (note that value LHSes need to be in scope for default methods)
151 -- You might think that we could build proper def/use information
152 -- for type and class declarations, but they can be involved
153 -- in mutual recursion across modules, and we only do the SCC
154 -- analysis for them in the type checker.
155 -- So we content ourselves with gathering uses only; that
156 -- means we'll only report a declaration as unused if it isn't
157 -- mentioned at all. Ah well.
158 traceRn (text "Start rnTyClDecls") ;
159 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
161 -- (F) Rename Value declarations right-hand sides
162 traceRn (text "Start rnmono") ;
163 (rn_val_decls, bind_dus) <- rnTopBindsRHS val_bndr_set new_lhs ;
164 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
166 -- (G) Rename Fixity and deprecations
168 -- Rename fixity declarations and error if we try to
169 -- fix something from another module (duplicates were checked in (A))
170 rn_fix_decls <- rnSrcFixityDecls all_bndr_set fix_decls ;
172 -- Rename deprec decls;
173 -- check for duplicates and ensure that deprecated things are defined locally
174 -- at the moment, we don't keep these around past renaming
175 rn_warns <- rnSrcWarnDecls all_bndr_set warn_decls ;
177 -- (H) Rename Everything else
179 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
180 (rn_rule_decls, src_fvs3) <- setOptM Opt_ScopedTypeVariables $
181 rnList rnHsRuleDecl rule_decls ;
182 -- Inside RULES, scoped type variables are on
183 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
184 (rn_ann_decls, src_fvs5) <- rnList rnAnnDecl ann_decls ;
185 (rn_default_decls, src_fvs6) <- rnList rnDefaultDecl default_decls ;
186 (rn_deriv_decls, src_fvs7) <- rnList rnSrcDerivDecl deriv_decls ;
187 -- Haddock docs; no free vars
188 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
190 -- (I) Compute the results and return
191 let {rn_group = HsGroup { hs_valds = rn_val_decls,
192 hs_tyclds = rn_tycl_decls,
193 hs_instds = rn_inst_decls,
194 hs_derivds = rn_deriv_decls,
195 hs_fixds = rn_fix_decls,
196 hs_warnds = [], -- warns are returned in the tcg_env
197 -- (see below) not in the HsGroup
198 hs_fords = rn_foreign_decls,
199 hs_annds = rn_ann_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_fvs3, src_fvs4,
205 src_fvs5, src_fvs6, src_fvs7] ;
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_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
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 :: NameSet -> [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 bound_names 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 bound_names what rdr_name
291 return [ L loc (FixitySig (L name_loc name) fixity)
293 what = ptext (sLit "fixity signature")
297 %*********************************************************
299 Source-code deprecations declarations
301 %*********************************************************
303 Check that the deprecated names are defined, are defined locally, and
304 that there are no duplicate deprecations.
306 It's only imported deprecations, dealt with in RnIfaces, that we
307 gather them together.
310 -- checks that the deprecations are defined locally, and that there are no duplicates
311 rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
312 rnSrcWarnDecls _bound_names []
315 rnSrcWarnDecls bound_names decls
316 = do { -- check for duplicates
317 ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups
318 ; mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
319 returnM (WarnSome ((concat pairs_s))) }
321 rn_deprec (Warning rdr_name txt)
322 -- ensures that the names are defined locally
323 = lookupLocalDataTcNames bound_names what rdr_name `thenM` \ names ->
324 returnM [(nameOccName name, txt) | name <- names]
326 what = ptext (sLit "deprecation")
328 -- look for duplicates among the OccNames;
329 -- we check that the names are defined above
330 -- invt: the lists returned by findDupsEq always have at least two elements
331 warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
332 (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
334 dupWarnDecl :: Located RdrName -> RdrName -> SDoc
335 -- Located RdrName -> DeprecDecl RdrName -> SDoc
336 dupWarnDecl (L loc _) rdr_name
337 = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
338 ptext (sLit "also at ") <+> ppr loc]
342 %*********************************************************
344 \subsection{Annotation declarations}
346 %*********************************************************
349 rnAnnDecl :: AnnDecl RdrName -> RnM (AnnDecl Name, FreeVars)
350 rnAnnDecl (HsAnnotation provenance expr) = do
351 (provenance', provenance_fvs) <- rnAnnProvenance provenance
352 (expr', expr_fvs) <- rnLExpr expr
353 return (HsAnnotation provenance' expr', provenance_fvs `plusFV` expr_fvs)
355 rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
356 rnAnnProvenance provenance = do
357 provenance' <- modifyAnnProvenanceNameM lookupTopBndrRn provenance
358 return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
361 %*********************************************************
363 \subsection{Default declarations}
365 %*********************************************************
368 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
369 rnDefaultDecl (DefaultDecl tys)
370 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
371 returnM (DefaultDecl tys', fvs)
373 doc_str = text "In a `default' declaration"
376 %*********************************************************
378 \subsection{Foreign declarations}
380 %*********************************************************
383 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
384 rnHsForeignDecl (ForeignImport name ty spec)
385 = lookupLocatedTopBndrRn name `thenM` \ name' ->
386 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
387 returnM (ForeignImport name' ty' spec, fvs)
389 rnHsForeignDecl (ForeignExport name ty spec)
390 = lookupLocatedOccRn name `thenM` \ name' ->
391 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
392 returnM (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
393 -- NB: a foreign export is an *occurrence site* for name, so
394 -- we add it to the free-variable list. It might, for example,
395 -- be imported from another module
397 fo_decl_msg :: Located RdrName -> SDoc
398 fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
402 %*********************************************************
404 \subsection{Instance declarations}
406 %*********************************************************
409 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
410 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
411 -- Used for both source and interface file decls
412 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
414 -- Rename the bindings
415 -- The typechecker (not the renamer) checks that all
416 -- the bindings are for the right class
418 meth_doc = text "In the bindings in an instance declaration"
419 meth_names = collectHsBindLocatedBinders mbinds
420 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
422 checkDupRdrNames meth_doc meth_names `thenM_`
423 -- Check that the same method is not given twice in the
424 -- same instance decl instance C T where
428 -- We must use checkDupRdrNames because the Name of the
429 -- method is the Name of the class selector, whose SrcSpan
430 -- points to the class declaration
432 extendTyVarEnvForMethodBinds inst_tyvars (
433 -- (Slightly strangely) the forall-d tyvars scope over
434 -- the method bindings too
435 rnMethodBinds cls (\_ -> []) -- No scoped tyvars
437 ) `thenM` \ (mbinds', meth_fvs) ->
438 -- Rename the associated types
439 -- The typechecker (not the renamer) checks that all
440 -- the declarations are for the right class
442 at_doc = text "In the associated types of an instance declaration"
443 at_names = map (head . tyClDeclNames . unLoc) ats
445 checkDupRdrNames at_doc at_names `thenM_`
446 -- See notes with checkDupRdrNames for methods, above
448 rnATInsts ats `thenM` \ (ats', at_fvs) ->
450 -- Rename the prags and signatures.
451 -- Note that the type variables are not in scope here,
452 -- so that instance Eq a => Eq (T a) where
453 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
456 -- But the (unqualified) method names are in scope
458 binders = collectHsBindBinders mbinds'
459 bndr_set = mkNameSet binders
461 bindLocalNames binders
462 (renameSigs (Just bndr_set) okInstDclSig uprags) `thenM` \ uprags' ->
464 returnM (InstDecl inst_ty' mbinds' uprags' ats',
465 meth_fvs `plusFV` at_fvs
466 `plusFV` hsSigsFVs uprags'
467 `plusFV` extractHsTyNames inst_ty')
468 -- We return the renamed associated data type declarations so
469 -- that they can be entered into the list of type declarations
470 -- for the binding group, but we also keep a copy in the instance.
471 -- The latter is needed for well-formedness checks in the type
472 -- checker (eg, to ensure that all ATs of the instance actually
473 -- receive a declaration).
474 -- NB: Even the copies in the instance declaration carry copies of
475 -- the instance context after renaming. This is a bit
476 -- strange, but should not matter (and it would be more work
477 -- to remove the context).
480 Renaming of the associated types in instances.
483 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
484 rnATInsts atDecls = rnList rnATInst atDecls
486 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
487 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
489 pprPanic "RnSource.rnATInsts: invalid AT instance"
490 (ppr (tcdName tydecl))
493 For the method bindings in class and instance decls, we extend the
494 type variable environment iff -fglasgow-exts
497 extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
498 -> RnM (Bag (LHsBind Name), FreeVars)
499 -> RnM (Bag (LHsBind Name), FreeVars)
500 extendTyVarEnvForMethodBinds tyvars thing_inside
501 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
503 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
508 %*********************************************************
510 \subsection{Stand-alone deriving declarations}
512 %*********************************************************
515 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
516 rnSrcDerivDecl (DerivDecl ty)
517 = do ty' <- rnLHsType (text "a deriving decl") ty
518 let fvs = extractHsTyNames ty'
519 return (DerivDecl ty', fvs)
522 %*********************************************************
526 %*********************************************************
529 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
530 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
531 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
532 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
533 do { (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
534 -- NB: The binders in a rule are always Ids
535 -- We don't (yet) support type variables
537 ; (lhs', fv_lhs') <- rnLExpr lhs
538 ; (rhs', fv_rhs') <- rnLExpr rhs
540 ; checkValidRule rule_name ids lhs' fv_lhs'
542 ; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
543 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
545 doc = text "In the transformation rule" <+> ftext rule_name
547 get_var (RuleBndr v) = v
548 get_var (RuleBndrSig v _) = v
550 rn_var (RuleBndr (L loc _), id)
551 = returnM (RuleBndr (L loc id), emptyFVs)
552 rn_var (RuleBndrSig (L loc _) t, id)
553 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
554 returnM (RuleBndrSig (L loc id) t', fvs)
556 badRuleVar :: FastString -> Name -> SDoc
558 = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
559 ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
560 ptext (sLit "does not appear on left hand side")]
563 Note [Rule LHS validity checking]
564 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
565 Check the shape of a transformation rule LHS. Currently we only allow
566 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
567 @forall@'d variables.
569 We used restrict the form of the 'ei' to prevent you writing rules
570 with LHSs with a complicated desugaring (and hence unlikely to match);
571 (e.g. a case expression is not allowed: too elaborate.)
573 But there are legitimate non-trivial args ei, like sections and
574 lambdas. So it seems simmpler not to check at all, and that is why
575 check_e is commented out.
578 checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
579 checkValidRule rule_name ids lhs' fv_lhs'
580 = do { -- Check for the form of the LHS
581 case (validRuleLhs ids lhs') of
583 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
585 -- Check that LHS vars are all bound
586 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
587 ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
589 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
591 -- Just e => Not ok, and e is the offending expression
592 validRuleLhs foralls lhs
595 checkl (L _ e) = check e
597 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
598 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
599 check (HsVar v) | v `notElem` foralls = Nothing
600 check other = Just other -- Failure
603 checkl_e (L _ _e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
605 {- Commented out; see Note [Rule LHS validity checking] above
606 check_e (HsVar v) = Nothing
607 check_e (HsPar e) = checkl_e e
608 check_e (HsLit e) = Nothing
609 check_e (HsOverLit e) = Nothing
611 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
612 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
613 check_e (NegApp e _) = checkl_e e
614 check_e (ExplicitList _ es) = checkl_es es
615 check_e (ExplicitTuple es _) = checkl_es es
616 check_e other = Just other -- Fails
618 checkl_es es = foldr (mplus . checkl_e) Nothing es
621 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
622 badRuleLhsErr name lhs bad_e
623 = sep [ptext (sLit "Rule") <+> ftext name <> colon,
624 nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
625 ptext (sLit "in left-hand side:") <+> ppr lhs])]
627 ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
631 %*********************************************************
633 \subsection{Type, class and iface sig declarations}
635 %*********************************************************
637 @rnTyDecl@ uses the `global name function' to create a new type
638 declaration in which local names have been replaced by their original
639 names, reporting any unknown names.
641 Renaming type variables is a pain. Because they now contain uniques,
642 it is necessary to pass in an association list which maps a parsed
643 tyvar to its @Name@ representation.
644 In some cases (type signatures of values),
645 it is even necessary to go over the type first
646 in order to get the set of tyvars used by it, make an assoc list,
647 and then go over it again to rename the tyvars!
648 However, we can also do some scoping checks at the same time.
651 rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
652 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
653 = lookupLocatedTopBndrRn name `thenM` \ name' ->
654 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
657 -- all flavours of type family declarations ("type family", "newtype fanily",
658 -- and "data family")
659 rnTyClDecl (tydecl@TyFamily {}) =
660 rnFamily tydecl bindTyVarsRn
662 -- "data", "newtype", "data instance, and "newtype instance" declarations
663 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
664 tcdLName = tycon, tcdTyVars = tyvars,
665 tcdTyPats = typatsMaybe, tcdCons = condecls,
666 tcdKindSig = sig, tcdDerivs = derivs})
667 | is_vanilla -- Normal Haskell data type decl
668 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
669 -- data type is syntactically illegal
670 do { tyvars <- pruneTyVars tydecl
671 ; bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
672 { tycon' <- if isFamInstDecl tydecl
673 then lookupLocatedOccRn tycon -- may be imported family
674 else lookupLocatedTopBndrRn tycon
675 ; context' <- rnContext data_doc context
676 ; typats' <- rnTyPats data_doc typatsMaybe
677 ; (derivs', deriv_fvs) <- rn_derivs derivs
678 ; condecls' <- rnConDecls (unLoc tycon') condecls
679 -- No need to check for duplicate constructor decls
680 -- since that is done by RnNames.extendGlobalRdrEnvRn
681 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
682 tcdLName = tycon', tcdTyVars = tyvars',
683 tcdTyPats = typats', tcdKindSig = Nothing,
684 tcdCons = condecls', tcdDerivs = derivs'},
685 delFVs (map hsLTyVarName tyvars') $
686 extractHsCtxtTyNames context' `plusFV`
687 plusFVs (map conDeclFVs condecls') `plusFV`
689 (if isFamInstDecl tydecl
690 then unitFV (unLoc tycon') -- type instance => use
695 = do { tycon' <- if isFamInstDecl tydecl
696 then lookupLocatedOccRn tycon -- may be imported family
697 else lookupLocatedTopBndrRn tycon
698 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
700 <- bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
701 { typats' <- rnTyPats data_doc typatsMaybe
702 ; return (tyvars', typats') }
703 -- For GADTs, the type variables in the declaration
704 -- do not scope over the constructor signatures
705 -- data T a where { T1 :: forall b. b-> b }
707 ; (derivs', deriv_fvs) <- rn_derivs derivs
708 ; condecls' <- rnConDecls (unLoc tycon') condecls
709 -- No need to check for duplicate constructor decls
710 -- since that is done by RnNames.extendGlobalRdrEnvRn
712 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
713 tcdLName = tycon', tcdTyVars = tyvars',
714 tcdTyPats = typats', tcdKindSig = sig,
715 tcdCons = condecls', tcdDerivs = derivs'},
716 plusFVs (map conDeclFVs condecls') `plusFV`
718 (if isFamInstDecl tydecl
719 then unitFV (unLoc tycon') -- type instance => use
723 is_vanilla = case condecls of -- Yuk
725 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
728 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
730 rn_derivs Nothing = returnM (Nothing, emptyFVs)
731 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
732 returnM (Just ds', extractHsTyNames_s ds')
734 -- "type" and "type instance" declarations
735 rnTyClDecl tydecl@(TySynonym {tcdLName = name,
736 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
737 = do { tyvars <- pruneTyVars tydecl
738 ; bindTyVarsRn syn_doc tyvars $ \ tyvars' -> do
739 { name' <- if isFamInstDecl tydecl
740 then lookupLocatedOccRn name -- may be imported family
741 else lookupLocatedTopBndrRn name
742 ; typats' <- rnTyPats syn_doc typatsMaybe
743 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
744 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
745 tcdTyPats = typats', tcdSynRhs = ty'},
746 delFVs (map hsLTyVarName tyvars') $
748 (if isFamInstDecl tydecl
749 then unitFV (unLoc name') -- type instance => use
753 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
755 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
756 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
757 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
758 = do { cname' <- lookupLocatedTopBndrRn cname
760 -- Tyvars scope over superclass context and method signatures
761 ; (tyvars', context', fds', ats', ats_fvs, sigs')
762 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
763 { context' <- rnContext cls_doc context
764 ; fds' <- rnFds cls_doc fds
765 ; (ats', ats_fvs) <- rnATs ats
766 ; sigs' <- renameSigs Nothing okClsDclSig sigs
767 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
769 -- No need to check for duplicate associated type decls
770 -- since that is done by RnNames.extendGlobalRdrEnvRn
772 -- Check the signatures
773 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
774 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
775 ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
776 -- Typechecker is responsible for checking that we only
777 -- give default-method bindings for things in this class.
778 -- The renamer *could* check this for class decls, but can't
779 -- for instance decls.
781 -- The newLocals call is tiresome: given a generic class decl
784 -- op {| x+y |} (Inl a) = ...
785 -- op {| x+y |} (Inr b) = ...
786 -- op {| a*b |} (a*b) = ...
787 -- we want to name both "x" tyvars with the same unique, so that they are
788 -- easy to group together in the typechecker.
789 ; (mbinds', meth_fvs)
790 <- extendTyVarEnvForMethodBinds tyvars' $ do
791 { name_env <- getLocalRdrEnv
792 ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
793 not (unLoc tv `elemLocalRdrEnv` name_env) ]
794 -- No need to check for duplicate method signatures
795 -- since that is done by RnNames.extendGlobalRdrEnvRn
796 -- and the methods are already in scope
797 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
798 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
801 ; docs' <- mapM (wrapLocM rnDocDecl) docs
803 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
804 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
805 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
807 delFVs (map hsLTyVarName tyvars') $
808 extractHsCtxtTyNames context' `plusFV`
809 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
810 hsSigsFVs sigs' `plusFV`
814 cls_doc = text "In the declaration for class" <+> ppr cname
815 sig_doc = text "In the signatures for class" <+> ppr cname
817 badGadtStupidTheta :: Located RdrName -> SDoc
819 = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
820 ptext (sLit "(You can put a context on each contructor, though.)")]
823 %*********************************************************
825 \subsection{Support code for type/data declarations}
827 %*********************************************************
830 -- Remove any duplicate type variables in family instances may have non-linear
831 -- left-hand sides. Complain if any, but the first occurence of a type
832 -- variable has a user-supplied kind signature.
834 pruneTyVars :: TyClDecl RdrName -> RnM [LHsTyVarBndr RdrName]
836 | isFamInstDecl tydecl
837 = do { let pruned_tyvars = nubBy eqLTyVar tyvars
838 ; assertNoSigsInRepeats tyvars
839 ; return pruned_tyvars
844 tyvars = tcdTyVars tydecl
846 assertNoSigsInRepeats [] = return ()
847 assertNoSigsInRepeats (tv:tvs)
848 = do { let offending_tvs = [ tv' | tv'@(L _ (KindedTyVar _ _)) <- tvs
850 ; checkErr (null offending_tvs) $
851 illegalKindSig (head offending_tvs)
852 ; assertNoSigsInRepeats tvs
856 = hsep [ptext (sLit "Repeat variable occurrence may not have a"),
857 ptext (sLit "kind signature:"), quotes (ppr tv)]
859 tv1 `eqLTyVar` tv2 = hsLTyVarLocName tv1 `eqLocated` hsLTyVarLocName tv2
861 -- Although, we are processing type patterns here, all type variables will
862 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
863 -- type declaration to which these patterns belong)
865 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
866 rnTyPats _ Nothing = return Nothing
867 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
869 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
870 rnConDecls _tycon condecls
871 = mappM (wrapLocM rnConDecl) condecls
873 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
874 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
875 = do { addLocM checkConName name
877 ; new_name <- lookupLocatedTopBndrRn name
878 ; name_env <- getLocalRdrEnv
880 -- For H98 syntax, the tvs are the existential ones
881 -- For GADT syntax, the tvs are all the quantified tyvars
882 -- Hence the 'filter' in the ResTyH98 case only
883 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
884 arg_tys = hsConDeclArgTys details
885 implicit_tvs = case res_ty of
886 ResTyH98 -> filter not_in_scope $
888 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
891 Implicit -> userHsTyVarBndrs implicit_tvs
893 ; mb_doc' <- rnMbLHsDoc mb_doc
895 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
896 { new_context <- rnContext doc cxt
897 ; new_details <- rnConDeclDetails doc details
898 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
899 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
901 doc = text "In the definition of data constructor" <+> quotes (ppr name)
902 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
905 -> HsConDetails (LHsType Name) [ConDeclField Name]
907 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
909 rnConResult _ details ResTyH98 = return (details, ResTyH98)
911 rnConResult doc details (ResTyGADT ty) = do
912 ty' <- rnHsSigType doc ty
913 let (arg_tys, res_ty) = splitHsFunType ty'
914 -- We can split it up, now the renamer has dealt with fixities
916 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
917 RecCon _ -> return (details, ResTyGADT ty')
918 InfixCon {} -> panic "rnConResult"
920 rnConDeclDetails :: SDoc
921 -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
922 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
923 rnConDeclDetails doc (PrefixCon tys)
924 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
925 returnM (PrefixCon new_tys)
927 rnConDeclDetails doc (InfixCon ty1 ty2)
928 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
929 rnLHsType doc ty2 `thenM` \ new_ty2 ->
930 returnM (InfixCon new_ty1 new_ty2)
932 rnConDeclDetails doc (RecCon fields)
933 = do { new_fields <- mappM (rnField doc) fields
934 -- No need to check for duplicate fields
935 -- since that is done by RnNames.extendGlobalRdrEnvRn
936 ; return (RecCon new_fields) }
938 rnField :: SDoc -> ConDeclField RdrName -> RnM (ConDeclField Name)
939 rnField doc (ConDeclField name ty haddock_doc)
940 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
941 rnLHsType doc ty `thenM` \ new_ty ->
942 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
943 returnM (ConDeclField new_name new_ty new_haddock_doc)
945 -- Rename family declarations
947 -- * This function is parametrised by the routine handling the index
948 -- variables. On the toplevel, these are defining occurences, whereas they
949 -- are usage occurences for associated types.
951 rnFamily :: TyClDecl RdrName
952 -> (SDoc -> [LHsTyVarBndr RdrName] ->
953 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
954 RnM (TyClDecl Name, FreeVars))
955 -> RnM (TyClDecl Name, FreeVars)
957 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
958 tcdLName = tycon, tcdTyVars = tyvars})
960 do { checkM (isDataFlavour flavour -- for synonyms,
961 || not (null tyvars)) $ addErr needOneIdx -- no. of indexes >= 1
962 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
963 ; tycon' <- lookupLocatedTopBndrRn tycon
964 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
965 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
969 isDataFlavour DataFamily = True
970 isDataFlavour _ = False
971 rnFamily d _ = pprPanic "rnFamily" (ppr d)
973 family_doc :: Located RdrName -> SDoc
974 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
977 needOneIdx = text "Type family declarations requires at least one type index"
979 -- Rename associated type declarations (in classes)
981 -- * This can be family declarations and (default) type instances
983 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
984 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
986 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
987 rn_at (tydecl@TySynonym {}) =
989 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
991 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
993 lookupIdxVars _ tyvars cont =
994 do { checkForDups tyvars;
995 ; tyvars' <- mappM lookupIdxVar tyvars
998 -- Type index variables must be class parameters, which are the only
999 -- type variables in scope at this point.
1000 lookupIdxVar (L l tyvar) =
1002 name' <- lookupOccRn (hsTyVarName tyvar)
1003 return $ L l (replaceTyVarName tyvar name')
1005 -- Type variable may only occur once.
1007 checkForDups [] = return ()
1008 checkForDups (L loc tv:ltvs) =
1009 do { setSrcSpan loc $
1010 when (hsTyVarName tv `ltvElem` ltvs) $
1011 addErr (repeatedTyVar tv)
1015 _ `ltvElem` [] = False
1016 rdrName `ltvElem` (L _ tv:ltvs)
1017 | rdrName == hsTyVarName tv = True
1018 | otherwise = rdrName `ltvElem` ltvs
1021 noPatterns = text "Default definition for an associated synonym cannot have"
1022 <+> text "type pattern"
1024 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
1025 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
1028 -- This data decl will parse OK
1030 -- treating "a" as the constructor.
1031 -- It is really hard to make the parser spot this malformation.
1032 -- So the renamer has to check that the constructor is legal
1034 -- We can get an operator as the constructor, even in the prefix form:
1035 -- data T = :% Int Int
1036 -- from interface files, which always print in prefix form
1038 checkConName :: RdrName -> TcRn ()
1039 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1041 badDataCon :: RdrName -> SDoc
1043 = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
1047 %*********************************************************
1049 \subsection{Support code for type/data declarations}
1051 %*********************************************************
1053 Get the mapping from constructors to fields for this module.
1054 It's convenient to do this after the data type decls have been renamed
1056 extendRecordFieldEnv :: [LTyClDecl RdrName] -> TcM TcGblEnv
1057 extendRecordFieldEnv decls
1058 = do { tcg_env <- getGblEnv
1059 ; field_env' <- foldrM get (tcg_field_env tcg_env) decls
1060 ; return (tcg_env { tcg_field_env = field_env' }) }
1062 -- we want to lookup:
1063 -- (a) a datatype constructor
1064 -- (b) a record field
1065 -- knowing that they're from this module.
1066 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1067 -- which keeps only the local ones.
1068 lookup x = do { x' <- lookupLocatedTopBndrRn x
1069 ; return $ unLoc x'}
1071 get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
1072 get _ env = return env
1074 get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds }))
1075 (RecFields env fld_set)
1076 = do { con' <- lookup con
1077 ; flds' <- mappM lookup (map cd_fld_name flds)
1078 ; let env' = extendNameEnv env con' flds'
1079 fld_set' = addListToNameSet fld_set flds'
1080 ; return $ (RecFields env' fld_set') }
1081 get_con _ env = return env
1084 %*********************************************************
1086 \subsection{Support code to rename types}
1088 %*********************************************************
1091 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1094 = mappM (wrapLocM rn_fds) fds
1097 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1098 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1099 returnM (tys1', tys2')
1101 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1102 rnHsTyVars doc tvs = mappM (rnHsTyVar doc) tvs
1104 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1105 rnHsTyVar _doc tyvar = lookupOccRn tyvar
1109 %*********************************************************
1113 %*********************************************************
1119 h = ...$(thing "f")...
1121 The splice can expand into literally anything, so when we do dependency
1122 analysis we must assume that it might mention 'f'. So we simply treat
1123 all locally-defined names as mentioned by any splice. This is terribly
1124 brutal, but I don't see what else to do. For example, it'll mean
1125 that every locally-defined thing will appear to be used, so no unused-binding
1126 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
1127 and that will crash the type checker because 'f' isn't in scope.
1129 Currently, I'm not treating a splice as also mentioning every import,
1130 which is a bit inconsistent -- but there are a lot of them. We might
1131 thereby get some bogus unused-import warnings, but we won't crash the
1132 type checker. Not very satisfactory really.
1135 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
1136 rnSplice (HsSplice n expr)
1137 = do { checkTH expr "splice"
1138 ; loc <- getSrcSpanM
1139 ; [n'] <- newLocalsRn [L loc n]
1140 ; (expr', fvs) <- rnLExpr expr
1142 -- Ugh! See Note [Splices] above
1143 ; lcl_rdr <- getLocalRdrEnv
1144 ; gbl_rdr <- getGlobalRdrEnv
1145 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
1147 lcl_names = mkNameSet (occEnvElts lcl_rdr)
1149 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
1151 checkTH :: Outputable a => a -> String -> RnM ()
1153 checkTH _ _ = returnM () -- OK
1155 checkTH e what -- Raise an error in a stage-1 compiler
1156 = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>
1157 ptext (sLit "illegal in a stage-1 compiler"),