Store dehydrated data structures in CgModBreaks

This fixes a tricky leak in GHCi where we were retaining old copies of
HscEnvs when reloading. If not all modules were recompiled then these
hydrated fields in break points would retain a reference to the old
HscEnv which could double memory usage.

Fixes #22530

5 files changed, 54 insertions, 14 deletions

diff --git a/compiler/GHC/ByteCode/Types.hs b/compiler/GHC/ByteCode/Types.hs
index a4b025ce92..a100e72085 100644
--- a/compiler/GHC/ByteCode/Types.hs
+++ b/compiler/GHC/ByteCode/Types.hs
@@ -23,12 +23,10 @@ import GHC.Prelude
 
 import GHC.Data.FastString
 import GHC.Data.SizedSeq
-import GHC.Types.Id
 import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Utils.Outputable
 import GHC.Builtin.PrimOps
-import GHC.Core.Type
 import GHC.Types.SrcLoc
 import GHCi.BreakArray
 import GHCi.RemoteTypes
@@ -41,10 +39,10 @@ import Data.Array.Base  ( UArray(..) )
 import Data.ByteString (ByteString)
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
-import Data.Maybe (catMaybes)
 import qualified GHC.Exts.Heap as Heap
 import GHC.Stack.CCS
 import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
+import GHC.Iface.Syntax
 
 -- -----------------------------------------------------------------------------
 -- Compiled Byte Code
@@ -174,18 +172,22 @@ instance NFData BCONPtr where
   rnf x = x `seq` ()
 
 -- | Information about a breakpoint that we know at code-generation time
+-- In order to be used, this needs to be hydrated relative to the current HscEnv by
+-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
+-- preventing space leaks (see #22530)
 data CgBreakInfo
    = CgBreakInfo
-   { cgb_vars   :: [Maybe (Id,Word16)]
-   , cgb_resty  :: Type
+   { cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
+   , cgb_vars   :: ![Maybe (IfaceIdBndr, Word16)]
+   , cgb_resty  :: !IfaceType
    }
 -- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
 
--- Not a real NFData instance because we can't rnf Id or Type
 seqCgBreakInfo :: CgBreakInfo -> ()
 seqCgBreakInfo CgBreakInfo{..} =
-  rnf (map snd (catMaybes (cgb_vars))) `seq`
-  seqType cgb_resty
+    rnf cgb_tyvars `seq`
+    rnf cgb_vars `seq`
+    rnf cgb_resty
 
 instance Outputable UnlinkedBCO where
    ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index 98595f0403..bf713aae53 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -43,12 +43,18 @@ module GHC.CoreToIface
     , toIfaceVar
       -- * Other stuff
     , toIfaceLFInfo
+      -- * CgBreakInfo
+    , dehydrateCgBreakInfo
     ) where
 
 import GHC.Prelude
 
+import Data.Word
+
 import GHC.StgToCmm.Types
 
+import GHC.ByteCode.Types
+
 import GHC.Core
 import GHC.Core.TyCon hiding ( pprPromotionQuote )
 import GHC.Core.Coercion.Axiom
@@ -685,6 +691,16 @@ toIfaceLFInfo nm lfi = case lfi of
     LFLetNoEscape ->
       panic "toIfaceLFInfo: LFLetNoEscape"
 
+-- Dehydrating CgBreakInfo
+
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word16)] -> Type -> CgBreakInfo
+dehydrateCgBreakInfo ty_vars idOffSets tick_ty =
+          CgBreakInfo
+            { cgb_tyvars = map toIfaceTvBndr ty_vars
+            , cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
+            , cgb_resty = toIfaceType tick_ty
+            }
+
 {- Note [Inlining and hs-boot files]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider this example (#10083, #12789):
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index a69cc34a73..fa714448ac 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -12,6 +12,7 @@ Type checking of type signatures in interface files
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module GHC.IfaceToCore (
         tcLookupImported_maybe,
@@ -25,10 +26,15 @@ module GHC.IfaceToCore (
         tcIfaceExpr,    -- Desired by HERMIT (#7683)
         tcIfaceGlobal,
         tcIfaceOneShot, tcTopIfaceBindings,
+        hydrateCgBreakInfo
  ) where
 
 import GHC.Prelude
 
+import GHC.ByteCode.Types
+
+import Data.Word
+
 import GHC.Driver.Env
 import GHC.Driver.Session
 import GHC.Driver.Config.Core.Lint ( initLintConfig )
@@ -2166,3 +2172,12 @@ bindIfaceTyConBinderX :: (IfaceBndr -> (TyCoVar -> IfL a) -> IfL a)
 bindIfaceTyConBinderX bind_tv (Bndr tv vis) thing_inside
   = bind_tv tv $ \tv' ->
     thing_inside (Bndr tv' vis)
+
+-- CgBreakInfo
+
+hydrateCgBreakInfo :: CgBreakInfo -> IfL ([Maybe (Id, Word16)], Type)
+hydrateCgBreakInfo CgBreakInfo{..} = do
+  bindIfaceTyVars cgb_tyvars $ \_ -> do
+    result_ty <- tcIfaceType cgb_resty
+    mbVars <- mapM (traverse (\(if_gbl, offset) -> (,offset) <$> bindIfaceId if_gbl return)) cgb_vars
+    return (mbVars, result_ty)
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index 74eba30421..7ee9b07050 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -136,6 +136,7 @@ import GHC.Tc.Solver (simplifyWantedsTcM)
 import GHC.Tc.Utils.Monad
 import GHC.Core.Class (classTyCon)
 import GHC.Unit.Env
+import GHC.IfaceToCore
 
 -- -----------------------------------------------------------------------------
 -- running a statement interactively
@@ -562,12 +563,19 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
        breaks    = getModBreaks hmi
        info      = expectJust "bindLocalsAtBreakpoint2" $
                      IntMap.lookup breakInfo_number (modBreaks_breakInfo breaks)
-       mbVars    = cgb_vars info
-       result_ty = cgb_resty info
        occs      = modBreaks_vars breaks ! breakInfo_number
        span      = modBreaks_locs breaks ! breakInfo_number
        decl      = intercalate "." $ modBreaks_decls breaks ! breakInfo_number
 
+  -- Rehydrate to understand the breakpoint info relative to the current environment.
+  -- This design is critical to preventing leaks (#22530)
+   (mbVars, result_ty) <- initIfaceLoad hsc_env
+                            $ initIfaceLcl breakInfo_module (text "debugger") NotBoot
+                            $ hydrateCgBreakInfo info
+
+
+   let
+
            -- Filter out any unboxed ids by changing them to Nothings;
            -- we can't bind these at the prompt
        mbPointers = nullUnboxed <$> mbVars
diff --git a/compiler/GHC/StgToByteCode.hs b/compiler/GHC/StgToByteCode.hs
index de37d987cb..02c5e5aa7b 100644
--- a/compiler/GHC/StgToByteCode.hs
+++ b/compiler/GHC/StgToByteCode.hs
@@ -89,6 +89,7 @@ import Data.Either ( partitionEithers )
 
 import GHC.Stg.Syntax
 import qualified Data.IntSet as IntSet
+import GHC.CoreToIface
 
 -- -----------------------------------------------------------------------------
 -- Generating byte code for a complete module
@@ -370,10 +371,8 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs) rhs)
         this_mod <- moduleName <$> getCurrentModule
         platform <- profilePlatform <$> getProfile
         let idOffSets = getVarOffSets platform d p fvs
-        let breakInfo = CgBreakInfo
-                        { cgb_vars = idOffSets
-                        , cgb_resty = tick_ty
-                        }
+            ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+        let breakInfo = dehydrateCgBreakInfo ty_vars idOffSets tick_ty
         newBreakInfo tick_no breakInfo
         hsc_env <- getHscEnv
         let cc | Just interp <- hsc_interp hsc_env