[Git][ghc/ghc][master] 2 commits: compiler: make getPrim eagerly evaluate its result

10 Jan 2026


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


Commits:
c4ebdbdf by Cheng Shao at 2026-01-09T20:23:06-05:00
compiler: make getPrim eagerly evaluate its result

This commit makes `GHC.Utils.Binary.getPrim` eagerly evaluate its
result, to avoid accidental laziness when future patches build other
binary parsers using `getPrim`.

- - - - -
66a0c4f7 by Cheng Shao at 2026-01-09T20:23:06-05:00
compiler: implement fast get/put for Word16/Word32/Word64

Previously, `GHC.Utils.Binary` contains `get`/`put` functions for
`Word16`/`Word32`/`Word64` which always loads and stores them as
big-endian words at a potentially unaligned address. The previous
implementation is based on loads/stores of individual bytes and
concatenating bytes with bitwise operations, which currently cannot be
fused to a single load/store operation by GHC.

This patch implements fast `get`/`put` functions for
`Word16`/`Word32`/`Word64` based on a single memory load/store, with
an additional `byteSwap` operation on little-endian hosts. It is based
on unaligned load/store primops added since GHC 9.10, and we already
require booting with at least 9.10, so it's about time to switch to
this faster path.

- - - - -


1 changed file:

- compiler/GHC/Utils/Binary.hs


Changes:

=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE UnboxedTuples #-}
 {-# LANGUAGE DerivingVia #-}
 
@@ -160,14 +161,17 @@ import qualified Data.Set as Set
 import Data.Time
 import Data.List (unfoldr)
 import System.IO as IO
-import System.IO.Unsafe         ( unsafeInterleaveIO )
 import System.IO.Error          ( mkIOError, eofErrorType )
 import Type.Reflection          ( Typeable, SomeTypeRep(..) )
 import qualified Type.Reflection as Refl
 import GHC.Real                 ( Ratio(..) )
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
+import GHC.ByteOrder
 import GHC.ForeignPtr           ( unsafeWithForeignPtr )
+import GHC.Exts
+import GHC.IO
+import GHC.Word
 
 import Unsafe.Coerce (unsafeCoerce)
 
@@ -638,7 +642,7 @@ getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do
   ix <- readFastMutInt ix_r
   when (ix + size > sz_r) $
       ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing)
-  w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix)
+  !w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix)
     -- This is safe WRT #17760 as we we guarantee that the above line doesn't
     -- diverge
   writeFastMutInt ix_r (ix + size)
@@ -651,71 +655,52 @@ getWord8 :: ReadBinHandle -> IO Word8
 getWord8 h = getPrim h 1 peek
 
 putWord16 :: WriteBinHandle -> Word16 -> IO ()
-putWord16 h w = putPrim h 2 (\op -> do
-  pokeElemOff op 0 (fromIntegral (w `shiftR` 8))
-  pokeElemOff op 1 (fromIntegral (w .&. 0xFF))
-  )
+putWord16 h w = putPrim h 2 $ \(Ptr p#) ->
+  IO $ \s -> (# writeWord8OffAddrAsWord16# p# 0# x# s, () #)
+  where
+    !(W16# x#) = case targetByteOrder of
+      BigEndian -> w
+      LittleEndian -> byteSwap16 w
 
 getWord16 :: ReadBinHandle -> IO Word16
-getWord16 h = getPrim h 2 (\op -> do
-  w0 <- fromIntegral <$> peekElemOff op 0
-  w1 <- fromIntegral <$> peekElemOff op 1
-  return $! w0 `shiftL` 8 .|. w1
-  )
+getWord16 h = getPrim h 2 $ \(Ptr p#) ->
+  IO $ \s -> case readWord8OffAddrAsWord16# p# 0# s of
+    (# s', w16# #) -> case targetByteOrder of
+      BigEndian -> (# s', W16# w16# #)
+      LittleEndian -> case byteSwap16 $ W16# w16# of
+        !w16 -> (# s', w16 #)
 
 putWord32 :: WriteBinHandle -> Word32 -> IO ()
-putWord32 h w = putPrim h 4 (\op -> do
-  pokeElemOff op 0 (fromIntegral (w `shiftR` 24))
-  pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF))
-  pokeElemOff op 2 (fromIntegral ((w `shiftR` 8) .&. 0xFF))
-  pokeElemOff op 3 (fromIntegral (w .&. 0xFF))
-  )
+putWord32 h w = putPrim h 4 $ \(Ptr p#) ->
+  IO $ \s -> (# writeWord8OffAddrAsWord32# p# 0# x# s, () #)
+  where
+    !(W32# x#) = case targetByteOrder of
+      BigEndian -> w
+      LittleEndian -> byteSwap32 w
 
 getWord32 :: ReadBinHandle -> IO Word32
-getWord32 h = getPrim h 4 (\op -> do
-  w0 <- fromIntegral <$> peekElemOff op 0
-  w1 <- fromIntegral <$> peekElemOff op 1
-  w2 <- fromIntegral <$> peekElemOff op 2
-  w3 <- fromIntegral <$> peekElemOff op 3
-
-  return $! (w0 `shiftL` 24) .|.
-            (w1 `shiftL` 16) .|.
-            (w2 `shiftL` 8)  .|.
-            w3
-  )
+getWord32 h = getPrim h 4 $ \(Ptr p#) ->
+  IO $ \s -> case readWord8OffAddrAsWord32# p# 0# s of
+    (# s', w32# #) -> case targetByteOrder of
+      BigEndian -> (# s', W32# w32# #)
+      LittleEndian -> case byteSwap32 $ W32# w32# of
+        !w32 -> (# s', w32 #)
 
 putWord64 :: WriteBinHandle -> Word64 -> IO ()
-putWord64 h w = putPrim h 8 (\op -> do
-  pokeElemOff op 0 (fromIntegral (w `shiftR` 56))
-  pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF))
-  pokeElemOff op 2 (fromIntegral ((w `shiftR` 40) .&. 0xFF))
-  pokeElemOff op 3 (fromIntegral ((w `shiftR` 32) .&. 0xFF))
-  pokeElemOff op 4 (fromIntegral ((w `shiftR` 24) .&. 0xFF))
-  pokeElemOff op 5 (fromIntegral ((w `shiftR` 16) .&. 0xFF))
-  pokeElemOff op 6 (fromIntegral ((w `shiftR` 8) .&. 0xFF))
-  pokeElemOff op 7 (fromIntegral (w .&. 0xFF))
-  )
+putWord64 h w = putPrim h 8 $ \(Ptr p#) ->
+  IO $ \s -> (# writeWord8OffAddrAsWord64# p# 0# x# s, () #)
+  where
+    !(W64# x#) = case targetByteOrder of
+      BigEndian -> w
+      LittleEndian -> byteSwap64 w
 
 getWord64 :: ReadBinHandle -> IO Word64
-getWord64 h = getPrim h 8 (\op -> do
-  w0 <- fromIntegral <$> peekElemOff op 0
-  w1 <- fromIntegral <$> peekElemOff op 1
-  w2 <- fromIntegral <$> peekElemOff op 2
-  w3 <- fromIntegral <$> peekElemOff op 3
-  w4 <- fromIntegral <$> peekElemOff op 4
-  w5 <- fromIntegral <$> peekElemOff op 5
-  w6 <- fromIntegral <$> peekElemOff op 6
-  w7 <- fromIntegral <$> peekElemOff op 7
-
-  return $! (w0 `shiftL` 56) .|.
-            (w1 `shiftL` 48) .|.
-            (w2 `shiftL` 40) .|.
-            (w3 `shiftL` 32) .|.
-            (w4 `shiftL` 24) .|.
-            (w5 `shiftL` 16) .|.
-            (w6 `shiftL` 8)  .|.
-            w7
-  )
+getWord64 h = getPrim h 8 $ \(Ptr p#) ->
+  IO $ \s -> case readWord8OffAddrAsWord64# p# 0# s of
+    (# s', w64# #) -> case targetByteOrder of
+      BigEndian -> (# s', W64# w64# #)
+      LittleEndian -> case byteSwap64 $ W64# w64# of
+        !w64 -> (# s', w64 #)
 
 putByte :: WriteBinHandle -> Word8 -> IO ()
 putByte bh !w = putWord8 bh w



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e1ce1fc3ad38d192cd3b6a38cb42051...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e1ce1fc3ad38d192cd3b6a38cb42051...
You're receiving this email because of your account on gitlab.haskell.org.

    

Marge Bot (＠marge-bot)

tags

participants (1)