X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fiface%2FMkIface.lhs;h=f76ac41773eeb83da6778e3ce73f9a547ff76d3a;hb=d1e15bd270b971d330238d99b66ff36074873f90;hp=e508a176f14ba4b06dc47c331aba39bba4e7cc08;hpb=91944423d83620441d6d3b120654a10fb41cfb3c;p=ghc-hetmet.git diff --git a/ghc/compiler/iface/MkIface.lhs b/ghc/compiler/iface/MkIface.lhs index e508a17..f76ac41 100644 --- a/ghc/compiler/iface/MkIface.lhs +++ b/ghc/compiler/iface/MkIface.lhs @@ -185,9 +185,8 @@ import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), import LoadIface ( readIface, loadInterface ) import BasicTypes ( Version, initialVersion, bumpVersion ) import TcRnMonad -import TcRnTypes ( mkModDeps ) import HscTypes ( ModIface(..), ModDetails(..), - ModGuts(..), ModGuts, IfaceExport, + ModGuts(..), IfaceExport, HscEnv(..), hscEPS, Dependencies(..), FixItem(..), ModSummary(..), msHiFilePath, mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache, @@ -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 ) @@ -234,7 +234,7 @@ import DATA_IOREF ( writeIORef ) import Monad ( when ) import List ( insert ) import Maybes ( orElse, mapCatMaybes, isNothing, isJust, - fromJust, expectJust, MaybeErr(..) ) + expectJust, MaybeErr(..) ) \end{code} @@ -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 @@ -320,7 +321,7 @@ mkIface hsc_env maybe_old_iface -- 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) @@ -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 @@ -895,7 +896,7 @@ checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers, -- 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