@@ -0,0 +1,89 @@
1+{-# LANGUAGE RankNTypes #-}
2+-- |
3+-- Module : Main
4+-- Copyright : (c) 2018 Harendra Kumar
5+--
6+-- License : BSD3
7+-- Maintainer : harendra.kumar@gmail.com
8+
9+import Control.Concurrent
10+import Control.Monad (when)
11+-- import Data.IORef
12+
13+import Gauge
14+import Streamly
15+import qualified Streamly.Prelude as S
16+
17+-------------------------------------------------------------------------------
18+-- Append
19+-------------------------------------------------------------------------------
20+
21+-- Single work item yielded per thread
22+{-# INLINE append #-}
23+append :: IsStream t
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)
27+ in S.drain
28+ $ t
29+ $ maxBuffer buflen
30+ $ maxThreads (-1)
31+ $ S.fromFoldableM $ map work [1..tcount]
32+
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)))
38+ in S.drain
39+ $ adapt
40+ $ maxThreads (-1)
41+ $ maxBuffer buflen
42+ $ S.concatMapBy t work
43+ $ S.replicate threads elems
44+
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
52+ ]
53+
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
61+ ]
62+
63+main :: IO ()
64+main = do
65+ defaultMain
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)
72+ {-
73+ , bgroup "forkIO-5000ms-10k" $
74+ let delay = threadDelay 5000000
75+ count = 10000 :: Int
76+ list = [1..count]
77+ work i = delay >> return i
78+ in
79+ [ bench "discard" $ nfIO $ do
80+ mapM_ (\i -> forkIO $ work i >> return ()) list
81+ threadDelay 6000000
82+ , bench "collect" $ nfIO $ do
83+ ref <- newIORef []
84+ mapM_ (\i -> forkIO $ work i >>=
85+ \j -> atomicModifyIORef ref $ \xs -> (j : xs, ())) list
86+ threadDelay 6000000
87+ ]
88+ -}
89+ ]