X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fiface%2FMkIface.lhs;h=2f15ee377365e7a24529ddfaecf96fdba176929b;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=f27538d4dfbd94442c4bab107575afafd871b067;hpb=4a5870490196e05c40a9362ac2fef0081567bffc;p=ghc-hetmet.git diff --git a/ghc/compiler/iface/MkIface.lhs b/ghc/compiler/iface/MkIface.lhs index f27538d..2f15ee3 100644 --- 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 TcRnTypes ( mkModDeps ) 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, @@ -214,7 +214,7 @@ import OccName ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv, isEmptyOccSet, intersectOccSet, intersectsOccSet, occNameFS, isTcOcc ) import Module ( Module, moduleFS, - ModLocation(..), mkSysModuleFS, moduleUserString, + ModLocation(..), mkModuleFS, moduleString, 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_home_mods = home_mods, 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 - ; 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 @@ -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 - | 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 } @@ -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 - dflags = hsc_dflags hsc_env 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 - | isHomeModule dflags mod = HomePkg mod occ vers + | isHomeModule hmods mod = HomePkg mod occ vers | otherwise = ExtPkg mod occ where mod = nameModule name @@ -638,23 +639,23 @@ bump_unless False v = bumpVersion v \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 @@ -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 - 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 @@ -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 - || 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 @@ -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 - 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` [] @@ -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 - = [ (mkSysModuleFS fs, eltsFM avails) + = [ (mkModuleFS fs, eltsFM avails) | (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) - ("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 @@ -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 (ghci_mode == Interactive) && not source_unchanged then + if (ghci_mode == Interactive || ghci_mode == JustTypecheck) + && not source_unchanged then returnM (outOfDate, maybe_iface) else