projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2006-01-06 16:30:17 by simonmar]
[ghc-hetmet.git]
/
ghc
/
compiler
/
iface
/
MkIface.lhs
diff --git
a/ghc/compiler/iface/MkIface.lhs
b/ghc/compiler/iface/MkIface.lhs
index
f27538d
..
2f15ee3
100644
(file)
--- a/
ghc/compiler/iface/MkIface.lhs
+++ b/
ghc/compiler/iface/MkIface.lhs
@@
-185,7
+185,6
@@
import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
import LoadIface ( readIface, loadInterface )
import BasicTypes ( Version, initialVersion, bumpVersion )
import TcRnMonad
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 HscTypes ( ModIface(..), ModDetails(..),
ModGuts(..), IfaceExport,
HscEnv(..), hscEPS, Dependencies(..), FixItem(..),
@@
-200,6
+199,7
@@
import HscTypes ( ModIface(..), ModDetails(..),
)
)
+import Packages ( HomeModules )
import DynFlags ( GhcMode(..), DynFlags(..), DynFlag(..), dopt )
import StaticFlags ( opt_HiVersion )
import Name ( Name, nameModule, nameOccName, nameParent,
import DynFlags ( GhcMode(..), DynFlags(..), DynFlag(..), dopt )
import StaticFlags ( opt_HiVersion )
import Name ( Name, nameModule, nameOccName, nameParent,
@@
-214,7
+214,7
@@
import OccName ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
isEmptyOccSet, intersectOccSet, intersectsOccSet,
occNameFS, isTcOcc )
import Module ( Module, moduleFS,
isEmptyOccSet, intersectOccSet, intersectsOccSet,
occNameFS, isTcOcc )
import Module ( Module, moduleFS,
- ModLocation(..), mkSysModuleFS, moduleUserString,
+ ModLocation(..), mkModuleFS, moduleString,
ModuleEnv, emptyModuleEnv, lookupModuleEnv,
extendModuleEnv_C
)
ModuleEnv, emptyModuleEnv, lookupModuleEnv,
extendModuleEnv_C
)
@@
-259,6
+259,7
@@
mkIface hsc_env maybe_old_iface
mg_boot = is_boot,
mg_usages = usages,
mg_deps = deps,
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 })
mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
mg_deprecs = src_deprecs })
@@
-273,7
+274,7
@@
mkIface hsc_env maybe_old_iface
-- to expose in the interface
= do { eps <- hscEPS hsc_env
-- 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
; ext_nm_lhs = mkLhsNameFn this_mod
; decls = [ tyThingToIfaceDecl ext_nm_rhs thing
@@
-338,8
+339,9
@@
mkIface hsc_env maybe_old_iface
writeIfaceFile :: HscEnv -> ModLocation -> ModIface -> Bool -> IO ()
-- Write the interface file, if necessary
writeIfaceFile hsc_env location new_iface no_change_at_all
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 ()
+ | no_change_at_all = return ()
+ | ghc_mode == Interactive = return ()
+ | ghc_mode == JustTypecheck = return ()
| otherwise
= do { createDirectoryHierarchy (directoryOf hi_file_path)
; writeBinIface hi_file_path new_iface }
| otherwise
= do { createDirectoryHierarchy (directoryOf hi_file_path)
; writeBinIface hi_file_path new_iface }
@@
-349,11
+351,10
@@
writeIfaceFile hsc_env location new_iface no_change_at_all
-----------------------------
-----------------------------
-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
= ext_nm
where
- dflags = hsc_dflags hsc_env
hpt = hsc_HPT hsc_env
pit = eps_PIT eps
hpt = hsc_HPT hsc_env
pit = eps_PIT eps
@@
-362,7
+363,7
@@
mkExtNameFn hsc_env eps this_mod
Nothing -> LocalTop occ
Just par -> LocalTopSub occ (nameOccName par)
| isWiredInName name = ExtPkg mod occ
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
| otherwise = ExtPkg mod occ
where
mod = nameModule name
@@
-638,23
+639,23
@@
bump_unless False v = bumpVersion v
\begin{code}
mkUsageInfo :: HscEnv
\begin{code}
mkUsageInfo :: HscEnv
- -> ModuleEnv (Module, Maybe Bool, SrcSpan)
+ -> HomeModules
+ -> ModuleEnv (Module, Bool, SrcSpan)
-> [(Module, IsBootInterface)]
-> NameSet -> IO [Usage]
-> [(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
= 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.
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
= 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
hpt = hsc_HPT hsc_env
used_names = mkNameSet $ -- Eliminate duplicates
@@
-674,9
+675,9
@@
mk_usage_info pit hsc_env dir_imp_mods dep_mods proto_used_names
mod = nameModule name
add_item occs _ = occ:occs
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
-- We want to create a Usage for a home module if
-- a) we used something from; has something in used_names
@@
-687,9
+688,9
@@
mk_usage_info pit hsc_env dir_imp_mods dep_mods proto_used_names
mkUsage :: (Module, Bool) -> Maybe Usage
mkUsage (mod_name, _)
| isNothing maybe_iface -- We can't depend on it if we didn't
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
|| (null used_occs
- && not all_imported
+ && isNothing export_vers
&& not orphan_mod)
= Nothing -- Record no usage info
&& not orphan_mod)
= Nothing -- Record no usage info
@@
-710,9
+711,8
@@
mk_usage_info pit hsc_env dir_imp_mods dep_mods proto_used_names
version_env = mi_ver_fn iface
mod_vers = mi_mod_vers iface
rules_vers = mi_rule_vers iface
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` []
-- The sort is to put them into canonical order
used_occs = lookupModuleEnv ent_map mod `orElse` []
@@
-726,7
+726,7
@@
mkIfaceExports :: NameSet -> [(Module, [GenAvailInfo OccName])]
-- Group by module and sort by occurrence
-- This keeps the list in canonical order
mkIfaceExports exports
-- 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
| (fs, avails) <- fmToList groupFM
]
where
@@
-768,7
+768,7
@@
checkOldIface :: HscEnv
checkOldIface hsc_env mod_summary source_unchanged maybe_iface
= do { showPass (hsc_dflags hsc_env)
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
; initIfaceCheck hsc_env $
check_old_iface mod_summary source_unchanged maybe_iface
@@
-783,7
+783,8
@@
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 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
+ if (ghci_mode == Interactive || ghci_mode == JustTypecheck)
+ && not source_unchanged then
returnM (outOfDate, maybe_iface)
else
returnM (outOfDate, maybe_iface)
else