Temporary fix for leak with -fno-code (#20509)

This hack inserted for backpack caused a very bad leak when using
-fno-code where EPS entries would end up retaining stale
HomePackageTables. For any interactive user, such as HLS, this is really
bad as once the entry makes it's way into the EPS then it's there for
the rest of the session.

This is a temporary fix which "solves" the issue by filtering the HPT to
only the part which is needed for the hack to work, but in future we
want to separate out hole modules from the HPT entirely to avoid needing
to do this kind of special casing.

-------------------------
Metric Decrease:
    MultiLayerModulesDefsGhci
-------------------------

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