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,
33 import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
34 import HscTypes ( GenAvailInfo(..), availsToNameSet )
35 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
38 import HscTypes ( Warnings(..), plusWarns )
39 import Class ( FunDep )
40 import Name ( Name, nameOccName )
48 import DynFlags ( DynFlag(..) )
49 import Maybe ( isNothing )
50 import BasicTypes ( Boxity(..) )
52 import ListSetOps (findDupsEq)
60 thenM :: Monad a => a b -> (b -> a c) -> a c
63 thenM_ :: Monad a => a b -> a c -> a c
67 @rnSourceDecl@ `renames' declarations.
68 It simultaneously performs dependency analysis and precedence parsing.
69 It also does the following error checks:
72 Checks that tyvars are used properly. This includes checking
73 for undefined tyvars, and tyvars in contexts that are ambiguous.
74 (Some of this checking has now been moved to module @TcMonoType@,
75 since we don't have functional dependency information at this point.)
77 Checks that all variable occurences are defined.
79 Checks the @(..)@ etc constraints in the export list.
84 -- Brings the binders of the group into scope in the appropriate places;
85 -- does NOT assume that anything is in scope already
86 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
87 -- Rename a HsGroup; used for normal source files *and* hs-boot files
88 rnSrcDecls group@(HsGroup {hs_valds = val_decls,
89 hs_tyclds = tycl_decls,
90 hs_instds = inst_decls,
91 hs_derivds = deriv_decls,
93 hs_warnds = warn_decls,
95 hs_fords = foreign_decls,
96 hs_defds = default_decls,
97 hs_ruleds = rule_decls,
100 -- (A) Process the fixity declarations, creating a mapping from
101 -- FastStrings to FixItems.
102 -- Also checks for duplcates.
103 local_fix_env <- makeMiniFixityEnv fix_decls;
105 -- (B) Bring top level binders (and their fixities) into scope,
106 -- *except* for the value bindings, which get brought in below.
107 -- However *do* include class ops, data constructors
108 -- And for hs-boot files *do* include the value signatures
109 tc_avails <- getLocalNonValBinders group ;
110 tc_envs <- extendGlobalRdrEnvRn tc_avails local_fix_env ;
111 setEnvs tc_envs $ do {
113 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
115 -- (C) Extract the mapping from data constructors to field names and
116 -- extend the record field env.
117 -- This depends on the data constructors and field names being in
118 -- scope from (B) above
119 inNewEnv (extendRecordFieldEnv tycl_decls inst_decls) $ \ _ -> do {
121 -- (D) Rename the left-hand sides of the value bindings.
122 -- This depends on everything from (B) being in scope,
123 -- and on (C) for resolving record wild cards.
124 -- It uses the fixity env from (A) to bind fixities for view patterns.
125 new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
126 -- bind the LHSes (and their fixities) in the global rdr environment
127 let { val_binders = map unLoc $ collectHsValBinders new_lhs ;
128 val_bndr_set = mkNameSet val_binders ;
129 all_bndr_set = val_bndr_set `unionNameSets` availsToNameSet tc_avails ;
130 val_avails = map Avail val_binders
132 (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
133 setEnvs (tcg_env, tcl_env) $ do {
135 -- Now everything is in scope, as the remaining renaming assumes.
137 -- (E) Rename type and class decls
138 -- (note that value LHSes need to be in scope for default methods)
140 -- You might think that we could build proper def/use information
141 -- for type and class declarations, but they can be involved
142 -- in mutual recursion across modules, and we only do the SCC
143 -- analysis for them in the type checker.
144 -- So we content ourselves with gathering uses only; that
145 -- means we'll only report a declaration as unused if it isn't
146 -- mentioned at all. Ah well.
147 traceRn (text "Start rnTyClDecls") ;
148 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
150 -- (F) Rename Value declarations right-hand sides
151 traceRn (text "Start rnmono") ;
152 (rn_val_decls, bind_dus) <- rnTopBindsRHS val_bndr_set new_lhs ;
153 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
155 -- (G) Rename Fixity and deprecations
157 -- Rename fixity declarations and error if we try to
158 -- fix something from another module (duplicates were checked in (A))
159 rn_fix_decls <- rnSrcFixityDecls all_bndr_set fix_decls ;
161 -- Rename deprec decls;
162 -- check for duplicates and ensure that deprecated things are defined locally
163 -- at the moment, we don't keep these around past renaming
164 rn_warns <- rnSrcWarnDecls all_bndr_set warn_decls ;
166 -- (H) Rename Everything else
168 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
169 (rn_rule_decls, src_fvs3) <- setOptM Opt_ScopedTypeVariables $
170 rnList rnHsRuleDecl rule_decls ;
171 -- Inside RULES, scoped type variables are on
172 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
173 (rn_ann_decls, src_fvs5) <- rnList rnAnnDecl ann_decls ;
174 (rn_default_decls, src_fvs6) <- rnList rnDefaultDecl default_decls ;
175 (rn_deriv_decls, src_fvs7) <- rnList rnSrcDerivDecl deriv_decls ;
176 -- Haddock docs; no free vars
177 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
179 -- (I) Compute the results and return
180 let {rn_group = HsGroup { hs_valds = rn_val_decls,
181 hs_tyclds = rn_tycl_decls,
182 hs_instds = rn_inst_decls,
183 hs_derivds = rn_deriv_decls,
184 hs_fixds = rn_fix_decls,
185 hs_warnds = [], -- warns are returned in the tcg_env
186 -- (see below) not in the HsGroup
187 hs_fords = rn_foreign_decls,
188 hs_annds = rn_ann_decls,
189 hs_defds = rn_default_decls,
190 hs_ruleds = rn_rule_decls,
191 hs_docs = rn_docs } ;
193 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
194 src_fvs5, src_fvs6, src_fvs7] ;
195 src_dus = bind_dus `plusDU` usesOnly other_fvs;
196 -- Note: src_dus will contain *uses* for locally-defined types
197 -- and classes, but no *defs* for them. (Because rnTyClDecl
198 -- returns only the uses.) This is a little
199 -- surprising but it doesn't actually matter at all.
201 final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
202 in -- we return the deprecs in the env, not in the HsGroup above
203 tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
206 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
207 traceRn (text "finish Dus" <+> ppr src_dus ) ;
208 return (final_tcg_env , rn_group)
211 -- some utils because we do this a bunch above
212 -- compute and install the new env
213 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
214 inNewEnv env cont = do e <- env
217 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
218 -- Used for external core
219 rnTyClDecls tycl_decls = do (decls', _fvs) <- rnList rnTyClDecl tycl_decls
222 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
223 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
225 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
226 rnList f xs = mapFvRn (wrapLocFstM f) xs
230 %*********************************************************
234 %*********************************************************
237 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
238 rnDocDecl (DocCommentNext doc) = do
239 rn_doc <- rnHsDoc doc
240 return (DocCommentNext rn_doc)
241 rnDocDecl (DocCommentPrev doc) = do
242 rn_doc <- rnHsDoc doc
243 return (DocCommentPrev rn_doc)
244 rnDocDecl (DocCommentNamed str doc) = do
245 rn_doc <- rnHsDoc doc
246 return (DocCommentNamed str rn_doc)
247 rnDocDecl (DocGroup lev doc) = do
248 rn_doc <- rnHsDoc doc
249 return (DocGroup lev rn_doc)
253 %*********************************************************
255 Source-code fixity declarations
257 %*********************************************************
260 rnSrcFixityDecls :: NameSet -> [LFixitySig RdrName] -> RnM [LFixitySig Name]
261 -- Rename the fixity decls, so we can put
262 -- the renamed decls in the renamed syntax tree
263 -- Errors if the thing being fixed is not defined locally.
265 -- The returned FixitySigs are not actually used for anything,
266 -- except perhaps the GHCi API
267 rnSrcFixityDecls bound_names fix_decls
268 = do fix_decls <- mapM rn_decl fix_decls
269 return (concat fix_decls)
271 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
272 -- GHC extension: look up both the tycon and data con
273 -- for con-like things; hence returning a list
274 -- If neither are in scope, report an error; otherwise
275 -- return a fixity sig for each (slightly odd)
276 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
277 = setSrcSpan name_loc $
278 -- this lookup will fail if the definition isn't local
279 do names <- lookupLocalDataTcNames bound_names what rdr_name
280 return [ L loc (FixitySig (L name_loc name) fixity)
282 what = ptext (sLit "fixity signature")
286 %*********************************************************
288 Source-code deprecations declarations
290 %*********************************************************
292 Check that the deprecated names are defined, are defined locally, and
293 that there are no duplicate deprecations.
295 It's only imported deprecations, dealt with in RnIfaces, that we
296 gather them together.
299 -- checks that the deprecations are defined locally, and that there are no duplicates
300 rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
301 rnSrcWarnDecls _bound_names []
304 rnSrcWarnDecls bound_names decls
305 = do { -- check for duplicates
306 ; mapM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups
307 ; mapM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
308 return (WarnSome ((concat pairs_s))) }
310 rn_deprec (Warning rdr_name txt)
311 -- ensures that the names are defined locally
312 = lookupLocalDataTcNames bound_names what rdr_name `thenM` \ names ->
313 return [(nameOccName name, txt) | name <- names]
315 what = ptext (sLit "deprecation")
317 -- look for duplicates among the OccNames;
318 -- we check that the names are defined above
319 -- invt: the lists returned by findDupsEq always have at least two elements
320 warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
321 (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
323 dupWarnDecl :: Located RdrName -> RdrName -> SDoc
324 -- Located RdrName -> DeprecDecl RdrName -> SDoc
325 dupWarnDecl (L loc _) rdr_name
326 = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
327 ptext (sLit "also at ") <+> ppr loc]
331 %*********************************************************
333 \subsection{Annotation declarations}
335 %*********************************************************
338 rnAnnDecl :: AnnDecl RdrName -> RnM (AnnDecl Name, FreeVars)
339 rnAnnDecl (HsAnnotation provenance expr) = do
340 (provenance', provenance_fvs) <- rnAnnProvenance provenance
341 (expr', expr_fvs) <- rnLExpr expr
342 return (HsAnnotation provenance' expr', provenance_fvs `plusFV` expr_fvs)
344 rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
345 rnAnnProvenance provenance = do
346 provenance' <- modifyAnnProvenanceNameM lookupTopBndrRn provenance
347 return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
350 %*********************************************************
352 \subsection{Default declarations}
354 %*********************************************************
357 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
358 rnDefaultDecl (DefaultDecl tys)
359 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
360 return (DefaultDecl tys', fvs)
362 doc_str = text "In a `default' declaration"
365 %*********************************************************
367 \subsection{Foreign declarations}
369 %*********************************************************
372 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
373 rnHsForeignDecl (ForeignImport name ty spec)
374 = lookupLocatedTopBndrRn name `thenM` \ name' ->
375 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
376 return (ForeignImport name' ty' spec, fvs)
378 rnHsForeignDecl (ForeignExport name ty spec)
379 = lookupLocatedOccRn name `thenM` \ name' ->
380 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
381 return (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
382 -- NB: a foreign export is an *occurrence site* for name, so
383 -- we add it to the free-variable list. It might, for example,
384 -- be imported from another module
386 fo_decl_msg :: Located RdrName -> SDoc
387 fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
391 %*********************************************************
393 \subsection{Instance declarations}
395 %*********************************************************
398 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
399 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
400 -- Used for both source and interface file decls
401 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
403 -- Rename the bindings
404 -- The typechecker (not the renamer) checks that all
405 -- the bindings are for the right class
407 meth_doc = text "In the bindings in an instance declaration"
408 meth_names = collectHsBindLocatedBinders mbinds
409 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
411 checkDupRdrNames meth_doc meth_names `thenM_`
412 -- Check that the same method is not given twice in the
413 -- same instance decl instance C T where
417 -- We must use checkDupRdrNames because the Name of the
418 -- method is the Name of the class selector, whose SrcSpan
419 -- points to the class declaration
421 extendTyVarEnvForMethodBinds inst_tyvars (
422 -- (Slightly strangely) the forall-d tyvars scope over
423 -- the method bindings too
424 rnMethodBinds cls (\_ -> []) -- No scoped tyvars
426 ) `thenM` \ (mbinds', meth_fvs) ->
427 -- Rename the associated types
428 -- The typechecker (not the renamer) checks that all
429 -- the declarations are for the right class
431 at_doc = text "In the associated types of an instance declaration"
432 at_names = map (head . tyClDeclNames . unLoc) ats
434 checkDupRdrNames at_doc at_names `thenM_`
435 -- See notes with checkDupRdrNames for methods, above
437 rnATInsts ats `thenM` \ (ats', at_fvs) ->
439 -- Rename the prags and signatures.
440 -- Note that the type variables are not in scope here,
441 -- so that instance Eq a => Eq (T a) where
442 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
445 -- But the (unqualified) method names are in scope
447 binders = collectHsBindBinders mbinds'
448 bndr_set = mkNameSet binders
450 bindLocalNames binders
451 (renameSigs (Just bndr_set) okInstDclSig uprags) `thenM` \ uprags' ->
453 return (InstDecl inst_ty' mbinds' uprags' ats',
454 meth_fvs `plusFV` at_fvs
455 `plusFV` hsSigsFVs uprags'
456 `plusFV` extractHsTyNames inst_ty')
457 -- We return the renamed associated data type declarations so
458 -- that they can be entered into the list of type declarations
459 -- for the binding group, but we also keep a copy in the instance.
460 -- The latter is needed for well-formedness checks in the type
461 -- checker (eg, to ensure that all ATs of the instance actually
462 -- receive a declaration).
463 -- NB: Even the copies in the instance declaration carry copies of
464 -- the instance context after renaming. This is a bit
465 -- strange, but should not matter (and it would be more work
466 -- to remove the context).
469 Renaming of the associated types in instances.
472 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
473 rnATInsts atDecls = rnList rnATInst atDecls
475 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
476 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
478 pprPanic "RnSource.rnATInsts: invalid AT instance"
479 (ppr (tcdName tydecl))
482 For the method bindings in class and instance decls, we extend the
483 type variable environment iff -fglasgow-exts
486 extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
487 -> RnM (Bag (LHsBind Name), FreeVars)
488 -> RnM (Bag (LHsBind Name), FreeVars)
489 extendTyVarEnvForMethodBinds tyvars thing_inside
490 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
492 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
497 %*********************************************************
499 \subsection{Stand-alone deriving declarations}
501 %*********************************************************
504 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
505 rnSrcDerivDecl (DerivDecl ty)
506 = do ty' <- rnLHsType (text "a deriving decl") ty
507 let fvs = extractHsTyNames ty'
508 return (DerivDecl ty', fvs)
511 %*********************************************************
515 %*********************************************************
518 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
519 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
520 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
521 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
522 do { (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
523 -- NB: The binders in a rule are always Ids
524 -- We don't (yet) support type variables
526 ; (lhs', fv_lhs') <- rnLExpr lhs
527 ; (rhs', fv_rhs') <- rnLExpr rhs
529 ; checkValidRule rule_name ids lhs' fv_lhs'
531 ; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
532 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
534 doc = text "In the transformation rule" <+> ftext rule_name
536 get_var (RuleBndr v) = v
537 get_var (RuleBndrSig v _) = v
539 rn_var (RuleBndr (L loc _), id)
540 = return (RuleBndr (L loc id), emptyFVs)
541 rn_var (RuleBndrSig (L loc _) t, id)
542 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
543 return (RuleBndrSig (L loc id) t', fvs)
545 badRuleVar :: FastString -> Name -> SDoc
547 = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
548 ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
549 ptext (sLit "does not appear on left hand side")]
552 Note [Rule LHS validity checking]
553 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
554 Check the shape of a transformation rule LHS. Currently we only allow
555 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
556 @forall@'d variables.
558 We used restrict the form of the 'ei' to prevent you writing rules
559 with LHSs with a complicated desugaring (and hence unlikely to match);
560 (e.g. a case expression is not allowed: too elaborate.)
562 But there are legitimate non-trivial args ei, like sections and
563 lambdas. So it seems simmpler not to check at all, and that is why
564 check_e is commented out.
567 checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
568 checkValidRule rule_name ids lhs' fv_lhs'
569 = do { -- Check for the form of the LHS
570 case (validRuleLhs ids lhs') of
572 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
574 -- Check that LHS vars are all bound
575 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
576 ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
578 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
580 -- Just e => Not ok, and e is the offending expression
581 validRuleLhs foralls lhs
584 checkl (L _ e) = check e
586 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
587 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
588 check (HsVar v) | v `notElem` foralls = Nothing
589 check other = Just other -- Failure
592 checkl_e (L _ _e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
594 {- Commented out; see Note [Rule LHS validity checking] above
595 check_e (HsVar v) = Nothing
596 check_e (HsPar e) = checkl_e e
597 check_e (HsLit e) = Nothing
598 check_e (HsOverLit e) = Nothing
600 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
601 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
602 check_e (NegApp e _) = checkl_e e
603 check_e (ExplicitList _ es) = checkl_es es
604 check_e (ExplicitTuple es _) = checkl_es es
605 check_e other = Just other -- Fails
607 checkl_es es = foldr (mplus . checkl_e) Nothing es
610 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
611 badRuleLhsErr name lhs bad_e
612 = sep [ptext (sLit "Rule") <+> ftext name <> colon,
613 nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
614 ptext (sLit "in left-hand side:") <+> ppr lhs])]
616 ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
620 %*********************************************************
622 \subsection{Type, class and iface sig declarations}
624 %*********************************************************
626 @rnTyDecl@ uses the `global name function' to create a new type
627 declaration in which local names have been replaced by their original
628 names, reporting any unknown names.
630 Renaming type variables is a pain. Because they now contain uniques,
631 it is necessary to pass in an association list which maps a parsed
632 tyvar to its @Name@ representation.
633 In some cases (type signatures of values),
634 it is even necessary to go over the type first
635 in order to get the set of tyvars used by it, make an assoc list,
636 and then go over it again to rename the tyvars!
637 However, we can also do some scoping checks at the same time.
640 rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
641 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
642 = lookupLocatedTopBndrRn name `thenM` \ name' ->
643 return (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
646 -- all flavours of type family declarations ("type family", "newtype fanily",
647 -- and "data family")
648 rnTyClDecl (tydecl@TyFamily {}) =
649 rnFamily tydecl bindTyVarsRn
651 -- "data", "newtype", "data instance, and "newtype instance" declarations
652 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
653 tcdLName = tycon, tcdTyVars = tyvars,
654 tcdTyPats = typatsMaybe, tcdCons = condecls,
655 tcdKindSig = sig, tcdDerivs = derivs})
656 | is_vanilla -- Normal Haskell data type decl
657 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
658 -- data type is syntactically illegal
659 do { tyvars <- pruneTyVars tydecl
660 ; bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
661 { tycon' <- if isFamInstDecl tydecl
662 then lookupLocatedOccRn tycon -- may be imported family
663 else lookupLocatedTopBndrRn tycon
664 ; context' <- rnContext data_doc context
665 ; typats' <- rnTyPats data_doc typatsMaybe
666 ; (derivs', deriv_fvs) <- rn_derivs derivs
667 ; condecls' <- rnConDecls (unLoc tycon') condecls
668 -- No need to check for duplicate constructor decls
669 -- since that is done by RnNames.extendGlobalRdrEnvRn
670 ; return (TyData {tcdND = new_or_data, tcdCtxt = context',
671 tcdLName = tycon', tcdTyVars = tyvars',
672 tcdTyPats = typats', tcdKindSig = Nothing,
673 tcdCons = condecls', tcdDerivs = derivs'},
674 delFVs (map hsLTyVarName tyvars') $
675 extractHsCtxtTyNames context' `plusFV`
676 plusFVs (map conDeclFVs condecls') `plusFV`
678 (if isFamInstDecl tydecl
679 then unitFV (unLoc tycon') -- type instance => use
684 = do { tycon' <- if isFamInstDecl tydecl
685 then lookupLocatedOccRn tycon -- may be imported family
686 else lookupLocatedTopBndrRn tycon
687 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
689 <- bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
690 { typats' <- rnTyPats data_doc typatsMaybe
691 ; return (tyvars', typats') }
692 -- For GADTs, the type variables in the declaration
693 -- do not scope over the constructor signatures
694 -- data T a where { T1 :: forall b. b-> b }
696 ; (derivs', deriv_fvs) <- rn_derivs derivs
697 ; condecls' <- rnConDecls (unLoc tycon') condecls
698 -- No need to check for duplicate constructor decls
699 -- since that is done by RnNames.extendGlobalRdrEnvRn
701 ; return (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
702 tcdLName = tycon', tcdTyVars = tyvars',
703 tcdTyPats = typats', tcdKindSig = sig,
704 tcdCons = condecls', tcdDerivs = derivs'},
705 plusFVs (map conDeclFVs condecls') `plusFV`
707 (if isFamInstDecl tydecl
708 then unitFV (unLoc tycon') -- type instance => use
712 is_vanilla = case condecls of -- Yuk
714 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
717 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
719 rn_derivs Nothing = return (Nothing, emptyFVs)
720 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
721 return (Just ds', extractHsTyNames_s ds')
723 -- "type" and "type instance" declarations
724 rnTyClDecl tydecl@(TySynonym {tcdLName = name,
725 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
726 = do { tyvars <- pruneTyVars tydecl
727 ; bindTyVarsRn syn_doc tyvars $ \ tyvars' -> do
728 { name' <- if isFamInstDecl tydecl
729 then lookupLocatedOccRn name -- may be imported family
730 else lookupLocatedTopBndrRn name
731 ; typats' <- rnTyPats syn_doc typatsMaybe
732 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
733 ; return (TySynonym {tcdLName = name', tcdTyVars = tyvars',
734 tcdTyPats = typats', tcdSynRhs = ty'},
735 delFVs (map hsLTyVarName tyvars') $
737 (if isFamInstDecl tydecl
738 then unitFV (unLoc name') -- type instance => use
742 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
744 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
745 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
746 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
747 = do { cname' <- lookupLocatedTopBndrRn cname
749 -- Tyvars scope over superclass context and method signatures
750 ; (tyvars', context', fds', ats', ats_fvs, sigs')
751 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
752 { context' <- rnContext cls_doc context
753 ; fds' <- rnFds cls_doc fds
754 ; (ats', ats_fvs) <- rnATs ats
755 ; sigs' <- renameSigs Nothing okClsDclSig sigs
756 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
758 -- No need to check for duplicate associated type decls
759 -- since that is done by RnNames.extendGlobalRdrEnvRn
761 -- Check the signatures
762 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
763 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
764 ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
765 -- Typechecker is responsible for checking that we only
766 -- give default-method bindings for things in this class.
767 -- The renamer *could* check this for class decls, but can't
768 -- for instance decls.
770 -- The newLocals call is tiresome: given a generic class decl
773 -- op {| x+y |} (Inl a) = ...
774 -- op {| x+y |} (Inr b) = ...
775 -- op {| a*b |} (a*b) = ...
776 -- we want to name both "x" tyvars with the same unique, so that they are
777 -- easy to group together in the typechecker.
778 ; (mbinds', meth_fvs)
779 <- extendTyVarEnvForMethodBinds tyvars' $ do
780 { name_env <- getLocalRdrEnv
781 ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
782 not (unLoc tv `elemLocalRdrEnv` name_env) ]
783 -- No need to check for duplicate method signatures
784 -- since that is done by RnNames.extendGlobalRdrEnvRn
785 -- and the methods are already in scope
786 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
787 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
790 ; docs' <- mapM (wrapLocM rnDocDecl) docs
792 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
793 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
794 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
796 delFVs (map hsLTyVarName tyvars') $
797 extractHsCtxtTyNames context' `plusFV`
798 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
799 hsSigsFVs sigs' `plusFV`
803 cls_doc = text "In the declaration for class" <+> ppr cname
804 sig_doc = text "In the signatures for class" <+> ppr cname
806 badGadtStupidTheta :: Located RdrName -> SDoc
808 = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
809 ptext (sLit "(You can put a context on each contructor, though.)")]
812 %*********************************************************
814 \subsection{Support code for type/data declarations}
816 %*********************************************************
819 -- Remove any duplicate type variables in family instances may have non-linear
820 -- left-hand sides. Complain if any, but the first occurence of a type
821 -- variable has a user-supplied kind signature.
823 pruneTyVars :: TyClDecl RdrName -> RnM [LHsTyVarBndr RdrName]
825 | isFamInstDecl tydecl
826 = do { let pruned_tyvars = nubBy eqLTyVar tyvars
827 ; assertNoSigsInRepeats tyvars
828 ; return pruned_tyvars
833 tyvars = tcdTyVars tydecl
835 assertNoSigsInRepeats [] = return ()
836 assertNoSigsInRepeats (tv:tvs)
837 = do { let offending_tvs = [ tv' | tv'@(L _ (KindedTyVar _ _)) <- tvs
839 ; checkErr (null offending_tvs) $
840 illegalKindSig (head offending_tvs)
841 ; assertNoSigsInRepeats tvs
845 = hsep [ptext (sLit "Repeat variable occurrence may not have a"),
846 ptext (sLit "kind signature:"), quotes (ppr tv)]
848 tv1 `eqLTyVar` tv2 = hsLTyVarLocName tv1 `eqLocated` hsLTyVarLocName tv2
850 -- Although, we are processing type patterns here, all type variables will
851 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
852 -- type declaration to which these patterns belong)
854 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
855 rnTyPats _ Nothing = return Nothing
856 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
858 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
859 rnConDecls _tycon condecls
860 = mapM (wrapLocM rnConDecl) condecls
862 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
863 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
864 = do { addLocM checkConName name
866 ; new_name <- lookupLocatedTopBndrRn name
867 ; name_env <- getLocalRdrEnv
869 -- For H98 syntax, the tvs are the existential ones
870 -- For GADT syntax, the tvs are all the quantified tyvars
871 -- Hence the 'filter' in the ResTyH98 case only
872 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
873 arg_tys = hsConDeclArgTys details
874 implicit_tvs = case res_ty of
875 ResTyH98 -> filter not_in_scope $
877 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
880 Implicit -> userHsTyVarBndrs implicit_tvs
882 ; mb_doc' <- rnMbLHsDoc mb_doc
884 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
885 { new_context <- rnContext doc cxt
886 ; new_details <- rnConDeclDetails doc details
887 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
888 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
890 doc = text "In the definition of data constructor" <+> quotes (ppr name)
891 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
894 -> HsConDetails (LHsType Name) [ConDeclField Name]
896 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
898 rnConResult _ details ResTyH98 = return (details, ResTyH98)
900 rnConResult doc details (ResTyGADT ty) = do
901 ty' <- rnHsSigType doc ty
902 let (arg_tys, res_ty) = splitHsFunType ty'
903 -- We can split it up, now the renamer has dealt with fixities
905 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
906 RecCon _ -> return (details, ResTyGADT ty')
907 InfixCon {} -> panic "rnConResult"
909 rnConDeclDetails :: SDoc
910 -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
911 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
912 rnConDeclDetails doc (PrefixCon tys)
913 = mapM (rnLHsType doc) tys `thenM` \ new_tys ->
914 return (PrefixCon new_tys)
916 rnConDeclDetails doc (InfixCon ty1 ty2)
917 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
918 rnLHsType doc ty2 `thenM` \ new_ty2 ->
919 return (InfixCon new_ty1 new_ty2)
921 rnConDeclDetails doc (RecCon fields)
922 = do { new_fields <- mapM (rnField doc) fields
923 -- No need to check for duplicate fields
924 -- since that is done by RnNames.extendGlobalRdrEnvRn
925 ; return (RecCon new_fields) }
927 rnField :: SDoc -> ConDeclField RdrName -> RnM (ConDeclField Name)
928 rnField doc (ConDeclField name ty haddock_doc)
929 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
930 rnLHsType doc ty `thenM` \ new_ty ->
931 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
932 return (ConDeclField new_name new_ty new_haddock_doc)
934 -- Rename family declarations
936 -- * This function is parametrised by the routine handling the index
937 -- variables. On the toplevel, these are defining occurences, whereas they
938 -- are usage occurences for associated types.
940 rnFamily :: TyClDecl RdrName
941 -> (SDoc -> [LHsTyVarBndr RdrName] ->
942 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
943 RnM (TyClDecl Name, FreeVars))
944 -> RnM (TyClDecl Name, FreeVars)
946 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
947 tcdLName = tycon, tcdTyVars = tyvars})
949 do { checkM (isDataFlavour flavour -- for synonyms,
950 || not (null tyvars)) $ addErr needOneIdx -- no. of indexes >= 1
951 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
952 ; tycon' <- lookupLocatedTopBndrRn tycon
953 ; return (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
954 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
958 isDataFlavour DataFamily = True
959 isDataFlavour _ = False
960 rnFamily d _ = pprPanic "rnFamily" (ppr d)
962 family_doc :: Located RdrName -> SDoc
963 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
966 needOneIdx = text "Type family declarations requires at least one type index"
968 -- Rename associated type declarations (in classes)
970 -- * This can be family declarations and (default) type instances
972 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
973 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
975 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
976 rn_at (tydecl@TySynonym {}) =
978 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
980 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
982 lookupIdxVars _ tyvars cont =
983 do { checkForDups tyvars;
984 ; tyvars' <- mapM lookupIdxVar tyvars
987 -- Type index variables must be class parameters, which are the only
988 -- type variables in scope at this point.
989 lookupIdxVar (L l tyvar) =
991 name' <- lookupOccRn (hsTyVarName tyvar)
992 return $ L l (replaceTyVarName tyvar name')
994 -- Type variable may only occur once.
996 checkForDups [] = return ()
997 checkForDups (L loc tv:ltvs) =
998 do { setSrcSpan loc $
999 when (hsTyVarName tv `ltvElem` ltvs) $
1000 addErr (repeatedTyVar tv)
1004 _ `ltvElem` [] = False
1005 rdrName `ltvElem` (L _ tv:ltvs)
1006 | rdrName == hsTyVarName tv = True
1007 | otherwise = rdrName `ltvElem` ltvs
1010 noPatterns = text "Default definition for an associated synonym cannot have"
1011 <+> text "type pattern"
1013 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
1014 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
1017 -- This data decl will parse OK
1019 -- treating "a" as the constructor.
1020 -- It is really hard to make the parser spot this malformation.
1021 -- So the renamer has to check that the constructor is legal
1023 -- We can get an operator as the constructor, even in the prefix form:
1024 -- data T = :% Int Int
1025 -- from interface files, which always print in prefix form
1027 checkConName :: RdrName -> TcRn ()
1028 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1030 badDataCon :: RdrName -> SDoc
1032 = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
1036 %*********************************************************
1038 \subsection{Support code for type/data declarations}
1040 %*********************************************************
1042 Get the mapping from constructors to fields for this module.
1043 It's convenient to do this after the data type decls have been renamed
1045 extendRecordFieldEnv :: [LTyClDecl RdrName] -> [LInstDecl RdrName] -> TcM TcGblEnv
1046 extendRecordFieldEnv tycl_decls inst_decls
1047 = do { tcg_env <- getGblEnv
1048 ; field_env' <- foldrM get_con (tcg_field_env tcg_env) all_data_cons
1049 ; return (tcg_env { tcg_field_env = field_env' }) }
1051 -- we want to lookup:
1052 -- (a) a datatype constructor
1053 -- (b) a record field
1054 -- knowing that they're from this module.
1055 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1056 -- which keeps only the local ones.
1057 lookup x = do { x' <- lookupLocatedTopBndrRn x
1058 ; return $ unLoc x'}
1060 all_data_cons :: [ConDecl RdrName]
1061 all_data_cons = [con | L _ (TyData { tcdCons = cons }) <- all_tycl_decls
1063 all_tycl_decls = at_tycl_decls ++ tycl_decls
1064 at_tycl_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
1065 -- Do not forget associated types!
1067 get_con (ConDecl { con_name = con, con_details = RecCon flds })
1068 (RecFields env fld_set)
1069 = do { con' <- lookup con
1070 ; flds' <- mapM lookup (map cd_fld_name flds)
1071 ; let env' = extendNameEnv env con' flds'
1072 fld_set' = addListToNameSet fld_set flds'
1073 ; return $ (RecFields env' fld_set') }
1074 get_con _ env = return env
1077 %*********************************************************
1079 \subsection{Support code to rename types}
1081 %*********************************************************
1084 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1087 = mapM (wrapLocM rn_fds) fds
1090 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1091 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1092 return (tys1', tys2')
1094 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1095 rnHsTyVars doc tvs = mapM (rnHsTyVar doc) tvs
1097 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1098 rnHsTyVar _doc tyvar = lookupOccRn tyvar
1102 %*********************************************************
1106 %*********************************************************
1112 h = ...$(thing "f")...
1114 The splice can expand into literally anything, so when we do dependency
1115 analysis we must assume that it might mention 'f'. So we simply treat
1116 all locally-defined names as mentioned by any splice. This is terribly
1117 brutal, but I don't see what else to do. For example, it'll mean
1118 that every locally-defined thing will appear to be used, so no unused-binding
1119 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
1120 and that will crash the type checker because 'f' isn't in scope.
1122 Currently, I'm not treating a splice as also mentioning every import,
1123 which is a bit inconsistent -- but there are a lot of them. We might
1124 thereby get some bogus unused-import warnings, but we won't crash the
1125 type checker. Not very satisfactory really.
1128 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
1129 rnSplice (HsSplice n expr)
1130 = do { checkTH expr "splice"
1131 ; loc <- getSrcSpanM
1132 ; [n'] <- newLocalsRn [L loc n]
1133 ; (expr', fvs) <- rnLExpr expr
1135 -- Ugh! See Note [Splices] above
1136 ; lcl_rdr <- getLocalRdrEnv
1137 ; gbl_rdr <- getGlobalRdrEnv
1138 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
1140 lcl_names = mkNameSet (occEnvElts lcl_rdr)
1142 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
1144 checkTH :: Outputable a => a -> String -> RnM ()
1146 checkTH _ _ = return () -- OK
1148 checkTH e what -- Raise an error in a stage-1 compiler
1149 = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>
1150 ptext (sLit "illegal in a stage-1 compiler"),