9b2ca30 · streamly · git.iko.soy

benchmark/Main.hs+9−7

compare with master

unifiedsplit

@@ -18,7 +18,7 @@ import qualified Conduit.Simple as S

18

19-- Transient

20import Control.Monad (guard)

21−import Control.Applicative (Alternative)

21+import Control.Applicative (Alternative(..))

22import Data.IORef (IORef, newIORef, writeIORef)

23import Data.Atomics (atomicModifyIORefCAS)

24import System.IO.Unsafe (unsafePerformIO)

@@ -102,12 +102,14 @@ asyncly_basic :: IO Int

102asyncly_basic = do

103 writeIORef count 0

104 xs <- A.toList $ do

105− A.each [1..1000000 :: Int]

105+ -- A.each [1..1000000 :: Int]

106+ (A.for [1..1000000 :: Int] $ \x ->

107+ return x

106− >>= afilter even

108+ >>= afilter even

107− >>= amap (+1)

109+ >>= amap (+1)

108− >>= adrop 1000

110+ >>= adrop 1000

109− >>= amap (+1)

111+ >>= amap (+1)

110− >>= afilter (\x -> x `mod` 2 == 0)

112+ >>= afilter (\x -> x `mod` 2 == 0))

111 assert (Prelude.length xs == 499000) $

113 assert (Prelude.length xs == 499000) $

112 return (Prelude.length xs)

114 return (Prelude.length xs)

113

115

src/Asyncly.hs+1

@@ -127,6 +127,7 @@ module Asyncly

127 , runAsyncly

128 , toList

129 , each

130+ , for

130

131

131{-

132{-

132 -- * Fork and Gather

133 -- * Fork and Gather

src/Asyncly/AsyncT.hs+1−4

@@ -187,9 +187,6 @@ push ctx m = go (Just ctx) m

187 channelYield pchan a

188 channelDone pchan

189

190− -- XXX If other threads are running, we should yield to the channel only

191− -- when the channel becomes empty so that we do not start more threads

192− -- unnecessarily.

193 {-# INLINE continue #-}

190 {-# INLINE continue #-}

194 continue a c mx = do

191 continue a c mx = do

195 channelYield pchan a

192 channelYield pchan a

@@ -288,7 +285,7 @@ fork m1 m2 = AsyncT $ \ctx stp yld -> do

288 Just c -> (runAsyncT (pushFork c m1 m2)) ctx stp yld

285 Just c -> (runAsyncT (pushFork c m1 m2)) ctx stp yld

289

286

290instance MonadAsync m => Alternative (AsyncT m) where

287instance MonadAsync m => Alternative (AsyncT m) where

291− empty = AsyncT $ \_ stp _ -> stp

288+ empty = mempty

292

289

293 m1 <|> m2 = AsyncT $ \ctx stp yld -> do

290 m1 <|> m2 = AsyncT $ \ctx stp yld -> do

294 doAsync <- liftIO $ canFork

291 doAsync <- liftIO $ canFork

src/Asyncly/RunAsync.hs+9−1

@@ -17,6 +17,7 @@ module Asyncly.RunAsync

17 , runAsyncly

18 , toList

19 , each

20+ , for

20 , runAsynclyRecorded

21 , runAsynclyRecorded

21-- , toListRecorded

22-- , toListRecorded

22 , playRecordings

23 , playRecordings

@@ -30,6 +31,7 @@ import Control.Monad.Catch (MonadThrow)

30import Control.Monad.IO.Class (MonadIO (..))

31import Control.Monad.IO.Class (MonadIO (..))

31import Control.Monad.Trans.Class (MonadTrans (lift))

32import Control.Monad.Trans.Class (MonadTrans (lift))

32import Control.Monad.State (StateT(..), runStateT)

33import Control.Monad.State (StateT(..), runStateT)

34+import Data.Monoid ((<>))

33import Data.IORef (IORef, newIORef, readIORef)

35import Data.IORef (IORef, newIORef, readIORef)

34

36

35import Control.Monad.Trans.Recorder (MonadRecorder(..), RecorderT,

37import Control.Monad.Trans.Recorder (MonadRecorder(..), RecorderT,

@@ -104,9 +106,15 @@ toList m = run Nothing m

104 {-# INLINE run #-}

106 {-# INLINE run #-}

105 run ctx mx = (runAsyncT mx) ctx stop yield

107 run ctx mx = (runAsyncT mx) ctx stop yield

106

108

109+-- | Run a given function concurrently on the list and collect the results.

110+{-# INLINABLE for #-}

111+for :: MonadAsync m => [a] -> (a -> AsyncT m b) -> AsynclyT m b

112+for xs f = foldr (<|>) empty $ map f xs

113+

114+-- XXX rename to fromList?

107{-# INLINABLE each #-}

115{-# INLINABLE each #-}

108each :: MonadAsync m => [a] -> AsynclyT m a

116each :: MonadAsync m => [a] -> AsynclyT m a

109−each xs = foldr (<|>) empty $ map return xs

117+each xs = foldr (<>) empty $ map return xs

110

118

111------------------------------------------------------------------------------

119------------------------------------------------------------------------------

112-- Logging

120-- Logging