packages feed

array-builder (empty) → 0.1.0.0

raw patch · 7 files changed

+303/−0 lines, 7 filesdep +array-builderdep +array-chunksdep +basesetup-changed

Dependencies added: array-builder, array-chunks, base, primitive, run-st, tasty, tasty-hunit

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for array-builder++## 0.1.0.0 -- 2019-09-12++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, Andrew Martin++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Andrew Martin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ array-builder.cabal view
@@ -0,0 +1,39 @@+cabal-version: 2.2+name: array-builder+version: 0.1.0.0+synopsis: Builders for arrays+homepage: https://github.com/andrewthad/array-builder+bug-reports: https://github.com/andrewthad/array-builder/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++library+  exposed-modules:+    Data.Builder+    Data.Builder.ST+  build-depends:+    , base >=4.12 && <5+    , primitive >=0.6.4 && <0.8+    , run-st >=0.1 && <0.2+    , array-chunks >=0.1 && <0.2+  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -Wall -O2++test-suite test+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  build-depends:+    , base+    , array-builder+    , tasty+    , tasty-hunit+  ghc-options: -Wall -O2+  default-language: Haskell2010+
+ src/Data/Builder.hs view
@@ -0,0 +1,97 @@+{-# language RankNTypes #-}+{-# language BangPatterns #-}+{-# language UnboxedTuples #-}+{-# language MagicHash #-}++module Data.Builder+  ( -- * Builder+    Builder(..)+  , cons+  , singleton+    -- * Run+  , run+  ) where++import Data.Primitive (SmallArray(SmallArray))+import Control.Monad.ST.Run (runSmallArrayST)+import GHC.Exts (State#,Int#,runRW#)+import GHC.Exts (writeSmallArray#,unsafeFreezeSmallArray#)+import GHC.Exts (SmallMutableArray#,freezeSmallArray#)+import GHC.Exts (newSmallArray#,sizeofSmallArray#)+import GHC.Exts ((*#),(+#),(-#),(>#))+import Data.Chunks (Chunks(ChunksNil,ChunksCons))++import qualified Data.Chunks as C+import qualified Data.Foldable as F+import qualified Data.Primitive as PM++-- | Builder for an array of boxed elements.+newtype Builder a = Builder+  -- The chunks being built up are in reverse order.+  -- Consequently, functions that run a builder must+  -- reverse the chunks at the end.+  (forall s. SmallMutableArray# s a -> Int# -> Int# -> Chunks a -> State# s+   -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #)+  )++run :: Builder a -> Chunks a+run (Builder f) = case runRW#+  -- The initial size of 16 elements is chosen somewhat+  -- arbitrarily. It is more than enough to saturate a+  -- cache line.+  (\s0 -> case newSmallArray# 16# errorThunk s0 of+    (# s1, marr0 #) -> case f marr0 0# 16# ChunksNil s1 of+      (# s2, marr, off, _, cs #) ->+        -- Recall that freezeSmallArray copies a slice.+        -- If resize functions ever become available for+        -- SmallArray, we should use that instead.+        case freezeSmallArray# marr 0# off s2 of+          (# s3, arr #) ->+            let !r = C.reverseOnto+                  (ChunksCons (SmallArray arr) ChunksNil)+                  cs+             in (# s3, r #)+  ) of (# _, cs #) -> cs++errorThunk :: a+{-# noinline errorThunk #-}+errorThunk = error "array-builder:Data.Builder: error"++instance Monoid (Builder a) where+  {-# inline mempty #-}+  mempty = Builder+    (\marr0 off0 len0 cs0 s0 ->+      (# s0, marr0, off0, len0, cs0 #)+    )++instance Semigroup (Builder a) where+  {-# inline (<>) #-}+  Builder f <> Builder g = Builder+    (\marr0 off0 len0 cs0 s0 -> case f marr0 off0 len0 cs0 s0 of+      (# s1, marr1, off1, len1, cs1 #) ->+        g marr1 off1 len1 cs1 s1+    )++cons :: a -> Builder a -> Builder a+{-# inline cons #-}+cons a b = singleton a <> b++singleton :: a -> Builder a+{-# noinline singleton #-}+singleton a = Builder+  (\marr off len cs s0 -> case len ># 0# of+    1# -> case writeSmallArray# marr off a s0 of+      s1 -> (# s1, marr, off +# 1#, len -# 1#, cs #)+    _ -> case unsafeFreezeSmallArray# marr s0 of+      (# s1, arr #) -> let !lenNew = nextLength (sizeofSmallArray# arr) in+        -- Since we feed the element to newSmallArray#, we do not+        -- need to write it to the 0 index.+        case newSmallArray# lenNew a s1 of+          (# s2, marrNew #) ->+            let !csNew = ChunksCons (SmallArray arr) cs in+              (# s2, marrNew, 1#, lenNew -# 1#, csNew #)+  )++nextLength :: Int# -> Int#+{-# inline nextLength #-}+nextLength i = i *# 2#
+ src/Data/Builder/ST.hs view
@@ -0,0 +1,90 @@+{-# language BangPatterns #-}++module Data.Builder.ST+  ( Builder(..)+  , new+  , push+  , freeze +  ) where++import Data.Primitive (SmallMutableArray)+import Control.Monad.ST (ST)+import Data.Primitive (newSmallArray,writeSmallArray,unsafeFreezeSmallArray)+import Data.Primitive (sizeofSmallArray,freezeSmallArray)+import Data.Chunks (Chunks(ChunksNil,ChunksCons))+import Foreign.Storable (sizeOf)++import qualified Data.Chunks as C++-- | Builder for an array of boxed elements. This type is appropriate+-- when constructing an array of unknown size in an effectful+-- (@ST@ or @IO@) setting. In a non-effectful setting, consider+-- the @Builder@ from @Data.Builder@ instead.+--+-- A 'Builder' must be used linearly. The type system does not+-- enforce this, so users must be careful when handling a 'Builder'.+data Builder s a = Builder+  !(SmallMutableArray s a)+  !Int+  !Int+  !(Chunks a)++-- | Create a new 'Builder' with no elements in it.+new :: ST s (Builder s a)+new = do+  marr <- newSmallArray initialLength errorThunk+  pure (Builder marr 0 initialLength ChunksNil)++-- | Push an element onto the end of the builder. This+-- is not strict in the element, so force it before pushing+-- it on to the builder if doing so is needed to prevent+-- space leaks.+push ::+     a -- ^ Element to push onto the end+  -> Builder s a -- ^ Builder, do not reuse this after pushing onto it+  -> ST s (Builder s a) -- ^ New builder+push a (Builder marr off len cs) = case len > 0 of+  True -> do+    writeSmallArray marr off a+    pure $! Builder marr (off + 1) (len - 1) cs+  False -> do+    arr <- unsafeFreezeSmallArray marr+    let lenNew = nextLength (sizeofSmallArray arr)+    marrNew <- newSmallArray lenNew a+    let !csNew = ChunksCons arr cs+    pure $! Builder marrNew 1 (lenNew - 1) csNew++-- The sequence of sizes we create is:+--   64-bit: 14, 30, 62, 126, 254, 254, 254...+--   32-bit: 14, 30, 62, 126, 254, 510, 510, 510...+-- The goal is to have objects whose sizes are increasing+-- powers of 2 until we reach the size of a block (4KB).+-- A 254-element SmallArray on a 64-bit platform uses+-- exactly 4KB (header + ptrs + payload).+nextLength :: Int -> Int+nextLength i = if i < maxElementCount - smallArrayHeaderWords+  then i * 2 + smallArrayHeaderWords+  else maxElementCount - smallArrayHeaderWords++maxElementCount :: Int+maxElementCount = div 4096 (sizeOf (undefined :: Int))++initialLength :: Int+initialLength = 16 - smallArrayHeaderWords++smallArrayHeaderWords :: Int+smallArrayHeaderWords = 2++-- | Convert a 'Builder' to 'Chunks'. The 'Builder' must not+-- be reused after this operation.+freeze ::+     Builder s a -- ^ Builder, do not reuse after freezing+  -> ST s (Chunks a)+freeze (Builder marr off _ cs) = do+  arr <- freezeSmallArray marr 0 off+  pure $! C.reverseOnto (ChunksCons arr ChunksNil) cs++errorThunk :: a+{-# noinline errorThunk #-}+errorThunk = error "array-builder:Data.Builder.ST: error"+
+ test/Main.hs view
@@ -0,0 +1,40 @@+{-# language BangPatterns #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}++import Data.Builder (singleton,run)+import Control.Monad.ST (runST)+import Test.Tasty (defaultMain,testGroup,TestTree)+import Test.Tasty.HUnit ((@=?))+import Data.Semigroup (stimes)+import qualified Data.List as L+import qualified Data.Foldable as F+import qualified GHC.Exts as Exts+import qualified Test.Tasty.HUnit as THU++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests"+  [ THU.testCase "A" $ "ABCDEF" @=?+    ( F.toList $ run+      (  singleton 'A'+      <> singleton 'B'+      <> singleton 'C'+      <> singleton 'D'+      <> singleton 'E'+      <> singleton 'F'+      )+    )+  , THU.testCase "B" $ "ABCCCCCCCCCCCCCCCD" @=?+    ( F.toList $ run+      (  singleton 'A'+      <> singleton 'B'+      <> stimes (15 :: Int) (singleton 'C')+      <> singleton 'D'+      )+    )+  , THU.testCase "C" $ (L.replicate 500 'X') @=?+    (F.toList $ run (stimes (500 :: Int) (singleton 'X')))+  ]