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, 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)
55 thenM :: Monad a => a b -> (b -> a c) -> a c
58 thenM_ :: Monad a => a b -> a c -> a c
62 @rnSourceDecl@ `renames' declarations.
63 It simultaneously performs dependency analysis and precedence parsing.
64 It also does the following error checks:
67 Checks that tyvars are used properly. This includes checking
68 for undefined tyvars, and tyvars in contexts that are ambiguous.
69 (Some of this checking has now been moved to module @TcMonoType@,
70 since we don't have functional dependency information at this point.)
72 Checks that all variable occurences are defined.
74 Checks the @(..)@ etc constraints in the export list.
79 -- Brings the binders of the group into scope in the appropriate places;
80 -- does NOT assume that anything is in scope already
81 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
82 -- Rename a HsGroup; used for normal source files *and* hs-boot files
83 rnSrcDecls group@(HsGroup {hs_valds = val_decls,
84 hs_tyclds = tycl_decls,
85 hs_instds = inst_decls,
86 hs_derivds = deriv_decls,
88 hs_warnds = warn_decls,
90 hs_fords = foreign_decls,
91 hs_defds = default_decls,
92 hs_ruleds = rule_decls,
95 -- (A) Process the fixity declarations, creating a mapping from
96 -- FastStrings to FixItems.
97 -- Also checks for duplcates.
98 local_fix_env <- makeMiniFixityEnv fix_decls;
100 -- (B) Bring top level binders (and their fixities) into scope,
101 -- *except* for the value bindings, which get brought in below.
102 -- However *do* include class ops, data constructors
103 -- And for hs-boot files *do* include the value signatures
104 tc_avails <- getLocalNonValBinders group ;
105 tc_envs <- extendGlobalRdrEnvRn tc_avails local_fix_env ;
106 setEnvs tc_envs $ do {
108 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
110 -- (C) Extract the mapping from data constructors to field names and
111 -- extend the record field env.
112 -- This depends on the data constructors and field names being in
113 -- scope from (B) above
114 inNewEnv (extendRecordFieldEnv tycl_decls inst_decls) $ \ _ -> do {
116 -- (D) Rename the left-hand sides of the value bindings.
117 -- This depends on everything from (B) being in scope,
118 -- and on (C) for resolving record wild cards.
119 -- It uses the fixity env from (A) to bind fixities for view patterns.
120 new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
121 -- bind the LHSes (and their fixities) in the global rdr environment
122 let { val_binders = map unLoc $ collectHsValBinders new_lhs ;
123 val_bndr_set = mkNameSet val_binders ;
124 all_bndr_set = val_bndr_set `unionNameSets` availsToNameSet tc_avails ;
125 val_avails = map Avail val_binders
127 (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
128 setEnvs (tcg_env, tcl_env) $ do {
130 -- Now everything is in scope, as the remaining renaming assumes.
132 -- (E) Rename type and class decls
133 -- (note that value LHSes need to be in scope for default methods)
135 -- You might think that we could build proper def/use information
136 -- for type and class declarations, but they can be involved
137 -- in mutual recursion across modules, and we only do the SCC
138 -- analysis for them in the type checker.
139 -- So we content ourselves with gathering uses only; that
140 -- means we'll only report a declaration as unused if it isn't
141 -- mentioned at all. Ah well.
142 traceRn (text "Start rnTyClDecls") ;
143 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
145 -- (F) Rename Value declarations right-hand sides
146 traceRn (text "Start rnmono") ;
147 (rn_val_decls, bind_dus) <- rnTopBindsRHS val_bndr_set new_lhs ;
148 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
150 -- (G) Rename Fixity and deprecations
152 -- Rename fixity declarations and error if we try to
153 -- fix something from another module (duplicates were checked in (A))
154 rn_fix_decls <- rnSrcFixityDecls all_bndr_set fix_decls ;
156 -- Rename deprec decls;
157 -- check for duplicates and ensure that deprecated things are defined locally
158 -- at the moment, we don't keep these around past renaming
159 rn_warns <- rnSrcWarnDecls all_bndr_set warn_decls ;
161 -- (H) Rename Everything else
163 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
164 (rn_rule_decls, src_fvs3) <- setOptM Opt_ScopedTypeVariables $
165 rnList rnHsRuleDecl rule_decls ;
166 -- Inside RULES, scoped type variables are on
167 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
168 (rn_ann_decls, src_fvs5) <- rnList rnAnnDecl ann_decls ;
169 (rn_default_decls, src_fvs6) <- rnList rnDefaultDecl default_decls ;
170 (rn_deriv_decls, src_fvs7) <- rnList rnSrcDerivDecl deriv_decls ;
171 -- Haddock docs; no free vars
172 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
174 -- (I) Compute the results and return
175 let {rn_group = HsGroup { hs_valds = rn_val_decls,
176 hs_tyclds = rn_tycl_decls,
177 hs_instds = rn_inst_decls,
178 hs_derivds = rn_deriv_decls,
179 hs_fixds = rn_fix_decls,
180 hs_warnds = [], -- warns are returned in the tcg_env
181 -- (see below) not in the HsGroup
182 hs_fords = rn_foreign_decls,
183 hs_annds = rn_ann_decls,
184 hs_defds = rn_default_decls,
185 hs_ruleds = rn_rule_decls,
186 hs_docs = rn_docs } ;
188 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
189 src_fvs5, src_fvs6, src_fvs7] ;
190 src_dus = bind_dus `plusDU` usesOnly other_fvs;
191 -- Note: src_dus will contain *uses* for locally-defined types
192 -- and classes, but no *defs* for them. (Because rnTyClDecl
193 -- returns only the uses.) This is a little
194 -- surprising but it doesn't actually matter at all.
196 final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
197 in -- we return the deprecs in the env, not in the HsGroup above
198 tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
201 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
202 traceRn (text "finish Dus" <+> ppr src_dus ) ;
203 return (final_tcg_env , rn_group)
206 -- some utils because we do this a bunch above
207 -- compute and install the new env
208 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
209 inNewEnv env cont = do e <- env
212 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
213 -- Used for external core
214 rnTyClDecls tycl_decls = do (decls', _fvs) <- rnList rnTyClDecl tycl_decls
217 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
218 -- This function could be defined lower down in the module hierarchy,
219 -- but there doesn't seem anywhere very logical to put it.
220 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
222 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
223 rnList f xs = mapFvRn (wrapLocFstM f) xs
227 %*********************************************************
231 %*********************************************************
234 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
235 rnDocDecl (DocCommentNext doc) = do
236 rn_doc <- rnHsDoc doc
237 return (DocCommentNext rn_doc)
238 rnDocDecl (DocCommentPrev doc) = do
239 rn_doc <- rnHsDoc doc
240 return (DocCommentPrev rn_doc)
241 rnDocDecl (DocCommentNamed str doc) = do
242 rn_doc <- rnHsDoc doc
243 return (DocCommentNamed str rn_doc)
244 rnDocDecl (DocGroup lev doc) = do
245 rn_doc <- rnHsDoc doc
246 return (DocGroup lev rn_doc)
250 %*********************************************************
252 Source-code fixity declarations
254 %*********************************************************
257 rnSrcFixityDecls :: NameSet -> [LFixitySig RdrName] -> RnM [LFixitySig Name]
258 -- Rename the fixity decls, so we can put
259 -- the renamed decls in the renamed syntax tree
260 -- Errors if the thing being fixed is not defined locally.
262 -- The returned FixitySigs are not actually used for anything,
263 -- except perhaps the GHCi API
264 rnSrcFixityDecls bound_names fix_decls
265 = do fix_decls <- mapM rn_decl fix_decls
266 return (concat fix_decls)
268 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
269 -- GHC extension: look up both the tycon and data con
270 -- for con-like things; hence returning a list
271 -- If neither are in scope, report an error; otherwise
272 -- return a fixity sig for each (slightly odd)
273 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
274 = setSrcSpan name_loc $
275 -- this lookup will fail if the definition isn't local
276 do names <- lookupLocalDataTcNames bound_names what rdr_name
277 return [ L loc (FixitySig (L name_loc name) fixity)
279 what = ptext (sLit "fixity signature")
283 %*********************************************************
285 Source-code deprecations declarations
287 %*********************************************************
289 Check that the deprecated names are defined, are defined locally, and
290 that there are no duplicate deprecations.
292 It's only imported deprecations, dealt with in RnIfaces, that we
293 gather them together.
296 -- checks that the deprecations are defined locally, and that there are no duplicates
297 rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
298 rnSrcWarnDecls _bound_names []
301 rnSrcWarnDecls bound_names decls
302 = do { -- check for duplicates
303 ; mapM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups
304 ; mapM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
305 return (WarnSome ((concat pairs_s))) }
307 rn_deprec (Warning rdr_name txt)
308 -- ensures that the names are defined locally
309 = lookupLocalDataTcNames bound_names what rdr_name `thenM` \ names ->
310 return [(nameOccName name, txt) | name <- names]
312 what = ptext (sLit "deprecation")
314 -- look for duplicates among the OccNames;
315 -- we check that the names are defined above
316 -- invt: the lists returned by findDupsEq always have at least two elements
317 warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
318 (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
320 dupWarnDecl :: Located RdrName -> RdrName -> SDoc
321 -- Located RdrName -> DeprecDecl RdrName -> SDoc
322 dupWarnDecl (L loc _) rdr_name
323 = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
324 ptext (sLit "also at ") <+> ppr loc]
328 %*********************************************************
330 \subsection{Annotation declarations}
332 %*********************************************************
335 rnAnnDecl :: AnnDecl RdrName -> RnM (AnnDecl Name, FreeVars)
336 rnAnnDecl (HsAnnotation provenance expr) = do
337 (provenance', provenance_fvs) <- rnAnnProvenance provenance
338 (expr', expr_fvs) <- rnLExpr expr
339 return (HsAnnotation provenance' expr', provenance_fvs `plusFV` expr_fvs)
341 rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
342 rnAnnProvenance provenance = do
343 provenance' <- modifyAnnProvenanceNameM lookupTopBndrRn provenance
344 return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
347 %*********************************************************
349 \subsection{Default declarations}
351 %*********************************************************
354 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
355 rnDefaultDecl (DefaultDecl tys)
356 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
357 return (DefaultDecl tys', fvs)
359 doc_str = text "In a `default' declaration"
362 %*********************************************************
364 \subsection{Foreign declarations}
366 %*********************************************************
369 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
370 rnHsForeignDecl (ForeignImport name ty spec)
371 = lookupLocatedTopBndrRn name `thenM` \ name' ->
372 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
373 return (ForeignImport name' ty' spec, fvs)
375 rnHsForeignDecl (ForeignExport name ty spec)
376 = lookupLocatedOccRn name `thenM` \ name' ->
377 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
378 return (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
379 -- NB: a foreign export is an *occurrence site* for name, so
380 -- we add it to the free-variable list. It might, for example,
381 -- be imported from another module
383 fo_decl_msg :: Located RdrName -> SDoc
384 fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
388 %*********************************************************
390 \subsection{Instance declarations}
392 %*********************************************************
395 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
396 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
397 -- Used for both source and interface file decls
398 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
400 -- Rename the bindings
401 -- The typechecker (not the renamer) checks that all
402 -- the bindings are for the right class
404 meth_doc = text "In the bindings in an instance declaration"
405 meth_names = collectHsBindLocatedBinders mbinds
406 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
408 checkDupRdrNames meth_doc meth_names `thenM_`
409 -- Check that the same method is not given twice in the
410 -- same instance decl instance C T where
414 -- We must use checkDupRdrNames because the Name of the
415 -- method is the Name of the class selector, whose SrcSpan
416 -- points to the class declaration
418 extendTyVarEnvForMethodBinds inst_tyvars (
419 -- (Slightly strangely) the forall-d tyvars scope over
420 -- the method bindings too
421 rnMethodBinds cls (\_ -> []) -- No scoped tyvars
423 ) `thenM` \ (mbinds', meth_fvs) ->
424 -- Rename the associated types
425 -- The typechecker (not the renamer) checks that all
426 -- the declarations are for the right class
428 at_doc = text "In the associated types of an instance declaration"
429 at_names = map (head . tyClDeclNames . unLoc) ats
431 checkDupRdrNames at_doc at_names `thenM_`
432 -- See notes with checkDupRdrNames for methods, above
434 rnATInsts ats `thenM` \ (ats', at_fvs) ->
436 -- Rename the prags and signatures.
437 -- Note that the type variables are not in scope here,
438 -- so that instance Eq a => Eq (T a) where
439 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
442 -- But the (unqualified) method names are in scope
444 binders = collectHsBindBinders mbinds'
445 bndr_set = mkNameSet binders
447 bindLocalNames binders
448 (renameSigs (Just bndr_set) okInstDclSig uprags) `thenM` \ uprags' ->
450 return (InstDecl inst_ty' mbinds' uprags' ats',
451 meth_fvs `plusFV` at_fvs
452 `plusFV` hsSigsFVs uprags'
453 `plusFV` extractHsTyNames inst_ty')
454 -- We return the renamed associated data type declarations so
455 -- that they can be entered into the list of type declarations
456 -- for the binding group, but we also keep a copy in the instance.
457 -- The latter is needed for well-formedness checks in the type
458 -- checker (eg, to ensure that all ATs of the instance actually
459 -- receive a declaration).
460 -- NB: Even the copies in the instance declaration carry copies of
461 -- the instance context after renaming. This is a bit
462 -- strange, but should not matter (and it would be more work
463 -- to remove the context).
466 Renaming of the associated types in instances.
469 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
470 rnATInsts atDecls = rnList rnATInst atDecls
472 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
473 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
475 pprPanic "RnSource.rnATInsts: invalid AT instance"
476 (ppr (tcdName tydecl))
479 For the method bindings in class and instance decls, we extend the
480 type variable environment iff -fglasgow-exts
483 extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
484 -> RnM (Bag (LHsBind Name), FreeVars)
485 -> RnM (Bag (LHsBind Name), FreeVars)
486 extendTyVarEnvForMethodBinds tyvars thing_inside
487 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
489 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
494 %*********************************************************
496 \subsection{Stand-alone deriving declarations}
498 %*********************************************************
501 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
502 rnSrcDerivDecl (DerivDecl ty)
503 = do ty' <- rnLHsType (text "a deriving decl") ty
504 let fvs = extractHsTyNames ty'
505 return (DerivDecl ty', fvs)
508 %*********************************************************
512 %*********************************************************
515 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
516 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
517 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
518 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
519 do { (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
520 -- NB: The binders in a rule are always Ids
521 -- We don't (yet) support type variables
523 ; (lhs', fv_lhs') <- rnLExpr lhs
524 ; (rhs', fv_rhs') <- rnLExpr rhs
526 ; checkValidRule rule_name ids lhs' fv_lhs'
528 ; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
529 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
531 doc = text "In the transformation rule" <+> ftext rule_name
533 get_var (RuleBndr v) = v
534 get_var (RuleBndrSig v _) = v
536 rn_var (RuleBndr (L loc _), id)
537 = return (RuleBndr (L loc id), emptyFVs)
538 rn_var (RuleBndrSig (L loc _) t, id)
539 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
540 return (RuleBndrSig (L loc id) t', fvs)
542 badRuleVar :: FastString -> Name -> SDoc
544 = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
545 ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
546 ptext (sLit "does not appear on left hand side")]
549 Note [Rule LHS validity checking]
550 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
551 Check the shape of a transformation rule LHS. Currently we only allow
552 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
553 @forall@'d variables.
555 We used restrict the form of the 'ei' to prevent you writing rules
556 with LHSs with a complicated desugaring (and hence unlikely to match);
557 (e.g. a case expression is not allowed: too elaborate.)
559 But there are legitimate non-trivial args ei, like sections and
560 lambdas. So it seems simmpler not to check at all, and that is why
561 check_e is commented out.
564 checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
565 checkValidRule rule_name ids lhs' fv_lhs'
566 = do { -- Check for the form of the LHS
567 case (validRuleLhs ids lhs') of
569 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
571 -- Check that LHS vars are all bound
572 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
573 ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
575 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
577 -- Just e => Not ok, and e is the offending expression
578 validRuleLhs foralls lhs
581 checkl (L _ e) = check e
583 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
584 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
585 check (HsVar v) | v `notElem` foralls = Nothing
586 check other = Just other -- Failure
589 checkl_e (L _ _e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
591 {- Commented out; see Note [Rule LHS validity checking] above
592 check_e (HsVar v) = Nothing
593 check_e (HsPar e) = checkl_e e
594 check_e (HsLit e) = Nothing
595 check_e (HsOverLit e) = Nothing
597 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
598 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
599 check_e (NegApp e _) = checkl_e e
600 check_e (ExplicitList _ es) = checkl_es es
601 check_e (ExplicitTuple es _) = checkl_es es
602 check_e other = Just other -- Fails
604 checkl_es es = foldr (mplus . checkl_e) Nothing es
607 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
608 badRuleLhsErr name lhs bad_e
609 = sep [ptext (sLit "Rule") <+> ftext name <> colon,
610 nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
611 ptext (sLit "in left-hand side:") <+> ppr lhs])]
613 ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
617 %*********************************************************
619 \subsection{Type, class and iface sig declarations}
621 %*********************************************************
623 @rnTyDecl@ uses the `global name function' to create a new type
624 declaration in which local names have been replaced by their original
625 names, reporting any unknown names.
627 Renaming type variables is a pain. Because they now contain uniques,
628 it is necessary to pass in an association list which maps a parsed
629 tyvar to its @Name@ representation.
630 In some cases (type signatures of values),
631 it is even necessary to go over the type first
632 in order to get the set of tyvars used by it, make an assoc list,
633 and then go over it again to rename the tyvars!
634 However, we can also do some scoping checks at the same time.
637 rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
638 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
639 = lookupLocatedTopBndrRn name `thenM` \ name' ->
640 return (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
643 -- all flavours of type family declarations ("type family", "newtype fanily",
644 -- and "data family")
645 rnTyClDecl (tydecl@TyFamily {}) =
646 rnFamily tydecl bindTyVarsRn
648 -- "data", "newtype", "data instance, and "newtype instance" declarations
649 rnTyClDecl tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
650 tcdLName = tycon, tcdTyVars = tyvars,
651 tcdTyPats = typatsMaybe, tcdCons = condecls,
652 tcdKindSig = sig, tcdDerivs = derivs}
653 | is_vanilla -- Normal Haskell data type decl
654 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
655 -- data type is syntactically illegal
656 ASSERT( distinctTyVarBndrs tyvars ) -- Tyvars should be distinct
657 do { bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
658 { tycon' <- if isFamInstDecl tydecl
659 then lookupLocatedOccRn tycon -- may be imported family
660 else lookupLocatedTopBndrRn tycon
661 ; context' <- rnContext data_doc context
662 ; typats' <- rnTyPats data_doc typatsMaybe
663 ; condecls' <- rnConDecls (unLoc tycon') condecls
664 -- No need to check for duplicate constructor decls
665 -- since that is done by RnNames.extendGlobalRdrEnvRn
666 ; (derivs', deriv_fvs) <- rn_derivs derivs
667 ; return (TyData {tcdND = new_or_data, tcdCtxt = context',
668 tcdLName = tycon', tcdTyVars = tyvars',
669 tcdTyPats = typats', tcdKindSig = Nothing,
670 tcdCons = condecls', tcdDerivs = derivs'},
671 delFVs (map hsLTyVarName tyvars') $
672 extractHsCtxtTyNames context' `plusFV`
673 plusFVs (map conDeclFVs condecls') `plusFV`
675 (if isFamInstDecl tydecl
676 then unitFV (unLoc tycon') -- type instance => use
681 = do { tycon' <- if isFamInstDecl tydecl
682 then lookupLocatedOccRn tycon -- may be imported family
683 else lookupLocatedTopBndrRn tycon
684 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
686 <- bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
687 { typats' <- rnTyPats data_doc typatsMaybe
688 ; return (tyvars', typats') }
689 -- For GADTs, the type variables in the declaration
690 -- do not scope over the constructor signatures
691 -- data T a where { T1 :: forall b. b-> b }
693 ; condecls' <- rnConDecls (unLoc tycon') condecls
694 -- No need to check for duplicate constructor decls
695 -- since that is done by RnNames.extendGlobalRdrEnvRn
697 ; (derivs', deriv_fvs) <- rn_derivs derivs
698 ; return (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
699 tcdLName = tycon', tcdTyVars = tyvars',
700 tcdTyPats = typats', tcdKindSig = sig,
701 tcdCons = condecls', tcdDerivs = derivs'},
702 plusFVs (map conDeclFVs condecls') `plusFV`
704 (if isFamInstDecl tydecl
705 then unitFV (unLoc tycon') -- type instance => use
709 is_vanilla = case condecls of -- Yuk
711 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
714 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
716 rn_derivs Nothing = return (Nothing, emptyFVs)
717 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
718 return (Just ds', extractHsTyNames_s ds')
720 -- "type" and "type instance" declarations
721 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
722 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
723 = ASSERT( distinctTyVarBndrs tyvars ) -- Tyvars should be distinct
724 do { bindTyVarsRn syn_doc tyvars $ \ tyvars' -> do
725 { name' <- if isFamInstDecl tydecl
726 then lookupLocatedOccRn name -- may be imported family
727 else lookupLocatedTopBndrRn name
728 ; typats' <- rnTyPats syn_doc typatsMaybe
729 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
730 ; return (TySynonym {tcdLName = name', tcdTyVars = tyvars',
731 tcdTyPats = typats', tcdSynRhs = ty'},
732 delFVs (map hsLTyVarName tyvars') $
734 (if isFamInstDecl tydecl
735 then unitFV (unLoc name') -- type instance => use
739 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
741 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
742 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
743 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
744 = do { cname' <- lookupLocatedTopBndrRn cname
746 -- Tyvars scope over superclass context and method signatures
747 ; (tyvars', context', fds', ats', ats_fvs, sigs')
748 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
749 { context' <- rnContext cls_doc context
750 ; fds' <- rnFds cls_doc fds
751 ; (ats', ats_fvs) <- rnATs ats
752 ; sigs' <- renameSigs Nothing okClsDclSig sigs
753 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
755 -- No need to check for duplicate associated type decls
756 -- since that is done by RnNames.extendGlobalRdrEnvRn
758 -- Check the signatures
759 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
760 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
761 ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
762 -- Typechecker is responsible for checking that we only
763 -- give default-method bindings for things in this class.
764 -- The renamer *could* check this for class decls, but can't
765 -- for instance decls.
767 -- The newLocals call is tiresome: given a generic class decl
770 -- op {| x+y |} (Inl a) = ...
771 -- op {| x+y |} (Inr b) = ...
772 -- op {| a*b |} (a*b) = ...
773 -- we want to name both "x" tyvars with the same unique, so that they are
774 -- easy to group together in the typechecker.
775 ; (mbinds', meth_fvs)
776 <- extendTyVarEnvForMethodBinds tyvars' $ do
777 { name_env <- getLocalRdrEnv
778 ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
779 not (unLoc tv `elemLocalRdrEnv` name_env) ]
780 -- No need to check for duplicate method signatures
781 -- since that is done by RnNames.extendGlobalRdrEnvRn
782 -- and the methods are already in scope
783 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
784 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
787 ; docs' <- mapM (wrapLocM rnDocDecl) docs
789 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
790 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
791 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
793 delFVs (map hsLTyVarName tyvars') $
794 extractHsCtxtTyNames context' `plusFV`
795 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
796 hsSigsFVs sigs' `plusFV`
800 cls_doc = text "In the declaration for class" <+> ppr cname
801 sig_doc = text "In the signatures for class" <+> ppr cname
803 distinctTyVarBndrs :: [LHsTyVarBndr RdrName] -> Bool
804 -- The tyvar binders should have distinct names
805 distinctTyVarBndrs tvs
806 = null (findDupsEq eq tvs)
808 eq (L _ v1) (L _ v2) = hsTyVarName v1 == hsTyVarName v2
810 badGadtStupidTheta :: Located RdrName -> SDoc
812 = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
813 ptext (sLit "(You can put a context on each contructor, though.)")]
817 %*********************************************************
819 \subsection{Support code for type/data declarations}
821 %*********************************************************
824 -- Although, we are processing type patterns here, all type variables will
825 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
826 -- type declaration to which these patterns belong)
828 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
829 rnTyPats _ Nothing = return Nothing
830 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
832 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
833 rnConDecls _tycon condecls
834 = mapM (wrapLocM rnConDecl) condecls
836 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
837 rnConDecl decl@(ConDecl { con_name = name, con_qvars = tvs
838 , con_cxt = cxt, con_details = details
839 , con_res = res_ty, con_doc = mb_doc
840 , con_old_rec = old_rec, con_explicit = expl })
841 = do { addLocM checkConName name
842 ; when old_rec (addWarn (deprecRecSyntax decl))
844 ; new_name <- lookupLocatedTopBndrRn name
845 ; name_env <- getLocalRdrEnv
847 -- For H98 syntax, the tvs are the existential ones
848 -- For GADT syntax, the tvs are all the quantified tyvars
849 -- Hence the 'filter' in the ResTyH98 case only
850 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
851 arg_tys = hsConDeclArgTys details
852 implicit_tvs = case res_ty of
853 ResTyH98 -> filter not_in_scope $
855 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
856 new_tvs = case expl of
858 Implicit -> userHsTyVarBndrs implicit_tvs
860 ; mb_doc' <- rnMbLHsDoc mb_doc
862 ; bindTyVarsRn doc new_tvs $ \new_tyvars -> do
863 { new_context <- rnContext doc cxt
864 ; new_details <- rnConDeclDetails doc details
865 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
866 ; return (decl { con_name = new_name, con_qvars = new_tyvars, con_cxt = new_context
867 , con_details = new_details', con_res = new_res_ty, con_doc = mb_doc' }) }}
869 doc = text "In the definition of data constructor" <+> quotes (ppr name)
870 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
873 -> HsConDetails (LHsType Name) [ConDeclField Name]
875 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
877 rnConResult _ details ResTyH98 = return (details, ResTyH98)
878 rnConResult doc details (ResTyGADT ty)
879 = do { ty' <- rnLHsType doc ty
880 ; let (arg_tys, res_ty) = splitHsFunType ty'
881 -- We can finally split it up,
882 -- now the renamer has dealt with fixities
883 -- See Note [Sorting out the result type] in RdrHsSyn
885 details' = case details of
887 PrefixCon {} -> PrefixCon arg_tys
888 InfixCon {} -> pprPanic "rnConResult" (ppr ty)
889 -- See Note [Sorting out the result type] in RdrHsSyn
891 ; when (not (null arg_tys) && case details of { RecCon {} -> True; _ -> False })
892 (addErr (badRecResTy doc))
893 ; return (details', ResTyGADT res_ty) }
895 rnConDeclDetails :: SDoc
896 -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
897 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
898 rnConDeclDetails doc (PrefixCon tys)
899 = mapM (rnLHsType doc) tys `thenM` \ new_tys ->
900 return (PrefixCon new_tys)
902 rnConDeclDetails doc (InfixCon ty1 ty2)
903 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
904 rnLHsType doc ty2 `thenM` \ new_ty2 ->
905 return (InfixCon new_ty1 new_ty2)
907 rnConDeclDetails doc (RecCon fields)
908 = do { new_fields <- rnConDeclFields doc fields
909 -- No need to check for duplicate fields
910 -- since that is done by RnNames.extendGlobalRdrEnvRn
911 ; return (RecCon new_fields) }
913 -- Rename family declarations
915 -- * This function is parametrised by the routine handling the index
916 -- variables. On the toplevel, these are defining occurences, whereas they
917 -- are usage occurences for associated types.
919 rnFamily :: TyClDecl RdrName
920 -> (SDoc -> [LHsTyVarBndr RdrName] ->
921 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
922 RnM (TyClDecl Name, FreeVars))
923 -> RnM (TyClDecl Name, FreeVars)
925 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
926 tcdLName = tycon, tcdTyVars = tyvars})
928 do { bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
929 ; tycon' <- lookupLocatedTopBndrRn tycon
930 ; return (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
931 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
934 rnFamily d _ = pprPanic "rnFamily" (ppr d)
936 family_doc :: Located RdrName -> SDoc
937 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
939 -- Rename associated type declarations (in classes)
941 -- * This can be family declarations and (default) type instances
943 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
944 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
946 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
947 rn_at (tydecl@TySynonym {}) =
949 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
951 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
953 lookupIdxVars _ tyvars cont =
954 do { checkForDups tyvars;
955 ; tyvars' <- mapM lookupIdxVar tyvars
958 -- Type index variables must be class parameters, which are the only
959 -- type variables in scope at this point.
960 lookupIdxVar (L l tyvar) =
962 name' <- lookupOccRn (hsTyVarName tyvar)
963 return $ L l (replaceTyVarName tyvar name')
965 -- Type variable may only occur once.
967 checkForDups [] = return ()
968 checkForDups (L loc tv:ltvs) =
969 do { setSrcSpan loc $
970 when (hsTyVarName tv `ltvElem` ltvs) $
971 addErr (repeatedTyVar tv)
975 _ `ltvElem` [] = False
976 rdrName `ltvElem` (L _ tv:ltvs)
977 | rdrName == hsTyVarName tv = True
978 | otherwise = rdrName `ltvElem` ltvs
980 deprecRecSyntax :: ConDecl RdrName -> SDoc
982 = vcat [ ptext (sLit "Declaration of") <+> quotes (ppr (con_name decl))
983 <+> ptext (sLit "uses deprecated syntax")
984 , ptext (sLit "Instead, use the form")
985 , nest 2 (ppr decl) ] -- Pretty printer uses new form
987 badRecResTy :: SDoc -> SDoc
988 badRecResTy doc = ptext (sLit "Malformed constructor signature") $$ doc
991 noPatterns = text "Default definition for an associated synonym cannot have"
992 <+> text "type pattern"
994 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
995 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
998 -- This data decl will parse OK
1000 -- treating "a" as the constructor.
1001 -- It is really hard to make the parser spot this malformation.
1002 -- So the renamer has to check that the constructor is legal
1004 -- We can get an operator as the constructor, even in the prefix form:
1005 -- data T = :% Int Int
1006 -- from interface files, which always print in prefix form
1008 checkConName :: RdrName -> TcRn ()
1009 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1011 badDataCon :: RdrName -> SDoc
1013 = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
1017 %*********************************************************
1019 \subsection{Support code for type/data declarations}
1021 %*********************************************************
1023 Get the mapping from constructors to fields for this module.
1024 It's convenient to do this after the data type decls have been renamed
1026 extendRecordFieldEnv :: [LTyClDecl RdrName] -> [LInstDecl RdrName] -> TcM TcGblEnv
1027 extendRecordFieldEnv tycl_decls inst_decls
1028 = do { tcg_env <- getGblEnv
1029 ; field_env' <- foldrM get_con (tcg_field_env tcg_env) all_data_cons
1030 ; return (tcg_env { tcg_field_env = field_env' }) }
1032 -- we want to lookup:
1033 -- (a) a datatype constructor
1034 -- (b) a record field
1035 -- knowing that they're from this module.
1036 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1037 -- which keeps only the local ones.
1038 lookup x = do { x' <- lookupLocatedTopBndrRn x
1039 ; return $ unLoc x'}
1041 all_data_cons :: [ConDecl RdrName]
1042 all_data_cons = [con | L _ (TyData { tcdCons = cons }) <- all_tycl_decls
1044 all_tycl_decls = at_tycl_decls ++ tycl_decls
1045 at_tycl_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
1046 -- Do not forget associated types!
1048 get_con (ConDecl { con_name = con, con_details = RecCon flds })
1049 (RecFields env fld_set)
1050 = do { con' <- lookup con
1051 ; flds' <- mapM lookup (map cd_fld_name flds)
1052 ; let env' = extendNameEnv env con' flds'
1053 fld_set' = addListToNameSet fld_set flds'
1054 ; return $ (RecFields env' fld_set') }
1055 get_con _ env = return env
1058 %*********************************************************
1060 \subsection{Support code to rename types}
1062 %*********************************************************
1065 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1068 = mapM (wrapLocM rn_fds) fds
1071 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1072 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1073 return (tys1', tys2')
1075 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1076 rnHsTyVars doc tvs = mapM (rnHsTyVar doc) tvs
1078 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1079 rnHsTyVar _doc tyvar = lookupOccRn tyvar