git.iko.soy/streamly
on fe28607 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Stream/ConcurrentCommon.hs
207 lines 6.8 kB history raw
1{-# LANGUAGE FlexibleContexts #-}
2-- |
3-- Module : Main
4-- Copyright : (c) 2018 Composewell Technologies
5--
6-- License : BSD3
7-- Maintainer : streamly@composewell.com
9module Stream.ConcurrentCommon
10 ( allBenchmarks
11 )
12where
14import Stream.Common
15 (composeN, benchIO, benchIOSink, benchIOSrc, sourceUnfoldrM)
16import Streamly.Data.Stream (Stream)
17import Streamly.Internal.Data.Stream.Concurrent (MonadAsync, Config)
19import qualified Data.List as List
20import qualified Streamly.Data.Fold as Fold
21import qualified Streamly.Data.Stream as Stream
22import qualified Streamly.Internal.Data.Stream.Concurrent as Async
24import Gauge
25import Prelude hiding (mapM)
26import Streamly.Benchmark.Common
28-- XXX Write inspection tests to make sure no dictionaries are being passed
29-- around to find specialization issues. Could be really bad for perf.
31-------------------------------------------------------------------------------
32-- Mapping
33-------------------------------------------------------------------------------
35{-# INLINE mapM #-}
36mapM ::
37 MonadAsync m
38 => (Config -> Config)
39 -> Int
40 -> Stream m Int
41 -> m ()
42mapM f n = composeN n $ Async.parMapM f return
44o_1_space_mapping :: Int -> (Config -> Config) -> [Benchmark]
45o_1_space_mapping value f =
46 [ bgroup "mapping"
47 [ benchIOSink value "mapM" $ mapM f 1
48 ]
49 ]
51-------------------------------------------------------------------------------
52-- Size conserving transformations (reordering, buffering, etc.)
53-------------------------------------------------------------------------------
55o_n_heap_buffering :: Int -> (Config -> Config) -> [Benchmark]
56o_n_heap_buffering value f =
57 [ bgroup "buffered"
58 [ benchIOSink value "mkAsync"
59 (Stream.fold Fold.drain . Async.parEval f)
60 ]
61 ]
63-------------------------------------------------------------------------------
64-- Joining
65-------------------------------------------------------------------------------
67{-# INLINE async2 #-}
68async2 :: (Config -> Config) -> Int -> Int -> IO ()
69async2 f count n =
70 Stream.fold Fold.drain
71 $ Async.combineWith f
72 (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
74{-# INLINE concatAsync2 #-}
75concatAsync2 :: (Config -> Config) -> Int -> Int -> IO ()
76concatAsync2 f count n =
77 Stream.fold Fold.drain
78 $ Async.parConcat f
79 $ Stream.fromList
80 [sourceUnfoldrM count n, sourceUnfoldrM count (n + 1)]
82o_1_space_joining :: Int -> (Config -> Config) -> [Benchmark]
83o_1_space_joining value f =
84 [ bgroup "joining"
85 [ benchIOSrc1 "async (2 of n/2)" (async2 f (value `div` 2))
86 , benchIOSrc1 "concat async (2 of n/2)" (concatAsync2 f (value `div` 2))
87 ]
88 ]
90-------------------------------------------------------------------------------
91-- Concat
92-------------------------------------------------------------------------------
94{-# INLINE sourceFoldMapWith #-}
95sourceFoldMapWith :: (Config -> Config) -> Int -> Int -> Stream IO Int
96sourceFoldMapWith f value n =
97 Async.parConcatMap f Stream.fromPure $ Stream.fromList [n..n+value]
99{-# INLINE sourceFoldMapWithStream #-}
100sourceFoldMapWithStream :: (Config -> Config) -> Int -> Int -> Stream IO Int
101sourceFoldMapWithStream f value n =
102 Async.parConcatMap f Stream.fromPure
103 $ Stream.enumerateFromTo n (n + value)
105{-# INLINE concatFoldableWith #-}
106concatFoldableWith :: (Config -> Config) -> Int -> Int -> Stream IO Int
107concatFoldableWith f value n =
108 let step x =
109 if x <= n + value
110 then Just (Stream.fromPure x, x + 1)
111 else Nothing
112 list = List.unfoldr step n
113 in Async.parConcat f (Stream.fromList list)
115o_1_space_concatFoldable :: Int -> (Config -> Config) -> [Benchmark]
116o_1_space_concatFoldable value f =
117 [ bgroup "concat-foldable"
118 [ benchIOSrc "foldMapWith (<>) (List)"
119 (sourceFoldMapWith f value)
120 , benchIOSrc "foldMapWith (<>) (Stream)"
121 (sourceFoldMapWithStream f value)
122 , benchIOSrc "S.concatFoldableWith (<>) (List)"
123 (concatFoldableWith f value)
124 ]
125 ]
127{-# INLINE concatMapStreamsWith #-}
128concatMapStreamsWith
129 :: (Config -> Config)
130 -> Int
131 -> Int
132 -> Int
133 -> IO ()
134concatMapStreamsWith f outer inner n =
135 Stream.fold Fold.drain
136 $ Async.parConcatMap f (sourceUnfoldrM inner) (sourceUnfoldrM outer n)
138{-# INLINE concatFmapStreamsWith #-}
139concatFmapStreamsWith
140 :: (Config -> Config)
141 -> Int
142 -> Int
143 -> Int
144 -> IO ()
145concatFmapStreamsWith f outer inner n =
146 Stream.fold Fold.drain
147 $ Async.parConcat f
148 $ fmap (sourceUnfoldrM inner) (sourceUnfoldrM outer n)
150o_1_space_concatMap :: Int -> (Config -> Config) -> [Benchmark]
151o_1_space_concatMap value f =
152 value2 `seq`
153 [ bgroup "concat"
154 [ benchIO "parConcatMap (n of 1)"
155 (concatMapStreamsWith f value 1)
156 , benchIO "parConcatMap (sqrt x of sqrt x)"
157 (concatMapStreamsWith f value2 value2)
158 , benchIO "parConcatMap (1 of n)"
159 (concatMapStreamsWith f 1 value)
160 , benchIO "concat . fmap (n of 1)"
161 (concatFmapStreamsWith f value 1)
162 ]
163 ]
165 where
167 value2 = round $ sqrt (fromIntegral value :: Double)
169-------------------------------------------------------------------------------
170-- Monadic outer product
171-------------------------------------------------------------------------------
173{-# INLINE toNullAp #-}
174toNullAp :: (Config -> Config) -> Int -> Int -> IO ()
175toNullAp f linearCount start =
176 Stream.fold Fold.drain
177 $ Async.parApply f
178 (fmap (+) (sourceUnfoldrM nestedCount2 start))
179 (sourceUnfoldrM nestedCount2 start)
181 where
183 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
185o_1_space_outerProduct :: Int -> (Config -> Config) -> [Benchmark]
186o_1_space_outerProduct value f =
187 [ bgroup "monad-outer-product"
188 [ benchIO "toNullAp" $ toNullAp f value
189 ]
190 ]
192-------------------------------------------------------------------------------
193-- Benchmark sets
194-------------------------------------------------------------------------------
196allBenchmarks :: String -> (Config -> Config) -> Int -> [Benchmark]
197allBenchmarks moduleName modifier value =
198 [ bgroup (o_1_space_prefix moduleName) $ concat
199 [ o_1_space_mapping value modifier
200 , o_1_space_concatFoldable value modifier
201 , o_1_space_concatMap value modifier
202 , o_1_space_outerProduct value modifier
203 , o_1_space_joining value modifier
204 ]
205 , bgroup (o_n_heap_prefix moduleName)
206 (o_n_heap_buffering value modifier)
207 ]