summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorhaskellworks <>2018-11-08 12:05:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-11-08 12:05:00 (GMT)
commit42505db76e3b2adf35360d090b14888e77ff3a0a (patch)
tree3f380d4f9c1d0f25cea91abe475c9be6f809ed57
parentbd5a9d3d956a91b3643bcc140221827d86a3f819 (diff)
version 0.6.2.190.6.2.19
-rw-r--r--hw-prim.cabal3
-rw-r--r--src/HaskellWorks/Data/Vector/Storable.hs34
-rw-r--r--test/HaskellWorks/Data/Vector/StorableSpec.hs30
3 files changed, 63 insertions, 4 deletions
diff --git a/hw-prim.cabal b/hw-prim.cabal
index 45ac654..f1de78f 100644
--- a/hw-prim.cabal
+++ b/hw-prim.cabal
@@ -3,7 +3,7 @@
-- see: https://github.com/sol/hpack
name: hw-prim
-version: 0.6.2.18
+version: 0.6.2.19
synopsis: Primitive functions and data types
description: Primitive functions and data types.
category: Data
@@ -118,6 +118,7 @@ test-suite hw-prim-test
HaskellWorks.Data.Vector.AsVector64sSpec
HaskellWorks.Data.Vector.AsVector8nsSpec
HaskellWorks.Data.Vector.AsVector8sSpec
+ HaskellWorks.Data.Vector.StorableSpec
default-language: Haskell2010
benchmark bench
diff --git a/src/HaskellWorks/Data/Vector/Storable.hs b/src/HaskellWorks/Data/Vector/Storable.hs
index 900bb96..04d52d4 100644
--- a/src/HaskellWorks/Data/Vector/Storable.hs
+++ b/src/HaskellWorks/Data/Vector/Storable.hs
@@ -1,9 +1,19 @@
-module HaskellWorks.Data.Vector.Storable where
+{-# LANGUAGE ScopedTypeVariables #-}
-import Data.Monoid (Monoid (..), (<>))
+module HaskellWorks.Data.Vector.Storable
+ ( padded
+ , foldMap
+ , mapAccumL
+ ) where
+
+import Control.Monad.ST (ST)
+import Data.Monoid (Monoid (..), (<>))
+import Data.Vector.Storable (Storable)
import Data.Word
+import Prelude hiding (foldMap)
-import qualified Data.Vector.Storable as DVS
+import qualified Data.Vector.Storable as DVS
+import qualified Data.Vector.Storable.Mutable as DVSM
{-# ANN module ("HLint: ignore Redundant do" :: String) #-}
@@ -14,3 +24,21 @@ padded n v = v <> DVS.replicate ((n - DVS.length v) `max` 0) 0
foldMap :: (DVS.Storable a, Monoid m) => (a -> m) -> DVS.Vector a -> m
foldMap f = DVS.foldl' (\a b -> a <> f b) mempty
{-# INLINE foldMap #-}
+
+mapAccumL :: forall a b c. (Storable b, Storable c)
+ => (a -> b -> (a, c))
+ -> a
+ -> DVS.Vector b
+ -> (a, DVS.Vector c)
+mapAccumL f a vb = DVS.createT $ do
+ vc <- DVSM.unsafeNew (DVS.length vb)
+ a' <- go 0 a vc
+ return (a', vc)
+ where go :: Int -> a -> DVS.MVector s c -> ST s a
+ go i a0 vc = if i < DVS.length vb
+ then do
+ let (a1, c1) = f a0 (DVS.unsafeIndex vb i)
+ DVSM.unsafeWrite vc i c1
+ go (i + 1) a1 vc
+ else return a0
+{-# INLINE mapAccumL #-}
diff --git a/test/HaskellWorks/Data/Vector/StorableSpec.hs b/test/HaskellWorks/Data/Vector/StorableSpec.hs
new file mode 100644
index 0000000..7067970
--- /dev/null
+++ b/test/HaskellWorks/Data/Vector/StorableSpec.hs
@@ -0,0 +1,30 @@
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module HaskellWorks.Data.Vector.StorableSpec
+ ( spec
+ ) where
+
+import HaskellWorks.Hspec.Hedgehog
+import Hedgehog
+import Test.Hspec
+
+import qualified Data.List as L
+import qualified Data.Vector.Storable as DVS
+import qualified HaskellWorks.Data.Vector.Storable as DVS
+import qualified Hedgehog.Gen as G
+import qualified Hedgehog.Range as R
+
+{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}
+
+spec :: Spec
+spec = describe "HaskellWorks.Data.Vector.StorableSpec" $ do
+ it "mapAccumL: f a b = (a + 1, b * 2)" $ requireProperty $ do
+ as <- forAll $ G.list (R.linear 0 10) (G.word64 (R.linear 0 255))
+ let f a b = (a + 1, b * 2)
+ (DVS.toList <$> DVS.mapAccumL f (0 :: Int) (DVS.fromList as)) === L.mapAccumL f (0 :: Int) as
+ it "mapAccumL: f a b = (a * 2, b + 1)" $ requireProperty $ do
+ as <- forAll $ G.list (R.linear 0 10) (G.word64 (R.linear 0 255))
+ let f a b = (a * 2, b + 1)
+ (DVS.toList <$> DVS.mapAccumL f (0 :: Int) (DVS.fromList as)) === L.mapAccumL f (0 :: Int) as