array-chunks 0.1.1.0 → 0.1.2.0

raw patch · 4 files changed

+180/−17 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• array-chunks.cabal +1/−1
• src/Data/Chunks.hs +157/−16
• test/Main.hs +14/−0

@@ -1,5 +1,13 @@ # Revision history for array-chunks +## 0.1.2.0 -- 2020-11-18++* Add `index`.+* Add `singleton`, `doubleton`, `tripleton`, `quadrupleton`,+  `quintupleton`, `sextupleton`, `septupleton`, `octupleton`.+* Add `map'`, which converts to `SmallArray` while mapping over+  the elements.+ ## 0.1.1.0 -- 2019-09-12  * Add `copy`, `copyReverse`, `concat`, and `concatReverse`.

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: array-chunks-version: 0.1.1.0+version: 0.1.2.0 synopsis: Lists of chunks description:   Lists of chunks. This is similar to the Cons List provided

@@ -6,15 +6,29 @@  module Data.Chunks   ( Chunks(..)+  , null   , reverse   , reverseOnto   , copy   , copyReverse   , concat   , concatReverse+    -- * Indexing+  , index+    -- * Traversals+  , map'+    -- * Construction+  , singleton+  , doubleton+  , tripleton+  , quadrupleton+  , quintupleton+  , sextupleton+  , septupleton+  , octupleton   ) where -import Prelude hiding (reverse,concat)+import Prelude hiding (reverse,concat,null)  import Data.Primitive (SmallArray(..),SmallMutableArray(..)) import GHC.Exts (IsList,Int#,State#,SmallMutableArray#,Int(I#),(+#),(-#))@@ -45,6 +59,26 @@   toList = chunksToSmallArrayList   fromList xs = F.foldr ChunksCons ChunksNil xs +-- | Are there any elements in the chunked list?+null :: Chunks a -> Bool+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.+index :: Chunks a -> Int -> Maybe a+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)+ chunksToSmallArrayList :: Chunks a -> [SmallArray a] chunksToSmallArrayList ChunksNil = [] chunksToSmallArrayList (ChunksCons x xs) =@@ -52,29 +86,22 @@  eqChunks :: Eq a => Chunks a -> Chunks a -> Bool eqChunks ChunksNil cs = allEmpty cs-eqChunks (ChunksCons x xs) cs = eqChunksConsLeft x 0 (PM.sizeofSmallArray x) xs cs+eqChunks (ChunksCons x xs) cs = eqChunksCons x 0 (PM.sizeofSmallArray x) xs cs --- The first argument chunk belongs to the second argument chunks.+-- The first argument chunk belongs to the first argument chunks. -- It is its head. -eqChunksConsLeft :: Eq a => SmallArray a -> Int -> Int -> Chunks a -> Chunks a -> Bool-eqChunksConsLeft !_ !_ !len xs ChunksNil = case len of+eqChunksCons :: Eq a => SmallArray a -> Int -> Int -> Chunks a -> Chunks a -> Bool+eqChunksCons !_ !_ !len xs ChunksNil = case len of   0 -> allEmpty xs   _ -> False-eqChunksConsLeft x !off !len xs (ChunksCons y ys) =+eqChunksCons x !off !len xs (ChunksCons y ys) =   eqChunksConsBoth x off len y 0 (PM.sizeofSmallArray y) xs ys -eqChunksConsRight :: Eq a => Chunks a -> SmallArray a -> Int -> Int -> Chunks a -> Bool-eqChunksConsRight ChunksNil !_ !_ !len ys = case len of-  0 -> allEmpty ys-  _ -> False-eqChunksConsRight (ChunksCons x xs) !y !off !len ys =-  eqChunksConsBoth x 0 (PM.sizeofSmallArray x) y off len xs ys- 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 && eqChunksConsRight xt yh xlen (ylen - xlen) yt-  GT -> eqRange xh xoff yh yoff ylen && eqChunksConsLeft xh ylen (xlen - ylen) xt yt-  EQ -> xh == yh && eqChunks xt yt+  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 !xs !xoff !ys !yoff !len@@ -244,3 +271,117 @@ errorThunk :: a {-# noinline errorThunk #-} errorThunk = error "Data.Chunks: mistake"++-- | Mapping over chunks is a little unusual in that the result+-- is just a 'SmallArray'.+map' :: (a -> b) -> Chunks a -> SmallArray b+{-# 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+  PM.unsafeFreezeSmallArray dst+  where+  !len = chunksLength cs++-- | Create chunks with 1 element.+singleton :: a -> Chunks a+{-# 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++-- | 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++-- | 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++-- | 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++-- | 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++-- | 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++-- | 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

@@ -8,10 +8,12 @@ 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 qualified Data.Chunks as C import qualified Data.Foldable as F import qualified Data.List as L@@ -36,6 +38,18 @@       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