2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[Rename]{Renaming and dependency analysis passes}
7 module Rename ( renameModule ) where
9 #include "HsVersions.h"
12 import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation,
13 RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl
15 import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
16 extractHsTyNames, extractHsCtxtTyNames,
17 instDeclFVs, tyClDeclFVs, ruleDeclFVs
20 import CmdLineOpts ( DynFlags, DynFlag(..) )
22 import RnNames ( getGlobalNames )
23 import RnSource ( rnSourceDecls, rnDecl, rnTyClDecl, rnRuleDecl, rnInstDecl )
24 import RnIfaces ( slurpImpDecls, mkImportInfo,
26 RecompileRequired, recompileRequired
28 import RnHiFiles ( findAndReadIface, removeContext, loadExports, loadFixDecls, loadDeprecs )
29 import RnEnv ( availName, availsToNameSet,
30 emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, sortAvails,
31 warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
32 lookupOrigNames, lookupGlobalRn, newGlobalName,
33 FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs, addOneFV
35 import Module ( Module, ModuleName, WhereFrom(..),
36 moduleNameUserString, moduleName,
39 import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
40 nameOccName, nameUnique, nameModule,
41 mkNameEnv, nameEnvElts, extendNameEnv
43 import OccName ( occNameFlavour )
45 import TyCon ( isSynTyCon, getSynTyConDefn )
47 import TysWiredIn ( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
48 import PrelNames ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
50 unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
53 import PrelInfo ( fractionalClassKeys, derivingOccurrences, wiredInThingEnv )
54 import Type ( namesOfType, funTyCon )
55 import ErrUtils ( dumpIfSet )
56 import Bag ( bagToList )
57 import FiniteMap ( FiniteMap, eltsFM, fmToList, emptyFM, lookupFM,
58 addToFM_C, elemFM, addToFM
60 import UniqFM ( lookupUFM )
61 import Maybes ( maybeToBool, catMaybes )
63 import IO ( openFile, IOMode(..) )
64 import HscTypes ( Finder, PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
65 ModIface(..), TyThing(..), WhatsImported(..),
66 VersionInfo(..), ImportVersion, IfaceDecls(..),
67 GlobalRdrEnv, AvailEnv, Avails, GenAvailInfo(..), AvailInfo,
68 Provenance(..), ImportReason(..), initialVersionInfo,
69 Deprecations(..), lookupDeprec
71 import List ( partition, nub )
76 %*********************************************************
78 \subsection{The main function: rename}
80 %*********************************************************
83 renameModule :: DynFlags -> Finder
84 -> HomeIfaceTable -> HomeSymbolTable
85 -> PersistentCompilerState
86 -> Module -> RdrNameHsModule
87 -> IO (PersistentCompilerState, Maybe (ModIface, [RenamedHsDecl]))
88 -- Nothing => some error occurred in the renamer
90 renameModule dflags finder hit hst old_pcs this_module rdr_module
91 = -- Initialise the renamer monad
93 (new_pcs, errors_found, maybe_rn_stuff)
94 <- initRn dflags finder hit hst old_pcs this_module (rename this_module rdr_module) ;
96 -- Return results. No harm in updating the PCS
98 return (new_pcs, Nothing)
100 return (new_pcs, maybe_rn_stuff)
105 rename :: Module -> RdrNameHsModule -> RnMG (Maybe (ModIface, [RenamedHsDecl]))
106 rename this_module this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec loc)
107 = -- FIND THE GLOBAL NAME ENVIRONMENT
108 getGlobalNames this_mod `thenRn` \ maybe_stuff ->
110 -- CHECK FOR EARLY EXIT
111 case maybe_stuff of {
112 Nothing -> -- Everything is up to date; no need to recompile further
113 rnDump [] [] `thenRn_`
116 Just (gbl_env, local_gbl_env, export_avails, global_avail_env) ->
118 -- DEAL WITH DEPRECATIONS
119 rnDeprecs local_gbl_env mod_deprec
120 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
122 -- DEAL WITH LOCAL FIXITIES
123 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
126 initRnMS gbl_env local_fixity_env SourceMode (
127 rnSourceDecls local_decls
128 ) `thenRn` \ (rn_local_decls, source_fvs) ->
130 -- SLURP IN ALL THE NEEDED DECLARATIONS
131 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
133 -- The export_fvs make the exported names look just as if they
134 -- occurred in the source program. For the reasoning, see the
135 -- comments with RnIfaces.getImportVersions.
136 -- We only need the 'parent name' of the avail;
137 -- that's enough to suck in the declaration.
138 export_fvs = mkNameSet (map availName export_avails)
139 real_source_fvs = source_fvs `plusFV` export_fvs
141 slurp_fvs = implicit_fvs `plusFV` real_source_fvs
142 -- It's important to do the "plus" this way round, so that
143 -- when compiling the prelude, locally-defined (), Bool, etc
144 -- override the implicit ones.
146 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
148 -- EXIT IF ERRORS FOUND
149 rnDump rn_imp_decls rn_local_decls `thenRn_`
150 checkErrsRn `thenRn` \ no_errs_so_far ->
151 if not no_errs_so_far then
152 -- Found errors already, so exit now
156 -- GENERATE THE VERSION/USAGE INFO
157 mkImportInfo mod_name imports `thenRn` \ my_usages ->
159 -- RETURN THE RENAMED MODULE
160 getNameSupplyRn `thenRn` \ name_supply ->
161 getIfacesRn `thenRn` \ ifaces ->
163 direct_import_mods :: [ModuleName]
164 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
166 -- We record fixities even for things that aren't exported,
167 -- so that we can change into the context of this moodule easily
168 fixities = mkNameEnv [ (name, fixity)
169 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
173 -- Sort the exports to make them easier to compare for versions
174 my_exports = sortAvails export_avails
176 mod_iface = ModIface { mi_module = this_module,
177 mi_version = initialVersionInfo,
178 mi_orphan = any isOrphanDecl rn_local_decls,
179 mi_exports = my_exports,
180 mi_globals = gbl_env,
181 mi_usages = my_usages,
182 mi_fixities = fixities,
183 mi_deprecs = my_deprecs,
184 mi_decls = panic "mi_decls"
187 final_decls = rn_local_decls ++ rn_imp_decls
190 -- REPORT UNUSED NAMES, AND DEBUG DUMP
191 reportUnusedNames mod_name direct_import_mods
192 gbl_env global_avail_env
193 export_avails source_fvs
194 rn_imp_decls `thenRn_`
196 returnRn (Just (mod_iface, final_decls))
200 @implicitFVs@ forces the renamer to slurp in some things which aren't
201 mentioned explicitly, but which might be needed by the type checker.
204 implicitFVs mod_name decls
205 = lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
206 returnRn (mkNameSet (map getName default_tycons) `plusFV`
209 -- Add occurrences for Int, and (), because they
210 -- are the types to which ambigious type variables may be defaulted by
211 -- the type checker; so they won't always appear explicitly.
212 -- [The () one is a GHC extension for defaulting CCall results.]
213 -- ALSO: funTyCon, since it occurs implicitly everywhere!
214 -- (we don't want to be bothered with making funTyCon a
215 -- free var at every function application!)
216 -- Double is dealt with separately in getGates
217 default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
219 -- Add occurrences for IO or PrimIO
220 implicit_main | mod_name == mAIN_Name
221 || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
224 -- Now add extra "occurrences" for things that
225 -- the deriving mechanism, or defaulting, will later need in order to
227 implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
229 -- Virtually every program has error messages in it somewhere
230 string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
233 get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _))
234 = concat (map get_deriv deriv_classes)
237 get_deriv cls = case lookupUFM derivingOccurrences cls of
243 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
244 = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
245 -- The 'removeContext' is because of
246 -- instance Foo a => Baz T where ...
247 -- The decl is an orphan if Baz and T are both not locally defined,
248 -- even if Foo *is* locally defined
250 isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
253 -- At the moment we just check for common LHS forms
254 -- Expand as necessary. Getting it wrong just means
255 -- more orphans than necessary
256 check (HsVar v) = not (isLocallyDefined v)
257 check (HsApp f a) = check f && check a
258 check (HsLit _) = False
259 check (HsOverLit _) = False
260 check (OpApp l o _ r) = check l && check o && check r
261 check (NegApp e _) = check e
262 check (HsPar e) = check e
263 check (SectionL e o) = check e && check o
264 check (SectionR o e) = check e && check o
266 check other = True -- Safe fall through
268 isOrphanDecl other = False
272 %*********************************************************
274 \subsection{Fixities}
276 %*********************************************************
279 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
280 fixitiesFromLocalDecls gbl_env decls
281 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn_unused ->
282 foldlRn (getFixities warn_unused) emptyNameEnv decls `thenRn` \ env ->
283 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))
287 getFixities :: Bool -> LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
288 getFixities warn_uu acc (FixD fix)
289 = fix_decl warn_uu acc fix
291 getFixities warn_uu acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ ))
292 = foldlRn (fix_decl warn_uu) acc [sig | FixSig sig <- sigs]
293 -- Get fixities from class decl sigs too.
294 getFixities warn_uu acc other_decl
297 fix_decl warn_uu acc sig@(FixitySig rdr_name fixity loc)
298 = -- Check for fixity decl for something not declared
300 lookupGlobalRn gbl_env rdr_name `thenRn` \ maybe_name ->
302 Nothing -> checkRn (not warn_uu) (unusedFixityDecl rdr_name fixity) `thenRn_`
307 -- Check for duplicate fixity decl
308 case lookupNameEnv acc name of {
309 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')
310 `thenRn_` returnRn acc ;
312 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
317 %*********************************************************
319 \subsection{Deprecations}
321 %*********************************************************
323 For deprecations, all we do is check that the names are in scope.
324 It's only imported deprecations, dealt with in RnIfaces, that we
325 gather them together.
328 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
329 -> [RdrNameDeprecation] -> RnMG Deprecations
330 rnDeprecs gbl_env Nothing []
333 rnDeprecs gbl_env (Just txt) decls
334 = mapRn (addErrRn . badDeprec) decls `thenRn_`
335 returnRn (DeprecAll txt)
337 rnDeprecs gbl_env Nothing decls
338 = mapRn rn_deprec decls `thenRn` \ pairs ->
339 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
341 rn_deprec (Deprecation rdr_name txt loc)
343 lookupGlobalRn gbl_env rdr_name `thenRn` \ maybe_name ->
345 Just n -> returnRn (Just (n,txt))
346 Nothing -> returnRn Nothing
350 %************************************************************************
352 \subsection{Grabbing the old interface file and checking versions}
354 %************************************************************************
357 checkOldIface :: DynFlags -> Finder
358 -> HomeIfaceTable -> HomeSymbolTable
359 -> PersistentCompilerState
361 -> Bool -- Source unchanged
362 -> Maybe ModIface -- Old interface from compilation manager, if any
363 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
364 -- True <=> errors happened
366 checkOldIface dflags finder hit hst pcs mod source_unchanged maybe_iface
367 = initRn dflags finder hit hst pcs mod $
369 -- Load the old interface file, if we havn't already got it
370 loadOldIface mod maybe_iface `thenRn` \ maybe_iface ->
373 recompileRequired mod source_unchanged maybe_iface `thenRn` \ recompile ->
375 returnRn (recompile, maybe_iface)
380 loadOldIface :: Module -> Maybe ModIface -> RnMG (Maybe ModIface)
381 loadOldIface mod (Just iface)
382 = returnRn (Just iface)
384 loadOldIface mod Nothing
385 = -- LOAD THE OLD INTERFACE FILE
386 findAndReadIface doc_str (moduleName mod) False {- Not hi-boot -} `thenRn` \ read_result ->
387 case read_result of {
388 Left err -> -- Old interface file not found, or garbled, so we'd better bail out
389 traceRn (vcat [ptext SLIT("No old interface file:"), err]) `thenRn_`
396 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
397 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
398 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
399 returnRn (decls, rules, insts)
400 ) `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
402 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
403 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
404 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
405 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
407 version = VersionInfo { vers_module = pi_vers iface,
408 vers_exports = export_vers,
409 vers_rules = rule_vers,
410 vers_decls = decls_vers }
412 decls = IfaceDecls { dcl_tycl = new_decls,
413 dcl_rules = new_rules,
414 dcl_insts = new_insts }
416 mod_iface = ModIface { mi_module = mod, mi_version = version,
417 mi_exports = avails, mi_orphan = pi_orphan iface,
418 mi_fixities = fix_env, mi_deprecs = deprec_env,
421 mi_globals = panic "No mi_globals in old interface"
424 returnRn (Just mod_iface)
429 doc_str = ptext SLIT("need usage info from") <+> ppr mod
433 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
434 -> RnMS (NameEnv Version, [RenamedTyClDecl])
435 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
437 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
438 -> (Version, RdrNameTyClDecl)
439 -> RnMS (NameEnv Version, [RenamedTyClDecl])
440 loadHomeDecl (version_map, decls) (version, decl)
441 = rnTyClDecl decl `thenRn` \ (decl', _) ->
442 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
445 loadHomeRules :: (Version, [RdrNameRuleDecl])
446 -> RnMS (Version, [RenamedRuleDecl])
447 loadHomeRules (version, rules)
448 = mapAndUnzipRn rnRuleDecl rules `thenRn` \ (rules', _) ->
449 returnRn (version, rules')
452 loadHomeInsts :: [RdrNameInstDecl]
453 -> RnMS [RenamedInstDecl]
454 loadHomeInsts insts = mapAndUnzipRn rnInstDecl insts `thenRn` \ (insts', _) ->
458 loadHomeUsage :: ImportVersion OccName
459 -> RnMG (ImportVersion Name)
460 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
461 = rn_imps whats_imported `thenRn` \ whats_imported' ->
462 returnRn (mod_name, orphans, is_boot, whats_imported')
464 rn_imps NothingAtAll = returnRn NothingAtAll
465 rn_imps (Everything v) = returnRn (Everything v)
466 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
467 returnRn (Specifically mv ev items' rv)
468 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
474 %*********************************************************
476 \subsection{Closing up the interface decls}
478 %*********************************************************
480 Suppose we discover we don't need to recompile. Then we start from the
481 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
484 closeIfaceDecls :: DynFlags -> Finder
485 -> HomeIfaceTable -> HomeSymbolTable
486 -> PersistentCompilerState
487 -> ModIface -- Get the decls from here
488 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
489 -- True <=> errors happened
490 closeIfaceDecls dflags finder hit hst pcs mod
491 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
492 = initRn dflags finder hit hst pcs mod $
495 rule_decls = dcl_rules iface_decls
496 inst_decls = dcl_insts iface_decls
497 tycl_decls = dcl_tycl iface_decls
498 decls = map RuleD rule_decls ++
499 map InstD inst_decls ++
501 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
502 unionManyNameSets (map instDeclFVs rule_decls) `unionNameSets`
503 unionManyNameSets (map tyClDeclFVs rule_decls)
505 closeDecls decls needed
508 %*********************************************************
510 \subsection{Unused names}
512 %*********************************************************
515 reportUnusedNames :: ModuleName -> [ModuleName]
516 -> GlobalRdrEnv -> AvailEnv
517 -> Avails -> NameSet -> [RenamedHsDecl]
519 reportUnusedNames mod_name direct_import_mods
521 export_avails mentioned_names
523 = warnUnusedModules unused_imp_mods `thenRn_`
524 warnUnusedLocalBinds bad_locals `thenRn_`
525 warnUnusedImports bad_imp_names `thenRn_`
526 printMinimalImports mod_name minimal_imports `thenRn_`
527 warnDeprecations really_used_names `thenRn_`
531 used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
533 -- Now, a use of C implies a use of T,
534 -- if C was brought into scope by T(..) or T(C)
535 really_used_names = used_names `unionNameSets`
536 mkNameSet [ parent_name
537 | sub_name <- nameSetToList used_names
539 -- Usually, every used name will appear in avail_env, but there
540 -- is one time when it doesn't: tuples and other built in syntax. When you
541 -- write (a,b) that gives rise to a *use* of "(,)", so that the
542 -- instances will get pulled in, but the tycon "(,)" isn't actually
543 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
544 -- similarly, 3.5 gives rise to an implcit use of :%
545 -- Hence the silent 'False' in all other cases
547 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
548 Just (AvailTC n _) -> Just n
552 defined_names, defined_and_used, defined_but_not_used :: [(Name,Provenance)]
553 defined_names = concat (rdrEnvElts gbl_env)
554 (defined_and_used, defined_but_not_used) = partition used defined_names
555 used (name,_) = not (name `elemNameSet` really_used_names)
557 -- Filter out the ones only defined implicitly
559 bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
561 bad_imp_names :: [(Name,Provenance)]
562 bad_imp_names = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True) _)) <- defined_but_not_used,
563 not (module_unused mod)]
565 -- inst_mods are directly-imported modules that
566 -- contain instance decl(s) that the renamer decided to suck in
567 -- It's not necessarily redundant to import such modules.
573 -- The import M() is not *necessarily* redundant, even if
574 -- we suck in no instance decls from M (e.g. it contains
575 -- no instance decls, or This contains no code). It may be
576 -- that we import M solely to ensure that M's orphan instance
577 -- decls (or those in its imports) are visible to people who
578 -- import This. Sigh.
579 -- There's really no good way to detect this, so the error message
580 -- in RnEnv.warnUnusedModules is weakened instead
581 inst_mods :: [ModuleName]
582 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
583 let m = moduleName (nameModule dfun),
584 m `elem` direct_import_mods
587 -- To figure out the minimal set of imports, start with the things
588 -- that are in scope (i.e. in gbl_env). Then just combine them
589 -- into a bunch of avails, so they are properly grouped
590 minimal_imports :: FiniteMap ModuleName AvailEnv
591 minimal_imports0 = emptyFM
592 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
593 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
595 add_name (n,NonLocalDef (UserImport m _ _) _) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
596 (unitAvailEnv (mk_avail n))
597 add_name (n,other_prov) acc = acc
599 mk_avail n = case lookupNameEnv avail_env n of
600 Just (AvailTC m _) | n==m -> AvailTC n [n]
601 | otherwise -> AvailTC m [n,m]
602 Just avail -> Avail n
603 Nothing -> pprPanic "mk_avail" (ppr n)
606 | m `elemFM` acc = acc -- We import something already
607 | otherwise = addToFM acc m emptyAvailEnv
608 -- Add an empty collection of imports for a module
609 -- from which we have sucked only instance decls
611 -- unused_imp_mods are the directly-imported modules
612 -- that are not mentioned in minimal_imports
613 unused_imp_mods = [m | m <- direct_import_mods,
614 not (maybeToBool (lookupFM minimal_imports m)),
617 module_unused :: Module -> Bool
618 module_unused mod = moduleName mod `elem` unused_imp_mods
621 warnDeprecations used_names
622 = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
623 if not warn_drs then returnRn () else
625 getIfacesRn `thenRn` \ ifaces ->
626 getHomeIfaceTableRn `thenRn` \ hit ->
630 | n <- nameSetToList used_names,
631 Just txt <- [lookup_deprec hit pit n] ]
633 mapRn_ warnDeprec deprecs
636 lookup_deprec hit pit n
637 = case lookupModuleEnv hit mod of
638 Just iface -> lookupDeprec iface n
639 Nothing -> case lookupModuleEnv pit mod of
640 Just iface -> lookupDeprec iface n
641 Nothing -> pprPanic "warnDeprecations:" (ppr n)
645 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
646 printMinimalImports mod_name imps
647 = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
648 if not dump_minimal then returnRn () else
650 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
651 ioToRnM (do { h <- openFile filename WriteMode ;
652 printForUser h (vcat (map ppr_mod_ie mod_ies))
656 filename = moduleNameUserString mod_name ++ ".imports"
657 ppr_mod_ie (mod_name, ies)
658 | mod_name == pRELUDE_Name
661 = ptext SLIT("import") <+> ppr mod_name <>
662 parens (fsep (punctuate comma (map ppr ies)))
664 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
667 to_ie :: AvailInfo -> RnMG (IE Name)
668 to_ie (Avail n) = returnRn (IEVar n)
669 to_ie (AvailTC n [m]) = ASSERT( n==m )
670 returnRn (IEThingAbs n)
671 to_ie (AvailTC n ns) = getInterfaceExports (moduleName (nameModule n))
672 ImportBySystem `thenRn` \ (_, avails) ->
673 case [ms | AvailTC m ms <- avails, m == n] of
674 [ms] | all (`elem` ns) ms -> returnRn (IEThingAll n)
675 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
676 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
679 rnDump :: [RenamedHsDecl] -- Renamed imported decls
680 -> [RenamedHsDecl] -- Renamed local decls
682 rnDump imp_decls local_decls
683 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
684 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
685 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
686 getIfacesRn `thenRn` \ ifaces ->
688 ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
690 (getRnStats imp_decls ifaces) ;
692 dumpIfSet dump_rn "Renamer:"
693 (vcat (map ppr (local_decls ++ imp_decls)))
700 %*********************************************************
702 \subsection{Statistics}
704 %*********************************************************
707 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
708 getRnStats imported_decls ifaces
709 = hcat [text "Renamer stats: ", stats])
711 n_mods = length [() | (_, _, True) <- eltsFM (iImpModInfo ifaces)]
713 decls_read = [decl | (avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
714 -- Data, newtype, and class decls are in the decls_fm
715 -- under multiple names; the tycon/class, and each
716 -- constructor/class op too.
717 -- The 'True' selects just the 'main' decl
718 not (isLocallyDefined (availName avail))
721 (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd) = countTyClDecls decls_read
722 (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
724 unslurped_insts = iInsts ifaces
725 inst_decls_unslurped = length (bagToList unslurped_insts)
726 inst_decls_read = id_sp + inst_decls_unslurped
729 [int n_mods <+> text "interfaces read",
730 hsep [ int cd_sp, text "class decls imported, out of",
731 int cd_rd, text "read"],
732 hsep [ int dd_sp, text "data decls imported, out of",
733 int dd_rd, text "read"],
734 hsep [ int nd_sp, text "newtype decls imported, out of",
735 int nd_rd, text "read"],
736 hsep [int sd_sp, text "type synonym decls imported, out of",
737 int sd_rd, text "read"],
738 hsep [int vd_sp, text "value signatures imported, out of",
739 int vd_rd, text "read"],
740 hsep [int id_sp, text "instance decls imported, out of",
741 int inst_decls_read, text "read"],
742 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
743 [d | TyClD d <- imported_decls, isClassDecl d]),
744 text "cls dcls read" <+> fsep (map (ppr . tyClDeclName)
745 [d | d <- decls_read, isClassDecl d])]
755 tycl_decls = [d | TyClD d <- decls]
756 (class_decls, data_decls, newtype_decls, syn_decls, val_decls) = countTyClDecls tycl_decls
758 inst_decls = length [() | InstD _ <- decls]
762 %************************************************************************
764 \subsection{Errors and warnings}
766 %************************************************************************
769 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
770 warnDeprec (name, txt)
771 = pushSrcLocRn (getSrcLoc name) $
773 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
774 text "is deprecated:", nest 4 (ppr txt) ]
777 unusedFixityDecl rdr_name fixity
778 = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
780 dupFixityDecl rdr_name loc1 loc2
781 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
782 ptext SLIT("at ") <+> ppr loc1,
783 ptext SLIT("and") <+> ppr loc2]
786 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),