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,
17 extractHsTyNames, RenamedStmt,
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, removeContext, loadInterface,
31 loadExports, loadFixDecls, loadDeprecs,
33 import MkIface ( pprUsage )
34 import RnEnv ( availsToNameSet, mkIfaceGlobalRdrEnv,
35 emptyAvailEnv, unitAvailEnv, availEnvElts,
36 plusAvailEnv, groupAvails, warnUnusedImports,
37 warnUnusedLocalBinds, warnUnusedModules,
38 lookupSrcName, addImplicitFVs,
39 newGlobalName, unQualInScope,, ubiquitousNames
41 import Module ( Module, ModuleName, WhereFrom(..),
42 moduleNameUserString, moduleName,
45 import Name ( Name, nameIsLocalOrFrom, 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,
69 import CmStaticInfo ( GhciMode(..) )
70 import List ( partition, nub )
76 %*********************************************************
78 \subsection{The two main wrappers}
80 %*********************************************************
83 renameModule :: DynFlags
84 -> HomeIfaceTable -> HomeSymbolTable
85 -> PersistentCompilerState
86 -> Module -> RdrNameHsModule
87 -> IO (PersistentCompilerState, PrintUnqualified,
88 Maybe (IsExported, ModIface, (SyntaxMap, [RenamedHsDecl])))
89 -- Nothing => some error occurred in the renamer
91 renameModule dflags hit hst pcs this_module rdr_module
92 = renameSource dflags hit hst pcs this_module $
93 rename this_module rdr_module
98 renameStmt :: DynFlags
99 -> HomeIfaceTable -> HomeSymbolTable
100 -> PersistentCompilerState
101 -> Module -- current context (scope to compile in)
102 -> Module -- current module
103 -> LocalRdrEnv -- current context (temp bindings)
104 -> RdrNameStmt -- parsed stmt
105 -> IO ( PersistentCompilerState,
107 Maybe ([Name], (SyntaxMap, RenamedStmt, [RenamedHsDecl]))
110 renameStmt dflags hit hst pcs scope_module this_module local_env stmt
111 = renameSource dflags hit hst pcs this_module $
113 -- Load the interface for the context module, so
114 -- that we can get its top-level lexical environment
115 -- Bale out if we fail to do this
116 loadInterface doc (moduleName scope_module) ImportByUser `thenRn` \ iface ->
117 let rdr_env = mi_globals iface
118 print_unqual = unQualInScope rdr_env
120 checkErrsRn `thenRn` \ no_errs_so_far ->
121 if not no_errs_so_far then
122 returnRn (print_unqual, Nothing)
126 initRnMS rdr_env local_env emptyLocalFixityEnv CmdLineMode (
127 rnStmt stmt $ \ stmt' ->
128 returnRn (([], stmt'), emptyFVs)
129 ) `thenRn` \ ((binders, stmt), fvs) ->
131 -- Bale out if we fail
132 checkErrsRn `thenRn` \ no_errs_so_far ->
133 if not no_errs_so_far then
134 doDump [] stmt [] `thenRn_` returnRn (print_unqual, Nothing)
137 let filtered_fvs = fvs `delListFromNameSet` rdrEnvElts local_env in
139 -- Add implicit free vars, and close decls
140 addImplicitFVs rdr_env Nothing filtered_fvs
141 `thenRn` \ (slurp_fvs, syntax_map) ->
142 slurpImpDecls slurp_fvs `thenRn` \ decls ->
144 doDump binders stmt decls `thenRn_`
145 returnRn (print_unqual, Just (binders, (syntax_map, stmt, decls)))
148 doc = text "context for compiling expression"
150 doDump :: [Name] -> RenamedStmt -> [RenamedHsDecl] -> RnMG (Either IOError ())
151 doDump bndrs stmt decls
152 = getDOptsRn `thenRn` \ dflags ->
153 ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
154 (vcat [text "Binders:" <+> ppr bndrs,
156 vcat (map ppr decls)]))
160 %*********************************************************
162 \subsection{The main function: rename}
164 %*********************************************************
167 renameSource :: DynFlags
168 -> HomeIfaceTable -> HomeSymbolTable
169 -> PersistentCompilerState
171 -> RnMG (PrintUnqualified, Maybe r)
172 -> IO (PersistentCompilerState, PrintUnqualified, Maybe r)
173 -- Nothing => some error occurred in the renamer
175 renameSource dflags hit hst old_pcs this_module thing_inside
176 = do { showPass dflags "Renamer"
178 -- Initialise the renamer monad
179 ; (new_pcs, msgs, (print_unqual, maybe_rn_stuff))
180 <- initRn dflags hit hst old_pcs this_module thing_inside
182 -- Print errors from renaming
183 ; printErrorsAndWarnings print_unqual msgs ;
185 -- Return results. No harm in updating the PCS
186 ; if errorsFound msgs then
187 return (new_pcs, print_unqual, Nothing)
189 return (new_pcs, print_unqual, maybe_rn_stuff)
194 rename :: Module -> RdrNameHsModule
195 -> RnMG (PrintUnqualified, Maybe (IsExported, ModIface, (SyntaxMap, [RenamedHsDecl])))
196 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
199 -- FIND THE GLOBAL NAME ENVIRONMENT
200 getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
202 print_unqualified = unQualInScope gbl_env
204 -- Exit if we've found any errors
205 checkErrsRn `thenRn` \ no_errs_so_far ->
206 if not no_errs_so_far then
207 -- Found errors already, so exit now
208 rnDump [] [] `thenRn_`
209 returnRn (print_unqualified, Nothing)
212 -- PROCESS EXPORT LIST
213 exportsFromAvail mod_name exports all_avails gbl_env `thenRn` \ export_avails ->
215 traceRn (text "Local top-level environment" $$
216 nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
218 -- DEAL WITH DEPRECATIONS
219 rnDeprecs local_gbl_env mod_deprec
220 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
222 -- DEAL WITH LOCAL FIXITIES
223 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
226 rnSourceDecls gbl_env local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
228 -- EXIT IF ERRORS FOUND
229 -- We exit here if there are any errors in the source, *before*
230 -- we attempt to slurp the decls from the interfaces, otherwise
231 -- the slurped decls may get lost when we return up the stack
232 -- to hscMain/hscExpr.
233 checkErrsRn `thenRn` \ no_errs_so_far ->
234 if not no_errs_so_far then
235 -- Found errors already, so exit now
236 rnDump [] rn_local_decls `thenRn_`
237 returnRn (print_unqualified, Nothing)
240 -- SLURP IN ALL THE NEEDED DECLARATIONS
241 addImplicitFVs gbl_env (Just (mod_name, rn_local_decls))
242 source_fvs `thenRn` \ (slurp_fvs, sugar_map) ->
243 traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList slurp_fvs))) `thenRn_`
244 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
246 rnDump rn_imp_decls rn_local_decls `thenRn_`
248 -- GENERATE THE VERSION/USAGE INFO
249 mkImportInfo mod_name imports `thenRn` \ my_usages ->
251 -- BUILD THE MODULE INTERFACE
253 -- We record fixities even for things that aren't exported,
254 -- so that we can change into the context of this moodule easily
255 fixities = mkNameEnv [ (name, fixity)
256 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
259 -- Sort the exports to make them easier to compare for versions
260 my_exports = groupAvails this_module export_avails
262 final_decls = rn_local_decls ++ rn_imp_decls
263 is_orphan = any (isOrphanDecl this_module) rn_local_decls
265 mod_iface = ModIface { mi_module = this_module,
266 mi_version = initialVersionInfo,
267 mi_usages = my_usages,
269 mi_orphan = is_orphan,
270 mi_exports = my_exports,
271 mi_globals = gbl_env,
272 mi_fixities = fixities,
273 mi_deprecs = my_deprecs,
274 mi_decls = panic "mi_decls"
277 is_exported name = name `elemNameSet` exported_names
278 exported_names = availsToNameSet export_avails
281 -- REPORT UNUSED NAMES, AND DEBUG DUMP
282 reportUnusedNames mod_iface print_unqualified
283 imports global_avail_env
284 source_fvs export_avails rn_imp_decls `thenRn_`
286 returnRn (print_unqualified, Just (is_exported, mod_iface, (sugar_map, final_decls)))
288 mod_name = moduleName this_module
292 isOrphanDecl this_mod (InstD (InstDecl inst_ty _ _ _ _))
293 = not (foldNameSet ((||) . nameIsLocalOrFrom this_mod) False
294 (extractHsTyNames (removeContext inst_ty)))
295 -- The 'removeContext' is because of
296 -- instance Foo a => Baz T where ...
297 -- The decl is an orphan if Baz and T are both not locally defined,
298 -- even if Foo *is* locally defined
300 isOrphanDecl this_mod (RuleD (HsRule _ _ _ lhs _ _))
303 -- At the moment we just check for common LHS forms
304 -- Expand as necessary. Getting it wrong just means
305 -- more orphans than necessary
306 check (HsVar v) = not (nameIsLocalOrFrom this_mod v)
307 check (HsApp f a) = check f && check a
308 check (HsLit _) = False
309 check (HsOverLit _) = False
310 check (OpApp l o _ r) = check l && check o && check r
311 check (NegApp e) = check e
312 check (HsPar e) = check e
313 check (SectionL e o) = check e && check o
314 check (SectionR o e) = check e && check o
316 check other = True -- Safe fall through
318 isOrphanDecl _ _ = False
322 %*********************************************************
324 \subsection{Fixities}
326 %*********************************************************
329 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
330 fixitiesFromLocalDecls gbl_env decls
331 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
332 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
335 getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
336 getFixities acc (FixD fix)
339 getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
340 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
341 -- Get fixities from class decl sigs too.
342 getFixities acc other_decl
345 fix_decl acc sig@(FixitySig rdr_name fixity loc)
346 = -- Check for fixity decl for something not declared
348 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
350 -- Check for duplicate fixity decl
351 case lookupNameEnv acc name of
352 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc') `thenRn_`
355 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
359 %*********************************************************
361 \subsection{Deprecations}
363 %*********************************************************
365 For deprecations, all we do is check that the names are in scope.
366 It's only imported deprecations, dealt with in RnIfaces, that we
367 gather them together.
370 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
371 -> [RdrNameDeprecation] -> RnMG Deprecations
372 rnDeprecs gbl_env Nothing []
375 rnDeprecs gbl_env (Just txt) decls
376 = mapRn (addErrRn . badDeprec) decls `thenRn_`
377 returnRn (DeprecAll txt)
379 rnDeprecs gbl_env Nothing decls
380 = mapRn rn_deprec decls `thenRn` \ pairs ->
381 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
383 rn_deprec (Deprecation rdr_name txt loc)
385 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
386 returnRn (Just (name, (name,txt)))
390 %************************************************************************
392 \subsection{Grabbing the old interface file and checking versions}
394 %************************************************************************
397 checkOldIface :: GhciMode
399 -> HomeIfaceTable -> HomeSymbolTable
400 -> PersistentCompilerState
402 -> Bool -- Source unchanged
403 -> Maybe ModIface -- Old interface from compilation manager, if any
404 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
405 -- True <=> errors happened
407 checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
408 = runRn dflags hit hst pcs (panic "Bogus module") $
410 -- CHECK WHETHER THE SOURCE HAS CHANGED
411 ( if not source_unchanged then
412 traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))
413 else returnRn () ) `thenRn_`
415 -- If the source has changed and we're in interactive mode, avoid reading
416 -- an interface; just return the one we might have been supplied with.
417 if ghci_mode == Interactive && not source_unchanged then
418 returnRn (outOfDate, maybe_iface)
422 Just old_iface -> -- Use the one we already have
423 setModuleRn (mi_module old_iface) (check_versions old_iface)
425 Nothing -- try and read it from a file
426 -> readIface iface_path `thenRn` \ read_result ->
428 Left err -> -- Old interface file not found, or garbled; give up
429 traceRn (text "Bad old interface file" $$ nest 4 err) `thenRn_`
430 returnRn (outOfDate, Nothing)
433 -> setModuleRn (pi_mod parsed_iface) $
434 loadOldIface parsed_iface `thenRn` \ m_iface ->
435 check_versions m_iface
437 check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
439 | not source_unchanged
440 = returnRn (outOfDate, Just iface)
443 recompileRequired iface_path iface `thenRn` \ recompile ->
444 returnRn (recompile, Just iface)
447 I think the following function should now have a more representative name,
451 loadOldIface :: ParsedIface -> RnMG ModIface
453 loadOldIface parsed_iface
454 = let iface = parsed_iface
458 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
459 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
460 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
461 returnRn (decls, rules, insts)
463 `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
465 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
466 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
467 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
468 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
470 version = VersionInfo { vers_module = pi_vers iface,
471 vers_exports = export_vers,
472 vers_rules = rule_vers,
473 vers_decls = decls_vers }
475 decls = mkIfaceDecls new_decls new_rules new_insts
477 mod_iface = ModIface { mi_module = mod, mi_version = version,
478 mi_exports = avails, mi_usages = usages,
479 mi_boot = False, mi_orphan = pi_orphan iface,
480 mi_fixities = fix_env, mi_deprecs = deprec_env,
482 mi_globals = mkIfaceGlobalRdrEnv avails
489 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
490 -> RnMS (NameEnv Version, [RenamedTyClDecl])
491 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
493 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
494 -> (Version, RdrNameTyClDecl)
495 -> RnMS (NameEnv Version, [RenamedTyClDecl])
496 loadHomeDecl (version_map, decls) (version, decl)
497 = rnTyClDecl decl `thenRn` \ decl' ->
498 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
501 loadHomeRules :: (Version, [RdrNameRuleDecl])
502 -> RnMS (Version, [RenamedRuleDecl])
503 loadHomeRules (version, rules)
504 = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
505 returnRn (version, rules')
508 loadHomeInsts :: [RdrNameInstDecl]
509 -> RnMS [RenamedInstDecl]
510 loadHomeInsts insts = mapRn rnInstDecl insts
513 loadHomeUsage :: ImportVersion OccName
514 -> RnMG (ImportVersion Name)
515 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
516 = rn_imps whats_imported `thenRn` \ whats_imported' ->
517 returnRn (mod_name, orphans, is_boot, whats_imported')
519 rn_imps NothingAtAll = returnRn NothingAtAll
520 rn_imps (Everything v) = returnRn (Everything v)
521 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
522 returnRn (Specifically mv ev items' rv)
523 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
529 %*********************************************************
531 \subsection{Closing up the interface decls}
533 %*********************************************************
535 Suppose we discover we don't need to recompile. Then we start from the
536 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
539 closeIfaceDecls :: DynFlags
540 -> HomeIfaceTable -> HomeSymbolTable
541 -> PersistentCompilerState
542 -> ModIface -- Get the decls from here
543 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
544 -- True <=> errors happened
545 closeIfaceDecls dflags hit hst pcs
546 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
547 = runRn dflags hit hst pcs mod $
550 rule_decls = dcl_rules iface_decls
551 inst_decls = dcl_insts iface_decls
552 tycl_decls = dcl_tycl iface_decls
553 decls = map RuleD rule_decls ++
554 map InstD inst_decls ++
556 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
557 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
558 unionManyNameSets (map tyClDeclFVs tycl_decls)
559 local_names = foldl add emptyNameSet tycl_decls
560 add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
563 recordLocalSlurps local_names `thenRn_`
565 -- Do the transitive closure
566 closeDecls decls (needed `plusFV` implicit_fvs) `thenRn` \closed_decls ->
567 rnDump [] closed_decls `thenRn_`
568 returnRn closed_decls
570 implicit_fvs = ubiquitousNames -- Data type decls with record selectors,
571 -- which may appear in the decls, need unpackCString
572 -- and friends. It's easier to just grab them right now.
575 %*********************************************************
577 \subsection{Unused names}
579 %*********************************************************
582 reportUnusedNames :: ModIface -> PrintUnqualified
583 -> [RdrNameImportDecl]
585 -> NameSet -- Used in this module
586 -> Avails -- Exported by this module
589 reportUnusedNames my_mod_iface unqual imports avail_env
590 source_fvs export_avails imported_decls
591 = warnUnusedModules unused_imp_mods `thenRn_`
592 warnUnusedLocalBinds bad_locals `thenRn_`
593 warnUnusedImports bad_imp_names `thenRn_`
594 printMinimalImports this_mod unqual minimal_imports
596 this_mod = mi_module my_mod_iface
597 gbl_env = mi_globals my_mod_iface
599 -- The export_fvs make the exported names look just as if they
600 -- occurred in the source program.
601 export_fvs = availsToNameSet export_avails
602 used_names = source_fvs `plusFV` export_fvs
604 -- Now, a use of C implies a use of T,
605 -- if C was brought into scope by T(..) or T(C)
606 really_used_names = used_names `unionNameSets`
607 mkNameSet [ parent_name
608 | sub_name <- nameSetToList used_names
610 -- Usually, every used name will appear in avail_env, but there
611 -- is one time when it doesn't: tuples and other built in syntax. When you
612 -- write (a,b) that gives rise to a *use* of "(,)", so that the
613 -- instances will get pulled in, but the tycon "(,)" isn't actually
614 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
615 -- similarly, 3.5 gives rise to an implcit use of :%
616 -- Hence the silent 'False' in all other cases
618 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
619 Just (AvailTC n _) -> Just n
623 -- Collect the defined names from the in-scope environment
624 -- Look for the qualified ones only, else get duplicates
625 defined_names :: [GlobalRdrElt]
626 defined_names = foldRdrEnv add [] gbl_env
627 add rdr_name ns acc | isQual rdr_name = ns ++ acc
630 defined_and_used, defined_but_not_used :: [GlobalRdrElt]
631 (defined_and_used, defined_but_not_used) = partition used defined_names
632 used (GRE name _ _) = name `elemNameSet` really_used_names
634 -- Filter out the ones only defined implicitly
636 bad_locals = [n | (GRE n LocalDef _) <- defined_but_not_used]
638 bad_imp_names :: [(Name,Provenance)]
639 bad_imp_names = [(n,p) | GRE n p@(NonLocalDef (UserImport mod _ True)) _ <- defined_but_not_used,
640 not (module_unused mod)]
642 -- inst_mods are directly-imported modules that
643 -- contain instance decl(s) that the renamer decided to suck in
644 -- It's not necessarily redundant to import such modules.
650 -- The import M() is not *necessarily* redundant, even if
651 -- we suck in no instance decls from M (e.g. it contains
652 -- no instance decls, or This contains no code). It may be
653 -- that we import M solely to ensure that M's orphan instance
654 -- decls (or those in its imports) are visible to people who
655 -- import This. Sigh.
656 -- There's really no good way to detect this, so the error message
657 -- in RnEnv.warnUnusedModules is weakened instead
658 inst_mods :: [ModuleName]
659 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
660 let m = moduleName (nameModule dfun),
661 m `elem` direct_import_mods
664 -- To figure out the minimal set of imports, start with the things
665 -- that are in scope (i.e. in gbl_env). Then just combine them
666 -- into a bunch of avails, so they are properly grouped
667 minimal_imports :: FiniteMap ModuleName AvailEnv
668 minimal_imports0 = emptyFM
669 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
670 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
672 -- We've carefully preserved the provenance so that we can
673 -- construct minimal imports that import the name by (one of)
674 -- the same route(s) as the programmer originally did.
675 add_name (GRE n (NonLocalDef (UserImport m _ _)) _) acc = addToFM_C plusAvailEnv acc (moduleName m)
676 (unitAvailEnv (mk_avail n))
677 add_name (GRE n other_prov _) acc = acc
679 mk_avail n = case lookupNameEnv avail_env n of
680 Just (AvailTC m _) | n==m -> AvailTC n [n]
681 | otherwise -> AvailTC m [n,m]
682 Just avail -> Avail n
683 Nothing -> pprPanic "mk_avail" (ppr n)
686 | m `elemFM` acc = acc -- We import something already
687 | otherwise = addToFM acc m emptyAvailEnv
688 -- Add an empty collection of imports for a module
689 -- from which we have sucked only instance decls
691 direct_import_mods :: [ModuleName]
692 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
694 -- unused_imp_mods are the directly-imported modules
695 -- that are not mentioned in minimal_imports
696 unused_imp_mods = [m | m <- direct_import_mods,
697 not (maybeToBool (lookupFM minimal_imports m)),
700 module_unused :: Module -> Bool
701 module_unused mod = moduleName mod `elem` unused_imp_mods
704 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
705 printMinimalImports :: Module -- This module
707 -> FiniteMap ModuleName AvailEnv -- Minimal imports
709 printMinimalImports this_mod unqual imps
710 = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
711 if not dump_minimal then returnRn () else
713 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
714 ioToRnM (do { h <- openFile filename WriteMode ;
715 printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
719 filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
720 ppr_mod_ie (mod_name, ies)
721 | mod_name == pRELUDE_Name
724 = ptext SLIT("import") <+> ppr mod_name <>
725 parens (fsep (punctuate comma (map ppr ies)))
727 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
730 to_ie :: AvailInfo -> RnMG (IE Name)
731 -- The main trick here is that if we're importing all the constructors
732 -- we want to say "T(..)", but if we're importing only a subset we want
733 -- to say "T(A,B,C)". So we have to find out what the module exports.
734 to_ie (Avail n) = returnRn (IEVar n)
735 to_ie (AvailTC n [m]) = ASSERT( n==m )
736 returnRn (IEThingAbs n)
738 = loadInterface (text "Compute minimal imports from" <+> ppr n_mod) n_mod ImportBySystem `thenRn` \ iface ->
739 case [xs | (m,as) <- mi_exports iface,
743 [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
744 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
745 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
748 n_mod = moduleName (nameModule n)
750 rnDump :: [RenamedHsDecl] -- Renamed imported decls
751 -> [RenamedHsDecl] -- Renamed local decls
753 rnDump imp_decls local_decls
754 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
755 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
756 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
757 getIfacesRn `thenRn` \ ifaces ->
759 ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
761 (getRnStats imp_decls ifaces) ;
763 dumpIfSet dump_rn "Renamer:"
764 (vcat (map ppr (local_decls ++ imp_decls)))
771 %*********************************************************
773 \subsection{Statistics}
775 %*********************************************************
778 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
779 getRnStats imported_decls ifaces
780 = hcat [text "Renamer stats: ", stats]
782 n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
783 -- This is really only right for a one-shot compile
785 (decls_map, n_decls_slurped) = iDecls ifaces
787 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
788 -- Data, newtype, and class decls are in the decls_fm
789 -- under multiple names; the tycon/class, and each
790 -- constructor/class op too.
791 -- The 'True' selects just the 'main' decl
794 (insts_left, n_insts_slurped) = iInsts ifaces
795 n_insts_left = length (bagToList insts_left)
797 (rules_left, n_rules_slurped) = iRules ifaces
798 n_rules_left = length (bagToList rules_left)
801 [int n_mods <+> text "interfaces read",
802 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
803 int (n_decls_slurped + n_decls_left), text "read"],
804 hsep [ int n_insts_slurped, text "instance decls imported, out of",
805 int (n_insts_slurped + n_insts_left), text "read"],
806 hsep [ int n_rules_slurped, text "rule decls imported, out of",
807 int (n_rules_slurped + n_rules_left), text "read"]
812 %************************************************************************
814 \subsection{Errors and warnings}
816 %************************************************************************
819 dupFixityDecl rdr_name loc1 loc2
820 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
821 ptext SLIT("at ") <+> ppr loc1,
822 ptext SLIT("and") <+> ppr loc2]
825 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),