[Git][ghc/ghc][wip/fendor/ghc-iface-sharing] Shrink Bin buffer

[Hannes Siebenhandl (@fendor)]

Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-sharing at Glasgow Haskell Compiler / GHC


Commits:
3f5bcc81 by Fendor at 2024-04-30T12:25:04+02:00
Shrink Bin buffer

- - - - -


2 changed files:

- compiler/GHC/Iface/Make.hs
- compiler/GHC/Utils/Binary.hs


Changes:

=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -158,7 +158,7 @@ shareIface nc compressionLevel  mi = do
   bh <- openBinMem (1024 * 1024)
   start <- tellBinWriter bh
   putIfaceWithExtFields QuietBinIFace compressionLevel bh mi
-  rbh <- freezeWriteHandle bh
+  rbh <- shrinkBinBuffer bh
   seekBinReader rbh start
   res <- getIfaceWithExtFields nc rbh
   let resiface = res { mi_src_hash = mi_src_hash mi }


=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -37,6 +37,7 @@ module GHC.Utils.Binary
    castBin,
    withBinBuffer,
    freezeWriteHandle,
+   shrinkBinBuffer,
    thawReadHandle,
 
    foldGet, foldGet',
@@ -101,6 +102,7 @@ module GHC.Utils.Binary
    BindingName(..),
    simpleBindingNameWriter,
    simpleBindingNameReader,
+   BinArray,
   ) where
 
 import GHC.Prelude
@@ -125,7 +127,7 @@ import Foreign hiding (shiftL, shiftR, void)
 import Data.Array
 import Data.Array.IO
 import Data.Array.Unsafe
-import Data.ByteString (ByteString)
+import Data.ByteString (ByteString, copy)
 import Data.Coerce
 import qualified Data.ByteString.Internal as BS
 import qualified Data.ByteString.Unsafe   as BS
@@ -344,6 +346,17 @@ freezeWriteHandle wbm = do
     , rbm_arr_r = rbm_arr_r
     }
 
+-- Copy the BinBuffer to a new BinBuffer which is exactly the right size.
+-- This performs a copy of the underlying buffer.
+-- The buffer may be truncated if the offset is not at the end of the written
+-- output.
+--
+-- UserData is also discarded during the copy
+-- You should just use this when translating a Put handle into a Get handle.
+shrinkBinBuffer :: WriteBinHandle -> IO ReadBinHandle
+shrinkBinBuffer bh = withBinBuffer bh $ \bs -> do
+  unsafeUnpackBinBuffer (copy bs)
+
 thawReadHandle :: ReadBinHandle -> IO WriteBinHandle
 thawReadHandle rbm = do
   wbm_off_r <- newFastMutInt =<< readFastMutInt (rbm_off_r rbm)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f5bcc81924ad148e1e1b60bfc4412422319e2e2

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f5bcc81924ad148e1e1b60bfc4412422319e2e2
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/20240430/cacd2fcb/attachment-0001.html>