import LoadIface ( readIface, loadInterface )
import BasicTypes ( Version, initialVersion, bumpVersion )
import TcRnMonad
-import TcRnTypes ( mkModDeps )
import HscTypes ( ModIface(..), ModDetails(..),
ModGuts(..), IfaceExport,
HscEnv(..), hscEPS, Dependencies(..), FixItem(..),
)
+import Packages ( HomeModules )
import DynFlags ( GhcMode(..), DynFlags(..), DynFlag(..), dopt )
import StaticFlags ( opt_HiVersion )
import Name ( Name, nameModule, nameOccName, nameParent,
isEmptyOccSet, intersectOccSet, intersectsOccSet,
occNameFS, isTcOcc )
import Module ( Module, moduleFS,
- ModLocation(..), mkSysModuleFS, moduleUserString,
+ ModLocation(..), mkModuleFS, moduleString,
ModuleEnv, emptyModuleEnv, lookupModuleEnv,
extendModuleEnv_C
)
import Monad ( when )
import List ( insert )
import Maybes ( orElse, mapCatMaybes, isNothing, isJust,
- fromJust, expectJust, MaybeErr(..) )
+ expectJust, MaybeErr(..) )
\end{code}
mg_boot = is_boot,
mg_usages = usages,
mg_deps = deps,
+ mg_home_mods = home_mods,
mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
mg_deprecs = src_deprecs })
-- to expose in the interface
= do { eps <- hscEPS hsc_env
- ; let { ext_nm_rhs = mkExtNameFn hsc_env eps this_mod
+ ; let { ext_nm_rhs = mkExtNameFn hsc_env home_mods eps this_mod
; ext_nm_lhs = mkLhsNameFn this_mod
; decls = [ tyThingToIfaceDecl ext_nm_rhs thing
-- Debug printing
; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags)
- (printDump (fromJust pp_orphs))
+ (printDump (expectJust "mkIface" pp_orphs))
; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
(pprModIface new_iface)
-----------------------------
-writeIfaceFile :: HscEnv -> ModLocation -> ModIface -> Bool -> IO ()
--- Write the interface file, if necessary
-writeIfaceFile hsc_env location new_iface no_change_at_all
- | no_change_at_all = return ()
- | ghc_mode == Interactive = return ()
- | otherwise
- = do { createDirectoryHierarchy (directoryOf hi_file_path)
- ; writeBinIface hi_file_path new_iface }
- where
- ghc_mode = ghcMode (hsc_dflags hsc_env)
- hi_file_path = ml_hi_file location
+writeIfaceFile :: ModLocation -> ModIface -> IO ()
+writeIfaceFile location new_iface
+ = do createDirectoryHierarchy (directoryOf hi_file_path)
+ writeBinIface hi_file_path new_iface
+ where hi_file_path = ml_hi_file location
-----------------------------
-mkExtNameFn :: HscEnv -> ExternalPackageState -> Module -> Name -> IfaceExtName
-mkExtNameFn hsc_env eps this_mod
+mkExtNameFn :: HscEnv -> HomeModules -> ExternalPackageState -> Module -> Name -> IfaceExtName
+mkExtNameFn hsc_env hmods eps this_mod
= ext_nm
where
- dflags = hsc_dflags hsc_env
hpt = hsc_HPT hsc_env
pit = eps_PIT eps
Nothing -> LocalTop occ
Just par -> LocalTopSub occ (nameOccName par)
| isWiredInName name = ExtPkg mod occ
- | isHomeModule dflags mod = HomePkg mod occ vers
+ | isHomeModule hmods mod = HomePkg mod occ vers
| otherwise = ExtPkg mod occ
where
mod = nameModule name
\begin{code}
mkUsageInfo :: HscEnv
- -> ModuleEnv (Module, Maybe Bool, SrcSpan)
+ -> HomeModules
+ -> ModuleEnv (Module, Bool, SrcSpan)
-> [(Module, IsBootInterface)]
-> NameSet -> IO [Usage]
-mkUsageInfo hsc_env dir_imp_mods dep_mods used_names
+mkUsageInfo hsc_env hmods dir_imp_mods dep_mods used_names
= do { eps <- hscEPS hsc_env
- ; let usages = mk_usage_info (eps_PIT eps) hsc_env
+ ; let usages = mk_usage_info (eps_PIT eps) hsc_env hmods
dir_imp_mods dep_mods used_names
; usages `seqList` return usages }
-- seq the list of Usages returned: occasionally these
-- don't get evaluated for a while and we can end up hanging on to
-- the entire collection of Ifaces.
-mk_usage_info pit hsc_env dir_imp_mods dep_mods proto_used_names
+mk_usage_info pit hsc_env hmods dir_imp_mods dep_mods proto_used_names
= mapCatMaybes mkUsage dep_mods
-- ToDo: do we need to sort into canonical order?
where
- dflags = hsc_dflags hsc_env
hpt = hsc_HPT hsc_env
used_names = mkNameSet $ -- Eliminate duplicates
mod = nameModule name
add_item occs _ = occ:occs
- import_all mod = case lookupModuleEnv dir_imp_mods mod of
- Just (_,imp_all,_) -> isNothing imp_all
- Nothing -> False
+ depend_on_exports mod = case lookupModuleEnv dir_imp_mods mod of
+ Just (_,no_imp,_) -> not no_imp
+ Nothing -> True
-- We want to create a Usage for a home module if
-- a) we used something from; has something in used_names
mkUsage :: (Module, Bool) -> Maybe Usage
mkUsage (mod_name, _)
| isNothing maybe_iface -- We can't depend on it if we didn't
- || not (isHomeModule dflags mod) -- even open the interface!
+ || not (isHomeModule hmods mod) -- even open the interface!
|| (null used_occs
- && not all_imported
+ && isNothing export_vers
&& not orphan_mod)
= Nothing -- Record no usage info
version_env = mi_ver_fn iface
mod_vers = mi_mod_vers iface
rules_vers = mi_rule_vers iface
- all_imported = import_all mod
- export_vers | all_imported = Just (mi_exp_vers iface)
- | otherwise = Nothing
+ export_vers | depend_on_exports mod = Just (mi_exp_vers iface)
+ | otherwise = Nothing
-- The sort is to put them into canonical order
used_occs = lookupModuleEnv ent_map mod `orElse` []
-- Group by module and sort by occurrence
-- This keeps the list in canonical order
mkIfaceExports exports
- = [ (mkSysModuleFS fs, eltsFM avails)
+ = [ (mkModuleFS fs, eltsFM avails)
| (fs, avails) <- fmToList groupFM
]
where
checkOldIface hsc_env mod_summary source_unchanged maybe_iface
= do { showPass (hsc_dflags hsc_env)
- ("Checking old interface for " ++ moduleUserString (ms_mod mod_summary)) ;
+ ("Checking old interface for " ++ moduleString (ms_mod mod_summary)) ;
; initIfaceCheck hsc_env $
check_old_iface mod_summary source_unchanged maybe_iface
-- If the source has changed and we're in interactive mode, avoid reading
-- an interface; just return the one we might have been supplied with.
- getGhciMode `thenM` \ ghci_mode ->
- if (ghci_mode == Interactive) && not source_unchanged then
+ getGhcMode `thenM` \ ghc_mode ->
+ if (ghc_mode == Interactive || ghc_mode == JustTypecheck)
+ && not source_unchanged then
returnM (outOfDate, maybe_iface)
else
-- CHECK EXPORT LIST
if checkExportList maybe_old_export_vers new_export_vers then
out_of_date_vers (ptext SLIT(" Export list changed"))
- (fromJust maybe_old_export_vers)
+ (expectJust "checkModUsage" maybe_old_export_vers)
new_export_vers
else
projects / ghc-hetmet.git / blobdiff