2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
8 rnSrcDecls, addTcgDUs, rnTyClDecls
11 #include "HsVersions.h"
13 import {-# SOURCE #-} RnExpr( rnLExpr )
16 import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv, rdrNameOcc )
17 import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
19 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext, rnConDeclFields )
20 import RnBinds ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
22 import RnEnv ( lookupLocalDataTcNames, lookupLocatedOccRn,
23 lookupTopBndrRn, lookupLocatedTopBndrRn,
24 lookupOccRn, newLocalBndrsRn, bindLocalNamesFV,
25 bindLocatedLocalsFV, bindPatSigTyVarsFV,
26 bindTyVarsRn, extendTyVarEnvFVRn,
27 bindLocalNames, checkDupRdrNames, mapFvRn
29 import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
30 import HscTypes ( GenAvailInfo(..), availsToNameSet )
31 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
34 import ForeignCall ( CCallTarget(..) )
36 import HscTypes ( Warnings(..), plusWarns )
37 import Class ( FunDep )
38 import Name ( Name, nameOccName )
44 import Util ( filterOut )
46 import DynFlags ( DynFlag(..), DynFlags, thisPackage )
47 import HscTypes ( HscEnv, hsc_dflags )
48 import BasicTypes ( Boxity(..) )
49 import ListSetOps ( findDupsEq )
58 thenM :: Monad a => a b -> (b -> a c) -> a c
61 thenM_ :: Monad a => a b -> a c -> a c
65 @rnSourceDecl@ `renames' declarations.
66 It simultaneously performs dependency analysis and precedence parsing.
67 It also does the following error checks:
70 Checks that tyvars are used properly. This includes checking
71 for undefined tyvars, and tyvars in contexts that are ambiguous.
72 (Some of this checking has now been moved to module @TcMonoType@,
73 since we don't have functional dependency information at this point.)
75 Checks that all variable occurences are defined.
77 Checks the @(..)@ etc constraints in the export list.
82 -- Brings the binders of the group into scope in the appropriate places;
83 -- does NOT assume that anything is in scope already
84 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
85 -- Rename a HsGroup; used for normal source files *and* hs-boot files
86 rnSrcDecls group@(HsGroup {hs_valds = val_decls,
87 hs_tyclds = tycl_decls,
88 hs_instds = inst_decls,
89 hs_derivds = deriv_decls,
91 hs_warnds = warn_decls,
93 hs_fords = foreign_decls,
94 hs_defds = default_decls,
95 hs_ruleds = rule_decls,
98 -- (A) Process the fixity declarations, creating a mapping from
99 -- FastStrings to FixItems.
100 -- Also checks for duplcates.
101 local_fix_env <- makeMiniFixityEnv fix_decls;
103 -- (B) Bring top level binders (and their fixities) into scope,
104 -- *except* for the value bindings, which get brought in below.
105 -- However *do* include class ops, data constructors
106 -- And for hs-boot files *do* include the value signatures
107 tc_avails <- getLocalNonValBinders group ;
108 tc_envs <- extendGlobalRdrEnvRn tc_avails local_fix_env ;
109 setEnvs tc_envs $ do {
111 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
113 -- (C) Extract the mapping from data constructors to field names and
114 -- extend the record field env.
115 -- This depends on the data constructors and field names being in
116 -- scope from (B) above
117 inNewEnv (extendRecordFieldEnv tycl_decls inst_decls) $ \ _ -> do {
119 -- (D) Rename the left-hand sides of the value bindings.
120 -- This depends on everything from (B) being in scope,
121 -- and on (C) for resolving record wild cards.
122 -- It uses the fixity env from (A) to bind fixities for view patterns.
123 new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
124 -- bind the LHSes (and their fixities) in the global rdr environment
125 let { val_binders = map unLoc $ collectHsValBinders new_lhs ;
126 val_bndr_set = mkNameSet val_binders ;
127 all_bndr_set = val_bndr_set `unionNameSets` availsToNameSet tc_avails ;
128 val_avails = map Avail val_binders
130 (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
131 setEnvs (tcg_env, tcl_env) $ do {
133 -- Now everything is in scope, as the remaining renaming assumes.
135 -- (E) Rename type and class decls
136 -- (note that value LHSes need to be in scope for default methods)
138 -- You might think that we could build proper def/use information
139 -- for type and class declarations, but they can be involved
140 -- in mutual recursion across modules, and we only do the SCC
141 -- analysis for them in the type checker.
142 -- So we content ourselves with gathering uses only; that
143 -- means we'll only report a declaration as unused if it isn't
144 -- mentioned at all. Ah well.
145 traceRn (text "Start rnTyClDecls") ;
146 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
148 -- (F) Rename Value declarations right-hand sides
149 traceRn (text "Start rnmono") ;
150 (rn_val_decls, bind_dus) <- rnTopBindsRHS val_bndr_set new_lhs ;
151 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
153 -- (G) Rename Fixity and deprecations
155 -- Rename fixity declarations and error if we try to
156 -- fix something from another module (duplicates were checked in (A))
157 rn_fix_decls <- rnSrcFixityDecls all_bndr_set fix_decls ;
159 -- Rename deprec decls;
160 -- check for duplicates and ensure that deprecated things are defined locally
161 -- at the moment, we don't keep these around past renaming
162 rn_warns <- rnSrcWarnDecls all_bndr_set warn_decls ;
164 -- (H) Rename Everything else
166 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
167 (rn_rule_decls, src_fvs3) <- setOptM Opt_ScopedTypeVariables $
168 rnList rnHsRuleDecl rule_decls ;
169 -- Inside RULES, scoped type variables are on
170 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
171 (rn_ann_decls, src_fvs5) <- rnList rnAnnDecl ann_decls ;
172 (rn_default_decls, src_fvs6) <- rnList rnDefaultDecl default_decls ;
173 (rn_deriv_decls, src_fvs7) <- rnList rnSrcDerivDecl deriv_decls ;
174 -- Haddock docs; no free vars
175 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
177 -- (I) Compute the results and return
178 let {rn_group = HsGroup { hs_valds = rn_val_decls,
179 hs_tyclds = rn_tycl_decls,
180 hs_instds = rn_inst_decls,
181 hs_derivds = rn_deriv_decls,
182 hs_fixds = rn_fix_decls,
183 hs_warnds = [], -- warns are returned in the tcg_env
184 -- (see below) not in the HsGroup
185 hs_fords = rn_foreign_decls,
186 hs_annds = rn_ann_decls,
187 hs_defds = rn_default_decls,
188 hs_ruleds = rn_rule_decls,
189 hs_docs = rn_docs } ;
191 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
192 src_fvs5, src_fvs6, src_fvs7] ;
193 src_dus = bind_dus `plusDU` usesOnly other_fvs;
194 -- Note: src_dus will contain *uses* for locally-defined types
195 -- and classes, but no *defs* for them. (Because rnTyClDecl
196 -- returns only the uses.) This is a little
197 -- surprising but it doesn't actually matter at all.
199 final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
200 in -- we return the deprecs in the env, not in the HsGroup above
201 tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
204 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
205 traceRn (text "finish Dus" <+> ppr src_dus ) ;
206 return (final_tcg_env , rn_group)
209 -- some utils because we do this a bunch above
210 -- compute and install the new env
211 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
212 inNewEnv env cont = do e <- env
215 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
216 -- Used for external core
217 rnTyClDecls tycl_decls = do (decls', _fvs) <- rnList rnTyClDecl tycl_decls
220 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
221 -- This function could be defined lower down in the module hierarchy,
222 -- but there doesn't seem anywhere very logical to put it.
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 -> RnM DocDecl
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_ (\ (L loc rdr:lrdr':_) -> addErrAt loc (dupWarnDecl lrdr' rdr))
308 ; pairs_s <- mapM (addLocM rn_deprec) decls
309 ; return (WarnSome ((concat pairs_s))) }
311 rn_deprec (Warning rdr_name txt)
312 -- ensures that the names are defined locally
313 = lookupLocalDataTcNames bound_names what rdr_name `thenM` \ names ->
314 return [(nameOccName name, txt) | name <- names]
316 what = ptext (sLit "deprecation")
318 -- look for duplicates among the OccNames;
319 -- we check that the names are defined above
320 -- invt: the lists returned by findDupsEq always have at least two elements
321 warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
322 (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
324 dupWarnDecl :: Located RdrName -> RdrName -> SDoc
325 -- Located RdrName -> DeprecDecl RdrName -> SDoc
326 dupWarnDecl (L loc _) rdr_name
327 = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
328 ptext (sLit "also at ") <+> ppr loc]
332 %*********************************************************
334 \subsection{Annotation declarations}
336 %*********************************************************
339 rnAnnDecl :: AnnDecl RdrName -> RnM (AnnDecl Name, FreeVars)
340 rnAnnDecl (HsAnnotation provenance expr) = do
341 (provenance', provenance_fvs) <- rnAnnProvenance provenance
342 (expr', expr_fvs) <- rnLExpr expr
343 return (HsAnnotation provenance' expr', provenance_fvs `plusFV` expr_fvs)
345 rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
346 rnAnnProvenance provenance = do
347 provenance' <- modifyAnnProvenanceNameM lookupTopBndrRn provenance
348 return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
351 %*********************************************************
353 \subsection{Default declarations}
355 %*********************************************************
358 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
359 rnDefaultDecl (DefaultDecl tys)
360 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
361 return (DefaultDecl tys', fvs)
363 doc_str = text "In a `default' declaration"
366 %*********************************************************
368 \subsection{Foreign declarations}
370 %*********************************************************
373 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
374 rnHsForeignDecl (ForeignImport name ty spec)
375 = getTopEnv `thenM` \ (topEnv :: HscEnv) ->
376 lookupLocatedTopBndrRn name `thenM` \ name' ->
377 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
379 -- Mark any PackageTarget style imports as coming from the current package
380 let packageId = thisPackage $ hsc_dflags topEnv
381 spec' = patchForeignImport packageId spec
383 in return (ForeignImport name' ty' spec', fvs)
385 rnHsForeignDecl (ForeignExport name ty spec)
386 = lookupLocatedOccRn name `thenM` \ name' ->
387 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
388 return (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
389 -- NB: a foreign export is an *occurrence site* for name, so
390 -- we add it to the free-variable list. It might, for example,
391 -- be imported from another module
393 fo_decl_msg :: Located RdrName -> SDoc
394 fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
397 -- | For Windows DLLs we need to know what packages imported symbols are from
398 -- to generate correct calls. Imported symbols are tagged with the current
399 -- package, so if they get inlined across a package boundry we'll still
400 -- know where they're from.
402 patchForeignImport :: PackageId -> ForeignImport -> ForeignImport
403 patchForeignImport packageId (CImport cconv safety fs spec)
404 = CImport cconv safety fs (patchCImportSpec packageId spec)
406 patchCImportSpec :: PackageId -> CImportSpec -> CImportSpec
407 patchCImportSpec packageId spec
409 CFunction callTarget -> CFunction $ patchCCallTarget packageId callTarget
412 patchCCallTarget :: PackageId -> CCallTarget -> CCallTarget
413 patchCCallTarget packageId callTarget
415 StaticTarget label Nothing
416 -> StaticTarget label (Just packageId)
424 %*********************************************************
426 \subsection{Instance declarations}
428 %*********************************************************
431 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
432 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
433 -- Used for both source and interface file decls
434 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
436 -- Rename the bindings
437 -- The typechecker (not the renamer) checks that all
438 -- the bindings are for the right class
440 meth_names = collectHsBindLocatedBinders mbinds
441 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
443 checkDupRdrNames meth_names `thenM_`
444 -- Check that the same method is not given twice in the
445 -- same instance decl instance C T where
449 -- We must use checkDupRdrNames because the Name of the
450 -- method is the Name of the class selector, whose SrcSpan
451 -- points to the class declaration
453 extendTyVarEnvForMethodBinds inst_tyvars (
454 -- (Slightly strangely) the forall-d tyvars scope over
455 -- the method bindings too
456 rnMethodBinds cls (\_ -> []) -- No scoped tyvars
458 ) `thenM` \ (mbinds', meth_fvs) ->
459 -- Rename the associated types
460 -- The typechecker (not the renamer) checks that all
461 -- the declarations are for the right class
463 at_names = map (head . tyClDeclNames . unLoc) ats
465 checkDupRdrNames at_names `thenM_`
466 -- See notes with checkDupRdrNames for methods, above
468 rnATInsts ats `thenM` \ (ats', at_fvs) ->
470 -- Rename the prags and signatures.
471 -- Note that the type variables are not in scope here,
472 -- so that instance Eq a => Eq (T a) where
473 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
476 -- But the (unqualified) method names are in scope
478 binders = collectHsBindBinders mbinds'
479 bndr_set = mkNameSet binders
481 bindLocalNames binders
482 (renameSigs (Just bndr_set) okInstDclSig uprags) `thenM` \ uprags' ->
484 return (InstDecl inst_ty' mbinds' uprags' ats',
485 meth_fvs `plusFV` at_fvs
486 `plusFV` hsSigsFVs uprags'
487 `plusFV` extractHsTyNames inst_ty')
488 -- We return the renamed associated data type declarations so
489 -- that they can be entered into the list of type declarations
490 -- for the binding group, but we also keep a copy in the instance.
491 -- The latter is needed for well-formedness checks in the type
492 -- checker (eg, to ensure that all ATs of the instance actually
493 -- receive a declaration).
494 -- NB: Even the copies in the instance declaration carry copies of
495 -- the instance context after renaming. This is a bit
496 -- strange, but should not matter (and it would be more work
497 -- to remove the context).
500 Renaming of the associated types in instances.
503 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
504 rnATInsts atDecls = rnList rnATInst atDecls
506 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
507 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
509 pprPanic "RnSource.rnATInsts: invalid AT instance"
510 (ppr (tcdName tydecl))
513 For the method bindings in class and instance decls, we extend the
514 type variable environment iff -fglasgow-exts
517 extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
518 -> RnM (Bag (LHsBind Name), FreeVars)
519 -> RnM (Bag (LHsBind Name), FreeVars)
520 extendTyVarEnvForMethodBinds tyvars thing_inside
521 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
523 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
528 %*********************************************************
530 \subsection{Stand-alone deriving declarations}
532 %*********************************************************
535 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
536 rnSrcDerivDecl (DerivDecl ty)
537 = do { standalone_deriv_ok <- doptM Opt_StandaloneDeriving
538 ; unless standalone_deriv_ok (addErr standaloneDerivErr)
539 ; ty' <- rnLHsType (text "a deriving decl") ty
540 ; let fvs = extractHsTyNames ty'
541 ; return (DerivDecl ty', fvs) }
543 standaloneDerivErr :: SDoc
545 = hang (ptext (sLit "Illegal standalone deriving declaration"))
546 2 (ptext (sLit "Use -XStandaloneDeriving to enable this extension"))
549 %*********************************************************
553 %*********************************************************
556 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
557 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
558 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
559 bindLocatedLocalsFV (map get_var vars) $ \ ids ->
560 do { (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
561 -- NB: The binders in a rule are always Ids
562 -- We don't (yet) support type variables
564 ; (lhs', fv_lhs') <- rnLExpr lhs
565 ; (rhs', fv_rhs') <- rnLExpr rhs
567 ; checkValidRule rule_name ids lhs' fv_lhs'
569 ; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
570 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
572 doc = text "In the transformation rule" <+> ftext rule_name
574 get_var (RuleBndr v) = v
575 get_var (RuleBndrSig v _) = v
577 rn_var (RuleBndr (L loc _), id)
578 = return (RuleBndr (L loc id), emptyFVs)
579 rn_var (RuleBndrSig (L loc _) t, id)
580 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
581 return (RuleBndrSig (L loc id) t', fvs)
583 badRuleVar :: FastString -> Name -> SDoc
585 = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
586 ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
587 ptext (sLit "does not appear on left hand side")]
590 Note [Rule LHS validity checking]
591 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
592 Check the shape of a transformation rule LHS. Currently we only allow
593 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
594 @forall@'d variables.
596 We used restrict the form of the 'ei' to prevent you writing rules
597 with LHSs with a complicated desugaring (and hence unlikely to match);
598 (e.g. a case expression is not allowed: too elaborate.)
600 But there are legitimate non-trivial args ei, like sections and
601 lambdas. So it seems simmpler not to check at all, and that is why
602 check_e is commented out.
605 checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
606 checkValidRule rule_name ids lhs' fv_lhs'
607 = do { -- Check for the form of the LHS
608 case (validRuleLhs ids lhs') of
610 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
612 -- Check that LHS vars are all bound
613 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
614 ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
616 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
618 -- Just e => Not ok, and e is the offending expression
619 validRuleLhs foralls lhs
622 checkl (L _ e) = check e
624 check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
625 check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
626 check (HsVar v) | v `notElem` foralls = Nothing
627 check other = Just other -- Failure
630 checkl_e (L _ _e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
632 {- Commented out; see Note [Rule LHS validity checking] above
633 check_e (HsVar v) = Nothing
634 check_e (HsPar e) = checkl_e e
635 check_e (HsLit e) = Nothing
636 check_e (HsOverLit e) = Nothing
638 check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
639 check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
640 check_e (NegApp e _) = checkl_e e
641 check_e (ExplicitList _ es) = checkl_es es
642 check_e other = Just other -- Fails
644 checkl_es es = foldr (mplus . checkl_e) Nothing es
647 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
648 badRuleLhsErr name lhs bad_e
649 = sep [ptext (sLit "Rule") <+> ftext name <> colon,
650 nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
651 ptext (sLit "in left-hand side:") <+> ppr lhs])]
653 ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
657 %*********************************************************
659 \subsection{Type, class and iface sig declarations}
661 %*********************************************************
663 @rnTyDecl@ uses the `global name function' to create a new type
664 declaration in which local names have been replaced by their original
665 names, reporting any unknown names.
667 Renaming type variables is a pain. Because they now contain uniques,
668 it is necessary to pass in an association list which maps a parsed
669 tyvar to its @Name@ representation.
670 In some cases (type signatures of values),
671 it is even necessary to go over the type first
672 in order to get the set of tyvars used by it, make an assoc list,
673 and then go over it again to rename the tyvars!
674 However, we can also do some scoping checks at the same time.
677 rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
678 rnTyClDecl (ForeignType {tcdLName = name, tcdExtName = ext_name})
679 = lookupLocatedTopBndrRn name `thenM` \ name' ->
680 return (ForeignType {tcdLName = name', tcdExtName = ext_name},
683 -- all flavours of type family declarations ("type family", "newtype fanily",
684 -- and "data family")
685 rnTyClDecl (tydecl@TyFamily {}) =
686 rnFamily tydecl bindTyVarsRn
688 -- "data", "newtype", "data instance, and "newtype instance" declarations
689 rnTyClDecl tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
690 tcdLName = tycon, tcdTyVars = tyvars,
691 tcdTyPats = typatsMaybe, tcdCons = condecls,
692 tcdKindSig = sig, tcdDerivs = derivs}
693 = do { tycon' <- if isFamInstDecl tydecl
694 then lookupLocatedOccRn tycon -- may be imported family
695 else lookupLocatedTopBndrRn tycon
696 ; checkTc (h98_style || null (unLoc context))
697 (badGadtStupidTheta tycon)
698 ; (tyvars', context', typats', derivs', deriv_fvs)
699 <- bindTyVarsRn tyvars $ \ tyvars' -> do
700 -- Checks for distinct tyvars
701 { typats' <- rnTyPats data_doc typatsMaybe
702 ; context' <- rnContext data_doc context
703 ; (derivs', deriv_fvs) <- rn_derivs derivs
704 ; return (tyvars', context', typats', derivs', deriv_fvs) }
705 -- For GADTs, the type variables in the declaration
706 -- do not scope over the constructor signatures
707 -- data T a where { T1 :: forall b. b-> b }
709 -- For the constructor declarations, bring into scope the tyvars
710 -- bound by the header, but *only* in the H98 case
711 ; let tc_tvs_in_scope | h98_style = hsLTyVarNames tyvars'
713 ; (condecls', con_fvs) <- bindLocalNamesFV tc_tvs_in_scope $
715 -- No need to check for duplicate constructor decls
716 -- since that is done by RnNames.extendGlobalRdrEnvRn
718 ; return (TyData {tcdND = new_or_data, tcdCtxt = context',
719 tcdLName = tycon', tcdTyVars = tyvars',
720 tcdTyPats = typats', tcdKindSig = sig,
721 tcdCons = condecls', tcdDerivs = derivs'},
724 (if isFamInstDecl tydecl
725 then unitFV (unLoc tycon') -- type instance => use
729 h98_style = case condecls of -- Note [Stupid theta]
730 L _ (ConDecl { con_res = ResTyGADT {} }) : _ -> False
733 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
735 rn_derivs Nothing = return (Nothing, emptyFVs)
736 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
737 return (Just ds', extractHsTyNames_s ds')
739 -- "type" and "type instance" declarations
740 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
741 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
742 = bindTyVarsRn tyvars $ \ tyvars' -> do
743 { -- Checks for distinct tyvars
744 name' <- if isFamInstDecl tydecl
745 then lookupLocatedOccRn name -- may be imported family
746 else lookupLocatedTopBndrRn name
747 ; typats' <- rnTyPats syn_doc typatsMaybe
748 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
749 ; return (TySynonym { tcdLName = name', tcdTyVars = tyvars'
750 , tcdTyPats = typats', tcdSynRhs = ty'},
751 delFVs (map hsLTyVarName tyvars') $
753 (if isFamInstDecl tydecl
754 then unitFV (unLoc name') -- type instance => use
758 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
760 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
761 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
762 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
763 = do { cname' <- lookupLocatedTopBndrRn cname
765 -- Tyvars scope over superclass context and method signatures
766 ; (tyvars', context', fds', ats', ats_fvs, sigs')
767 <- bindTyVarsRn tyvars $ \ tyvars' -> do
768 -- Checks for distinct tyvars
769 { context' <- rnContext cls_doc context
770 ; fds' <- rnFds cls_doc fds
771 ; (ats', ats_fvs) <- rnATs ats
772 ; sigs' <- renameSigs Nothing okClsDclSig sigs
773 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
775 -- No need to check for duplicate associated type decls
776 -- since that is done by RnNames.extendGlobalRdrEnvRn
778 -- Check the signatures
779 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
780 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
781 ; checkDupRdrNames sig_rdr_names_w_locs
782 -- Typechecker is responsible for checking that we only
783 -- give default-method bindings for things in this class.
784 -- The renamer *could* check this for class decls, but can't
785 -- for instance decls.
787 -- The newLocals call is tiresome: given a generic class decl
790 -- op {| x+y |} (Inl a) = ...
791 -- op {| x+y |} (Inr b) = ...
792 -- op {| a*b |} (a*b) = ...
793 -- we want to name both "x" tyvars with the same unique, so that they are
794 -- easy to group together in the typechecker.
795 ; (mbinds', meth_fvs)
796 <- extendTyVarEnvForMethodBinds tyvars' $ do
797 { name_env <- getLocalRdrEnv
798 ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
799 not (unLoc tv `elemLocalRdrEnv` name_env) ]
800 -- No need to check for duplicate method signatures
801 -- since that is done by RnNames.extendGlobalRdrEnvRn
802 -- and the methods are already in scope
803 ; gen_tyvars <- newLocalBndrsRn gen_rdr_tyvars_w_locs
804 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
807 ; docs' <- mapM (wrapLocM rnDocDecl) docs
809 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
810 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
811 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
813 delFVs (map hsLTyVarName tyvars') $
814 extractHsCtxtTyNames context' `plusFV`
815 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
816 hsSigsFVs sigs' `plusFV`
820 cls_doc = text "In the declaration for class" <+> ppr cname
822 badGadtStupidTheta :: Located RdrName -> SDoc
824 = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
825 ptext (sLit "(You can put a context on each contructor, though.)")]
830 Trac #3850 complains about a regression wrt 6.10 for
832 There is no reason not to allow the stupid theta if there are no data
833 constructors. It's still stupid, but does no harm, and I don't want
834 to cause programs to break unnecessarily (notably HList). So if there
835 are no data constructors we allow h98_style = True
838 %*********************************************************
840 \subsection{Support code for type/data declarations}
842 %*********************************************************
845 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
846 -- Although, we are processing type patterns here, all type variables will
847 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
848 -- type declaration to which these patterns belong)
849 rnTyPats _ Nothing = return Nothing
850 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
852 rnConDecls :: [LConDecl RdrName] -> RnM ([LConDecl Name], FreeVars)
854 = do { condecls' <- mapM (wrapLocM rnConDecl) condecls
855 ; return (condecls', plusFVs (map conDeclFVs condecls')) }
857 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
858 rnConDecl decl@(ConDecl { con_name = name, con_qvars = tvs
859 , con_cxt = cxt, con_details = details
860 , con_res = res_ty, con_doc = mb_doc
861 , con_old_rec = old_rec, con_explicit = expl })
862 = do { addLocM checkConName name
863 ; when old_rec (addWarn (deprecRecSyntax decl))
864 ; new_name <- lookupLocatedTopBndrRn name
866 -- For H98 syntax, the tvs are the existential ones
867 -- For GADT syntax, the tvs are all the quantified tyvars
868 -- Hence the 'filter' in the ResTyH98 case only
869 ; rdr_env <- getLocalRdrEnv
870 ; let in_scope = (`elemLocalRdrEnv` rdr_env) . unLoc
871 arg_tys = hsConDeclArgTys details
872 implicit_tvs = case res_ty of
873 ResTyH98 -> filterOut in_scope (get_rdr_tvs arg_tys)
874 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
875 new_tvs = case expl of
877 Implicit -> userHsTyVarBndrs implicit_tvs
879 ; mb_doc' <- rnMbLHsDoc mb_doc
881 ; bindTyVarsRn new_tvs $ \new_tyvars -> do
882 { new_context <- rnContext doc cxt
883 ; new_details <- rnConDeclDetails doc details
884 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
885 ; return (decl { con_name = new_name, con_qvars = new_tyvars, con_cxt = new_context
886 , con_details = new_details', con_res = new_res_ty, con_doc = mb_doc' }) }}
888 doc = text "In the definition of data constructor" <+> quotes (ppr name)
889 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
892 -> HsConDetails (LHsType Name) [ConDeclField Name]
894 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
896 rnConResult _ details ResTyH98 = return (details, ResTyH98)
897 rnConResult doc details (ResTyGADT ty)
898 = do { ty' <- rnLHsType doc ty
899 ; let (arg_tys, res_ty) = splitHsFunType ty'
900 -- We can finally split it up,
901 -- now the renamer has dealt with fixities
902 -- See Note [Sorting out the result type] in RdrHsSyn
904 details' = case details of
906 PrefixCon {} -> PrefixCon arg_tys
907 InfixCon {} -> pprPanic "rnConResult" (ppr ty)
908 -- See Note [Sorting out the result type] in RdrHsSyn
910 ; when (not (null arg_tys) && case details of { RecCon {} -> True; _ -> False })
911 (addErr (badRecResTy doc))
912 ; return (details', ResTyGADT res_ty) }
914 rnConDeclDetails :: SDoc
915 -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
916 -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
917 rnConDeclDetails doc (PrefixCon tys)
918 = mapM (rnLHsType doc) tys `thenM` \ new_tys ->
919 return (PrefixCon new_tys)
921 rnConDeclDetails doc (InfixCon ty1 ty2)
922 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
923 rnLHsType doc ty2 `thenM` \ new_ty2 ->
924 return (InfixCon new_ty1 new_ty2)
926 rnConDeclDetails doc (RecCon fields)
927 = do { new_fields <- rnConDeclFields doc fields
928 -- No need to check for duplicate fields
929 -- since that is done by RnNames.extendGlobalRdrEnvRn
930 ; return (RecCon new_fields) }
932 -- Rename family declarations
934 -- * This function is parametrised by the routine handling the index
935 -- variables. On the toplevel, these are defining occurences, whereas they
936 -- are usage occurences for associated types.
938 rnFamily :: TyClDecl RdrName
939 -> ([LHsTyVarBndr RdrName] ->
940 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
941 RnM (TyClDecl Name, FreeVars))
942 -> RnM (TyClDecl Name, FreeVars)
944 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
945 tcdLName = tycon, tcdTyVars = tyvars})
947 do { bindIdxVars tyvars $ \tyvars' -> do {
948 ; tycon' <- lookupLocatedTopBndrRn tycon
949 ; return (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
950 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
953 rnFamily d _ = pprPanic "rnFamily" (ppr d)
955 -- Rename associated type declarations (in classes)
957 -- * This can be family declarations and (default) type instances
959 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
960 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
962 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
963 rn_at (tydecl@TySynonym {}) =
965 unless (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
967 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
969 lookupIdxVars tyvars cont =
970 do { checkForDups tyvars;
971 ; tyvars' <- mapM lookupIdxVar tyvars
974 -- Type index variables must be class parameters, which are the only
975 -- type variables in scope at this point.
976 lookupIdxVar (L l tyvar) =
978 name' <- lookupOccRn (hsTyVarName tyvar)
979 return $ L l (replaceTyVarName tyvar name')
981 -- Type variable may only occur once.
983 checkForDups [] = return ()
984 checkForDups (L loc tv:ltvs) =
985 do { setSrcSpan loc $
986 when (hsTyVarName tv `ltvElem` ltvs) $
987 addErr (repeatedTyVar tv)
991 _ `ltvElem` [] = False
992 rdrName `ltvElem` (L _ tv:ltvs)
993 | rdrName == hsTyVarName tv = True
994 | otherwise = rdrName `ltvElem` ltvs
996 deprecRecSyntax :: ConDecl RdrName -> SDoc
998 = vcat [ ptext (sLit "Declaration of") <+> quotes (ppr (con_name decl))
999 <+> ptext (sLit "uses deprecated syntax")
1000 , ptext (sLit "Instead, use the form")
1001 , nest 2 (ppr decl) ] -- Pretty printer uses new form
1003 badRecResTy :: SDoc -> SDoc
1004 badRecResTy doc = ptext (sLit "Malformed constructor signature") $$ doc
1007 noPatterns = text "Default definition for an associated synonym cannot have"
1008 <+> text "type pattern"
1010 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
1011 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
1014 -- This data decl will parse OK
1016 -- treating "a" as the constructor.
1017 -- It is really hard to make the parser spot this malformation.
1018 -- So the renamer has to check that the constructor is legal
1020 -- We can get an operator as the constructor, even in the prefix form:
1021 -- data T = :% Int Int
1022 -- from interface files, which always print in prefix form
1024 checkConName :: RdrName -> TcRn ()
1025 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1027 badDataCon :: RdrName -> SDoc
1029 = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
1033 %*********************************************************
1035 \subsection{Support code for type/data declarations}
1037 %*********************************************************
1039 Get the mapping from constructors to fields for this module.
1040 It's convenient to do this after the data type decls have been renamed
1042 extendRecordFieldEnv :: [LTyClDecl RdrName] -> [LInstDecl RdrName] -> TcM TcGblEnv
1043 extendRecordFieldEnv tycl_decls inst_decls
1044 = do { tcg_env <- getGblEnv
1045 ; field_env' <- foldrM get_con (tcg_field_env tcg_env) all_data_cons
1046 ; return (tcg_env { tcg_field_env = field_env' }) }
1048 -- we want to lookup:
1049 -- (a) a datatype constructor
1050 -- (b) a record field
1051 -- knowing that they're from this module.
1052 -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1053 -- which keeps only the local ones.
1054 lookup x = do { x' <- lookupLocatedTopBndrRn x
1055 ; return $ unLoc x'}
1057 all_data_cons :: [ConDecl RdrName]
1058 all_data_cons = [con | L _ (TyData { tcdCons = cons }) <- all_tycl_decls
1060 all_tycl_decls = at_tycl_decls ++ tycl_decls
1061 at_tycl_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
1062 -- Do not forget associated types!
1064 get_con (ConDecl { con_name = con, con_details = RecCon flds })
1065 (RecFields env fld_set)
1066 = do { con' <- lookup con
1067 ; flds' <- mapM lookup (map cd_fld_name flds)
1068 ; let env' = extendNameEnv env con' flds'
1069 fld_set' = addListToNameSet fld_set flds'
1070 ; return $ (RecFields env' fld_set') }
1071 get_con _ env = return env
1074 %*********************************************************
1076 \subsection{Support code to rename types}
1078 %*********************************************************
1081 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1084 = mapM (wrapLocM rn_fds) fds
1087 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
1088 rnHsTyVars doc tys2 `thenM` \ tys2' ->
1089 return (tys1', tys2')
1091 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1092 rnHsTyVars doc tvs = mapM (rnHsTyVar doc) tvs
1094 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1095 rnHsTyVar _doc tyvar = lookupOccRn tyvar