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 )
20 import RnBinds ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
22 import RnEnv ( lookupLocalDataTcNames, lookupLocatedOccRn,
23 lookupTopBndrRn, lookupLocatedTopBndrRn,
24 lookupOccRn, newLocalsRn,
25 bindLocatedLocalsFV, bindPatSigTyVarsFV,
26 bindTyVarsRn, extendTyVarEnvFVRn,
27 bindLocalNames, checkDupRdrNames, mapFvRn,
30 import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
31 import HscTypes ( GenAvailInfo(..), availsToNameSet )
32 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
35 import HscTypes ( Warnings(..), plusWarns )
36 import Class ( FunDep )
37 import Name ( Name, nameOccName )
44 import DynFlags ( DynFlag(..) )
45 import Maybe ( isNothing )
46 import BasicTypes ( Boxity(..) )
48 import ListSetOps (findDupsEq)
56 thenM :: Monad a => a b -> (b -> a c) -> a c
59 thenM_ :: Monad a => a b -> a c -> a c
63 @rnSourceDecl@ `renames' declarations.
64 It simultaneously performs dependency analysis and precedence parsing.
65 It also does the following error checks:
68 Checks that tyvars are used properly. This includes checking
69 for undefined tyvars, and tyvars in contexts that are ambiguous.
70 (Some of this checking has now been moved to module @TcMonoType@,
71 since we don't have functional dependency information at this point.)
73 Checks that all variable occurences are defined.
75 Checks the @(..)@ etc constraints in the export list.
80 -- Brings the binders of the group into scope in the appropriate places;
81 -- does NOT assume that anything is in scope already
82 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
83 -- Rename a HsGroup; used for normal source files *and* hs-boot files
84 rnSrcDecls group@(HsGroup {hs_valds = val_decls,
85 hs_tyclds = tycl_decls,
86 hs_instds = inst_decls,
87 hs_derivds = deriv_decls,
89 hs_warnds = warn_decls,
91 hs_fords = foreign_decls,
92 hs_defds = default_decls,
93 hs_ruleds = rule_decls,
96 -- (A) Process the fixity declarations, creating a mapping from
97 -- FastStrings to FixItems.
98 -- Also checks for duplcates.
99 local_fix_env <- makeMiniFixityEnv fix_decls;
101 -- (B) Bring top level binders (and their fixities) into scope,
102 -- *except* for the value bindings, which get brought in below.
103 -- However *do* include class ops, data constructors
104 -- And for hs-boot files *do* include the value signatures
105 tc_avails <- getLocalNonValBinders group ;
106 tc_envs <- extendGlobalRdrEnvRn tc_avails local_fix_env ;
107 setEnvs tc_envs $ do {
109 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
111 -- (C) Extract the mapping from data constructors to field names and
112 -- extend the record field env.
113 -- This depends on the data constructors and field names being in
114 -- scope from (B) above
115 inNewEnv (extendRecordFieldEnv tycl_decls inst_decls) $ \ _ -> do {
117 -- (D) Rename the left-hand sides of the value bindings.
118 -- This depends on everything from (B) being in scope,
119 -- and on (C) for resolving record wild cards.
120 -- It uses the fixity env from (A) to bind fixities for view patterns.
121 new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
122 -- bind the LHSes (and their fixities) in the global rdr environment
123 let { val_binders = map unLoc $ collectHsValBinders new_lhs ;
124 val_bndr_set = mkNameSet val_binders ;
125 all_bndr_set = val_bndr_set `unionNameSets` availsToNameSet tc_avails ;
126 val_avails = map Avail val_binders
128 (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
129 setEnvs (tcg_env, tcl_env) $ do {
131 -- Now everything is in scope, as the remaining renaming assumes.
133 -- (E) Rename type and class decls
134 -- (note that value LHSes need to be in scope for default methods)
136 -- You might think that we could build proper def/use information
137 -- for type and class declarations, but they can be involved
138 -- in mutual recursion across modules, and we only do the SCC
139 -- analysis for them in the type checker.
140 -- So we content ourselves with gathering uses only; that
141 -- means we'll only report a declaration as unused if it isn't
142 -- mentioned at all. Ah well.
143 traceRn (text "Start rnTyClDecls") ;
144 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
146 -- (F) Rename Value declarations right-hand sides
147 traceRn (text "Start rnmono") ;
148 (rn_val_decls, bind_dus) <- rnTopBindsRHS val_bndr_set new_lhs ;
149 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
151 -- (G) Rename Fixity and deprecations
153 -- Rename fixity declarations and error if we try to
154 -- fix something from another module (duplicates were checked in (A))
155 rn_fix_decls <- rnSrcFixityDecls all_bndr_set fix_decls ;
157 -- Rename deprec decls;
158 -- check for duplicates and ensure that deprecated things are defined locally
159 -- at the moment, we don't keep these around past renaming
160 rn_warns <- rnSrcWarnDecls all_bndr_set warn_decls ;
162 -- (H) Rename Everything else
164 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
165 (rn_rule_decls, src_fvs3) <- setOptM Opt_ScopedTypeVariables $
166 rnList rnHsRuleDecl rule_decls ;
167 -- Inside RULES, scoped type variables are on
168 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
169 (rn_ann_decls, src_fvs5) <- rnList rnAnnDecl ann_decls ;
170 (rn_default_decls, src_fvs6) <- rnList rnDefaultDecl default_decls ;
171 (rn_deriv_decls, src_fvs7) <- rnList rnSrcDerivDecl deriv_decls ;
172 -- Haddock docs; no free vars
173 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
175 -- (I) Compute the results and return
176 let {rn_group = HsGroup { hs_valds = rn_val_decls,
177 hs_tyclds = rn_tycl_decls,
178 hs_instds = rn_inst_decls,
179 hs_derivds = rn_deriv_decls,
180 hs_fixds = rn_fix_decls,
181 hs_warnds = [], -- warns are returned in the tcg_env
182 -- (see below) not in the HsGroup
183 hs_fords = rn_foreign_decls,
184 hs_annds = rn_ann_decls,
185 hs_defds = rn_default_decls,
186 hs_ruleds = rn_rule_decls,
187 hs_docs = rn_docs } ;
189 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
190 src_fvs5, src_fvs6, src_fvs7] ;
191 src_dus = bind_dus `plusDU` usesOnly other_fvs;
192 -- Note: src_dus will contain *uses* for locally-defined types
193 -- and classes, but no *defs* for them. (Because rnTyClDecl
194 -- returns only the uses.) This is a little
195 -- surprising but it doesn't actually matter at all.
197 final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
198 in -- we return the deprecs in the env, not in the HsGroup above
199 tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
202 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
203 traceRn (text "finish Dus" <+> ppr src_dus ) ;
204 return (final_tcg_env , rn_group)
207 -- some utils because we do this a bunch above
208 -- compute and install the new env
209 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
210 inNewEnv env cont = do e <- env
213 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
214 -- Used for external core
215 rnTyClDecls tycl_decls = do (decls', _fvs) <- rnList rnTyClDecl tycl_decls
218 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
219 -- This function could be defined lower down in the module hierarchy,
220 -- but there doesn't seem anywhere very logical to put it.
221 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
223 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
224 rnList f xs = mapFvRn (wrapLocFstM f) xs
228 %*********************************************************
232 %*********************************************************
235 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
236 rnDocDecl (DocCommentNext doc) = do
237 rn_doc <- rnHsDoc doc
238 return (DocCommentNext rn_doc)
239 rnDocDecl (DocCommentPrev doc) = do
240 rn_doc <- rnHsDoc doc
241 return (DocCommentPrev rn_doc)
242 rnDocDecl (DocCommentNamed str doc) = do
243 rn_doc <- rnHsDoc doc
244 return (DocCommentNamed str rn_doc)
245 rnDocDecl (DocGroup lev doc) = do
246 rn_doc <- rnHsDoc doc
247 return (DocGroup lev rn_doc)
251 %*********************************************************
253 Source-code fixity declarations
255 %*********************************************************
258 rnSrcFixityDecls :: NameSet -> [LFixitySig RdrName] -> RnM [LFixitySig Name]
259 -- Rename the fixity decls, so we can put
260 -- the renamed decls in the renamed syntax tree
261 -- Errors if the thing being fixed is not defined locally.
263 -- The returned FixitySigs are not actually used for anything,
264 -- except perhaps the GHCi API
265 rnSrcFixityDecls bound_names fix_decls
266 = do fix_decls <- mapM rn_decl fix_decls
267 return (concat fix_decls)
269 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
270 -- GHC extension: look up both the tycon and data con
271 -- for con-like things; hence returning a list
272 -- If neither are in scope, report an error; otherwise
273 -- return a fixity sig for each (slightly odd)
274 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
275 = setSrcSpan name_loc $
276 -- this lookup will fail if the definition isn't local
277 do names <- lookupLocalDataTcNames bound_names what rdr_name
278 return [ L loc (FixitySig (L name_loc name) fixity)
280 what = ptext (sLit "fixity signature")
284 %*********************************************************
286 Source-code deprecations declarations
288 %*********************************************************
290 Check that the deprecated names are defined, are defined locally, and
291 that there are no duplicate deprecations.
293 It's only imported deprecations, dealt with in RnIfaces, that we
294 gather them together.
297 -- checks that the deprecations are defined locally, and that there are no duplicates
298 rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
299 rnSrcWarnDecls _bound_names []
302 rnSrcWarnDecls bound_names decls
303 = do { -- check for duplicates
304 ; mapM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups
305 ; mapM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
306 return (WarnSome ((concat pairs_s))) }
308 rn_deprec (Warning rdr_name txt)
309 -- ensures that the names are defined locally
310 = lookupLocalDataTcNames bound_names what rdr_name `thenM` \ names ->
311 return [(nameOccName name, txt) | name <- names]
313 what = ptext (sLit "deprecation")
315 -- look for duplicates among the OccNames;
316 -- we check that the names are defined above
317 -- invt: the lists returned by findDupsEq always have at least two elements
318 warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
319 (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
321 dupWarnDecl :: Located RdrName -> RdrName -> SDoc
322 -- Located RdrName -> DeprecDecl RdrName -> SDoc
323 dupWarnDecl (L loc _) rdr_name
324 = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
325 ptext (sLit "also at ") <+> ppr loc]
329 %*********************************************************
331 \subsection{Annotation declarations}
333 %*********************************************************
336 rnAnnDecl :: AnnDecl RdrName -> RnM (AnnDecl Name, FreeVars)
337 rnAnnDecl (HsAnnotation provenance expr) = do
338 (provenance', provenance_fvs) <- rnAnnProvenance provenance
339 (expr', expr_fvs) <- rnLExpr expr
340 return (HsAnnotation provenance' expr', provenance_fvs `plusFV` expr_fvs)
342 rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
343 rnAnnProvenance provenance = do
344 provenance' <- modifyAnnProvenanceNameM lookupTopBndrRn provenance
345 return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
348 %*********************************************************
350 \subsection{Default declarations}
352 %*********************************************************
355 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
356 rnDefaultDecl (DefaultDecl tys)
357 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
358 return (DefaultDecl tys', fvs)
360 doc_str = text "In a `default' declaration"
363 %*********************************************************
365 \subsection{Foreign declarations}
367 %*********************************************************
370 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
371 rnHsForeignDecl (ForeignImport name ty spec)
372 = lookupLocatedTopBndrRn name `thenM` \ name' ->
373 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
374 return (ForeignImport name' ty' spec, fvs)
376 rnHsForeignDecl (ForeignExport name ty spec)
377 = lookupLocatedOccRn name `thenM` \ name' ->
378 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
379 return (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
380 -- NB: a foreign export is an *occurrence site* for name, so
381 -- we add it to the free-variable list. It might, for example,
382 -- be imported from another module
384 fo_decl_msg :: Located RdrName -> SDoc
385 fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
389 %*********************************************************
391 \subsection{Instance declarations}
393 %*********************************************************
396 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
397 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
398 -- Used for both source and interface file decls
399 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
401 -- Rename the bindings
402 -- The typechecker (not the renamer) checks that all
403 -- the bindings are for the right class
405 meth_doc = text "In the bindings in an instance declaration"
406 meth_names = collectHsBindLocatedBinders mbinds
407 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
409 checkDupRdrNames meth_doc meth_names `thenM_`
410 -- Check that the same method is not given twice in the
411 -- same instance decl instance C T where
415 -- We must use checkDupRdrNames because the Name of the
416 -- method is the Name of the class selector, whose SrcSpan
417 -- points to the class declaration
419 extendTyVarEnvForMethodBinds inst_tyvars (
420 -- (Slightly strangely) the forall-d tyvars scope over
421 -- the method bindings too
422 rnMethodBinds cls (\_ -> []) -- No scoped tyvars
424 ) `thenM` \ (mbinds', meth_fvs) ->
425 -- Rename the associated types
426 -- The typechecker (not the renamer) checks that all
427 -- the declarations are for the right class
429 at_doc = text "In the associated types of an instance declaration"
430 at_names = map (head . tyClDeclNames . unLoc) ats
432 checkDupRdrNames at_doc at_names `thenM_`
433 -- See notes with checkDupRdrNames for methods, above
435 rnATInsts ats `thenM` \ (ats', at_fvs) ->
437 -- Rename the prags and signatures.
438 -- Note that the type variables are not in scope here,
439 -- so that instance Eq a => Eq (T a) where
440 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
443 -- But the (unqualified) method names are in scope
445 binders = collectHsBindBinders mbinds'
446 bndr_set = mkNameSet binders
448 bindLocalNames binders
449 (renameSigs (Just bndr_set) okInstDclSig uprags) `thenM` \ uprags' ->
451 return (InstDecl inst_ty' mbinds' uprags' ats',
452 meth_fvs `plusFV` at_fvs
453 `plusFV` hsSigsFVs uprags'
454 `plusFV` extractHsTyNames inst_ty')
455 -- We return the renamed associated data type declarations so
456 -- that they can be entered into the list of type declarations
457 -- for the binding group, but we also keep a copy in the instance.
458 -- The latter is needed for well-formedness checks in the type
459 -- checker (eg, to ensure that all ATs of the instance actually
460 -- receive a declaration).
461 -- NB: Even the copies in the instance declaration carry copies of
462 -- the instance context after renaming. This is a bit
463 -- strange, but should not matter (and it would be more work
464 -- to remove the context).
467 Renaming of the associated types in instances.
470 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
471 rnATInsts atDecls = rnList rnATInst atDecls
473 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
474 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
476 pprPanic "RnSource.rnATInsts: invalid AT instance"
477 (ppr (tcdName tydecl))
480 For the method bindings in class and instance decls, we extend the
481 type variable environment iff -fglasgow-exts
484 extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
485 -> RnM (Bag (LHsBind Name), FreeVars)
486 -> RnM (Bag (LHsBind Name), FreeVars)
487 extendTyVarEnvForMethodBinds tyvars thing_inside
488 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
490 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
495 %*********************************************************
497 \subsection{Stand-alone deriving declarations}
499 %*********************************************************
502 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
503 rnSrcDerivDecl (DerivDecl ty)
504 = do ty' <- rnLHsType (text "a deriving decl") ty
505 let fvs = extractHsTyNames ty'
506 return (DerivDecl ty', fvs)
509 %*********************************************************
513 %*********************************************************
516 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
517 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
518 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
519 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
520 do { (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
521 -- NB: The binders in a rule are always Ids
522 -- We don't (yet) support type variables
524 ; (lhs', fv_lhs') <- rnLExpr lhs
525 ; (rhs', fv_rhs') <- rnLExpr rhs
527 ; checkValidRule rule_name ids lhs' fv_lhs'
529 ; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
530 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
532 doc = text "In the transformation rule" <+> ftext rule_name
534 get_var (RuleBndr v) = v
535 get_var (RuleBndrSig v _) = v
537 rn_var (RuleBndr (L loc _), id)
538 = return (RuleBndr (L loc id), emptyFVs)
539 rn_var (RuleBndrSig (L loc _) t, id)
540 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
541 return (RuleBndrSig (L loc id) t', fvs)
543 badRuleVar :: FastString -> Name -> SDoc
545 = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
546 ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
547 ptext (sLit "does not appear on left hand side")]
550 Note [Rule LHS validity checking]
551 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
552 Check the shape of a transformation rule LHS. Currently we only allow
553 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
554 @forall@'d variables.
556 We used restrict the form of the 'ei' to prevent you writing rules
557 with LHSs with a complicated desugaring (and hence unlikely to match);
558 (e.g. a case expression is not allowed: too elaborate.)
560 But there are legitimate non-trivial args ei, like sections and
561 lambdas. So it seems simmpler not to check at all, and that is why
562 check_e is commented out.
565 checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
566 checkValidRule rule_name ids lhs' fv_lhs'
567 = do { -- Check for the form of the LHS
568 case (validRuleLhs ids lhs') of
570 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
572 -- Check that LHS vars are all bound
573 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
574 ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
576 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
578 -- Just e => Not ok, and e is the offending expression
579 validRuleLhs foralls lhs
582 checkl (L _ e) = check e
584 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
585 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
586 check (HsVar v) | v `notElem` foralls = Nothing
587 check other = Just other -- Failure
590 checkl_e (L _ _e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
592 {- Commented out; see Note [Rule LHS validity checking] above
593 check_e (HsVar v) = Nothing
594 check_e (HsPar e) = checkl_e e
595 check_e (HsLit e) = Nothing
596 check_e (HsOverLit e) = Nothing
598 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
599 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
600 check_e (NegApp e _) = checkl_e e
601 check_e (ExplicitList _ es) = checkl_es es
602 check_e (ExplicitTuple es _) = checkl_es es
603 check_e other = Just other -- Fails
605 checkl_es es = foldr (mplus . checkl_e) Nothing es
608 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
609 badRuleLhsErr name lhs bad_e
610 = sep [ptext (sLit "Rule") <+> ftext name <> colon,
611 nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
612 ptext (sLit "in left-hand side:") <+> ppr lhs])]
614 ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
618 %*********************************************************
620 \subsection{Type, class and iface sig declarations}
622 %*********************************************************
624 @rnTyDecl@ uses the `global name function' to create a new type
625 declaration in which local names have been replaced by their original
626 names, reporting any unknown names.
628 Renaming type variables is a pain. Because they now contain uniques,
629 it is necessary to pass in an association list which maps a parsed
630 tyvar to its @Name@ representation.
631 In some cases (type signatures of values),
632 it is even necessary to go over the type first
633 in order to get the set of tyvars used by it, make an assoc list,
634 and then go over it again to rename the tyvars!
635 However, we can also do some scoping checks at the same time.
638 rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
639 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
640 = lookupLocatedTopBndrRn name `thenM` \ name' ->
641 return (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
644 -- all flavours of type family declarations ("type family", "newtype fanily",
645 -- and "data family")
646 rnTyClDecl (tydecl@TyFamily {}) =
647 rnFamily tydecl bindTyVarsRn
649 -- "data", "newtype", "data instance, and "newtype instance" declarations
650 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
651 tcdLName = tycon, tcdTyVars = tyvars,
652 tcdTyPats = typatsMaybe, tcdCons = condecls,
653 tcdKindSig = sig, tcdDerivs = derivs})
654 | is_vanilla -- Normal Haskell data type decl
655 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
656 -- data type is syntactically illegal
657 do { tyvars <- pruneTyVars tydecl
658 ; bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
659 { tycon' <- if isFamInstDecl tydecl
660 then lookupLocatedOccRn tycon -- may be imported family
661 else lookupLocatedTopBndrRn tycon
662 ; context' <- rnContext data_doc context
663 ; typats' <- rnTyPats data_doc typatsMaybe
664 ; condecls' <- rnConDecls (unLoc tycon') condecls
665 -- No need to check for duplicate constructor decls
666 -- since that is done by RnNames.extendGlobalRdrEnvRn
667 ; (derivs', deriv_fvs) <- rn_derivs derivs
668 ; return (TyData {tcdND = new_or_data, tcdCtxt = context',
669 tcdLName = tycon', tcdTyVars = tyvars',
670 tcdTyPats = typats', tcdKindSig = Nothing,
671 tcdCons = condecls', tcdDerivs = derivs'},
672 delFVs (map hsLTyVarName tyvars') $
673 extractHsCtxtTyNames context' `plusFV`
674 plusFVs (map conDeclFVs condecls') `plusFV`
676 (if isFamInstDecl tydecl
677 then unitFV (unLoc tycon') -- type instance => use
682 = do { tycon' <- if isFamInstDecl tydecl
683 then lookupLocatedOccRn tycon -- may be imported family
684 else lookupLocatedTopBndrRn tycon
685 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
687 <- bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
688 { typats' <- rnTyPats data_doc typatsMaybe
689 ; return (tyvars', typats') }
690 -- For GADTs, the type variables in the declaration
691 -- do not scope over the constructor signatures
692 -- data T a where { T1 :: forall b. b-> b }
694 ; condecls' <- rnConDecls (unLoc tycon') condecls
695 -- No need to check for duplicate constructor decls
696 -- since that is done by RnNames.extendGlobalRdrEnvRn
698 ; (derivs', deriv_fvs) <- rn_derivs derivs
699 ; return (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
700 tcdLName = tycon', tcdTyVars = tyvars',
701 tcdTyPats = typats', tcdKindSig = sig,
702 tcdCons = condecls', tcdDerivs = derivs'},
703 plusFVs (map conDeclFVs condecls') `plusFV`
705 (if isFamInstDecl tydecl
706 then unitFV (unLoc tycon') -- type instance => use
710 is_vanilla = case condecls of -- Yuk
712 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
715 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
717 rn_derivs Nothing = return (Nothing, emptyFVs)
718 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
719 return (Just ds', extractHsTyNames_s ds')
721 -- "type" and "type instance" declarations
722 rnTyClDecl tydecl@(TySynonym {tcdLName = name,
723 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
724 = do { tyvars <- pruneTyVars tydecl
725 ; bindTyVarsRn syn_doc tyvars $ \ tyvars' -> do
726 { name' <- if isFamInstDecl tydecl
727 then lookupLocatedOccRn name -- may be imported family
728 else lookupLocatedTopBndrRn name
729 ; typats' <- rnTyPats syn_doc typatsMaybe
730 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
731 ; return (TySynonym {tcdLName = name', tcdTyVars = tyvars',
732 tcdTyPats = typats', tcdSynRhs = ty'},
733 delFVs (map hsLTyVarName tyvars') $
735 (if isFamInstDecl tydecl
736 then unitFV (unLoc name') -- type instance => use
740 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
742 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
743 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
744 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
745 = do { cname' <- lookupLocatedTopBndrRn cname
747 -- Tyvars scope over superclass context and method signatures
748 ; (tyvars', context', fds', ats', ats_fvs, sigs')
749 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
750 { context' <- rnContext cls_doc context
751 ; fds' <- rnFds cls_doc fds
752 ; (ats', ats_fvs) <- rnATs ats
753 ; sigs' <- renameSigs Nothing okClsDclSig sigs
754 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
756 -- No need to check for duplicate associated type decls
757 -- since that is done by RnNames.extendGlobalRdrEnvRn
759 -- Check the signatures
760 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
761 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
762 ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
763 -- Typechecker is responsible for checking that we only
764 -- give default-method bindings for things in this class.
765 -- The renamer *could* check this for class decls, but can't
766 -- for instance decls.
768 -- The newLocals call is tiresome: given a generic class decl
771 -- op {| x+y |} (Inl a) = ...
772 -- op {| x+y |} (Inr b) = ...
773 -- op {| a*b |} (a*b) = ...
774 -- we want to name both "x" tyvars with the same unique, so that they are
775 -- easy to group together in the typechecker.
776 ; (mbinds', meth_fvs)
777 <- extendTyVarEnvForMethodBinds tyvars' $ do
778 { name_env <- getLocalRdrEnv
779 ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
780 not (unLoc tv `elemLocalRdrEnv` name_env) ]
781 -- No need to check for duplicate method signatures
782 -- since that is done by RnNames.extendGlobalRdrEnvRn
783 -- and the methods are already in scope
784 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
785 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
788 ; docs' <- mapM (wrapLocM rnDocDecl) docs
790 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
791 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
792 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
794 delFVs (map hsLTyVarName tyvars') $
795 extractHsCtxtTyNames context' `plusFV`
796 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
797 hsSigsFVs sigs' `plusFV`
801 cls_doc = text "In the declaration for class" <+> ppr cname
802 sig_doc = text "In the signatures for class" <+> ppr cname
804 badGadtStupidTheta :: Located RdrName -> SDoc
806 = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
807 ptext (sLit "(You can put a context on each contructor, though.)")]
811 %*********************************************************
813 \subsection{Support code for type/data declarations}
815 %*********************************************************
818 -- Remove any duplicate type variables in family instances may have non-linear
819 -- left-hand sides. Complain if any, but the first occurence of a type
820 -- variable has a user-supplied kind signature.
822 pruneTyVars :: TyClDecl RdrName -> RnM [LHsTyVarBndr RdrName]
824 | isFamInstDecl tydecl
825 = do { let pruned_tyvars = nubBy eqLTyVar tyvars
826 ; assertNoSigsInRepeats tyvars
827 ; return pruned_tyvars
832 tyvars = tcdTyVars tydecl
834 assertNoSigsInRepeats [] = return ()
835 assertNoSigsInRepeats (tv:tvs)
836 = do { let offending_tvs = [ tv' | tv'@(L _ (KindedTyVar _ _)) <- tvs
838 ; checkErr (null offending_tvs) $
839 illegalKindSig (head offending_tvs)
840 ; assertNoSigsInRepeats tvs
844 = hsep [ptext (sLit "Repeat variable occurrence may not have a"),
845 ptext (sLit "kind signature:"), quotes (ppr tv)]
847 tv1 `eqLTyVar` tv2 = hsLTyVarLocName tv1 `eqLocated` hsLTyVarLocName tv2
849 -- Although, we are processing type patterns here, all type variables will
850 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
851 -- type declaration to which these patterns belong)
853 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
854 rnTyPats _ Nothing = return Nothing
855 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
857 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
858 rnConDecls _tycon condecls
859 = mapM (wrapLocM rnConDecl) condecls
861 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
862 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
863 = do { addLocM checkConName name
865 ; new_name <- lookupLocatedTopBndrRn name
866 ; name_env <- getLocalRdrEnv
868 -- For H98 syntax, the tvs are the existential ones
869 -- For GADT syntax, the tvs are all the quantified tyvars
870 -- Hence the 'filter' in the ResTyH98 case only
871 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
872 arg_tys = hsConDeclArgTys details
873 implicit_tvs = case res_ty of
874 ResTyH98 -> filter not_in_scope $
876 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
879 Implicit -> userHsTyVarBndrs implicit_tvs
881 ; mb_doc' <- rnMbLHsDoc mb_doc
883 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
884 { new_context <- rnContext doc cxt
885 ; new_details <- rnConDeclDetails doc details
886 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
887 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
889 doc = text "In the definition of data constructor" <+> quotes (ppr name)
890 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
893 -> HsConDetails (LHsType Name) [ConDeclField Name]
895 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
897 rnConResult _ details ResTyH98 = return (details, ResTyH98)
899 rnConResult doc details (ResTyGADT ty) = do
900 ty' <- rnHsSigType doc ty
901 let (arg_tys, res_ty) = splitHsFunType ty'
902 -- We can split it up, now the renamer has dealt with fixities
904 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
905 RecCon _ -> return (details, ResTyGADT ty')
906 InfixCon {} -> panic "rnConResult"
908 rnConDeclDetails :: SDoc
909 -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
910 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
911 rnConDeclDetails doc (PrefixCon tys)
912 = mapM (rnLHsType doc) tys `thenM` \ new_tys ->
913 return (PrefixCon new_tys)
915 rnConDeclDetails doc (InfixCon ty1 ty2)
916 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
917 rnLHsType doc ty2 `thenM` \ new_ty2 ->
918 return (InfixCon new_ty1 new_ty2)
920 rnConDeclDetails doc (RecCon fields)
921 = do { new_fields <- mapM (rnField doc) fields
922 -- No need to check for duplicate fields
923 -- since that is done by RnNames.extendGlobalRdrEnvRn
924 ; return (RecCon new_fields) }
926 rnField :: SDoc -> ConDeclField RdrName -> RnM (ConDeclField Name)
927 rnField doc (ConDeclField name ty haddock_doc)
928 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
929 rnLHsType doc ty `thenM` \ new_ty ->
930 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
931 return (ConDeclField new_name new_ty new_haddock_doc)
933 -- Rename family declarations
935 -- * This function is parametrised by the routine handling the index
936 -- variables. On the toplevel, these are defining occurences, whereas they
937 -- are usage occurences for associated types.
939 rnFamily :: TyClDecl RdrName
940 -> (SDoc -> [LHsTyVarBndr RdrName] ->
941 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
942 RnM (TyClDecl Name, FreeVars))
943 -> RnM (TyClDecl Name, FreeVars)
945 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
946 tcdLName = tycon, tcdTyVars = tyvars})
948 do { checkM (isDataFlavour flavour -- for synonyms,
949 || not (null tyvars)) $ addErr needOneIdx -- no. of indexes >= 1
950 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
951 ; tycon' <- lookupLocatedTopBndrRn tycon
952 ; return (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
953 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
957 isDataFlavour DataFamily = True
958 isDataFlavour _ = False
959 rnFamily d _ = pprPanic "rnFamily" (ppr d)
961 family_doc :: Located RdrName -> SDoc
962 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
965 needOneIdx = text "Type family declarations requires at least one type index"
967 -- Rename associated type declarations (in classes)
969 -- * This can be family declarations and (default) type instances
971 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
972 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
974 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
975 rn_at (tydecl@TySynonym {}) =
977 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
979 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
981 lookupIdxVars _ tyvars cont =
982 do { checkForDups tyvars;
983 ; tyvars' <- mapM lookupIdxVar tyvars
986 -- Type index variables must be class parameters, which are the only
987 -- type variables in scope at this point.
988 lookupIdxVar (L l tyvar) =
990 name' <- lookupOccRn (hsTyVarName tyvar)
991 return $ L l (replaceTyVarName tyvar name')
993 -- Type variable may only occur once.
995 checkForDups [] = return ()
996 checkForDups (L loc tv:ltvs) =
997 do { setSrcSpan loc $
998 when (hsTyVarName tv `ltvElem` ltvs) $
999 addErr (repeatedTyVar tv)
1003 _ `ltvElem` [] = False
1004 rdrName `ltvElem` (L _ tv:ltvs)
1005 | rdrName == hsTyVarName tv = True
1006 | otherwise = rdrName `ltvElem` ltvs
1009 noPatterns = text "Default definition for an associated synonym cannot have"
1010 <+> text "type pattern"
1012 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
1013 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
1016 -- This data decl will parse OK
1018 -- treating "a" as the constructor.
1019 -- It is really hard to make the parser spot this malformation.
1020 -- So the renamer has to check that the constructor is legal
1022 -- We can get an operator as the constructor, even in the prefix form:
1023 -- data T = :% Int Int
1024 -- from interface files, which always print in prefix form
1026 checkConName :: RdrName -> TcRn ()
1027 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1029 badDataCon :: RdrName -> SDoc
1031 = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
1035 %*********************************************************
1037 \subsection{Support code for type/data declarations}
1039 %*********************************************************
1041 Get the mapping from constructors to fields for this module.
1042 It's convenient to do this after the data type decls have been renamed
1044 extendRecordFieldEnv :: [LTyClDecl RdrName] -> [LInstDecl RdrName] -> TcM TcGblEnv
1045 extendRecordFieldEnv tycl_decls inst_decls
1046 = do { tcg_env <- getGblEnv
1047 ; field_env' <- foldrM get_con (tcg_field_env tcg_env) all_data_cons
1048 ; return (tcg_env { tcg_field_env = field_env' }) }
1050 -- we want to lookup:
1051 -- (a) a datatype constructor
1052 -- (b) a record field
1053 -- knowing that they're from this module.
1054 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1055 -- which keeps only the local ones.
1056 lookup x = do { x' <- lookupLocatedTopBndrRn x
1057 ; return $ unLoc x'}
1059 all_data_cons :: [ConDecl RdrName]
1060 all_data_cons = [con | L _ (TyData { tcdCons = cons }) <- all_tycl_decls
1062 all_tycl_decls = at_tycl_decls ++ tycl_decls
1063 at_tycl_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
1064 -- Do not forget associated types!
1066 get_con (ConDecl { con_name = con, con_details = RecCon flds })
1067 (RecFields env fld_set)
1068 = do { con' <- lookup con
1069 ; flds' <- mapM lookup (map cd_fld_name flds)
1070 ; let env' = extendNameEnv env con' flds'
1071 fld_set' = addListToNameSet fld_set flds'
1072 ; return $ (RecFields env' fld_set') }
1073 get_con _ env = return env
1076 %*********************************************************
1078 \subsection{Support code to rename types}
1080 %*********************************************************
1083 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1086 = mapM (wrapLocM rn_fds) fds
1089 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1090 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1091 return (tys1', tys2')
1093 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1094 rnHsTyVars doc tvs = mapM (rnHsTyVar doc) tvs
1096 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1097 rnHsTyVar _doc tyvar = lookupOccRn tyvar