[Git][ghc/ghc][master] binary: Directly copy ShortByteString to buffer rather than go via ByteString

[Marge Bot (@marge-bot)]

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


Commits:
f1830d74 by Matthew Pickering at 2025-03-14T13:12:21-04:00
binary: Directly copy ShortByteString to buffer rather than go via ByteString

This avoids allocating an intermediate bytestring. I just noticed on a
profile that `putFS` was allocating, and it seemed strange to me why
since it should just copy the contents of the FastString into the
already allocated buffer. It turned out we were going indirectly via a
ByteString.

Fixes #25861

- - - - -


1 changed file:

- compiler/GHC/Utils/Binary.hs


Changes:

=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -135,6 +135,7 @@ import Data.ByteString (ByteString, copy)
 import Data.Coerce
 import qualified Data.ByteString.Internal as BS
 import qualified Data.ByteString.Unsafe   as BS
+import qualified Data.ByteString.Short.Internal as SBS
 import Data.IORef
 import Data.Char                ( ord, chr )
 import Data.List.NonEmpty       ( NonEmpty(..))
@@ -1771,7 +1772,7 @@ type SymbolTable a = Array Int a
 ---------------------------------------------------------
 
 putFS :: WriteBinHandle -> FastString -> IO ()
-putFS bh fs = putBS bh $ bytesFS fs
+putFS bh fs = putSBS bh $ fastStringToShortByteString fs
 
 getFS :: ReadBinHandle -> IO FastString
 getFS bh = do
@@ -1791,6 +1792,18 @@ getByteString bh l =
   BS.create l $ \dest -> do
     getPrim bh l (\src -> copyBytes dest src l)
 
+putSBS :: WriteBinHandle -> SBS.ShortByteString -> IO ()
+putSBS bh sbs = do
+  let l = SBS.length sbs
+  put_ bh l
+  putPrim bh l (\p -> SBS.copyToPtr sbs 0 p l)
+
+
+getSBS :: ReadBinHandle -> IO SBS.ShortByteString
+getSBS bh = do
+  l <- get bh :: IO Int
+  getPrim bh l (\src -> SBS.createFromPtr src l)
+
 putBS :: WriteBinHandle -> ByteString -> IO ()
 putBS bh bs =
   BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do
@@ -1803,6 +1816,10 @@ getBS bh = do
   BS.create l $ \dest -> do
     getPrim bh l (\src -> copyBytes dest src l)
 
+instance Binary SBS.ShortByteString where
+  put_ bh f = putSBS bh f
+  get bh = getSBS bh
+
 instance Binary ByteString where
   put_ bh f = putBS bh f
   get bh = getBS bh



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f1830d74b41f125eb5154c203ae4450f592f1e18
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/20250314/7834faea/attachment-0001.html>