array-chunks 0.1.4.0 → 0.1.4.1
raw patch · 5 files changed
+402/−345 lines, 5 filessetup-changednew-uploaderPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Data.Chunks: instance GHC.Exts.IsList (Data.Chunks.Chunks a)
+ Data.Chunks: instance GHC.IsList.IsList (Data.Chunks.Chunks a)
Files
- CHANGELOG.md +4/−0
- Setup.hs +0/−2
- array-chunks.cabal +34/−25
- src/Data/Chunks.hs +311/−260
- test/Main.hs +53/−58
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for array-chunks +## 0.1.4.1 -- 2024-02-05++* Update package metadata.+ ## 0.1.4.0 -- 2023-08-30 * Add `constructN` functions that use numbers instead of tuple names
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
array-chunks.cabal view
@@ -1,43 +1,52 @@-cabal-version: 2.2-name: array-chunks-version: 0.1.4.0-synopsis: Lists of chunks+cabal-version: 2.2+name: array-chunks+version: 0.1.4.1+synopsis: Lists of chunks description: Lists of chunks. This is similar to the Cons List provided by `Data.List`, but it is more useful as a target for a builder since the chunks are cache coherent.-homepage: https://github.com/andrewthad/array-chunks-bug-reports: https://github.com/andrewthad/array-chunks/issues-license: BSD-3-Clause-license-file: LICENSE-author: Andrew Martin-maintainer: andrew.thaddeus@gmail.com-copyright: 2019 Andrew Martin-category: Data-extra-source-files: CHANGELOG.md +homepage: https://github.com/byteverse/array-chunks+bug-reports: https://github.com/byteverse/array-chunks/issues+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: amartin@layer3com.com+copyright: 2019 Andrew Martin+category: Data+extra-doc-files: CHANGELOG.md++common build-settings+ default-language: Haskell2010+ ghc-options: -Wall -Wunused-packages+ library+ import: build-settings exposed-modules: Data.Chunks build-depends:- , base >=4.12 && <5- , primitive >=0.6.4 && <0.10- , run-st >=0.1 && <0.2- hs-source-dirs: src- default-language: Haskell2010- ghc-options: -O2 -Wall+ , base >=4.12 && <5+ , primitive >=0.6.4 && <0.10+ , run-st >=0.1 && <0.2 + hs-source-dirs: src+ ghc-options: -O2+ test-suite test- type: exitcode-stdio-1.0+ import: build-settings+ type: exitcode-stdio-1.0 hs-source-dirs: test- main-is: Main.hs+ main-is: Main.hs build-depends:- , QuickCheck , array-chunks , base , primitive- , quickcheck-classes >=0.6.3 && <0.7+ , QuickCheck+ , quickcheck-classes >=0.6.3 && <0.7 , tasty , tasty-hunit , tasty-quickcheck- ghc-options: -Wall -O2- default-language: Haskell2010++source-repository head+ type: git+ location: git://github.com/byteverse/array-chunks.git
src/Data/Chunks.hs view
@@ -1,11 +1,11 @@-{-# language BangPatterns #-}-{-# language DerivingStrategies #-}-{-# language TypeFamilies #-}-{-# language MagicHash #-}-{-# language UnboxedTuples #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnboxedTuples #-} module Data.Chunks- ( Chunks(..)+ ( Chunks (..) , null , reverse , reverseOnto@@ -13,10 +13,13 @@ , copyReverse , concat , concatReverse+ -- * Indexing , index+ -- * Traversals , map'+ -- * Construction , singleton , doubleton@@ -30,6 +33,7 @@ , decupleton , undecupleton , duodecupleton+ -- * Construction Alternate , construct1 , construct2@@ -45,30 +49,30 @@ , construct12 ) where -import Prelude hiding (reverse,concat,null)+import Prelude hiding (concat, null, reverse) -import Data.Primitive (SmallArray(..),SmallMutableArray(..))-import GHC.Exts (IsList,Int#,State#,SmallMutableArray#,Int(I#),(+#),(-#))-import GHC.Exts (SmallArray#)-import GHC.ST (ST(..)) import Control.Monad.ST.Run (runSmallArrayST)+import Data.Primitive (SmallArray (..), SmallMutableArray (..))+import GHC.Exts (Int (I#), Int#, IsList, SmallArray#, SmallMutableArray#, State#, (+#), (-#))+import GHC.ST (ST (..)) -import qualified GHC.Exts as Exts import qualified Data.Foldable as F import qualified Data.Primitive as PM+import qualified GHC.Exts as Exts --- | A list of chunks. This is a foundation on top of--- which efficient builder-like abstractions can be--- implemented. There are no restrictions on the number--- of elements in each chunk, although extremely small--- chunks (singleton or doubleton chunks) may lead to--- poor performance.+{- | A list of chunks. This is a foundation on top of+which efficient builder-like abstractions can be+implemented. There are no restrictions on the number+of elements in each chunk, although extremely small+chunks (singleton or doubleton chunks) may lead to+poor performance.+-} data Chunks a = ChunksCons !(SmallArray a) !(Chunks a) | ChunksNil deriving stock (Show) -instance Eq a => Eq (Chunks a) where+instance (Eq a) => Eq (Chunks a) where (==) = eqChunks instance IsList (Chunks a) where@@ -78,54 +82,57 @@ -- | Are there any elements in the chunked list? null :: Chunks a -> Bool-null = go where+null = go+ where go ChunksNil = True go (ChunksCons x xs) = case PM.sizeofSmallArray x of 0 -> go xs _ -> False --- | Indexing into the chunked list, returning @Nothing@ if there--- are not enough elements.+{- | Indexing into the chunked list, returning @Nothing@ if there+are not enough elements.+-} index :: Chunks a -> Int -> Maybe a-index cs0 !ix0 = go cs0 ix0 where+index cs0 !ix0 = go cs0 ix0+ where go ChunksNil !_ = Nothing go (ChunksCons x xs) !ix =- let !len = PM.sizeofSmallArray x in- if ix < len- then case PM.indexSmallArray## x ix of- (# v #) -> Just v- else go xs (ix - len)+ let !len = PM.sizeofSmallArray x+ in if ix < len+ then case PM.indexSmallArray## x ix of+ (# v #) -> Just v+ else go xs (ix - len) chunksToSmallArrayList :: Chunks a -> [SmallArray a] chunksToSmallArrayList ChunksNil = [] chunksToSmallArrayList (ChunksCons x xs) = x : chunksToSmallArrayList xs -eqChunks :: Eq a => Chunks a -> Chunks a -> Bool+eqChunks :: (Eq a) => Chunks a -> Chunks a -> Bool eqChunks ChunksNil cs = allEmpty cs eqChunks (ChunksCons x xs) cs = eqChunksCons x 0 (PM.sizeofSmallArray x) xs cs -- The first argument chunk belongs to the first argument chunks.--- It is its head. -eqChunksCons :: Eq a => SmallArray a -> Int -> Int -> Chunks a -> Chunks a -> Bool+-- It is its head.+eqChunksCons :: (Eq a) => SmallArray a -> Int -> Int -> Chunks a -> Chunks a -> Bool eqChunksCons !_ !_ !len xs ChunksNil = case len of 0 -> allEmpty xs _ -> False eqChunksCons x !off !len xs (ChunksCons y ys) = eqChunksConsBoth x off len y 0 (PM.sizeofSmallArray y) xs ys -eqChunksConsBoth :: Eq a => SmallArray a -> Int -> Int -> SmallArray a -> Int -> Int -> Chunks a -> Chunks a -> Bool+eqChunksConsBoth :: (Eq a) => SmallArray a -> Int -> Int -> SmallArray a -> Int -> Int -> Chunks a -> Chunks a -> Bool eqChunksConsBoth !xh !xoff !xlen !yh !yoff !ylen !xt !yt = case compare xlen ylen of LT -> eqRange xh xoff yh yoff xlen && eqChunksCons yh (yoff + xlen) (ylen - xlen) yt xt GT -> eqRange xh xoff yh yoff ylen && eqChunksCons xh (xoff + ylen) (xlen - ylen) xt yt EQ -> eqRange xh xoff yh yoff xlen && eqChunks xt yt -eqRange :: Eq a => SmallArray a -> Int -> SmallArray a -> Int -> Int -> Bool+eqRange :: (Eq a) => SmallArray a -> Int -> SmallArray a -> Int -> Int -> Bool eqRange !xs !xoff !ys !yoff !len | len == 0 = True | otherwise =- PM.indexSmallArray xs xoff == PM.indexSmallArray ys yoff &&- eqRange xs (xoff + 1) ys (yoff + 1) (len - 1)+ PM.indexSmallArray xs xoff == PM.indexSmallArray ys yoff+ && eqRange xs (xoff + 1) ys (yoff + 1) (len - 1) allEmpty :: Chunks a -> Bool allEmpty ChunksNil = True@@ -143,27 +150,29 @@ mempty = ChunksNil instance Foldable Chunks where- {-# inline foldl' #-}- {-# inline foldr #-}- {-# inline length #-}+ {-# INLINE foldl' #-}+ {-# INLINE foldr #-}+ {-# INLINE length #-} foldl' = chunksFoldl' foldr = chunksFoldr length = chunksLength chunksFoldl' :: (b -> a -> b) -> b -> Chunks a -> b-{-# inline chunksFoldl' #-}-chunksFoldl' f = go where+{-# INLINE chunksFoldl' #-}+chunksFoldl' f = go+ where go !acc ChunksNil = acc go !acc (ChunksCons x cs) = go (F.foldl' f acc x) cs chunksFoldr :: (a -> b -> b) -> b -> Chunks a -> b-{-# inline chunksFoldr #-}-chunksFoldr f z0 = go where+{-# INLINE chunksFoldr #-}+chunksFoldr f z0 = go+ where go ChunksNil = z0 go (ChunksCons x cs) = F.foldr f (go cs) x chunksLength :: Chunks a -> Int-{-# inline chunksLength #-}+{-# INLINE chunksLength #-} chunksLength = chunksLengthGo 0 chunksLengthGo :: Int -> Chunks a -> Int@@ -171,86 +180,100 @@ chunksLengthGo !n (ChunksCons c cs) = chunksLengthGo (n + PM.sizeofSmallArray c) cs --- | Reverse chunks but not the elements within each--- chunk.------ >>> reverse [[42,17,94],[6,12],[3,14]]--- [[3,14],[6,12],[42,17,94]]+{- | Reverse chunks but not the elements within each+chunk.++>>> reverse [[42,17,94],[6,12],[3,14]]+[[3,14],[6,12],[42,17,94]]+-} reverse :: Chunks a -> Chunks a 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 [[15],[12,4]] [[42,17,94],[6,12],[3,14]]--- [[3,14],[6,12],[42,17,94],[15],[12,4]]+{- | Variant of 'reverse' that allows the caller to provide+an initial list of chunks that the reversed chunks will+be pushed onto.++>>> reverseOnto [[15],[12,4]] [[42,17,94],[6,12],[3,14]]+[[3,14],[6,12],[42,17,94],[15],[12,4]]+-} reverseOnto :: Chunks a -> Chunks a -> Chunks a reverseOnto !x ChunksNil = x reverseOnto !x (ChunksCons y ys) = reverseOnto (ChunksCons y x) ys --- | 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.------ > dest (before): [x,x,x,x,x,x,x,x,x,x,x,x]--- > copy dest 2 [[X,Y,Z],[A,B],[C,D]] (returns 9)--- > dest (after): [x,x,X,Y,Z,A,B,C,D,x,x,x]+{- | 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.++> dest (before): [x,x,x,x,x,x,x,x,x,x,x,x]+> copy dest 2 [[X,Y,Z],[A,B],[C,D]] (returns 9)+> dest (after): [x,x,X,Y,Z,A,B,C,D,x,x,x]+-} copy ::- SmallMutableArray s a -- ^ Destination- -> Int -- ^ Destination offset- -> Chunks a -- ^ Source- -> ST s Int -- ^ Returns the next index into the destination after the payload-{-# inline copy #-}-copy (SmallMutableArray dst) (I# off) cs = ST- (\s0 -> case copy# dst off cs s0 of- (# s1, nextOff #) -> (# s1, I# nextOff #)- )+ -- | Destination+ SmallMutableArray s a ->+ -- | Destination offset+ Int ->+ -- | Source+ Chunks a ->+ -- | Returns the next index into the destination after the payload+ ST s Int+{-# INLINE copy #-}+copy (SmallMutableArray dst) (I# off) cs =+ ST+ ( \s0 -> case copy# dst off cs s0 of+ (# s1, nextOff #) -> (# s1, I# nextOff #)+ ) copy# :: SmallMutableArray# s a -> Int# -> Chunks a -> State# s -> (# State# s, Int# #) copy# _ off ChunksNil s0 = (# s0, off #) copy# marr off (ChunksCons (SmallArray c) cs) s0 =- let !sz = Exts.sizeofSmallArray# c in- case Exts.copySmallArray# c 0# marr off sz s0 of- s1 -> copy# marr (off +# sz) cs s1+ let !sz = Exts.sizeofSmallArray# c+ in case Exts.copySmallArray# c 0# marr off sz s0 of+ s1 -> copy# marr (off +# sz) cs s1 --- | Copy the contents of the chunks into a mutable array,--- reversing the order of the chunks. Precondition: The--- destination must have enough space to house the contents.--- This is not checked.------ > dest (before): [x,x,x,x,x,x,x,x,x,x,x,x]--- > copyReverse dest 10 [[X,Y,Z],[A,B],[C,D]] (returns 3)--- > dest (after): [x,x,x,C,D,A,B,X,Y,Z,x,x]+{- | Copy the contents of the chunks into a mutable array,+reversing the order of the chunks. Precondition: The+destination must have enough space to house the contents.+This is not checked.++> dest (before): [x,x,x,x,x,x,x,x,x,x,x,x]+> copyReverse dest 10 [[X,Y,Z],[A,B],[C,D]] (returns 3)+> dest (after): [x,x,x,C,D,A,B,X,Y,Z,x,x]+-} copyReverse ::- SmallMutableArray s a -- ^ Destination- -> Int -- ^ Destination range successor- -> Chunks a -- ^ Source- -> ST s Int -- ^ Returns the next index into the destination after the payload-{-# inline copyReverse #-}-copyReverse (SmallMutableArray dst) (I# off) cs = ST- (\s0 -> case copyReverse# dst off cs s0 of- (# s1, nextOff #) -> (# s1, I# nextOff #)- )+ -- | Destination+ SmallMutableArray s a ->+ -- | Destination range successor+ Int ->+ -- | Source+ Chunks a ->+ -- | Returns the next index into the destination after the payload+ ST s Int+{-# INLINE copyReverse #-}+copyReverse (SmallMutableArray dst) (I# off) cs =+ ST+ ( \s0 -> case copyReverse# dst off cs s0 of+ (# s1, nextOff #) -> (# s1, I# nextOff #)+ ) copyReverse# :: SmallMutableArray# s a -> Int# -> Chunks a -> State# s -> (# State# s, Int# #) copyReverse# _ off ChunksNil s0 = (# s0, off #) copyReverse# marr prevOff (ChunksCons (SmallArray c) cs) s0 = let !sz = Exts.sizeofSmallArray# c- !off = prevOff -# sz in- case Exts.copySmallArray# c 0# marr off sz s0 of- s1 -> copyReverse# marr off cs s1+ !off = prevOff -# sz+ in case Exts.copySmallArray# c 0# marr off sz s0 of+ s1 -> copyReverse# marr off cs s1 concat :: Chunks a -> SmallArray a-{-# inline concat #-}+{-# INLINE concat #-} concat x = SmallArray (concat# x) concat# :: Chunks a -> SmallArray# a-{-# noinline concat# #-}-concat# ChunksNil = case mempty of {SmallArray x -> x}+{-# NOINLINE concat# #-}+concat# ChunksNil = case mempty of SmallArray x -> x concat# (ChunksCons c cs) = case cs of- ChunksNil -> case c of {SmallArray x -> x}+ ChunksNil -> case c of SmallArray x -> x ChunksCons d ds -> unSmallArray $ runSmallArrayST $ do let szc = PM.sizeofSmallArray c szd = PM.sizeofSmallArray d@@ -263,14 +286,14 @@ PM.unsafeFreezeSmallArray dst concatReverse :: Chunks a -> SmallArray a-{-# inline concatReverse #-}+{-# INLINE concatReverse #-} concatReverse x = SmallArray (concatReverse# x) concatReverse# :: Chunks a -> SmallArray# a-{-# noinline concatReverse# #-}-concatReverse# ChunksNil = case mempty of {SmallArray x -> x}+{-# NOINLINE concatReverse# #-}+concatReverse# ChunksNil = case mempty of SmallArray x -> x concatReverse# (ChunksCons c cs) = case cs of- ChunksNil -> case c of {SmallArray x -> x}+ ChunksNil -> case c of SmallArray x -> x ChunksCons d ds -> unSmallArray $ runSmallArrayST $ do let szc = PM.sizeofSmallArray c szd = PM.sizeofSmallArray d@@ -286,241 +309,269 @@ unSmallArray (SmallArray x) = x errorThunk :: a-{-# noinline errorThunk #-}+{-# NOINLINE errorThunk #-} errorThunk = error "Data.Chunks: mistake" --- | Mapping over chunks is a little unusual in that the result--- is just a 'SmallArray'.+{- | Mapping over chunks is a little unusual in that the result+is just a 'SmallArray'.+-} map' :: (a -> b) -> Chunks a -> SmallArray b-{-# inline map' #-}+{-# INLINE map' #-} map' f cs = runSmallArrayST $ do dst <- PM.newSmallArray len errorThunk- !_ <- F.foldlM- ( \ !ix a -> do- let !b = f a- PM.writeSmallArray dst ix b- pure (ix + 1)- ) 0 cs+ !_ <-+ F.foldlM+ ( \ !ix a -> do+ let !b = f a+ PM.writeSmallArray dst ix b+ pure (ix + 1)+ )+ 0+ cs PM.unsafeFreezeSmallArray dst- where+ where !len = chunksLength cs construct1 :: a -> Chunks a-{-# inline construct1 #-}+{-# INLINE construct1 #-} construct1 = singleton construct2 :: a -> a -> Chunks a-{-# inline construct2 #-}+{-# INLINE construct2 #-} construct2 = doubleton construct3 :: a -> a -> a -> Chunks a-{-# inline construct3 #-}+{-# INLINE construct3 #-} construct3 = tripleton construct4 :: a -> a -> a -> a -> Chunks a-{-# inline construct4 #-}+{-# INLINE construct4 #-} construct4 = quadrupleton construct5 :: a -> a -> a -> a -> a -> Chunks a-{-# inline construct5 #-}+{-# INLINE construct5 #-} construct5 = quintupleton construct6 :: a -> a -> a -> a -> a -> a -> Chunks a-{-# inline construct6 #-}+{-# INLINE construct6 #-} construct6 = sextupleton construct7 :: a -> a -> a -> a -> a -> a -> a -> Chunks a-{-# inline construct7 #-}+{-# INLINE construct7 #-} construct7 = septupleton construct8 :: a -> a -> a -> a -> a -> a -> a -> a -> Chunks a-{-# inline construct8 #-}+{-# INLINE construct8 #-} construct8 = octupleton construct9 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> Chunks a-{-# inline construct9 #-}+{-# INLINE construct9 #-} construct9 = nonupleton construct10 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> Chunks a-{-# inline construct10 #-}+{-# INLINE construct10 #-} construct10 = decupleton construct11 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> Chunks a-{-# inline construct11 #-}+{-# INLINE construct11 #-} construct11 = undecupleton construct12 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> Chunks a-{-# inline construct12 #-}+{-# INLINE construct12 #-} construct12 = duodecupleton -- | Create chunks with 1 element. singleton :: a -> Chunks a-{-# inline singleton #-}-singleton a = ChunksCons- ( runSmallArrayST (PM.newSmallArray 1 a >>= PM.unsafeFreezeSmallArray)- ) ChunksNil+{-# INLINE singleton #-}+singleton a =+ ChunksCons+ ( runSmallArrayST (PM.newSmallArray 1 a >>= PM.unsafeFreezeSmallArray)+ )+ ChunksNil -- | Create chunks with 2 elements. doubleton :: a -> a -> Chunks a-{-# inline doubleton #-}-doubleton a b = ChunksCons- ( runSmallArrayST $ do- dst <- PM.newSmallArray 2 a- PM.writeSmallArray dst 1 b- PM.unsafeFreezeSmallArray dst- ) ChunksNil+{-# INLINE doubleton #-}+doubleton a b =+ ChunksCons+ ( runSmallArrayST $ do+ dst <- PM.newSmallArray 2 a+ PM.writeSmallArray dst 1 b+ PM.unsafeFreezeSmallArray dst+ )+ ChunksNil -- | Create chunks with 3 elements. tripleton :: a -> a -> a -> Chunks a-{-# inline tripleton #-}-tripleton a b c = ChunksCons- ( runSmallArrayST $ do- dst <- PM.newSmallArray 3 a- PM.writeSmallArray dst 1 b- PM.writeSmallArray dst 2 c- PM.unsafeFreezeSmallArray dst- ) ChunksNil+{-# INLINE tripleton #-}+tripleton a b c =+ ChunksCons+ ( runSmallArrayST $ do+ dst <- PM.newSmallArray 3 a+ PM.writeSmallArray dst 1 b+ PM.writeSmallArray dst 2 c+ PM.unsafeFreezeSmallArray dst+ )+ ChunksNil -- | Create chunks with 4 elements. quadrupleton :: a -> a -> a -> a -> Chunks a-{-# inline quadrupleton #-}-quadrupleton a b c d = ChunksCons- ( runSmallArrayST $ do- dst <- PM.newSmallArray 4 a- PM.writeSmallArray dst 1 b- PM.writeSmallArray dst 2 c- PM.writeSmallArray dst 3 d- PM.unsafeFreezeSmallArray dst- ) ChunksNil+{-# INLINE quadrupleton #-}+quadrupleton a b c d =+ ChunksCons+ ( runSmallArrayST $ do+ dst <- PM.newSmallArray 4 a+ PM.writeSmallArray dst 1 b+ PM.writeSmallArray dst 2 c+ PM.writeSmallArray dst 3 d+ PM.unsafeFreezeSmallArray dst+ )+ ChunksNil -- | Create chunks with 5 elements. quintupleton :: a -> a -> a -> a -> a -> Chunks a-{-# inline quintupleton #-}-quintupleton a b c d e = ChunksCons- ( runSmallArrayST $ do- dst <- PM.newSmallArray 5 a- PM.writeSmallArray dst 1 b- PM.writeSmallArray dst 2 c- PM.writeSmallArray dst 3 d- PM.writeSmallArray dst 4 e- PM.unsafeFreezeSmallArray dst- ) ChunksNil+{-# INLINE quintupleton #-}+quintupleton a b c d e =+ ChunksCons+ ( runSmallArrayST $ do+ dst <- PM.newSmallArray 5 a+ PM.writeSmallArray dst 1 b+ PM.writeSmallArray dst 2 c+ PM.writeSmallArray dst 3 d+ PM.writeSmallArray dst 4 e+ PM.unsafeFreezeSmallArray dst+ )+ ChunksNil -- | Create chunks with 6 elements. sextupleton :: a -> a -> a -> a -> a -> a -> Chunks a-{-# inline sextupleton #-}-sextupleton a b c d e f = ChunksCons- ( runSmallArrayST $ do- dst <- PM.newSmallArray 6 a- PM.writeSmallArray dst 1 b- PM.writeSmallArray dst 2 c- PM.writeSmallArray dst 3 d- PM.writeSmallArray dst 4 e- PM.writeSmallArray dst 5 f- PM.unsafeFreezeSmallArray dst- ) ChunksNil+{-# INLINE sextupleton #-}+sextupleton a b c d e f =+ ChunksCons+ ( runSmallArrayST $ do+ dst <- PM.newSmallArray 6 a+ PM.writeSmallArray dst 1 b+ PM.writeSmallArray dst 2 c+ PM.writeSmallArray dst 3 d+ PM.writeSmallArray dst 4 e+ PM.writeSmallArray dst 5 f+ PM.unsafeFreezeSmallArray dst+ )+ ChunksNil -- | Create chunks with 7 elements. septupleton :: a -> a -> a -> a -> a -> a -> a -> Chunks a-{-# inline septupleton #-}-septupleton a b c d e f g = ChunksCons- ( runSmallArrayST $ do- dst <- PM.newSmallArray 7 a- PM.writeSmallArray dst 1 b- PM.writeSmallArray dst 2 c- PM.writeSmallArray dst 3 d- PM.writeSmallArray dst 4 e- PM.writeSmallArray dst 5 f- PM.writeSmallArray dst 6 g- PM.unsafeFreezeSmallArray dst- ) ChunksNil+{-# INLINE septupleton #-}+septupleton a b c d e f g =+ ChunksCons+ ( runSmallArrayST $ do+ dst <- PM.newSmallArray 7 a+ PM.writeSmallArray dst 1 b+ PM.writeSmallArray dst 2 c+ PM.writeSmallArray dst 3 d+ PM.writeSmallArray dst 4 e+ PM.writeSmallArray dst 5 f+ PM.writeSmallArray dst 6 g+ PM.unsafeFreezeSmallArray dst+ )+ ChunksNil -- | Create chunks with 8 elements. octupleton :: a -> a -> a -> a -> a -> a -> a -> a -> Chunks a-{-# inline octupleton #-}-octupleton a b c d e f g h = ChunksCons- ( runSmallArrayST $ do- dst <- PM.newSmallArray 8 a- PM.writeSmallArray dst 1 b- PM.writeSmallArray dst 2 c- PM.writeSmallArray dst 3 d- PM.writeSmallArray dst 4 e- PM.writeSmallArray dst 5 f- PM.writeSmallArray dst 6 g- PM.writeSmallArray dst 7 h- PM.unsafeFreezeSmallArray dst- ) ChunksNil+{-# INLINE octupleton #-}+octupleton a b c d e f g h =+ ChunksCons+ ( runSmallArrayST $ do+ dst <- PM.newSmallArray 8 a+ PM.writeSmallArray dst 1 b+ PM.writeSmallArray dst 2 c+ PM.writeSmallArray dst 3 d+ PM.writeSmallArray dst 4 e+ PM.writeSmallArray dst 5 f+ PM.writeSmallArray dst 6 g+ PM.writeSmallArray dst 7 h+ PM.unsafeFreezeSmallArray dst+ )+ ChunksNil -- | Create chunks with 9 elements. nonupleton :: a -> a -> a -> a -> a -> a -> a -> a -> a -> Chunks a-{-# inline nonupleton #-}-nonupleton a b c d e f g h i = ChunksCons- ( runSmallArrayST $ do- dst <- PM.newSmallArray 9 a- PM.writeSmallArray dst 1 b- PM.writeSmallArray dst 2 c- PM.writeSmallArray dst 3 d- PM.writeSmallArray dst 4 e- PM.writeSmallArray dst 5 f- PM.writeSmallArray dst 6 g- PM.writeSmallArray dst 7 h- PM.writeSmallArray dst 8 i- PM.unsafeFreezeSmallArray dst- ) ChunksNil+{-# INLINE nonupleton #-}+nonupleton a b c d e f g h i =+ ChunksCons+ ( runSmallArrayST $ do+ dst <- PM.newSmallArray 9 a+ PM.writeSmallArray dst 1 b+ PM.writeSmallArray dst 2 c+ PM.writeSmallArray dst 3 d+ PM.writeSmallArray dst 4 e+ PM.writeSmallArray dst 5 f+ PM.writeSmallArray dst 6 g+ PM.writeSmallArray dst 7 h+ PM.writeSmallArray dst 8 i+ PM.unsafeFreezeSmallArray dst+ )+ ChunksNil -- | Create chunks with 10 elements. decupleton :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> Chunks a-{-# inline decupleton #-}-decupleton a b c d e f g h i j = ChunksCons- ( runSmallArrayST $ do- dst <- PM.newSmallArray 10 a- PM.writeSmallArray dst 1 b- PM.writeSmallArray dst 2 c- PM.writeSmallArray dst 3 d- PM.writeSmallArray dst 4 e- PM.writeSmallArray dst 5 f- PM.writeSmallArray dst 6 g- PM.writeSmallArray dst 7 h- PM.writeSmallArray dst 8 i- PM.writeSmallArray dst 9 j- PM.unsafeFreezeSmallArray dst- ) ChunksNil+{-# INLINE decupleton #-}+decupleton a b c d e f g h i j =+ ChunksCons+ ( runSmallArrayST $ do+ dst <- PM.newSmallArray 10 a+ PM.writeSmallArray dst 1 b+ PM.writeSmallArray dst 2 c+ PM.writeSmallArray dst 3 d+ PM.writeSmallArray dst 4 e+ PM.writeSmallArray dst 5 f+ PM.writeSmallArray dst 6 g+ PM.writeSmallArray dst 7 h+ PM.writeSmallArray dst 8 i+ PM.writeSmallArray dst 9 j+ PM.unsafeFreezeSmallArray dst+ )+ ChunksNil -- | Create chunks with 11 elements. undecupleton :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> Chunks a-{-# inline undecupleton #-}-undecupleton a b c d e f g h i j k = ChunksCons- ( runSmallArrayST $ do- dst <- PM.newSmallArray 11 a- PM.writeSmallArray dst 1 b- PM.writeSmallArray dst 2 c- PM.writeSmallArray dst 3 d- PM.writeSmallArray dst 4 e- PM.writeSmallArray dst 5 f- PM.writeSmallArray dst 6 g- PM.writeSmallArray dst 7 h- PM.writeSmallArray dst 8 i- PM.writeSmallArray dst 9 j- PM.writeSmallArray dst 10 k- PM.unsafeFreezeSmallArray dst- ) ChunksNil+{-# INLINE undecupleton #-}+undecupleton a b c d e f g h i j k =+ ChunksCons+ ( runSmallArrayST $ do+ dst <- PM.newSmallArray 11 a+ PM.writeSmallArray dst 1 b+ PM.writeSmallArray dst 2 c+ PM.writeSmallArray dst 3 d+ PM.writeSmallArray dst 4 e+ PM.writeSmallArray dst 5 f+ PM.writeSmallArray dst 6 g+ PM.writeSmallArray dst 7 h+ PM.writeSmallArray dst 8 i+ PM.writeSmallArray dst 9 j+ PM.writeSmallArray dst 10 k+ PM.unsafeFreezeSmallArray dst+ )+ ChunksNil -- | Create chunks with 12 elements. duodecupleton :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> Chunks a-{-# inline duodecupleton #-}-duodecupleton a b c d e f g h i j k l = ChunksCons- ( runSmallArrayST $ do- dst <- PM.newSmallArray 12 a- PM.writeSmallArray dst 1 b- PM.writeSmallArray dst 2 c- PM.writeSmallArray dst 3 d- PM.writeSmallArray dst 4 e- PM.writeSmallArray dst 5 f- PM.writeSmallArray dst 6 g- PM.writeSmallArray dst 7 h- PM.writeSmallArray dst 8 i- PM.writeSmallArray dst 9 j- PM.writeSmallArray dst 10 k- PM.writeSmallArray dst 11 l- PM.unsafeFreezeSmallArray dst- ) ChunksNil+{-# INLINE duodecupleton #-}+duodecupleton a b c d e f g h i j k l =+ ChunksCons+ ( runSmallArrayST $ do+ dst <- PM.newSmallArray 12 a+ PM.writeSmallArray dst 1 b+ PM.writeSmallArray dst 2 c+ PM.writeSmallArray dst 3 d+ PM.writeSmallArray dst 4 e+ PM.writeSmallArray dst 5 f+ PM.writeSmallArray dst 6 g+ PM.writeSmallArray dst 7 h+ PM.writeSmallArray dst 8 i+ PM.writeSmallArray dst 9 j+ PM.writeSmallArray dst 10 k+ PM.writeSmallArray dst 11 l+ PM.unsafeFreezeSmallArray dst+ )+ ChunksNil
test/Main.hs view
@@ -1,81 +1,76 @@-{-# language BangPatterns #-}-{-# language LambdaCase #-}-{-# language ScopedTypeVariables #-}-{-# language TypeApplications #-}-+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -import Data.Chunks (Chunks(ChunksCons,ChunksNil))-import Data.Primitive (SmallArray)-import Data.Proxy (Proxy(Proxy))-import GHC.Exts (fromList)-import Test.QuickCheck (Arbitrary,Gen,(===))-import Test.QuickCheck.Classes (eqLaws,semigroupLaws)-import Test.QuickCheck.Classes (monoidLaws,isListLaws,foldableLaws)-import Test.Tasty (defaultMain,testGroup,TestTree)-import Test.Tasty.HUnit (testCase,(@=?))+import Data.Chunks (Chunks (ChunksCons, ChunksNil)) import qualified Data.Chunks as C import qualified Data.Foldable as F import qualified Data.List as L+import Data.Primitive (SmallArray)+import Data.Proxy (Proxy (Proxy))+import GHC.Exts (fromList) import qualified GHC.Exts as Exts+import Test.QuickCheck (Arbitrary, Gen, (===)) import qualified Test.QuickCheck as QC+import Test.QuickCheck.Classes (eqLaws, foldableLaws, isListLaws, monoidLaws, semigroupLaws) import qualified Test.QuickCheck.Classes as QCC+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (testCase, (@=?)) import qualified Test.Tasty.QuickCheck as TQC main :: IO () main = defaultMain tests tests :: TestTree-tests = testGroup "Chunks"- [ lawsToTest (eqLaws (Proxy :: Proxy (Chunks Integer)))- , lawsToTest (semigroupLaws (Proxy :: Proxy (Chunks Integer)))- , lawsToTest (monoidLaws (Proxy :: Proxy (Chunks Integer)))- , lawsToTest (isListLaws (Proxy :: Proxy (Chunks Integer)))- , lawsToTest (foldableLaws (Proxy :: Proxy Chunks))- , TQC.testProperty "concat" $ \(cs :: Chunks Integer) ->- F.toList cs === Exts.toList (C.concat cs)- , TQC.testProperty "concatReverse" $ \(cs :: Chunks Integer) ->- Exts.toList (mconcat (L.reverse (Exts.toList cs)))- ===- Exts.toList (C.concatReverse cs)- , testCase "eq-A" $- fromList [fromList [5 :: Integer],fromList [6 :: Integer]]- @=?- (fromList [fromList [5 :: Integer,6]] :: Chunks Integer)- , testCase "eq-B" $- fromList [fromList [],fromList [5 :: Integer],fromList [6 :: Integer]]- @=?- (fromList [fromList [5 :: Integer,6]] :: Chunks Integer)- , testCase "eq-C" $- fromList [fromList [],fromList [5 :: Integer],fromList [6 :: Integer]]- @=?- (fromList [fromList [5 :: Integer,6],fromList []] :: Chunks Integer)- ]+tests =+ testGroup+ "Chunks"+ [ lawsToTest (eqLaws (Proxy :: Proxy (Chunks Integer)))+ , lawsToTest (semigroupLaws (Proxy :: Proxy (Chunks Integer)))+ , lawsToTest (monoidLaws (Proxy :: Proxy (Chunks Integer)))+ , lawsToTest (isListLaws (Proxy :: Proxy (Chunks Integer)))+ , lawsToTest (foldableLaws (Proxy :: Proxy Chunks))+ , TQC.testProperty "concat" $ \(cs :: Chunks Integer) ->+ F.toList cs === Exts.toList (C.concat cs)+ , TQC.testProperty "concatReverse" $ \(cs :: Chunks Integer) ->+ Exts.toList (mconcat (L.reverse (Exts.toList cs)))+ === Exts.toList (C.concatReverse cs)+ , testCase "eq-A" $+ fromList [fromList [5 :: Integer], fromList [6 :: Integer]]+ @=? (fromList [fromList [5 :: Integer, 6]] :: Chunks Integer)+ , testCase "eq-B" $+ fromList [fromList [], fromList [5 :: Integer], fromList [6 :: Integer]]+ @=? (fromList [fromList [5 :: Integer, 6]] :: Chunks Integer)+ , testCase "eq-C" $+ fromList [fromList [], fromList [5 :: Integer], fromList [6 :: Integer]]+ @=? (fromList [fromList [5 :: Integer, 6], fromList []] :: Chunks Integer)+ ] lawsToTest :: QCC.Laws -> TestTree lawsToTest (QCC.Laws name pairs) = testGroup name (map (uncurry TQC.testProperty) pairs) -instance Arbitrary a => Arbitrary (Chunks a) where- arbitrary = QC.choose (0,3 :: Int) >>= \case- 0 -> pure ChunksNil- 1 -> do- a <- arbitrarySmallArray- pure (ChunksCons a ChunksNil)- 2 -> do- a <- arbitrarySmallArray- b <- arbitrarySmallArray- pure (ChunksCons a (ChunksCons b ChunksNil))- 3 -> do- a <- arbitrarySmallArray- b <- arbitrarySmallArray- c <- arbitrarySmallArray- pure (ChunksCons a (ChunksCons b (ChunksCons c ChunksNil)))- _ -> error "Chunks.arbitrary: not possible"+instance (Arbitrary a) => Arbitrary (Chunks a) where+ arbitrary =+ QC.choose (0, 3 :: Int) >>= \case+ 0 -> pure ChunksNil+ 1 -> do+ a <- arbitrarySmallArray+ pure (ChunksCons a ChunksNil)+ 2 -> do+ a <- arbitrarySmallArray+ b <- arbitrarySmallArray+ pure (ChunksCons a (ChunksCons b ChunksNil))+ 3 -> do+ a <- arbitrarySmallArray+ b <- arbitrarySmallArray+ c <- arbitrarySmallArray+ pure (ChunksCons a (ChunksCons b (ChunksCons c ChunksNil)))+ _ -> error "Chunks.arbitrary: not possible" -instance Arbitrary a => Arbitrary (SmallArray a) where+instance (Arbitrary a) => Arbitrary (SmallArray a) where arbitrary = arbitrarySmallArray -arbitrarySmallArray :: Arbitrary a => Gen (SmallArray a)+arbitrarySmallArray :: (Arbitrary a) => Gen (SmallArray a) arbitrarySmallArray = do- n <- QC.choose (0,2 :: Int)+ n <- QC.choose (0, 2 :: Int) fmap Exts.fromList (QC.vectorOf n QC.arbitrary)