From 71fa47a8ee7c213c2cf2b6dd96028f7b4ad7d700 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Wed, 15 Jan 2020 16:50:24 -0500 Subject: [PATCH] Move Data.Bytes.Chunks into byteslice --- small-bytearray-builder.cabal | 5 +- src/Data/Bytes/Chunks.hs | 112 ---------------------------------- test/Main.hs | 25 +------- 3 files changed, 4 insertions(+), 138 deletions(-) delete mode 100644 src/Data/Bytes/Chunks.hs diff --git a/small-bytearray-builder.cabal b/small-bytearray-builder.cabal index fcb0c52..01bb15f 100644 --- a/small-bytearray-builder.cabal +++ b/small-bytearray-builder.cabal @@ -36,14 +36,15 @@ flag checked library exposed-modules: - Data.Bytes.Chunks Data.ByteArray.Builder Data.ByteArray.Builder.Unsafe Data.ByteArray.Builder.Bounded Data.ByteArray.Builder.Bounded.Unsafe + reexported-modules: + Data.Bytes.Chunks build-depends: , base >=4.12.0.0 && <5 - , byteslice >=0.1 && <0.3 + , byteslice >=0.2 && <0.3 , bytestring >=0.10.8.2 && <0.11 , natural-arithmetic >=0.1 && <0.2 , primitive-offset >=0.2 && <0.3 diff --git a/src/Data/Bytes/Chunks.hs b/src/Data/Bytes/Chunks.hs deleted file mode 100644 index 816a8ab..0000000 --- a/src/Data/Bytes/Chunks.hs +++ /dev/null @@ -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 diff --git a/test/Main.hs b/test/Main.hs index f39cec3..79bf221 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -8,14 +8,12 @@ import Control.Applicative (liftA2) import Control.Monad.ST (runST) import Data.ByteArray.Builder -import Data.Bytes.Types (Bytes(Bytes),MutableBytes(MutableBytes)) -import Data.Bytes.Chunks (Chunks(ChunksNil,ChunksCons)) +import Data.Bytes.Types (MutableBytes(MutableBytes)) import Data.Primitive (PrimArray) import Data.Word import Data.Char (ord,chr) import Data.IORef (IORef,newIORef,readIORef,writeIORef) import Data.Primitive (ByteArray) -import Data.Proxy (Proxy(..)) import Data.WideWord (Word128(Word128)) import Test.Tasty (defaultMain,testGroup,TestTree) import Test.QuickCheck ((===),Arbitrary) @@ -33,7 +31,6 @@ import qualified Data.Primitive as PM import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified GHC.Exts as Exts -import qualified Test.QuickCheck.Classes as QCC import qualified Test.Tasty.HUnit as THU import qualified Test.Tasty.QuickCheck as TQC @@ -206,11 +203,6 @@ tests = testGroup "Tests" === 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" [ THU.testCase "A" $ do ref <- newIORef [] @@ -252,21 +244,6 @@ bytesOntoRef !ref (MutableBytes buf off len) = do dst' <- PM.unsafeFreezeByteArray 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 n w = runST $ do m <- PM.newByteArray n