vector-builder 0.3.2 → 0.3.3
raw patch · 8 files changed
+97/−124 lines, 8 files
Files
- foldl-benchmark/Main.hs +14/−12
- library/VectorBuilder/MVector.hs +6/−9
- library/VectorBuilder/Private/Action.hs +0/−29
- library/VectorBuilder/Private/Builder.hs +39/−34
- library/VectorBuilder/Private/Prelude.hs +6/−0
- library/VectorBuilder/Private/SizeTrackingAction.hs +0/−36
- library/VectorBuilder/Private/Update.hs +30/−0
- vector-builder.cabal +2/−4
foldl-benchmark/Main.hs view
@@ -1,7 +1,6 @@ module Main where import Prelude-import Bug import Criterion import Criterion.Main import qualified Control.Foldl as A@@ -11,15 +10,18 @@ main =- defaultMain- [- bench "vector-builder" (nf foldWithBuilder input),- bench "default" (nf foldDefault input)- ]+ defaultMain [group 100, group 10000, group 1000000] where- input =- [0..1000]- foldWithBuilder input =- A.fold (A.foldMap N.singleton O.build) input :: Vector Int- foldDefault input =- runST (A.foldM A.vector input) :: Vector Int+ group size =+ bgroup (show size)+ [+ bench "vector-builder" (nf foldWithBuilder input),+ bench "default" (nf foldDefault input)+ ]+ where+ input =+ [0..size]+ foldWithBuilder input =+ A.fold (A.foldMap N.singleton O.build) input :: Vector Int+ foldDefault input =+ runST (A.foldM A.vector input) :: Vector Int
library/VectorBuilder/MVector.hs view
@@ -6,8 +6,7 @@ import VectorBuilder.Private.Prelude import Data.Vector.Generic.Mutable import qualified VectorBuilder.Private.Builder as A-import qualified VectorBuilder.Private.SizeTrackingAction as B-import qualified VectorBuilder.Private.Action as C+import qualified VectorBuilder.Private.Update as C -- |@@ -16,10 +15,8 @@ -- Supports all kinds of vectors: boxed, unboxed, primitive, storable. {-# INLINABLE build #-} build :: MVector vector element => A.Builder element -> ST s (vector s element)-build (A.Builder (B.SizeTrackingAction sizeTrackingActionFn)) =- case sizeTrackingActionFn 0 of- (C.Action actionFn, size) ->- do- vector <- unsafeNew size- actionFn vector- return vector+build (A.Builder size (C.Update update)) =+ do+ vector <- unsafeNew size+ update vector 0+ return vector
− library/VectorBuilder/Private/Action.hs
@@ -1,29 +0,0 @@-module VectorBuilder.Private.Action-where--import VectorBuilder.Private.Prelude-import qualified Data.Vector.Generic.Mutable as A-import qualified Data.Vector.Generic as B---newtype Action element result =- Action (forall s vector. A.MVector vector element => vector s element -> ST s result)- deriving (Functor)--instance Applicative (Action element) where- {-# INLINABLE pure #-}- pure result =- Action (const (pure result))- {-# INLINABLE (<*>) #-}- (<*>) (Action actionFn1) (Action actionFn2) =- Action ((<*>) <$> actionFn1 <*> actionFn2)--{-# INLINABLE unsafeWrite #-}-unsafeWrite :: Int -> element -> Action element ()-unsafeWrite index element =- Action (\mVector -> A.unsafeWrite mVector index element)--{-# INLINABLE unsafeWriteMany #-}-unsafeWriteMany :: B.Vector vector element => Int -> vector element -> Action element ()-unsafeWriteMany startingIndex appendedVector =- Action (\mVector -> B.ifoldM' (\_ index element -> A.unsafeWrite mVector (startingIndex + index) element) () appendedVector)
library/VectorBuilder/Private/Builder.hs view
@@ -1,34 +1,17 @@ module VectorBuilder.Private.Builder where -import VectorBuilder.Private.Prelude-import qualified VectorBuilder.Private.SizeTrackingAction as A+import VectorBuilder.Private.Prelude hiding (empty)+import qualified VectorBuilder.Private.Update as A import qualified Data.Vector.Generic as B -- |--- An abstraction over the size of a vector for the process of its construction.+-- An abstrupdate over the size of a vector for the process of its construction. -- -- It postpones the actual construction of a vector until the execution of the builder.-newtype Builder element =- Builder (A.SizeTrackingAction element ())---- |--- Provides support for /O(1)/ concatenation.-instance Monoid (Builder element) where- {-# INLINE mempty #-}- mempty =- VectorBuilder.Private.Builder.empty- {-# INLINE mappend #-}- mappend =- prepend---- |--- Provides support for /O(1)/ concatenation.-instance Semigroup (Builder element) where- {-# INLINE (<>) #-}- (<>) =- prepend+data Builder element =+ Builder !Int !(A.Update element) -- * Initialisation@@ -38,14 +21,14 @@ {-# INLINE empty #-} empty :: Builder element empty =- Builder (pure ())+ Builder 0 A.empty -- | -- Builder of a single element. {-# INLINE singleton #-} singleton :: element -> Builder element singleton element =- Builder (A.snoc element)+ Builder 1 (A.write element) -- | -- Builder from an immutable vector of elements.@@ -54,27 +37,49 @@ {-# INLINE vector #-} vector :: B.Vector vector element => vector element -> Builder element vector vector =- Builder (A.append vector)+ Builder (B.length vector) (A.writeMany vector) --- * Updates+-- -- * Updates {-# INLINE snoc #-} snoc :: element -> Builder element -> Builder element-snoc element (Builder action) =- Builder (action *> A.snoc element)+snoc element (Builder size update) =+ Builder (succ size) (A.prepend size update (A.write element)) {-# INLINE cons #-} cons :: element -> Builder element -> Builder element-cons element (Builder action) =- Builder (A.snoc element *> action)+cons element (Builder size update) =+ Builder (succ size) (A.prepend 1 (A.write element) update) {-# INLINE prepend #-} prepend :: Builder element -> Builder element -> Builder element-prepend (Builder action1) (Builder action2) =- Builder (action1 *> action2)+prepend (Builder leftSize leftUpdate) (Builder rightSize rightUpdate) =+ Builder (leftSize + rightSize) (A.prepend leftSize leftUpdate rightUpdate) {-# INLINE append #-} append :: Builder element -> Builder element -> Builder element-append (Builder action1) (Builder action2) =- Builder (action1 <* action2)+append =+ flip prepend+++-- * Instances++-- |+-- Provides support for /O(1)/ concatenation.+instance Semigroup (Builder element) where+ {-# INLINE (<>) #-}+ (<>) =+ prepend++-- |+-- Provides support for /O(1)/ concatenation.+instance Monoid (Builder element) where+ {-# INLINE mempty #-}+ mempty =+ empty+ {-# INLINE mappend #-}+ mappend =+ (<>)++
library/VectorBuilder/Private/Prelude.hs view
@@ -1,8 +1,14 @@ module VectorBuilder.Private.Prelude ( module Exports,+ strict, ) where import BasePrelude as Exports hiding ((<>)) import Data.Semigroup as Exports (Semigroup(..))++{-# INLINE strict #-}+strict :: a -> a+strict a =+ seq a a
− library/VectorBuilder/Private/SizeTrackingAction.hs
@@ -1,36 +0,0 @@-module VectorBuilder.Private.SizeTrackingAction-where--import VectorBuilder.Private.Prelude-import qualified Data.Vector.Generic as B-import qualified VectorBuilder.Private.Action as C---newtype SizeTrackingAction element result =- SizeTrackingAction (Int -> (C.Action element result, Int))- deriving (Functor)--instance Applicative (SizeTrackingAction element) where- {-# INLINE pure #-}- pure result =- SizeTrackingAction (\size -> (pure result, size))- {-# INLINE (<*>) #-}- (<*>) (SizeTrackingAction sizeTrackingActionFn1) (SizeTrackingAction sizeTrackingActionFn2) =- SizeTrackingAction sizeTrackingActionFn- where- sizeTrackingActionFn size =- case sizeTrackingActionFn1 size of- (action1, !size1) ->- case sizeTrackingActionFn2 size1 of- (action2, !size2) ->- (action1 <*> action2, size2)--{-# INLINE snoc #-}-snoc :: element -> SizeTrackingAction element ()-snoc element =- SizeTrackingAction (\size -> (C.unsafeWrite size element, succ size))--{-# INLINE append #-}-append :: B.Vector vector element => vector element -> SizeTrackingAction element ()-append appendedVector =- SizeTrackingAction (\size -> (C.unsafeWriteMany size appendedVector, size + B.length appendedVector))
+ library/VectorBuilder/Private/Update.hs view
@@ -0,0 +1,30 @@+module VectorBuilder.Private.Update+where++import VectorBuilder.Private.Prelude+import qualified Data.Vector.Generic.Mutable as A+import qualified Data.Vector.Generic as B+++newtype Update element =+ Update (forall s vector. A.MVector vector element => vector s element -> Int -> ST s ())++{-# INLINE write #-}+write :: element -> Update element+write element =+ Update (\mVector offset -> A.unsafeWrite mVector offset element)++{-# INLINE writeMany #-}+writeMany :: B.Vector vector element => vector element -> Update element+writeMany appendedVector =+ Update (\mVector offset -> B.ifoldM' (\_ index element -> A.unsafeWrite mVector (strict (offset + index)) element) () appendedVector)++{-# INLINE prepend #-}+prepend :: Int -> Update element -> Update element -> Update element+prepend size (Update leftST) (Update rightST) =+ Update (\mVector offset -> leftST mVector offset >> rightST mVector (strict (size + offset)))++{-# INLINE empty #-}+empty :: Update element+empty =+ Update (\_ _ -> pure ())
vector-builder.cabal view
@@ -1,7 +1,7 @@ name: vector-builder version:- 0.3.2+ 0.3.3 synopsis: Vector builder description:@@ -69,8 +69,7 @@ Haskell2010 other-modules: VectorBuilder.Private.Prelude- VectorBuilder.Private.Action- VectorBuilder.Private.SizeTrackingAction+ VectorBuilder.Private.Update VectorBuilder.Private.Builder exposed-modules: VectorBuilder.Builder@@ -130,7 +129,6 @@ -- benchmarking: criterion >= 1.1 && < 2, -- general:- bug == 1.*, rerebase < 2