@@ -0,0 +1,89 @@
1+{-# LANGUAGE RankNTypes #-}
4+-- Copyright : (c) 2018 Harendra Kumar
7+-- Maintainer : harendra.kumar@gmail.com
9+import Control.Concurrent
10+import Control.Monad (when)
15+import qualified Streamly.Prelude as S
17+-------------------------------------------------------------------------------
19+-------------------------------------------------------------------------------
21+-- Single work item yielded per thread
24+ => Int -> Int -> Int -> (t IO Int -> SerialT IO Int) -> IO ()
25+append buflen tcount d t =
26+ let work = (\i -> when (d /= 0) (threadDelay d) >> return i)
31+ $ S.fromFoldableM $ map work [1..tcount]
33+-- Big stream of items yielded per thread
34+{-# INLINE concated #-}
35+concated :: Int -> Int -> Int -> Int -> (forall a. SerialT IO a -> SerialT IO a -> SerialT IO a) -> IO ()
36+concated buflen threads d elems t =
37+ let work = (\i -> (S.replicateM i ((when (d /= 0) (threadDelay d)) >> return i)))
42+ $ S.concatMapBy t work
43+ $ S.replicate threads elems
45+appendGroup :: Int -> Int -> Int -> [Benchmark]
46+appendGroup buflen threads delay =
47+ [ -- bench "serial" $ nfIO $ append buflen threads delay serially
48+ bench "ahead" $ nfIO $ append buflen threads delay aheadly
49+ , bench "async" $ nfIO $ append buflen threads delay asyncly
50+ , bench "wAsync" $ nfIO $ append buflen threads delay wAsyncly
51+ , bench "parallel" $ nfIO $ append buflen threads delay parallely
54+concatGroup :: Int -> Int -> Int -> Int -> [Benchmark]
55+concatGroup buflen threads delay n =
56+ [ bench "serial" $ nfIO $ concated buflen threads delay n serial
57+ , bench "ahead" $ nfIO $ concated buflen threads delay n ahead
58+ , bench "async" $ nfIO $ concated buflen threads delay n async
59+ , bench "wAsync" $ nfIO $ concated buflen threads delay n wAsync
60+ , bench "parallel" $ nfIO $ concated buflen threads delay n parallel
66+ [ -- bgroup "append/buf-1-threads-10k-0sec" (appendGroup 1 10000 0)
67+ -- , bgroup "append/buf-100-threads-100k-0sec" (appendGroup 100 100000 0)
68+ bgroup "append/buf-10k-threads-10k-5sec" (appendGroup 10000 10000 5000000)
69+ -- bgroup "concat/buf-1-threads-100k-count-1" (concatGroup 1 100000 0 1)
70+ -- bgroup "concat/buf-1-threads-1-count-10m" (concatGroup 1 1 0 10000000)
71+ , bgroup "concat/buf-100-threads-100-count-500k" (concatGroup 100 100 0 500000)
73+ , bgroup "forkIO-5000ms-10k" $
74+ let delay = threadDelay 5000000
77+ work i = delay >> return i
79+ [ bench "discard" $ nfIO $ do
80+ mapM_ (\i -> forkIO $ work i >> return ()) list
82+ , bench "collect" $ nfIO $ do
84+ mapM_ (\i -> forkIO $ work i >>=
85+ \j -> atomicModifyIORef ref $ \xs -> (j : xs, ())) list