ghc-compact: Use keepAlive# in GHC.Compact.Serialized

1 files changed, 2 insertions, 10 deletions

diff --git a/libraries/ghc-compact/GHC/Compact/Serialized.hs b/libraries/ghc-compact/GHC/Compact/Serialized.hs
index ac79c95b16..943aabf012 100644
--- a/libraries/ghc-compact/GHC/Compact/Serialized.hs
+++ b/libraries/ghc-compact/GHC/Compact/Serialized.hs
@@ -29,6 +29,7 @@ module GHC.Compact.Serialized(
 import GHC.Prim
 import GHC.Types
 import GHC.Word (Word8)
+import GHC.IO (unIO)
 
 import GHC.Ptr (Ptr(..), plusPtr)
 
@@ -74,12 +75,6 @@ mkBlockList buffer = compactGetFirstBlock buffer >>= go
       rest <- go next
       return $ item : rest
 
--- We MUST mark withSerializedCompact as NOINLINE
--- Otherwise the compiler will eliminate the call to touch#
--- causing the Compact# to be potentially GCed too eagerly,
--- before func had a chance to copy everything into its own
--- buffers/sockets/whatever
-
 -- | Serialize the 'Compact', and call the provided function with
 -- with the 'Compact' serialized representation.  It is not safe
 -- to return the pointer from the action and use it after
@@ -89,7 +84,6 @@ mkBlockList buffer = compactGetFirstBlock buffer >>= go
 -- unsound to use 'unsafeInterleaveIO' to lazily construct
 -- a lazy bytestring from the 'Ptr'.
 --
-{-# NOINLINE withSerializedCompact #-}
 withSerializedCompact :: Compact a ->
                          (SerializedCompact a -> IO c) -> IO c
 withSerializedCompact (Compact buffer root lock) func = withMVar lock $ \_ -> do
@@ -97,9 +91,7 @@ withSerializedCompact (Compact buffer root lock) func = withMVar lock $ \_ -> do
                     (# s', rootAddr #) -> (# s', Ptr rootAddr #) )
   blockList <- mkBlockList buffer
   let serialized = SerializedCompact blockList rootPtr
-  r <- func serialized
-  IO (\s -> case touch# buffer s of
-         s' -> (# s', r #) )
+  IO $ \s -> keepAlive# buffer s (unIO $ func serialized)
 
 fixupPointers :: Addr# -> Addr# -> State# RealWorld ->
                  (# State# RealWorld, Maybe (Compact a) #)