diff --git a/src/Data/ByteArray/Builder/Small.hs b/src/Data/ByteArray/Builder/Small.hs index b68f4d0..d79b99c 100644 --- a/src/Data/ByteArray/Builder/Small.hs +++ b/src/Data/ByteArray/Builder/Small.hs @@ -24,6 +24,7 @@ module Data.ByteArray.Builder.Small -- * Numbers , word64Dec , word64PaddedUpperHex + , word32PaddedUpperHex ) where import Control.Monad.Primitive @@ -57,6 +58,7 @@ instance Monoid Builder where mempty = Builder $ \_ off0 _ s0 -> (# s0, off0 #) -- | Run a builder. An accurate size hint is important for good performance. +-- The size hint should be slightly larger than the actual size. run :: Int -- ^ Hint for upper bound on size -> Builder -- ^ Builder @@ -71,6 +73,7 @@ run hint b = runByteArrayST $ do unsafeFreezeByteArray arr go hint +-- | Variant of 'pasteArrayST' that runs in 'IO'. pasteArrayIO :: MutableBytes RealWorld -- ^ Buffer -> (a -> Builder) -- ^ Builder @@ -78,6 +81,8 @@ pasteArrayIO :: -> IO (V.Vector a, MutableBytes RealWorld) -- ^ Shifted vector, shifted buffer 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 :: MutableBytes s -- ^ Buffer -> (a -> Builder) -- ^ Builder @@ -123,6 +128,10 @@ pasteGrowIO :: -- ^ Final buffer that accomodated the builder. 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) {-# inline pasteST #-} 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) #) else (# s1, Nothing #) +-- | Variant of 'pasteST' that runs in 'IO'. pasteIO :: Builder -> MutableBytes RealWorld -> IO (Maybe Int) {-# inline pasteIO #-} 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 f = Builder $ \arr off len s0 -> @@ -151,9 +164,11 @@ fromUnsafe (Unsafe.Builder f) = Builder $ \arr off len s0 -> 1# -> f arr off s0 _ -> (# s0, (-1#) #) +-- | Create a builder from an unsliced byte sequence. bytearray :: ByteArray -> Builder bytearray a = bytes (Bytes a 0 (sizeofByteArray a)) +-- | Create a builder from a sliced byte sequence. bytes :: Bytes -> Builder bytes (Bytes src soff slen) = construct $ \(MutableBytes arr off len) -> if len >= slen then do @@ -161,13 +176,26 @@ bytes (Bytes src soff slen) = construct $ \(MutableBytes arr off len) -> if len pure (Just (len - slen)) 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 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 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 f) = f diff --git a/src/Data/ByteArray/Builder/Small/Unsafe.hs b/src/Data/ByteArray/Builder/Small/Unsafe.hs index 36e071c..866d4b3 100644 --- a/src/Data/ByteArray/Builder/Small/Unsafe.hs +++ b/src/Data/ByteArray/Builder/Small/Unsafe.hs @@ -12,14 +12,19 @@ -- | The functions in this module do not check to -- see if there is enough space in the buffer. module Data.ByteArray.Builder.Small.Unsafe - ( Builder(..) + ( -- * Builder + Builder(..) + , construct + -- * Execute , run , pasteST , pasteIO - , construct + -- * Combine , append + -- * Encode Integral Types , word64Dec , word64PaddedUpperHex + , word32PaddedUpperHex ) where import Control.Monad.Primitive @@ -34,11 +39,14 @@ import GHC.Word import Data.Kind 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 Builder :: (forall s. MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)) -> Builder n +-- | Execute the builder. This function is safe. run :: forall n. KnownNat n => Builder n -- ^ Builder -> ByteArray @@ -63,6 +71,9 @@ pasteIO :: Builder n -> MutableByteArray RealWorld -> Int -> IO Int {-# inline pasteIO #-} 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 {-# inline construct #-} construct f = Builder @@ -70,12 +81,14 @@ construct f = Builder case unST (f (MutableByteArray arr) (I# off)) s0 of (# s1, (I# n) #) -> (# s1, n #) +-- | Concatenate two builders. append :: Builder n -> Builder m -> Builder (n + m) append (Builder f) (Builder g) = Builder $ \arr off0 s0 -> case f arr off0 s0 of (# 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 (W64# w) = word64Dec# w @@ -115,10 +128,19 @@ toHexUpper w' = fromIntegral loSolved = w + 48 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 (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 {-# noinline word64PaddedUpperHex# #-} word64PaddedUpperHex# w# = construct $ \arr off -> do @@ -142,6 +164,23 @@ word64PaddedUpperHex# w# = construct $ \arr off -> do where 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 () {-# inline reverseBytes #-} reverseBytes arr begin end = go begin end where