{-# LANGUAGE CPP, MagicHash #-}
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
#include "MachDeps.h"
#endif
module Data.Binary.Builder (
Builder
, toLazyByteString
, empty
, singleton
, append
, fromByteString
, fromLazyByteString
, flush
, putWord16be
, putWord32be
, putWord64be
, putWord16le
, putWord32le
, putWord64le
, putWordhost
, putWord16host
, putWord32host
, putWord64host
) where
#if MIN_VERSION_base(4,8,0)
import Prelude hiding (empty)
#endif
import Foreign(Word,Word8,Ptr,Storable,ForeignPtr,withForeignPtr,poke,plusPtr,sizeOf)
import System.IO.Unsafe(unsafePerformIO)
import Data.Monoid
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
#ifdef BYTESTRING_IN_BASE
import Data.ByteString.Base (inlinePerformIO)
import qualified Data.ByteString.Base as S
#else
import Data.ByteString.Internal (accursedUnutterablePerformIO)
import qualified Data.ByteString.Internal as S
#endif
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
import GHC.Base(Int(..),uncheckedShiftRL# )
import GHC.Word (Word32(..),Word16(..),Word64(..))
#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608
import GHC.Word (uncheckedShiftRL64#)
#endif
#endif
newtype Builder = Builder {
Builder -> (Buffer -> [ByteString]) -> Buffer -> [ByteString]
runBuilder :: (Buffer -> [S.ByteString]) -> Buffer -> [S.ByteString]
}
#if MIN_VERSION_base(4,11,0)
instance Semigroup Builder where
<> :: Builder -> Builder -> Builder
(<>) = Builder -> Builder -> Builder
append
#endif
instance Monoid Builder where
mempty :: Builder
mempty = Builder
empty
{-# INLINE mempty #-}
mappend :: Builder -> Builder -> Builder
mappend = Builder -> Builder -> Builder
append
{-# INLINE mappend #-}
empty :: Builder
empty :: Builder
empty = ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
Builder (Buffer -> [ByteString]) -> Buffer -> [ByteString]
forall a. a -> a
id
{-# INLINE empty #-}
singleton :: Word8 -> Builder
singleton :: Word8 -> Builder
singleton = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
1 ((Ptr Word8 -> IO ()) -> Builder)
-> (Word8 -> Ptr Word8 -> IO ()) -> Word8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Word8 -> Word8 -> IO ()) -> Word8 -> Ptr Word8 -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke
{-# INLINE singleton #-}
append :: Builder -> Builder -> Builder
append :: Builder -> Builder -> Builder
append (Builder (Buffer -> [ByteString]) -> Buffer -> [ByteString]
f) (Builder (Buffer -> [ByteString]) -> Buffer -> [ByteString]
g) = ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
Builder ((Buffer -> [ByteString]) -> Buffer -> [ByteString]
f ((Buffer -> [ByteString]) -> Buffer -> [ByteString])
-> ((Buffer -> [ByteString]) -> Buffer -> [ByteString])
-> (Buffer -> [ByteString])
-> Buffer
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> [ByteString]) -> Buffer -> [ByteString]
g)
{-# INLINE append #-}
fromByteString :: S.ByteString -> Builder
fromByteString :: ByteString -> Builder
fromByteString ByteString
bs
| ByteString -> Bool
S.null ByteString
bs = Builder
empty
| Bool
otherwise = Builder
flush Builder -> Builder -> Builder
`append` ([ByteString] -> [ByteString]) -> Builder
mapBuilder (ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)
{-# INLINE fromByteString #-}
fromLazyByteString :: L.ByteString -> Builder
fromLazyByteString :: ByteString -> Builder
fromLazyByteString ByteString
bss = Builder
flush Builder -> Builder -> Builder
`append` ([ByteString] -> [ByteString]) -> Builder
mapBuilder (ByteString -> [ByteString]
L.toChunks ByteString
bss [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++)
{-# INLINE fromLazyByteString #-}
data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8)
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
toLazyByteString :: Builder -> L.ByteString
toLazyByteString :: Builder -> ByteString
toLazyByteString Builder
m = [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ IO [ByteString] -> [ByteString]
forall a. IO a -> a
unsafePerformIO (IO [ByteString] -> [ByteString])
-> IO [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ do
Buffer
buf <- Int -> IO Buffer
newBuffer Int
defaultSize
[ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> (Buffer -> [ByteString]) -> Buffer -> [ByteString]
runBuilder (Builder
m Builder -> Builder -> Builder
`append` Builder
flush) ([ByteString] -> Buffer -> [ByteString]
forall a b. a -> b -> a
const []) Buffer
buf)
flush :: Builder
flush :: Builder
flush = ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
Builder (((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder)
-> ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
forall a b. (a -> b) -> a -> b
$ \ Buffer -> [ByteString]
k buf :: Buffer
buf@(Buffer ForeignPtr Word8
p Int
o Int
u Int
l) ->
if Int
u Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Buffer -> [ByteString]
k Buffer
buf
else ForeignPtr Word8 -> Int -> Int -> ByteString
S.PS ForeignPtr Word8
p Int
o Int
u ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Buffer -> [ByteString]
k (ForeignPtr Word8 -> Int -> Int -> Int -> Buffer
Buffer ForeignPtr Word8
p (Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
u) Int
0 Int
l)
defaultSize :: Int
defaultSize :: Int
defaultSize = Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
overhead
where k :: Int
k = Int
1024
overhead :: Int
overhead = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Storable a => a -> Int
sizeOf (Int
forall a. HasCallStack => a
undefined :: Int)
unsafeLiftIO :: (Buffer -> IO Buffer) -> Builder
unsafeLiftIO :: (Buffer -> IO Buffer) -> Builder
unsafeLiftIO Buffer -> IO Buffer
f = ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
Builder (((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder)
-> ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
forall a b. (a -> b) -> a -> b
$ \ Buffer -> [ByteString]
k Buffer
buf -> IO [ByteString] -> [ByteString]
forall a. IO a -> a
accursedUnutterablePerformIO (IO [ByteString] -> [ByteString])
-> IO [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ do
Buffer
buf' <- Buffer -> IO Buffer
f Buffer
buf
[ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer -> [ByteString]
k Buffer
buf')
{-# INLINE unsafeLiftIO #-}
withSize :: (Int -> Builder) -> Builder
withSize :: (Int -> Builder) -> Builder
withSize Int -> Builder
f = ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
Builder (((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder)
-> ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
forall a b. (a -> b) -> a -> b
$ \ Buffer -> [ByteString]
k buf :: Buffer
buf@(Buffer ForeignPtr Word8
_ Int
_ Int
_ Int
l) ->
Builder -> (Buffer -> [ByteString]) -> Buffer -> [ByteString]
runBuilder (Int -> Builder
f Int
l) Buffer -> [ByteString]
k Buffer
buf
mapBuilder :: ([S.ByteString] -> [S.ByteString]) -> Builder
mapBuilder :: ([ByteString] -> [ByteString]) -> Builder
mapBuilder [ByteString] -> [ByteString]
f = ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
Builder ([ByteString] -> [ByteString]
f ([ByteString] -> [ByteString])
-> (Buffer -> [ByteString]) -> Buffer -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
ensureFree :: Int -> Builder
ensureFree :: Int -> Builder
ensureFree Int
n = Int
n Int -> Builder -> Builder
`seq` (Int -> Builder) -> Builder
withSize ((Int -> Builder) -> Builder) -> (Int -> Builder) -> Builder
forall a b. (a -> b) -> a -> b
$ \ Int
l ->
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l then Builder
empty else
Builder
flush Builder -> Builder -> Builder
`append` (Buffer -> IO Buffer) -> Builder
unsafeLiftIO (IO Buffer -> Buffer -> IO Buffer
forall a b. a -> b -> a
const (Int -> IO Buffer
newBuffer (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
defaultSize)))
{-# INLINE ensureFree #-}
writeN :: Int -> (Ptr Word8 -> IO ()) -> Builder
writeN :: Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
n Ptr Word8 -> IO ()
f = Int -> Builder
ensureFree Int
n Builder -> Builder -> Builder
`append` (Buffer -> IO Buffer) -> Builder
unsafeLiftIO (Int -> (Ptr Word8 -> IO ()) -> Buffer -> IO Buffer
writeNBuffer Int
n Ptr Word8 -> IO ()
f)
{-# INLINE writeN #-}
writeNBuffer :: Int -> (Ptr Word8 -> IO ()) -> Buffer -> IO Buffer
writeNBuffer :: Int -> (Ptr Word8 -> IO ()) -> Buffer -> IO Buffer
writeNBuffer Int
n Ptr Word8 -> IO ()
f (Buffer ForeignPtr Word8
fp Int
o Int
u Int
l) = do
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp (\Ptr Word8
p -> Ptr Word8 -> IO ()
f (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
u)))
Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> Int -> Buffer
Buffer ForeignPtr Word8
fp Int
o (Int
uInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n))
{-# INLINE writeNBuffer #-}
newBuffer :: Int -> IO Buffer
newBuffer :: Int -> IO Buffer
newBuffer Int
size = do
ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
S.mallocByteString Int
size
Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer -> IO Buffer) -> Buffer -> IO Buffer
forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> Int -> Int -> Buffer
Buffer ForeignPtr Word8
fp Int
0 Int
0 Int
size
{-# INLINE newBuffer #-}
writeNbytes :: Storable a => Int -> (Ptr a -> IO ()) -> Builder
writeNbytes :: Int -> (Ptr a -> IO ()) -> Builder
writeNbytes Int
n Ptr a -> IO ()
f = Int -> Builder
ensureFree Int
n Builder -> Builder -> Builder
`append` (Buffer -> IO Buffer) -> Builder
unsafeLiftIO (Int -> (Ptr a -> IO ()) -> Buffer -> IO Buffer
forall a.
Storable a =>
Int -> (Ptr a -> IO ()) -> Buffer -> IO Buffer
writeNBufferBytes Int
n Ptr a -> IO ()
f)
{-# INLINE writeNbytes #-}
writeNBufferBytes :: Storable a => Int -> (Ptr a -> IO ()) -> Buffer -> IO Buffer
writeNBufferBytes :: Int -> (Ptr a -> IO ()) -> Buffer -> IO Buffer
writeNBufferBytes Int
n Ptr a -> IO ()
f (Buffer ForeignPtr Word8
fp Int
o Int
u Int
l) = do
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp (\Ptr Word8
p -> Ptr a -> IO ()
f (Ptr Word8
p Ptr Word8 -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
u)))
Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> Int -> Buffer
Buffer ForeignPtr Word8
fp Int
o (Int
uInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n))
{-# INLINE writeNBufferBytes #-}
putWord16be :: Word16 -> Builder
putWord16be :: Word16 -> Builder
putWord16be Word16
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
2 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int -> Word16
shiftr_w16 Word16
w Int
8) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
w) :: Word8)
{-# INLINE putWord16be #-}
putWord16le :: Word16 -> Builder
putWord16le :: Word16 -> Builder
putWord16le Word16
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
2 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
w) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int -> Word16
shiftr_w16 Word16
w Int
8) :: Word8)
{-# INLINE putWord16le #-}
putWord32be :: Word32 -> Builder
putWord32be :: Word32 -> Builder
putWord32be Word32
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
4 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
shiftr_w32 Word32
w Int
24) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
shiftr_w32 Word32
w Int
16) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
shiftr_w32 Word32
w Int
8) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w) :: Word8)
{-# INLINE putWord32be #-}
putWord32le :: Word32 -> Builder
putWord32le :: Word32 -> Builder
putWord32le Word32
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
4 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
shiftr_w32 Word32
w Int
8) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
shiftr_w32 Word32
w Int
16) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
shiftr_w32 Word32
w Int
24) :: Word8)
{-# INLINE putWord32le #-}
putWord64be :: Word64 -> Builder
#if WORD_SIZE_IN_BITS < 64
putWord64be w =
let a = fromIntegral (shiftr_w64 w 32) :: Word32
b = fromIntegral w :: Word32
in writeN 8 $ \p -> do
poke p (fromIntegral (shiftr_w32 a 24) :: Word8)
poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a 16) :: Word8)
poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a 8) :: Word8)
poke (p `plusPtr` 3) (fromIntegral (a) :: Word8)
poke (p `plusPtr` 4) (fromIntegral (shiftr_w32 b 24) :: Word8)
poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b 16) :: Word8)
poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b 8) :: Word8)
poke (p `plusPtr` 7) (fromIntegral (b) :: Word8)
#else
putWord64be :: Word64 -> Builder
putWord64be Word64
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
8 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
56) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
48) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
40) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
32) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
24) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
5) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
16) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
6) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
8) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
7) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w) :: Word8)
#endif
{-# INLINE putWord64be #-}
putWord64le :: Word64 -> Builder
#if WORD_SIZE_IN_BITS < 64
putWord64le w =
let b = fromIntegral (shiftr_w64 w 32) :: Word32
a = fromIntegral w :: Word32
in writeN 8 $ \p -> do
poke (p) (fromIntegral (a) :: Word8)
poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a 8) :: Word8)
poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a 16) :: Word8)
poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 a 24) :: Word8)
poke (p `plusPtr` 4) (fromIntegral (b) :: Word8)
poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b 8) :: Word8)
poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b 16) :: Word8)
poke (p `plusPtr` 7) (fromIntegral (shiftr_w32 b 24) :: Word8)
#else
putWord64le :: Word64 -> Builder
putWord64le Word64
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
8 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
8) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
16) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
24) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
32) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
5) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
40) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
6) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
48) :: Word8)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
7) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
shiftr_w64 Word64
w Int
56) :: Word8)
#endif
{-# INLINE putWord64le #-}
putWordhost :: Word -> Builder
putWordhost :: Word -> Builder
putWordhost Word
w = Int -> (Ptr Word -> IO ()) -> Builder
forall a. Storable a => Int -> (Ptr a -> IO ()) -> Builder
writeNbytes (Word -> Int
forall a. Storable a => a -> Int
sizeOf (Word
forall a. HasCallStack => a
undefined :: Word)) (\Ptr Word
p -> Ptr Word -> Word -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word
p Word
w)
{-# INLINE putWordhost #-}
putWord16host :: Word16 -> Builder
putWord16host :: Word16 -> Builder
putWord16host Word16
w16 = Int -> (Ptr Word16 -> IO ()) -> Builder
forall a. Storable a => Int -> (Ptr a -> IO ()) -> Builder
writeNbytes (Word16 -> Int
forall a. Storable a => a -> Int
sizeOf (Word16
forall a. HasCallStack => a
undefined :: Word16)) (\Ptr Word16
p -> Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word16
p Word16
w16)
{-# INLINE putWord16host #-}
putWord32host :: Word32 -> Builder
putWord32host :: Word32 -> Builder
putWord32host Word32
w32 = Int -> (Ptr Word32 -> IO ()) -> Builder
forall a. Storable a => Int -> (Ptr a -> IO ()) -> Builder
writeNbytes (Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32)) (\Ptr Word32
p -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word32
p Word32
w32)
{-# INLINE putWord32host #-}
putWord64host :: Word64 -> Builder
putWord64host :: Word64 -> Builder
putWord64host Word64
w = Int -> (Ptr Word64 -> IO ()) -> Builder
forall a. Storable a => Int -> (Ptr a -> IO ()) -> Builder
writeNbytes (Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: Word64)) (\Ptr Word64
p -> Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word64
p Word64
w)
{-# INLINE putWord64host #-}
{-# INLINE shiftr_w16 #-}
shiftr_w16 :: Word16 -> Int -> Word16
{-# INLINE shiftr_w32 #-}
shiftr_w32 :: Word32 -> Int -> Word32
{-# INLINE shiftr_w64 #-}
shiftr_w64 :: Word64 -> Int -> Word64
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
shiftr_w16 :: Word16 -> Int -> Word16
shiftr_w16 (W16# Word#
w) (I# Int#
i) = Word# -> Word16
W16# (Word#
w Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
i)
shiftr_w32 :: Word32 -> Int -> Word32
shiftr_w32 (W32# Word#
w) (I# Int#
i) = Word# -> Word32
W32# (Word#
w Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
i)
#if WORD_SIZE_IN_BITS < 64
shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
#if __GLASGOW_HASKELL__ <= 606
foreign import ccall unsafe "stg_uncheckedShiftRL64"
uncheckedShiftRL64# :: Word64# -> Int# -> Word64#
#endif
#else
shiftr_w64 :: Word64 -> Int -> Word64
shiftr_w64 (W64# Word#
w) (I# Int#
i) = Word# -> Word64
W64# (Word#
w Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
i)
#endif
#else
shiftr_w16 = shiftR
shiftr_w32 = shiftR
shiftr_w64 = shiftR
#endif