2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
8 rnSrcDecls, checkModDeprec,
9 rnTyClDecl, rnIfaceRuleDecl, rnInstDecl,
10 rnBinds, rnBindsAndThen, rnStats,
13 #include "HsVersions.h"
16 import RdrName ( RdrName, isRdrDataCon, elemRdrEnv )
17 import RdrHsSyn ( RdrNameConDecl, RdrNameTyClDecl,
18 RdrNameDeprecation, RdrNameFixitySig,
20 extractGenericPatTyVars
24 import RnExpr ( rnExpr )
25 import RnTypes ( rnHsType, rnHsSigType, rnHsTypeFVs, rnContext )
27 import RnBinds ( rnTopMonoBinds, rnMonoBinds, rnMethodBinds,
28 rnMonoBindsAndThen, renameSigs, checkSigs )
29 import RnEnv ( lookupTopBndrRn, lookupOccRn, lookupSysBndr,
30 newLocalsRn, lookupGlobalOccRn,
31 bindLocalsFVRn, bindPatSigTyVars,
32 bindTyVarsRn, extendTyVarEnvFVRn,
33 bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
34 checkDupOrQualNames, checkDupNames, mapFvRn,
35 lookupTopSrcBndr_maybe, lookupTopSrcBndr,
36 dataTcOccs, newIPName, unknownNameErr
40 import BasicTypes ( FixitySig(..) )
41 import HscTypes ( ExternalPackageState(..), FixityEnv,
42 Deprecations(..), plusDeprecs )
43 import Module ( moduleEnvElts )
44 import Class ( FunDep, DefMeth (..) )
45 import TyCon ( DataConDetails(..), visibleDataCons )
49 import ErrUtils ( dumpIfSet )
50 import PrelNames ( newStablePtrName, bindIOName, returnIOName )
51 import List ( partition )
52 import Bag ( bagToList )
54 import SrcLoc ( SrcLoc )
55 import CmdLineOpts ( DynFlag(..) )
56 -- Warn of unused for-all'd tyvars
57 import Maybes ( maybeToBool, seqMaybe )
58 import Maybe ( maybe, catMaybes, isNothing )
61 @rnSourceDecl@ `renames' declarations.
62 It simultaneously performs dependency analysis and precedence parsing.
63 It also does the following error checks:
66 Checks that tyvars are used properly. This includes checking
67 for undefined tyvars, and tyvars in contexts that are ambiguous.
68 (Some of this checking has now been moved to module @TcMonoType@,
69 since we don't have functional dependency information at this point.)
71 Checks that all variable occurences are defined.
73 Checks the @(..)@ etc constraints in the export list.
78 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name, FreeVars)
80 rnSrcDecls (HsGroup { hs_valds = MonoBind binds sigs _,
81 hs_tyclds = tycl_decls,
82 hs_instds = inst_decls,
84 hs_depds = deprec_decls,
85 hs_fords = foreign_decls,
86 hs_defds = default_decls,
87 hs_ruleds = rule_decls,
88 hs_coreds = core_decls })
90 = do { -- Deal with deprecations (returns only the extra deprecations)
91 deprecs <- rnSrcDeprecDecls deprec_decls ;
92 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
95 -- Deal with top-level fixity decls
96 -- (returns the total new fixity env)
97 fix_env <- rnSrcFixityDecls fix_decls ;
98 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
101 -- Rename other declarations
102 (rn_val_decls, src_fvs1) <- rnTopMonoBinds binds sigs ;
103 (rn_inst_decls, src_fvs2) <- mapFvRn rnSrcInstDecl inst_decls ;
104 (rn_tycl_decls, src_fvs3) <- mapFvRn rnSrcTyClDecl tycl_decls ;
105 (rn_rule_decls, src_fvs4) <- mapFvRn rnHsRuleDecl rule_decls ;
106 (rn_foreign_decls, src_fvs5) <- mapFvRn rnHsForeignDecl foreign_decls ;
107 (rn_default_decls, src_fvs6) <- mapFvRn rnDefaultDecl default_decls ;
108 (rn_core_decls, src_fvs7) <- mapFvRn rnCoreDecl core_decls ;
111 rn_group = HsGroup { hs_valds = rn_val_decls,
112 hs_tyclds = rn_tycl_decls,
113 hs_instds = rn_inst_decls,
116 hs_fords = rn_foreign_decls,
117 hs_defds = rn_default_decls,
118 hs_ruleds = rn_rule_decls,
119 hs_coreds = rn_core_decls } ;
120 src_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
121 src_fvs5, src_fvs6, src_fvs7] } ;
123 traceRn (text "rnSrcDecls" <+> ppr (nameSetToList src_fvs)) ;
124 tcg_env <- getGblEnv ;
125 return (tcg_env, rn_group, src_fvs)
130 %*********************************************************
132 Source-code fixity declarations
134 %*********************************************************
137 rnSrcFixityDecls :: [RdrNameFixitySig] -> TcRn m FixityEnv
138 rnSrcFixityDecls fix_decls
139 = getGblEnv `thenM` \ gbl_env ->
140 foldlM rnFixityDecl (tcg_fix_env gbl_env)
141 fix_decls `thenM` \ fix_env ->
142 traceRn (text "fixity env" <+> ppr fix_env) `thenM_`
145 rnFixityDecl :: FixityEnv -> RdrNameFixitySig -> TcRn m FixityEnv
146 rnFixityDecl fix_env (FixitySig rdr_name fixity loc)
147 = -- GHC extension: look up both the tycon and data con
148 -- for con-like things
149 -- If neither are in scope, report an error; otherwise
150 -- add both to the fixity env
151 mappM lookupTopSrcBndr_maybe (dataTcOccs rdr_name) `thenM` \ maybe_ns ->
152 case catMaybes maybe_ns of
153 [] -> addSrcLoc loc $
154 addErr (unknownNameErr rdr_name) `thenM_`
156 ns -> foldlM add fix_env ns
159 = case lookupNameEnv fix_env name of
160 Just (FixitySig _ _ loc') -> addErr (dupFixityDecl rdr_name loc loc') `thenM_`
162 Nothing -> returnM (extendNameEnv fix_env name (FixitySig name fixity loc))
164 dupFixityDecl rdr_name loc1 loc2
165 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
166 ptext SLIT("at ") <+> ppr loc1,
167 ptext SLIT("and") <+> ppr loc2]
171 %*********************************************************
173 Source-code deprecations declarations
175 %*********************************************************
177 For deprecations, all we do is check that the names are in scope.
178 It's only imported deprecations, dealt with in RnIfaces, that we
179 gather them together.
182 rnSrcDeprecDecls :: [RdrNameDeprecation] -> TcRn m Deprecations
186 rnSrcDeprecDecls decls
187 = mappM rn_deprec decls `thenM` \ pairs ->
188 returnM (DeprecSome (mkNameEnv (catMaybes pairs)))
190 rn_deprec (Deprecation rdr_name txt loc)
192 lookupTopSrcBndr rdr_name `thenM` \ name ->
193 returnM (Just (name, (name,txt)))
195 checkModDeprec :: Maybe DeprecTxt -> Deprecations
196 -- Check for a module deprecation; done once at top level
197 checkModDeprec Nothing = NoDeprecs
198 checkModdeprec (Just txt) = DeprecAll txt
201 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
205 %*********************************************************
207 \subsection{Source code declarations}
209 %*********************************************************
212 rnSrcTyClDecl tycl_decl
213 = rnTyClDecl tycl_decl `thenM` \ new_decl ->
214 finishSourceTyClDecl tycl_decl new_decl `thenM` \ (new_decl', fvs) ->
215 returnM (new_decl', fvs `plusFV` tyClDeclFVs new_decl')
218 = rnInstDecl inst `thenM` \ new_inst ->
219 finishSourceInstDecl inst new_inst `thenM` \ (new_inst', fvs) ->
220 returnM (new_inst', fvs `plusFV` instDeclFVs new_inst')
222 rnDefaultDecl (DefaultDecl tys src_loc)
223 = addSrcLoc src_loc $
224 mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
225 returnM (DefaultDecl tys' src_loc, fvs)
227 doc_str = text "In a `default' declaration"
230 rnCoreDecl (CoreDecl name ty rhs loc)
232 lookupTopBndrRn name `thenM` \ name' ->
233 rnHsTypeFVs doc_str ty `thenM` \ (ty', ty_fvs) ->
234 rnCoreExpr rhs `thenM` \ rhs' ->
235 returnM (CoreDecl name' ty' rhs' loc,
236 ty_fvs `plusFV` ufExprFVs rhs')
238 doc_str = text "In the Core declaration for" <+> quotes (ppr name)
241 %*********************************************************
245 %*********************************************************
247 These chaps are here, rather than in TcBinds, so that there
248 is just one hi-boot file (for RnSource). rnSrcDecls is part
249 of the loop too, and it must be defined in this module.
252 rnTopBinds :: RdrNameHsBinds -> RnM (RenamedHsBinds, FreeVars)
253 rnTopBinds EmptyBinds = returnM (EmptyBinds, emptyFVs)
254 rnTopBinds (MonoBind bind sigs _) = rnTopMonoBinds bind sigs
255 -- The parser doesn't produce other forms
257 rnBinds :: RdrNameHsBinds -> RnM (RenamedHsBinds, FreeVars)
258 -- This version assumes that the binders are already in scope
259 -- It's used only in 'mdo'
260 rnBinds EmptyBinds = returnM (EmptyBinds, emptyFVs)
261 rnBinds (MonoBind bind sigs _) = rnMonoBinds bind sigs
262 rnBinds b@(IPBinds bind _) = addErr (badIpBinds b) `thenM_`
263 returnM (EmptyBinds, emptyFVs)
265 rnBindsAndThen :: RdrNameHsBinds
266 -> (RenamedHsBinds -> RnM (result, FreeVars))
267 -> RnM (result, FreeVars)
268 -- This version (a) assumes that the binding vars are not already in scope
269 -- (b) removes the binders from the free vars of the thing inside
270 -- The parser doesn't produce ThenBinds
271 rnBindsAndThen EmptyBinds thing_inside = thing_inside EmptyBinds
272 rnBindsAndThen (MonoBind bind sigs _) thing_inside = rnMonoBindsAndThen bind sigs thing_inside
273 rnBindsAndThen (IPBinds binds is_with) thing_inside
274 = warnIf is_with withWarning `thenM_`
275 rnIPBinds binds `thenM` \ (binds',fv_binds) ->
276 thing_inside (IPBinds binds' is_with) `thenM` \ (thing, fvs_thing) ->
277 returnM (thing, fvs_thing `plusFV` fv_binds)
281 %************************************************************************
283 \subsubsection{@rnIPBinds@s: in implicit parameter bindings} *
285 %************************************************************************
288 rnIPBinds [] = returnM ([], emptyFVs)
289 rnIPBinds ((n, expr) : binds)
290 = newIPName n `thenM` \ name ->
291 rnExpr expr `thenM` \ (expr',fvExpr) ->
292 rnIPBinds binds `thenM` \ (binds',fvBinds) ->
293 returnM ((name, expr') : binds', fvExpr `plusFV` fvBinds)
298 %*********************************************************
300 \subsection{Foreign declarations}
302 %*********************************************************
305 rnHsForeignDecl (ForeignImport name ty spec isDeprec src_loc)
306 = addSrcLoc src_loc $
307 lookupTopBndrRn name `thenM` \ name' ->
308 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
309 returnM (ForeignImport name' ty' spec isDeprec src_loc,
310 fvs `plusFV` extras spec)
312 extras (CImport _ _ _ _ CWrapper) = mkFVs [newStablePtrName,
313 bindIOName, returnIOName]
316 rnHsForeignDecl (ForeignExport name ty spec isDeprec src_loc)
317 = addSrcLoc src_loc $
318 lookupOccRn name `thenM` \ name' ->
319 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
320 returnM (ForeignExport name' ty' spec isDeprec src_loc,
321 mkFVs [name', bindIOName, returnIOName] `plusFV` fvs )
322 -- NB: a foreign export is an *occurrence site* for name, so
323 -- we add it to the free-variable list. It might, for example,
324 -- be imported from another module
326 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
330 %*********************************************************
332 \subsection{Instance declarations}
334 %*********************************************************
337 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
338 -- Used for both source and interface file decls
339 = addSrcLoc src_loc $
340 rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
342 (case maybe_dfun_rdr_name of
343 Nothing -> returnM Nothing
344 Just dfun_rdr_name -> lookupGlobalOccRn dfun_rdr_name `thenM` \ dfun_name ->
345 returnM (Just dfun_name)
346 ) `thenM` \ maybe_dfun_name ->
348 -- The typechecker checks that all the bindings are for the right class.
349 returnM (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
351 -- Compare finishSourceTyClDecl
352 finishSourceInstDecl (InstDecl _ mbinds uprags _ _ )
353 (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
354 -- Used for both source decls only
355 = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
357 meth_doc = text "In the bindings in an instance declaration"
358 meth_names = collectLocatedMonoBinders mbinds
359 (inst_tyvars, _, cls,_) = splitHsInstDeclTy inst_ty
360 -- (Slightly strangely) the forall-d tyvars scope over
361 -- the method bindings too
364 -- Rename the bindings
365 -- NB meth_names can be qualified!
366 checkDupNames meth_doc meth_names `thenM_`
367 extendTyVarEnvForMethodBinds inst_tyvars (
368 rnMethodBinds cls [] mbinds
369 ) `thenM` \ (mbinds', meth_fvs) ->
371 binders = collectMonoBinders mbinds'
373 -- Rename the prags and signatures.
374 -- Note that the type variables are not in scope here,
375 -- so that instance Eq a => Eq (T a) where
376 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
379 -- But the (unqualified) method names are in scope
380 bindLocalNames binders (renameSigs uprags) `thenM` \ uprags' ->
381 checkSigs okInstDclSig (mkNameSet binders) uprags' `thenM_`
383 returnM (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
384 meth_fvs `plusFV` hsSigsFVs uprags')
387 %*********************************************************
391 %*********************************************************
394 rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
395 = addSrcLoc src_loc $
396 lookupOccRn fn `thenM` \ fn' ->
397 rnCoreBndrs vars $ \ vars' ->
398 mappM rnCoreExpr args `thenM` \ args' ->
399 rnCoreExpr rhs `thenM` \ rhs' ->
400 returnM (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
402 rnIfaceRuleDecl (IfaceRuleOut fn rule) -- Builtin rules come this way
403 = lookupOccRn fn `thenM` \ fn' ->
404 returnM (IfaceRuleOut fn' rule)
406 rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
407 = addSrcLoc src_loc $
408 bindPatSigTyVars (collectRuleBndrSigTys vars) $
410 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
411 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
413 rnExpr lhs `thenM` \ (lhs', fv_lhs) ->
414 rnExpr rhs `thenM` \ (rhs', fv_rhs) ->
416 mb_bad = validRuleLhs ids lhs'
418 checkErr (isNothing mb_bad)
419 (badRuleLhsErr rule_name lhs' mb_bad) `thenM_`
421 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
423 mappM (addErr . badRuleVar rule_name) bad_vars `thenM_`
424 returnM (HsRule rule_name act vars' lhs' rhs' src_loc,
425 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
427 doc = text "In the transformation rule" <+> ftext rule_name
429 get_var (RuleBndr v) = v
430 get_var (RuleBndrSig v _) = v
432 rn_var (RuleBndr v, id) = returnM (RuleBndr id, emptyFVs)
433 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
434 returnM (RuleBndrSig id t', fvs)
437 Check the shape of a transformation rule LHS. Currently
438 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
439 not one of the @forall@'d variables. We also restrict the form of the LHS so
440 that it may be plausibly matched. Basically you only get to write ordinary
441 applications. (E.g. a case expression is not allowed: too elaborate.)
443 NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
446 validRuleLhs :: [Name] -> RenamedHsExpr -> Maybe RenamedHsExpr
448 -- Just e => Not ok, and e is the offending expression
449 validRuleLhs foralls lhs
452 check (OpApp e1 op _ e2) = check op `seqMaybe` check_e e1 `seqMaybe` check_e e2
453 check (HsApp e1 e2) = check e1 `seqMaybe` check_e e2
454 check (HsVar v) | v `notElem` foralls = Nothing
455 check other = Just other -- Failure
457 check_e (HsVar v) = Nothing
458 check_e (HsPar e) = check_e e
459 check_e (HsLit e) = Nothing
460 check_e (HsOverLit e) = Nothing
462 check_e (OpApp e1 op _ e2) = check_e e1 `seqMaybe` check_e op `seqMaybe` check_e e2
463 check_e (HsApp e1 e2) = check_e e1 `seqMaybe` check_e e2
464 check_e (NegApp e _) = check_e e
465 check_e (ExplicitList _ es) = check_es es
466 check_e (ExplicitTuple es _) = check_es es
467 check_e other = Just other -- Fails
469 check_es es = foldr (seqMaybe . check_e) Nothing es
473 %*********************************************************
475 \subsection{Type, class and iface sig declarations}
477 %*********************************************************
479 @rnTyDecl@ uses the `global name function' to create a new type
480 declaration in which local names have been replaced by their original
481 names, reporting any unknown names.
483 Renaming type variables is a pain. Because they now contain uniques,
484 it is necessary to pass in an association list which maps a parsed
485 tyvar to its @Name@ representation.
486 In some cases (type signatures of values),
487 it is even necessary to go over the type first
488 in order to get the set of tyvars used by it, make an assoc list,
489 and then go over it again to rename the tyvars!
490 However, we can also do some scoping checks at the same time.
493 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
495 lookupTopBndrRn name `thenM` \ name' ->
496 rnHsType doc_str ty `thenM` \ ty' ->
497 mappM rnIdInfo id_infos `thenM` \ id_infos' ->
498 returnM (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
500 doc_str = text "In the interface signature for" <+> quotes (ppr name)
502 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
504 lookupTopBndrRn name `thenM` \ name' ->
505 returnM (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
507 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
508 tcdTyVars = tyvars, tcdCons = condecls, tcdGeneric = want_generic,
509 tcdDerivs = derivs, tcdLoc = src_loc})
510 = addSrcLoc src_loc $
511 lookupTopBndrRn tycon `thenM` \ tycon' ->
512 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
513 rnContext data_doc context `thenM` \ context' ->
514 rn_derivs derivs `thenM` \ derivs' ->
515 checkDupOrQualNames data_doc con_names `thenM_`
517 rnConDecls tycon' condecls `thenM` \ condecls' ->
518 returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
519 tcdTyVars = tyvars', tcdCons = condecls', tcdGeneric = want_generic,
520 tcdDerivs = derivs', tcdLoc = src_loc})
522 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
523 con_names = map conDeclName (visibleDataCons condecls)
525 rn_derivs Nothing = returnM Nothing
526 rn_derivs (Just ds) = rnContext data_doc ds `thenM` \ ds' -> returnM (Just ds')
528 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
529 = addSrcLoc src_loc $
530 lookupTopBndrRn name `thenM` \ name' ->
531 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
532 rnHsType syn_doc ty `thenM` \ ty' ->
533 returnM (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
535 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
537 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
538 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
540 -- Used for both source and interface file decls
541 = addSrcLoc src_loc $
543 lookupTopBndrRn cname `thenM` \ cname' ->
545 -- Tyvars scope over superclass context and method signatures
546 bindTyVarsRn cls_doc tyvars $ \ tyvars' ->
548 -- Check the superclasses
549 rnContext cls_doc context `thenM` \ context' ->
551 -- Check the functional dependencies
552 rnFds cls_doc fds `thenM` \ fds' ->
554 -- Check the signatures
555 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
557 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
558 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
560 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenM_`
561 mappM (rnClassOp cname' fds') op_sigs `thenM` \ sigs' ->
563 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
565 renameSigs non_op_sigs `thenM` \ non_ops' ->
566 checkSigs okClsDclSig binders non_ops' `thenM_`
567 -- Typechecker is responsible for checking that we only
568 -- give default-method bindings for things in this class.
569 -- The renamer *could* check this for class decls, but can't
570 -- for instance decls.
572 returnM (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
573 tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
576 cls_doc = text "In the declaration for class" <+> ppr cname
577 sig_doc = text "In the signatures for class" <+> ppr cname
579 rnClassOp clas clas_fds sig@(ClassOpSig op dm_stuff ty locn)
581 lookupTopBndrRn op `thenM` \ op_name ->
583 -- Check the signature
584 rnHsSigType (quotes (ppr op)) ty `thenM` \ new_ty ->
586 -- Make the default-method name
589 -> -- Imported class that has a default method decl
590 lookupSysBndr dm_rdr_name `thenM` \ dm_name ->
591 returnM (DefMeth dm_name)
592 -- An imported class decl for a class decl that had an explicit default
593 -- method, mentions, rather than defines,
594 -- the default method, so we must arrange to pull it in
596 GenDefMeth -> returnM GenDefMeth
597 NoDefMeth -> returnM NoDefMeth
598 ) `thenM` \ dm_stuff' ->
600 returnM (ClassOpSig op_name dm_stuff' new_ty locn)
602 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnM (RenamedTyClDecl, FreeVars)
603 -- Used for source file decls only
604 -- Renames the default-bindings of a class decl
605 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
606 rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars}) -- Everything else is here
607 -- There are some default-method bindings (abeit possibly empty) so
608 -- this is a source-code class declaration
609 = -- The newLocals call is tiresome: given a generic class decl
612 -- op {| x+y |} (Inl a) = ...
613 -- op {| x+y |} (Inr b) = ...
614 -- op {| a*b |} (a*b) = ...
615 -- we want to name both "x" tyvars with the same unique, so that they are
616 -- easy to group together in the typechecker.
619 extendTyVarEnvForMethodBinds tyvars $
620 getLocalRdrEnv `thenM` \ name_env ->
622 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
623 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
624 not (tv `elemRdrEnv` name_env)]
626 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenM_`
627 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
628 rnMethodBinds cls gen_tyvars mbinds `thenM` \ (mbinds', meth_fvs) ->
629 returnM (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
631 meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
633 finishSourceTyClDecl _ tycl_decl@(TyData {tcdDerivs = derivings})
634 -- Derivings are returned here so that they don't form part of the tyClDeclFVs.
635 -- This is important, because tyClDeclFVs should contain only the
636 -- FVs that are `needed' by the interface file declaration, and
637 -- derivings do not appear in this. It also means that the tcGroups
638 -- are smaller, which turned out to be important for the usage inference. KSW 2002-02.
639 = returnM (tycl_decl,
640 maybe emptyFVs extractHsCtxtTyNames derivings)
642 finishSourceTyClDecl _ tycl_decl = returnM (tycl_decl, emptyFVs)
643 -- Not a class declaration
646 For the method bindings in class and instance decls, we extend the
647 type variable environment iff -fglasgow-exts
650 extendTyVarEnvForMethodBinds tyvars thing_inside
651 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
652 if opt_GlasgowExts then
653 extendTyVarEnvFVRn (map hsTyVarName tyvars) thing_inside
659 %*********************************************************
661 \subsection{Support code for type/data declarations}
663 %*********************************************************
666 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
667 conDeclName (ConDecl n _ _ _ l) = (n,l)
669 rnConDecls :: Name -> DataConDetails RdrNameConDecl -> RnM (DataConDetails RenamedConDecl)
670 rnConDecls tycon Unknown = returnM Unknown
671 rnConDecls tycon (HasCons n) = returnM (HasCons n)
672 rnConDecls tycon (DataCons condecls)
673 = -- Check that there's at least one condecl,
674 -- or else we're reading an interface file, or -fglasgow-exts
675 (if null condecls then
676 doptM Opt_GlasgowExts `thenM` \ glaExts ->
677 getModeRn `thenM` \ mode ->
678 checkErr (glaExts || isInterfaceMode mode)
679 (emptyConDeclsErr tycon)
683 mappM rnConDecl condecls `thenM` \ condecls' ->
684 returnM (DataCons condecls')
686 rnConDecl :: RdrNameConDecl -> RnM RenamedConDecl
687 rnConDecl (ConDecl name tvs cxt details locn)
689 checkConName name `thenM_`
690 lookupTopBndrRn name `thenM` \ new_name ->
692 bindTyVarsRn doc tvs $ \ new_tyvars ->
693 rnContext doc cxt `thenM` \ new_context ->
694 rnConDetails doc locn details `thenM` \ new_details ->
695 returnM (ConDecl new_name new_tyvars new_context new_details locn)
697 doc = text "In the definition of data constructor" <+> quotes (ppr name)
699 rnConDetails doc locn (PrefixCon tys)
700 = mappM (rnBangTy doc) tys `thenM` \ new_tys ->
701 returnM (PrefixCon new_tys)
703 rnConDetails doc locn (InfixCon ty1 ty2)
704 = rnBangTy doc ty1 `thenM` \ new_ty1 ->
705 rnBangTy doc ty2 `thenM` \ new_ty2 ->
706 returnM (InfixCon new_ty1 new_ty2)
708 rnConDetails doc locn (RecCon fields)
709 = checkDupOrQualNames doc field_names `thenM_`
710 mappM (rnField doc) fields `thenM` \ new_fields ->
711 returnM (RecCon new_fields)
713 field_names = [(fld, locn) | (fld, _) <- fields]
715 rnField doc (name, ty)
716 = lookupTopBndrRn name `thenM` \ new_name ->
717 rnBangTy doc ty `thenM` \ new_ty ->
718 returnM (new_name, new_ty)
720 rnBangTy doc (BangType s ty)
721 = rnHsType doc ty `thenM` \ new_ty ->
722 returnM (BangType s new_ty)
724 -- This data decl will parse OK
726 -- treating "a" as the constructor.
727 -- It is really hard to make the parser spot this malformation.
728 -- So the renamer has to check that the constructor is legal
730 -- We can get an operator as the constructor, even in the prefix form:
731 -- data T = :% Int Int
732 -- from interface files, which always print in prefix form
735 = checkErr (isRdrDataCon name) (badDataCon name)
739 %*********************************************************
741 \subsection{Support code to rename types}
743 %*********************************************************
746 rnFds :: SDoc -> [FunDep RdrName] -> RnM [FunDep Name]
752 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
753 rnHsTyVars doc tys2 `thenM` \ tys2' ->
754 returnM (tys1', tys2')
756 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
757 rnHsTyvar doc tyvar = lookupOccRn tyvar
760 %*********************************************************
764 %*********************************************************
767 rnIdInfo (HsWorker worker arity)
768 = lookupOccRn worker `thenM` \ worker' ->
769 returnM (HsWorker worker' arity)
771 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenM` \ expr' ->
772 returnM (HsUnfold inline expr')
773 rnIdInfo (HsStrictness str) = returnM (HsStrictness str)
774 rnIdInfo (HsArity arity) = returnM (HsArity arity)
775 rnIdInfo HsNoCafRefs = returnM HsNoCafRefs
778 @UfCore@ expressions.
781 rnCoreExpr (UfType ty)
782 = rnHsType (text "unfolding type") ty `thenM` \ ty' ->
786 = lookupOccRn v `thenM` \ v' ->
792 rnCoreExpr (UfLitLit l ty)
793 = rnHsType (text "litlit") ty `thenM` \ ty' ->
794 returnM (UfLitLit l ty')
796 rnCoreExpr (UfFCall cc ty)
797 = rnHsType (text "ccall") ty `thenM` \ ty' ->
798 returnM (UfFCall cc ty')
800 rnCoreExpr (UfTuple (HsTupCon boxity arity) args)
801 = mappM rnCoreExpr args `thenM` \ args' ->
802 returnM (UfTuple (HsTupCon boxity arity) args')
804 rnCoreExpr (UfApp fun arg)
805 = rnCoreExpr fun `thenM` \ fun' ->
806 rnCoreExpr arg `thenM` \ arg' ->
807 returnM (UfApp fun' arg')
809 rnCoreExpr (UfCase scrut bndr alts)
810 = rnCoreExpr scrut `thenM` \ scrut' ->
811 bindCoreLocalRn bndr $ \ bndr' ->
812 mappM rnCoreAlt alts `thenM` \ alts' ->
813 returnM (UfCase scrut' bndr' alts')
815 rnCoreExpr (UfNote note expr)
816 = rnNote note `thenM` \ note' ->
817 rnCoreExpr expr `thenM` \ expr' ->
818 returnM (UfNote note' expr')
820 rnCoreExpr (UfLam bndr body)
821 = rnCoreBndr bndr $ \ bndr' ->
822 rnCoreExpr body `thenM` \ body' ->
823 returnM (UfLam bndr' body')
825 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
826 = rnCoreExpr rhs `thenM` \ rhs' ->
827 rnCoreBndr bndr $ \ bndr' ->
828 rnCoreExpr body `thenM` \ body' ->
829 returnM (UfLet (UfNonRec bndr' rhs') body')
831 rnCoreExpr (UfLet (UfRec pairs) body)
832 = rnCoreBndrs bndrs $ \ bndrs' ->
833 mappM rnCoreExpr rhss `thenM` \ rhss' ->
834 rnCoreExpr body `thenM` \ body' ->
835 returnM (UfLet (UfRec (bndrs' `zip` rhss')) body')
837 (bndrs, rhss) = unzip pairs
841 rnCoreBndr (UfValBinder name ty) thing_inside
842 = rnHsType doc ty `thenM` \ ty' ->
843 bindCoreLocalRn name $ \ name' ->
844 thing_inside (UfValBinder name' ty')
846 doc = text "unfolding id"
848 rnCoreBndr (UfTyBinder name kind) thing_inside
849 = bindCoreLocalRn name $ \ name' ->
850 thing_inside (UfTyBinder name' kind)
852 rnCoreBndrs [] thing_inside = thing_inside []
853 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
854 rnCoreBndrs bs $ \ names' ->
855 thing_inside (name':names')
859 rnCoreAlt (con, bndrs, rhs)
860 = rnUfCon con `thenM` \ con' ->
861 bindCoreLocalsRn bndrs $ \ bndrs' ->
862 rnCoreExpr rhs `thenM` \ rhs' ->
863 returnM (con', bndrs', rhs')
866 = rnHsType (text "unfolding coerce") ty `thenM` \ ty' ->
867 returnM (UfCoerce ty')
869 rnNote (UfSCC cc) = returnM (UfSCC cc)
870 rnNote UfInlineCall = returnM UfInlineCall
871 rnNote UfInlineMe = returnM UfInlineMe
877 rnUfCon (UfTupleAlt tup_con)
878 = returnM (UfTupleAlt tup_con)
880 rnUfCon (UfDataAlt con)
881 = lookupOccRn con `thenM` \ con' ->
882 returnM (UfDataAlt con')
884 rnUfCon (UfLitAlt lit)
885 = returnM (UfLitAlt lit)
887 rnUfCon (UfLitLitAlt lit ty)
888 = rnHsType (text "litlit") ty `thenM` \ ty' ->
889 returnM (UfLitLitAlt lit ty')
892 %*********************************************************
894 \subsection{Statistics}
896 %*********************************************************
899 rnStats :: [RenamedHsDecl] -- Imported decls
902 = doptM Opt_D_dump_rn_trace `thenM` \ dump_rn_trace ->
903 doptM Opt_D_dump_rn_stats `thenM` \ dump_rn_stats ->
904 doptM Opt_D_dump_rn `thenM` \ dump_rn ->
905 getEps `thenM` \ eps ->
907 ioToTcRn (dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
909 (getRnStats eps imp_decls)) `thenM_`
912 getRnStats :: ExternalPackageState -> [RenamedHsDecl] -> SDoc
913 getRnStats eps imported_decls
914 = hcat [text "Renamer stats: ", stats]
916 n_mods = length [() | _ <- moduleEnvElts (eps_PIT eps)]
917 -- This is really only right for a one-shot compile
919 (decls_map, n_decls_slurped) = eps_decls eps
921 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
922 -- Data, newtype, and class decls are in the decls_fm
923 -- under multiple names; the tycon/class, and each
924 -- constructor/class op too.
925 -- The 'True' selects just the 'main' decl
928 (insts_left, n_insts_slurped) = eps_insts eps
929 n_insts_left = length (bagToList insts_left)
931 (rules_left, n_rules_slurped) = eps_rules eps
932 n_rules_left = length (bagToList rules_left)
935 [int n_mods <+> text "interfaces read",
936 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
937 int (n_decls_slurped + n_decls_left), text "read"],
938 hsep [ int n_insts_slurped, text "instance decls imported, out of",
939 int (n_insts_slurped + n_insts_left), text "read"],
940 hsep [ int n_rules_slurped, text "rule decls imported, out of",
941 int (n_rules_slurped + n_rules_left), text "read"]
945 %*********************************************************
949 %*********************************************************
953 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
955 badRuleLhsErr name lhs (Just bad_e)
956 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
957 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
958 ptext SLIT("in left-hand side:") <+> ppr lhs])]
960 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
963 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
964 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
965 ptext SLIT("does not appear on left hand side")]
967 emptyConDeclsErr tycon
968 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
969 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
972 = sep [quotes (ptext SLIT("with")),
973 ptext SLIT("is deprecated, use"),
974 quotes (ptext SLIT("let")),
975 ptext SLIT("instead")]
978 = hang (ptext SLIT("Implicit-parameter bindings illegal in 'mdo':")) 4