From f8a32ebb1b2f4dfd8d3e804c4b92cfd718201be7 Mon Sep 17 00:00:00 2001 From: Zankoku Okuno Date: Fri, 7 Feb 2020 09:39:59 -0500 Subject: [PATCH] Word256 lacunae for big-endian and little-endian output Implement BE and LE builders for 256-bit words and arrays of 256-bit words. Test new functions in the test suite. --- CHANGELOG.md | 1 + small-bytearray-builder.cabal | 2 +- src/Data/ByteArray/Builder.hs | 55 +++++++++++++++++++++++++-- src/Data/ByteArray/Builder/Bounded.hs | 8 ++++ test/Main.hs | 10 +++++ 5 files changed, 71 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 37bb3ed..10632e7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,7 @@ ## 0.3.3.0 -- 2020-??-?? * Add `word64PaddedLowerHex` and `word32PaddedLowerHex` +* Add `word256Array{LE,BE}` and `word256{LE,BE}` * Add `word{128,256}Padded{Lower,Upper}Hex` ## 0.3.2.0 -- 2020-01-20 diff --git a/small-bytearray-builder.cabal b/small-bytearray-builder.cabal index aba63e2..9227879 100644 --- a/small-bytearray-builder.cabal +++ b/small-bytearray-builder.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: small-bytearray-builder -version: 0.3.2.0 +version: 0.3.3.0 synopsis: Serialize to a small byte arrays description: This is similar to the builder facilities provided by diff --git a/src/Data/ByteArray/Builder.hs b/src/Data/ByteArray/Builder.hs index ee9f0da..af89701 100644 --- a/src/Data/ByteArray/Builder.hs +++ b/src/Data/ByteArray/Builder.hs @@ -57,6 +57,7 @@ module Data.ByteArray.Builder -- *** One , word8 -- **** Big Endian + , word256BE , word128BE , word64BE , word32BE @@ -65,6 +66,7 @@ module Data.ByteArray.Builder , int32BE , int16BE -- **** Little Endian + , word256LE , word128LE , word64LE , word32LE @@ -79,6 +81,7 @@ module Data.ByteArray.Builder , word32ArrayBE , word64ArrayBE , word128ArrayBE + , word256ArrayBE , int64ArrayBE , int32ArrayBE , int16ArrayBE @@ -87,6 +90,7 @@ module Data.ByteArray.Builder , word32ArrayLE , word64ArrayLE , word128ArrayLE + , word256ArrayLE , int64ArrayLE , int32ArrayLE , int16ArrayLE @@ -119,7 +123,7 @@ import Data.Foldable (foldlM) import Data.Int (Int64,Int32,Int16,Int8) import Data.Primitive (ByteArray(..),MutableByteArray(..),PrimArray(..)) import Data.Text.Short (ShortText) -import Data.WideWord (Word128) +import Data.WideWord (Word128,Word256) import Data.Word (Word64,Word32,Word16,Word8) import GHC.ByteOrder (ByteOrder(BigEndian,LittleEndian),targetByteOrder) import GHC.Exts (Int(I#),Char(C#),Int#,State#,ByteArray#,(>=#)) @@ -390,6 +394,16 @@ word128ArrayBE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of BigEndian -> bytes (Bytes (ByteArray arr) (soff0 * 16) (slen0 * 16)) LittleEndian -> word128ArraySwap src soff0 slen0 +word256ArrayLE :: PrimArray Word256 -> Int -> Int -> Builder +word256ArrayLE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of + LittleEndian -> bytes (Bytes (ByteArray arr) (soff0 * 32) (slen0 * 32)) + BigEndian -> word256ArraySwap src soff0 slen0 + +word256ArrayBE :: PrimArray Word256 -> Int -> Int -> Builder +word256ArrayBE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of + BigEndian -> bytes (Bytes (ByteArray arr) (soff0 * 32) (slen0 * 32)) + LittleEndian -> word256ArraySwap src soff0 slen0 + word64ArrayLE :: PrimArray Word64 -> Int -> Int -> Builder word64ArrayLE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of LittleEndian -> bytes (Bytes (ByteArray arr) (soff0 * 8) (slen0 * 8)) @@ -525,6 +539,28 @@ word128ArraySwap src soff0 slen0 = go (soff + 16) send dst (doff + 16) else pure doff +word256ArraySwap :: PrimArray Word256 -> Int -> Int -> Builder +word256ArraySwap src soff0 slen0 = + fromFunction (slen0 * 32) (go (soff0 * 32) ((soff0 + slen0) * 32)) + where + -- TODO: Perhaps we could put byteswapping functions to use + -- rather than indexing tons of Word8s. This could be done + -- both here and in the other swap functions. There are a + -- decent number of tests for these array-swapping functions, + -- which makes changing this less scary. + go :: Int -> Int -> MutableByteArray s -> Int -> ST s Int + go !soff !send !dst !doff = if soff < send + then do + let loop !i + | i < 32 = do + let v = PM.indexPrimArray (asWord8s src) (soff + i) + PM.writeByteArray dst (doff + (31 - i)) v + loop (i + 1) + | otherwise = pure () + loop 0 + go (soff + 32) send dst (doff + 32) + else pure doff + asWord8s :: PrimArray a -> PrimArray Word8 asWord8s (PrimArray x) = PrimArray x @@ -766,6 +802,11 @@ int32BE w = fromBounded Nat.constant (Bounded.int32BE w) int16BE :: Int16 -> Builder int16BE w = fromBounded Nat.constant (Bounded.int16BE w) +-- | Requires exactly 32 bytes. Dump the octets of a 256-bit +-- word in a little-endian fashion. +word256LE :: Word256 -> Builder +word256LE w = fromBounded Nat.constant (Bounded.word256LE w) + -- | Requires exactly 16 bytes. Dump the octets of a 128-bit -- word in a little-endian fashion. word128LE :: Word128 -> Builder @@ -786,16 +827,22 @@ word32LE w = fromBounded Nat.constant (Bounded.word32LE w) word16LE :: Word16 -> Builder word16LE w = fromBounded Nat.constant (Bounded.word16LE w) --- | Requires exactly 8 bytes. Dump the octets of a 64-bit + +-- | Requires exactly 32 bytes. Dump the octets of a 256-bit -- word in a big-endian fashion. -word64BE :: Word64 -> Builder -word64BE w = fromBounded Nat.constant (Bounded.word64BE w) +word256BE :: Word256 -> Builder +word256BE w = fromBounded Nat.constant (Bounded.word256BE w) -- | Requires exactly 16 bytes. Dump the octets of a 128-bit -- word in a big-endian fashion. word128BE :: Word128 -> Builder word128BE w = fromBounded Nat.constant (Bounded.word128BE w) +-- | Requires exactly 8 bytes. Dump the octets of a 64-bit +-- word in a big-endian fashion. +word64BE :: Word64 -> Builder +word64BE w = fromBounded Nat.constant (Bounded.word64BE w) + -- | Requires exactly 4 bytes. Dump the octets of a 32-bit -- word in a big-endian fashion. word32BE :: Word32 -> Builder diff --git a/src/Data/ByteArray/Builder/Bounded.hs b/src/Data/ByteArray/Builder/Bounded.hs index 42a7114..8ecc771 100644 --- a/src/Data/ByteArray/Builder/Bounded.hs +++ b/src/Data/ByteArray/Builder/Bounded.hs @@ -66,6 +66,7 @@ module Data.ByteArray.Builder.Bounded -- *** One , word8 -- **** Big Endian + , word256BE , word128BE , word64BE , word32BE @@ -74,6 +75,7 @@ module Data.ByteArray.Builder.Bounded , int32BE , int16BE -- **** Little Endian + , word256LE , word128LE , word64LE , word32LE @@ -764,6 +766,12 @@ word128LE (Word128 hi lo) = append (word64LE lo) (word64LE hi) word128BE :: Word128 -> Builder 16 word128BE (Word128 hi lo) = append (word64BE hi) (word64BE lo) +word256LE :: Word256 -> Builder 32 +word256LE (Word256 hi mhi mlo lo) = word64LE lo `append` word64LE mlo `append` word64LE mhi `append` word64LE hi + +word256BE :: Word256 -> Builder 32 +word256BE (Word256 hi mhi mlo lo) = word64BE hi `append` word64BE mhi `append` word64BE mlo `append` word64BE lo + -- | Requires exactly 8 bytes. Dump the octets of a 64-bit -- word in a little-endian fashion. word64LE :: Word64 -> Builder 8 diff --git a/test/Main.hs b/test/Main.hs index 2af505a..637165b 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -201,6 +201,16 @@ tests = testGroup "Tests" in runConcat 1 (foldMap word128BE xs) === runConcat 1 (word128ArrayBE ys 0 (Prelude.length xs)) + , TQC.testProperty "word256ArrayLE" $ \(xs :: [Word256]) -> + let ys = Exts.fromList xs :: PrimArray Word256 + in runConcat 1 (foldMap word256LE xs) + === + runConcat 1 (word256ArrayLE ys 0 (Prelude.length xs)) + , TQC.testProperty "word256ArrayBE" $ \(xs :: [Word256]) -> + let ys = Exts.fromList xs :: PrimArray Word256 + in runConcat 1 (foldMap word256BE xs) + === + runConcat 1 (word256ArrayBE ys 0 (Prelude.length xs)) ] , testGroup "alternate" [ TQC.testProperty "HexWord64" $ \x y ->