make pasteGrowST accept an offset. correct the implementation of bytes
This commit is contained in:
parent
0c093e0971
commit
b0823d03c3
2 changed files with 41 additions and 6 deletions
|
@ -55,6 +55,8 @@ import qualified Data.ByteArray.Builder.Small.Unsafe as Unsafe
|
||||||
-- | An unmaterialized sequence of bytes that may be pasted
|
-- | An unmaterialized sequence of bytes that may be pasted
|
||||||
-- into a mutable byte array.
|
-- into a mutable byte array.
|
||||||
newtype Builder = Builder
|
newtype Builder = Builder
|
||||||
|
-- This functions takes an offset and a number of remaining bytes
|
||||||
|
-- and returns the new offset.
|
||||||
(forall s. MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #))
|
(forall s. MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #))
|
||||||
|
|
||||||
instance Semigroup Builder where
|
instance Semigroup Builder where
|
||||||
|
@ -115,15 +117,15 @@ pasteArrayST (MutableBytes arr off0 len0) f !xs0 = do
|
||||||
pasteGrowST ::
|
pasteGrowST ::
|
||||||
Int -- ^ How many bytes to grow by at a time
|
Int -- ^ How many bytes to grow by at a time
|
||||||
-> Builder
|
-> Builder
|
||||||
-> MutableByteArray s
|
-> MutableByteArrayOffset s
|
||||||
-- ^ Initial buffer, used linearly. Do not reuse this argument.
|
-- ^ Initial buffer, used linearly. Do not reuse this argument.
|
||||||
-> ST s (MutableByteArrayOffset s)
|
-> ST s (MutableByteArrayOffset s)
|
||||||
-- ^ Final buffer that accomodated the builder.
|
-- ^ Final buffer that accomodated the builder.
|
||||||
pasteGrowST !n b !arr0 = do
|
pasteGrowST !n b !(MutableByteArrayOffset arr0 off0) = do
|
||||||
let go !arr !sz = pasteST b (MutableBytes arr 0 sz) >>= \case
|
let go !arr !sz = pasteST b (MutableBytes arr off0 (sz - off0)) >>= \case
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
let szNext = sz + n
|
let szNext = sz + n
|
||||||
arrNext <- PM.newByteArray szNext
|
arrNext <- PM.resizeMutableByteArray arr szNext
|
||||||
go arrNext szNext
|
go arrNext szNext
|
||||||
Just ix -> pure (MutableByteArrayOffset{array=arr,offset=ix})
|
Just ix -> pure (MutableByteArrayOffset{array=arr,offset=ix})
|
||||||
go arr0 =<< PM.getSizeofMutableByteArray arr0
|
go arr0 =<< PM.getSizeofMutableByteArray arr0
|
||||||
|
@ -132,7 +134,7 @@ pasteGrowST !n b !arr0 = do
|
||||||
pasteGrowIO ::
|
pasteGrowIO ::
|
||||||
Int -- ^ How many bytes to grow by at a time
|
Int -- ^ How many bytes to grow by at a time
|
||||||
-> Builder
|
-> Builder
|
||||||
-> MutableByteArray RealWorld
|
-> MutableByteArrayOffset RealWorld
|
||||||
-- ^ Initial buffer, used linearly. Do not reuse this argument.
|
-- ^ Initial buffer, used linearly. Do not reuse this argument.
|
||||||
-> IO (MutableByteArrayOffset RealWorld)
|
-> IO (MutableByteArrayOffset RealWorld)
|
||||||
-- ^ Final buffer that accomodated the builder.
|
-- ^ Final buffer that accomodated the builder.
|
||||||
|
@ -183,7 +185,7 @@ bytes :: Bytes -> Builder
|
||||||
bytes (Bytes src soff slen) = construct $ \(MutableBytes arr off len) -> if len >= slen
|
bytes (Bytes src soff slen) = construct $ \(MutableBytes arr off len) -> if len >= slen
|
||||||
then do
|
then do
|
||||||
copyByteArray arr off src soff slen
|
copyByteArray arr off src soff slen
|
||||||
pure (Just (len - slen))
|
pure (Just (off + slen))
|
||||||
else pure Nothing
|
else pure Nothing
|
||||||
|
|
||||||
-- | Encodes an unsigned 64-bit integer as decimal.
|
-- | Encodes an unsigned 64-bit integer as decimal.
|
||||||
|
|
|
@ -19,6 +19,7 @@ module Data.ByteArray.Builder.Small.Unsafe
|
||||||
-- * Execute
|
-- * Execute
|
||||||
, run
|
, run
|
||||||
, pasteST
|
, pasteST
|
||||||
|
, pasteGrowST
|
||||||
, pasteIO
|
, pasteIO
|
||||||
-- * Combine
|
-- * Combine
|
||||||
, append
|
, append
|
||||||
|
@ -34,6 +35,7 @@ module Data.ByteArray.Builder.Small.Unsafe
|
||||||
, word64BE
|
, word64BE
|
||||||
, word32BE
|
, word32BE
|
||||||
, word16BE
|
, word16BE
|
||||||
|
, word8
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Primitive
|
import Control.Monad.Primitive
|
||||||
|
@ -47,6 +49,9 @@ import GHC.Word
|
||||||
import GHC.Int
|
import GHC.Int
|
||||||
import Data.Kind
|
import Data.Kind
|
||||||
import GHC.TypeLits (KnownNat,Nat,type (+),natVal')
|
import GHC.TypeLits (KnownNat,Nat,type (+),natVal')
|
||||||
|
import Data.Primitive.ByteArray.Offset (MutableByteArrayOffset(..))
|
||||||
|
|
||||||
|
import qualified Data.Primitive as PM
|
||||||
|
|
||||||
-- | A builder parameterized by the maximum number of bytes it uses
|
-- | A builder parameterized by the maximum number of bytes it uses
|
||||||
-- when executed.
|
-- when executed.
|
||||||
|
@ -74,6 +79,29 @@ pasteST (Builder f) (MutableByteArray arr) (I# off) =
|
||||||
ST $ \s0 -> case f arr off s0 of
|
ST $ \s0 -> case f arr off s0 of
|
||||||
(# s1, r #) -> (# s1, (I# r) #)
|
(# s1, r #) -> (# s1, (I# r) #)
|
||||||
|
|
||||||
|
-- | Paste the builder into the byte array starting at offset zero.
|
||||||
|
-- This reallocates the byte array if it cannot accomodate the builder,
|
||||||
|
-- growing it by the minimum amount necessary.
|
||||||
|
pasteGrowST :: forall n s. KnownNat n
|
||||||
|
=> Builder n
|
||||||
|
-> MutableByteArrayOffset s
|
||||||
|
-- ^ Initial buffer, used linearly. Do not reuse this argument.
|
||||||
|
-> ST s (MutableByteArrayOffset s)
|
||||||
|
-- ^ Final buffer that accomodated the builder.
|
||||||
|
{-# inline pasteGrowST #-}
|
||||||
|
pasteGrowST b !(MutableByteArrayOffset{array=arr0,offset=off0}) = do
|
||||||
|
sz0 <- PM.getSizeofMutableByteArray arr0
|
||||||
|
let req = fromIntegral (natVal' (proxy# :: Proxy# n))
|
||||||
|
let sz1 = off0 + req
|
||||||
|
if sz1 <= sz0
|
||||||
|
then do
|
||||||
|
off1 <- pasteST b arr0 off0
|
||||||
|
pure (MutableByteArrayOffset arr0 off1)
|
||||||
|
else do
|
||||||
|
arr1 <- PM.resizeMutableByteArray arr0 sz1
|
||||||
|
off1 <- pasteST b arr1 off0
|
||||||
|
pure (MutableByteArrayOffset arr1 off1)
|
||||||
|
|
||||||
-- | This function does not enforce the known upper bound on the
|
-- | This function does not enforce the known upper bound on the
|
||||||
-- size. It is up to the user to do this.
|
-- size. It is up to the user to do this.
|
||||||
pasteIO :: Builder n -> MutableByteArray RealWorld -> Int -> IO Int
|
pasteIO :: Builder n -> MutableByteArray RealWorld -> Int -> IO Int
|
||||||
|
@ -283,6 +311,11 @@ word16BE w = construct $ \arr off -> do
|
||||||
writeByteArray arr (off + 1) (fromIntegral @Word16 @Word8 w)
|
writeByteArray arr (off + 1) (fromIntegral @Word16 @Word8 w)
|
||||||
pure (off + 2)
|
pure (off + 2)
|
||||||
|
|
||||||
|
word8 :: Word8 -> Builder 1
|
||||||
|
word8 w = construct $ \arr off -> do
|
||||||
|
writeByteArray arr off w
|
||||||
|
pure (off + 1)
|
||||||
|
|
||||||
-- Reverse the bytes in the designated slice. This takes
|
-- Reverse the bytes in the designated slice. This takes
|
||||||
-- an inclusive start offset and an inclusive end offset.
|
-- an inclusive start offset and an inclusive end offset.
|
||||||
reverseBytes :: MutableByteArray s -> Int -> Int -> ST s ()
|
reverseBytes :: MutableByteArray s -> Int -> Int -> ST s ()
|
||||||
|
|
Loading…
Reference in a new issue