2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[Rename]{Renaming and dependency analysis passes}
7 module Rename ( renameModule, closeIfaceDecls, checkOldIface ) where
9 #include "HsVersions.h"
12 import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation,
13 RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl
15 import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
17 instDeclFVs, tyClDeclFVs, ruleDeclFVs
20 import CmdLineOpts ( DynFlags, DynFlag(..) )
22 import RnNames ( getGlobalNames, exportsFromAvail )
23 import RnSource ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
24 import RnIfaces ( slurpImpDecls, mkImportInfo,
25 getInterfaceExports, closeDecls,
26 RecompileRequired, outOfDate, recompileRequired
28 import RnHiFiles ( readIface, removeContext, loadInterface,
29 loadExports, loadFixDecls, loadDeprecs )
30 import RnEnv ( availsToNameSet, availName,
31 emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
32 warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
33 lookupOrigNames, lookupSrcName, newGlobalName, unQualInScope
35 import Module ( Module, ModuleName, WhereFrom(..),
36 moduleNameUserString, moduleName,
39 import Name ( Name, NamedThing(..), getSrcLoc,
40 nameIsLocalOrFrom, nameOccName, nameModule,
42 import Name ( mkNameEnv, nameEnvElts, extendNameEnv )
43 import RdrName ( elemRdrEnv, foldRdrEnv, isQual )
44 import OccName ( occNameFlavour )
46 import TysWiredIn ( unitTyCon, intTyCon, boolTyCon )
47 import PrelNames ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
48 ioTyCon_RDR, main_RDR_Unqual,
49 unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
52 import PrelInfo ( derivingOccurrences )
53 import Type ( funTyCon )
54 import ErrUtils ( dumpIfSet, showPass, printErrorsAndWarnings, errorsFound )
55 import Bag ( bagToList )
56 import FiniteMap ( FiniteMap, fmToList, emptyFM, lookupFM,
57 addToFM_C, elemFM, addToFM
59 import UniqFM ( lookupUFM )
60 import Maybes ( maybeToBool, catMaybes )
62 import IO ( openFile, IOMode(..) )
63 import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
64 ModIface(..), WhatsImported(..),
65 VersionInfo(..), ImportVersion, IsExported,
66 IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
67 GlobalRdrEnv, pprGlobalRdrEnv,
68 AvailEnv, GenAvailInfo(..), AvailInfo, Avails,
69 Provenance(..), ImportReason(..), initialVersionInfo,
70 Deprecations(..), lookupDeprec, lookupIface
72 import List ( partition, nub )
77 %*********************************************************
79 \subsection{The main function: rename}
81 %*********************************************************
84 renameModule :: DynFlags
85 -> HomeIfaceTable -> HomeSymbolTable
86 -> PersistentCompilerState
87 -> Module -> RdrNameHsModule
88 -> IO (PersistentCompilerState, Maybe (PrintUnqualified, IsExported, ModIface, [RenamedHsDecl]))
89 -- Nothing => some error occurred in the renamer
91 renameModule dflags hit hst old_pcs this_module rdr_module
92 = do { showPass dflags "Renamer"
94 -- Initialise the renamer monad
95 ; (new_pcs, msgs, maybe_rn_stuff) <- initRn dflags hit hst old_pcs this_module
96 (rename this_module rdr_module)
98 ; let print_unqualified = case maybe_rn_stuff of
99 Just (unqual, _, _, _) -> unqual
100 Nothing -> alwaysQualify
103 -- Print errors from renaming
104 ; printErrorsAndWarnings print_unqualified msgs ;
106 -- Return results. No harm in updating the PCS
107 ; if errorsFound msgs then
108 return (new_pcs, Nothing)
110 return (new_pcs, maybe_rn_stuff)
115 rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, IsExported, ModIface, [RenamedHsDecl]))
116 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
119 -- FIND THE GLOBAL NAME ENVIRONMENT
120 getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
122 -- Exit if we've found any errors
123 checkErrsRn `thenRn` \ no_errs_so_far ->
124 if not no_errs_so_far then
125 -- Found errors already, so exit now
126 rnDump [] [] `thenRn_`
130 -- PROCESS EXPORT LIST
131 exportsFromAvail mod_name exports all_avails gbl_env `thenRn` \ export_avails ->
133 traceRn (text "Local top-level environment" $$
134 nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
136 -- DEAL WITH DEPRECATIONS
137 rnDeprecs local_gbl_env mod_deprec
138 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
140 -- DEAL WITH LOCAL FIXITIES
141 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
144 rnSourceDecls gbl_env local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
146 -- CHECK THAT main IS DEFINED, IF REQUIRED
147 checkMain this_module local_gbl_env `thenRn_`
149 -- SLURP IN ALL THE NEEDED DECLARATIONS
150 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
152 slurp_fvs = implicit_fvs `plusFV` source_fvs
153 -- It's important to do the "plus" this way round, so that
154 -- when compiling the prelude, locally-defined (), Bool, etc
155 -- override the implicit ones.
157 traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList slurp_fvs))) `thenRn_`
158 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
160 -- EXIT IF ERRORS FOUND
161 rnDump rn_imp_decls rn_local_decls `thenRn_`
162 checkErrsRn `thenRn` \ no_errs_so_far ->
163 if not no_errs_so_far then
164 -- Found errors already, so exit now
168 -- GENERATE THE VERSION/USAGE INFO
169 mkImportInfo mod_name imports `thenRn` \ my_usages ->
171 -- BUILD THE MODULE INTERFACE
173 -- We record fixities even for things that aren't exported,
174 -- so that we can change into the context of this moodule easily
175 fixities = mkNameEnv [ (name, fixity)
176 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
179 -- Sort the exports to make them easier to compare for versions
180 my_exports = groupAvails this_module export_avails
182 final_decls = rn_local_decls ++ rn_imp_decls
183 is_orphan = any (isOrphanDecl this_module) rn_local_decls
185 mod_iface = ModIface { mi_module = this_module,
186 mi_version = initialVersionInfo,
187 mi_usages = my_usages,
189 mi_orphan = is_orphan,
190 mi_exports = my_exports,
191 mi_globals = gbl_env,
192 mi_fixities = fixities,
193 mi_deprecs = my_deprecs,
194 mi_decls = panic "mi_decls"
197 print_unqualified = unQualInScope gbl_env
198 is_exported name = name `elemNameSet` exported_names
199 exported_names = availsToNameSet export_avails
202 -- REPORT UNUSED NAMES, AND DEBUG DUMP
203 reportUnusedNames mod_iface print_unqualified
204 imports global_avail_env
205 source_fvs export_avails rn_imp_decls `thenRn_`
207 returnRn (Just (print_unqualified, is_exported, mod_iface, final_decls))
209 mod_name = moduleName this_module
212 Checking that main is defined
215 checkMain :: Module -> GlobalRdrEnv -> RnMG ()
216 checkMain this_mod local_env
217 | moduleName this_mod == mAIN_Name
218 = checkRn (main_RDR_Unqual `elemRdrEnv` local_env) noMainErr
223 @implicitFVs@ forces the renamer to slurp in some things which aren't
224 mentioned explicitly, but which might be needed by the type checker.
227 implicitFVs mod_name decls
228 = lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
229 returnRn (mkNameSet (map getName default_tycons) `plusFV`
232 -- Add occurrences for Int, and (), because they
233 -- are the types to which ambigious type variables may be defaulted by
234 -- the type checker; so they won't always appear explicitly.
235 -- [The () one is a GHC extension for defaulting CCall results.]
236 -- ALSO: funTyCon, since it occurs implicitly everywhere!
237 -- (we don't want to be bothered with making funTyCon a
238 -- free var at every function application!)
239 -- Double is dealt with separately in getGates
240 default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
242 -- Add occurrences for IO or PrimIO
243 implicit_main | mod_name == mAIN_Name
244 || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
247 -- Now add extra "occurrences" for things that
248 -- the deriving mechanism, or defaulting, will later need in order to
250 implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
252 -- Virtually every program has error messages in it somewhere
253 string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR,
254 unpackCStringUtf8_RDR, eqString_RDR]
256 get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _))
257 = concat (map get_deriv deriv_classes)
260 get_deriv cls = case lookupUFM derivingOccurrences cls of
266 isOrphanDecl this_mod (InstD (InstDecl inst_ty _ _ _ _))
267 = not (foldNameSet ((||) . nameIsLocalOrFrom this_mod) False
268 (extractHsTyNames (removeContext inst_ty)))
269 -- The 'removeContext' is because of
270 -- instance Foo a => Baz T where ...
271 -- The decl is an orphan if Baz and T are both not locally defined,
272 -- even if Foo *is* locally defined
274 isOrphanDecl this_mod (RuleD (HsRule _ _ _ lhs _ _))
277 -- At the moment we just check for common LHS forms
278 -- Expand as necessary. Getting it wrong just means
279 -- more orphans than necessary
280 check (HsVar v) = not (nameIsLocalOrFrom this_mod v)
281 check (HsApp f a) = check f && check a
282 check (HsLit _) = False
283 check (HsOverLit _) = False
284 check (OpApp l o _ r) = check l && check o && check r
285 check (NegApp e _) = check e
286 check (HsPar e) = check e
287 check (SectionL e o) = check e && check o
288 check (SectionR o e) = check e && check o
290 check other = True -- Safe fall through
292 isOrphanDecl _ _ = False
296 %*********************************************************
298 \subsection{Fixities}
300 %*********************************************************
303 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
304 fixitiesFromLocalDecls gbl_env decls
305 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
306 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
309 getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
310 getFixities acc (FixD fix)
313 getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ ))
314 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
315 -- Get fixities from class decl sigs too.
316 getFixities acc other_decl
319 fix_decl acc sig@(FixitySig rdr_name fixity loc)
320 = -- Check for fixity decl for something not declared
322 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
324 -- Check for duplicate fixity decl
325 case lookupNameEnv acc name of
326 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc') `thenRn_`
329 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
333 %*********************************************************
335 \subsection{Deprecations}
337 %*********************************************************
339 For deprecations, all we do is check that the names are in scope.
340 It's only imported deprecations, dealt with in RnIfaces, that we
341 gather them together.
344 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
345 -> [RdrNameDeprecation] -> RnMG Deprecations
346 rnDeprecs gbl_env Nothing []
349 rnDeprecs gbl_env (Just txt) decls
350 = mapRn (addErrRn . badDeprec) decls `thenRn_`
351 returnRn (DeprecAll txt)
353 rnDeprecs gbl_env Nothing decls
354 = mapRn rn_deprec decls `thenRn` \ pairs ->
355 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
357 rn_deprec (Deprecation rdr_name txt loc)
359 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
360 returnRn (Just (name, (name,txt)))
364 %************************************************************************
366 \subsection{Grabbing the old interface file and checking versions}
368 %************************************************************************
371 checkOldIface :: DynFlags
372 -> HomeIfaceTable -> HomeSymbolTable
373 -> PersistentCompilerState
375 -> Bool -- Source unchanged
376 -> Maybe ModIface -- Old interface from compilation manager, if any
377 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
378 -- True <=> errors happened
380 checkOldIface dflags hit hst pcs iface_path source_unchanged maybe_iface
381 = runRn dflags hit hst pcs (panic "Bogus module") $
383 Just old_iface -> -- Use the one we already have
384 setModuleRn (mi_module old_iface) (check_versions old_iface)
386 Nothing -- try and read it from a file
387 -> readIface iface_path `thenRn` \ read_result ->
389 Left err -> -- Old interface file not found, or garbled; give up
390 traceRn (text "Bad old interface file" $$ nest 4 err) `thenRn_`
391 returnRn (outOfDate, Nothing)
394 -> setModuleRn (pi_mod parsed_iface) $
395 loadOldIface parsed_iface `thenRn` \ m_iface ->
396 check_versions m_iface
398 check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
401 recompileRequired iface_path source_unchanged iface
402 `thenRn` \ recompile ->
403 returnRn (recompile, Just iface)
406 I think the following function should now have a more representative name,
410 loadOldIface :: ParsedIface -> RnMG ModIface
412 loadOldIface parsed_iface
413 = let iface = parsed_iface
417 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
418 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
419 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
420 returnRn (decls, rules, insts)
422 `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
424 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
425 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
426 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
427 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
429 version = VersionInfo { vers_module = pi_vers iface,
430 vers_exports = export_vers,
431 vers_rules = rule_vers,
432 vers_decls = decls_vers }
434 decls = mkIfaceDecls new_decls new_rules new_insts
436 mod_iface = ModIface { mi_module = mod, mi_version = version,
437 mi_exports = avails, mi_usages = usages,
438 mi_boot = False, mi_orphan = pi_orphan iface,
439 mi_fixities = fix_env, mi_deprecs = deprec_env,
441 mi_globals = panic "No mi_globals in old interface"
448 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
449 -> RnMS (NameEnv Version, [RenamedTyClDecl])
450 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
452 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
453 -> (Version, RdrNameTyClDecl)
454 -> RnMS (NameEnv Version, [RenamedTyClDecl])
455 loadHomeDecl (version_map, decls) (version, decl)
456 = rnTyClDecl decl `thenRn` \ decl' ->
457 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
460 loadHomeRules :: (Version, [RdrNameRuleDecl])
461 -> RnMS (Version, [RenamedRuleDecl])
462 loadHomeRules (version, rules)
463 = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
464 returnRn (version, rules')
467 loadHomeInsts :: [RdrNameInstDecl]
468 -> RnMS [RenamedInstDecl]
469 loadHomeInsts insts = mapRn rnInstDecl insts
472 loadHomeUsage :: ImportVersion OccName
473 -> RnMG (ImportVersion Name)
474 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
475 = rn_imps whats_imported `thenRn` \ whats_imported' ->
476 returnRn (mod_name, orphans, is_boot, whats_imported')
478 rn_imps NothingAtAll = returnRn NothingAtAll
479 rn_imps (Everything v) = returnRn (Everything v)
480 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
481 returnRn (Specifically mv ev items' rv)
482 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
488 %*********************************************************
490 \subsection{Closing up the interface decls}
492 %*********************************************************
494 Suppose we discover we don't need to recompile. Then we start from the
495 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
498 closeIfaceDecls :: DynFlags
499 -> HomeIfaceTable -> HomeSymbolTable
500 -> PersistentCompilerState
501 -> ModIface -- Get the decls from here
502 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
503 -- True <=> errors happened
504 closeIfaceDecls dflags hit hst pcs
505 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
506 = runRn dflags hit hst pcs mod $
509 rule_decls = dcl_rules iface_decls
510 inst_decls = dcl_insts iface_decls
511 tycl_decls = dcl_tycl iface_decls
512 decls = map RuleD rule_decls ++
513 map InstD inst_decls ++
515 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
516 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
517 unionManyNameSets (map tyClDeclFVs tycl_decls)
519 closeDecls decls needed
522 %*********************************************************
524 \subsection{Unused names}
526 %*********************************************************
529 reportUnusedNames :: ModIface -> PrintUnqualified
530 -> [RdrNameImportDecl]
532 -> NameSet -- Used in this module
533 -> Avails -- Exported by this module
536 reportUnusedNames my_mod_iface unqual imports avail_env
537 source_fvs export_avails imported_decls
538 = warnUnusedModules unused_imp_mods `thenRn_`
539 warnUnusedLocalBinds bad_locals `thenRn_`
540 warnUnusedImports bad_imp_names `thenRn_`
541 printMinimalImports this_mod unqual minimal_imports `thenRn_`
542 warnDeprecations this_mod export_avails my_deprecs
546 this_mod = mi_module my_mod_iface
547 gbl_env = mi_globals my_mod_iface
548 my_deprecs = mi_deprecs my_mod_iface
550 -- The export_fvs make the exported names look just as if they
551 -- occurred in the source program.
552 export_fvs = availsToNameSet export_avails
553 used_names = source_fvs `plusFV` export_fvs
555 -- Now, a use of C implies a use of T,
556 -- if C was brought into scope by T(..) or T(C)
557 really_used_names = used_names `unionNameSets`
558 mkNameSet [ parent_name
559 | sub_name <- nameSetToList used_names
561 -- Usually, every used name will appear in avail_env, but there
562 -- is one time when it doesn't: tuples and other built in syntax. When you
563 -- write (a,b) that gives rise to a *use* of "(,)", so that the
564 -- instances will get pulled in, but the tycon "(,)" isn't actually
565 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
566 -- similarly, 3.5 gives rise to an implcit use of :%
567 -- Hence the silent 'False' in all other cases
569 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
570 Just (AvailTC n _) -> Just n
574 -- Collect the defined names from the in-scope environment
575 -- Look for the qualified ones only, else get duplicates
576 defined_names :: [(Name,Provenance)]
577 defined_names = foldRdrEnv add [] gbl_env
578 add rdr_name ns acc | isQual rdr_name = ns ++ acc
581 defined_and_used, defined_but_not_used :: [(Name,Provenance)]
582 (defined_and_used, defined_but_not_used) = partition used defined_names
583 used (name,_) = name `elemNameSet` really_used_names
585 -- Filter out the ones only defined implicitly
587 bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
589 bad_imp_names :: [(Name,Provenance)]
590 bad_imp_names = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True))) <- defined_but_not_used,
591 not (module_unused mod)]
593 -- inst_mods are directly-imported modules that
594 -- contain instance decl(s) that the renamer decided to suck in
595 -- It's not necessarily redundant to import such modules.
601 -- The import M() is not *necessarily* redundant, even if
602 -- we suck in no instance decls from M (e.g. it contains
603 -- no instance decls, or This contains no code). It may be
604 -- that we import M solely to ensure that M's orphan instance
605 -- decls (or those in its imports) are visible to people who
606 -- import This. Sigh.
607 -- There's really no good way to detect this, so the error message
608 -- in RnEnv.warnUnusedModules is weakened instead
609 inst_mods :: [ModuleName]
610 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
611 let m = moduleName (nameModule dfun),
612 m `elem` direct_import_mods
615 -- To figure out the minimal set of imports, start with the things
616 -- that are in scope (i.e. in gbl_env). Then just combine them
617 -- into a bunch of avails, so they are properly grouped
618 minimal_imports :: FiniteMap ModuleName AvailEnv
619 minimal_imports0 = emptyFM
620 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
621 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
623 add_name (n,NonLocalDef (UserImport m _ _)) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
624 (unitAvailEnv (mk_avail n))
625 add_name (n,other_prov) acc = acc
627 mk_avail n = case lookupNameEnv avail_env n of
628 Just (AvailTC m _) | n==m -> AvailTC n [n]
629 | otherwise -> AvailTC m [n,m]
630 Just avail -> Avail n
631 Nothing -> pprPanic "mk_avail" (ppr n)
634 | m `elemFM` acc = acc -- We import something already
635 | otherwise = addToFM acc m emptyAvailEnv
636 -- Add an empty collection of imports for a module
637 -- from which we have sucked only instance decls
639 direct_import_mods :: [ModuleName]
640 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
642 -- unused_imp_mods are the directly-imported modules
643 -- that are not mentioned in minimal_imports
644 unused_imp_mods = [m | m <- direct_import_mods,
645 not (maybeToBool (lookupFM minimal_imports m)),
648 module_unused :: Module -> Bool
649 module_unused mod = moduleName mod `elem` unused_imp_mods
651 warnDeprecations this_mod export_avails my_deprecs used_names
652 = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
653 if not warn_drs then returnRn () else
655 -- The home modules for things in the export list
656 -- may not have been loaded yet; do it now, so
657 -- that we can see their deprecations, if any
658 mapRn_ load_home export_mods `thenRn_`
660 getIfacesRn `thenRn` \ ifaces ->
661 getHomeIfaceTableRn `thenRn` \ hit ->
665 | n <- nameSetToList used_names,
666 Just txt <- [lookup_deprec hit pit n] ]
668 mapRn_ warnDeprec deprecs
671 export_mods = nub [ moduleName (nameModule name)
672 | avail <- export_avails,
673 let name = availName avail,
674 not (nameIsLocalOrFrom this_mod name) ]
676 load_home m = loadInterface (text "Check deprecations for" <+> ppr m) m ImportBySystem
678 lookup_deprec hit pit n
679 | nameIsLocalOrFrom this_mod n
680 = lookupDeprec my_deprecs n
682 = case lookupIface hit pit n of
683 Just iface -> lookupDeprec (mi_deprecs iface) n
684 Nothing -> pprPanic "warnDeprecations:" (ppr n)
686 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
687 printMinimalImports this_mod unqual imps
688 = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
689 if not dump_minimal then returnRn () else
691 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
692 ioToRnM (do { h <- openFile filename WriteMode ;
693 printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
697 filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
698 ppr_mod_ie (mod_name, ies)
699 | mod_name == pRELUDE_Name
702 = ptext SLIT("import") <+> ppr mod_name <>
703 parens (fsep (punctuate comma (map ppr ies)))
705 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
708 to_ie :: AvailInfo -> RnMG (IE Name)
709 to_ie (Avail n) = returnRn (IEVar n)
710 to_ie (AvailTC n [m]) = ASSERT( n==m )
711 returnRn (IEThingAbs n)
713 = getInterfaceExports n_mod ImportBySystem `thenRn` \ (_, avails_by_module) ->
714 case [xs | (m,as) <- avails_by_module,
718 [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
719 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
720 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
723 n_mod = moduleName (nameModule n)
725 rnDump :: [RenamedHsDecl] -- Renamed imported decls
726 -> [RenamedHsDecl] -- Renamed local decls
728 rnDump imp_decls local_decls
729 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
730 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
731 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
732 getIfacesRn `thenRn` \ ifaces ->
734 ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
736 (getRnStats imp_decls ifaces) ;
738 dumpIfSet dump_rn "Renamer:"
739 (vcat (map ppr (local_decls ++ imp_decls)))
746 %*********************************************************
748 \subsection{Statistics}
750 %*********************************************************
753 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
754 getRnStats imported_decls ifaces
755 = hcat [text "Renamer stats: ", stats]
757 n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
758 -- This is really only right for a one-shot compile
760 (decls_map, n_decls_slurped) = iDecls ifaces
762 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
763 -- Data, newtype, and class decls are in the decls_fm
764 -- under multiple names; the tycon/class, and each
765 -- constructor/class op too.
766 -- The 'True' selects just the 'main' decl
769 (insts_left, n_insts_slurped) = iInsts ifaces
770 n_insts_left = length (bagToList insts_left)
772 (rules_left, n_rules_slurped) = iRules ifaces
773 n_rules_left = length (bagToList rules_left)
776 [int n_mods <+> text "interfaces read",
777 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
778 int (n_decls_slurped + n_decls_left), text "read"],
779 hsep [ int n_insts_slurped, text "instance decls imported, out of",
780 int (n_insts_slurped + n_insts_left), text "read"],
781 hsep [ int n_rules_slurped, text "rule decls imported, out of",
782 int (n_rules_slurped + n_rules_left), text "read"]
787 %************************************************************************
789 \subsection{Errors and warnings}
791 %************************************************************************
794 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
795 warnDeprec (name, txt)
796 = pushSrcLocRn (getSrcLoc name) $
798 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
799 text "is deprecated:", nest 4 (ppr txt) ]
802 dupFixityDecl rdr_name loc1 loc2
803 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
804 ptext SLIT("at ") <+> ppr loc1,
805 ptext SLIT("and") <+> ppr loc2]
808 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
812 = hsep [ptext SLIT("Module"), quotes (ppr mAIN_Name),
813 ptext SLIT("must include a definition for"), quotes (ptext SLIT("main"))]