2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
8 rnSrcDecls, rnExtCoreDecls, checkModDeprec,
9 rnTyClDecl, rnIfaceRuleDecl, rnInstDecl,
13 #include "HsVersions.h"
17 import RdrName ( RdrName, isRdrDataCon, elemRdrEnv )
18 import RdrHsSyn ( RdrNameConDecl, RdrNameTyClDecl, RdrNameHsDecl,
19 RdrNameDeprecation, RdrNameFixitySig,
21 extractGenericPatTyVars
26 import RnNames ( importsFromLocalDecls )
27 import RnTypes ( rnHsType, rnHsSigType, rnHsTypeFVs, rnContext )
29 import RnBinds ( rnTopMonoBinds, rnMonoBinds, rnMethodBinds,
30 renameSigs, renameSigsFVs )
31 import RnEnv ( lookupTopBndrRn, lookupOccRn, lookupSysBndr,
32 newLocalsRn, lookupGlobalOccRn,
33 bindLocalsFVRn, bindPatSigTyVars,
34 bindTyVarsRn, extendTyVarEnvFVRn,
35 bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
36 checkDupOrQualNames, checkDupNames, mapFvRn,
37 lookupTopSrcBndr_maybe, lookupTopSrcBndr,
38 dataTcOccs, unknownNameErr,
43 import BasicTypes ( FixitySig(..) )
44 import HscTypes ( ExternalPackageState(..), FixityEnv,
45 Deprecations(..), plusDeprecs )
46 import Module ( moduleEnvElts )
47 import Class ( FunDep, DefMeth (..) )
48 import TyCon ( DataConDetails(..), visibleDataCons )
52 import ErrUtils ( dumpIfSet )
53 import PrelNames ( newStablePtrName, bindIOName, returnIOName )
54 import List ( partition )
55 import Bag ( bagToList )
57 import SrcLoc ( SrcLoc )
58 import CmdLineOpts ( DynFlag(..) )
59 -- Warn of unused for-all'd tyvars
60 import Maybes ( maybeToBool, seqMaybe )
61 import Maybe ( maybe, catMaybes, isNothing )
64 @rnSourceDecl@ `renames' declarations.
65 It simultaneously performs dependency analysis and precedence parsing.
66 It also does the following error checks:
69 Checks that tyvars are used properly. This includes checking
70 for undefined tyvars, and tyvars in contexts that are ambiguous.
71 (Some of this checking has now been moved to module @TcMonoType@,
72 since we don't have functional dependency information at this point.)
74 Checks that all variable occurences are defined.
76 Checks the @(..)@ etc constraints in the export list.
81 rnSrcDecls :: [RdrNameHsDecl] -> RnM (TcGblEnv, [RenamedHsDecl], FreeVars)
84 = do { (rdr_env, imports) <- importsFromLocalDecls decls ;
85 updGblEnv (\gbl -> gbl { tcg_rdr_env = rdr_env `plusGlobalRdrEnv`
87 tcg_imports = imports `plusImportAvails`
91 -- Deal with deprecations (returns only the extra deprecations)
92 deprecs <- rnSrcDeprecDecls [d | DeprecD d <- decls] ;
93 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
96 -- Deal with top-level fixity decls
97 -- (returns the total new fixity env)
98 fix_env <- rnSrcFixityDecls decls ;
99 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
102 -- Rename remaining declarations
103 (rn_src_decls, src_fvs) <- rn_src_decls decls ;
105 tcg_env <- getGblEnv ;
106 return (tcg_env, rn_src_decls, src_fvs)
109 rnExtCoreDecls :: [RdrNameHsDecl] -> RnM ([RenamedHsDecl], FreeVars)
110 rnExtCoreDecls decls = rn_src_decls decls
112 rn_src_decls decls -- Declarartions get reversed, but no matter
113 = go emptyFVs [] decls
115 -- Fixity and deprecations have been dealt with already; ignore them
116 go fvs ds' [] = returnM (ds', fvs)
117 go fvs ds' (FixD _:ds) = go fvs ds' ds
118 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
119 go fvs ds' (d:ds) = rnSrcDecl d `thenM` \(d', fvs') ->
120 go (fvs `plusFV` fvs') (d':ds') ds
124 %*********************************************************
126 Source-code fixity declarations
128 %*********************************************************
131 rnSrcFixityDecls :: [RdrNameHsDecl] -> TcRn m FixityEnv
132 rnSrcFixityDecls decls
133 = getGblEnv `thenM` \ gbl_env ->
134 foldlM rnFixityDecl (tcg_fix_env gbl_env)
135 fix_decls `thenM` \ fix_env ->
136 traceRn (text "fixity env" <+> ppr fix_env) `thenM_`
139 fix_decls = foldr get_fix_sigs [] decls
141 -- Get fixities from top level decls, and from class decl sigs too
142 get_fix_sigs (FixD fix) acc = fix:acc
143 get_fix_sigs (TyClD (ClassDecl { tcdSigs = sigs})) acc
144 = [sig | FixSig sig <- sigs] ++ acc
145 get_fix_sigs other_decl acc = acc
147 rnFixityDecl :: FixityEnv -> RdrNameFixitySig -> TcRn m FixityEnv
148 rnFixityDecl fix_env (FixitySig rdr_name fixity loc)
149 = -- GHC extension: look up both the tycon and data con
150 -- for con-like things
151 -- If neither are in scope, report an error; otherwise
152 -- add both to the fixity env
153 mappM lookupTopSrcBndr_maybe (dataTcOccs rdr_name) `thenM` \ maybe_ns ->
154 case catMaybes maybe_ns of
155 [] -> addSrcLoc loc $
156 addErr (unknownNameErr rdr_name) `thenM_`
158 ns -> foldlM add fix_env ns
161 = case lookupNameEnv fix_env name of
162 Just (FixitySig _ _ loc') -> addErr (dupFixityDecl rdr_name loc loc') `thenM_`
164 Nothing -> returnM (extendNameEnv fix_env name (FixitySig name fixity loc))
166 dupFixityDecl rdr_name loc1 loc2
167 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
168 ptext SLIT("at ") <+> ppr loc1,
169 ptext SLIT("and") <+> ppr loc2]
173 %*********************************************************
175 Source-code deprecations declarations
177 %*********************************************************
179 For deprecations, all we do is check that the names are in scope.
180 It's only imported deprecations, dealt with in RnIfaces, that we
181 gather them together.
184 rnSrcDeprecDecls :: [RdrNameDeprecation] -> TcRn m Deprecations
188 rnSrcDeprecDecls decls
189 = mappM rn_deprec decls `thenM` \ pairs ->
190 returnM (DeprecSome (mkNameEnv (catMaybes pairs)))
192 rn_deprec (Deprecation rdr_name txt loc)
194 lookupTopSrcBndr rdr_name `thenM` \ name ->
195 returnM (Just (name, (name,txt)))
197 checkModDeprec :: Maybe DeprecTxt -> Deprecations
198 -- Check for a module deprecation; done once at top level
199 checkModDeprec Nothing = NoDeprecs
200 checkModdeprec (Just txt) = DeprecAll txt
203 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
207 %*********************************************************
209 \subsection{Source code declarations}
211 %*********************************************************
214 rnSrcDecl :: RdrNameHsDecl -> RnM (RenamedHsDecl, FreeVars)
216 rnSrcDecl (ValD binds) = rnTopBinds binds `thenM` \ (new_binds, fvs) ->
217 returnM (ValD new_binds, fvs)
219 rnSrcDecl (TyClD tycl_decl)
220 = rnTyClDecl tycl_decl `thenM` \ new_decl ->
221 finishSourceTyClDecl tycl_decl new_decl `thenM` \ (new_decl', fvs) ->
222 returnM (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
224 rnSrcDecl (InstD inst)
225 = rnInstDecl inst `thenM` \ new_inst ->
226 finishSourceInstDecl inst new_inst `thenM` \ (new_inst', fvs) ->
227 returnM (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
229 rnSrcDecl (RuleD rule)
230 = rnHsRuleDecl rule `thenM` \ (new_rule, fvs) ->
231 returnM (RuleD new_rule, fvs)
233 rnSrcDecl (ForD ford)
234 = rnHsForeignDecl ford `thenM` \ (new_ford, fvs) ->
235 returnM (ForD new_ford, fvs)
237 rnSrcDecl (DefD (DefaultDecl tys src_loc))
238 = addSrcLoc src_loc $
239 mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
240 returnM (DefD (DefaultDecl tys' src_loc), fvs)
242 doc_str = text "In a `default' declaration"
245 rnSrcDecl (CoreD (CoreDecl name ty rhs loc))
247 lookupTopBndrRn name `thenM` \ name' ->
248 rnHsTypeFVs doc_str ty `thenM` \ (ty', ty_fvs) ->
249 rnCoreExpr rhs `thenM` \ rhs' ->
250 returnM (CoreD (CoreDecl name' ty' rhs' loc),
251 ty_fvs `plusFV` ufExprFVs rhs')
253 doc_str = text "In the Core declaration for" <+> quotes (ppr name)
256 %*********************************************************
260 %*********************************************************
262 These chaps are here, rather than in TcBinds, so that there
263 is just one hi-boot file (for RnSource). rnSrcDecls is part
264 of the loop too, and it must be defined in this module.
267 rnTopBinds :: RdrNameHsBinds -> RnM (RenamedHsBinds, FreeVars)
268 rnTopBinds EmptyBinds = returnM (EmptyBinds, emptyFVs)
269 rnTopBinds (MonoBind bind sigs _) = rnTopMonoBinds bind sigs
270 -- The parser doesn't produce other forms
272 rnBinds :: RdrNameHsBinds
273 -> (RenamedHsBinds -> RnM (result, FreeVars))
274 -> RnM (result, FreeVars)
275 rnBinds EmptyBinds thing_inside = thing_inside EmptyBinds
276 rnBinds (MonoBind bind sigs _) thing_inside = rnMonoBinds bind sigs thing_inside
277 -- the parser doesn't produce other forms
281 %*********************************************************
283 \subsection{Foreign declarations}
285 %*********************************************************
288 rnHsForeignDecl (ForeignImport name ty spec isDeprec src_loc)
289 = addSrcLoc src_loc $
290 lookupTopBndrRn name `thenM` \ name' ->
291 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
292 returnM (ForeignImport name' ty' spec isDeprec src_loc,
293 fvs `plusFV` extras spec)
295 extras (CImport _ _ _ _ CWrapper) = mkFVs [newStablePtrName,
296 bindIOName, returnIOName]
299 rnHsForeignDecl (ForeignExport name ty spec isDeprec src_loc)
300 = addSrcLoc src_loc $
301 lookupOccRn name `thenM` \ name' ->
302 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
303 returnM (ForeignExport name' ty' spec isDeprec src_loc,
304 mkFVs [name', bindIOName, returnIOName] `plusFV` fvs )
305 -- NB: a foreign export is an *occurrence site* for name, so
306 -- we add it to the free-variable list. It might, for example,
307 -- be imported from another module
309 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
313 %*********************************************************
315 \subsection{Instance declarations}
317 %*********************************************************
320 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
321 -- Used for both source and interface file decls
322 = addSrcLoc src_loc $
323 rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
325 (case maybe_dfun_rdr_name of
326 Nothing -> returnM Nothing
327 Just dfun_rdr_name -> lookupGlobalOccRn dfun_rdr_name `thenM` \ dfun_name ->
328 returnM (Just dfun_name)
329 ) `thenM` \ maybe_dfun_name ->
331 -- The typechecker checks that all the bindings are for the right class.
332 returnM (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
334 -- Compare finishSourceTyClDecl
335 finishSourceInstDecl (InstDecl _ mbinds uprags _ _ )
336 (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
337 -- Used for both source decls only
338 = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
340 meth_doc = text "In the bindings in an instance declaration"
341 meth_names = collectLocatedMonoBinders mbinds
342 (inst_tyvars, _, cls,_) = splitHsInstDeclTy inst_ty
343 -- (Slightly strangely) the forall-d tyvars scope over
344 -- the method bindings too
347 -- Rename the bindings
348 -- NB meth_names can be qualified!
349 checkDupNames meth_doc meth_names `thenM_`
350 extendTyVarEnvForMethodBinds inst_tyvars (
351 rnMethodBinds cls [] mbinds
352 ) `thenM` \ (mbinds', meth_fvs) ->
354 binders = collectMonoBinders mbinds'
355 binder_set = mkNameSet binders
357 -- Rename the prags and signatures.
358 -- Note that the type variables are not in scope here,
359 -- so that instance Eq a => Eq (T a) where
360 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
363 -- But the (unqualified) method names are in scope
364 bindLocalNames binders (
365 renameSigsFVs (okInstDclSig binder_set) uprags
366 ) `thenM` \ (uprags', prag_fvs) ->
368 returnM (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
369 meth_fvs `plusFV` prag_fvs)
372 %*********************************************************
376 %*********************************************************
379 rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
380 = addSrcLoc src_loc $
381 lookupOccRn fn `thenM` \ fn' ->
382 rnCoreBndrs vars $ \ vars' ->
383 mappM rnCoreExpr args `thenM` \ args' ->
384 rnCoreExpr rhs `thenM` \ rhs' ->
385 returnM (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
387 rnIfaceRuleDecl (IfaceRuleOut fn rule) -- Builtin rules come this way
388 = lookupOccRn fn `thenM` \ fn' ->
389 returnM (IfaceRuleOut fn' rule)
391 rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
392 = addSrcLoc src_loc $
393 bindPatSigTyVars (collectRuleBndrSigTys vars) $
395 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
396 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
398 rnExpr lhs `thenM` \ (lhs', fv_lhs) ->
399 rnExpr rhs `thenM` \ (rhs', fv_rhs) ->
401 mb_bad = validRuleLhs ids lhs'
403 checkErr (isNothing mb_bad)
404 (badRuleLhsErr rule_name lhs' mb_bad) `thenM_`
406 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
408 mappM (addErr . badRuleVar rule_name) bad_vars `thenM_`
409 returnM (HsRule rule_name act vars' lhs' rhs' src_loc,
410 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
412 doc = text "In the transformation rule" <+> ftext rule_name
414 get_var (RuleBndr v) = v
415 get_var (RuleBndrSig v _) = v
417 rn_var (RuleBndr v, id) = returnM (RuleBndr id, emptyFVs)
418 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
419 returnM (RuleBndrSig id t', fvs)
422 Check the shape of a transformation rule LHS. Currently
423 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
424 not one of the @forall@'d variables. We also restrict the form of the LHS so
425 that it may be plausibly matched. Basically you only get to write ordinary
426 applications. (E.g. a case expression is not allowed: too elaborate.)
428 NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
431 validRuleLhs :: [Name] -> RenamedHsExpr -> Maybe RenamedHsExpr
433 -- Just e => Not ok, and e is the offending expression
434 validRuleLhs foralls lhs
437 check (OpApp e1 op _ e2) = check op `seqMaybe` check_e e1 `seqMaybe` check_e e2
438 check (HsApp e1 e2) = check e1 `seqMaybe` check_e e2
439 check (HsVar v) | v `notElem` foralls = Nothing
440 check other = Just other -- Failure
442 check_e (HsVar v) = Nothing
443 check_e (HsPar e) = check_e e
444 check_e (HsLit e) = Nothing
445 check_e (HsOverLit e) = Nothing
447 check_e (OpApp e1 op _ e2) = check_e e1 `seqMaybe` check_e op `seqMaybe` check_e e2
448 check_e (HsApp e1 e2) = check_e e1 `seqMaybe` check_e e2
449 check_e (NegApp e _) = check_e e
450 check_e (ExplicitList _ es) = check_es es
451 check_e (ExplicitTuple es _) = check_es es
452 check_e other = Just other -- Fails
454 check_es es = foldr (seqMaybe . check_e) Nothing es
458 %*********************************************************
460 \subsection{Type, class and iface sig declarations}
462 %*********************************************************
464 @rnTyDecl@ uses the `global name function' to create a new type
465 declaration in which local names have been replaced by their original
466 names, reporting any unknown names.
468 Renaming type variables is a pain. Because they now contain uniques,
469 it is necessary to pass in an association list which maps a parsed
470 tyvar to its @Name@ representation.
471 In some cases (type signatures of values),
472 it is even necessary to go over the type first
473 in order to get the set of tyvars used by it, make an assoc list,
474 and then go over it again to rename the tyvars!
475 However, we can also do some scoping checks at the same time.
478 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
480 lookupTopBndrRn name `thenM` \ name' ->
481 rnHsType doc_str ty `thenM` \ ty' ->
482 mappM rnIdInfo id_infos `thenM` \ id_infos' ->
483 returnM (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
485 doc_str = text "In the interface signature for" <+> quotes (ppr name)
487 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
489 lookupTopBndrRn name `thenM` \ name' ->
490 returnM (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
492 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
493 tcdTyVars = tyvars, tcdCons = condecls, tcdGeneric = want_generic,
494 tcdDerivs = derivs, tcdLoc = src_loc})
495 = addSrcLoc src_loc $
496 lookupTopBndrRn tycon `thenM` \ tycon' ->
497 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
498 rnContext data_doc context `thenM` \ context' ->
499 rn_derivs derivs `thenM` \ derivs' ->
500 checkDupOrQualNames data_doc con_names `thenM_`
502 rnConDecls tycon' condecls `thenM` \ condecls' ->
503 returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
504 tcdTyVars = tyvars', tcdCons = condecls', tcdGeneric = want_generic,
505 tcdDerivs = derivs', tcdLoc = src_loc})
507 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
508 con_names = map conDeclName (visibleDataCons condecls)
510 rn_derivs Nothing = returnM Nothing
511 rn_derivs (Just ds) = rnContext data_doc ds `thenM` \ ds' -> returnM (Just ds')
513 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
514 = addSrcLoc src_loc $
515 lookupTopBndrRn name `thenM` \ name' ->
516 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
517 rnHsType syn_doc ty `thenM` \ ty' ->
518 returnM (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
520 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
522 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
523 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
525 -- Used for both source and interface file decls
526 = addSrcLoc src_loc $
528 lookupTopBndrRn cname `thenM` \ cname' ->
530 -- Tyvars scope over superclass context and method signatures
531 bindTyVarsRn cls_doc tyvars $ \ tyvars' ->
533 -- Check the superclasses
534 rnContext cls_doc context `thenM` \ context' ->
536 -- Check the functional dependencies
537 rnFds cls_doc fds `thenM` \ fds' ->
539 -- Check the signatures
540 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
542 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
543 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
545 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenM_`
546 mappM (rnClassOp cname' fds') op_sigs `thenM` \ sigs' ->
548 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
550 renameSigs (okClsDclSig binders) non_op_sigs `thenM` \ non_ops' ->
552 -- Typechecker is responsible for checking that we only
553 -- give default-method bindings for things in this class.
554 -- The renamer *could* check this for class decls, but can't
555 -- for instance decls.
557 returnM (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
558 tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
561 cls_doc = text "In the declaration for class" <+> ppr cname
562 sig_doc = text "In the signatures for class" <+> ppr cname
564 rnClassOp clas clas_fds sig@(ClassOpSig op dm_stuff ty locn)
566 lookupTopBndrRn op `thenM` \ op_name ->
568 -- Check the signature
569 rnHsSigType (quotes (ppr op)) ty `thenM` \ new_ty ->
571 -- Make the default-method name
574 -> -- Imported class that has a default method decl
575 lookupSysBndr dm_rdr_name `thenM` \ dm_name ->
576 returnM (DefMeth dm_name)
577 -- An imported class decl for a class decl that had an explicit default
578 -- method, mentions, rather than defines,
579 -- the default method, so we must arrange to pull it in
581 GenDefMeth -> returnM GenDefMeth
582 NoDefMeth -> returnM NoDefMeth
583 ) `thenM` \ dm_stuff' ->
585 returnM (ClassOpSig op_name dm_stuff' new_ty locn)
587 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnM (RenamedTyClDecl, FreeVars)
588 -- Used for source file decls only
589 -- Renames the default-bindings of a class decl
590 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
591 rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars}) -- Everything else is here
592 -- There are some default-method bindings (abeit possibly empty) so
593 -- this is a source-code class declaration
594 = -- The newLocals call is tiresome: given a generic class decl
597 -- op {| x+y |} (Inl a) = ...
598 -- op {| x+y |} (Inr b) = ...
599 -- op {| a*b |} (a*b) = ...
600 -- we want to name both "x" tyvars with the same unique, so that they are
601 -- easy to group together in the typechecker.
604 extendTyVarEnvForMethodBinds tyvars $
605 getLocalRdrEnv `thenM` \ name_env ->
607 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
608 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
609 not (tv `elemRdrEnv` name_env)]
611 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenM_`
612 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
613 rnMethodBinds cls gen_tyvars mbinds `thenM` \ (mbinds', meth_fvs) ->
614 returnM (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
616 meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
618 finishSourceTyClDecl _ tycl_decl@(TyData {tcdDerivs = derivings})
619 -- Derivings are returned here so that they don't form part of the tyClDeclFVs.
620 -- This is important, because tyClDeclFVs should contain only the
621 -- FVs that are `needed' by the interface file declaration, and
622 -- derivings do not appear in this. It also means that the tcGroups
623 -- are smaller, which turned out to be important for the usage inference. KSW 2002-02.
624 = returnM (tycl_decl,
625 maybe emptyFVs extractHsCtxtTyNames derivings)
627 finishSourceTyClDecl _ tycl_decl = returnM (tycl_decl, emptyFVs)
628 -- Not a class declaration
631 For the method bindings in class and instance decls, we extend the
632 type variable environment iff -fglasgow-exts
635 extendTyVarEnvForMethodBinds tyvars thing_inside
636 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
637 if opt_GlasgowExts then
638 extendTyVarEnvFVRn (map hsTyVarName tyvars) thing_inside
644 %*********************************************************
646 \subsection{Support code for type/data declarations}
648 %*********************************************************
651 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
652 conDeclName (ConDecl n _ _ _ l) = (n,l)
654 rnConDecls :: Name -> DataConDetails RdrNameConDecl -> RnM (DataConDetails RenamedConDecl)
655 rnConDecls tycon Unknown = returnM Unknown
656 rnConDecls tycon (HasCons n) = returnM (HasCons n)
657 rnConDecls tycon (DataCons condecls)
658 = -- Check that there's at least one condecl,
659 -- or else we're reading an interface file, or -fglasgow-exts
660 (if null condecls then
661 doptM Opt_GlasgowExts `thenM` \ glaExts ->
662 getModeRn `thenM` \ mode ->
663 checkErr (glaExts || isInterfaceMode mode)
664 (emptyConDeclsErr tycon)
668 mappM rnConDecl condecls `thenM` \ condecls' ->
669 returnM (DataCons condecls')
671 rnConDecl :: RdrNameConDecl -> RnM RenamedConDecl
672 rnConDecl (ConDecl name tvs cxt details locn)
674 checkConName name `thenM_`
675 lookupTopBndrRn name `thenM` \ new_name ->
677 bindTyVarsRn doc tvs $ \ new_tyvars ->
678 rnContext doc cxt `thenM` \ new_context ->
679 rnConDetails doc locn details `thenM` \ new_details ->
680 returnM (ConDecl new_name new_tyvars new_context new_details locn)
682 doc = text "In the definition of data constructor" <+> quotes (ppr name)
684 rnConDetails doc locn (PrefixCon tys)
685 = mappM (rnBangTy doc) tys `thenM` \ new_tys ->
686 returnM (PrefixCon new_tys)
688 rnConDetails doc locn (InfixCon ty1 ty2)
689 = rnBangTy doc ty1 `thenM` \ new_ty1 ->
690 rnBangTy doc ty2 `thenM` \ new_ty2 ->
691 returnM (InfixCon new_ty1 new_ty2)
693 rnConDetails doc locn (RecCon fields)
694 = checkDupOrQualNames doc field_names `thenM_`
695 mappM (rnField doc) fields `thenM` \ new_fields ->
696 returnM (RecCon new_fields)
698 field_names = [(fld, locn) | (fld, _) <- fields]
700 rnField doc (name, ty)
701 = lookupTopBndrRn name `thenM` \ new_name ->
702 rnBangTy doc ty `thenM` \ new_ty ->
703 returnM (new_name, new_ty)
705 rnBangTy doc (BangType s ty)
706 = rnHsType doc ty `thenM` \ new_ty ->
707 returnM (BangType s new_ty)
709 -- This data decl will parse OK
711 -- treating "a" as the constructor.
712 -- It is really hard to make the parser spot this malformation.
713 -- So the renamer has to check that the constructor is legal
715 -- We can get an operator as the constructor, even in the prefix form:
716 -- data T = :% Int Int
717 -- from interface files, which always print in prefix form
720 = checkErr (isRdrDataCon name) (badDataCon name)
724 %*********************************************************
726 \subsection{Support code to rename types}
728 %*********************************************************
731 rnFds :: SDoc -> [FunDep RdrName] -> RnM [FunDep Name]
737 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
738 rnHsTyVars doc tys2 `thenM` \ tys2' ->
739 returnM (tys1', tys2')
741 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
742 rnHsTyvar doc tyvar = lookupOccRn tyvar
745 %*********************************************************
749 %*********************************************************
752 rnIdInfo (HsWorker worker arity)
753 = lookupOccRn worker `thenM` \ worker' ->
754 returnM (HsWorker worker' arity)
756 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenM` \ expr' ->
757 returnM (HsUnfold inline expr')
758 rnIdInfo (HsStrictness str) = returnM (HsStrictness str)
759 rnIdInfo (HsArity arity) = returnM (HsArity arity)
760 rnIdInfo HsNoCafRefs = returnM HsNoCafRefs
763 @UfCore@ expressions.
766 rnCoreExpr (UfType ty)
767 = rnHsType (text "unfolding type") ty `thenM` \ ty' ->
771 = lookupOccRn v `thenM` \ v' ->
777 rnCoreExpr (UfLitLit l ty)
778 = rnHsType (text "litlit") ty `thenM` \ ty' ->
779 returnM (UfLitLit l ty')
781 rnCoreExpr (UfFCall cc ty)
782 = rnHsType (text "ccall") ty `thenM` \ ty' ->
783 returnM (UfFCall cc ty')
785 rnCoreExpr (UfTuple (HsTupCon boxity arity) args)
786 = mappM rnCoreExpr args `thenM` \ args' ->
787 returnM (UfTuple (HsTupCon boxity arity) args')
789 rnCoreExpr (UfApp fun arg)
790 = rnCoreExpr fun `thenM` \ fun' ->
791 rnCoreExpr arg `thenM` \ arg' ->
792 returnM (UfApp fun' arg')
794 rnCoreExpr (UfCase scrut bndr alts)
795 = rnCoreExpr scrut `thenM` \ scrut' ->
796 bindCoreLocalRn bndr $ \ bndr' ->
797 mappM rnCoreAlt alts `thenM` \ alts' ->
798 returnM (UfCase scrut' bndr' alts')
800 rnCoreExpr (UfNote note expr)
801 = rnNote note `thenM` \ note' ->
802 rnCoreExpr expr `thenM` \ expr' ->
803 returnM (UfNote note' expr')
805 rnCoreExpr (UfLam bndr body)
806 = rnCoreBndr bndr $ \ bndr' ->
807 rnCoreExpr body `thenM` \ body' ->
808 returnM (UfLam bndr' body')
810 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
811 = rnCoreExpr rhs `thenM` \ rhs' ->
812 rnCoreBndr bndr $ \ bndr' ->
813 rnCoreExpr body `thenM` \ body' ->
814 returnM (UfLet (UfNonRec bndr' rhs') body')
816 rnCoreExpr (UfLet (UfRec pairs) body)
817 = rnCoreBndrs bndrs $ \ bndrs' ->
818 mappM rnCoreExpr rhss `thenM` \ rhss' ->
819 rnCoreExpr body `thenM` \ body' ->
820 returnM (UfLet (UfRec (bndrs' `zip` rhss')) body')
822 (bndrs, rhss) = unzip pairs
826 rnCoreBndr (UfValBinder name ty) thing_inside
827 = rnHsType doc ty `thenM` \ ty' ->
828 bindCoreLocalRn name $ \ name' ->
829 thing_inside (UfValBinder name' ty')
831 doc = text "unfolding id"
833 rnCoreBndr (UfTyBinder name kind) thing_inside
834 = bindCoreLocalRn name $ \ name' ->
835 thing_inside (UfTyBinder name' kind)
837 rnCoreBndrs [] thing_inside = thing_inside []
838 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
839 rnCoreBndrs bs $ \ names' ->
840 thing_inside (name':names')
844 rnCoreAlt (con, bndrs, rhs)
845 = rnUfCon con `thenM` \ con' ->
846 bindCoreLocalsRn bndrs $ \ bndrs' ->
847 rnCoreExpr rhs `thenM` \ rhs' ->
848 returnM (con', bndrs', rhs')
851 = rnHsType (text "unfolding coerce") ty `thenM` \ ty' ->
852 returnM (UfCoerce ty')
854 rnNote (UfSCC cc) = returnM (UfSCC cc)
855 rnNote UfInlineCall = returnM UfInlineCall
856 rnNote UfInlineMe = returnM UfInlineMe
862 rnUfCon (UfTupleAlt tup_con)
863 = returnM (UfTupleAlt tup_con)
865 rnUfCon (UfDataAlt con)
866 = lookupOccRn con `thenM` \ con' ->
867 returnM (UfDataAlt con')
869 rnUfCon (UfLitAlt lit)
870 = returnM (UfLitAlt lit)
872 rnUfCon (UfLitLitAlt lit ty)
873 = rnHsType (text "litlit") ty `thenM` \ ty' ->
874 returnM (UfLitLitAlt lit ty')
877 %*********************************************************
879 \subsection{Statistics}
881 %*********************************************************
884 rnStats :: [RenamedHsDecl] -- Imported decls
887 = doptM Opt_D_dump_rn_trace `thenM` \ dump_rn_trace ->
888 doptM Opt_D_dump_rn_stats `thenM` \ dump_rn_stats ->
889 doptM Opt_D_dump_rn `thenM` \ dump_rn ->
890 getEps `thenM` \ eps ->
892 ioToTcRn (dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
894 (getRnStats eps imp_decls)) `thenM_`
897 getRnStats :: ExternalPackageState -> [RenamedHsDecl] -> SDoc
898 getRnStats eps imported_decls
899 = hcat [text "Renamer stats: ", stats]
901 n_mods = length [() | _ <- moduleEnvElts (eps_PIT eps)]
902 -- This is really only right for a one-shot compile
904 (decls_map, n_decls_slurped) = eps_decls eps
906 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
907 -- Data, newtype, and class decls are in the decls_fm
908 -- under multiple names; the tycon/class, and each
909 -- constructor/class op too.
910 -- The 'True' selects just the 'main' decl
913 (insts_left, n_insts_slurped) = eps_insts eps
914 n_insts_left = length (bagToList insts_left)
916 (rules_left, n_rules_slurped) = eps_rules eps
917 n_rules_left = length (bagToList rules_left)
920 [int n_mods <+> text "interfaces read",
921 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
922 int (n_decls_slurped + n_decls_left), text "read"],
923 hsep [ int n_insts_slurped, text "instance decls imported, out of",
924 int (n_insts_slurped + n_insts_left), text "read"],
925 hsep [ int n_rules_slurped, text "rule decls imported, out of",
926 int (n_rules_slurped + n_rules_left), text "read"]
930 %*********************************************************
934 %*********************************************************
938 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
940 badRuleLhsErr name lhs (Just bad_e)
941 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
942 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
943 ptext SLIT("in left-hand side:") <+> ppr lhs])]
945 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
948 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
949 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
950 ptext SLIT("does not appear on left hand side")]
952 emptyConDeclsErr tycon
953 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
954 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]