[Git][ghc/ghc][master] 4 commits: Store dehydrated data structures in CgModBreaks

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu Jan 26 17:35:22 UTC 2023



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00
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

- - - - -
e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00
Force more in NFData Name instance

Doesn't force the lazy `OccName` field (#19619) which is already known
as a really bad source of leaks.

When we slam the hammer storing Names on disk (in interface files or the
like), all this should be forced as otherwise a `Name` can easily retain
an `Id` and hence the entire world.

Fixes #22833

- - - - -
3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00
Force OccName in tidyTopName

This occname has just been derived from an `Id`, so need to force it
promptly so we can release the Id back to the world.

Another symptom of the bug caused by #19619

- - - - -
f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00
Strict fields in ModNodeKey (otherwise retains HomeModInfo)

Towards #22530

- - - - -


8 changed files:

- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Types/Name.hs
- compiler/GHC/Unit/Module/Graph.hs


Changes:

=====================================
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)


=====================================
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):


=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -1077,7 +1077,8 @@ tidyTopName mod name_cache maybe_ref occ_env id
   -- we have to update the name cache in a nice atomic fashion
 
   | local  && internal = do uniq <- takeUniqFromNameCache name_cache
-                            let new_local_name = mkInternalName uniq occ' loc
+                            -- See #19619
+                            let new_local_name = occ' `seq` mkInternalName uniq occ' loc
                             return (occ_env', new_local_name)
         -- Even local, internal names must get a unique occurrence, because
         -- if we do -split-objs we externalise the name later, in the code generator


=====================================
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)


=====================================
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


=====================================
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


=====================================
compiler/GHC/Types/Name.hs
=====================================
@@ -155,7 +155,7 @@ instance Outputable NameSort where
   ppr  System         = text "system"
 
 instance NFData Name where
-  rnf Name{..} = rnf n_sort
+  rnf Name{..} = rnf n_sort `seq` rnf n_occ `seq` n_uniq `seq` rnf n_loc
 
 instance NFData NameSort where
   rnf (External m) = rnf m


=====================================
compiler/GHC/Unit/Module/Graph.hs
=====================================
@@ -134,8 +134,8 @@ nodeKeyModName :: NodeKey -> Maybe ModuleName
 nodeKeyModName (NodeKey_Module mk) = Just (gwib_mod $ mnkModuleName mk)
 nodeKeyModName _ = Nothing
 
-data ModNodeKeyWithUid = ModNodeKeyWithUid { mnkModuleName :: ModuleNameWithIsBoot
-                                           , mnkUnitId     :: UnitId } deriving (Eq, Ord)
+data ModNodeKeyWithUid = ModNodeKeyWithUid { mnkModuleName :: !ModuleNameWithIsBoot
+                                           , mnkUnitId     :: !UnitId } deriving (Eq, Ord)
 
 instance Outputable ModNodeKeyWithUid where
   ppr (ModNodeKeyWithUid mnwib uid) = ppr uid <> colon <> ppr mnwib



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1bd32a355bd5fc484b641270ca7186e01d1b0c06...f2a0fea09a88693d876fb891ea7c8c97373c4aa6

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1bd32a355bd5fc484b641270ca7186e01d1b0c06...f2a0fea09a88693d876fb891ea7c8c97373c4aa6
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230126/3ea34b7b/attachment-0001.html>


More information about the ghc-commits mailing list