2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
8 rnSrcDecls, addTcgDUs, rnTyClDecls
11 #include "HsVersions.h"
13 import {-# SOURCE #-} RnExpr( rnLExpr )
16 import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv, rdrNameOcc )
17 import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
19 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext, rnConDeclFields )
20 import RnBinds ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
22 import RnEnv ( lookupLocalDataTcNames, lookupLocatedOccRn,
23 lookupTopBndrRn, lookupLocatedTopBndrRn,
24 lookupOccRn, newLocalBndrsRn,
25 bindLocatedLocalsFV, bindPatSigTyVarsFV,
26 bindTyVarsRn, extendTyVarEnvFVRn,
27 bindLocalNames, checkDupRdrNames, mapFvRn
29 import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
30 import HscTypes ( GenAvailInfo(..), availsToNameSet )
31 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
34 import HscTypes ( Warnings(..), plusWarns )
35 import Class ( FunDep )
36 import Name ( Name, nameOccName )
43 import DynFlags ( DynFlag(..) )
44 import BasicTypes ( Boxity(..) )
46 import ListSetOps (findDupsEq)
54 thenM :: Monad a => a b -> (b -> a c) -> a c
57 thenM_ :: Monad a => a b -> a c -> a c
61 @rnSourceDecl@ `renames' declarations.
62 It simultaneously performs dependency analysis and precedence parsing.
63 It also does the following error checks:
66 Checks that tyvars are used properly. This includes checking
67 for undefined tyvars, and tyvars in contexts that are ambiguous.
68 (Some of this checking has now been moved to module @TcMonoType@,
69 since we don't have functional dependency information at this point.)
71 Checks that all variable occurences are defined.
73 Checks the @(..)@ etc constraints in the export list.
78 -- Brings the binders of the group into scope in the appropriate places;
79 -- does NOT assume that anything is in scope already
80 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
81 -- Rename a HsGroup; used for normal source files *and* hs-boot files
82 rnSrcDecls group@(HsGroup {hs_valds = val_decls,
83 hs_tyclds = tycl_decls,
84 hs_instds = inst_decls,
85 hs_derivds = deriv_decls,
87 hs_warnds = warn_decls,
89 hs_fords = foreign_decls,
90 hs_defds = default_decls,
91 hs_ruleds = rule_decls,
94 -- (A) Process the fixity declarations, creating a mapping from
95 -- FastStrings to FixItems.
96 -- Also checks for duplcates.
97 local_fix_env <- makeMiniFixityEnv fix_decls;
99 -- (B) Bring top level binders (and their fixities) into scope,
100 -- *except* for the value bindings, which get brought in below.
101 -- However *do* include class ops, data constructors
102 -- And for hs-boot files *do* include the value signatures
103 tc_avails <- getLocalNonValBinders group ;
104 tc_envs <- extendGlobalRdrEnvRn tc_avails local_fix_env ;
105 setEnvs tc_envs $ 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 inst_decls) $ \ _ -> 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 { val_binders = map unLoc $ collectHsValBinders new_lhs ;
122 val_bndr_set = mkNameSet val_binders ;
123 all_bndr_set = val_bndr_set `unionNameSets` availsToNameSet tc_avails ;
124 val_avails = map Avail val_binders
126 (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
127 setEnvs (tcg_env, tcl_env) $ do {
129 -- Now everything is in scope, as the remaining renaming assumes.
131 -- (E) Rename type and class decls
132 -- (note that value LHSes need to be in scope for default methods)
134 -- You might think that we could build proper def/use information
135 -- for type and class declarations, but they can be involved
136 -- in mutual recursion across modules, and we only do the SCC
137 -- analysis for them in the type checker.
138 -- So we content ourselves with gathering uses only; that
139 -- means we'll only report a declaration as unused if it isn't
140 -- mentioned at all. Ah well.
141 traceRn (text "Start rnTyClDecls") ;
142 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
144 -- (F) Rename Value declarations right-hand sides
145 traceRn (text "Start rnmono") ;
146 (rn_val_decls, bind_dus) <- rnTopBindsRHS val_bndr_set new_lhs ;
147 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
149 -- (G) Rename Fixity and deprecations
151 -- Rename fixity declarations and error if we try to
152 -- fix something from another module (duplicates were checked in (A))
153 rn_fix_decls <- rnSrcFixityDecls all_bndr_set fix_decls ;
155 -- Rename deprec decls;
156 -- check for duplicates and ensure that deprecated things are defined locally
157 -- at the moment, we don't keep these around past renaming
158 rn_warns <- rnSrcWarnDecls all_bndr_set warn_decls ;
160 -- (H) Rename Everything else
162 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
163 (rn_rule_decls, src_fvs3) <- setOptM Opt_ScopedTypeVariables $
164 rnList rnHsRuleDecl rule_decls ;
165 -- Inside RULES, scoped type variables are on
166 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
167 (rn_ann_decls, src_fvs5) <- rnList rnAnnDecl ann_decls ;
168 (rn_default_decls, src_fvs6) <- rnList rnDefaultDecl default_decls ;
169 (rn_deriv_decls, src_fvs7) <- rnList rnSrcDerivDecl deriv_decls ;
170 -- Haddock docs; no free vars
171 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
173 -- (I) Compute the results and return
174 let {rn_group = HsGroup { hs_valds = rn_val_decls,
175 hs_tyclds = rn_tycl_decls,
176 hs_instds = rn_inst_decls,
177 hs_derivds = rn_deriv_decls,
178 hs_fixds = rn_fix_decls,
179 hs_warnds = [], -- warns are returned in the tcg_env
180 -- (see below) not in the HsGroup
181 hs_fords = rn_foreign_decls,
182 hs_annds = rn_ann_decls,
183 hs_defds = rn_default_decls,
184 hs_ruleds = rn_rule_decls,
185 hs_docs = rn_docs } ;
187 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
188 src_fvs5, src_fvs6, src_fvs7] ;
189 src_dus = bind_dus `plusDU` usesOnly other_fvs;
190 -- Note: src_dus will contain *uses* for locally-defined types
191 -- and classes, but no *defs* for them. (Because rnTyClDecl
192 -- returns only the uses.) This is a little
193 -- surprising but it doesn't actually matter at all.
195 final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
196 in -- we return the deprecs in the env, not in the HsGroup above
197 tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
200 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
201 traceRn (text "finish Dus" <+> ppr src_dus ) ;
202 return (final_tcg_env , rn_group)
205 -- some utils because we do this a bunch above
206 -- compute and install the new env
207 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
208 inNewEnv env cont = do e <- env
211 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
212 -- Used for external core
213 rnTyClDecls tycl_decls = do (decls', _fvs) <- rnList rnTyClDecl tycl_decls
216 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
217 -- This function could be defined lower down in the module hierarchy,
218 -- but there doesn't seem anywhere very logical to put it.
219 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
221 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
222 rnList f xs = mapFvRn (wrapLocFstM f) xs
226 %*********************************************************
230 %*********************************************************
233 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
234 rnDocDecl (DocCommentNext doc) = do
235 rn_doc <- rnHsDoc doc
236 return (DocCommentNext rn_doc)
237 rnDocDecl (DocCommentPrev doc) = do
238 rn_doc <- rnHsDoc doc
239 return (DocCommentPrev rn_doc)
240 rnDocDecl (DocCommentNamed str doc) = do
241 rn_doc <- rnHsDoc doc
242 return (DocCommentNamed str rn_doc)
243 rnDocDecl (DocGroup lev doc) = do
244 rn_doc <- rnHsDoc doc
245 return (DocGroup lev rn_doc)
249 %*********************************************************
251 Source-code fixity declarations
253 %*********************************************************
256 rnSrcFixityDecls :: NameSet -> [LFixitySig RdrName] -> RnM [LFixitySig Name]
257 -- Rename the fixity decls, so we can put
258 -- the renamed decls in the renamed syntax tree
259 -- Errors if the thing being fixed is not defined locally.
261 -- The returned FixitySigs are not actually used for anything,
262 -- except perhaps the GHCi API
263 rnSrcFixityDecls bound_names fix_decls
264 = do fix_decls <- mapM rn_decl fix_decls
265 return (concat fix_decls)
267 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
268 -- GHC extension: look up both the tycon and data con
269 -- for con-like things; hence returning a list
270 -- If neither are in scope, report an error; otherwise
271 -- return a fixity sig for each (slightly odd)
272 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
273 = setSrcSpan name_loc $
274 -- this lookup will fail if the definition isn't local
275 do names <- lookupLocalDataTcNames bound_names what rdr_name
276 return [ L loc (FixitySig (L name_loc name) fixity)
278 what = ptext (sLit "fixity signature")
282 %*********************************************************
284 Source-code deprecations declarations
286 %*********************************************************
288 Check that the deprecated names are defined, are defined locally, and
289 that there are no duplicate deprecations.
291 It's only imported deprecations, dealt with in RnIfaces, that we
292 gather them together.
295 -- checks that the deprecations are defined locally, and that there are no duplicates
296 rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
297 rnSrcWarnDecls _bound_names []
300 rnSrcWarnDecls bound_names decls
301 = do { -- check for duplicates
302 ; mapM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups
303 ; mapM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
304 return (WarnSome ((concat pairs_s))) }
306 rn_deprec (Warning rdr_name txt)
307 -- ensures that the names are defined locally
308 = lookupLocalDataTcNames bound_names what rdr_name `thenM` \ names ->
309 return [(nameOccName name, txt) | name <- names]
311 what = ptext (sLit "deprecation")
313 -- look for duplicates among the OccNames;
314 -- we check that the names are defined above
315 -- invt: the lists returned by findDupsEq always have at least two elements
316 warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
317 (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
319 dupWarnDecl :: Located RdrName -> RdrName -> SDoc
320 -- Located RdrName -> DeprecDecl RdrName -> SDoc
321 dupWarnDecl (L loc _) rdr_name
322 = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
323 ptext (sLit "also at ") <+> ppr loc]
327 %*********************************************************
329 \subsection{Annotation declarations}
331 %*********************************************************
334 rnAnnDecl :: AnnDecl RdrName -> RnM (AnnDecl Name, FreeVars)
335 rnAnnDecl (HsAnnotation provenance expr) = do
336 (provenance', provenance_fvs) <- rnAnnProvenance provenance
337 (expr', expr_fvs) <- rnLExpr expr
338 return (HsAnnotation provenance' expr', provenance_fvs `plusFV` expr_fvs)
340 rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
341 rnAnnProvenance provenance = do
342 provenance' <- modifyAnnProvenanceNameM lookupTopBndrRn provenance
343 return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
346 %*********************************************************
348 \subsection{Default declarations}
350 %*********************************************************
353 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
354 rnDefaultDecl (DefaultDecl tys)
355 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
356 return (DefaultDecl tys', fvs)
358 doc_str = text "In a `default' declaration"
361 %*********************************************************
363 \subsection{Foreign declarations}
365 %*********************************************************
368 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
369 rnHsForeignDecl (ForeignImport name ty spec)
370 = lookupLocatedTopBndrRn name `thenM` \ name' ->
371 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
372 return (ForeignImport name' ty' spec, fvs)
374 rnHsForeignDecl (ForeignExport name ty spec)
375 = lookupLocatedOccRn name `thenM` \ name' ->
376 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
377 return (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
378 -- NB: a foreign export is an *occurrence site* for name, so
379 -- we add it to the free-variable list. It might, for example,
380 -- be imported from another module
382 fo_decl_msg :: Located RdrName -> SDoc
383 fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
387 %*********************************************************
389 \subsection{Instance declarations}
391 %*********************************************************
394 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
395 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
396 -- Used for both source and interface file decls
397 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
399 -- Rename the bindings
400 -- The typechecker (not the renamer) checks that all
401 -- the bindings are for the right class
403 meth_doc = text "In the bindings in an instance declaration"
404 meth_names = collectHsBindLocatedBinders mbinds
405 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
407 checkDupRdrNames meth_doc meth_names `thenM_`
408 -- Check that the same method is not given twice in the
409 -- same instance decl instance C T where
413 -- We must use checkDupRdrNames because the Name of the
414 -- method is the Name of the class selector, whose SrcSpan
415 -- points to the class declaration
417 extendTyVarEnvForMethodBinds inst_tyvars (
418 -- (Slightly strangely) the forall-d tyvars scope over
419 -- the method bindings too
420 rnMethodBinds cls (\_ -> []) -- No scoped tyvars
422 ) `thenM` \ (mbinds', meth_fvs) ->
423 -- Rename the associated types
424 -- The typechecker (not the renamer) checks that all
425 -- the declarations are for the right class
427 at_doc = text "In the associated types of an instance declaration"
428 at_names = map (head . tyClDeclNames . unLoc) ats
430 checkDupRdrNames at_doc at_names `thenM_`
431 -- See notes with checkDupRdrNames for methods, above
433 rnATInsts ats `thenM` \ (ats', at_fvs) ->
435 -- Rename the prags and signatures.
436 -- Note that the type variables are not in scope here,
437 -- so that instance Eq a => Eq (T a) where
438 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
441 -- But the (unqualified) method names are in scope
443 binders = collectHsBindBinders mbinds'
444 bndr_set = mkNameSet binders
446 bindLocalNames binders
447 (renameSigs (Just bndr_set) okInstDclSig uprags) `thenM` \ uprags' ->
449 return (InstDecl inst_ty' mbinds' uprags' ats',
450 meth_fvs `plusFV` at_fvs
451 `plusFV` hsSigsFVs uprags'
452 `plusFV` extractHsTyNames inst_ty')
453 -- We return the renamed associated data type declarations so
454 -- that they can be entered into the list of type declarations
455 -- for the binding group, but we also keep a copy in the instance.
456 -- The latter is needed for well-formedness checks in the type
457 -- checker (eg, to ensure that all ATs of the instance actually
458 -- receive a declaration).
459 -- NB: Even the copies in the instance declaration carry copies of
460 -- the instance context after renaming. This is a bit
461 -- strange, but should not matter (and it would be more work
462 -- to remove the context).
465 Renaming of the associated types in instances.
468 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
469 rnATInsts atDecls = rnList rnATInst atDecls
471 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
472 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
474 pprPanic "RnSource.rnATInsts: invalid AT instance"
475 (ppr (tcdName tydecl))
478 For the method bindings in class and instance decls, we extend the
479 type variable environment iff -fglasgow-exts
482 extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
483 -> RnM (Bag (LHsBind Name), FreeVars)
484 -> RnM (Bag (LHsBind Name), FreeVars)
485 extendTyVarEnvForMethodBinds tyvars thing_inside
486 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
488 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
493 %*********************************************************
495 \subsection{Stand-alone deriving declarations}
497 %*********************************************************
500 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
501 rnSrcDerivDecl (DerivDecl ty)
502 = do { standalone_deriv_ok <- doptM Opt_StandaloneDeriving
503 ; unless standalone_deriv_ok (addErr standaloneDerivErr)
504 ; ty' <- rnLHsType (text "a deriving decl") ty
505 ; let fvs = extractHsTyNames ty'
506 ; return (DerivDecl ty', fvs) }
508 standaloneDerivErr :: SDoc
510 = hang (ptext (sLit "Illegal standalone deriving declaration"))
511 2 (ptext (sLit "Use -XStandaloneDeriving to enable this extension"))
514 %*********************************************************
518 %*********************************************************
521 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
522 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
523 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
524 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
525 do { (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
526 -- NB: The binders in a rule are always Ids
527 -- We don't (yet) support type variables
529 ; (lhs', fv_lhs') <- rnLExpr lhs
530 ; (rhs', fv_rhs') <- rnLExpr rhs
532 ; checkValidRule rule_name ids lhs' fv_lhs'
534 ; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
535 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
537 doc = text "In the transformation rule" <+> ftext rule_name
539 get_var (RuleBndr v) = v
540 get_var (RuleBndrSig v _) = v
542 rn_var (RuleBndr (L loc _), id)
543 = return (RuleBndr (L loc id), emptyFVs)
544 rn_var (RuleBndrSig (L loc _) t, id)
545 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
546 return (RuleBndrSig (L loc id) t', fvs)
548 badRuleVar :: FastString -> Name -> SDoc
550 = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
551 ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
552 ptext (sLit "does not appear on left hand side")]
555 Note [Rule LHS validity checking]
556 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
557 Check the shape of a transformation rule LHS. Currently we only allow
558 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
559 @forall@'d variables.
561 We used restrict the form of the 'ei' to prevent you writing rules
562 with LHSs with a complicated desugaring (and hence unlikely to match);
563 (e.g. a case expression is not allowed: too elaborate.)
565 But there are legitimate non-trivial args ei, like sections and
566 lambdas. So it seems simmpler not to check at all, and that is why
567 check_e is commented out.
570 checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
571 checkValidRule rule_name ids lhs' fv_lhs'
572 = do { -- Check for the form of the LHS
573 case (validRuleLhs ids lhs') of
575 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
577 -- Check that LHS vars are all bound
578 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
579 ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
581 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
583 -- Just e => Not ok, and e is the offending expression
584 validRuleLhs foralls lhs
587 checkl (L _ e) = check e
589 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
590 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
591 check (HsVar v) | v `notElem` foralls = Nothing
592 check other = Just other -- Failure
595 checkl_e (L _ _e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
597 {- Commented out; see Note [Rule LHS validity checking] above
598 check_e (HsVar v) = Nothing
599 check_e (HsPar e) = checkl_e e
600 check_e (HsLit e) = Nothing
601 check_e (HsOverLit e) = Nothing
603 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
604 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
605 check_e (NegApp e _) = checkl_e e
606 check_e (ExplicitList _ es) = checkl_es es
607 check_e other = Just other -- Fails
609 checkl_es es = foldr (mplus . checkl_e) Nothing es
612 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
613 badRuleLhsErr name lhs bad_e
614 = sep [ptext (sLit "Rule") <+> ftext name <> colon,
615 nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
616 ptext (sLit "in left-hand side:") <+> ppr lhs])]
618 ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
622 %*********************************************************
624 \subsection{Type, class and iface sig declarations}
626 %*********************************************************
628 @rnTyDecl@ uses the `global name function' to create a new type
629 declaration in which local names have been replaced by their original
630 names, reporting any unknown names.
632 Renaming type variables is a pain. Because they now contain uniques,
633 it is necessary to pass in an association list which maps a parsed
634 tyvar to its @Name@ representation.
635 In some cases (type signatures of values),
636 it is even necessary to go over the type first
637 in order to get the set of tyvars used by it, make an assoc list,
638 and then go over it again to rename the tyvars!
639 However, we can also do some scoping checks at the same time.
642 rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
643 rnTyClDecl (ForeignType {tcdLName = name, tcdExtName = ext_name})
644 = lookupLocatedTopBndrRn name `thenM` \ name' ->
645 return (ForeignType {tcdLName = name', tcdExtName = ext_name},
648 -- all flavours of type family declarations ("type family", "newtype fanily",
649 -- and "data family")
650 rnTyClDecl (tydecl@TyFamily {}) =
651 rnFamily tydecl bindTyVarsRn
653 -- "data", "newtype", "data instance, and "newtype instance" declarations
654 rnTyClDecl tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
655 tcdLName = tycon, tcdTyVars = tyvars,
656 tcdTyPats = typatsMaybe, tcdCons = condecls,
657 tcdKindSig = sig, tcdDerivs = derivs}
658 | is_vanilla -- Normal Haskell data type decl
659 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
660 -- data type is syntactically illegal
661 ASSERT( distinctTyVarBndrs tyvars ) -- Tyvars should be distinct
662 do { bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
663 { tycon' <- if isFamInstDecl tydecl
664 then lookupLocatedOccRn tycon -- may be imported family
665 else lookupLocatedTopBndrRn tycon
666 ; context' <- rnContext data_doc context
667 ; typats' <- rnTyPats data_doc typatsMaybe
668 ; condecls' <- rnConDecls (unLoc tycon') condecls
669 -- No need to check for duplicate constructor decls
670 -- since that is done by RnNames.extendGlobalRdrEnvRn
671 ; (derivs', deriv_fvs) <- rn_derivs derivs
672 ; return (TyData {tcdND = new_or_data, tcdCtxt = context',
673 tcdLName = tycon', tcdTyVars = tyvars',
674 tcdTyPats = typats', tcdKindSig = Nothing,
675 tcdCons = condecls', tcdDerivs = derivs'},
676 delFVs (map hsLTyVarName tyvars') $
677 extractHsCtxtTyNames context' `plusFV`
678 plusFVs (map conDeclFVs condecls') `plusFV`
680 (if isFamInstDecl tydecl
681 then unitFV (unLoc tycon') -- type instance => use
686 = do { tycon' <- if isFamInstDecl tydecl
687 then lookupLocatedOccRn tycon -- may be imported family
688 else lookupLocatedTopBndrRn tycon
689 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
691 <- bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
692 { typats' <- rnTyPats data_doc typatsMaybe
693 ; return (tyvars', typats') }
694 -- For GADTs, the type variables in the declaration
695 -- do not scope over the constructor signatures
696 -- data T a where { T1 :: forall b. b-> b }
698 ; condecls' <- rnConDecls (unLoc tycon') condecls
699 -- No need to check for duplicate constructor decls
700 -- since that is done by RnNames.extendGlobalRdrEnvRn
702 ; (derivs', deriv_fvs) <- rn_derivs derivs
703 ; return (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
704 tcdLName = tycon', tcdTyVars = tyvars',
705 tcdTyPats = typats', tcdKindSig = sig,
706 tcdCons = condecls', tcdDerivs = derivs'},
707 plusFVs (map conDeclFVs condecls') `plusFV`
709 (if isFamInstDecl tydecl
710 then unitFV (unLoc tycon') -- type instance => use
714 is_vanilla = case condecls of -- Yuk
716 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
719 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
721 rn_derivs Nothing = return (Nothing, emptyFVs)
722 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
723 return (Just ds', extractHsTyNames_s ds')
725 -- "type" and "type instance" declarations
726 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
727 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
728 = ASSERT( distinctTyVarBndrs tyvars ) -- Tyvars should be distinct
729 do { bindTyVarsRn syn_doc tyvars $ \ tyvars' -> do
730 { name' <- if isFamInstDecl tydecl
731 then lookupLocatedOccRn name -- may be imported family
732 else lookupLocatedTopBndrRn name
733 ; typats' <- rnTyPats syn_doc typatsMaybe
734 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
735 ; return (TySynonym {tcdLName = name', tcdTyVars = tyvars',
736 tcdTyPats = typats', tcdSynRhs = ty'},
737 delFVs (map hsLTyVarName tyvars') $
739 (if isFamInstDecl tydecl
740 then unitFV (unLoc name') -- type instance => use
744 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
746 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
747 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
748 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
749 = do { cname' <- lookupLocatedTopBndrRn cname
751 -- Tyvars scope over superclass context and method signatures
752 ; (tyvars', context', fds', ats', ats_fvs, sigs')
753 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
754 { context' <- rnContext cls_doc context
755 ; fds' <- rnFds cls_doc fds
756 ; (ats', ats_fvs) <- rnATs ats
757 ; sigs' <- renameSigs Nothing okClsDclSig sigs
758 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
760 -- No need to check for duplicate associated type decls
761 -- since that is done by RnNames.extendGlobalRdrEnvRn
763 -- Check the signatures
764 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
765 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
766 ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
767 -- Typechecker is responsible for checking that we only
768 -- give default-method bindings for things in this class.
769 -- The renamer *could* check this for class decls, but can't
770 -- for instance decls.
772 -- The newLocals call is tiresome: given a generic class decl
775 -- op {| x+y |} (Inl a) = ...
776 -- op {| x+y |} (Inr b) = ...
777 -- op {| a*b |} (a*b) = ...
778 -- we want to name both "x" tyvars with the same unique, so that they are
779 -- easy to group together in the typechecker.
780 ; (mbinds', meth_fvs)
781 <- extendTyVarEnvForMethodBinds tyvars' $ do
782 { name_env <- getLocalRdrEnv
783 ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
784 not (unLoc tv `elemLocalRdrEnv` name_env) ]
785 -- No need to check for duplicate method signatures
786 -- since that is done by RnNames.extendGlobalRdrEnvRn
787 -- and the methods are already in scope
788 ; gen_tyvars <- newLocalBndrsRn gen_rdr_tyvars_w_locs
789 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
792 ; docs' <- mapM (wrapLocM rnDocDecl) docs
794 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
795 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
796 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
798 delFVs (map hsLTyVarName tyvars') $
799 extractHsCtxtTyNames context' `plusFV`
800 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
801 hsSigsFVs sigs' `plusFV`
805 cls_doc = text "In the declaration for class" <+> ppr cname
806 sig_doc = text "In the signatures for class" <+> ppr cname
808 distinctTyVarBndrs :: [LHsTyVarBndr RdrName] -> Bool
809 -- The tyvar binders should have distinct names
810 distinctTyVarBndrs tvs
811 = null (findDupsEq eq tvs)
813 eq (L _ v1) (L _ v2) = hsTyVarName v1 == hsTyVarName v2
815 badGadtStupidTheta :: Located RdrName -> SDoc
817 = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
818 ptext (sLit "(You can put a context on each contructor, though.)")]
822 %*********************************************************
824 \subsection{Support code for type/data declarations}
826 %*********************************************************
829 -- Although, we are processing type patterns here, all type variables will
830 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
831 -- type declaration to which these patterns belong)
833 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
834 rnTyPats _ Nothing = return Nothing
835 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
837 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
838 rnConDecls _tycon condecls
839 = mapM (wrapLocM rnConDecl) condecls
841 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
842 rnConDecl decl@(ConDecl { con_name = name, con_qvars = tvs
843 , con_cxt = cxt, con_details = details
844 , con_res = res_ty, con_doc = mb_doc
845 , con_old_rec = old_rec, con_explicit = expl })
846 = do { addLocM checkConName name
847 ; when old_rec (addWarn (deprecRecSyntax decl))
849 ; new_name <- lookupLocatedTopBndrRn name
850 ; name_env <- getLocalRdrEnv
852 -- For H98 syntax, the tvs are the existential ones
853 -- For GADT syntax, the tvs are all the quantified tyvars
854 -- Hence the 'filter' in the ResTyH98 case only
855 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
856 arg_tys = hsConDeclArgTys details
857 implicit_tvs = case res_ty of
858 ResTyH98 -> filter not_in_scope $
860 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
861 new_tvs = case expl of
863 Implicit -> userHsTyVarBndrs implicit_tvs
865 ; mb_doc' <- rnMbLHsDoc mb_doc
867 ; bindTyVarsRn doc new_tvs $ \new_tyvars -> do
868 { new_context <- rnContext doc cxt
869 ; new_details <- rnConDeclDetails doc details
870 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
871 ; return (decl { con_name = new_name, con_qvars = new_tyvars, con_cxt = new_context
872 , con_details = new_details', con_res = new_res_ty, con_doc = mb_doc' }) }}
874 doc = text "In the definition of data constructor" <+> quotes (ppr name)
875 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
878 -> HsConDetails (LHsType Name) [ConDeclField Name]
880 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
882 rnConResult _ details ResTyH98 = return (details, ResTyH98)
883 rnConResult doc details (ResTyGADT ty)
884 = do { ty' <- rnLHsType doc ty
885 ; let (arg_tys, res_ty) = splitHsFunType ty'
886 -- We can finally split it up,
887 -- now the renamer has dealt with fixities
888 -- See Note [Sorting out the result type] in RdrHsSyn
890 details' = case details of
892 PrefixCon {} -> PrefixCon arg_tys
893 InfixCon {} -> pprPanic "rnConResult" (ppr ty)
894 -- See Note [Sorting out the result type] in RdrHsSyn
896 ; when (not (null arg_tys) && case details of { RecCon {} -> True; _ -> False })
897 (addErr (badRecResTy doc))
898 ; return (details', ResTyGADT res_ty) }
900 rnConDeclDetails :: SDoc
901 -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
902 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
903 rnConDeclDetails doc (PrefixCon tys)
904 = mapM (rnLHsType doc) tys `thenM` \ new_tys ->
905 return (PrefixCon new_tys)
907 rnConDeclDetails doc (InfixCon ty1 ty2)
908 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
909 rnLHsType doc ty2 `thenM` \ new_ty2 ->
910 return (InfixCon new_ty1 new_ty2)
912 rnConDeclDetails doc (RecCon fields)
913 = do { new_fields <- rnConDeclFields doc fields
914 -- No need to check for duplicate fields
915 -- since that is done by RnNames.extendGlobalRdrEnvRn
916 ; return (RecCon new_fields) }
918 -- Rename family declarations
920 -- * This function is parametrised by the routine handling the index
921 -- variables. On the toplevel, these are defining occurences, whereas they
922 -- are usage occurences for associated types.
924 rnFamily :: TyClDecl RdrName
925 -> (SDoc -> [LHsTyVarBndr RdrName] ->
926 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
927 RnM (TyClDecl Name, FreeVars))
928 -> RnM (TyClDecl Name, FreeVars)
930 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
931 tcdLName = tycon, tcdTyVars = tyvars})
933 do { bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
934 ; tycon' <- lookupLocatedTopBndrRn tycon
935 ; return (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
936 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
939 rnFamily d _ = pprPanic "rnFamily" (ppr d)
941 family_doc :: Located RdrName -> SDoc
942 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
944 -- Rename associated type declarations (in classes)
946 -- * This can be family declarations and (default) type instances
948 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
949 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
951 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
952 rn_at (tydecl@TySynonym {}) =
954 unless (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
956 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
958 lookupIdxVars _ tyvars cont =
959 do { checkForDups tyvars;
960 ; tyvars' <- mapM lookupIdxVar tyvars
963 -- Type index variables must be class parameters, which are the only
964 -- type variables in scope at this point.
965 lookupIdxVar (L l tyvar) =
967 name' <- lookupOccRn (hsTyVarName tyvar)
968 return $ L l (replaceTyVarName tyvar name')
970 -- Type variable may only occur once.
972 checkForDups [] = return ()
973 checkForDups (L loc tv:ltvs) =
974 do { setSrcSpan loc $
975 when (hsTyVarName tv `ltvElem` ltvs) $
976 addErr (repeatedTyVar tv)
980 _ `ltvElem` [] = False
981 rdrName `ltvElem` (L _ tv:ltvs)
982 | rdrName == hsTyVarName tv = True
983 | otherwise = rdrName `ltvElem` ltvs
985 deprecRecSyntax :: ConDecl RdrName -> SDoc
987 = vcat [ ptext (sLit "Declaration of") <+> quotes (ppr (con_name decl))
988 <+> ptext (sLit "uses deprecated syntax")
989 , ptext (sLit "Instead, use the form")
990 , nest 2 (ppr decl) ] -- Pretty printer uses new form
992 badRecResTy :: SDoc -> SDoc
993 badRecResTy doc = ptext (sLit "Malformed constructor signature") $$ doc
996 noPatterns = text "Default definition for an associated synonym cannot have"
997 <+> text "type pattern"
999 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
1000 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
1003 -- This data decl will parse OK
1005 -- treating "a" as the constructor.
1006 -- It is really hard to make the parser spot this malformation.
1007 -- So the renamer has to check that the constructor is legal
1009 -- We can get an operator as the constructor, even in the prefix form:
1010 -- data T = :% Int Int
1011 -- from interface files, which always print in prefix form
1013 checkConName :: RdrName -> TcRn ()
1014 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1016 badDataCon :: RdrName -> SDoc
1018 = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
1022 %*********************************************************
1024 \subsection{Support code for type/data declarations}
1026 %*********************************************************
1028 Get the mapping from constructors to fields for this module.
1029 It's convenient to do this after the data type decls have been renamed
1031 extendRecordFieldEnv :: [LTyClDecl RdrName] -> [LInstDecl RdrName] -> TcM TcGblEnv
1032 extendRecordFieldEnv tycl_decls inst_decls
1033 = do { tcg_env <- getGblEnv
1034 ; field_env' <- foldrM get_con (tcg_field_env tcg_env) all_data_cons
1035 ; return (tcg_env { tcg_field_env = field_env' }) }
1037 -- we want to lookup:
1038 -- (a) a datatype constructor
1039 -- (b) a record field
1040 -- knowing that they're from this module.
1041 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1042 -- which keeps only the local ones.
1043 lookup x = do { x' <- lookupLocatedTopBndrRn x
1044 ; return $ unLoc x'}
1046 all_data_cons :: [ConDecl RdrName]
1047 all_data_cons = [con | L _ (TyData { tcdCons = cons }) <- all_tycl_decls
1049 all_tycl_decls = at_tycl_decls ++ tycl_decls
1050 at_tycl_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
1051 -- Do not forget associated types!
1053 get_con (ConDecl { con_name = con, con_details = RecCon flds })
1054 (RecFields env fld_set)
1055 = do { con' <- lookup con
1056 ; flds' <- mapM lookup (map cd_fld_name flds)
1057 ; let env' = extendNameEnv env con' flds'
1058 fld_set' = addListToNameSet fld_set flds'
1059 ; return $ (RecFields env' fld_set') }
1060 get_con _ env = return env
1063 %*********************************************************
1065 \subsection{Support code to rename types}
1067 %*********************************************************
1070 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1073 = mapM (wrapLocM rn_fds) fds
1076 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1077 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1078 return (tys1', tys2')
1080 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1081 rnHsTyVars doc tvs = mapM (rnHsTyVar doc) tvs
1083 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1084 rnHsTyVar _doc tyvar = lookupOccRn tyvar