@@ -7,8 +7,7 @@
7-- Maintainer : streamly@composewell.com
7-- Maintainer : streamly@composewell.com
9import Control.Concurrent
9import Control.Concurrent
10−import Control.Monad (when)
10+import Control.Monad (when, replicateM)
13import Gauge
12import Gauge
14import Streamly
13import Streamly
@@ -18,7 +17,10 @@ import qualified Streamly.Prelude as S
19-------------------------------------------------------------------------------
18-------------------------------------------------------------------------------
21−-- Single work item yielded per thread
20+-- | Run @tcount@ number of actions concurrently using the given concurrency
21+-- style. Each thread produces a single output after a delay of @d@
22{-# INLINE append #-}
24{-# INLINE append #-}
23append :: IsStream t
25append :: IsStream t
24 => Int -> Int -> Int -> (t IO Int -> SerialT IO Int) -> IO ()
26 => Int -> Int -> Int -> (t IO Int -> SerialT IO Int) -> IO ()
@@ -30,11 +32,22 @@ append buflen tcount d t =
30 $ maxThreads (-1)
32 $ maxThreads (-1)
31 $ S.fromFoldableM $ map work [1..tcount]
33 $ S.fromFoldableM $ map work [1..tcount]
33−-- Big stream of items yielded per thread
35+-- | Run @threads@ concurrently, each producing streams of @elems@ elements
36+-- with a delay of @d@ microseconds between successive elements, and merge
37+-- their outputs in a single output stream. The individual streams are produced
38+-- serially but merged using the provided concurrency style.
34{-# INLINE concated #-}
40{-# INLINE concated #-}
35−concated :: Int -> Int -> Int -> Int -> (forall a. SerialT IO a -> SerialT IO a -> SerialT IO a) -> IO ()
46+ -> (forall a. SerialT IO a -> SerialT IO a -> SerialT IO a)
36concated buflen threads d elems t =
48concated buflen threads d elems t =
49+ let work = \i -> S.replicateM i
37− let work = (\i -> (S.replicateM i ((when (d /= 0) (threadDelay d)) >> return i)))
50+ ((when (d /= 0) (threadDelay d)) >> return i)
38 in S.drain
51 in S.drain
40 $ maxThreads (-1)
53 $ maxThreads (-1)
@@ -72,25 +85,19 @@ main = do
73 [ -- bgroup "append/buf-1-threads-10k-0sec" (appendGroup 1 10000 0)
86 [ -- bgroup "append/buf-1-threads-10k-0sec" (appendGroup 1 10000 0)
74 -- , bgroup "append/buf-100-threads-100k-0sec" (appendGroup 100 100000 0)
87 -- , bgroup "append/buf-100-threads-100k-0sec" (appendGroup 100 100000 0)
75− bgroup "append/buf-10k-threads-10k-5sec" (appendGroup 10000 10000 5000000)
88+ bgroup "stream1x10k/buf10k-threads10k-5sec" (appendGroup 10000 10000 5000000)
76 -- bgroup "concat/buf-1-threads-100k-count-1" (concatGroup 1 100000 0 1)
89 -- bgroup "concat/buf-1-threads-100k-count-1" (concatGroup 1 100000 0 1)
77 -- bgroup "concat/buf-1-threads-1-count-10m" (concatGroup 1 1 0 10000000)
90 -- bgroup "concat/buf-1-threads-1-count-10m" (concatGroup 1 1 0 10000000)
78− , bgroup "concat/buf-100-threads-100-count-500k" (concatGroup 100 100 0 500000)
91+ , bgroup "streams100x500k/buf100-threads100" (concatGroup 100 100 0 500000)
80− , bgroup "forkIO-5000ms-10k" $
93+ , bench "forkIO/threads10k-5sec" $
81− let delay = threadDelay 5000000
94+ let delay = threadDelay 5000000
82− count = 10000 :: Int
95+ count = 10000 :: Int
83− list = [1..count]
96+ list = [1..count]
84− work i = delay >> return i
97+ work i = delay >> return i
86− [ bench "discard" $ nfIO $ do
98+ in nfIO $ do
87− mapM_ (\i -> forkIO $ work i >> return ()) list
99+ ref <- newEmptyMVar
89− , bench "collect" $ nfIO $ do
91− mapM_ (\i -> forkIO $ work i >>=
100+ mapM_ (\i -> forkIO $ work i >>=
92− \j -> atomicModifyIORef ref $ \xs -> (j : xs, ())) list
101+ \j -> putMVar ref j) list
93− threadDelay 6000000
102+ replicateM 10000 (takeMVar ref)