95b8d90 · streamly · git.iko.soy

benchmark/Streamly/Benchmark/Data/Array.hs+9−2

compare with master

unifiedsplit

@@ -13,7 +13,12 @@ import System.Random (randomRIO)

13

14import qualified Streamly.Benchmark.Data.ArrayOps as Ops

15import qualified Streamly.Data.Array.Foreign as A

16+

17+#ifdef DATA_ARRAY

18+import qualified Streamly.Internal.Data.Array as IA

19+#else

16import qualified Streamly.Internal.Data.Array.Foreign as IA

20import qualified Streamly.Internal.Data.Array.Foreign as IA

21+#endif

17import qualified Streamly.Prelude as S

22import qualified Streamly.Prelude as S

18

23

19import Gauge

24import Gauge

@@ -117,8 +122,10 @@ o_1_space_elimination value =

117 , benchIOSink value "foldl'" Ops.pureFoldl'

122 , benchIOSink value "foldl'" Ops.pureFoldl'

118 , benchIOSink value "read" Ops.unfoldReadDrain

123 , benchIOSink value "read" Ops.unfoldReadDrain

119 , benchIOSink value "toStreamRev" Ops.toStreamRevDrain

124 , benchIOSink value "toStreamRev" Ops.toStreamRevDrain

125+ , benchFold "writeLastN.1"

120− , benchFold "writeLastN.1" (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)

126+ (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)

127+ , benchFold "writeLastN.10"

121− , benchFold "writeLastN.10" (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)

128+ (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)

122#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)

129#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)

123#ifdef DEVBUILD

130#ifdef DEVBUILD

124 , benchPureSink value "foldable/foldl'" Ops.foldableFoldl'

131 , benchPureSink value "foldable/foldl'" Ops.foldableFoldl'

src/Streamly/Internal/Data/Array.hs+30

@@ -18,6 +18,7 @@ module Streamly.Internal.Data.Array

18 -- * Construction

19 , writeN

20 , write

21+ , writeLastN

21

22

22 , fromStreamDN

23 , fromStreamDN

23 , fromStreamD

24 , fromStreamD

@@ -52,6 +53,7 @@ import Control.DeepSeq (NFData(..))

52import Control.Monad (when)

53import Control.Monad (when)

53import Control.Monad.IO.Class (liftIO, MonadIO)

54import Control.Monad.IO.Class (liftIO, MonadIO)

54import Data.Functor.Identity (runIdentity)

55import Data.Functor.Identity (runIdentity)

56+import Data.IORef

55import GHC.Base (Int(..))

57import GHC.Base (Int(..))

56import GHC.IO (unsafePerformIO)

58import GHC.IO (unsafePerformIO)

57

59

@@ -62,6 +64,7 @@ import Streamly.Internal.Data.Unfold.Type (Unfold(..))

62

64

63import qualified GHC.Exts as Exts

65import qualified GHC.Exts as Exts

64import qualified Streamly.Internal.Data.Fold.Type as FL

66import qualified Streamly.Internal.Data.Fold.Type as FL

67+import qualified Streamly.Internal.Data.Ring as RB

65import qualified Streamly.Internal.Data.Stream.StreamD as D

68import qualified Streamly.Internal.Data.Stream.StreamD as D

66

69

67import Data.Primitive.Array hiding (fromList, fromListN)

70import Data.Primitive.Array hiding (fromList, fromListN)

@@ -248,3 +251,30 @@ streamFold f arr = f (toStream arr)

248{-# INLINE getIndexUnsafe #-}

251{-# INLINE getIndexUnsafe #-}

249getIndexUnsafe :: Array a -> Int -> a

252getIndexUnsafe :: Array a -> Int -> a

250getIndexUnsafe = indexArray

253getIndexUnsafe = indexArray

254+

255+{-# INLINE writeLastN #-}

256+writeLastN :: MonadIO m => Int -> Fold m a (Array a)

257+writeLastN n

258+ | n <= 0 = fmap (const mempty) FL.drain

259+ | otherwise = Fold step initial done

260+

261+ where

262+

263+ initial = do

264+ rb <- liftIO $ RB.createRing n

265+ return $ FL.Partial $ Tuple' rb (0 :: Int)

266+

267+ step (Tuple' rb rh) x = do

268+ liftIO $ RB.unsafeInsertRing rb rh x

269+ return $ FL.Partial $ Tuple' rb (rh + 1)

270+

271+ done (Tuple' rb rh) = do

272+ arr' <- liftIO $ newArray (min rh n) (undefined :: a)

273+ ref <- liftIO $ readIORef $ RB.ringHead rb

274+ if rh < n

275+ then

276+ liftIO $ copyMutableArray arr' 0 (RB.arr rb) 0 ref

277+ else do

278+ liftIO $ copyMutableArray arr' 0 (RB.arr rb) ref (n - ref)

279+ liftIO $ copyMutableArray arr' (n - ref) (RB.arr rb) 0 ref

280+ liftIO $ unsafeFreezeArray arr'

src/Streamly/Internal/Data/Ring.hsnew file+44

@@ -0,0 +1,44 @@

1+-- |

2+-- Module : Streamly.Internal.Data.Ring

4+-- License : BSD-3-Clause

5+-- Maintainer : streamly@composewell.com

6+-- Stability : experimental

7+-- Portability : GHC

8+--

9+

10+module Streamly.Internal.Data.Ring

11+ ( Ring(..)

12+ , createRing

13+ , unsafeInsertRing

14+ ) where

15+

16+import Control.Monad.Primitive (PrimMonad(PrimState))

17+import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef, IORef)

18+import Data.Primitive.Array (newArray, writeArray, MutableArray)

19+

20+data Ring a = Ring

21+ { arr :: MutableArray (PrimState IO) a

22+ , ringHead :: IORef Int -- current index to be over-written

23+ , ringMax :: !Int -- first index beyond allocated memory

24+ }

25+

26+{-# INLINE createRing #-}

27+createRing :: Int -> IO (Ring a)

28+createRing count = do

29+ arr' <- newArray count (undefined :: a)

30+ head' <- newIORef 0

31+ return (Ring

32+ { arr = arr'

33+ , ringHead = head'

34+ , ringMax = count

35+ })

36+

37+{-# INLINE unsafeInsertRing #-}

38+unsafeInsertRing :: Ring a -> Int -> a -> IO ()

39+unsafeInsertRing Ring{..} idx x = do

40+ writeArray arr (mod idx ringMax) x

41+ ref <- readIORef ringHead

42+ if (ref+1) < ringMax

43+ then modifyIORef' ringHead ( + 1)

44+ else writeIORef ringHead 0

streamly.cabal+1

@@ -477,6 +477,7 @@ library

477

478 -- Memory storage

479 , Streamly.Internal.Ring.Foreign

480+ , Streamly.Internal.Data.Ring

480

481

481 -- IOVec (depends on arrays/streams)

482 -- IOVec (depends on arrays/streams)

482 , Streamly.Internal.System.IOVec

483 , Streamly.Internal.System.IOVec