summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/Iface/Load.hs19
-rw-r--r--compiler/GHC/Unit/Home/ModInfo.hs4
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