Cheng Shao pushed to branch wip/ghci-spark at Glasgow Haskell Compiler / GHC Commits: 3142ed32 by Cheng Shao at 2025-12-28T06:41:07+01:00 ghci: avoid arbitrary chunking in parallelized CreateBCOs serialization Previously, when the `CreateBCOs` message is serialized, we split the `[ResolvedBCO]` list into chunks and use sparks to serialize the chunks in parallel. However, in terms of load balancing, instead of arbitrarily grouping work, it's better to spawn work on a finer granularity and rely on the work-stealing nature of the sparks mechanism to distribute work more evenly across idle Capabilities. So this patch refactors the `CreateBCOs` serialization logic to spawn one spark per `ResolvedBCO` object. This is based on an added helper module `GHC.Utils.Spark` in `ghc-boot`, which might come in handy later when we want to use sparks in other parts of the compiler. - - - - - 3 changed files: - + libraries/ghc-boot/GHC/Utils/Spark.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/GHCi/Message.hs Changes: ===================================== libraries/ghc-boot/GHC/Utils/Spark.hs ===================================== @@ -0,0 +1,25 @@ +{-# LANGUAGE MagicHash #-} + +module GHC.Utils.Spark + ( sparkST, + sparkIO, + ) +where + +import Control.Monad +import GHC.Exts +import GHC.IO +import GHC.ST +import Prelude + +-- | Same as 'sparkIO' but in the 'ST' monad, useful if no other side +-- effects are involved. +sparkST :: ST s a -> ST s a +sparkST = ST . spark# <=< unsafeInterleaveST + +-- | Spawns an 'IO' computation as a spark and returns a thunk that +-- evaluates to the computation's result. The computation is guarded +-- by 'noDuplicate' to prevent being executed by multiple threads at +-- once. +sparkIO :: IO a -> IO a +sparkIO = IO . spark# <=< unsafeInterleaveIO ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -55,6 +55,7 @@ Library GHC.Data.SizedSeq GHC.Utils.Encoding GHC.Utils.Encoding.UTF8 + GHC.Utils.Spark GHC.LanguageExtensions GHC.Unit.Database GHC.Serialized ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -44,13 +44,13 @@ import qualified GHC.Exts.Heap as Heap #endif import GHC.ForeignSrcLang import GHC.Fingerprint -import GHC.Conc (pseq, par) import Control.Concurrent import Control.DeepSeq import Control.Exception #if MIN_VERSION_base(4,20,0) import Control.Exception.Context #endif +import Control.Monad.ST import Data.Binary import Data.Binary.Get import Data.Binary.Put @@ -66,6 +66,7 @@ import Data.Map (Map) import Foreign import GHC.Generics import GHC.Stack.CCS +import GHC.Utils.Spark import qualified GHC.Boot.TH.Syntax as TH import qualified GHC.Boot.TH.Monad as TH import System.Exit @@ -572,7 +573,7 @@ getMessage = do 9 -> Msg <$> RemoveLibrarySearchPath <$> get 10 -> Msg <$> return ResolveObjs 11 -> Msg <$> FindSystemLibrary <$> get - 12 -> Msg <$> (CreateBCOs . concatMap (runGet get)) <$> (get :: Get [LB.ByteString]) + 12 -> Msg <$> (CreateBCOs . fmap (runGet get)) <$> (get :: Get [LB.ByteString]) -- See Note [Parallelize CreateBCOs serialization] 13 -> Msg <$> FreeHValueRefs <$> get 14 -> Msg <$> MallocData <$> get @@ -653,29 +654,17 @@ putMessage m = case m of Note [Parallelize CreateBCOs serialization] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Serializing ResolvedBCO is expensive, so we do it in parallel. -We split the list [ResolvedBCO] into chunks of length <= 100, -and serialize every chunk in parallel, getting a [LB.ByteString] -where every bytestring corresponds to a single chunk (multiple ResolvedBCOs). +For each element in the list [ResolvedBCO], we spawn a spark which +serializes it, getting a [LB.ByteString] where every fully evaluated +lazy ByteString corresponds to a single ResolvedBCO. Previously, we stored [LB.ByteString] in the Message object, but that incurs unneccessary serialization with the internal interpreter (#23919). -} serializeBCOs :: [ResolvedBCO] -> [LB.ByteString] -serializeBCOs rbcos = parMap doChunk (chunkList 100 rbcos) - where - -- make sure we force the whole lazy ByteString - doChunk c = pseq (LB.length bs) bs - where bs = runPut (put c) - - -- We don't have the parallel package, so roll our own simple parMap - parMap _ [] = [] - parMap f (x:xs) = fx `par` (fxs `pseq` (fx : fxs)) - where fx = f x; fxs = parMap f xs - - chunkList :: Int -> [a] -> [[a]] - chunkList _ [] = [] - chunkList n xs = as : chunkList n bs where (as,bs) = splitAt n xs +serializeBCOs rbcos = + runST $ traverse (sparkST . pure . force . runPut . put) rbcos -- ----------------------------------------------------------------------------- -- Reading/writing messages View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3142ed3262732173721dcd2fa8f79050... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3142ed3262732173721dcd2fa8f79050... You're receiving this email because of your account on gitlab.haskell.org.