document everything
This commit is contained in:
parent
831c25c81a
commit
c3b248a598
2 changed files with 71 additions and 4 deletions
|
@ -24,6 +24,7 @@ module Data.ByteArray.Builder.Small
|
||||||
-- * Numbers
|
-- * Numbers
|
||||||
, word64Dec
|
, word64Dec
|
||||||
, word64PaddedUpperHex
|
, word64PaddedUpperHex
|
||||||
|
, word32PaddedUpperHex
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Primitive
|
import Control.Monad.Primitive
|
||||||
|
@ -57,6 +58,7 @@ instance Monoid Builder where
|
||||||
mempty = Builder $ \_ off0 _ s0 -> (# s0, off0 #)
|
mempty = Builder $ \_ off0 _ s0 -> (# s0, off0 #)
|
||||||
|
|
||||||
-- | Run a builder. An accurate size hint is important for good performance.
|
-- | Run a builder. An accurate size hint is important for good performance.
|
||||||
|
-- The size hint should be slightly larger than the actual size.
|
||||||
run ::
|
run ::
|
||||||
Int -- ^ Hint for upper bound on size
|
Int -- ^ Hint for upper bound on size
|
||||||
-> Builder -- ^ Builder
|
-> Builder -- ^ Builder
|
||||||
|
@ -71,6 +73,7 @@ run hint b = runByteArrayST $ do
|
||||||
unsafeFreezeByteArray arr
|
unsafeFreezeByteArray arr
|
||||||
go hint
|
go hint
|
||||||
|
|
||||||
|
-- | Variant of 'pasteArrayST' that runs in 'IO'.
|
||||||
pasteArrayIO ::
|
pasteArrayIO ::
|
||||||
MutableBytes RealWorld -- ^ Buffer
|
MutableBytes RealWorld -- ^ Buffer
|
||||||
-> (a -> Builder) -- ^ Builder
|
-> (a -> Builder) -- ^ Builder
|
||||||
|
@ -78,6 +81,8 @@ pasteArrayIO ::
|
||||||
-> IO (V.Vector a, MutableBytes RealWorld) -- ^ Shifted vector, shifted buffer
|
-> IO (V.Vector a, MutableBytes RealWorld) -- ^ Shifted vector, shifted buffer
|
||||||
pasteArrayIO !arr f !xs = stToIO (pasteArrayST arr f xs)
|
pasteArrayIO !arr f !xs = stToIO (pasteArrayST arr f xs)
|
||||||
|
|
||||||
|
-- | Fold over a vector, applying the builder to each element until
|
||||||
|
-- the buffer cannot accomodate any more.
|
||||||
pasteArrayST ::
|
pasteArrayST ::
|
||||||
MutableBytes s -- ^ Buffer
|
MutableBytes s -- ^ Buffer
|
||||||
-> (a -> Builder) -- ^ Builder
|
-> (a -> Builder) -- ^ Builder
|
||||||
|
@ -123,6 +128,10 @@ pasteGrowIO ::
|
||||||
-- ^ Final buffer that accomodated the builder.
|
-- ^ Final buffer that accomodated the builder.
|
||||||
pasteGrowIO !n b !arr = stToIO (pasteGrowST n b arr)
|
pasteGrowIO !n b !arr = stToIO (pasteGrowST n b arr)
|
||||||
|
|
||||||
|
-- | Execute the builder, pasting its contents into a buffer.
|
||||||
|
-- If the buffer is not large enough, this returns 'Nothing'.
|
||||||
|
-- Otherwise, it returns the index in the buffer that follows
|
||||||
|
-- the payload just written.
|
||||||
pasteST :: Builder -> MutableBytes s -> ST s (Maybe Int)
|
pasteST :: Builder -> MutableBytes s -> ST s (Maybe Int)
|
||||||
{-# inline pasteST #-}
|
{-# inline pasteST #-}
|
||||||
pasteST (Builder f) (MutableBytes (MutableByteArray arr) (I# off) (I# len)) =
|
pasteST (Builder f) (MutableBytes (MutableByteArray arr) (I# off) (I# len)) =
|
||||||
|
@ -131,10 +140,14 @@ pasteST (Builder f) (MutableBytes (MutableByteArray arr) (I# off) (I# len)) =
|
||||||
then (# s1, Just (I# r) #)
|
then (# s1, Just (I# r) #)
|
||||||
else (# s1, Nothing #)
|
else (# s1, Nothing #)
|
||||||
|
|
||||||
|
-- | Variant of 'pasteST' that runs in 'IO'.
|
||||||
pasteIO :: Builder -> MutableBytes RealWorld -> IO (Maybe Int)
|
pasteIO :: Builder -> MutableBytes RealWorld -> IO (Maybe Int)
|
||||||
{-# inline pasteIO #-}
|
{-# inline pasteIO #-}
|
||||||
pasteIO b m = stToIO (pasteST b m)
|
pasteIO b m = stToIO (pasteST b m)
|
||||||
|
|
||||||
|
-- | Constructor for 'Builder' that works on a function with lifted
|
||||||
|
-- arguments instead of unlifted ones. This is just as unsafe as the
|
||||||
|
-- actual constructor.
|
||||||
construct :: (forall s. MutableBytes s -> ST s (Maybe Int)) -> Builder
|
construct :: (forall s. MutableBytes s -> ST s (Maybe Int)) -> Builder
|
||||||
construct f = Builder
|
construct f = Builder
|
||||||
$ \arr off len s0 ->
|
$ \arr off len s0 ->
|
||||||
|
@ -151,9 +164,11 @@ fromUnsafe (Unsafe.Builder f) = Builder $ \arr off len s0 ->
|
||||||
1# -> f arr off s0
|
1# -> f arr off s0
|
||||||
_ -> (# s0, (-1#) #)
|
_ -> (# s0, (-1#) #)
|
||||||
|
|
||||||
|
-- | Create a builder from an unsliced byte sequence.
|
||||||
bytearray :: ByteArray -> Builder
|
bytearray :: ByteArray -> Builder
|
||||||
bytearray a = bytes (Bytes a 0 (sizeofByteArray a))
|
bytearray a = bytes (Bytes a 0 (sizeofByteArray a))
|
||||||
|
|
||||||
|
-- | Create a builder from a sliced byte sequence.
|
||||||
bytes :: Bytes -> Builder
|
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
|
||||||
|
@ -161,13 +176,26 @@ bytes (Bytes src soff slen) = construct $ \(MutableBytes arr off len) -> if len
|
||||||
pure (Just (len - slen))
|
pure (Just (len - slen))
|
||||||
else pure Nothing
|
else pure Nothing
|
||||||
|
|
||||||
|
-- | Encodes an unsigned 64-bit integer as decimal.
|
||||||
|
-- This encoding never starts with a zero unless the
|
||||||
|
-- argument was zero.
|
||||||
word64Dec :: Word64 -> Builder
|
word64Dec :: Word64 -> Builder
|
||||||
word64Dec w = fromUnsafe (Unsafe.word64Dec w)
|
word64Dec w = fromUnsafe (Unsafe.word64Dec w)
|
||||||
|
|
||||||
|
-- | Encode a 64-bit unsigned integer as hexadecimal, zero-padding
|
||||||
|
-- the encoding to 16 digits. This uses uppercase for the alphabetical
|
||||||
|
-- digits. For example, this encodes the number 1022 as @00000000000003FE@.
|
||||||
word64PaddedUpperHex :: Word64 -> Builder
|
word64PaddedUpperHex :: Word64 -> Builder
|
||||||
word64PaddedUpperHex w =
|
word64PaddedUpperHex w =
|
||||||
fromUnsafe (Unsafe.word64PaddedUpperHex w)
|
fromUnsafe (Unsafe.word64PaddedUpperHex w)
|
||||||
|
|
||||||
|
-- | Encode a 32-bit unsigned integer as hexadecimal, zero-padding
|
||||||
|
-- the encoding to 8 digits. This uses uppercase for the alphabetical
|
||||||
|
-- digits. For example, this encodes the number 1022 as @000003FE@.
|
||||||
|
word32PaddedUpperHex :: Word32 -> Builder
|
||||||
|
word32PaddedUpperHex w =
|
||||||
|
fromUnsafe (Unsafe.word32PaddedUpperHex w)
|
||||||
|
|
||||||
unST :: ST s a -> State# s -> (# State# s, a #)
|
unST :: ST s a -> State# s -> (# State# s, a #)
|
||||||
unST (ST f) = f
|
unST (ST f) = f
|
||||||
|
|
||||||
|
|
|
@ -12,14 +12,19 @@
|
||||||
-- | The functions in this module do not check to
|
-- | The functions in this module do not check to
|
||||||
-- see if there is enough space in the buffer.
|
-- see if there is enough space in the buffer.
|
||||||
module Data.ByteArray.Builder.Small.Unsafe
|
module Data.ByteArray.Builder.Small.Unsafe
|
||||||
( Builder(..)
|
( -- * Builder
|
||||||
|
Builder(..)
|
||||||
|
, construct
|
||||||
|
-- * Execute
|
||||||
, run
|
, run
|
||||||
, pasteST
|
, pasteST
|
||||||
, pasteIO
|
, pasteIO
|
||||||
, construct
|
-- * Combine
|
||||||
, append
|
, append
|
||||||
|
-- * Encode Integral Types
|
||||||
, word64Dec
|
, word64Dec
|
||||||
, word64PaddedUpperHex
|
, word64PaddedUpperHex
|
||||||
|
, word32PaddedUpperHex
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Primitive
|
import Control.Monad.Primitive
|
||||||
|
@ -34,11 +39,14 @@ import GHC.Word
|
||||||
import Data.Kind
|
import Data.Kind
|
||||||
import GHC.TypeLits (KnownNat,Nat,type (+),natVal')
|
import GHC.TypeLits (KnownNat,Nat,type (+),natVal')
|
||||||
|
|
||||||
|
-- | A builder parameterized by the maximum number of bytes it uses
|
||||||
|
-- when executed.
|
||||||
newtype Builder :: Nat -> Type where
|
newtype Builder :: Nat -> Type where
|
||||||
Builder ::
|
Builder ::
|
||||||
(forall s. MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #))
|
(forall s. MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #))
|
||||||
-> Builder n
|
-> Builder n
|
||||||
|
|
||||||
|
-- | Execute the builder. This function is safe.
|
||||||
run :: forall n. KnownNat n
|
run :: forall n. KnownNat n
|
||||||
=> Builder n -- ^ Builder
|
=> Builder n -- ^ Builder
|
||||||
-> ByteArray
|
-> ByteArray
|
||||||
|
@ -63,6 +71,9 @@ pasteIO :: Builder n -> MutableByteArray RealWorld -> Int -> IO Int
|
||||||
{-# inline pasteIO #-}
|
{-# inline pasteIO #-}
|
||||||
pasteIO b m off = stToIO (pasteST b m off)
|
pasteIO b m off = stToIO (pasteST b m off)
|
||||||
|
|
||||||
|
-- | Constructor for 'Builder' that works on a function with lifted
|
||||||
|
-- arguments instead of unlifted ones. This is just as unsafe as the
|
||||||
|
-- actual constructor.
|
||||||
construct :: (forall s. MutableByteArray s -> Int -> ST s Int) -> Builder n
|
construct :: (forall s. MutableByteArray s -> Int -> ST s Int) -> Builder n
|
||||||
{-# inline construct #-}
|
{-# inline construct #-}
|
||||||
construct f = Builder
|
construct f = Builder
|
||||||
|
@ -70,12 +81,14 @@ construct f = Builder
|
||||||
case unST (f (MutableByteArray arr) (I# off)) s0 of
|
case unST (f (MutableByteArray arr) (I# off)) s0 of
|
||||||
(# s1, (I# n) #) -> (# s1, n #)
|
(# s1, (I# n) #) -> (# s1, n #)
|
||||||
|
|
||||||
|
-- | Concatenate two builders.
|
||||||
append :: Builder n -> Builder m -> Builder (n + m)
|
append :: Builder n -> Builder m -> Builder (n + m)
|
||||||
append (Builder f) (Builder g) =
|
append (Builder f) (Builder g) =
|
||||||
Builder $ \arr off0 s0 -> case f arr off0 s0 of
|
Builder $ \arr off0 s0 -> case f arr off0 s0 of
|
||||||
(# s1, r #) -> g arr r s1
|
(# s1, r #) -> g arr r s1
|
||||||
|
|
||||||
-- | Requires up to 19 bytes.
|
-- | Requires up to 19 bytes. Encodes an unsigned 64-bit integer as decimal.
|
||||||
|
-- This encoding never starts with a zero unless the argument was zero.
|
||||||
word64Dec :: Word64 -> Builder 19
|
word64Dec :: Word64 -> Builder 19
|
||||||
word64Dec (W64# w) = word64Dec# w
|
word64Dec (W64# w) = word64Dec# w
|
||||||
|
|
||||||
|
@ -115,10 +128,19 @@ toHexUpper w' = fromIntegral
|
||||||
loSolved = w + 48
|
loSolved = w + 48
|
||||||
hiSolved = w + 55
|
hiSolved = w + 55
|
||||||
|
|
||||||
-- | Requires up to 16 bytes.
|
-- | Requires exactly 16 bytes. Encodes a 64-bit unsigned integer as
|
||||||
|
-- hexadecimal, zero-padding the encoding to 16 digits. This uses
|
||||||
|
-- uppercase for the alphabetical digits. For example, this encodes the
|
||||||
|
-- number 1022 as @00000000000003FE@.
|
||||||
word64PaddedUpperHex :: Word64 -> Builder 16
|
word64PaddedUpperHex :: Word64 -> Builder 16
|
||||||
word64PaddedUpperHex (W64# w) = word64PaddedUpperHex# w
|
word64PaddedUpperHex (W64# w) = word64PaddedUpperHex# w
|
||||||
|
|
||||||
|
-- | Requires exactly 8 bytes. Encodes a 32-bit unsigned integer as
|
||||||
|
-- hexadecimal, zero-padding the encoding to 8 digits. This uses
|
||||||
|
-- uppercase for the alphabetical digits.
|
||||||
|
word32PaddedUpperHex :: Word32 -> Builder 8
|
||||||
|
word32PaddedUpperHex (W32# w) = word32PaddedUpperHex# w
|
||||||
|
|
||||||
word64PaddedUpperHex# :: Word# -> Builder 16
|
word64PaddedUpperHex# :: Word# -> Builder 16
|
||||||
{-# noinline word64PaddedUpperHex# #-}
|
{-# noinline word64PaddedUpperHex# #-}
|
||||||
word64PaddedUpperHex# w# = construct $ \arr off -> do
|
word64PaddedUpperHex# w# = construct $ \arr off -> do
|
||||||
|
@ -142,6 +164,23 @@ word64PaddedUpperHex# w# = construct $ \arr off -> do
|
||||||
where
|
where
|
||||||
w = W# w#
|
w = W# w#
|
||||||
|
|
||||||
|
word32PaddedUpperHex# :: Word# -> Builder 8
|
||||||
|
{-# noinline word32PaddedUpperHex# #-}
|
||||||
|
word32PaddedUpperHex# w# = construct $ \arr off -> do
|
||||||
|
writeByteArray arr off (toHexUpper (unsafeShiftR w 28))
|
||||||
|
writeByteArray arr (off + 1) (toHexUpper (unsafeShiftR w 24))
|
||||||
|
writeByteArray arr (off + 2) (toHexUpper (unsafeShiftR w 20))
|
||||||
|
writeByteArray arr (off + 3) (toHexUpper (unsafeShiftR w 16))
|
||||||
|
writeByteArray arr (off + 4) (toHexUpper (unsafeShiftR w 12))
|
||||||
|
writeByteArray arr (off + 5) (toHexUpper (unsafeShiftR w 8))
|
||||||
|
writeByteArray arr (off + 6) (toHexUpper (unsafeShiftR w 4))
|
||||||
|
writeByteArray arr (off + 7) (toHexUpper (unsafeShiftR w 0))
|
||||||
|
pure (off + 8)
|
||||||
|
where
|
||||||
|
w = W# w#
|
||||||
|
|
||||||
|
-- Reverse the bytes in the designated slice. This takes
|
||||||
|
-- an inclusive start offset and an inclusive end offset.
|
||||||
reverseBytes :: MutableByteArray s -> Int -> Int -> ST s ()
|
reverseBytes :: MutableByteArray s -> Int -> Int -> ST s ()
|
||||||
{-# inline reverseBytes #-}
|
{-# inline reverseBytes #-}
|
||||||
reverseBytes arr begin end = go begin end where
|
reverseBytes arr begin end = go begin end where
|
||||||
|
|
Loading…
Reference in a new issue