Move Data.Bytes.Chunks into byteslice

This commit is contained in:
Andrew Martin 2020-01-15 16:50:24 -05:00
parent d496f23fd8
commit 71fa47a8ee
3 changed files with 4 additions and 138 deletions

View file

@ -36,14 +36,15 @@ flag checked
library library
exposed-modules: exposed-modules:
Data.Bytes.Chunks
Data.ByteArray.Builder Data.ByteArray.Builder
Data.ByteArray.Builder.Unsafe Data.ByteArray.Builder.Unsafe
Data.ByteArray.Builder.Bounded Data.ByteArray.Builder.Bounded
Data.ByteArray.Builder.Bounded.Unsafe Data.ByteArray.Builder.Bounded.Unsafe
reexported-modules:
Data.Bytes.Chunks
build-depends: build-depends:
, base >=4.12.0.0 && <5 , base >=4.12.0.0 && <5
, byteslice >=0.1 && <0.3 , byteslice >=0.2 && <0.3
, bytestring >=0.10.8.2 && <0.11 , bytestring >=0.10.8.2 && <0.11
, natural-arithmetic >=0.1 && <0.2 , natural-arithmetic >=0.1 && <0.2
, primitive-offset >=0.2 && <0.3 , primitive-offset >=0.2 && <0.3

View file

@ -1,112 +0,0 @@
{-# language BangPatterns #-}
{-# language DerivingStrategies #-}
{-# language DuplicateRecordFields #-}
{-# language TypeFamilies #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language NamedFieldPuns #-}
module Data.Bytes.Chunks
( Chunks(..)
, concat
, reverse
, reverseOnto
, length
) where
import Prelude hiding (length,concat,reverse)
import GHC.ST (ST(..))
import Data.Bytes.Types (Bytes(Bytes))
import Data.Primitive (ByteArray(..),MutableByteArray(..))
import GHC.Exts (ByteArray#,MutableByteArray#)
import GHC.Exts (Int#,State#,Int(I#),(+#))
import Control.Monad.ST.Run (runByteArrayST)
import qualified GHC.Exts as Exts
import qualified Data.Primitive as PM
import qualified Data.Bytes.Types as B
data Chunks
= ChunksCons {-# UNPACK #-} !Bytes !Chunks
| ChunksNil
deriving stock (Show)
instance Semigroup Chunks where
ChunksNil <> a = a
cs@(ChunksCons _ _) <> ChunksNil = cs
as@(ChunksCons _ _) <> bs@(ChunksCons _ _) =
reverseOnto bs (reverse as)
instance Monoid Chunks where
mempty = ChunksNil
instance Eq Chunks where
-- TODO: There is a more efficient way to do this, but
-- it is tedious.
a == b = concat a == concat b
concat :: Chunks -> ByteArray
concat x = ByteArray (concat# x)
concat# :: Chunks -> ByteArray#
{-# noinline concat# #-}
concat# ChunksNil = case mempty of {ByteArray x -> x}
concat# (ChunksCons (Bytes{array=c,offset=coff,length=szc}) cs) = case cs of
ChunksNil -> case c of {ByteArray x -> x}
ChunksCons (Bytes{array=d,offset=doff,length=szd}) ds ->
unBa $ runByteArrayST $ do
let szboth = szc + szd
len = chunksLengthGo szboth ds
dst <- PM.newByteArray len
PM.copyByteArray dst 0 c coff szc
PM.copyByteArray dst szc d doff szd
_ <- copy dst szboth ds
PM.unsafeFreezeByteArray dst
length :: Chunks -> Int
length = chunksLengthGo 0
chunksLengthGo :: Int -> Chunks -> Int
chunksLengthGo !n ChunksNil = n
chunksLengthGo !n (ChunksCons (Bytes{B.length=len}) cs) =
chunksLengthGo (n + len) cs
-- | Copy the contents of the chunks into a mutable array.
-- Precondition: The destination must have enough space to
-- house the contents. This is not checked.
copy ::
MutableByteArray s -- ^ Destination
-> Int -- ^ Destination offset
-> Chunks -- ^ Source
-> ST s Int -- ^ Returns the next index into the destination after the payload
{-# inline copy #-}
copy (MutableByteArray dst) (I# off) cs = ST
(\s0 -> case copy# dst off cs s0 of
(# s1, nextOff #) -> (# s1, I# nextOff #)
)
copy# :: MutableByteArray# s -> Int# -> Chunks -> State# s -> (# State# s, Int# #)
copy# _ off ChunksNil s0 = (# s0, off #)
copy# marr off (ChunksCons (Bytes{B.array,B.offset,B.length=len}) cs) s0 =
case Exts.copyByteArray# (unBa array) (unI offset) marr off (unI len) s0 of
s1 -> copy# marr (off +# unI len) cs s1
-- | Reverse chunks but not the bytes within each chunk.
reverse :: Chunks -> Chunks
reverse = reverseOnto ChunksNil
-- | Variant of 'reverse' that allows the caller to provide
-- an initial list of chunks that the reversed chunks will
-- be pushed onto.
reverseOnto :: Chunks -> Chunks -> Chunks
reverseOnto !x ChunksNil = x
reverseOnto !x (ChunksCons y ys) =
reverseOnto (ChunksCons y x) ys
unI :: Int -> Int#
unI (I# i) = i
unBa :: ByteArray -> ByteArray#
unBa (ByteArray x) = x

View file

@ -8,14 +8,12 @@
import Control.Applicative (liftA2) import Control.Applicative (liftA2)
import Control.Monad.ST (runST) import Control.Monad.ST (runST)
import Data.ByteArray.Builder import Data.ByteArray.Builder
import Data.Bytes.Types (Bytes(Bytes),MutableBytes(MutableBytes)) import Data.Bytes.Types (MutableBytes(MutableBytes))
import Data.Bytes.Chunks (Chunks(ChunksNil,ChunksCons))
import Data.Primitive (PrimArray) import Data.Primitive (PrimArray)
import Data.Word import Data.Word
import Data.Char (ord,chr) import Data.Char (ord,chr)
import Data.IORef (IORef,newIORef,readIORef,writeIORef) import Data.IORef (IORef,newIORef,readIORef,writeIORef)
import Data.Primitive (ByteArray) import Data.Primitive (ByteArray)
import Data.Proxy (Proxy(..))
import Data.WideWord (Word128(Word128)) import Data.WideWord (Word128(Word128))
import Test.Tasty (defaultMain,testGroup,TestTree) import Test.Tasty (defaultMain,testGroup,TestTree)
import Test.QuickCheck ((===),Arbitrary) import Test.QuickCheck ((===),Arbitrary)
@ -33,7 +31,6 @@ import qualified Data.Primitive as PM
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding as TE
import qualified GHC.Exts as Exts import qualified GHC.Exts as Exts
import qualified Test.QuickCheck.Classes as QCC
import qualified Test.Tasty.HUnit as THU import qualified Test.Tasty.HUnit as THU
import qualified Test.Tasty.QuickCheck as TQC import qualified Test.Tasty.QuickCheck as TQC
@ -206,11 +203,6 @@ tests = testGroup "Tests"
=== ===
pack (showWord64PaddedUpperHex x <> showWord64PaddedUpperHex y) pack (showWord64PaddedUpperHex x <> showWord64PaddedUpperHex y)
] ]
, testGroup "Chunks"
[ lawsToTest (QCC.eqLaws (Proxy :: Proxy Chunks))
, lawsToTest (QCC.semigroupLaws (Proxy :: Proxy Chunks))
, lawsToTest (QCC.monoidLaws (Proxy :: Proxy Chunks))
]
, testGroup "putMany" , testGroup "putMany"
[ THU.testCase "A" $ do [ THU.testCase "A" $ do
ref <- newIORef [] ref <- newIORef []
@ -252,21 +244,6 @@ bytesOntoRef !ref (MutableBytes buf off len) = do
dst' <- PM.unsafeFreezeByteArray dst dst' <- PM.unsafeFreezeByteArray dst
writeIORef ref (rs ++ [dst']) writeIORef ref (rs ++ [dst'])
instance Arbitrary Chunks where
arbitrary = do
xs :: [[Word8]] <- TQC.arbitrary
let ys = map
(\x -> Exts.fromList ([255] ++ x ++ [255]))
xs
zs = foldr
(\b cs ->
ChunksCons (Bytes b 1 (PM.sizeofByteArray b - 2)) cs
) ChunksNil ys
pure zs
lawsToTest :: QCC.Laws -> TestTree
lawsToTest (QCC.Laws name pairs) = testGroup name (map (uncurry TQC.testProperty) pairs)
replicateByte :: Int -> Word8 -> ByteArray replicateByte :: Int -> Word8 -> ByteArray
replicateByte n w = runST $ do replicateByte n w = runST $ do
m <- PM.newByteArray n m <- PM.newByteArray n