rhi/bytebuild
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add big-endian and little-endian parsers for Word128

Browse source
This commit is contained in:
Andrew Martin 2019-10-17 11:26:14 -04:00
parent d94cf3d000
commit 00f437f8cc
5 changed files with 110 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
CHANGELOG.md
View file

@ -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

6
small-bytearray-builder.cabal
View file

@ -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

76
src/Data/ByteArray/Builder.hs
View file

@ -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

9
src/Data/ByteArray/Builder/Bounded.hs
View file

@ -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

19
test/Main.hs
View file

@ -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