@@ -0,0 +1,193 @@
1+{-# LANGUAGE FlexibleContexts #-}
4+-- Copyright : (c) 2018 Composewell Technologies
7+-- Maintainer : streamly@composewell.com
10+ (composeN, benchIO, benchIOSink, benchIOSrc, sourceUnfoldrM)
11+import Streamly.Data.Stream (Stream)
12+import Streamly.Internal.Data.Stream.Async (MonadAsync)
14+import qualified Data.List as List
15+import qualified Streamly.Data.Fold as Fold
16+import qualified Streamly.Data.Stream as Stream
17+import qualified Streamly.Internal.Data.Stream.Async as Async
20+import Prelude hiding (mapM)
21+import Streamly.Benchmark.Common
24+moduleName = "Data.Stream.Async"
26+-- XXX Write inspection tests to make sure no dictionaries are being passed
27+-- around to find specialization issues. Could be really bad for perf.
29+-------------------------------------------------------------------------------
31+-------------------------------------------------------------------------------
39+mapM n = composeN n $ Async.mapM return
41+o_1_space_mapping :: Int -> [Benchmark]
42+o_1_space_mapping value =
44+ [ benchIOSink value "mapM" $ mapM 1
48+-------------------------------------------------------------------------------
49+-- Size conserving transformations (reordering, buffering, etc.)
50+-------------------------------------------------------------------------------
52+o_n_heap_buffering :: Int -> [Benchmark]
53+o_n_heap_buffering value =
55+ [benchIOSink value "mkAsync" (Stream.fold Fold.drain . Async.eval)]
58+-------------------------------------------------------------------------------
60+-------------------------------------------------------------------------------
63+async2 :: Int -> Int -> IO ()
65+ Stream.fold Fold.drain $
66+ sourceUnfoldrM count n `Async.append` sourceUnfoldrM count (n + 1)
68+o_1_space_joining :: Int -> [Benchmark]
69+o_1_space_joining value =
71+ [ benchIOSrc1 "async (2 of n/2)" (async2 (value `div` 2))
75+-------------------------------------------------------------------------------
77+-------------------------------------------------------------------------------
79+{-# INLINE sourceFoldMapWith #-}
80+sourceFoldMapWith :: Int -> Int -> Stream IO Int
81+sourceFoldMapWith value n =
82+ Async.concatMap Stream.fromPure $ Stream.fromList [n..n+value]
84+{-# INLINE sourceFoldMapWithStream #-}
85+sourceFoldMapWithStream :: Int -> Int -> Stream IO Int
86+sourceFoldMapWithStream value n =
87+ Async.concatMap Stream.fromPure $ Stream.enumerateFromTo n (n + value)
89+{-# INLINE concatFoldableWith #-}
90+concatFoldableWith :: Int -> Int -> Stream IO Int
91+concatFoldableWith value n =
94+ then Just (Stream.fromPure x, x + 1)
96+ list = List.unfoldr step n
97+ in Async.concatList list
99+o_1_space_concatFoldable :: Int -> [Benchmark]
100+o_1_space_concatFoldable value =
101+ [ bgroup "concat-foldable"
102+ [ benchIOSrc "foldMapWith (<>) (List)"
103+ (sourceFoldMapWith value)
104+ , benchIOSrc "foldMapWith (<>) (Stream)"
105+ (sourceFoldMapWithStream value)
106+ , benchIOSrc "S.concatFoldableWith (<>) (List)"
107+ (concatFoldableWith value)
111+{-# INLINE concatMapStreamsWith #-}
117+concatMapStreamsWith outer inner n =
118+ Stream.fold Fold.drain
119+ $ Async.concatMap (sourceUnfoldrM inner) (sourceUnfoldrM outer n)
121+{-# INLINE concatFmapStreamsWith #-}
122+concatFmapStreamsWith
127+concatFmapStreamsWith outer inner n =
128+ Stream.fold Fold.drain
130+ $ fmap (sourceUnfoldrM inner) (sourceUnfoldrM outer n)
132+o_1_space_concatMap :: Int -> [Benchmark]
133+o_1_space_concatMap value =
136+ [ benchIO "concatMapWith (n of 1)"
137+ (concatMapStreamsWith value 1)
138+ , benchIO "concatMapWith (sqrt x of sqrt x)"
139+ (concatMapStreamsWith value2 value2)
140+ , benchIO "concatMapWith (1 of n)"
141+ (concatMapStreamsWith 1 value)
142+ , benchIO "concat . fmap (n of 1)"
143+ (concatFmapStreamsWith value 1)
149+ value2 = round $ sqrt (fromIntegral value :: Double)
151+-------------------------------------------------------------------------------
152+-- Monadic outer product
153+-------------------------------------------------------------------------------
155+{-# INLINE toNullAp #-}
156+toNullAp :: Int -> Int -> IO ()
157+toNullAp linearCount start =
158+ Stream.fold Fold.drain
160+ (fmap (+) (sourceUnfoldrM nestedCount2 start))
161+ (sourceUnfoldrM nestedCount2 start)
165+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
167+o_1_space_outerProduct :: Int -> [Benchmark]
168+o_1_space_outerProduct value =
169+ [ bgroup "monad-outer-product"
170+ [ benchIO "toNullAp" $ toNullAp value
174+-------------------------------------------------------------------------------
176+-------------------------------------------------------------------------------
179+main = runWithCLIOpts defaultStreamSize allBenchmarks
184+ allBenchmarks value =
185+ [ bgroup (o_1_space_prefix moduleName) $ concat
186+ [ o_1_space_mapping value
187+ , o_1_space_concatFoldable value
188+ , o_1_space_concatMap value
189+ , o_1_space_outerProduct value
190+ , o_1_space_joining value
192+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_buffering value)