instDeclFVs, tyClDeclFVs, ruleDeclFVs
)
-import CmdLineOpts ( DynFlags, DynFlag(..) )
+import CmdLineOpts ( DynFlags, DynFlag(..), dopt )
import RnMonad
import RnNames ( getGlobalNames )
import RnSource ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
import RnIfaces ( slurpImpDecls, mkImportInfo,
getInterfaceExports, closeDecls,
- RecompileRequired, recompileRequired
+ RecompileRequired, outOfDate, recompileRequired
)
-import RnHiFiles ( findAndReadIface, removeContext, loadExports, loadFixDecls, loadDeprecs )
+import RnHiFiles ( readIface, removeContext,
+ loadExports, loadFixDecls, loadDeprecs )
import RnEnv ( availName,
emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
lookupOrigNames, lookupGlobalRn, newGlobalName
)
import Module ( Module, ModuleName, WhereFrom(..),
- moduleNameUserString, moduleName
+ moduleNameUserString, moduleName,
+ mkModuleInThisPackage, mkModuleName, moduleEnvElts
)
import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
nameOccName, nameModule,
import Type ( funTyCon )
import ErrUtils ( dumpIfSet )
import Bag ( bagToList )
-import FiniteMap ( FiniteMap, eltsFM, fmToList, emptyFM, lookupFM,
+import FiniteMap ( FiniteMap, fmToList, emptyFM, lookupFM,
addToFM_C, elemFM, addToFM
)
import UniqFM ( lookupUFM )
mod_iface = ModIface { mi_module = this_module,
mi_version = initialVersionInfo,
+ mi_boot = False,
mi_orphan = any isOrphanDecl rn_local_decls,
mi_exports = my_exports,
mi_globals = gbl_env,
checkOldIface :: DynFlags
-> HomeIfaceTable -> HomeSymbolTable
-> PersistentCompilerState
- -> Module
+ -> FilePath
-> Bool -- Source unchanged
-> Maybe ModIface -- Old interface from compilation manager, if any
-> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
-- True <=> errors happened
-checkOldIface dflags hit hst pcs mod source_unchanged maybe_iface
- = initRn dflags hit hst pcs mod $
-
- -- Load the old interface file, if we havn't already got it
- loadOldIface mod maybe_iface `thenRn` \ maybe_iface ->
-
- -- Check versions
- recompileRequired mod source_unchanged maybe_iface `thenRn` \ recompile ->
-
- returnRn (recompile, maybe_iface)
+checkOldIface dflags hit hst pcs iface_path source_unchanged maybe_iface
+ = case maybe_iface of
+ Just old_iface -> -- Use the one we already have
+ startRn (mi_module old_iface) $
+ check_versions old_iface
+ Nothing -- try and read it from a file
+ -> do read_result <- readIface do_traceRn iface_path
+ case read_result of
+ Left err -> -- Old interface file not found, or garbled; give up
+ return (pcs, False, (outOfDate, Nothing))
+ Right parsed_iface
+ -> startRn (pi_mod parsed_iface) $
+ loadOldIface parsed_iface `thenRn` \ m_iface ->
+ check_versions m_iface
+ where
+ check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
+ check_versions iface
+ = -- Check versions
+ recompileRequired iface_path source_unchanged iface
+ `thenRn` \ recompile ->
+ returnRn (recompile, Just iface)
+
+ do_traceRn = dopt Opt_D_dump_rn_trace dflags
+ ioTraceRn sdoc = if do_traceRn then printErrs sdoc else return ()
+ startRn mod = initRn dflags hit hst pcs mod
\end{code}
+I think the following function should now have a more representative name,
+but what?
\begin{code}
-loadOldIface :: Module -> Maybe ModIface -> RnMG (Maybe ModIface)
-loadOldIface mod (Just iface)
- = returnRn (Just iface)
-
-loadOldIface mod Nothing
- = -- LOAD THE OLD INTERFACE FILE
- findAndReadIface doc_str (moduleName mod) False {- Not hi-boot -} `thenRn` \ read_result ->
- case read_result of {
- Left err -> -- Old interface file not found, or garbled, so we'd better bail out
- traceRn (vcat [ptext SLIT("No old interface file:"), err]) `thenRn_`
- returnRn Nothing ;
-
- Right (_, iface) ->
+loadOldIface :: ParsedIface -> RnMG ModIface
- -- RENAME IT
+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
+ in
initIfaceRnMS mod (
loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
loadHomeRules (pi_rules iface) `thenRn` \ rules ->
loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
returnRn (decls, rules, insts)
- ) `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
+ )
+ `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
- loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
+ loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
let
dcl_insts = new_insts }
mod_iface = ModIface { mi_module = mod, mi_version = version,
- mi_exports = avails, mi_orphan = pi_orphan iface,
+ mi_exports = avails, mi_usages = usages,
+ mi_boot = False, mi_orphan = pi_orphan iface,
mi_fixities = fix_env, mi_deprecs = deprec_env,
- mi_usages = usages,
mi_decls = decls,
mi_globals = panic "No mi_globals in old interface"
}
in
- returnRn (Just mod_iface)
- }
-
-
- where
- doc_str = ptext SLIT("need usage info from") <+> ppr mod
+ returnRn mod_iface
\end{code}
\begin{code}
mapRn_ warnDeprec deprecs
where
- mod = mi_module my_mod_iface
my_deprecs = mi_deprecs my_mod_iface
lookup_deprec hit pit n
- | isLocalThing mod n = lookupDeprec my_deprecs n
+ | isLocallyDefined n = lookupDeprec my_deprecs n
| otherwise = case lookupTable hit pit n of
Just iface -> lookupDeprec (mi_deprecs iface) n
Nothing -> pprPanic "warnDeprecations:" (ppr n)
getRnStats imported_decls ifaces
= hcat [text "Renamer stats: ", stats]
where
- n_mods = length [() | (_, _, True) <- eltsFM (iImpModInfo ifaces)]
+ n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
+ -- This is really only right for a one-shot compile
decls_read = [decl | (avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
-- Data, newtype, and class decls are in the decls_fm
projects / ghc-hetmet.git / blobdiff