diff --git a/CHANGELOG.md b/CHANGELOG.md index 6895211..fef1090 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for small-bytearray-builder +## 0.3.1.0 -- 2019-??-?? + +* Add big-endian and little-endian parsers for `Word128`. This includes + both the single and multiple element variants. + ## 0.3.0.0 -- 2019-10-17 * Breaking change: Change the internal implementation of `Builder`. This diff --git a/small-bytearray-builder.cabal b/small-bytearray-builder.cabal index 4b7ad74..0eb64e0 100644 --- a/small-bytearray-builder.cabal +++ b/small-bytearray-builder.cabal @@ -44,11 +44,12 @@ library build-depends: , base >=4.12.0.0 && <5 , byteslice >=0.1 && <0.2 + , bytestring >=0.10.8.2 && <0.11 + , natural-arithmetic >=0.1 && <0.2 , primitive-offset >=0.2 && <0.3 , run-st >=0.1 && <0.2 - , bytestring >=0.10.8.2 && <0.11 , text-short >=0.1.3 && <0.2 - , natural-arithmetic >=0.1 && <0.2 + , wide-word >=0.1.0.9 && <0.2 if flag(checked) build-depends: primitive-checked >= 0.7 && <0.8 else @@ -79,6 +80,7 @@ test-suite test , tasty-quickcheck >=0.10.1 && <0.11 , text >=1.2 && <1.3 , vector + , wide-word >=0.1.0.9 && <0.2 benchmark bench type: exitcode-stdio-1.0 diff --git a/src/Data/ByteArray/Builder.hs b/src/Data/ByteArray/Builder.hs index 558ecee..f83b9f6 100644 --- a/src/Data/ByteArray/Builder.hs +++ b/src/Data/ByteArray/Builder.hs @@ -54,6 +54,7 @@ module Data.ByteArray.Builder -- *** One , word8 -- **** Big Endian + , word128BE , word64BE , word32BE , word16BE @@ -61,6 +62,7 @@ module Data.ByteArray.Builder , int32BE , int16BE -- **** Little Endian + , word128LE , word64LE , word32LE , word16LE @@ -73,6 +75,7 @@ module Data.ByteArray.Builder , word16ArrayBE , word32ArrayBE , word64ArrayBE + , word128ArrayBE , int64ArrayBE , int32ArrayBE , int16ArrayBE @@ -80,6 +83,7 @@ module Data.ByteArray.Builder , word16ArrayLE , word32ArrayLE , word64ArrayLE + , word128ArrayLE , int64ArrayLE , int32ArrayLE , int16ArrayLE @@ -99,17 +103,18 @@ import Data.ByteArray.Builder.Unsafe (Builder(Builder)) import Data.ByteArray.Builder.Unsafe (Commits(Initial,Mutable,Immutable)) import Data.ByteArray.Builder.Unsafe (stringUtf8,cstring) import Data.ByteString.Short.Internal (ShortByteString(SBS)) +import Data.Bytes.Chunks (Chunks(..)) import Data.Bytes.Types (Bytes(Bytes)) import Data.Char (ord) import Data.Int (Int64,Int32,Int16,Int8) import Data.Primitive (ByteArray(..),MutableByteArray(..),PrimArray(..)) import Data.Text.Short (ShortText) +import Data.WideWord (Word128) import Data.Word (Word64,Word32,Word16,Word8) +import GHC.ByteOrder (ByteOrder(BigEndian,LittleEndian),targetByteOrder) import GHC.Exts (Int(I#),Char(C#),Int#,State#,ByteArray#,(>=#)) import GHC.Exts (MutableByteArray#,(+#),(-#),(<#)) import GHC.ST (ST(ST)) -import Data.Bytes.Chunks (Chunks(..)) -import GHC.ByteOrder (ByteOrder(BigEndian,LittleEndian),targetByteOrder) import qualified Arithmetic.Nat as Nat import qualified Arithmetic.Types as Arithmetic @@ -262,6 +267,16 @@ int16ArrayLE (PrimArray x) = word16ArrayLE (PrimArray x) int16ArrayBE :: PrimArray Int16 -> Int -> Int -> Builder int16ArrayBE (PrimArray x) = word16ArrayBE (PrimArray x) +word128ArrayLE :: PrimArray Word128 -> Int -> Int -> Builder +word128ArrayLE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of + LittleEndian -> bytes (Bytes (ByteArray arr) (soff0 * 16) (slen0 * 16)) + BigEndian -> word128ArraySwap src soff0 slen0 + +word128ArrayBE :: PrimArray Word128 -> Int -> Int -> Builder +word128ArrayBE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of + BigEndian -> bytes (Bytes (ByteArray arr) (soff0 * 16) (slen0 * 16)) + LittleEndian -> word128ArraySwap 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)) @@ -350,6 +365,53 @@ word64ArraySwap src soff0 slen0 = go (soff + 8) send dst (doff + 8) else pure doff +word128ArraySwap :: PrimArray Word128 -> Int -> Int -> Builder +word128ArraySwap src soff0 slen0 = + fromFunction (slen0 * 16) (go (soff0 * 16) ((soff0 + slen0) * 16)) + 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 v0 = PM.indexPrimArray (asWord8s src) soff + v1 = PM.indexPrimArray (asWord8s src) (soff + 1) + v2 = PM.indexPrimArray (asWord8s src) (soff + 2) + v3 = PM.indexPrimArray (asWord8s src) (soff + 3) + v4 = PM.indexPrimArray (asWord8s src) (soff + 4) + v5 = PM.indexPrimArray (asWord8s src) (soff + 5) + v6 = PM.indexPrimArray (asWord8s src) (soff + 6) + v7 = PM.indexPrimArray (asWord8s src) (soff + 7) + v8 = PM.indexPrimArray (asWord8s src) (soff + 8) + v9 = PM.indexPrimArray (asWord8s src) (soff + 9) + v10 = PM.indexPrimArray (asWord8s src) (soff + 10) + v11 = PM.indexPrimArray (asWord8s src) (soff + 11) + v12 = PM.indexPrimArray (asWord8s src) (soff + 12) + v13 = PM.indexPrimArray (asWord8s src) (soff + 13) + v14 = PM.indexPrimArray (asWord8s src) (soff + 14) + v15 = PM.indexPrimArray (asWord8s src) (soff + 15) + PM.writeByteArray dst doff v15 + PM.writeByteArray dst (doff + 1) v14 + PM.writeByteArray dst (doff + 2) v13 + PM.writeByteArray dst (doff + 3) v12 + PM.writeByteArray dst (doff + 4) v11 + PM.writeByteArray dst (doff + 5) v10 + PM.writeByteArray dst (doff + 6) v9 + PM.writeByteArray dst (doff + 7) v8 + PM.writeByteArray dst (doff + 8) v7 + PM.writeByteArray dst (doff + 9) v6 + PM.writeByteArray dst (doff + 10) v5 + PM.writeByteArray dst (doff + 11) v4 + PM.writeByteArray dst (doff + 12) v3 + PM.writeByteArray dst (doff + 13) v2 + PM.writeByteArray dst (doff + 14) v1 + PM.writeByteArray dst (doff + 15) v0 + go (soff + 16) send dst (doff + 16) + else pure doff + asWord8s :: PrimArray a -> PrimArray Word8 asWord8s (PrimArray x) = PrimArray x @@ -595,6 +657,11 @@ int32BE w = fromBounded Nat.constant (Bounded.int32BE w) int16BE :: Int16 -> Builder int16BE w = fromBounded Nat.constant (Bounded.int16BE w) +-- | Requires exactly 16 bytes. Dump the octets of a 128-bit +-- word in a little-endian fashion. +word128LE :: Word128 -> Builder +word128LE w = fromBounded Nat.constant (Bounded.word128LE w) + -- | Requires exactly 8 bytes. Dump the octets of a 64-bit -- word in a little-endian fashion. word64LE :: Word64 -> Builder @@ -615,6 +682,11 @@ word16LE w = fromBounded Nat.constant (Bounded.word16LE w) word64BE :: Word64 -> Builder word64BE w = fromBounded Nat.constant (Bounded.word64BE 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 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 449f9bd..8f8966c 100644 --- a/src/Data/ByteArray/Builder/Bounded.hs +++ b/src/Data/ByteArray/Builder/Bounded.hs @@ -55,6 +55,7 @@ module Data.ByteArray.Builder.Bounded -- *** One , word8 -- **** Big Endian + , word128BE , word64BE , word32BE , word16BE @@ -62,6 +63,7 @@ module Data.ByteArray.Builder.Bounded , int32BE , int16BE -- **** Little Endian + , word128LE , word64LE , word32LE , word16LE @@ -81,6 +83,7 @@ import Data.ByteArray.Builder.Bounded.Unsafe (Builder(..)) import Data.Char (ord) import Data.Primitive import Data.Primitive.ByteArray.Offset (MutableByteArrayOffset(..)) +import Data.WideWord (Word128(Word128)) import GHC.Exts import GHC.Int (Int64(I64#),Int32(I32#),Int16(I16#),Int8(I8#)) import GHC.ST (ST(ST)) @@ -609,6 +612,12 @@ int32LE (I32# i) = word32LE (W32# (int2Word# i)) int16LE :: Int16 -> Builder 2 int16LE (I16# i) = word16LE (W16# (int2Word# i)) +word128LE :: Word128 -> Builder 16 +word128LE (Word128 hi lo) = append (word64LE lo) (word64LE hi) + +word128BE :: Word128 -> Builder 16 +word128BE (Word128 hi lo) = append (word64BE hi) (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 5fe9994..012f292 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -3,14 +3,18 @@ {-# language TypeApplications #-} {-# language OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +import Control.Applicative (liftA2) import Control.Monad.ST (runST) import Data.ByteArray.Builder import Data.Primitive (PrimArray) import Data.Word import Data.Char (ord,chr) import Data.Primitive (ByteArray) +import Data.WideWord (Word128(Word128)) import Test.Tasty (defaultMain,testGroup,TestTree) -import Test.QuickCheck ((===)) +import Test.QuickCheck ((===),Arbitrary) import Text.Printf (printf) import Test.Tasty.HUnit ((@=?)) @@ -164,6 +168,16 @@ tests = testGroup "Tests" in runConcat 1 (foldMap word64BE xs) === runConcat 1 (word64ArrayBE ys 0 (Prelude.length xs)) + , TQC.testProperty "word128ArrayLE" $ \(xs :: [Word128]) -> + let ys = Exts.fromList xs :: PrimArray Word128 + in runConcat 1 (foldMap word128LE xs) + === + runConcat 1 (word128ArrayLE ys 0 (Prelude.length xs)) + , TQC.testProperty "word128ArrayBE" $ \(xs :: [Word128]) -> + let ys = Exts.fromList xs :: PrimArray Word128 + in runConcat 1 (foldMap word128BE xs) + === + runConcat 1 (word128ArrayBE ys 0 (Prelude.length xs)) ] , testGroup "alternate" [ TQC.testProperty "HexWord64" $ \x y -> @@ -193,3 +207,6 @@ showWord64PaddedUpperHex = printf "%016X" runConcat :: Int -> Builder -> ByteArray runConcat n = Chunks.concat . run n + +instance Arbitrary Word128 where + arbitrary = liftA2 Word128 TQC.arbitrary TQC.arbitrary