getInterfaceExports, closeDecls,
RecompileRequired, outOfDate, recompileRequired
)
-import RnHiFiles ( readIface, removeContext,
+import RnHiFiles ( readIface, removeContext, loadInterface,
loadExports, loadFixDecls, loadDeprecs )
-import RnEnv ( availName,
+import RnEnv ( availsToNameSet, availName,
emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
lookupOrigNames, lookupSrcName, newGlobalName
mkModuleInThisPackage, mkModuleName, moduleEnvElts
)
import Name ( Name, NamedThing(..), getSrcLoc,
- nameIsLocalOrFrom,
- nameOccName, nameModule,
+ nameIsLocalOrFrom, nameOccName, nameModule,
)
import Name ( mkNameEnv, nameEnvElts, extendNameEnv )
-import RdrName ( elemRdrEnv, foldRdrEnv, isQual )
+import RdrName ( rdrEnvToList, elemRdrEnv, foldRdrEnv, isQual )
import OccName ( occNameFlavour )
import NameSet
import TysWiredIn ( unitTyCon, intTyCon, boolTyCon )
import IO ( openFile, IOMode(..) )
import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
ModIface(..), WhatsImported(..),
- VersionInfo(..), ImportVersion, IfaceDecls(..),
- GlobalRdrEnv, AvailEnv, GenAvailInfo(..), AvailInfo,
+ VersionInfo(..), ImportVersion,
+ IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
+ GlobalRdrEnv, AvailEnv, GenAvailInfo(..), AvailInfo, Avails,
Provenance(..), ImportReason(..), initialVersionInfo,
Deprecations(..), lookupDeprec, lookupIface
)
-- SLURP IN ALL THE NEEDED DECLARATIONS
implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
let
- -- The export_fvs make the exported names look just as if they
- -- occurred in the source program. For the reasoning, see the
- -- comments with RnIfaces.getImportVersions.
- -- We only need the 'parent name' of the avail;
- -- that's enough to suck in the declaration.
- export_fvs = mkNameSet (map availName export_avails)
- real_source_fvs = source_fvs `plusFV` export_fvs
-
- slurp_fvs = implicit_fvs `plusFV` real_source_fvs
+ slurp_fvs = implicit_fvs `plusFV` source_fvs
-- It's important to do the "plus" this way round, so that
-- when compiling the prelude, locally-defined (), Bool, etc
-- override the implicit ones.
-- REPORT UNUSED NAMES, AND DEBUG DUMP
reportUnusedNames mod_iface imports global_avail_env
- real_source_fvs rn_imp_decls `thenRn_`
+ source_fvs export_avails rn_imp_decls `thenRn_`
returnRn (Just (mod_iface, final_decls))
where
loadOldIface parsed_iface
= let iface = parsed_iface
- in -- RENAME IT
- let mod = pi_mod iface
- doc_str = ptext SLIT("need usage info from") <+> ppr mod
+ mod = pi_mod iface
in
initIfaceRnMS mod (
loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
vers_rules = rule_vers,
vers_decls = decls_vers }
- decls = IfaceDecls { dcl_tycl = new_decls,
- dcl_rules = new_rules,
- dcl_insts = new_insts }
+ decls = mkIfaceDecls new_decls new_rules new_insts
mod_iface = ModIface { mi_module = mod, mi_version = version,
mi_exports = avails, mi_usages = usages,
\begin{code}
reportUnusedNames :: ModIface -> [RdrNameImportDecl]
-> AvailEnv
- -> NameSet
+ -> NameSet -- Used in this module
+ -> Avails -- Exported by this module
-> [RenamedHsDecl]
-> RnMG ()
reportUnusedNames my_mod_iface imports avail_env
- used_names imported_decls
+ source_fvs export_avails imported_decls
= warnUnusedModules unused_imp_mods `thenRn_`
warnUnusedLocalBinds bad_locals `thenRn_`
warnUnusedImports bad_imp_names `thenRn_`
printMinimalImports this_mod minimal_imports `thenRn_`
- warnDeprecations this_mod my_deprecs really_used_names `thenRn_`
+ warnDeprecations this_mod export_avails my_deprecs
+ really_used_names `thenRn_`
traceRn (text "Used" <+> fsep (map ppr (nameSetToList used_names))) `thenRn_`
returnRn ()
gbl_env = mi_globals my_mod_iface
my_deprecs = mi_deprecs my_mod_iface
+ -- The export_fvs make the exported names look just as if they
+ -- occurred in the source program.
+ export_fvs = availsToNameSet export_avails
+ used_names = source_fvs `plusFV` export_fvs
+
-- Now, a use of C implies a use of T,
-- if C was brought into scope by T(..) or T(C)
really_used_names = used_names `unionNameSets`
module_unused :: Module -> Bool
module_unused mod = moduleName mod `elem` unused_imp_mods
-
-warnDeprecations this_mod my_deprecs used_names
+warnDeprecations this_mod export_avails my_deprecs used_names
= doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
if not warn_drs then returnRn () else
- getIfacesRn `thenRn` \ ifaces ->
- getHomeIfaceTableRn `thenRn` \ hit ->
+ -- The home modules for things in the export list
+ -- may not have been loaded yet; do it now, so
+ -- that we can see their deprecations, if any
+ mapRn_ load_home export_mods `thenRn_`
+
+ getIfacesRn `thenRn` \ ifaces ->
+ getHomeIfaceTableRn `thenRn` \ hit ->
let
pit = iPIT ifaces
deprecs = [ (n,txt)
mapRn_ warnDeprec deprecs
where
+ export_mods = nub [ moduleName (nameModule name)
+ | avail <- export_avails,
+ let name = availName avail,
+ not (nameIsLocalOrFrom this_mod name) ]
+
+ load_home m = loadInterface (text "Check deprecations for" <+> ppr m) m ImportBySystem
+
lookup_deprec hit pit n
| nameIsLocalOrFrom this_mod n
= lookupDeprec my_deprecs n
where
n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
-- This is really only right for a one-shot compile
+
+ (decls_map, n_decls_slurped) = iDecls ifaces
- decls_read = [decl | (avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces)
+ n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
-- Data, newtype, and class decls are in the decls_fm
-- under multiple names; the tycon/class, and each
-- constructor/class op too.
-- The 'True' selects just the 'main' decl
]
- (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd) = countTyClDecls decls_read
- (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
+ (insts_left, n_insts_slurped) = iInsts ifaces
+ n_insts_left = length (bagToList insts_left)
- unslurped_insts = iInsts ifaces
- inst_decls_unslurped = length (bagToList unslurped_insts)
- inst_decls_read = id_sp + inst_decls_unslurped
+ (rules_left, n_rules_slurped) = iRules ifaces
+ n_rules_left = length (bagToList rules_left)
stats = vcat
[int n_mods <+> text "interfaces read",
- hsep [ int cd_sp, text "class decls imported, out of",
- int cd_rd, text "read"],
- hsep [ int dd_sp, text "data decls imported, out of",
- int dd_rd, text "read"],
- hsep [ int nd_sp, text "newtype decls imported, out of",
- int nd_rd, text "read"],
- hsep [int sd_sp, text "type synonym decls imported, out of",
- int sd_rd, text "read"],
- hsep [int vd_sp, text "value signatures imported, out of",
- int vd_rd, text "read"],
- hsep [int id_sp, text "instance decls imported, out of",
- int inst_decls_read, text "read"],
- text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
- [d | TyClD d <- imported_decls, isClassDecl d]),
- text "cls dcls read" <+> fsep (map (ppr . tyClDeclName)
- [d | d <- decls_read, isClassDecl d])]
+ hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
+ int (n_decls_slurped + n_decls_left), text "read"],
+ hsep [ int n_insts_slurped, text "instance decls imported, out of",
+ int (n_insts_slurped + n_insts_left), text "read"],
+ hsep [ int n_rules_slurped, text "rule decls imported, out of",
+ int (n_rules_slurped + n_rules_left), text "read"]
+ ]
count_decls decls
= (class_decls,
projects / ghc-hetmet.git / blobdiff