array-chunks 0.1.0.0 → 0.1.1.0

raw patch · 4 files changed

+128/−6 lines, 4 filesdep +run-stPVP ok

version bump matches the API change (PVP)

Dependencies added: run-st

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• array-chunks.cabal +3/−2
• src/Data/Chunks.hs +111/−3
• test/Main.hs +10/−1

@@ -1,5 +1,9 @@ # Revision history for array-chunks +## 0.1.1.0 -- 2019-09-12++* Add `copy`, `copyReverse`, `concat`, and `concatReverse`.+ ## 0.1.0.0 -- 2019-08-12  * First version. Released on an unsuspecting world.

@@ -1,6 +1,6 @@-cabal-version:       2.2+cabal-version: 2.2 name: array-chunks-version: 0.1.0.0+version: 0.1.1.0 synopsis: Lists of chunks description:   Lists of chunks. This is similar to the Cons List provided@@ -21,6 +21,7 @@   build-depends:     , base >=4.12 && <5     , primitive >=0.6.4 && <0.8+    , run-st >=0.1 && <0.2   hs-source-dirs: src   default-language: Haskell2010   ghc-options: -O2 -Wall

@@ -1,17 +1,26 @@ {-# language BangPatterns #-} {-# language DerivingStrategies #-} {-# language TypeFamilies #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}  module Data.Chunks   ( Chunks(..)   , reverse   , reverseOnto+  , copy+  , copyReverse+  , concat+  , concatReverse   ) where -import Prelude hiding (reverse)+import Prelude hiding (reverse,concat) -import Data.Primitive (SmallArray)-import GHC.Exts (IsList)+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 qualified GHC.Exts as Exts import qualified Data.Foldable as F@@ -136,3 +145,102 @@ 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 ::+     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 #)+  )++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++-- | 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 #)+  )++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++concat :: Chunks a -> SmallArray a+{-# inline concat #-}+concat x = SmallArray (concat# x)++concat# :: Chunks a -> SmallArray# a+{-# noinline concat# #-}+concat# ChunksNil = case mempty of {SmallArray x -> x}+concat# (ChunksCons c cs) = case cs of+  ChunksNil -> case c of {SmallArray x -> x}+  ChunksCons d ds -> unSmallArray $ runSmallArrayST $ do+    let szc = PM.sizeofSmallArray c+        szd = PM.sizeofSmallArray d+        szboth = szc + szd+        len = chunksLengthGo szboth ds+    dst <- PM.newSmallArray len errorThunk+    PM.copySmallArray dst 0 c 0 szc+    PM.copySmallArray dst szc d 0 szd+    _ <- copy dst szboth ds+    PM.unsafeFreezeSmallArray dst++concatReverse :: Chunks a -> SmallArray a+{-# inline concatReverse #-}+concatReverse x = SmallArray (concatReverse# x)++concatReverse# :: Chunks a -> SmallArray# a+{-# noinline concatReverse# #-}+concatReverse# ChunksNil = case mempty of {SmallArray x -> x}+concatReverse# (ChunksCons c cs) = case cs of+  ChunksNil -> case c of {SmallArray x -> x}+  ChunksCons d ds -> unSmallArray $ runSmallArrayST $ do+    let szc = PM.sizeofSmallArray c+        szd = PM.sizeofSmallArray d+        szboth = szc + szd+        len = chunksLengthGo szboth ds+    dst <- PM.newSmallArray len errorThunk+    PM.copySmallArray dst (len - szc) c 0 szc+    PM.copySmallArray dst (len - (szc + szd)) d 0 szd+    _ <- copyReverse dst (len - (szc + szd)) ds+    PM.unsafeFreezeSmallArray dst++unSmallArray :: SmallArray a -> SmallArray# a+unSmallArray (SmallArray x) = x++errorThunk :: a+{-# noinline errorThunk #-}+errorThunk = error "Data.Chunks: mistake"

@@ -8,10 +8,13 @@ import Data.Chunks (Chunks(ChunksCons,ChunksNil)) import Data.Primitive (SmallArray) import Data.Proxy (Proxy(Proxy))-import Test.QuickCheck (Arbitrary,Gen)+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 qualified Data.Chunks as C+import qualified Data.Foldable as F+import qualified Data.List as L import qualified GHC.Exts as Exts import qualified Test.QuickCheck as QC import qualified Test.QuickCheck.Classes as QCC@@ -27,6 +30,12 @@   , 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)   ]  lawsToTest :: QCC.Laws -> TestTree