diff options
-rw-r--r-- | libraries/ghc-compact/GHC/Compact/Serialized.hs | 12 |
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) #) |