diff options
-rw-r--r-- | compiler/GHC/Iface/Load.hs | 19 | ||||
-rw-r--r-- | compiler/GHC/Unit/Home/ModInfo.hs | 4 |
2 files changed, 13 insertions, 10 deletions
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs index 38d7511103..77db1f22c6 100644 --- a/compiler/GHC/Iface/Load.hs +++ b/compiler/GHC/Iface/Load.hs @@ -48,7 +48,6 @@ import GHC.Driver.Config.Finder import GHC.Driver.Env import GHC.Driver.Errors.Types import GHC.Driver.Session -import GHC.Driver.Backend import GHC.Driver.Hooks import GHC.Driver.Plugins @@ -647,19 +646,19 @@ dontLeakTheHPT thing_inside = do -- wrinkle: when we're typechecking in --backpack mode, the -- instantiation of a signature might reside in the HPT, so -- this case breaks the assumption that EPS interfaces only - -- refer to other EPS interfaces. We can detect when we're in - -- typechecking-only mode by using backend==NoBackend, and - -- in that case we don't empty the HPT. (admittedly this is - -- a bit of a hack, better suggestions welcome). A number of - -- tests in testsuite/tests/backpack break without this + -- refer to other EPS interfaces. + -- As a temporary (MP Oct 2021 #20509) we only keep the HPT if it + -- contains any hole modules. + -- Quite a few tests in testsuite/tests/backpack break without this -- tweak. old_unit_env = hsc_unit_env hsc_env + keepFor20509 hmi + | isHoleModule (mi_semantic_module (hm_iface hmi)) = True + | otherwise = False !unit_env - | NoBackend <- backend (hsc_dflags hsc_env) = old_unit_env - | otherwise - = old_unit_env - { ue_hpt = emptyHomePackageTable + { ue_hpt = if anyHpt keepFor20509 (ue_hpt old_unit_env) then ue_hpt old_unit_env + else emptyHomePackageTable } in hsc_env { hsc_targets = panic "cleanTopEnv: hsc_targets" diff --git a/compiler/GHC/Unit/Home/ModInfo.hs b/compiler/GHC/Unit/Home/ModInfo.hs index b5960a5223..2173b7431b 100644 --- a/compiler/GHC/Unit/Home/ModInfo.hs +++ b/compiler/GHC/Unit/Home/ModInfo.hs @@ -7,6 +7,7 @@ module GHC.Unit.Home.ModInfo , eltsHpt , filterHpt , allHpt + , anyHpt , mapHpt , delFromHpt , addToHpt @@ -90,6 +91,9 @@ filterHpt = filterUDFM allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool allHpt = allUDFM +anyHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool +anyHpt = anyUDFM + mapHpt :: (HomeModInfo -> HomeModInfo) -> HomePackageTable -> HomePackageTable mapHpt = mapUDFM |