2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[Rename]{Renaming and dependency analysis passes}
7 module Rename ( renameModule, renameStmt, closeIfaceDecls, checkOldIface ) where
9 #include "HsVersions.h"
12 import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation,
13 RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl,
16 import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
18 instDeclFVs, tyClDeclFVs, ruleDeclFVs
21 import CmdLineOpts ( DynFlags, DynFlag(..) )
23 import RnExpr ( rnStmt )
24 import RnNames ( getGlobalNames, exportsFromAvail )
25 import RnSource ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
26 import RnIfaces ( slurpImpDecls, mkImportInfo, recordLocalSlurps,
28 RecompileRequired, outOfDate, recompileRequired
30 import RnHiFiles ( readIface, loadInterface,
31 loadExports, loadFixDecls, loadDeprecs,
33 import RnEnv ( availsToNameSet, mkIfaceGlobalRdrEnv,
34 emptyAvailEnv, unitAvailEnv, availEnvElts,
35 plusAvailEnv, groupAvails, warnUnusedImports,
36 warnUnusedLocalBinds, warnUnusedModules,
37 lookupSrcName, getImplicitStmtFVs, getImplicitModuleFVs, rnSyntaxNames,
38 newGlobalName, unQualInScope,, ubiquitousNames
40 import Module ( Module, ModuleName, WhereFrom(..),
41 moduleNameUserString, moduleName,
44 import Name ( Name, nameModule )
47 import RdrName ( foldRdrEnv, isQual )
48 import PrelNames ( SyntaxMap, vanillaSyntaxMap, pRELUDE_Name )
49 import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass,
50 printErrorsAndWarnings, errorsFound )
51 import Bag ( bagToList )
52 import FiniteMap ( FiniteMap, fmToList, emptyFM, lookupFM,
53 addToFM_C, elemFM, addToFM
55 import Maybes ( maybeToBool, catMaybes )
57 import IO ( openFile, IOMode(..) )
58 import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
59 ModIface(..), WhatsImported(..),
60 VersionInfo(..), ImportVersion, IsExported,
61 IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
62 GlobalRdrEnv, GlobalRdrElt(..), pprGlobalRdrEnv,
63 AvailEnv, GenAvailInfo(..), AvailInfo,
64 Provenance(..), ImportReason(..), initialVersionInfo,
65 Deprecations(..), GhciMode(..),
68 import List ( partition, nub )
74 %*********************************************************
76 \subsection{The two main wrappers}
78 %*********************************************************
81 renameModule :: DynFlags
82 -> HomeIfaceTable -> HomeSymbolTable
83 -> PersistentCompilerState
84 -> Module -> RdrNameHsModule
85 -> IO (PersistentCompilerState, PrintUnqualified,
86 Maybe (IsExported, ModIface, (SyntaxMap, [RenamedHsDecl])))
87 -- Nothing => some error occurred in the renamer
89 renameModule dflags hit hst pcs this_module rdr_module
90 = renameSource dflags hit hst pcs this_module $
91 rename this_module rdr_module
96 renameStmt :: DynFlags
97 -> HomeIfaceTable -> HomeSymbolTable
98 -> PersistentCompilerState
99 -> Module -- current context (scope to compile in)
100 -> Module -- current module
101 -> LocalRdrEnv -- current context (temp bindings)
102 -> RdrNameStmt -- parsed stmt
103 -> IO ( PersistentCompilerState,
105 Maybe ([Name], (SyntaxMap, RenamedStmt, [RenamedHsDecl]))
108 renameStmt dflags hit hst pcs scope_module this_module local_env stmt
109 = renameSource dflags hit hst pcs this_module $
111 -- Load the interface for the context module, so
112 -- that we can get its top-level lexical environment
113 -- Bale out if we fail to do this
114 loadInterface doc (moduleName scope_module) ImportByUser `thenRn` \ iface ->
115 let rdr_env = mi_globals iface
116 print_unqual = unQualInScope rdr_env
118 checkErrsRn `thenRn` \ no_errs_so_far ->
119 if not no_errs_so_far then
120 returnRn (print_unqual, Nothing)
124 initRnMS rdr_env local_env emptyLocalFixityEnv CmdLineMode (
125 rnStmt stmt $ \ stmt' ->
126 returnRn (([], stmt'), emptyFVs)
127 ) `thenRn` \ ((binders, stmt), fvs) ->
129 -- Bale out if we fail
130 checkErrsRn `thenRn` \ no_errs_so_far ->
131 if not no_errs_so_far then
132 doDump [] stmt [] `thenRn_` returnRn (print_unqual, Nothing)
135 -- Add implicit free vars, and close decls
136 getImplicitStmtFVs `thenRn` \ implicit_fvs ->
138 filtered_fvs = fvs `delListFromNameSet` rdrEnvElts local_env
139 source_fvs = implicit_fvs `plusFV` filtered_fvs
141 slurpImpDecls source_fvs `thenRn` \ decls ->
143 doDump binders stmt decls `thenRn_`
144 returnRn (print_unqual, Just (binders, (vanillaSyntaxMap, stmt, decls)))
147 doc = text "context for compiling expression"
149 doDump :: [Name] -> RenamedStmt -> [RenamedHsDecl] -> RnMG (Either IOError ())
150 doDump bndrs stmt decls
151 = getDOptsRn `thenRn` \ dflags ->
152 ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
153 (vcat [text "Binders:" <+> ppr bndrs,
155 vcat (map ppr decls)]))
159 %*********************************************************
161 \subsection{The main function: rename}
163 %*********************************************************
166 renameSource :: DynFlags
167 -> HomeIfaceTable -> HomeSymbolTable
168 -> PersistentCompilerState
170 -> RnMG (PrintUnqualified, Maybe r)
171 -> IO (PersistentCompilerState, PrintUnqualified, Maybe r)
172 -- Nothing => some error occurred in the renamer
174 renameSource dflags hit hst old_pcs this_module thing_inside
175 = do { showPass dflags "Renamer"
177 -- Initialise the renamer monad
178 ; (new_pcs, msgs, (print_unqual, maybe_rn_stuff))
179 <- initRn dflags hit hst old_pcs this_module thing_inside
181 -- Print errors from renaming
182 ; printErrorsAndWarnings print_unqual msgs ;
184 -- Return results. No harm in updating the PCS
185 ; if errorsFound msgs then
186 return (new_pcs, print_unqual, Nothing)
188 return (new_pcs, print_unqual, maybe_rn_stuff)
193 rename :: Module -> RdrNameHsModule
194 -> RnMG (PrintUnqualified, Maybe (IsExported, ModIface, (SyntaxMap, [RenamedHsDecl])))
195 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
198 -- FIND THE GLOBAL NAME ENVIRONMENT
199 getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
201 print_unqualified = unQualInScope gbl_env
203 -- Exit if we've found any errors
204 checkErrsRn `thenRn` \ no_errs_so_far ->
205 if not no_errs_so_far then
206 -- Found errors already, so exit now
207 rnDump [] [] `thenRn_`
208 returnRn (print_unqualified, Nothing)
211 -- PROCESS EXPORT LIST
212 exportsFromAvail mod_name exports all_avails gbl_env `thenRn` \ export_avails ->
214 traceRn (text "Local top-level environment" $$
215 nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
217 -- DEAL WITH DEPRECATIONS
218 rnDeprecs local_gbl_env mod_deprec
219 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
221 -- DEAL WITH LOCAL FIXITIES
222 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
225 rnSourceDecls gbl_env local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
227 -- EXIT IF ERRORS FOUND
228 -- We exit here if there are any errors in the source, *before*
229 -- we attempt to slurp the decls from the interfaces, otherwise
230 -- the slurped decls may get lost when we return up the stack
231 -- to hscMain/hscExpr.
232 checkErrsRn `thenRn` \ no_errs_so_far ->
233 if not no_errs_so_far then
234 -- Found errors already, so exit now
235 rnDump [] rn_local_decls `thenRn_`
236 returnRn (print_unqualified, Nothing)
239 -- SLURP IN ALL THE NEEDED DECLARATIONS
240 -- Find out what re-bindable names to use for desugaring
241 getImplicitModuleFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
242 rnSyntaxNames gbl_env source_fvs `thenRn` \ (source_fvs1, sugar_map) ->
244 export_fvs = availsToNameSet export_avails
245 source_fvs2 = source_fvs1 `plusFV` export_fvs
246 -- The export_fvs make the exported names look just as if they
247 -- occurred in the source program. For the reasoning, see the
248 -- comments with RnIfaces.mkImportInfo
249 -- It also helps reportUnusedNames, which of course must not complain
250 -- that 'f' isn't mentioned if it is mentioned in the export list
252 source_fvs3 = implicit_fvs `plusFV` source_fvs2
253 -- It's important to do the "plus" this way round, so that
254 -- when compiling the prelude, locally-defined (), Bool, etc
255 -- override the implicit ones.
258 traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList source_fvs3))) `thenRn_`
259 slurpImpDecls source_fvs3 `thenRn` \ rn_imp_decls ->
260 rnDump rn_imp_decls rn_local_decls `thenRn_`
262 -- GENERATE THE VERSION/USAGE INFO
263 mkImportInfo mod_name imports `thenRn` \ my_usages ->
265 -- BUILD THE MODULE INTERFACE
267 -- We record fixities even for things that aren't exported,
268 -- so that we can change into the context of this moodule easily
269 fixities = mkNameEnv [ (name, fixity)
270 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
273 -- Sort the exports to make them easier to compare for versions
274 my_exports = groupAvails this_module export_avails
276 final_decls = rn_local_decls ++ rn_imp_decls
278 mod_iface = ModIface { mi_module = this_module,
279 mi_version = initialVersionInfo,
280 mi_usages = my_usages,
282 mi_orphan = panic "is_orphan",
283 mi_exports = my_exports,
284 mi_globals = gbl_env,
285 mi_fixities = fixities,
286 mi_deprecs = my_deprecs,
287 mi_decls = panic "mi_decls"
290 is_exported name = name `elemNameSet` exported_names
291 exported_names = availsToNameSet export_avails
294 -- REPORT UNUSED NAMES, AND DEBUG DUMP
295 reportUnusedNames mod_iface print_unqualified
296 imports global_avail_env
297 source_fvs2 rn_imp_decls `thenRn_`
298 -- NB: source_fvs2: include exports (else we get bogus
299 -- warnings of unused things) but not implicit FVs.
301 returnRn (print_unqualified, Just (is_exported, mod_iface, (sugar_map, final_decls)))
303 mod_name = moduleName this_module
308 %*********************************************************
310 \subsection{Fixities}
312 %*********************************************************
315 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
316 fixitiesFromLocalDecls gbl_env decls
317 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
318 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
321 getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
322 getFixities acc (FixD fix)
325 getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
326 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
327 -- Get fixities from class decl sigs too.
328 getFixities acc other_decl
331 fix_decl acc sig@(FixitySig rdr_name fixity loc)
332 = -- Check for fixity decl for something not declared
334 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
336 -- Check for duplicate fixity decl
337 case lookupNameEnv acc name of
338 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc') `thenRn_`
341 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
345 %*********************************************************
347 \subsection{Deprecations}
349 %*********************************************************
351 For deprecations, all we do is check that the names are in scope.
352 It's only imported deprecations, dealt with in RnIfaces, that we
353 gather them together.
356 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
357 -> [RdrNameDeprecation] -> RnMG Deprecations
358 rnDeprecs gbl_env Nothing []
361 rnDeprecs gbl_env (Just txt) decls
362 = mapRn (addErrRn . badDeprec) decls `thenRn_`
363 returnRn (DeprecAll txt)
365 rnDeprecs gbl_env Nothing decls
366 = mapRn rn_deprec decls `thenRn` \ pairs ->
367 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
369 rn_deprec (Deprecation rdr_name txt loc)
371 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
372 returnRn (Just (name, (name,txt)))
376 %************************************************************************
378 \subsection{Grabbing the old interface file and checking versions}
380 %************************************************************************
383 checkOldIface :: GhciMode
385 -> HomeIfaceTable -> HomeSymbolTable
386 -> PersistentCompilerState
388 -> Bool -- Source unchanged
389 -> Maybe ModIface -- Old interface from compilation manager, if any
390 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
391 -- True <=> errors happened
393 checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
394 = runRn dflags hit hst pcs (panic "Bogus module") $
396 -- CHECK WHETHER THE SOURCE HAS CHANGED
397 ( if not source_unchanged then
398 traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))
399 else returnRn () ) `thenRn_`
401 -- If the source has changed and we're in interactive mode, avoid reading
402 -- an interface; just return the one we might have been supplied with.
403 if ghci_mode == Interactive && not source_unchanged then
404 returnRn (outOfDate, maybe_iface)
408 Just old_iface -> -- Use the one we already have
409 setModuleRn (mi_module old_iface) (check_versions old_iface)
411 Nothing -- try and read it from a file
412 -> readIface iface_path `thenRn` \ read_result ->
414 Left err -> -- Old interface file not found, or garbled; give up
416 text "Cannot read old interface file:"
417 $$ nest 4 err) `thenRn_`
418 returnRn (outOfDate, Nothing)
421 -> setModuleRn (pi_mod parsed_iface) $
422 loadOldIface parsed_iface `thenRn` \ m_iface ->
423 check_versions m_iface
425 check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
427 | not source_unchanged
428 = returnRn (outOfDate, Just iface)
431 recompileRequired iface_path iface `thenRn` \ recompile ->
432 returnRn (recompile, Just iface)
435 I think the following function should now have a more representative name,
439 loadOldIface :: ParsedIface -> RnMG ModIface
441 loadOldIface parsed_iface
442 = let iface = parsed_iface
446 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
447 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
448 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
449 returnRn (decls, rules, insts)
451 `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
453 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
454 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
455 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
456 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
458 version = VersionInfo { vers_module = pi_vers iface,
459 vers_exports = export_vers,
460 vers_rules = rule_vers,
461 vers_decls = decls_vers }
463 decls = mkIfaceDecls new_decls new_rules new_insts
465 mod_iface = ModIface { mi_module = mod, mi_version = version,
466 mi_exports = avails, mi_usages = usages,
467 mi_boot = False, mi_orphan = pi_orphan iface,
468 mi_fixities = fix_env, mi_deprecs = deprec_env,
470 mi_globals = mkIfaceGlobalRdrEnv avails
477 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
478 -> RnMS (NameEnv Version, [RenamedTyClDecl])
479 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
481 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
482 -> (Version, RdrNameTyClDecl)
483 -> RnMS (NameEnv Version, [RenamedTyClDecl])
484 loadHomeDecl (version_map, decls) (version, decl)
485 = rnTyClDecl decl `thenRn` \ decl' ->
486 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
489 loadHomeRules :: (Version, [RdrNameRuleDecl])
490 -> RnMS (Version, [RenamedRuleDecl])
491 loadHomeRules (version, rules)
492 = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
493 returnRn (version, rules')
496 loadHomeInsts :: [RdrNameInstDecl]
497 -> RnMS [RenamedInstDecl]
498 loadHomeInsts insts = mapRn rnInstDecl insts
501 loadHomeUsage :: ImportVersion OccName
502 -> RnMG (ImportVersion Name)
503 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
504 = rn_imps whats_imported `thenRn` \ whats_imported' ->
505 returnRn (mod_name, orphans, is_boot, whats_imported')
507 rn_imps NothingAtAll = returnRn NothingAtAll
508 rn_imps (Everything v) = returnRn (Everything v)
509 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
510 returnRn (Specifically mv ev items' rv)
511 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
517 %*********************************************************
519 \subsection{Closing up the interface decls}
521 %*********************************************************
523 Suppose we discover we don't need to recompile. Then we start from the
524 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
527 closeIfaceDecls :: DynFlags
528 -> HomeIfaceTable -> HomeSymbolTable
529 -> PersistentCompilerState
530 -> ModIface -- Get the decls from here
531 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
532 -- True <=> errors happened
533 closeIfaceDecls dflags hit hst pcs
534 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
535 = runRn dflags hit hst pcs mod $
538 rule_decls = dcl_rules iface_decls
539 inst_decls = dcl_insts iface_decls
540 tycl_decls = dcl_tycl iface_decls
541 decls = map RuleD rule_decls ++
542 map InstD inst_decls ++
544 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
545 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
546 unionManyNameSets (map tyClDeclFVs tycl_decls)
547 local_names = foldl add emptyNameSet tycl_decls
548 add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
551 recordLocalSlurps local_names `thenRn_`
553 -- Do the transitive closure
554 closeDecls decls (needed `plusFV` implicit_fvs) `thenRn` \closed_decls ->
555 rnDump [] closed_decls `thenRn_`
556 returnRn closed_decls
558 implicit_fvs = ubiquitousNames -- Data type decls with record selectors,
559 -- which may appear in the decls, need unpackCString
560 -- and friends. It's easier to just grab them right now.
563 %*********************************************************
565 \subsection{Unused names}
567 %*********************************************************
570 reportUnusedNames :: ModIface -> PrintUnqualified
571 -> [RdrNameImportDecl]
573 -> NameSet -- Used in this module
576 reportUnusedNames my_mod_iface unqual imports avail_env
577 used_names imported_decls
578 = warnUnusedModules unused_imp_mods `thenRn_`
579 warnUnusedLocalBinds bad_locals `thenRn_`
580 warnUnusedImports bad_imp_names `thenRn_`
581 printMinimalImports this_mod unqual minimal_imports
583 this_mod = mi_module my_mod_iface
584 gbl_env = mi_globals my_mod_iface
586 -- Now, a use of C implies a use of T,
587 -- if C was brought into scope by T(..) or T(C)
588 really_used_names = used_names `unionNameSets`
589 mkNameSet [ parent_name
590 | sub_name <- nameSetToList used_names
592 -- Usually, every used name will appear in avail_env, but there
593 -- is one time when it doesn't: tuples and other built in syntax. When you
594 -- write (a,b) that gives rise to a *use* of "(,)", so that the
595 -- instances will get pulled in, but the tycon "(,)" isn't actually
596 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
597 -- similarly, 3.5 gives rise to an implcit use of :%
598 -- Hence the silent 'False' in all other cases
600 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
601 Just (AvailTC n _) -> Just n
605 -- Collect the defined names from the in-scope environment
606 -- Look for the qualified ones only, else get duplicates
607 defined_names :: [GlobalRdrElt]
608 defined_names = foldRdrEnv add [] gbl_env
609 add rdr_name ns acc | isQual rdr_name = ns ++ acc
612 defined_and_used, defined_but_not_used :: [GlobalRdrElt]
613 (defined_and_used, defined_but_not_used) = partition used defined_names
614 used (GRE name _ _) = name `elemNameSet` really_used_names
616 -- Filter out the ones only defined implicitly
618 bad_locals = [n | (GRE n LocalDef _) <- defined_but_not_used]
620 bad_imp_names :: [(Name,Provenance)]
621 bad_imp_names = [(n,p) | GRE n p@(NonLocalDef (UserImport mod _ True)) _ <- defined_but_not_used,
622 not (module_unused mod)]
624 -- inst_mods are directly-imported modules that
625 -- contain instance decl(s) that the renamer decided to suck in
626 -- It's not necessarily redundant to import such modules.
632 -- The import M() is not *necessarily* redundant, even if
633 -- we suck in no instance decls from M (e.g. it contains
634 -- no instance decls, or This contains no code). It may be
635 -- that we import M solely to ensure that M's orphan instance
636 -- decls (or those in its imports) are visible to people who
637 -- import This. Sigh.
638 -- There's really no good way to detect this, so the error message
639 -- in RnEnv.warnUnusedModules is weakened instead
640 inst_mods :: [ModuleName]
641 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
642 let m = moduleName (nameModule dfun),
643 m `elem` direct_import_mods
646 -- To figure out the minimal set of imports, start with the things
647 -- that are in scope (i.e. in gbl_env). Then just combine them
648 -- into a bunch of avails, so they are properly grouped
649 minimal_imports :: FiniteMap ModuleName AvailEnv
650 minimal_imports0 = emptyFM
651 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
652 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
654 -- We've carefully preserved the provenance so that we can
655 -- construct minimal imports that import the name by (one of)
656 -- the same route(s) as the programmer originally did.
657 add_name (GRE n (NonLocalDef (UserImport m _ _)) _) acc = addToFM_C plusAvailEnv acc (moduleName m)
658 (unitAvailEnv (mk_avail n))
659 add_name (GRE n other_prov _) acc = acc
661 mk_avail n = case lookupNameEnv avail_env n of
662 Just (AvailTC m _) | n==m -> AvailTC n [n]
663 | otherwise -> AvailTC m [n,m]
664 Just avail -> Avail n
665 Nothing -> pprPanic "mk_avail" (ppr n)
668 | m `elemFM` acc = acc -- We import something already
669 | otherwise = addToFM acc m emptyAvailEnv
670 -- Add an empty collection of imports for a module
671 -- from which we have sucked only instance decls
673 direct_import_mods :: [ModuleName]
674 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
676 -- unused_imp_mods are the directly-imported modules
677 -- that are not mentioned in minimal_imports
678 unused_imp_mods = [m | m <- direct_import_mods,
679 not (maybeToBool (lookupFM minimal_imports m)),
682 module_unused :: Module -> Bool
683 module_unused mod = moduleName mod `elem` unused_imp_mods
686 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
687 printMinimalImports :: Module -- This module
689 -> FiniteMap ModuleName AvailEnv -- Minimal imports
691 printMinimalImports this_mod unqual imps
692 = ifOptRn Opt_D_dump_minimal_imports $
694 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
695 ioToRnM (do { h <- openFile filename WriteMode ;
696 printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
700 filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
701 ppr_mod_ie (mod_name, ies)
702 | mod_name == pRELUDE_Name
705 = ptext SLIT("import") <+> ppr mod_name <>
706 parens (fsep (punctuate comma (map ppr ies)))
708 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
711 to_ie :: AvailInfo -> RnMG (IE Name)
712 -- The main trick here is that if we're importing all the constructors
713 -- we want to say "T(..)", but if we're importing only a subset we want
714 -- to say "T(A,B,C)". So we have to find out what the module exports.
715 to_ie (Avail n) = returnRn (IEVar n)
716 to_ie (AvailTC n [m]) = ASSERT( n==m )
717 returnRn (IEThingAbs n)
719 = loadInterface (text "Compute minimal imports from" <+> ppr n_mod) n_mod ImportBySystem `thenRn` \ iface ->
720 case [xs | (m,as) <- mi_exports iface,
724 [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
725 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
726 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
729 n_mod = moduleName (nameModule n)
731 rnDump :: [RenamedHsDecl] -- Renamed imported decls
732 -> [RenamedHsDecl] -- Renamed local decls
734 rnDump imp_decls local_decls
735 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
736 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
737 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
738 getIfacesRn `thenRn` \ ifaces ->
740 ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
742 (getRnStats imp_decls ifaces) ;
744 dumpIfSet dump_rn "Renamer:"
745 (vcat (map ppr (local_decls ++ imp_decls)))
752 %*********************************************************
754 \subsection{Statistics}
756 %*********************************************************
759 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
760 getRnStats imported_decls ifaces
761 = hcat [text "Renamer stats: ", stats]
763 n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
764 -- This is really only right for a one-shot compile
766 (decls_map, n_decls_slurped) = iDecls ifaces
768 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
769 -- Data, newtype, and class decls are in the decls_fm
770 -- under multiple names; the tycon/class, and each
771 -- constructor/class op too.
772 -- The 'True' selects just the 'main' decl
775 (insts_left, n_insts_slurped) = iInsts ifaces
776 n_insts_left = length (bagToList insts_left)
778 (rules_left, n_rules_slurped) = iRules ifaces
779 n_rules_left = length (bagToList rules_left)
782 [int n_mods <+> text "interfaces read",
783 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
784 int (n_decls_slurped + n_decls_left), text "read"],
785 hsep [ int n_insts_slurped, text "instance decls imported, out of",
786 int (n_insts_slurped + n_insts_left), text "read"],
787 hsep [ int n_rules_slurped, text "rule decls imported, out of",
788 int (n_rules_slurped + n_rules_left), text "read"]
793 %************************************************************************
795 \subsection{Errors and warnings}
797 %************************************************************************
800 dupFixityDecl rdr_name loc1 loc2
801 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
802 ptext SLIT("at ") <+> ppr loc1,
803 ptext SLIT("and") <+> ppr loc2]
806 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),