2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[Rename]{Renaming and dependency analysis passes}
7 module Rename ( renameModule, renameExpr, closeIfaceDecls, checkOldIface ) where
9 #include "HsVersions.h"
12 import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation, RdrNameHsExpr,
13 RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl
15 import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
16 extractHsTyNames, RenamedHsExpr,
17 instDeclFVs, tyClDeclFVs, ruleDeclFVs
20 import CmdLineOpts ( DynFlags, DynFlag(..) )
22 import RnExpr ( rnExpr )
23 import RnNames ( getGlobalNames, exportsFromAvail )
24 import RnSource ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
25 import RnIfaces ( slurpImpDecls, mkImportInfo, recordLocalSlurps,
27 RecompileRequired, outOfDate, recompileRequired
29 import RnHiFiles ( readIface, removeContext, loadInterface,
30 loadExports, loadFixDecls, loadDeprecs,
32 import RnEnv ( availsToNameSet, mkIfaceGlobalRdrEnv,
33 emptyAvailEnv, unitAvailEnv, availEnvElts,
34 plusAvailEnv, groupAvails, warnUnusedImports,
35 warnUnusedLocalBinds, warnUnusedModules,
36 lookupSrcName, addImplicitFVs,
37 newGlobalName, unQualInScope,, ubiquitousNames
39 import Module ( Module, ModuleName, WhereFrom(..),
40 moduleNameUserString, moduleName,
43 import Name ( Name, NamedThing(..),
44 nameIsLocalOrFrom, nameOccName, nameModule,
46 import Name ( mkNameEnv, nameEnvElts, extendNameEnv )
47 import RdrName ( foldRdrEnv, isQual )
49 import PrelNames ( SyntaxMap, pRELUDE_Name )
50 import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass,
51 printErrorsAndWarnings, errorsFound )
52 import Bag ( bagToList )
53 import FiniteMap ( FiniteMap, fmToList, emptyFM, lookupFM,
54 addToFM_C, elemFM, addToFM
56 import Maybes ( maybeToBool, catMaybes )
58 import IO ( openFile, IOMode(..) )
59 import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
60 ModIface(..), WhatsImported(..),
61 VersionInfo(..), ImportVersion, IsExported,
62 IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
63 GlobalRdrEnv, GlobalRdrElt(..), pprGlobalRdrEnv,
64 AvailEnv, GenAvailInfo(..), AvailInfo, Avails,
65 Provenance(..), ImportReason(..), initialVersionInfo,
68 import CmStaticInfo ( GhciMode(..) )
69 import List ( partition, nub )
75 %*********************************************************
77 \subsection{The two main wrappers}
79 %*********************************************************
82 renameModule :: DynFlags
83 -> HomeIfaceTable -> HomeSymbolTable
84 -> PersistentCompilerState
85 -> Module -> RdrNameHsModule
86 -> IO (PersistentCompilerState,
87 Maybe (PrintUnqualified, (IsExported, ModIface, (SyntaxMap, [RenamedHsDecl]))))
88 -- Nothing => some error occurred in the renamer
90 renameModule dflags hit hst pcs this_module rdr_module
91 = renameSource dflags hit hst pcs this_module $
92 rename this_module rdr_module
97 renameExpr :: DynFlags
98 -> HomeIfaceTable -> HomeSymbolTable
99 -> PersistentCompilerState
100 -> Module -> RdrNameHsExpr
101 -> IO ( PersistentCompilerState,
102 Maybe (PrintUnqualified, (SyntaxMap, RenamedHsExpr, [RenamedHsDecl]))
105 renameExpr dflags hit hst pcs this_module expr
106 = renameSource dflags hit hst pcs this_module $
107 tryLoadInterface doc (moduleName this_module) ImportByUser
108 `thenRn` \ (iface, maybe_err) ->
110 Just msg -> ioToRnM (printErrs alwaysQualify
111 (ptext SLIT("failed to load interface for")
112 <+> quotes (ppr this_module)
113 <> char ':' <+> msg)) `thenRn_`
117 let rdr_env = mi_globals iface
118 print_unqual = unQualInScope rdr_env
121 initRnMS rdr_env emptyLocalFixityEnv CmdLineMode (rnExpr expr)
122 `thenRn` \ (e,fvs) ->
124 checkErrsRn `thenRn` \ no_errs_so_far ->
125 if not no_errs_so_far then
126 -- Found errors already, so exit now
127 doDump e [] `thenRn_`
131 addImplicitFVs rdr_env Nothing fvs `thenRn` \ (slurp_fvs, syntax_map) ->
132 slurpImpDecls slurp_fvs `thenRn` \ decls ->
134 doDump e decls `thenRn_`
135 returnRn (Just (print_unqual, (syntax_map, e, decls)))
138 doc = text "context for compiling expression"
140 doDump :: RenamedHsExpr -> [RenamedHsDecl] -> RnMG (Either IOError ())
142 getDOptsRn `thenRn` \ dflags ->
143 ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
144 (vcat (ppr e : map ppr decls)))
148 %*********************************************************
150 \subsection{The main function: rename}
152 %*********************************************************
155 renameSource :: DynFlags
156 -> HomeIfaceTable -> HomeSymbolTable
157 -> PersistentCompilerState
159 -> RnMG (Maybe (PrintUnqualified, r))
160 -> IO (PersistentCompilerState, Maybe (PrintUnqualified, r))
161 -- Nothing => some error occurred in the renamer
163 renameSource dflags hit hst old_pcs this_module thing_inside
164 = do { showPass dflags "Renamer"
166 -- Initialise the renamer monad
167 ; (new_pcs, msgs, maybe_rn_stuff) <- initRn dflags hit hst old_pcs this_module thing_inside
169 -- Print errors from renaming
170 ; let print_unqual = case maybe_rn_stuff of
171 Just (unqual, _) -> unqual
172 Nothing -> alwaysQualify
174 ; printErrorsAndWarnings print_unqual msgs ;
176 -- Return results. No harm in updating the PCS
177 ; if errorsFound msgs then
178 return (new_pcs, Nothing)
180 return (new_pcs, maybe_rn_stuff)
185 rename :: Module -> RdrNameHsModule
186 -> RnMG (Maybe (PrintUnqualified, (IsExported, ModIface, (SyntaxMap, [RenamedHsDecl]))))
187 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
190 -- FIND THE GLOBAL NAME ENVIRONMENT
191 getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
193 -- Exit if we've found any errors
194 checkErrsRn `thenRn` \ no_errs_so_far ->
195 if not no_errs_so_far then
196 -- Found errors already, so exit now
197 rnDump [] [] `thenRn_`
201 -- PROCESS EXPORT LIST
202 exportsFromAvail mod_name exports all_avails gbl_env `thenRn` \ export_avails ->
204 traceRn (text "Local top-level environment" $$
205 nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
207 -- DEAL WITH DEPRECATIONS
208 rnDeprecs local_gbl_env mod_deprec
209 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
211 -- DEAL WITH LOCAL FIXITIES
212 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
215 rnSourceDecls gbl_env local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
217 -- EXIT IF ERRORS FOUND
218 -- We exit here if there are any errors in the source, *before*
219 -- we attempt to slurp the decls from the interfaces, otherwise
220 -- the slurped decls may get lost when we return up the stack
221 -- to hscMain/hscExpr.
222 checkErrsRn `thenRn` \ no_errs_so_far ->
223 if not no_errs_so_far then
224 -- Found errors already, so exit now
225 rnDump [] rn_local_decls `thenRn_`
229 -- SLURP IN ALL THE NEEDED DECLARATIONS
230 addImplicitFVs gbl_env (Just (mod_name, rn_local_decls))
231 source_fvs `thenRn` \ (slurp_fvs, sugar_map) ->
232 traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList slurp_fvs))) `thenRn_`
233 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
235 rnDump rn_imp_decls rn_local_decls `thenRn_`
237 -- GENERATE THE VERSION/USAGE INFO
238 mkImportInfo mod_name imports `thenRn` \ my_usages ->
240 -- BUILD THE MODULE INTERFACE
242 -- We record fixities even for things that aren't exported,
243 -- so that we can change into the context of this moodule easily
244 fixities = mkNameEnv [ (name, fixity)
245 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
248 -- Sort the exports to make them easier to compare for versions
249 my_exports = groupAvails this_module export_avails
251 final_decls = rn_local_decls ++ rn_imp_decls
252 is_orphan = any (isOrphanDecl this_module) rn_local_decls
254 mod_iface = ModIface { mi_module = this_module,
255 mi_version = initialVersionInfo,
256 mi_usages = my_usages,
258 mi_orphan = is_orphan,
259 mi_exports = my_exports,
260 mi_globals = gbl_env,
261 mi_fixities = fixities,
262 mi_deprecs = my_deprecs,
263 mi_decls = panic "mi_decls"
266 print_unqualified = unQualInScope gbl_env
267 is_exported name = name `elemNameSet` exported_names
268 exported_names = availsToNameSet export_avails
271 -- REPORT UNUSED NAMES, AND DEBUG DUMP
272 reportUnusedNames mod_iface print_unqualified
273 imports global_avail_env
274 source_fvs export_avails rn_imp_decls `thenRn_`
276 returnRn (Just (print_unqualified, (is_exported, mod_iface, (sugar_map, final_decls))))
278 mod_name = moduleName this_module
282 isOrphanDecl this_mod (InstD (InstDecl inst_ty _ _ _ _))
283 = not (foldNameSet ((||) . nameIsLocalOrFrom this_mod) False
284 (extractHsTyNames (removeContext inst_ty)))
285 -- The 'removeContext' is because of
286 -- instance Foo a => Baz T where ...
287 -- The decl is an orphan if Baz and T are both not locally defined,
288 -- even if Foo *is* locally defined
290 isOrphanDecl this_mod (RuleD (HsRule _ _ _ lhs _ _))
293 -- At the moment we just check for common LHS forms
294 -- Expand as necessary. Getting it wrong just means
295 -- more orphans than necessary
296 check (HsVar v) = not (nameIsLocalOrFrom this_mod v)
297 check (HsApp f a) = check f && check a
298 check (HsLit _) = False
299 check (HsOverLit _) = False
300 check (OpApp l o _ r) = check l && check o && check r
301 check (NegApp e) = check e
302 check (HsPar e) = check e
303 check (SectionL e o) = check e && check o
304 check (SectionR o e) = check e && check o
306 check other = True -- Safe fall through
308 isOrphanDecl _ _ = False
312 %*********************************************************
314 \subsection{Fixities}
316 %*********************************************************
319 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
320 fixitiesFromLocalDecls gbl_env decls
321 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
322 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
325 getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
326 getFixities acc (FixD fix)
329 getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
330 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
331 -- Get fixities from class decl sigs too.
332 getFixities acc other_decl
335 fix_decl acc sig@(FixitySig rdr_name fixity loc)
336 = -- Check for fixity decl for something not declared
338 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
340 -- Check for duplicate fixity decl
341 case lookupNameEnv acc name of
342 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc') `thenRn_`
345 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
349 %*********************************************************
351 \subsection{Deprecations}
353 %*********************************************************
355 For deprecations, all we do is check that the names are in scope.
356 It's only imported deprecations, dealt with in RnIfaces, that we
357 gather them together.
360 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
361 -> [RdrNameDeprecation] -> RnMG Deprecations
362 rnDeprecs gbl_env Nothing []
365 rnDeprecs gbl_env (Just txt) decls
366 = mapRn (addErrRn . badDeprec) decls `thenRn_`
367 returnRn (DeprecAll txt)
369 rnDeprecs gbl_env Nothing decls
370 = mapRn rn_deprec decls `thenRn` \ pairs ->
371 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
373 rn_deprec (Deprecation rdr_name txt loc)
375 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
376 returnRn (Just (name, (name,txt)))
380 %************************************************************************
382 \subsection{Grabbing the old interface file and checking versions}
384 %************************************************************************
387 checkOldIface :: GhciMode
389 -> HomeIfaceTable -> HomeSymbolTable
390 -> PersistentCompilerState
392 -> Bool -- Source unchanged
393 -> Maybe ModIface -- Old interface from compilation manager, if any
394 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
395 -- True <=> errors happened
397 checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
398 = runRn dflags hit hst pcs (panic "Bogus module") $
400 -- CHECK WHETHER THE SOURCE HAS CHANGED
401 ( if not source_unchanged then
402 traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))
403 else returnRn () ) `thenRn_`
405 -- If the source has changed and we're in interactive mode, avoid reading
406 -- an interface; just return the one we might have been supplied with.
407 if ghci_mode == Interactive && not source_unchanged then
408 returnRn (outOfDate, maybe_iface)
412 Just old_iface -> -- Use the one we already have
413 setModuleRn (mi_module old_iface) (check_versions old_iface)
415 Nothing -- try and read it from a file
416 -> readIface iface_path `thenRn` \ read_result ->
418 Left err -> -- Old interface file not found, or garbled; give up
419 traceRn (text "Bad old interface file" $$ nest 4 err) `thenRn_`
420 returnRn (outOfDate, Nothing)
423 -> setModuleRn (pi_mod parsed_iface) $
424 loadOldIface parsed_iface `thenRn` \ m_iface ->
425 check_versions m_iface
427 check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
429 | not source_unchanged
430 = returnRn (outOfDate, Just iface)
433 recompileRequired iface_path iface `thenRn` \ recompile ->
434 returnRn (recompile, Just iface)
437 I think the following function should now have a more representative name,
441 loadOldIface :: ParsedIface -> RnMG ModIface
443 loadOldIface parsed_iface
444 = let iface = parsed_iface
448 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
449 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
450 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
451 returnRn (decls, rules, insts)
453 `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
455 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
456 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
457 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
458 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
460 version = VersionInfo { vers_module = pi_vers iface,
461 vers_exports = export_vers,
462 vers_rules = rule_vers,
463 vers_decls = decls_vers }
465 decls = mkIfaceDecls new_decls new_rules new_insts
467 mod_iface = ModIface { mi_module = mod, mi_version = version,
468 mi_exports = avails, mi_usages = usages,
469 mi_boot = False, mi_orphan = pi_orphan iface,
470 mi_fixities = fix_env, mi_deprecs = deprec_env,
472 mi_globals = mkIfaceGlobalRdrEnv avails
479 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
480 -> RnMS (NameEnv Version, [RenamedTyClDecl])
481 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
483 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
484 -> (Version, RdrNameTyClDecl)
485 -> RnMS (NameEnv Version, [RenamedTyClDecl])
486 loadHomeDecl (version_map, decls) (version, decl)
487 = rnTyClDecl decl `thenRn` \ decl' ->
488 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
491 loadHomeRules :: (Version, [RdrNameRuleDecl])
492 -> RnMS (Version, [RenamedRuleDecl])
493 loadHomeRules (version, rules)
494 = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
495 returnRn (version, rules')
498 loadHomeInsts :: [RdrNameInstDecl]
499 -> RnMS [RenamedInstDecl]
500 loadHomeInsts insts = mapRn rnInstDecl insts
503 loadHomeUsage :: ImportVersion OccName
504 -> RnMG (ImportVersion Name)
505 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
506 = rn_imps whats_imported `thenRn` \ whats_imported' ->
507 returnRn (mod_name, orphans, is_boot, whats_imported')
509 rn_imps NothingAtAll = returnRn NothingAtAll
510 rn_imps (Everything v) = returnRn (Everything v)
511 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
512 returnRn (Specifically mv ev items' rv)
513 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
519 %*********************************************************
521 \subsection{Closing up the interface decls}
523 %*********************************************************
525 Suppose we discover we don't need to recompile. Then we start from the
526 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
529 closeIfaceDecls :: DynFlags
530 -> HomeIfaceTable -> HomeSymbolTable
531 -> PersistentCompilerState
532 -> ModIface -- Get the decls from here
533 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
534 -- True <=> errors happened
535 closeIfaceDecls dflags hit hst pcs
536 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
537 = runRn dflags hit hst pcs mod $
540 rule_decls = dcl_rules iface_decls
541 inst_decls = dcl_insts iface_decls
542 tycl_decls = dcl_tycl iface_decls
543 decls = map RuleD rule_decls ++
544 map InstD inst_decls ++
546 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
547 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
548 unionManyNameSets (map tyClDeclFVs tycl_decls)
549 local_names = foldl add emptyNameSet tycl_decls
550 add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
553 recordLocalSlurps local_names `thenRn_`
555 -- Do the transitive closure
556 closeDecls decls (needed `plusFV` implicit_fvs) `thenRn` \closed_decls ->
557 rnDump [] closed_decls `thenRn_`
558 returnRn closed_decls
560 implicit_fvs = ubiquitousNames -- Data type decls with record selectors,
561 -- which may appear in the decls, need unpackCString
562 -- and friends. It's easier to just grab them right now.
565 %*********************************************************
567 \subsection{Unused names}
569 %*********************************************************
572 reportUnusedNames :: ModIface -> PrintUnqualified
573 -> [RdrNameImportDecl]
575 -> NameSet -- Used in this module
576 -> Avails -- Exported by this module
579 reportUnusedNames my_mod_iface unqual imports avail_env
580 source_fvs export_avails imported_decls
581 = warnUnusedModules unused_imp_mods `thenRn_`
582 warnUnusedLocalBinds bad_locals `thenRn_`
583 warnUnusedImports bad_imp_names `thenRn_`
584 printMinimalImports this_mod unqual minimal_imports
586 this_mod = mi_module my_mod_iface
587 gbl_env = mi_globals my_mod_iface
589 -- The export_fvs make the exported names look just as if they
590 -- occurred in the source program.
591 export_fvs = availsToNameSet export_avails
592 used_names = source_fvs `plusFV` export_fvs
594 -- Now, a use of C implies a use of T,
595 -- if C was brought into scope by T(..) or T(C)
596 really_used_names = used_names `unionNameSets`
597 mkNameSet [ parent_name
598 | sub_name <- nameSetToList used_names
600 -- Usually, every used name will appear in avail_env, but there
601 -- is one time when it doesn't: tuples and other built in syntax. When you
602 -- write (a,b) that gives rise to a *use* of "(,)", so that the
603 -- instances will get pulled in, but the tycon "(,)" isn't actually
604 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
605 -- similarly, 3.5 gives rise to an implcit use of :%
606 -- Hence the silent 'False' in all other cases
608 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
609 Just (AvailTC n _) -> Just n
613 -- Collect the defined names from the in-scope environment
614 -- Look for the qualified ones only, else get duplicates
615 defined_names :: [GlobalRdrElt]
616 defined_names = foldRdrEnv add [] gbl_env
617 add rdr_name ns acc | isQual rdr_name = ns ++ acc
620 defined_and_used, defined_but_not_used :: [GlobalRdrElt]
621 (defined_and_used, defined_but_not_used) = partition used defined_names
622 used (GRE name _ _) = name `elemNameSet` really_used_names
624 -- Filter out the ones only defined implicitly
626 bad_locals = [n | (GRE n LocalDef _) <- defined_but_not_used]
628 bad_imp_names :: [(Name,Provenance)]
629 bad_imp_names = [(n,p) | GRE n p@(NonLocalDef (UserImport mod _ True)) _ <- defined_but_not_used,
630 not (module_unused mod)]
632 -- inst_mods are directly-imported modules that
633 -- contain instance decl(s) that the renamer decided to suck in
634 -- It's not necessarily redundant to import such modules.
640 -- The import M() is not *necessarily* redundant, even if
641 -- we suck in no instance decls from M (e.g. it contains
642 -- no instance decls, or This contains no code). It may be
643 -- that we import M solely to ensure that M's orphan instance
644 -- decls (or those in its imports) are visible to people who
645 -- import This. Sigh.
646 -- There's really no good way to detect this, so the error message
647 -- in RnEnv.warnUnusedModules is weakened instead
648 inst_mods :: [ModuleName]
649 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
650 let m = moduleName (nameModule dfun),
651 m `elem` direct_import_mods
654 -- To figure out the minimal set of imports, start with the things
655 -- that are in scope (i.e. in gbl_env). Then just combine them
656 -- into a bunch of avails, so they are properly grouped
657 minimal_imports :: FiniteMap ModuleName AvailEnv
658 minimal_imports0 = emptyFM
659 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
660 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
662 -- We've carefully preserved the provenance so that we can
663 -- construct minimal imports that import the name by (one of)
664 -- the same route(s) as the programmer originally did.
665 add_name (GRE n (NonLocalDef (UserImport m _ _)) _) acc = addToFM_C plusAvailEnv acc (moduleName m)
666 (unitAvailEnv (mk_avail n))
667 add_name (GRE n other_prov _) acc = acc
669 mk_avail n = case lookupNameEnv avail_env n of
670 Just (AvailTC m _) | n==m -> AvailTC n [n]
671 | otherwise -> AvailTC m [n,m]
672 Just avail -> Avail n
673 Nothing -> pprPanic "mk_avail" (ppr n)
676 | m `elemFM` acc = acc -- We import something already
677 | otherwise = addToFM acc m emptyAvailEnv
678 -- Add an empty collection of imports for a module
679 -- from which we have sucked only instance decls
681 direct_import_mods :: [ModuleName]
682 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
684 -- unused_imp_mods are the directly-imported modules
685 -- that are not mentioned in minimal_imports
686 unused_imp_mods = [m | m <- direct_import_mods,
687 not (maybeToBool (lookupFM minimal_imports m)),
690 module_unused :: Module -> Bool
691 module_unused mod = moduleName mod `elem` unused_imp_mods
694 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
695 printMinimalImports :: Module -- This module
697 -> FiniteMap ModuleName AvailEnv -- Minimal imports
699 printMinimalImports this_mod unqual imps
700 = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
701 if not dump_minimal then returnRn () else
703 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
704 ioToRnM (do { h <- openFile filename WriteMode ;
705 printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
709 filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
710 ppr_mod_ie (mod_name, ies)
711 | mod_name == pRELUDE_Name
714 = ptext SLIT("import") <+> ppr mod_name <>
715 parens (fsep (punctuate comma (map ppr ies)))
717 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
720 to_ie :: AvailInfo -> RnMG (IE Name)
721 -- The main trick here is that if we're importing all the constructors
722 -- we want to say "T(..)", but if we're importing only a subset we want
723 -- to say "T(A,B,C)". So we have to find out what the module exports.
724 to_ie (Avail n) = returnRn (IEVar n)
725 to_ie (AvailTC n [m]) = ASSERT( n==m )
726 returnRn (IEThingAbs n)
728 = loadInterface (text "Compute minimal imports from" <+> ppr n_mod) n_mod ImportBySystem `thenRn` \ iface ->
729 case [xs | (m,as) <- mi_exports iface,
733 [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
734 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
735 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
738 n_mod = moduleName (nameModule n)
740 rnDump :: [RenamedHsDecl] -- Renamed imported decls
741 -> [RenamedHsDecl] -- Renamed local decls
743 rnDump imp_decls local_decls
744 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
745 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
746 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
747 getIfacesRn `thenRn` \ ifaces ->
749 ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
751 (getRnStats imp_decls ifaces) ;
753 dumpIfSet dump_rn "Renamer:"
754 (vcat (map ppr (local_decls ++ imp_decls)))
761 %*********************************************************
763 \subsection{Statistics}
765 %*********************************************************
768 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
769 getRnStats imported_decls ifaces
770 = hcat [text "Renamer stats: ", stats]
772 n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
773 -- This is really only right for a one-shot compile
775 (decls_map, n_decls_slurped) = iDecls ifaces
777 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
778 -- Data, newtype, and class decls are in the decls_fm
779 -- under multiple names; the tycon/class, and each
780 -- constructor/class op too.
781 -- The 'True' selects just the 'main' decl
784 (insts_left, n_insts_slurped) = iInsts ifaces
785 n_insts_left = length (bagToList insts_left)
787 (rules_left, n_rules_slurped) = iRules ifaces
788 n_rules_left = length (bagToList rules_left)
791 [int n_mods <+> text "interfaces read",
792 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
793 int (n_decls_slurped + n_decls_left), text "read"],
794 hsep [ int n_insts_slurped, text "instance decls imported, out of",
795 int (n_insts_slurped + n_insts_left), text "read"],
796 hsep [ int n_rules_slurped, text "rule decls imported, out of",
797 int (n_rules_slurped + n_rules_left), text "read"]
802 %************************************************************************
804 \subsection{Errors and warnings}
806 %************************************************************************
809 dupFixityDecl rdr_name loc1 loc2
810 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
811 ptext SLIT("at ") <+> ppr loc1,
812 ptext SLIT("and") <+> ppr loc2]
815 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),