git.iko.soy/streamly
on 4eaeb10 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Stream/Async.hs
224 lines 7.1 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
9import Stream.Common
10 (composeN, benchIO, benchIOSink, benchIOSrc, sourceUnfoldrM)
11import Streamly.Data.Stream (Stream)
12import Streamly.Internal.Data.Stream.Async (MonadAsync)
14import qualified Data.List as List
15import qualified Streamly.Data.Fold as Fold
16import qualified Streamly.Data.Stream as Stream
17import qualified Streamly.Internal.Data.Stream.Async as Async
19import Gauge
20import Prelude hiding (mapM)
21import Streamly.Benchmark.Common
23moduleName :: String
24moduleName = "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-------------------------------------------------------------------------------
30-- Mapping
31-------------------------------------------------------------------------------
33{-# INLINE mapM #-}
34mapM ::
35 MonadAsync m
36 => Int
37 -> Stream m Int
38 -> m ()
39mapM n = composeN n $ Async.mapM return
41o_1_space_mapping :: Int -> [Benchmark]
42o_1_space_mapping value =
43 [ bgroup "mapping"
44 [ benchIOSink value "mapM" $ mapM 1
45 ]
46 ]
48-------------------------------------------------------------------------------
49-- Size conserving transformations (reordering, buffering, etc.)
50-------------------------------------------------------------------------------
52o_n_heap_buffering :: Int -> [Benchmark]
53o_n_heap_buffering value =
54 [ bgroup "buffered"
55 [benchIOSink value "mkAsync" (Stream.fold Fold.drain . Async.eval)]
56 ]
58-------------------------------------------------------------------------------
59-- Joining
60-------------------------------------------------------------------------------
62{-# INLINE async2 #-}
63async2 :: Int -> Int -> IO ()
64async2 count n =
65 Stream.fold Fold.drain $
66 sourceUnfoldrM count n `Async.append` sourceUnfoldrM count (n + 1)
68{-# INLINE concatAsync2 #-}
69concatAsync2 :: Int -> Int -> IO ()
70concatAsync2 count n =
71 Stream.fold Fold.drain $
72 Async.concatList [sourceUnfoldrM count n, sourceUnfoldrM count (n + 1)]
74{-# INLINE interleave2 #-}
75interleave2 :: Int -> Int -> IO ()
76interleave2 count n =
77 Stream.fold Fold.drain $
78 sourceUnfoldrM count n `Async.interleave` sourceUnfoldrM count (n + 1)
80o_1_space_joining :: Int -> [Benchmark]
81o_1_space_joining value =
82 [ bgroup "joining"
83 [ benchIOSrc1 "async (2 of n/2)" (async2 (value `div` 2))
84 , benchIOSrc1 "concat async (2 of n/2)" (concatAsync2 (value `div` 2))
85 , benchIOSrc1 "interleave (2 of n/2)" (interleave2 (value `div` 2))
86 ]
87 ]
89-------------------------------------------------------------------------------
90-- Concat
91-------------------------------------------------------------------------------
93{-# INLINE sourceFoldMapWith #-}
94sourceFoldMapWith :: Int -> Int -> Stream IO Int
95sourceFoldMapWith value n =
96 Async.concatMap Stream.fromPure $ Stream.fromList [n..n+value]
98{-# INLINE sourceFoldMapWithStream #-}
99sourceFoldMapWithStream :: Int -> Int -> Stream IO Int
100sourceFoldMapWithStream value n =
101 Async.concatMap Stream.fromPure $ Stream.enumerateFromTo n (n + value)
103{-# INLINE concatFoldableWith #-}
104concatFoldableWith :: Int -> Int -> Stream IO Int
105concatFoldableWith value n =
106 let step x =
107 if x <= n + value
108 then Just (Stream.fromPure x, x + 1)
109 else Nothing
110 list = List.unfoldr step n
111 in Async.concatList list
113o_1_space_concatFoldable :: Int -> [Benchmark]
114o_1_space_concatFoldable value =
115 [ bgroup "concat-foldable"
116 [ benchIOSrc "foldMapWith (<>) (List)"
117 (sourceFoldMapWith value)
118 , benchIOSrc "foldMapWith (<>) (Stream)"
119 (sourceFoldMapWithStream value)
120 , benchIOSrc "S.concatFoldableWith (<>) (List)"
121 (concatFoldableWith value)
122 ]
123 ]
125{-# INLINE concatMapStreamsWith #-}
126concatMapStreamsWith
127 :: Int
128 -> Int
129 -> Int
130 -> IO ()
131concatMapStreamsWith outer inner n =
132 Stream.fold Fold.drain
133 $ Async.concatMap (sourceUnfoldrM inner) (sourceUnfoldrM outer n)
135{-# INLINE concatFmapStreamsWith #-}
136concatFmapStreamsWith
137 :: Int
138 -> Int
139 -> Int
140 -> IO ()
141concatFmapStreamsWith outer inner n =
142 Stream.fold Fold.drain
143 $ Async.concat
144 $ fmap (sourceUnfoldrM inner) (sourceUnfoldrM outer n)
146{-# INLINE concatMapInterleaveStreamsWith #-}
147concatMapInterleaveStreamsWith
148 :: Int
149 -> Int
150 -> Int
151 -> IO ()
152concatMapInterleaveStreamsWith outer inner n =
153 Stream.fold Fold.drain
154 $ Async.concatMapInterleave
155 (sourceUnfoldrM inner) (sourceUnfoldrM outer n)
157o_1_space_concatMap :: Int -> [Benchmark]
158o_1_space_concatMap value =
159 value2 `seq`
160 [ bgroup "concat"
161 [ benchIO "concatMapWith (n of 1)"
162 (concatMapStreamsWith value 1)
163 , benchIO "concatMapWith (sqrt x of sqrt x)"
164 (concatMapStreamsWith value2 value2)
165 , benchIO "concatMapWith (1 of n)"
166 (concatMapStreamsWith 1 value)
167 , benchIO "concat . fmap (n of 1)"
168 (concatFmapStreamsWith value 1)
169 , benchIO "concatMapInterleaveWith (n of 1)"
170 (concatMapInterleaveStreamsWith value 1)
171 , benchIO "concatMapInterleaveWith (sqrt x of sqrt x)"
172 (concatMapInterleaveStreamsWith value2 value2)
173 , benchIO "concatMapInterleaveWith (1 of n)"
174 (concatMapInterleaveStreamsWith 1 value)
175 ]
176 ]
178 where
180 value2 = round $ sqrt (fromIntegral value :: Double)
182-------------------------------------------------------------------------------
183-- Monadic outer product
184-------------------------------------------------------------------------------
186{-# INLINE toNullAp #-}
187toNullAp :: Int -> Int -> IO ()
188toNullAp linearCount start =
189 Stream.fold Fold.drain
190 $ Async.apply
191 (fmap (+) (sourceUnfoldrM nestedCount2 start))
192 (sourceUnfoldrM nestedCount2 start)
194 where
196 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
198o_1_space_outerProduct :: Int -> [Benchmark]
199o_1_space_outerProduct value =
200 [ bgroup "monad-outer-product"
201 [ benchIO "toNullAp" $ toNullAp value
202 ]
203 ]
205-------------------------------------------------------------------------------
206-- Main
207-------------------------------------------------------------------------------
209main :: IO ()
210main = runWithCLIOpts defaultStreamSize allBenchmarks
213 where
215 allBenchmarks value =
216 [ bgroup (o_1_space_prefix moduleName) $ concat
217 [ o_1_space_mapping value
218 , o_1_space_concatFoldable value
219 , o_1_space_concatMap value
220 , o_1_space_outerProduct value
221 , o_1_space_joining value
222 ]
223 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_buffering value)
224 ]