git.iko.soy/streamly
on master help sign in
Add more Prelude.Serial benchmarks to Data.Stream
bfb1624Harendra Kumar
.github/workflows/regression-check.yml+1−1
compare with master
unifiedsplit
@@ -25,11 +25,11 @@ jobs:
25 Data.Parser.ParserD
25 Data.Parser.ParserD
26 Data.Parser.ParserK
26 Data.Parser.ParserK
27 Data.SmallArray
27 Data.SmallArray
28− Data.Stream
29 Data.Stream.StreamD
28 Data.Stream.StreamD
30 Data.Stream.StreamDK
29 Data.Stream.StreamDK
31 Data.Stream.StreamK:6
30 Data.Stream.StreamK:6
32 Data.Unfold
31 Data.Unfold
32+ Data.Stream
33 FileSystem.Handle
33 FileSystem.Handle
34 Prelude.Ahead
34 Prelude.Ahead
35 Prelude.Async:12
35 Prelude.Async:12
.hlint.yaml+5−5
@@ -26,11 +26,11 @@
26- ignore: {name: "Use fmap"}
26- ignore: {name: "Use fmap"}
27
27
28# Warnings ignored in specific places
28# Warnings ignored in specific places
29−- ignore: {name: "Use ++", within: Stream.Transformation}
29+- ignore: {name: "Use ++", within: Stream.Transform}
30−- ignore: {name: "Use mapM", within: Stream.Transformation}
30+- ignore: {name: "Use mapM", within: Stream.Transform}
31−- ignore: {name: "Use traverse", within: Stream.Transformation}
31+- ignore: {name: "Use traverse", within: Stream.Transform}
32−- ignore: {name: "Redundant <*", within: Stream.NestedStream}
32+- ignore: {name: "Redundant <*", within: Stream.Expand}
33−- ignore: {name: "Use ++", within: Stream.NestedStream}
33+- ignore: {name: "Use ++", within: Stream.Reduce}
34- ignore: {name: "Use ++", within: Stream.Split}
34- ignore: {name: "Use ++", within: Stream.Split}
35- ignore: {name: "Redundant bracket", within: Stream.Split}
35- ignore: {name: "Redundant bracket", within: Stream.Split}
36- ignore: {name: "Use isDigit", within: Streamly.Internal.Unicode.Char.Parser}
36- ignore: {name: "Use isDigit", within: Streamly.Internal.Unicode.Char.Parser}
benchmark/Streamly/Benchmark/Data/Stream.hs+9−11
@@ -15,15 +15,14 @@ import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
15
15
16import qualified Stream.Eliminate as Elimination
16import qualified Stream.Eliminate as Elimination
17import qualified Stream.Exceptions as Exceptions
17import qualified Stream.Exceptions as Exceptions
18+import qualified Stream.Expand as NestedStream
18import qualified Stream.Generate as Generation
19import qualified Stream.Generate as Generation
19import qualified Stream.Lift as Lift
20import qualified Stream.Lift as Lift
20−import qualified Stream.Reduce as Reduction
21+import qualified Stream.Reduce as NestedFold
21−import qualified Stream.Transformation as Transformation
22#ifdef USE_PRELUDE
22#ifdef USE_PRELUDE
23−import qualified Stream.NestedFold as NestedFold
24−import qualified Stream.NestedStream as NestedStream
25import qualified Stream.Split as Split
23import qualified Stream.Split as Split
26#endif
24#endif
25+import qualified Stream.Transform as Transformation
27
26
28import Streamly.Benchmark.Common
27import Streamly.Benchmark.Common
29
28
@@ -45,15 +44,14 @@ main = do
45 where
44 where
46
45
47 allBenchmarks env size = Prelude.concat
46 allBenchmarks env size = Prelude.concat
47+ [ Generation.benchmarks moduleName size
48− [ Elimination.benchmarks moduleName size
48+ , Elimination.benchmarks moduleName size
49 , Exceptions.benchmarks moduleName env size
49 , Exceptions.benchmarks moduleName env size
50− , Generation.benchmarks moduleName size
51− , Lift.benchmarks moduleName size
52− , Reduction.benchmarks moduleName size
53− , Transformation.benchmarks moduleName size
54#ifdef USE_PRELUDE
50#ifdef USE_PRELUDE
55− , NestedFold.benchmarks moduleName size
56− , NestedStream.benchmarks moduleName size
57 , Split.benchmarks moduleName env
51 , Split.benchmarks moduleName env
58#endif
52#endif
53+ , Transformation.benchmarks moduleName size
54+ , NestedFold.benchmarks moduleName size
55+ , Lift.benchmarks moduleName size
56+ , NestedStream.benchmarks moduleName size
59 ]
57 ]
benchmark/Streamly/Benchmark/Data/Stream/Common.hs+416−14
@@ -1,3 +1,8 @@
1+{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE CPP #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
5+
1-- |
6-- |
2-- Module : Stream.Common
7-- Module : Stream.Common
3-- Copyright : (c) 2018 Composewell Technologies
8-- Copyright : (c) 2018 Composewell Technologies
@@ -5,40 +10,164 @@
5-- Maintainer : streamly@composewell.com
10-- Maintainer : streamly@composewell.com
6
11
7module Stream.Common
12module Stream.Common
13+ ( MonadAsync
14+
15+ -- Generation
16+ , enumerateFromTo
17+ , replicate
18+ , unfoldrM
19+ , fromListM
20+
21+ , append
22+ , append2
23+
24+ -- Elimination
25+ , drain
26+ , foldl'
27+ , scanl'
28+
29+ -- Benchmark stream generation
8− ( sourceUnfoldr
30+ , sourceUnfoldr
9 , sourceUnfoldrM
31 , sourceUnfoldrM
10 , sourceUnfoldrAction
32 , sourceUnfoldrAction
33+ , sourceConcatMapId
34+ , sourceFromFoldable
35+ , sourceFromFoldableM
36+
37+ -- Benchmark stream elimination
11 , benchIOSink
38 , benchIOSink
12 , benchIOSrc
39 , benchIOSrc
40+
41+ -- Benchmarking functions
42+ , concatStreamsWith
43+ , concatPairsWith
44+ , apDiscardFst
45+ , apDiscardSnd
46+ , apLiftA2
47+ , toNullAp
48+ , monadThen
49+ , toNullM
50+ , toNullM3
51+ , filterAllOutM
52+ , filterAllInM
53+ , filterSome
54+ , breakAfterSome
55+ , toListM
56+ , toListSome
57+ , composeN
58+ , mapN
59+ , mapM
60+ , transformMapM
61+ , transformComposeMapM
62+ , transformTeeMapM
63+ , transformZipMapM
13 )
64 )
14where
65where
15
66
67+import Control.Applicative (liftA2)
68+import Control.Exception (try)
69+import GHC.Exception (ErrorCall)
16−import Streamly.Internal.Data.Stream (Stream, unfold)
70+import Streamly.Internal.Data.Stream (Stream)
71+import System.Random (randomRIO)
72+
17import qualified Streamly.Internal.Data.Fold as Fold
73import qualified Streamly.Internal.Data.Fold as Fold
18−import qualified Streamly.Internal.Data.Stream as Stream
74+import qualified Streamly.Internal.Data.Pipe as Pipe
75+
76+#ifdef USE_PRELUDE
77+import Streamly.Prelude (foldl', scanl')
19−import qualified Streamly.Internal.Data.Unfold as UF
78+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
79+import qualified Streamly.Prelude as Stream
80+import Streamly.Benchmark.Prelude
81+ ( composeN, sourceUnfoldr, sourceUnfoldr, sourceFromFoldable
82+ , sourceFromFoldableM, sourceUnfoldrAction, sourceConcatMapId, benchIOSink
83+ , concatStreamsWith, concatPairsWith
84+ )
85+#else
20import Control.DeepSeq (NFData)
86import Control.DeepSeq (NFData)
87+import Streamly.Internal.Data.Stream (unfold)
88+import qualified Streamly.Internal.Data.Stream as Stream
89+import qualified Streamly.Internal.Data.Unfold as Unfold
90+#endif
91+
21import Gauge
92import Gauge
22−import Prelude hiding (mapM)
93+import Prelude hiding (mapM, replicate)
23−import System.Random (randomRIO)
94+
95+#ifdef USE_PRELUDE
96+type MonadAsync m = Stream.MonadAsync m
97+#else
98+type MonadAsync = Monad
99+#endif
100+
101+{-# INLINE append #-}
102+append :: Stream m a -> Stream m a -> Stream m a
103+#ifdef USE_PRELUDE
104+append = Stream.serial
105+#else
106+append = Stream.append
107+#endif
108+
109+{-# INLINE append2 #-}
110+append2 :: Monad m => Stream m a -> Stream m a -> Stream m a
111+#ifdef USE_PRELUDE
112+append2 = Stream.append
113+#else
114+append2 = Stream.append2
115+#endif
116+
117+{-# INLINE drain #-}
118+drain :: Monad m => Stream m a -> m ()
119+drain = Stream.fold Fold.drain
24
120
25−{-# INLINE toNull #-}
121+{-# INLINE enumerateFromTo #-}
26−toNull :: Monad m => Stream m a -> m ()
122+enumerateFromTo :: Monad m => Int -> Int -> Stream m Int
27−toNull = Stream.fold Fold.drain
123+#ifdef USE_PRELUDE
124+enumerateFromTo = Stream.enumerateFromTo
125+#else
126+enumerateFromTo from to = Stream.unfold Unfold.enumerateFromTo (from, to)
127+#endif
128+
129+{-# INLINE replicate #-}
130+replicate :: Monad m => Int -> a -> Stream m a
131+#ifdef USE_PRELUDE
132+replicate = Stream.replicate
133+#else
134+replicate n = Stream.unfold (Unfold.replicateM n) . return
135+#endif
136+
137+{-# INLINE unfoldrM #-}
138+unfoldrM :: MonadAsync m => (b -> m (Maybe (a, b))) -> b -> Stream m a
139+#ifdef USE_PRELUDE
140+unfoldrM = Stream.unfoldrM
141+#else
142+unfoldrM step = Stream.unfold (Unfold.unfoldrM step)
143+#endif
144+
145+{-# INLINE fromListM #-}
146+fromListM :: MonadAsync m => [m a] -> Stream m a
147+#ifdef USE_PRELUDE
148+fromListM = Stream.fromListM
149+#else
150+fromListM = Stream.unfold Unfold.fromListM
151+#endif
28
152
29{-# INLINE sourceUnfoldrM #-}
153{-# INLINE sourceUnfoldrM #-}
30−sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
154+sourceUnfoldrM :: MonadAsync m => Int -> Int -> Stream m Int
31−sourceUnfoldrM count start = unfold (UF.unfoldrM step) start
155+sourceUnfoldrM count start = unfoldrM step start
156+
32 where
157 where
158+
33 step cnt =
159 step cnt =
34 if cnt > start + count
160 if cnt > start + count
35 then return Nothing
161 then return Nothing
36 else return (Just (cnt, cnt + 1))
162 else return (Just (cnt, cnt + 1))
37
163
164+#ifndef USE_PRELUDE
38{-# INLINE sourceUnfoldr #-}
165{-# INLINE sourceUnfoldr #-}
39sourceUnfoldr :: Monad m => Int -> Int -> Stream m Int
166sourceUnfoldr :: Monad m => Int -> Int -> Stream m Int
40−sourceUnfoldr count start = unfold (UF.unfoldr step) start
167+sourceUnfoldr count start = unfold (Unfold.unfoldr step) start
168+
41 where
169 where
170+
42 step cnt =
171 step cnt =
43 if cnt > start + count
172 if cnt > start + count
44 then Nothing
173 then Nothing
@@ -46,19 +175,30 @@ sourceUnfoldr count start = unfold (UF.unfoldr step) start
46
175
47{-# INLINE sourceUnfoldrAction #-}
176{-# INLINE sourceUnfoldrAction #-}
48sourceUnfoldrAction :: (Monad m1, Monad m) => Int -> Int -> Stream m (m1 Int)
177sourceUnfoldrAction :: (Monad m1, Monad m) => Int -> Int -> Stream m (m1 Int)
49−sourceUnfoldrAction value n = unfold (UF.unfoldr step) n
178+sourceUnfoldrAction value n = unfold (Unfold.unfoldr step) n
179+
50 where
180 where
181+
51 step cnt =
182 step cnt =
52 if cnt > n + value
183 if cnt > n + value
53 then Nothing
184 then Nothing
54 else Just (return cnt, cnt + 1)
185 else Just (return cnt, cnt + 1)
55
186
187+{-# INLINE sourceFromFoldable #-}
188+sourceFromFoldable :: Int -> Int -> Stream m Int
189+sourceFromFoldable value n = Stream.fromFoldable [n..n+value]
190+
191+{-# INLINE sourceFromFoldableM #-}
192+sourceFromFoldableM :: Monad m => Int -> Int -> Stream m Int
193+sourceFromFoldableM value n = Stream.fromFoldableM (fmap return [n..n+value])
194+
56{-# INLINE benchIOSink #-}
195{-# INLINE benchIOSink #-}
57benchIOSink
196benchIOSink
58 :: (NFData b)
197 :: (NFData b)
59 => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
198 => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
60benchIOSink value name f =
199benchIOSink value name f =
61 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
200 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
201+#endif
62
202
63-- | Takes a source, and uses it with a default drain/fold method.
203-- | Takes a source, and uses it with a default drain/fold method.
64{-# INLINE benchIOSrc #-}
204{-# INLINE benchIOSrc #-}
@@ -67,4 +207,266 @@ benchIOSrc
67 -> (Int -> Stream IO a)
207 -> (Int -> Stream IO a)
68 -> Benchmark
208 -> Benchmark
69benchIOSrc name f =
209benchIOSrc name f =
70− bench name $ nfIO $ randomRIO (1,1) >>= toNull . f
210+ bench name $ nfIO $ randomRIO (1,1) >>= drain . f
211+
212+#ifndef USE_PRELUDE
213+{-# INLINE concatStreamsWith #-}
214+concatStreamsWith
215+ :: (Stream IO Int -> Stream IO Int -> Stream IO Int)
216+ -> Int
217+ -> Int
218+ -> Int
219+ -> IO ()
220+concatStreamsWith op outer inner n =
221+ drain $ Stream.concatMapWith op
222+ (sourceUnfoldrM inner)
223+ (sourceUnfoldrM outer n)
224+
225+{-# INLINE concatPairsWith #-}
226+concatPairsWith
227+ :: (Stream IO Int -> Stream IO Int -> Stream IO Int)
228+ -> Int
229+ -> Int
230+ -> Int
231+ -> IO ()
232+concatPairsWith op outer inner n =
233+ drain $ Stream.concatPairsWith op
234+ (sourceUnfoldrM inner)
235+ (sourceUnfoldrM outer n)
236+
237+{-# INLINE sourceConcatMapId #-}
238+sourceConcatMapId :: (Monad m)
239+ => Int -> Int -> Stream m (Stream m Int)
240+sourceConcatMapId value n =
241+ Stream.fromFoldable $ fmap (Stream.fromEffect . return) [n..n+value]
242+#endif
243+
244+{-# INLINE apDiscardFst #-}
245+apDiscardFst :: MonadAsync m =>
246+ Int -> Int -> m ()
247+apDiscardFst linearCount start = drain $
248+ sourceUnfoldrM nestedCount2 start
249+ *> sourceUnfoldrM nestedCount2 start
250+
251+ where
252+
253+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
254+
255+{-# INLINE apDiscardSnd #-}
256+apDiscardSnd :: MonadAsync m => Int -> Int -> m ()
257+apDiscardSnd linearCount start = drain $
258+ sourceUnfoldrM nestedCount2 start
259+ <* sourceUnfoldrM nestedCount2 start
260+
261+ where
262+
263+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
264+
265+{-# INLINE apLiftA2 #-}
266+apLiftA2 :: MonadAsync m => Int -> Int -> m ()
267+apLiftA2 linearCount start = drain $
268+ liftA2 (+) (sourceUnfoldrM nestedCount2 start)
269+ (sourceUnfoldrM nestedCount2 start)
270+
271+ where
272+
273+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
274+
275+{-# INLINE toNullAp #-}
276+toNullAp :: MonadAsync m => Int -> Int -> m ()
277+toNullAp linearCount start = drain $
278+ (+) <$> sourceUnfoldrM nestedCount2 start
279+ <*> sourceUnfoldrM nestedCount2 start
280+
281+ where
282+
283+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
284+
285+{-# INLINE monadThen #-}
286+monadThen :: MonadAsync m => Int -> Int -> m ()
287+monadThen linearCount start = drain $ do
288+ sourceUnfoldrM nestedCount2 start >>
289+ sourceUnfoldrM nestedCount2 start
290+
291+ where
292+
293+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
294+
295+{-# INLINE toNullM #-}
296+toNullM :: MonadAsync m => Int -> Int -> m ()
297+toNullM linearCount start = drain $ do
298+ x <- sourceUnfoldrM nestedCount2 start
299+ y <- sourceUnfoldrM nestedCount2 start
300+ return $ x + y
301+
302+ where
303+
304+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
305+
306+{-# INLINE toNullM3 #-}
307+toNullM3 :: MonadAsync m => Int -> Int -> m ()
308+toNullM3 linearCount start = drain $ do
309+ x <- sourceUnfoldrM nestedCount3 start
310+ y <- sourceUnfoldrM nestedCount3 start
311+ z <- sourceUnfoldrM nestedCount3 start
312+ return $ x + y + z
313+ where
314+ nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
315+
316+{-# INLINE filterAllOutM #-}
317+filterAllOutM :: MonadAsync m => Int -> Int -> m ()
318+filterAllOutM linearCount start = drain $ do
319+ x <- sourceUnfoldrM nestedCount2 start
320+ y <- sourceUnfoldrM nestedCount2 start
321+ let s = x + y
322+ if s < 0
323+ then return s
324+ else Stream.nil
325+ where
326+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
327+
328+{-# INLINE filterAllInM #-}
329+filterAllInM :: MonadAsync m => Int -> Int -> m ()
330+filterAllInM linearCount start = drain $ do
331+ x <- sourceUnfoldrM nestedCount2 start
332+ y <- sourceUnfoldrM nestedCount2 start
333+ let s = x + y
334+ if s > 0
335+ then return s
336+ else Stream.nil
337+ where
338+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
339+
340+{-# INLINE filterSome #-}
341+filterSome :: MonadAsync m => Int -> Int -> m ()
342+filterSome linearCount start = drain $ do
343+ x <- sourceUnfoldrM nestedCount2 start
344+ y <- sourceUnfoldrM nestedCount2 start
345+ let s = x + y
346+ if s > 1100000
347+ then return s
348+ else Stream.nil
349+ where
350+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
351+
352+{-# INLINE breakAfterSome #-}
353+breakAfterSome :: Int -> Int -> IO ()
354+breakAfterSome linearCount start = do
355+ (_ :: Either ErrorCall ()) <- try $ drain $ do
356+ x <- sourceUnfoldrM nestedCount2 start
357+ y <- sourceUnfoldrM nestedCount2 start
358+ let s = x + y
359+ if s > 1100000
360+ then error "break"
361+ else return s
362+ return ()
363+ where
364+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
365+
366+{-# INLINE toListM #-}
367+toListM :: MonadAsync m => Int -> Int -> m [Int]
368+toListM linearCount start = Stream.fold Fold.toList $ do
369+ x <- sourceUnfoldrM nestedCount2 start
370+ y <- sourceUnfoldrM nestedCount2 start
371+ return $ x + y
372+ where
373+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
374+
375+-- Taking a specified number of elements is very expensive in logict so we have
376+-- a test to measure the same.
377+{-# INLINE toListSome #-}
378+toListSome :: MonadAsync m => Int -> Int -> m [Int]
379+toListSome linearCount start =
380+ Stream.fold Fold.toList $ Stream.take 10000 $ do
381+ x <- sourceUnfoldrM nestedCount2 start
382+ y <- sourceUnfoldrM nestedCount2 start
383+ return $ x + y
384+ where
385+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
386+
387+#ifndef USE_PRELUDE
388+{-# INLINE composeN #-}
389+composeN ::
390+ (Monad m)
391+ => Int
392+ -> (Stream m Int -> Stream m Int)
393+ -> Stream m Int
394+ -> m ()
395+composeN n f =
396+ case n of
397+ 1 -> drain . f
398+ 2 -> drain . f . f
399+ 3 -> drain . f . f . f
400+ 4 -> drain . f . f . f . f
401+ _ -> undefined
402+#endif
403+
404+{-# INLINE mapN #-}
405+mapN ::
406+ Monad m
407+ => Int
408+ -> Stream m Int
409+ -> m ()
410+mapN n = composeN n $ fmap (+ 1)
411+
412+{-# INLINE mapM #-}
413+mapM ::
414+ MonadAsync m
415+ => Int
416+ -> Stream m Int
417+ -> m ()
418+mapM n = composeN n $ Stream.mapM return
419+
420+#ifndef USE_PRELUDE
421+foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b
422+foldl' f z = Stream.fold (Fold.foldl' f z)
423+
424+scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b
425+scanl' f z = Stream.scan (Fold.foldl' f z)
426+#endif
427+
428+{-# INLINE transformMapM #-}
429+transformMapM ::
430+ (Monad m)
431+ => Int
432+ -> Stream m Int
433+ -> m ()
434+transformMapM n = composeN n $ Stream.transform (Pipe.mapM return)
435+
436+{-# INLINE transformComposeMapM #-}
437+transformComposeMapM ::
438+ (Monad m)
439+ => Int
440+ -> Stream m Int
441+ -> m ()
442+transformComposeMapM n =
443+ composeN n $
444+ Stream.transform
445+ (Pipe.mapM (\x -> return (x + 1)) `Pipe.compose`
446+ Pipe.mapM (\x -> return (x + 2)))
447+
448+{-# INLINE transformTeeMapM #-}
449+transformTeeMapM ::
450+ (Monad m)
451+ => Int
452+ -> Stream m Int
453+ -> m ()
454+transformTeeMapM n =
455+ composeN n $
456+ Stream.transform
457+ (Pipe.mapM (\x -> return (x + 1)) `Pipe.tee`
458+ Pipe.mapM (\x -> return (x + 2)))
459+
460+{-# INLINE transformZipMapM #-}
461+transformZipMapM ::
462+ (Monad m)
463+ => Int
464+ -> Stream m Int
465+ -> m ()
466+transformZipMapM n =
467+ composeN n $
468+ Stream.transform
469+ (Pipe.zipWith
470+ (+)
471+ (Pipe.mapM (\x -> return (x + 1)))
472+ (Pipe.mapM (\x -> return (x + 2))))
benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs+17−13
@@ -35,14 +35,13 @@ import qualified Streamly.Internal.Data.Stream.StreamD as D
35#endif
35#endif
36import qualified Streamly.Internal.Data.Fold as Fold
36import qualified Streamly.Internal.Data.Fold as Fold
37#ifdef USE_PRELUDE
37#ifdef USE_PRELUDE
38−import qualified Streamly.Prelude as S
39import qualified Streamly.Internal.Data.Stream.IsStream as S
38import qualified Streamly.Internal.Data.Stream.IsStream as S
40−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
41#else
39#else
42import qualified Streamly.Internal.Data.Stream as S
40import qualified Streamly.Internal.Data.Stream as S
43#endif
41#endif
44
42
45import Gauge
43import Gauge
44+-- XXX Replace SerialT with Stream
46import Streamly.Internal.Data.Stream.Serial (SerialT)
45import Streamly.Internal.Data.Stream.Serial (SerialT)
47#ifdef USE_PRELUDE
46#ifdef USE_PRELUDE
48import Streamly.Prelude (fromSerial)
47import Streamly.Prelude (fromSerial)
@@ -56,7 +55,6 @@ import Stream.Common
56 )
55 )
57#endif
56#endif
58import Streamly.Benchmark.Common
57import Streamly.Benchmark.Common
59−
60import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),
58import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),
61 lookup, repeat, minimum, maximum, product, last, mapM_, init)
59 lookup, repeat, minimum, maximum, product, last, mapM_, init)
62import qualified Prelude
60import qualified Prelude
@@ -66,6 +64,7 @@ import qualified Prelude
66repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
64repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
67repeat count = S.take count . S.repeat
65repeat count = S.take count . S.repeat
68#endif
66#endif
67+
69-------------------------------------------------------------------------------
68-------------------------------------------------------------------------------
70-- Elimination
69-- Elimination
71-------------------------------------------------------------------------------
70-------------------------------------------------------------------------------
@@ -281,6 +280,7 @@ uncons s = do
281 case r of
280 case r of
282 Nothing -> return ()
281 Nothing -> return ()
283 Just (_, t) -> uncons t
282 Just (_, t) -> uncons t
283+
284#ifdef USE_PRELUDE
284#ifdef USE_PRELUDE
285{-# INLINE init #-}
285{-# INLINE init #-}
286init :: Monad m => SerialT m a -> m ()
286init :: Monad m => SerialT m a -> m ()
@@ -308,6 +308,7 @@ foldrToStream = S.foldr S.cons S.nil
308{-# INLINE foldrMBuild #-}
308{-# INLINE foldrMBuild #-}
309foldrMBuild :: Monad m => SerialT m Int -> m [Int]
309foldrMBuild :: Monad m => SerialT m Int -> m [Int]
310foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])
310foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])
311+
311#ifdef USE_PRELUDE
312#ifdef USE_PRELUDE
312{-# INLINE foldl'Reduce #-}
313{-# INLINE foldl'Reduce #-}
313foldl'Reduce :: Monad m => SerialT m Int -> m Int
314foldl'Reduce :: Monad m => SerialT m Int -> m Int
@@ -411,12 +412,13 @@ drainWhile = S.drainWhile (const True)
411
412
412{-# INLINE (!!) #-}
413{-# INLINE (!!) #-}
413(!!) :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
414(!!) :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
414−(!!) = flip (Internal.!!)
415+(!!) = flip (S.!!)
415
416
416{-# INLINE lookup #-}
417{-# INLINE lookup #-}
417lookup :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
418lookup :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
418lookup val = S.lookup val . S.map (\x -> (x, x))
419lookup val = S.lookup val . S.map (\x -> (x, x))
419#endif
420#endif
421+
420o_1_space_elimination_folds :: Int -> [Benchmark]
422o_1_space_elimination_folds :: Int -> [Benchmark]
421o_1_space_elimination_folds value =
423o_1_space_elimination_folds value =
422 [ bgroup "elimination"
424 [ bgroup "elimination"
@@ -445,10 +447,10 @@ o_1_space_elimination_folds value =
445 ]
447 ]
446 , bgroup "Identity"
448 , bgroup "Identity"
447 [ benchIdentitySink value "foldrMElem" (foldrMElem value)
449 [ benchIdentitySink value "foldrMElem" (foldrMElem value)
448− , benchPureSink value "foldrMToListLength"
449− (Prelude.length . runIdentity . foldrMBuild)
450 , benchIdentitySink value "foldrToStreamLength"
450 , benchIdentitySink value "foldrToStreamLength"
451 (S.fold Fold.length . runIdentity . foldrToStream)
451 (S.fold Fold.length . runIdentity . foldrToStream)
452+ , benchPureSink value "foldrMToListLength"
453+ (Prelude.length . runIdentity . foldrMBuild)
452 ]
454 ]
453 ]
455 ]
454
456
@@ -467,7 +469,7 @@ o_1_space_elimination_folds value =
467 , benchIOSink value "mapM_" mapM_
469 , benchIOSink value "mapM_" mapM_
468
470
469 -- this is too fast, causes all benchmarks reported in ns
471 -- this is too fast, causes all benchmarks reported in ns
470− --, benchIOSink value "head" head
472+ -- , benchIOSink value "head" head
471 , benchIOSink value "last" last
473 , benchIOSink value "last" last
472 , benchIOSink value "length" length
474 , benchIOSink value "length" length
473 , benchIOSink value "sum" sum
475 , benchIOSink value "sum" sum
@@ -476,9 +478,8 @@ o_1_space_elimination_folds value =
476 , benchIOSink value "maximum" maximum
478 , benchIOSink value "maximum" maximum
477 , benchIOSink value "minimumBy" minimumBy
479 , benchIOSink value "minimumBy" minimumBy
478 , benchIOSink value "minimum" minimum
480 , benchIOSink value "minimum" minimum
479−#ifdef USE_PRELUDE
481+
480 , bench "the" $ nfIO $ randomRIO (1,1) >>= the . repeat value
482 , bench "the" $ nfIO $ randomRIO (1,1) >>= the . repeat value
481−#endif
482 , benchIOSink value "find" (find value)
483 , benchIOSink value "find" (find value)
483 , benchIOSink value "findM" (findM value)
484 , benchIOSink value "findM" (findM value)
484 -- , benchIOSink value "lookupFirst" (lookup 1)
485 -- , benchIOSink value "lookupFirst" (lookup 1)
@@ -487,7 +488,7 @@ o_1_space_elimination_folds value =
487 , benchIOSink value "findIndex" (findIndex value)
488 , benchIOSink value "findIndex" (findIndex value)
488 , benchIOSink value "elemIndex" (elemIndex value)
489 , benchIOSink value "elemIndex" (elemIndex value)
489 -- this is too fast, causes all benchmarks reported in ns
490 -- this is too fast, causes all benchmarks reported in ns
490− -- , benchIOSink value "null" S.null
491+ -- , benchIOSink value "null" S.null
491 , benchIOSink value "elem" (elem value)
492 , benchIOSink value "elem" (elem value)
492 , benchIOSink value "notElem" (notElem value)
493 , benchIOSink value "notElem" (notElem value)
493 , benchIOSink value "all" (all value)
494 , benchIOSink value "all" (all value)
@@ -504,6 +505,7 @@ o_1_space_elimination_folds value =
504-------------------------------------------------------------------------------
505-------------------------------------------------------------------------------
505-- Buffered Transformations by fold
506-- Buffered Transformations by fold
506-------------------------------------------------------------------------------
507-------------------------------------------------------------------------------
508+
507#ifdef USE_PRELUDE
509#ifdef USE_PRELUDE
508{-# INLINE foldl'Build #-}
510{-# INLINE foldl'Build #-}
509foldl'Build :: Monad m => SerialT m Int -> m [Int]
511foldl'Build :: Monad m => SerialT m Int -> m [Int]
@@ -559,14 +561,15 @@ o_n_space_elimination_foldr value =
559 , benchIOSink value "foldrM/reduce/IO (sum)" foldrMReduce
561 , benchIOSink value "foldrM/reduce/IO (sum)" foldrMReduce
560 ]
562 ]
561 ]
563 ]
564+
562#ifdef USE_PRELUDE
565#ifdef USE_PRELUDE
563o_n_heap_elimination_toList :: Int -> [Benchmark]
566o_n_heap_elimination_toList :: Int -> [Benchmark]
564o_n_heap_elimination_toList value =
567o_n_heap_elimination_toList value =
565 [ bgroup "toList"
568 [ bgroup "toList"
566 -- Converting the stream to a list or pure stream in a strict monad
569 -- Converting the stream to a list or pure stream in a strict monad
567− [ benchIOSink value "toListRev" Internal.toListRev
570+ [ benchIOSink value "toListRev" S.toListRev
568 , benchIOSink value "toStreamRev"
571 , benchIOSink value "toStreamRev"
569− (Internal.toStreamRev :: (SerialT IO Int -> IO (SerialT Identity Int)))
572+ (S.toStreamRev :: (SerialT IO Int -> IO (SerialT Identity Int)))
570 ]
573 ]
571 ]
574 ]
572
575
@@ -576,10 +579,11 @@ o_n_space_elimination_toList value =
576 -- Converting the stream to a list or pure stream in a strict monad
579 -- Converting the stream to a list or pure stream in a strict monad
577 [ benchIOSink value "toList" S.toList
580 [ benchIOSink value "toList" S.toList
578 , benchIOSink value "toStream"
581 , benchIOSink value "toStream"
579− (Internal.toStream :: (SerialT IO Int -> IO (SerialT Identity Int)))
582+ (S.toStream :: (SerialT IO Int -> IO (SerialT Identity Int)))
580 ]
583 ]
581 ]
584 ]
582#endif
585#endif
586+
583-------------------------------------------------------------------------------
587-------------------------------------------------------------------------------
584-- Multi-stream folds
588-- Multi-stream folds
585-------------------------------------------------------------------------------
589-------------------------------------------------------------------------------
benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs+47−61
@@ -7,6 +7,7 @@
7-- Portability : GHC
7-- Portability : GHC
8
8
9{-# LANGUAGE CPP #-}
9{-# LANGUAGE CPP #-}
10+{-# LANGUAGE FlexibleContexts #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE ScopedTypeVariables #-}
11
12
12#ifdef __HADDOCK_VERSION__
13#ifdef __HADDOCK_VERSION__
@@ -21,26 +22,24 @@
21module Stream.Exceptions (benchmarks) where
22module Stream.Exceptions (benchmarks) where
22
23
23import Control.Exception (SomeException, Exception, throwIO)
24import Control.Exception (SomeException, Exception, throwIO)
25+import Stream.Common (drain, enumerateFromTo)
26+import Streamly.Internal.Data.Stream.Serial (SerialT)
24import System.IO (Handle, hClose, hPutChar)
27import System.IO (Handle, hClose, hPutChar)
25
28
26import qualified Data.IORef as Ref
29import qualified Data.IORef as Ref
27import qualified Data.Map.Strict as Map
30import qualified Data.Map.Strict as Map
28−
31+import qualified Stream.Common as Common
29import qualified Streamly.FileSystem.Handle as FH
32import qualified Streamly.FileSystem.Handle as FH
30import qualified Streamly.Internal.Data.Unfold as IUF
33import qualified Streamly.Internal.Data.Unfold as IUF
31import qualified Streamly.Internal.FileSystem.Handle as IFH
34import qualified Streamly.Internal.FileSystem.Handle as IFH
32#ifdef USE_PRELUDE
35#ifdef USE_PRELUDE
33import qualified Streamly.Internal.Data.Stream.IsStream as Stream
36import qualified Streamly.Internal.Data.Stream.IsStream as Stream
34−import qualified Streamly.Prelude as S
35#else
37#else
36import qualified Streamly.Internal.Data.Stream as Stream
38import qualified Streamly.Internal.Data.Stream as Stream
37−import qualified Streamly.Internal.Data.Stream as S
38−import qualified Streamly.Internal.Data.Fold as Fold
39import qualified Streamly.Internal.Data.Unfold as Unfold
39import qualified Streamly.Internal.Data.Unfold as Unfold
40#endif
40#endif
41
41
42import Gauge hiding (env)
42import Gauge hiding (env)
43−import Streamly.Internal.Data.Stream.Serial (SerialT)
44import Prelude hiding (last, length)
43import Prelude hiding (last, length)
45import Streamly.Benchmark.Common
44import Streamly.Benchmark.Common
46import Streamly.Benchmark.Common.Handle
45import Streamly.Benchmark.Common.Handle
@@ -55,28 +54,14 @@ import qualified Streamly.Internal.Data.Stream.StreamD as D
55-- stream exceptions
54-- stream exceptions
56-------------------------------------------------------------------------------
55-------------------------------------------------------------------------------
57
56
58−drain :: SerialT IO a -> IO ()
57+{-# INLINE replicateM #-}
59−#ifdef USE_PRELUDE
58+replicateM :: Common.MonadAsync m => Int -> m a -> SerialT m a
60−drain = Stream.drain
61−#else
62−drain = Stream.fold Fold.drain
63−#endif
64−
65−enumerateFromTo :: Int -> Int -> SerialT IO Int
66#ifdef USE_PRELUDE
59#ifdef USE_PRELUDE
67−enumerateFromTo length from = S.enumerateFromTo from (from + length)
60+replicateM = Stream.replicateM
68#else
61#else
69−enumerateFromTo length from = Stream.unfold Unfold.enumerateFromTo (from, from + length)
62+replicateM = Stream.unfold . Unfold.replicateM
70#endif
63#endif
71
64
72−sourceRef :: (Num b) => Int -> Int -> Ref.IORef b -> SerialT IO b
73−#ifdef USE_PRELUDE
74−sourceRef length from ref = S.replicateM (from + length)
75−#else
76−sourceRef length from ref = Stream.unfold (Unfold.replicateM (from + length))
77−#endif
78− $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
79−
80data BenchException
65data BenchException
81 = BenchException1
66 = BenchException1
82 | BenchException2
67 | BenchException2
@@ -89,31 +74,32 @@ retryNoneSimple length from =
89 drain
74 drain
90 $ Stream.retry
75 $ Stream.retry
91 (Map.singleton BenchException1 length)
76 (Map.singleton BenchException1 length)
92− (const S.nil)
77+ (const Stream.nil)
93 source
78 source
94
79
95 where
80 where
96
81
97− source = enumerateFromTo length from
82+ source = enumerateFromTo from (from + length)
98
83
99retryNone :: Int -> Int -> IO ()
84retryNone :: Int -> Int -> IO ()
100retryNone length from = do
85retryNone length from = do
101 ref <- Ref.newIORef (0 :: Int)
86 ref <- Ref.newIORef (0 :: Int)
102 drain
87 drain
103− $ Stream.retry (Map.singleton BenchException1 length) (const S.nil)
88+ $ Stream.retry (Map.singleton BenchException1 length) (const Stream.nil)
104 $ source ref
89 $ source ref
105
90
106 where
91 where
107
92
108− source = sourceRef length from
93+ source ref =
109−
94+ replicateM (from + length)
95+ $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
110
96
111retryAll :: Int -> Int -> IO ()
97retryAll :: Int -> Int -> IO ()
112retryAll length from = do
98retryAll length from = do
113 ref <- Ref.newIORef 0
99 ref <- Ref.newIORef 0
114 drain
100 drain
115 $ Stream.retry
101 $ Stream.retry
116− (Map.singleton BenchException1 (length + from)) (const S.nil)
102+ (Map.singleton BenchException1 (length + from)) (const Stream.nil)
117 $ source ref
103 $ source ref
118
104
119 where
105 where
@@ -131,11 +117,11 @@ retryUnknown :: Int -> Int -> IO ()
131retryUnknown length from = do
117retryUnknown length from = do
132 drain
118 drain
133 $ Stream.retry (Map.singleton BenchException1 length) (const source)
119 $ Stream.retry (Map.singleton BenchException1 length) (const source)
134− $ throwIO BenchException2 `S.before` S.nil
120+ $ throwIO BenchException2 `Stream.before` Stream.nil
135
121
136 where
122 where
137
123
138− source = enumerateFromTo length from
124+ source = enumerateFromTo from (from + length)
139
125
140
126
141o_1_space_serial_exceptions :: Int -> [Benchmark]
127o_1_space_serial_exceptions :: Int -> [Benchmark]
@@ -156,8 +142,8 @@ o_1_space_serial_exceptions length =
156-- | Send the file contents to /dev/null with exception handling
142-- | Send the file contents to /dev/null with exception handling
157readWriteOnExceptionStream :: Handle -> Handle -> IO ()
143readWriteOnExceptionStream :: Handle -> Handle -> IO ()
158readWriteOnExceptionStream inh devNull =
144readWriteOnExceptionStream inh devNull =
159− let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
145+ let readEx = Stream.onException (hClose inh) (Stream.unfold FH.read inh)
160− in S.fold (FH.write devNull) readEx
146+ in Stream.fold (FH.write devNull) readEx
161
147
162#ifdef INSPECTION
148#ifdef INSPECTION
163inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
149inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
@@ -166,9 +152,9 @@ inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
166-- | Send the file contents to /dev/null with exception handling
152-- | Send the file contents to /dev/null with exception handling
167readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
153readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
168readWriteHandleExceptionStream inh devNull =
154readWriteHandleExceptionStream inh devNull =
169− let handler (_e :: SomeException) = S.fromEffect (hClose inh >> return 10)
155+ let handler (_e :: SomeException) = Stream.fromEffect (hClose inh >> return 10)
170− readEx = S.handle handler (S.unfold FH.read inh)
156+ readEx = Stream.handle handler (Stream.unfold FH.read inh)
171− in S.fold (FH.write devNull) readEx
157+ in Stream.fold (FH.write devNull) readEx
172
158
173#ifdef INSPECTION
159#ifdef INSPECTION
174inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
160inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
@@ -177,8 +163,8 @@ inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
177-- | Send the file contents to /dev/null with exception handling
163-- | Send the file contents to /dev/null with exception handling
178readWriteFinally_Stream :: Handle -> Handle -> IO ()
164readWriteFinally_Stream :: Handle -> Handle -> IO ()
179readWriteFinally_Stream inh devNull =
165readWriteFinally_Stream inh devNull =
180− let readEx = Stream.finally_ (hClose inh) (S.unfold FH.read inh)
166+ let readEx = Stream.finally_ (hClose inh) (Stream.unfold FH.read inh)
181− in S.fold (FH.write devNull) readEx
167+ in Stream.fold (FH.write devNull) readEx
182
168
183#ifdef INSPECTION
169#ifdef INSPECTION
184inspect $ hasNoTypeClasses 'readWriteFinally_Stream
170inspect $ hasNoTypeClasses 'readWriteFinally_Stream
@@ -186,8 +172,8 @@ inspect $ hasNoTypeClasses 'readWriteFinally_Stream
186
172
187readWriteFinallyStream :: Handle -> Handle -> IO ()
173readWriteFinallyStream :: Handle -> Handle -> IO ()
188readWriteFinallyStream inh devNull =
174readWriteFinallyStream inh devNull =
189− let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
175+ let readEx = Stream.finally (hClose inh) (Stream.unfold FH.read inh)
190− in S.fold (FH.write devNull) readEx
176+ in Stream.fold (FH.write devNull) readEx
191
177
192-- | Send the file contents to /dev/null with exception handling
178-- | Send the file contents to /dev/null with exception handling
193fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
179fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
@@ -202,7 +188,7 @@ inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
202
188
203fromToBytesBracketStream :: Handle -> Handle -> IO ()
189fromToBytesBracketStream :: Handle -> Handle -> IO ()
204fromToBytesBracketStream inh devNull =
190fromToBytesBracketStream inh devNull =
205− let readEx = S.bracket (return ()) (\_ -> hClose inh)
191+ let readEx = Stream.bracket (return ()) (\_ -> hClose inh)
206 (\_ -> IFH.getBytes inh)
192 (\_ -> IFH.getBytes inh)
207 in IFH.putBytes devNull readEx
193 in IFH.putBytes devNull readEx
208
194
@@ -210,8 +196,8 @@ readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
210readWriteBeforeAfterStream inh devNull =
196readWriteBeforeAfterStream inh devNull =
211 let readEx =
197 let readEx =
212 Stream.after (hClose inh)
198 Stream.after (hClose inh)
213− $ Stream.before (hPutChar devNull 'A') (S.unfold FH.read inh)
199+ $ Stream.before (hPutChar devNull 'A') (Stream.unfold FH.read inh)
214− in S.fold (FH.write devNull) readEx
200+ in Stream.fold (FH.write devNull) readEx
215
201
216#ifdef INSPECTION
202#ifdef INSPECTION
217inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
203inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
@@ -219,8 +205,8 @@ inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
219
205
220readWriteAfterStream :: Handle -> Handle -> IO ()
206readWriteAfterStream :: Handle -> Handle -> IO ()
221readWriteAfterStream inh devNull =
207readWriteAfterStream inh devNull =
222− let readEx = Stream.after (hClose inh) (S.unfold FH.read inh)
208+ let readEx = Stream.after (hClose inh) (Stream.unfold FH.read inh)
223− in S.fold (FH.write devNull) readEx
209+ in Stream.fold (FH.write devNull) readEx
224
210
225#ifdef INSPECTION
211#ifdef INSPECTION
226inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
212inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
@@ -228,8 +214,8 @@ inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
228
214
229readWriteAfter_Stream :: Handle -> Handle -> IO ()
215readWriteAfter_Stream :: Handle -> Handle -> IO ()
230readWriteAfter_Stream inh devNull =
216readWriteAfter_Stream inh devNull =
231− let readEx = Stream.after_ (hClose inh) (S.unfold FH.read inh)
217+ let readEx = Stream.after_ (hClose inh) (Stream.unfold FH.read inh)
232− in S.fold (FH.write devNull) readEx
218+ in Stream.fold (FH.write devNull) readEx
233
219
234#ifdef INSPECTION
220#ifdef INSPECTION
235inspect $ hasNoTypeClasses 'readWriteAfter_Stream
221inspect $ hasNoTypeClasses 'readWriteAfter_Stream
@@ -239,25 +225,25 @@ inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step
239o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
225o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
240o_1_space_copy_stream_exceptions env =
226o_1_space_copy_stream_exceptions env =
241 [ bgroup "exceptions"
227 [ bgroup "exceptions"
242− [ mkBenchSmall "S.onException" env $ \inh _ ->
228+ [ mkBenchSmall "Stream.onException" env $ \inh _ ->
243 readWriteOnExceptionStream inh (nullH env)
229 readWriteOnExceptionStream inh (nullH env)
244− , mkBenchSmall "S.handle" env $ \inh _ ->
230+ , mkBenchSmall "Stream.handle" env $ \inh _ ->
245 readWriteHandleExceptionStream inh (nullH env)
231 readWriteHandleExceptionStream inh (nullH env)
246− , mkBenchSmall "S.finally_" env $ \inh _ ->
232+ , mkBenchSmall "Stream.finally_" env $ \inh _ ->
247 readWriteFinally_Stream inh (nullH env)
233 readWriteFinally_Stream inh (nullH env)
248− , mkBenchSmall "S.finally" env $ \inh _ ->
234+ , mkBenchSmall "Stream.finally" env $ \inh _ ->
249 readWriteFinallyStream inh (nullH env)
235 readWriteFinallyStream inh (nullH env)
250− , mkBenchSmall "S.after . S.before" env $ \inh _ ->
236+ , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ ->
251 readWriteBeforeAfterStream inh (nullH env)
237 readWriteBeforeAfterStream inh (nullH env)
252− , mkBenchSmall "S.after" env $ \inh _ ->
238+ , mkBenchSmall "Stream.after" env $ \inh _ ->
253 readWriteAfterStream inh (nullH env)
239 readWriteAfterStream inh (nullH env)
254− , mkBenchSmall "S.after_" env $ \inh _ ->
240+ , mkBenchSmall "Stream.after_" env $ \inh _ ->
255 readWriteAfter_Stream inh (nullH env)
241 readWriteAfter_Stream inh (nullH env)
256 ]
242 ]
257 , bgroup "exceptions/fromToBytes"
243 , bgroup "exceptions/fromToBytes"
258− [ mkBenchSmall "S.bracket_" env $ \inh _ ->
244+ [ mkBenchSmall "Stream.bracket_" env $ \inh _ ->
259 fromToBytesBracket_Stream inh (nullH env)
245 fromToBytesBracket_Stream inh (nullH env)
260− , mkBenchSmall "S.bracket" env $ \inh _ ->
246+ , mkBenchSmall "Stream.bracket" env $ \inh _ ->
261 fromToBytesBracketStream inh (nullH env)
247 fromToBytesBracketStream inh (nullH env)
262 ]
248 ]
263 ]
249 ]
@@ -314,7 +300,7 @@ toChunksBracket_ inh devNull =
314 (return ())
300 (return ())
315 (\_ -> hClose inh)
301 (\_ -> hClose inh)
316 (\_ -> IFH.getChunks inh)
302 (\_ -> IFH.getChunks inh)
317− in S.fold (IFH.writeChunks devNull) readEx
303+ in Stream.fold (IFH.writeChunks devNull) readEx
318
304
319#ifdef INSPECTION
305#ifdef INSPECTION
320inspect $ hasNoTypeClasses 'toChunksBracket_
306inspect $ hasNoTypeClasses 'toChunksBracket_
@@ -322,18 +308,18 @@ inspect $ hasNoTypeClasses 'toChunksBracket_
322
308
323toChunksBracket :: Handle -> Handle -> IO ()
309toChunksBracket :: Handle -> Handle -> IO ()
324toChunksBracket inh devNull =
310toChunksBracket inh devNull =
325− let readEx = S.bracket
311+ let readEx = Stream.bracket
326 (return ())
312 (return ())
327 (\_ -> hClose inh)
313 (\_ -> hClose inh)
328 (\_ -> IFH.getChunks inh)
314 (\_ -> IFH.getChunks inh)
329− in S.fold (IFH.writeChunks devNull) readEx
315+ in Stream.fold (IFH.writeChunks devNull) readEx
330
316
331o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
317o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
332o_1_space_copy_exceptions_toChunks env =
318o_1_space_copy_exceptions_toChunks env =
333 [ bgroup "exceptions/toChunks"
319 [ bgroup "exceptions/toChunks"
334− [ mkBench "S.bracket_" env $ \inH _ ->
320+ [ mkBench "Stream.bracket_" env $ \inH _ ->
335 toChunksBracket_ inH (nullH env)
321 toChunksBracket_ inH (nullH env)
336− , mkBench "S.bracket" env $ \inH _ ->
322+ , mkBench "Stream.bracket" env $ \inH _ ->
337 toChunksBracket inH (nullH env)
323 toChunksBracket inH (nullH env)
338 ]
324 ]
339 ]
325 ]
benchmark/Streamly/Benchmark/Data/Stream/NestedStream.hs → benchmark/Streamly/Benchmark/Data/Stream/Expand.hsrenamed+87−71
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Stream.NestedStream
2+-- Module : Stream.Expand
3-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -18,9 +18,10 @@
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
19#endif
20
20
21−module Stream.NestedStream (benchmarks) where
21+module Stream.Expand (benchmarks) where
22
22
23import Control.Monad.Trans.Class (lift)
23import Control.Monad.Trans.Class (lift)
24+import Streamly.Internal.Data.Stream.Serial (SerialT)
24
25
25import qualified Control.Applicative as AP
26import qualified Control.Applicative as AP
26
27
@@ -31,14 +32,23 @@ import Test.Inspection
31import qualified Streamly.Internal.Data.Stream.StreamD as D
32import qualified Streamly.Internal.Data.Stream.StreamD as D
32#endif
33#endif
33
34
34−import qualified Streamly.Prelude as S
35+import qualified Stream.Common as Common
36+#ifdef USE_PRELUDE
35−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
37+import qualified Streamly.Internal.Data.Stream.IsStream as S
38+import Streamly.Benchmark.Prelude hiding
39+ (benchIOSrc, sourceUnfoldrM, apDiscardFst, apDiscardSnd, apLiftA2, toNullAp
40+ , monadThen, toNullM, toNullM3, filterAllInM, filterAllOutM, filterSome
41+ , breakAfterSome, toListM, toListSome)
42+#else
43+import Streamly.Benchmark.Prelude (benchIO)
44+import qualified Streamly.Internal.Data.Stream as S
45+#endif
36import qualified Streamly.Internal.Data.Unfold as UF
46import qualified Streamly.Internal.Data.Unfold as UF
47+import qualified Streamly.Internal.Data.Fold as Fold
37
48
38import Gauge
49import Gauge
39−import Streamly.Prelude (SerialT, fromSerial, serial)
50+import Stream.Common hiding (append2)
40import Streamly.Benchmark.Common
51import Streamly.Benchmark.Common
41−import Streamly.Benchmark.Prelude
42import Prelude hiding (concatMap)
52import Prelude hiding (concatMap)
43
53
44-------------------------------------------------------------------------------
54-------------------------------------------------------------------------------
@@ -56,13 +66,14 @@ iterateN g initial count = f count initial
56
66
57-- Iterate a transformation over a singleton stream
67-- Iterate a transformation over a singleton stream
58{-# INLINE iterateSingleton #-}
68{-# INLINE iterateSingleton #-}
59−iterateSingleton :: S.MonadAsync m
69+iterateSingleton :: Monad m
60 => (Int -> SerialT m Int -> SerialT m Int)
70 => (Int -> SerialT m Int -> SerialT m Int)
61 -> Int
71 -> Int
62 -> Int
72 -> Int
63 -> SerialT m Int
73 -> SerialT m Int
64iterateSingleton g count n = iterateN g (return n) count
74iterateSingleton g count n = iterateN g (return n) count
65
75
76+{-
66-- XXX need to check why this is slower than the explicit recursion above, even
77-- XXX need to check why this is slower than the explicit recursion above, even
67-- if the above code is written in a foldr like head recursive way. We also
78-- if the above code is written in a foldr like head recursive way. We also
68-- need to try this with foldlM' once #150 is fixed.
79-- need to try this with foldlM' once #150 is fixed.
@@ -70,12 +81,13 @@ iterateSingleton g count n = iterateN g (return n) count
70-- foldrM and any related fusion issues.
81-- foldrM and any related fusion issues.
71{-# INLINE _iterateSingleton #-}
82{-# INLINE _iterateSingleton #-}
72_iterateSingleton ::
83_iterateSingleton ::
73− S.MonadAsync m
84+ Monad m
74 => (Int -> SerialT m Int -> SerialT m Int)
85 => (Int -> SerialT m Int -> SerialT m Int)
75 -> Int
86 -> Int
76 -> Int
87 -> Int
77 -> SerialT m Int
88 -> SerialT m Int
78_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
89_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
90+-}
79
91
80-------------------------------------------------------------------------------
92-------------------------------------------------------------------------------
81-- Multi-Stream
93-- Multi-Stream
@@ -88,34 +100,34 @@ _iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
88{-# INLINE serial2 #-}
100{-# INLINE serial2 #-}
89serial2 :: Int -> Int -> IO ()
101serial2 :: Int -> Int -> IO ()
90serial2 count n =
102serial2 count n =
91− S.drain $
103+ drain $
92− S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
104+ Common.append (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
93
105
94{-# INLINE serial4 #-}
106{-# INLINE serial4 #-}
95serial4 :: Int -> Int -> IO ()
107serial4 :: Int -> Int -> IO ()
96serial4 count n =
108serial4 count n =
97− S.drain $
109+ drain $
98− S.serial
110+ Common.append
99− (S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)))
111+ (Common.append (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)))
100− (S.serial
112+ (Common.append
101 (sourceUnfoldrM count (n + 2))
113 (sourceUnfoldrM count (n + 2))
102 (sourceUnfoldrM count (n + 3)))
114 (sourceUnfoldrM count (n + 3)))
103
115
104{-# INLINE append2 #-}
116{-# INLINE append2 #-}
105append2 :: Int -> Int -> IO ()
117append2 :: Int -> Int -> IO ()
106append2 count n =
118append2 count n =
107− S.drain $
119+ drain $
108− Internal.append (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
120+ Common.append2 (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
109
121
110{-# INLINE append4 #-}
122{-# INLINE append4 #-}
111append4 :: Int -> Int -> IO ()
123append4 :: Int -> Int -> IO ()
112append4 count n =
124append4 count n =
113− S.drain $
125+ drain $
114− Internal.append
126+ Common.append2
115− (Internal.append
127+ (Common.append2
116 (sourceUnfoldrM count n)
128 (sourceUnfoldrM count n)
117 (sourceUnfoldrM count (n + 1)))
129 (sourceUnfoldrM count (n + 1)))
118− (Internal.append
130+ (Common.append2
119 (sourceUnfoldrM count (n + 2))
131 (sourceUnfoldrM count (n + 2))
120 (sourceUnfoldrM count (n + 3)))
132 (sourceUnfoldrM count (n + 3)))
121
133
@@ -139,22 +151,24 @@ o_1_space_joining value =
139-- Concat Foldable containers
151-- Concat Foldable containers
140-------------------------------------------------------------------------------
152-------------------------------------------------------------------------------
141
153
154+#ifdef USE_PRELUDE
142o_1_space_concatFoldable :: Int -> [Benchmark]
155o_1_space_concatFoldable :: Int -> [Benchmark]
143o_1_space_concatFoldable value =
156o_1_space_concatFoldable value =
144 [ bgroup "concat-foldable"
157 [ bgroup "concat-foldable"
145− [ benchIOSrc fromSerial "foldMapWith (<>) (List)"
158+ [ benchIOSrc "foldMapWith (<>) (List)"
146 (sourceFoldMapWith value)
159 (sourceFoldMapWith value)
147− , benchIOSrc fromSerial "foldMapWith (<>) (Stream)"
160+ , benchIOSrc "foldMapWith (<>) (Stream)"
148 (sourceFoldMapWithStream value)
161 (sourceFoldMapWithStream value)
149− , benchIOSrc fromSerial "foldMapWithM (<>) (List)"
162+ , benchIOSrc "foldMapWithM (<>) (List)"
150 (sourceFoldMapWithM value)
163 (sourceFoldMapWithM value)
151− , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"
164+ , benchIOSrc "S.concatFoldableWith (<>) (List)"
152 (concatFoldableWith value)
165 (concatFoldableWith value)
153− , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"
166+ , benchIOSrc "S.concatForFoldableWith (<>) (List)"
154 (concatForFoldableWith value)
167 (concatForFoldableWith value)
155− , benchIOSrc fromSerial "foldMapM (List)" (sourceFoldMapM value)
168+ , benchIOSrc "foldMapM (List)" (sourceFoldMapM value)
156 ]
169 ]
157 ]
170 ]
171+#endif
158
172
159-------------------------------------------------------------------------------
173-------------------------------------------------------------------------------
160-- Concat
174-- Concat
@@ -165,14 +179,14 @@ o_1_space_concatFoldable value =
165{-# INLINE concatMap #-}
179{-# INLINE concatMap #-}
166concatMap :: Int -> Int -> Int -> IO ()
180concatMap :: Int -> Int -> Int -> IO ()
167concatMap outer inner n =
181concatMap outer inner n =
168− S.drain $ S.concatMap
182+ drain $ S.concatMap
169 (\_ -> sourceUnfoldrM inner n)
183 (\_ -> sourceUnfoldrM inner n)
170 (sourceUnfoldrM outer n)
184 (sourceUnfoldrM outer n)
171
185
172{-# INLINE concatMapM #-}
186{-# INLINE concatMapM #-}
173concatMapM :: Int -> Int -> Int -> IO ()
187concatMapM :: Int -> Int -> Int -> IO ()
174concatMapM outer inner n =
188concatMapM outer inner n =
175− S.drain $ S.concatMapM
189+ drain $ S.concatMapM
176 (\_ -> return $ sourceUnfoldrM inner n)
190 (\_ -> return $ sourceUnfoldrM inner n)
177 (sourceUnfoldrM outer n)
191 (sourceUnfoldrM outer n)
178
192
@@ -186,7 +200,7 @@ inspect $ 'concatMap `hasNoType` ''SPEC
186{-# INLINE concatMapPure #-}
200{-# INLINE concatMapPure #-}
187concatMapPure :: Int -> Int -> Int -> IO ()
201concatMapPure :: Int -> Int -> Int -> IO ()
188concatMapPure outer inner n =
202concatMapPure outer inner n =
189− S.drain $ S.concatMap
203+ drain $ S.concatMap
190 (\_ -> sourceUnfoldr inner n)
204 (\_ -> sourceUnfoldr inner n)
191 (sourceUnfoldr outer n)
205 (sourceUnfoldr outer n)
192
206
@@ -200,7 +214,7 @@ inspect $ 'concatMapPure `hasNoType` ''SPEC
200{-# INLINE concatMapRepl #-}
214{-# INLINE concatMapRepl #-}
201concatMapRepl :: Int -> Int -> Int -> IO ()
215concatMapRepl :: Int -> Int -> Int -> IO ()
202concatMapRepl outer inner n =
216concatMapRepl outer inner n =
203− S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrM outer n)
217+ drain $ S.concatMap (Common.replicate inner) (sourceUnfoldrM outer n)
204
218
205#ifdef INSPECTION
219#ifdef INSPECTION
206inspect $ hasNoTypeClasses 'concatMapRepl
220inspect $ hasNoTypeClasses 'concatMapRepl
@@ -211,7 +225,7 @@ inspect $ 'concatMapRepl `hasNoType` ''SPEC
211
225
212{-# INLINE concatMapWithSerial #-}
226{-# INLINE concatMapWithSerial #-}
213concatMapWithSerial :: Int -> Int -> Int -> IO ()
227concatMapWithSerial :: Int -> Int -> Int -> IO ()
214−concatMapWithSerial = concatStreamsWith S.serial
228+concatMapWithSerial = concatStreamsWith Common.append
215
229
216#ifdef INSPECTION
230#ifdef INSPECTION
217inspect $ hasNoTypeClasses 'concatMapWithSerial
231inspect $ hasNoTypeClasses 'concatMapWithSerial
@@ -220,7 +234,7 @@ inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
220
234
221{-# INLINE concatMapWithAppend #-}
235{-# INLINE concatMapWithAppend #-}
222concatMapWithAppend :: Int -> Int -> Int -> IO ()
236concatMapWithAppend :: Int -> Int -> Int -> IO ()
223−concatMapWithAppend = concatStreamsWith Internal.append
237+concatMapWithAppend = concatStreamsWith Common.append2
224
238
225#ifdef INSPECTION
239#ifdef INSPECTION
226inspect $ hasNoTypeClasses 'concatMapWithAppend
240inspect $ hasNoTypeClasses 'concatMapWithAppend
@@ -231,11 +245,11 @@ inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
231
245
232{-# INLINE concatPairWithSerial #-}
246{-# INLINE concatPairWithSerial #-}
233concatPairWithSerial :: Int -> Int -> Int -> IO ()
247concatPairWithSerial :: Int -> Int -> Int -> IO ()
234−concatPairWithSerial = concatPairsWith Internal.serial
248+concatPairWithSerial = concatPairsWith Common.append
235
249
236{-# INLINE concatPairWithAppend #-}
250{-# INLINE concatPairWithAppend #-}
237concatPairWithAppend :: Int -> Int -> Int -> IO ()
251concatPairWithAppend :: Int -> Int -> Int -> IO ()
238−concatPairWithAppend = concatPairsWith Internal.append
252+concatPairWithAppend = concatPairsWith Common.append2
239
253
240-- unfoldMany
254-- unfoldMany
241
255
@@ -244,7 +258,7 @@ concatPairWithAppend = concatPairsWith Internal.append
244{-# INLINE unfoldManyRepl #-}
258{-# INLINE unfoldManyRepl #-}
245unfoldManyRepl :: Int -> Int -> Int -> IO ()
259unfoldManyRepl :: Int -> Int -> Int -> IO ()
246unfoldManyRepl outer inner n =
260unfoldManyRepl outer inner n =
247− S.drain
261+ drain
248 $ S.unfoldMany
262 $ S.unfoldMany
249 (UF.lmap return (UF.replicateM inner))
263 (UF.lmap return (UF.replicateM inner))
250 (sourceUnfoldrM outer n)
264 (sourceUnfoldrM outer n)
@@ -266,7 +280,7 @@ o_1_space_concat value = sqrtVal `seq`
266 (concatMapPure 1 value)
280 (concatMapPure 1 value)
267
281
268 -- This is for comparison with foldMapWith
282 -- This is for comparison with foldMapWith
269− , benchIOSrc fromSerial "concatMapId (n of 1) (fromFoldable)"
283+ , benchIOSrc "concatMapId (n of 1) (fromFoldable)"
270 (S.concatMap id . sourceConcatMapId value)
284 (S.concatMap id . sourceConcatMapId value)
271
285
272 , benchIOSrc1 "concatMap (n of 1)"
286 , benchIOSrc1 "concatMap (n of 1)"
@@ -284,8 +298,8 @@ o_1_space_concat value = sqrtVal `seq`
284 (concatMapM 1 value)
298 (concatMapM 1 value)
285
299
286 -- This is for comparison with foldMapWith
300 -- This is for comparison with foldMapWith
287− , benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"
301+ , benchIOSrc "concatMapWithId (n of 1) (fromFoldable)"
288− (S.concatMapWith serial id . sourceConcatMapId value)
302+ (S.concatMapWith Common.append id . sourceConcatMapId value)
289
303
290 , benchIOSrc1 "concatMapWith (n of 1)"
304 , benchIOSrc1 "concatMapWith (n of 1)"
291 (concatMapWithSerial value 1)
305 (concatMapWithSerial value 1)
@@ -343,23 +357,23 @@ o_n_space_concat value = sqrtVal `seq`
343o_1_space_applicative :: Int -> [Benchmark]
357o_1_space_applicative :: Int -> [Benchmark]
344o_1_space_applicative value =
358o_1_space_applicative value =
345 [ bgroup "Applicative"
359 [ bgroup "Applicative"
346− [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value fromSerial
360+ [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value
347− , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value fromSerial
361+ , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value
348− , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value fromSerial
362+ , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value
349− , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value fromSerial
363+ , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value
350 ]
364 ]
351 ]
365 ]
352
366
353o_n_space_applicative :: Int -> [Benchmark]
367o_n_space_applicative :: Int -> [Benchmark]
354o_n_space_applicative value =
368o_n_space_applicative value =
355 [ bgroup "Applicative"
369 [ bgroup "Applicative"
356− [ benchIOSrc fromSerial "(*>) (n times)" $
370+ [ benchIOSrc "(*>) (n times)" $
357 iterateSingleton ((*>) . pure) value
371 iterateSingleton ((*>) . pure) value
358− , benchIOSrc fromSerial "(<*) (n times)" $
372+ , benchIOSrc "(<*) (n times)" $
359− iterateSingleton (\x xs -> xs <* pure x) value
373+ iterateSingleton (\x xs -> xs <* pure x) value
360− , benchIOSrc fromSerial "(<*>) (n times)" $
374+ , benchIOSrc "(<*>) (n times)" $
361 iterateSingleton (\x xs -> pure (+ x) <*> xs) value
375 iterateSingleton (\x xs -> pure (+ x) <*> xs) value
362− , benchIOSrc fromSerial "liftA2 (n times)" $
376+ , benchIOSrc "liftA2 (n times)" $
363 iterateSingleton (AP.liftA2 (+) . pure) value
377 iterateSingleton (AP.liftA2 (+) . pure) value
364 ]
378 ]
365 ]
379 ]
@@ -371,18 +385,18 @@ o_n_space_applicative value =
371o_1_space_monad :: Int -> [Benchmark]
385o_1_space_monad :: Int -> [Benchmark]
372o_1_space_monad value =
386o_1_space_monad value =
373 [ bgroup "Monad"
387 [ bgroup "Monad"
374− [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value fromSerial
388+ [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value
375− , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value fromSerial
389+ , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value
376 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
390 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
377− filterAllOutM value fromSerial
391+ filterAllOutM value
378 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
392 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
379− filterAllInM value fromSerial
393+ filterAllInM value
380 , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
394 , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
381− filterSome value fromSerial
395+ filterSome value
382 , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
396 , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
383− breakAfterSome value fromSerial
397+ breakAfterSome value
384 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
398 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
385− toNullM3 value fromSerial
399+ toNullM3 value
386 ]
400 ]
387 ]
401 ]
388
402
@@ -400,16 +414,16 @@ sieve s = do
400o_n_space_monad :: Int -> [Benchmark]
414o_n_space_monad :: Int -> [Benchmark]
401o_n_space_monad value =
415o_n_space_monad value =
402 [ bgroup "Monad"
416 [ bgroup "Monad"
403− [ benchIOSrc fromSerial "(>>) (n times)" $
417+ [ benchIOSrc "(>>) (n times)" $
404 iterateSingleton ((>>) . pure) value
418 iterateSingleton ((>>) . pure) value
405− , benchIOSrc fromSerial "(>>=) (n times)" $
419+ , benchIOSrc "(>>=) (n times)" $
406 iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value
420 iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value
407 , benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
421 , benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
408− toListM value fromSerial
422+ toListM value
409 , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
423 , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
410− toListSome value fromSerial
424+ toListSome value
411 , benchIO "naive prime sieve (n/4)"
425 , benchIO "naive prime sieve (n/4)"
412− (\n -> S.sum $ sieve $ S.enumerateFromTo 2 (value `div` 4 + n))
426+ (\n -> S.fold Fold.sum $ sieve $ enumerateFromTo 2 (value `div` 4 + n))
413 ]
427 ]
414 ]
428 ]
415
429
@@ -421,22 +435,22 @@ toKv :: Int -> (Int, Int)
421toKv p = (p, p)
435toKv p = (p, p)
422
436
423{-# INLINE joinWith #-}
437{-# INLINE joinWith #-}
424−joinWith :: (S.MonadAsync m) =>
438+joinWith :: Common.MonadAsync m =>
425 ((Int -> Int -> Bool) -> SerialT m Int -> SerialT m Int -> SerialT m b)
439 ((Int -> Int -> Bool) -> SerialT m Int -> SerialT m Int -> SerialT m b)
426 -> Int
440 -> Int
427 -> Int
441 -> Int
428 -> m ()
442 -> m ()
429joinWith j val i =
443joinWith j val i =
430− S.drain $ j (==) (sourceUnfoldrM val i) (sourceUnfoldrM val (val `div` 2))
444+ drain $ j (==) (sourceUnfoldrM val i) (sourceUnfoldrM val (val `div` 2))
431
445
432{-# INLINE joinMapWith #-}
446{-# INLINE joinMapWith #-}
433−joinMapWith :: (S.MonadAsync m) =>
447+joinMapWith :: Common.MonadAsync m =>
434 (SerialT m (Int, Int) -> SerialT m (Int, Int) -> SerialT m b)
448 (SerialT m (Int, Int) -> SerialT m (Int, Int) -> SerialT m b)
435 -> Int
449 -> Int
436 -> Int
450 -> Int
437 -> m ()
451 -> m ()
438joinMapWith j val i =
452joinMapWith j val i =
439− S.drain
453+ drain
440 $ j
454 $ j
441 (fmap toKv (sourceUnfoldrM val i))
455 (fmap toKv (sourceUnfoldrM val i))
442 (fmap toKv (sourceUnfoldrM val (val `div` 2)))
456 (fmap toKv (sourceUnfoldrM val (val `div` 2)))
@@ -446,21 +460,21 @@ o_n_heap_buffering value =
446 [ bgroup "buffered"
460 [ bgroup "buffered"
447 [
461 [
448 benchIOSrc1 "joinInner (sqrtVal)"
462 benchIOSrc1 "joinInner (sqrtVal)"
449− $ joinWith Internal.joinInner sqrtVal
463+ $ joinWith S.joinInner sqrtVal
450 , benchIOSrc1 "joinInnerMap"
464 , benchIOSrc1 "joinInnerMap"
451− $ joinMapWith Internal.joinInnerMap halfVal
465+ $ joinMapWith S.joinInnerMap halfVal
452 , benchIOSrc1 "joinLeft (sqrtVal)"
466 , benchIOSrc1 "joinLeft (sqrtVal)"
453− $ joinWith Internal.joinLeft sqrtVal
467+ $ joinWith S.joinLeft sqrtVal
454 , benchIOSrc1 "joinLeftMap "
468 , benchIOSrc1 "joinLeftMap "
455− $ joinMapWith Internal.joinLeftMap halfVal
469+ $ joinMapWith S.joinLeftMap halfVal
456 , benchIOSrc1 "joinOuter (sqrtVal)"
470 , benchIOSrc1 "joinOuter (sqrtVal)"
457− $ joinWith Internal.joinOuter sqrtVal
471+ $ joinWith S.joinOuter sqrtVal
458 , benchIOSrc1 "joinOuterMap"
472 , benchIOSrc1 "joinOuterMap"
459− $ joinMapWith Internal.joinOuterMap halfVal
473+ $ joinMapWith S.joinOuterMap halfVal
460 , benchIOSrc1 "intersectBy (sqrtVal)"
474 , benchIOSrc1 "intersectBy (sqrtVal)"
461− $ joinWith Internal.intersectBy sqrtVal
475+ $ joinWith S.intersectBy sqrtVal
462 , benchIOSrc1 "intersectBySorted"
476 , benchIOSrc1 "intersectBySorted"
463− $ joinMapWith (Internal.intersectBySorted compare) halfVal
477+ $ joinMapWith (S.intersectBySorted compare) halfVal
464 ]
478 ]
465 ]
479 ]
466
480
@@ -482,7 +496,9 @@ benchmarks moduleName size =
482 [
496 [
483 -- multi-stream
497 -- multi-stream
484 o_1_space_joining size
498 o_1_space_joining size
499+#ifdef USE_PRELUDE
485 , o_1_space_concatFoldable size
500 , o_1_space_concatFoldable size
501+#endif
486 , o_1_space_concat size
502 , o_1_space_concat size
487
503
488 , o_1_space_applicative size
504 , o_1_space_applicative size
benchmark/Streamly/Benchmark/Data/Stream/Generate.hs+54−65
@@ -13,22 +13,29 @@ module Stream.Generate (benchmarks) where
13
13
14import Data.Functor.Identity (Identity)
14import Data.Functor.Identity (Identity)
15
15
16+import qualified Stream.Common as Common
16#ifdef USE_PRELUDE
17#ifdef USE_PRELUDE
17import qualified GHC.Exts as GHC
18import qualified GHC.Exts as GHC
18import qualified Streamly.Prelude as S
19import qualified Streamly.Prelude as S
20+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
19import qualified Prelude
21import qualified Prelude
20−#endif
22+#else
21import qualified Streamly.Internal.Data.Stream as Stream
23import qualified Streamly.Internal.Data.Stream as Stream
22−import qualified Streamly.Internal.Data.Unfold as Unfold
24+#endif
23
25
24import Gauge
26import Gauge
25import Streamly.Benchmark.Common
27import Streamly.Benchmark.Common
26import Streamly.Internal.Data.Stream.Serial (SerialT)
28import Streamly.Internal.Data.Stream.Serial (SerialT)
27#ifdef USE_PRELUDE
29#ifdef USE_PRELUDE
30+import Streamly.Prelude (MonadAsync)
31+import Stream.Common hiding (MonadAsync, replicate, enumerateFromTo)
28−import Streamly.Benchmark.Prelude
32+import Streamly.Benchmark.Prelude hiding
29−import Streamly.Prelude (fromSerial, MonadAsync)
33+ (benchIOSrc, sourceUnfoldrM, apDiscardFst, apDiscardSnd, apLiftA2, toNullAp
34+ , monadThen, toNullM, toNullM3, filterAllInM, filterAllOutM, filterSome
35+ , breakAfterSome, toListM, toListSome)
36+#else
37+import Stream.Common
30#endif
38#endif
31−import qualified Stream.Common as SC
32
39
33import System.IO.Unsafe (unsafeInterleaveIO)
40import System.IO.Unsafe (unsafeInterleaveIO)
34
41
@@ -41,6 +48,7 @@ import Prelude hiding (repeat, replicate, iterate)
41-------------------------------------------------------------------------------
48-------------------------------------------------------------------------------
42-- fromList
49-- fromList
43-------------------------------------------------------------------------------
50-------------------------------------------------------------------------------
51+
44#ifdef USE_PRELUDE
52#ifdef USE_PRELUDE
45{-# INLINE sourceIsList #-}
53{-# INLINE sourceIsList #-}
46sourceIsList :: Int -> Int -> SerialT Identity Int
54sourceIsList :: Int -> Int -> SerialT Identity Int
@@ -126,42 +134,6 @@ fromIndices value n = S.take value $ S.fromIndices (+ n)
126{-# INLINE fromIndicesM #-}
134{-# INLINE fromIndicesM #-}
127fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
135fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
128fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))
136fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))
129−
130−o_1_space_generation_prel :: Int -> [Benchmark]
131−o_1_space_generation_prel value =
132− [ bgroup "generation"
133− [ benchIOSrc fromSerial "unfoldr" (sourceUnfoldr value)
134− , benchIOSrc fromSerial "unfoldrM" (sourceUnfoldrM value)
135− , benchIOSrc fromSerial "repeat" (repeat value)
136− , benchIOSrc fromSerial "repeatM" (repeatM value)
137− , benchIOSrc fromSerial "replicate" (replicate value)
138− , benchIOSrc fromSerial "replicateM" (replicateM value)
139− , benchIOSrc fromSerial "iterate" (iterate value)
140− , benchIOSrc fromSerial "iterateM" (iterateM value)
141− , benchIOSrc fromSerial "fromIndices" (fromIndices value)
142− , benchIOSrc fromSerial "fromIndicesM" (fromIndicesM value)
143− , benchIOSrc fromSerial "intFromTo" (sourceIntFromTo value)
144− , benchIOSrc fromSerial "intFromThenTo" (sourceIntFromThenTo value)
145− , benchIOSrc fromSerial "integerFromStep" (sourceIntegerFromStep value)
146− , benchIOSrc fromSerial "fracFromThenTo" (sourceFracFromThenTo value)
147− , benchIOSrc fromSerial "fracFromTo" (sourceFracFromTo value)
148− , benchIOSrc fromSerial "fromList" (sourceFromList value)
149− , benchPureSrc "IsList.fromList" (sourceIsList value)
150− , benchPureSrc "IsString.fromString" (sourceIsString value)
151− , benchIOSrc fromSerial "fromListM" (sourceFromListM value)
152− , benchIOSrc fromSerial "enumerateFrom" (enumerateFrom value)
153− , benchIOSrc fromSerial "enumerateFromTo" (enumerateFromTo value)
154− , benchIOSrc fromSerial "enumerateFromThen" (enumerateFromThen value)
155− , benchIOSrc fromSerial "enumerateFromThenTo" (enumerateFromThenTo value)
156− , benchIOSrc fromSerial "enumerate" (enumerate value)
157− , benchIOSrc fromSerial "enumerateTo" (enumerateTo value)
158−
159− -- These essentially test cons and consM
160− , benchIOSrc fromSerial "fromFoldable" (sourceFromFoldable value)
161− , benchIOSrc fromSerial "fromFoldableM" (sourceFromFoldableM value)
162− , benchIOSrc fromSerial "absTimes" $ absTimes value
163− ]
164− ]
165#endif
137#endif
166
138
167{-# INLINE mfixUnfold #-}
139{-# INLINE mfixUnfold #-}
@@ -170,29 +142,51 @@ mfixUnfold count start = Stream.mfix f
170 where
142 where
171 f action = do
143 f action = do
172 let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act
144 let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act
173− x <- Stream.unfold Unfold.fromListM [incr 1 action, incr 2 action]
145+ x <- Common.fromListM [incr 1 action, incr 2 action]
174− y <- SC.sourceUnfoldr count start
146+ y <- Common.sourceUnfoldr count start
175 return (x, y)
147 return (x, y)
176
148
177−{-# INLINE fromFoldable #-}
178−fromFoldable :: Int -> Int -> SerialT m Int
179−fromFoldable count start =
180− Stream.fromFoldable (Prelude.enumFromTo count start)
181−
182−{-# INLINE fromFoldableM #-}
183−fromFoldableM :: Monad m => Int -> Int -> SerialT m Int
184−fromFoldableM count start =
185− Stream.fromFoldableM (fmap return (Prelude.enumFromTo count start))
186−
187o_1_space_generation :: Int -> [Benchmark]
149o_1_space_generation :: Int -> [Benchmark]
188o_1_space_generation value =
150o_1_space_generation value =
189 [ bgroup "generation"
151 [ bgroup "generation"
190− [ SC.benchIOSrc "unfold" (SC.sourceUnfoldr value)
152+ [ benchIOSrc "unfoldr" (sourceUnfoldr value)
191− , SC.benchIOSrc "fromFoldable" (fromFoldable value)
153+ , benchIOSrc "unfoldrM" (sourceUnfoldrM value)
154+#ifdef USE_PRELUDE
155+ , benchIOSrc "repeat" (repeat value)
156+ , benchIOSrc "repeatM" (repeatM value)
157+ , benchIOSrc "replicate" (replicate value)
158+ , benchIOSrc "replicateM" (replicateM value)
159+ , benchIOSrc "iterate" (iterate value)
160+ , benchIOSrc "iterateM" (iterateM value)
161+ , benchIOSrc "fromIndices" (fromIndices value)
162+ , benchIOSrc "fromIndicesM" (fromIndicesM value)
163+ , benchIOSrc "intFromTo" (sourceIntFromTo value)
164+ , benchIOSrc "intFromThenTo" (sourceIntFromThenTo value)
165+ , benchIOSrc "integerFromStep" (sourceIntegerFromStep value)
166+ , benchIOSrc "fracFromThenTo" (sourceFracFromThenTo value)
167+ , benchIOSrc "fracFromTo" (sourceFracFromTo value)
168+ , benchIOSrc "fromList" (sourceFromList value)
169+ , benchPureSrc "IsList.fromList" (sourceIsList value)
170+ , benchPureSrc "IsString.fromString" (sourceIsString value)
171+ , benchIOSrc "fromListM" (sourceFromListM value)
172+ , benchIOSrc "enumerateFrom" (enumerateFrom value)
173+ , benchIOSrc "enumerateFromTo" (enumerateFromTo value)
174+ , benchIOSrc "enumerateFromThen" (enumerateFromThen value)
175+ , benchIOSrc "enumerateFromThenTo" (enumerateFromThenTo value)
176+ , benchIOSrc "enumerate" (enumerate value)
177+ , benchIOSrc "enumerateTo" (enumerateTo value)
178+#endif
179+
180+ -- These essentially test cons and consM
181+ , benchIOSrc "fromFoldable" (sourceFromFoldable value)
192− , SC.benchIOSrc "fromFoldableM" (fromFoldableM value)
182+ , benchIOSrc "fromFoldableM" (sourceFromFoldableM value)
183+
184+#ifdef USE_PRELUDE
185+ , benchIOSrc "absTimes" $ absTimes value
186+#endif
193− , SC.benchIOSrc "mfix_10" (mfixUnfold 10)
187+ , Common.benchIOSrc "mfix_10" (mfixUnfold 10)
194− , SC.benchIOSrc "mfix_100" (mfixUnfold 100)
188+ , Common.benchIOSrc "mfix_100" (mfixUnfold 100)
195− , SC.benchIOSrc "mfix_1000" (mfixUnfold 1000)
189+ , Common.benchIOSrc "mfix_1000" (mfixUnfold 1000)
196 ]
190 ]
197 ]
191 ]
198
192
@@ -218,11 +212,6 @@ o_n_heap_generation value =
218--
212--
219benchmarks :: String -> Int -> [Benchmark]
213benchmarks :: String -> Int -> [Benchmark]
220benchmarks moduleName size =
214benchmarks moduleName size =
221− [
222−#ifdef USE_PRELUDE
223− bgroup (o_1_space_prefix moduleName) (o_1_space_generation_prel size)
224− ,
225−#endif
226− bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
215+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
227 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_generation size)
216 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_generation size)
228 ]
217 ]
benchmark/Streamly/Benchmark/Data/Stream/Lift.hs+36−56
@@ -11,21 +11,23 @@
11
11
12module Stream.Lift (benchmarks) where
12module Stream.Lift (benchmarks) where
13
13
14−#ifdef USE_PRELUDE
14+import Control.DeepSeq (NFData(..))
15import Control.Monad.Trans.Class (lift)
15import Control.Monad.Trans.Class (lift)
16import Control.Monad.State.Strict (StateT, get, put, MonadState)
16import Control.Monad.State.Strict (StateT, get, put, MonadState)
17−import Streamly.Prelude (fromSerial)
18−import Streamly.Benchmark.Prelude
19−import qualified Control.Monad.State.Strict as State
20−import qualified Streamly.Prelude as Stream
21−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
22−#else
23−import Control.DeepSeq (NFData(..))
24import Data.Functor.Identity (Identity)
17import Data.Functor.Identity (Identity)
25−import Stream.Common (sourceUnfoldr, sourceUnfoldrM, benchIOSrc)
18+import Stream.Common (sourceUnfoldr, sourceUnfoldrM, benchIOSrc, drain)
26import System.Random (randomRIO)
19import System.Random (randomRIO)
20+#ifdef USE_PRELUDE
21+import Streamly.Benchmark.Prelude hiding
22+ (sourceUnfoldr, sourceUnfoldrM, benchIOSrc)
23+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
24+#else
25+import Streamly.Benchmark.Prelude (benchIO)
27import qualified Streamly.Internal.Data.Stream as Stream
26import qualified Streamly.Internal.Data.Stream as Stream
28#endif
27#endif
28+import qualified Streamly.Internal.Data.Fold as Fold
29+import qualified Stream.Common as Common
30+import qualified Control.Monad.State.Strict as State
29
31
30import Gauge
32import Gauge
31import Streamly.Internal.Data.Stream.Serial (SerialT)
33import Streamly.Internal.Data.Stream.Serial (SerialT)
@@ -36,11 +38,11 @@ import Prelude hiding (reverse, tail)
36-------------------------------------------------------------------------------
38-------------------------------------------------------------------------------
37-- Monad transformation (hoisting etc.)
39-- Monad transformation (hoisting etc.)
38-------------------------------------------------------------------------------
40-------------------------------------------------------------------------------
39−#ifdef USE_PRELUDE
41+
40{-# INLINE sourceUnfoldrState #-}
42{-# INLINE sourceUnfoldrState #-}
41−sourceUnfoldrState :: (Stream.IsStream t, Stream.MonadAsync m)
43+sourceUnfoldrState :: Common.MonadAsync m =>
42− => Int -> Int -> t (StateT Int m) Int
44+ Int -> Int -> SerialT (StateT Int m) Int
43−sourceUnfoldrState value n = Stream.unfoldrM step n
45+sourceUnfoldrState value n = Common.unfoldrM step n
44 where
46 where
45 step cnt =
47 step cnt =
46 if cnt > n + value
48 if cnt > n + value
@@ -51,27 +53,36 @@ sourceUnfoldrState value n = Stream.unfoldrM step n
51 return (Just (s, cnt + 1))
53 return (Just (s, cnt + 1))
52
54
53{-# INLINE evalStateT #-}
55{-# INLINE evalStateT #-}
54−evalStateT :: Stream.MonadAsync m => Int -> Int -> SerialT m Int
56+evalStateT :: Common.MonadAsync m => Int -> Int -> SerialT m Int
55evalStateT value n =
57evalStateT value n =
56− Internal.evalStateT (return 0) (sourceUnfoldrState value n)
58+ Stream.evalStateT (return 0) (sourceUnfoldrState value n)
57
59
58{-# INLINE withState #-}
60{-# INLINE withState #-}
59−withState :: Stream.MonadAsync m => Int -> Int -> SerialT m Int
61+withState :: Common.MonadAsync m => Int -> Int -> SerialT m Int
60withState value n =
62withState value n =
61− Internal.evalStateT
63+ Stream.evalStateT
62− (return (0 :: Int)) (Internal.liftInner (sourceUnfoldrM value n))
64+ (return (0 :: Int)) (Stream.liftInner (sourceUnfoldrM value n))
65+
66+{-# INLINE benchHoistSink #-}
67+benchHoistSink
68+ :: (NFData b)
69+ => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
70+benchHoistSink value name f =
71+ bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
63
72
64o_1_space_hoisting :: Int -> [Benchmark]
73o_1_space_hoisting :: Int -> [Benchmark]
65o_1_space_hoisting value =
74o_1_space_hoisting value =
66 [ bgroup "hoisting"
75 [ bgroup "hoisting"
67− [ benchIOSrc fromSerial "evalState" (evalStateT value)
76+ [ benchIOSrc "evalState" (evalStateT value)
68− , benchIOSrc fromSerial "withState" (withState value)
77+ , benchIOSrc "withState" (withState value)
78+ , benchHoistSink value "generally"
79+ ((\xs -> Stream.fold Fold.length xs :: IO Int) . Stream.generally)
69 ]
80 ]
70 ]
81 ]
71
82
72{-# INLINE iterateStateIO #-}
83{-# INLINE iterateStateIO #-}
73iterateStateIO ::
84iterateStateIO ::
74− (Stream.MonadAsync m)
85+ Monad m
75 => Int
86 => Int
76 -> StateT Int m Int
87 -> StateT Int m Int
77iterateStateIO n = do
88iterateStateIO n = do
@@ -95,7 +106,7 @@ iterateStateT n = do
95{-# INLINE iterateState #-}
106{-# INLINE iterateState #-}
96{-# SPECIALIZE iterateState :: Int -> SerialT (StateT Int IO) Int #-}
107{-# SPECIALIZE iterateState :: Int -> SerialT (StateT Int IO) Int #-}
97iterateState ::
108iterateState ::
98− (Stream.MonadAsync m, MonadState Int m)
109+ MonadState Int m
99 => Int
110 => Int
100 -> SerialT m Int
111 -> SerialT m Int
101iterateState n = do
112iterateState n = do
@@ -112,38 +123,12 @@ o_n_heap_transformer value =
112 [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->
123 [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->
113 State.evalStateT (iterateStateIO n) value
124 State.evalStateT (iterateStateIO n) value
114 , benchIO "SerialT (StateT Int IO) (n times)" $ \n ->
125 , benchIO "SerialT (StateT Int IO) (n times)" $ \n ->
115− State.evalStateT (Stream.drain (iterateStateT n)) value
126+ State.evalStateT (drain (iterateStateT n)) value
116 , benchIO "MonadState Int m => SerialT m Int" $ \n ->
127 , benchIO "MonadState Int m => SerialT m Int" $ \n ->
117− State.evalStateT (Stream.drain (iterateState n)) value
128+ State.evalStateT (drain (iterateState n)) value
118 ]
129 ]
119 ]
130 ]
120−#else
121−{-# INLINE benchHoistSink #-}
122−benchHoistSink
123− :: (NFData b)
124− => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
125−benchHoistSink value name f =
126− bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
127−
128−-- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but
129−-- we can't use it as it requires MonadAsync constraint.
130−
131−{-# INLINE liftInner #-}
132−liftInner :: Monad m => Int -> Int -> SerialT m Int
133−liftInner value n =
134− Stream.evalStateT
135− (return (0 :: Int)) (Stream.liftInner (sourceUnfoldrM value n))
136−
137−o_1_space_generation :: Int -> [Benchmark]
138−o_1_space_generation value =
139− [ bgroup "lift"
140− [ benchHoistSink value "length . generally"
141− ((\(_ :: SerialT IO Int) -> return 8 :: IO Int) . Stream.generally)
142
131
143− , benchIOSrc "liftInner/evalStateT" (liftInner value)
144− ]
145− ]
146−#endif
147-------------------------------------------------------------------------------
132-------------------------------------------------------------------------------
148-- Main
133-- Main
149-------------------------------------------------------------------------------
134-------------------------------------------------------------------------------
@@ -153,11 +138,6 @@ o_1_space_generation value =
153--
138--
154benchmarks :: String -> Int -> [Benchmark]
139benchmarks :: String -> Int -> [Benchmark]
155benchmarks moduleName size =
140benchmarks moduleName size =
156− [
157−#ifdef USE_PRELUDE
158− bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)
141+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)
159 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_transformer size)
142 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_transformer size)
160−#else
161− bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
162−#endif
163 ]
143 ]
benchmark/Streamly/Benchmark/Data/Stream/NestedFold.hsdeleted−488
@@ -1,488 +0,0 @@
1−-- |
2−-- Module : Stream.NestedFold
3−-- Copyright : (c) 2018 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE CPP #-}
8−{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−{-# LANGUAGE DeriveAnyClass #-}
11−{-# LANGUAGE DeriveGeneric #-}
12−{-# LANGUAGE RankNTypes #-}
13−
14−module Stream.NestedFold (benchmarks) where
15−
16−import Control.DeepSeq (NFData(..))
17−import Control.Monad (when)
18−import Control.Monad.IO.Class (MonadIO(..))
19−import Data.Monoid (Sum(..))
20−import Data.Proxy (Proxy(..))
21−import Data.HashMap.Strict (HashMap)
22−import GHC.Generics (Generic)
23−import Streamly.Internal.Data.IsMap.HashMap ()
24−
25−import qualified Streamly.Internal.Data.Refold.Type as Refold
26−import qualified Streamly.Internal.Data.Fold as FL
27−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
28−import qualified Streamly.Prelude as S
29−
30−import Gauge
31−import Streamly.Prelude (SerialT, fromSerial)
32−import Streamly.Benchmark.Common
33−import Streamly.Benchmark.Prelude
34−import Prelude hiding (reverse, tail)
35−
36−-------------------------------------------------------------------------------
37−-- Iteration/looping utilities
38−-------------------------------------------------------------------------------
39−
40−{-# INLINE iterateN #-}
41−iterateN :: (Int -> a -> a) -> a -> Int -> a
42−iterateN g initial count = f count initial
43−
44− where
45−
46− f (0 :: Int) x = x
47− f i x = f (i - 1) (g i x)
48−
49−-- Iterate a transformation over a singleton stream
50−{-# INLINE iterateSingleton #-}
51−iterateSingleton :: S.MonadAsync m
52− => (Int -> SerialT m Int -> SerialT m Int)
53− -> Int
54− -> Int
55− -> SerialT m Int
56−iterateSingleton g count n = iterateN g (return n) count
57−
58−-- XXX need to check why this is slower than the explicit recursion above, even
59−-- if the above code is written in a foldr like head recursive way. We also
60−-- need to try this with foldlM' once #150 is fixed.
61−-- However, it is perhaps best to keep the iteration benchmarks independent of
62−-- foldrM and any related fusion issues.
63−{-# INLINE _iterateSingleton #-}
64−_iterateSingleton ::
65− S.MonadAsync m
66− => (Int -> SerialT m Int -> SerialT m Int)
67− -> Int
68− -> Int
69− -> SerialT m Int
70−_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
71−
72−-- Apply transformation g count times on a stream of length len
73−{-# INLINE iterateSource #-}
74−iterateSource ::
75− S.MonadAsync m
76− => (SerialT m Int -> SerialT m Int)
77− -> Int
78− -> Int
79− -> Int
80− -> SerialT m Int
81−iterateSource g count len n = f count (sourceUnfoldrM len n)
82−
83− where
84−
85− f (0 :: Int) stream = stream
86− f i stream = f (i - 1) (g stream)
87−
88−-------------------------------------------------------------------------------
89−-- Functor
90−-------------------------------------------------------------------------------
91−
92−o_n_space_functor :: Int -> [Benchmark]
93−o_n_space_functor value =
94− [ bgroup "Functor"
95− [ benchIO "(+) (n times) (baseline)" $ \i0 ->
96− iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value
97− , benchIOSrc fromSerial "(<$) (n times)" $
98− iterateSingleton (<$) value
99− , benchIOSrc fromSerial "fmap (n times)" $
100− iterateSingleton (fmap . (+)) value
101− {-
102− , benchIOSrc fromSerial "_(<$) (n times)" $
103− _iterateSingleton (<$) value
104− , benchIOSrc fromSerial "_fmap (n times)" $
105− _iterateSingleton (fmap . (+)) value
106− -}
107− ]
108− ]
109−
110−-------------------------------------------------------------------------------
111−-- Grouping transformations
112−-------------------------------------------------------------------------------
113−
114−{-# INLINE groups #-}
115−groups :: MonadIO m => SerialT m Int -> m ()
116−groups = S.drain . S.groups FL.drain
117−
118−-- XXX Change this test when the order of comparison is later changed
119−{-# INLINE groupsByGT #-}
120−groupsByGT :: MonadIO m => SerialT m Int -> m ()
121−groupsByGT = S.drain . S.groupsBy (>) FL.drain
122−
123−{-# INLINE groupsByEq #-}
124−groupsByEq :: MonadIO m => SerialT m Int -> m ()
125−groupsByEq = S.drain . S.groupsBy (==) FL.drain
126−
127−-- XXX Change this test when the order of comparison is later changed
128−{-# INLINE groupsByRollingLT #-}
129−groupsByRollingLT :: MonadIO m => SerialT m Int -> m ()
130−groupsByRollingLT =
131− S.drain . S.groupsByRolling (<) FL.drain
132−
133−{-# INLINE groupsByRollingEq #-}
134−groupsByRollingEq :: MonadIO m => SerialT m Int -> m ()
135−groupsByRollingEq =
136− S.drain . S.groupsByRolling (==) FL.drain
137−
138−{-# INLINE foldMany #-}
139−foldMany :: Monad m => SerialT m Int -> m ()
140−foldMany =
141− S.drain
142− . S.map getSum
143− . Internal.foldMany (FL.take 2 FL.mconcat)
144− . S.map Sum
145−
146−{-# INLINE refoldMany #-}
147−refoldMany :: Monad m => SerialT m Int -> m ()
148−refoldMany =
149− S.drain
150− . S.map getSum
151− . Internal.refoldMany (Refold.take 2 Refold.sconcat) (return mempty)
152− . S.map Sum
153−
154−{-# INLINE foldIterateM #-}
155−foldIterateM :: Monad m => SerialT m Int -> m ()
156−foldIterateM =
157− S.drain
158− . S.map getSum
159− . Internal.foldIterateM
160− (return . FL.take 2 . FL.sconcat) (return (Sum 0))
161− . S.map Sum
162−
163−{-# INLINE refoldIterateM #-}
164−refoldIterateM :: Monad m => SerialT m Int -> m ()
165−refoldIterateM =
166− S.drain
167− . S.map getSum
168− . Internal.refoldIterateM
169− (Refold.take 2 Refold.sconcat) (return (Sum 0))
170− . S.map Sum
171−
172−o_1_space_grouping :: Int -> [Benchmark]
173−o_1_space_grouping value =
174− -- Buffering operations using heap proportional to group/window sizes.
175− [ bgroup "grouping"
176− [ benchIOSink value "groups" groups
177− , benchIOSink value "groupsByGT" groupsByGT
178− , benchIOSink value "groupsByEq" groupsByEq
179− , benchIOSink value "groupsByRollingLT" groupsByRollingLT
180− , benchIOSink value "groupsByRollingEq" groupsByRollingEq
181− , benchIOSink value "foldMany" foldMany
182− , benchIOSink value "refoldMany" refoldMany
183− , benchIOSink value "foldIterateM" foldIterateM
184− , benchIOSink value "refoldIterateM" refoldIterateM
185− ]
186− ]
187−
188−-------------------------------------------------------------------------------
189−-- Size conserving transformations (reordering, buffering, etc.)
190−-------------------------------------------------------------------------------
191−
192−{-# INLINE reverse #-}
193−reverse :: MonadIO m => Int -> SerialT m Int -> m ()
194−reverse n = composeN n S.reverse
195−
196−{-# INLINE reverse' #-}
197−reverse' :: MonadIO m => Int -> SerialT m Int -> m ()
198−reverse' n = composeN n Internal.reverse'
199−
200−o_n_heap_buffering :: Int -> [Benchmark]
201−o_n_heap_buffering value =
202− [ bgroup "buffered"
203− [
204− -- Reversing a stream
205− benchIOSink value "reverse" (reverse 1)
206− , benchIOSink value "reverse'" (reverse' 1)
207−
208− , benchIOSink value "mkAsync" (mkAsync fromSerial)
209− ]
210− ]
211−
212−-------------------------------------------------------------------------------
213−-- Grouping/Splitting
214−-------------------------------------------------------------------------------
215−
216−{-# INLINE classifySessionsOf #-}
217−classifySessionsOf :: S.MonadAsync m => (Int -> Int) -> SerialT m Int -> m ()
218−classifySessionsOf getKey =
219− S.drain
220− . Internal.classifySessionsOf
221− (const (return False)) 3 (FL.take 10 FL.sum)
222− . Internal.timestamped
223− . S.map (\x -> (getKey x, x))
224−
225−{-# INLINE classifySessionsOfHash #-}
226−classifySessionsOfHash :: S.MonadAsync m =>
227− (Int -> Int) -> SerialT m Int -> m ()
228−classifySessionsOfHash getKey =
229− S.drain
230− . Internal.classifySessionsByGeneric
231− (Proxy :: Proxy (HashMap k))
232− 1 False (const (return False)) 3 (FL.take 10 FL.sum)
233− . Internal.timestamped
234− . S.map (\x -> (getKey x, x))
235−
236−o_n_space_grouping :: Int -> [Benchmark]
237−o_n_space_grouping value =
238− -- Buffering operations using heap proportional to group/window sizes.
239− [ bgroup "grouping"
240− [ benchIOSink value "classifySessionsOf (10000 buckets)"
241− (classifySessionsOf (getKey 10000))
242− , benchIOSink value "classifySessionsOf (64 buckets)"
243− (classifySessionsOf (getKey 64))
244− , benchIOSink value "classifySessionsOfHash (10000 buckets)"
245− (classifySessionsOfHash (getKey 10000))
246− , benchIOSink value "classifySessionsOfHash (64 buckets)"
247− (classifySessionsOfHash (getKey 64))
248− ]
249− ]
250−
251− where
252−
253− getKey n = (`mod` n)
254−
255−-------------------------------------------------------------------------------
256−-- Mixed Transformation
257−-------------------------------------------------------------------------------
258−
259−{-# INLINE scanMap #-}
260−scanMap :: MonadIO m => Int -> SerialT m Int -> m ()
261−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
262−
263−{-# INLINE dropMap #-}
264−dropMap :: MonadIO m => Int -> SerialT m Int -> m ()
265−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
266−
267−{-# INLINE dropScan #-}
268−dropScan :: MonadIO m => Int -> SerialT m Int -> m ()
269−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
270−
271−{-# INLINE takeDrop #-}
272−takeDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
273−takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)
274−
275−{-# INLINE takeScan #-}
276−takeScan :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
277−takeScan value n = composeN n $ S.scanl' (+) 0 . S.take (value + 1)
278−
279−{-# INLINE takeMap #-}
280−takeMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
281−takeMap value n = composeN n $ S.map (subtract 1) . S.take (value + 1)
282−
283−{-# INLINE filterDrop #-}
284−filterDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
285−filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1))
286−
287−{-# INLINE filterTake #-}
288−filterTake :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
289−filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))
290−
291−{-# INLINE filterScan #-}
292−filterScan :: MonadIO m => Int -> SerialT m Int -> m ()
293−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
294−
295−{-# INLINE filterScanl1 #-}
296−filterScanl1 :: MonadIO m => Int -> SerialT m Int -> m ()
297−filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
298−
299−{-# INLINE filterMap #-}
300−filterMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
301−filterMap value n = composeN n $ S.map (subtract 1) . S.filter (<= (value + 1))
302−
303−-------------------------------------------------------------------------------
304−-- Scan and fold
305−-------------------------------------------------------------------------------
306−
307−data Pair a b =
308− Pair !a !b
309− deriving (Generic, NFData)
310−
311−{-# INLINE sumProductFold #-}
312−sumProductFold :: Monad m => SerialT m Int -> m (Int, Int)
313−sumProductFold = S.foldl' (\(s, p) x -> (s + x, p * x)) (0, 1)
314−
315−{-# INLINE sumProductScan #-}
316−sumProductScan :: Monad m => SerialT m Int -> m (Pair Int Int)
317−sumProductScan =
318− S.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p * x)) (Pair 0 1) .
319− S.scanl' (\(s, _) x -> (s + x, x)) (0, 0)
320−
321−{-# INLINE foldl'ReduceMap #-}
322−foldl'ReduceMap :: Monad m => SerialT m Int -> m Int
323−foldl'ReduceMap = fmap (+ 1) . S.foldl' (+) 0
324−
325−o_1_space_transformations_mixed :: Int -> [Benchmark]
326−o_1_space_transformations_mixed value =
327− -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl
328− -- library. If scan/fold followed by a map is efficient enough we may not
329− -- need monolithic implementations of these.
330− [ bgroup "mixed"
331− [ benchIOSink value "scanl-map" (scanMap 1)
332− , benchIOSink value "foldl-map" foldl'ReduceMap
333− , benchIOSink value "sum-product-fold" sumProductFold
334− , benchIOSink value "sum-product-scan" sumProductScan
335− ]
336− ]
337−
338−o_1_space_transformations_mixedX4 :: Int -> [Benchmark]
339−o_1_space_transformations_mixedX4 value =
340− [ bgroup "mixedX4"
341− [ benchIOSink value "scan-map" (scanMap 4)
342− , benchIOSink value "drop-map" (dropMap 4)
343− , benchIOSink value "drop-scan" (dropScan 4)
344− , benchIOSink value "take-drop" (takeDrop value 4)
345− , benchIOSink value "take-scan" (takeScan value 4)
346− , benchIOSink value "take-map" (takeMap value 4)
347− , benchIOSink value "filter-drop" (filterDrop value 4)
348− , benchIOSink value "filter-take" (filterTake value 4)
349− , benchIOSink value "filter-scan" (filterScan 4)
350− , benchIOSink value "filter-scanl1" (filterScanl1 4)
351− , benchIOSink value "filter-map" (filterMap value 4)
352− ]
353− ]
354−
355−-------------------------------------------------------------------------------
356−-- Iterating a transformation over and over again
357−-------------------------------------------------------------------------------
358−
359−-- this is quadratic
360−{-# INLINE iterateScan #-}
361−iterateScan :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
362−iterateScan = iterateSource (S.scanl' (+) 0)
363−
364−-- this is quadratic
365−{-# INLINE iterateScanl1 #-}
366−iterateScanl1 :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
367−iterateScanl1 = iterateSource (S.scanl1' (+))
368−
369−{-# INLINE iterateMapM #-}
370−iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
371−iterateMapM = iterateSource (S.mapM return)
372−
373−{-# INLINE iterateFilterEven #-}
374−iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
375−iterateFilterEven = iterateSource (S.filter even)
376−
377−{-# INLINE iterateTakeAll #-}
378−iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> SerialT m Int
379−iterateTakeAll value = iterateSource (S.take (value + 1))
380−
381−{-# INLINE iterateDropOne #-}
382−iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
383−iterateDropOne = iterateSource (S.drop 1)
384−
385−{-# INLINE iterateDropWhileFalse #-}
386−iterateDropWhileFalse :: S.MonadAsync m
387− => Int -> Int -> Int -> Int -> SerialT m Int
388−iterateDropWhileFalse value = iterateSource (S.dropWhile (> (value + 1)))
389−
390−{-# INLINE iterateDropWhileTrue #-}
391−iterateDropWhileTrue :: S.MonadAsync m
392− => Int -> Int -> Int -> Int -> SerialT m Int
393−iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))
394−
395−{-# INLINE tail #-}
396−tail :: Monad m => SerialT m a -> m ()
397−tail s = S.tail s >>= mapM_ tail
398−
399−{-# INLINE nullHeadTail #-}
400−nullHeadTail :: Monad m => SerialT m Int -> m ()
401−nullHeadTail s = do
402− r <- S.null s
403− when (not r) $ do
404− _ <- S.head s
405− S.tail s >>= mapM_ nullHeadTail
406−
407−-- Head recursive operations.
408−o_n_stack_iterated :: Int -> [Benchmark]
409−o_n_stack_iterated value = by10 `seq` by100 `seq`
410− [ bgroup "iterated"
411− [ benchIOSrc fromSerial "mapM (n/10 x 10)" $ iterateMapM by10 10
412− , benchIOSrc fromSerial "scanl' (quadratic) (n/100 x 100)" $
413− iterateScan by100 100
414− , benchIOSrc fromSerial "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10
415− , benchIOSrc fromSerial "filterEven (n/10 x 10)" $
416− iterateFilterEven by10 10
417− , benchIOSrc fromSerial "takeAll (n/10 x 10)" $
418− iterateTakeAll value by10 10
419− , benchIOSrc fromSerial "dropOne (n/10 x 10)" $ iterateDropOne by10 10
420− , benchIOSrc fromSerial "dropWhileFalse (n/10 x 10)" $
421− iterateDropWhileFalse value by10 10
422− , benchIOSrc fromSerial "dropWhileTrue (n/10 x 10)" $
423− iterateDropWhileTrue value by10 10
424− , benchIOSink value "tail" tail
425− , benchIOSink value "nullHeadTail" nullHeadTail
426− ]
427− ]
428−
429− where
430−
431− by10 = value `div` 10
432− by100 = value `div` 100
433−
434−-------------------------------------------------------------------------------
435−-- Pipes
436−-------------------------------------------------------------------------------
437−
438−o_1_space_pipes :: Int -> [Benchmark]
439−o_1_space_pipes value =
440− [ bgroup "pipes"
441− [ benchIOSink value "mapM" (transformMapM fromSerial 1)
442− , benchIOSink value "compose" (transformComposeMapM fromSerial 1)
443− , benchIOSink value "tee" (transformTeeMapM fromSerial 1)
444−#ifdef DEVBUILD
445− -- XXX this take 1 GB memory to compile
446− , benchIOSink value "zip" (transformZipMapM fromSerial 1)
447−#endif
448− ]
449− ]
450−
451−o_1_space_pipesX4 :: Int -> [Benchmark]
452−o_1_space_pipesX4 value =
453− [ bgroup "pipesX4"
454− [ benchIOSink value "mapM" (transformMapM fromSerial 4)
455− , benchIOSink value "compose" (transformComposeMapM fromSerial 4)
456− , benchIOSink value "tee" (transformTeeMapM fromSerial 4)
457−#ifdef DEVBUILD
458− -- XXX this take 1 GB memory to compile
459− , benchIOSink value "zip" (transformZipMapM fromSerial 4)
460−#endif
461− ]
462− ]
463−
464−-------------------------------------------------------------------------------
465−-- Main
466−-------------------------------------------------------------------------------
467−
468−-- In addition to gauge options, the number of elements in the stream can be
469−-- passed using the --stream-size option.
470−--
471−benchmarks :: String -> Int -> [Benchmark]
472−benchmarks moduleName size =
473− [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
474− [ o_1_space_grouping size
475− , o_1_space_transformations_mixed size
476− , o_1_space_transformations_mixedX4 size
477−
478− -- pipes
479− , o_1_space_pipes size
480− , o_1_space_pipesX4 size
481− ]
482− , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)
483− , bgroup (o_n_heap_prefix moduleName) $ Prelude.concat
484− [ o_n_space_grouping size
485− , o_n_space_functor size
486− , o_n_heap_buffering size
487− ]
488− ]
benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs+482−67
@@ -7,118 +7,533 @@
7{-# LANGUAGE CPP #-}
7{-# LANGUAGE CPP #-}
8{-# LANGUAGE FlexibleContexts #-}
8{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE DeriveAnyClass #-}
11+{-# LANGUAGE DeriveGeneric #-}
10{-# LANGUAGE RankNTypes #-}
12{-# LANGUAGE RankNTypes #-}
11
13
12module Stream.Reduce (benchmarks) where
14module Stream.Reduce (benchmarks) where
13
15
14−import Control.Monad.Catch (MonadCatch)
16+import Control.DeepSeq (NFData(..))
17+import Control.Monad.IO.Class (MonadIO(..))
15−import Data.Monoid (Sum(Sum), getSum)
18+import Data.Monoid (Sum(..))
16−import Stream.Common (benchIOSink)
19+import GHC.Generics (Generic)
17−import Streamly.Benchmark.Common (o_1_space_prefix)
20+import Streamly.Internal.Data.IsMap.HashMap ()
18−import Streamly.Internal.Data.Stream (Stream)
21+import Streamly.Internal.Data.Stream.Serial (SerialT)
19
22
20−import qualified Streamly.Internal.Data.Stream as Stream
23+import qualified Streamly.Internal.Data.Refold.Type as Refold
21−import qualified Streamly.Internal.Data.Parser as PR
24+import qualified Streamly.Internal.Data.Fold as FL
25+import qualified Stream.Common as Common
26+#ifdef USE_PRELUDE
27+import Control.Monad (when)
28+import Data.Proxy (Proxy(..))
29+import Data.HashMap.Strict (HashMap)
22−import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
30+import qualified Streamly.Internal.Data.Stream.IsStream as S
23−
31+import Streamly.Prelude (fromSerial)
24−import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),
32+import Streamly.Benchmark.Prelude hiding
25− lookup, repeat, minimum, maximum, product, last, mapM_, init)
33+ ( benchIOSrc, sourceUnfoldrM, apDiscardFst, apDiscardSnd, apLiftA2
34+ , toNullAp, monadThen, toNullM, toNullM3, filterAllInM, filterAllOutM
35+ , filterSome, breakAfterSome, toListM, toListSome, transformMapM
36+ , transformComposeMapM, transformTeeMapM, transformZipMapM)
37+#else
38+import Streamly.Benchmark.Prelude (benchIO)
39+import qualified Streamly.Internal.Data.Stream as S
40+#endif
26
41
27import Gauge
42import Gauge
43+import Streamly.Benchmark.Common
44+import Stream.Common
45+import Prelude hiding (reverse, tail)
28
46
29−import qualified Streamly.Data.Fold as FL
47+-------------------------------------------------------------------------------
30−import qualified Streamly.Internal.Data.Refold.Type as Refold
48+-- Iteration/looping utilities
31−import Control.Monad.IO.Class (MonadIO)
49+-------------------------------------------------------------------------------
50+
51+{-# INLINE iterateN #-}
52+iterateN :: (Int -> a -> a) -> a -> Int -> a
53+iterateN g initial count = f count initial
54+
55+ where
56+
57+ f (0 :: Int) x = x
58+ f i x = f (i - 1) (g i x)
59+
60+-- Iterate a transformation over a singleton stream
61+{-# INLINE iterateSingleton #-}
62+iterateSingleton :: Monad m
63+ => (Int -> SerialT m Int -> SerialT m Int)
64+ -> Int
65+ -> Int
66+ -> SerialT m Int
67+iterateSingleton g count n = iterateN g (return n) count
68+
69+{-
70+-- XXX need to check why this is slower than the explicit recursion above, even
71+-- if the above code is written in a foldr like head recursive way. We also
72+-- need to try this with foldlM' once #150 is fixed.
73+-- However, it is perhaps best to keep the iteration benchmarks independent of
74+-- foldrM and any related fusion issues.
75+{-# INLINE _iterateSingleton #-}
76+_iterateSingleton ::
77+ Monad m
78+ => (Int -> SerialT m Int -> SerialT m Int)
79+ -> Int
80+ -> Int
81+ -> SerialT m Int
82+_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
83+-}
84+
85+-- Apply transformation g count times on a stream of length len
86+{-# INLINE iterateSource #-}
87+iterateSource ::
88+ MonadAsync m
89+ => (SerialT m Int -> SerialT m Int)
90+ -> Int
91+ -> Int
92+ -> Int
93+ -> SerialT m Int
94+iterateSource g count len n = f count (sourceUnfoldrM len n)
95+
96+ where
97+
98+ f (0 :: Int) stream = stream
99+ f i stream = f (i - 1) (g stream)
100+
101+-------------------------------------------------------------------------------
102+-- Functor
103+-------------------------------------------------------------------------------
104+
105+o_n_space_functor :: Int -> [Benchmark]
106+o_n_space_functor value =
107+ [ bgroup "Functor"
108+ [ benchIO "(+) (n times) (baseline)" $ \i0 ->
109+ iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value
110+ , benchIOSrc "(<$) (n times)" $
111+ iterateSingleton (<$) value
112+ , benchIOSrc "fmap (n times)" $
113+ iterateSingleton (fmap . (+)) value
114+ {-
115+ , benchIOSrc fromSerial "_(<$) (n times)" $
116+ _iterateSingleton (<$) value
117+ , benchIOSrc fromSerial "_fmap (n times)" $
118+ _iterateSingleton (fmap . (+)) value
119+ -}
120+ ]
121+ ]
122+
123+-------------------------------------------------------------------------------
124+-- Grouping transformations
125+-------------------------------------------------------------------------------
126+
127+#ifdef USE_PRELUDE
128+{-# INLINE groups #-}
129+groups :: MonadIO m => SerialT m Int -> m ()
130+groups = Common.drain . S.groups FL.drain
131+
132+-- XXX Change this test when the order of comparison is later changed
133+{-# INLINE groupsByGT #-}
134+groupsByGT :: MonadIO m => SerialT m Int -> m ()
135+groupsByGT = Common.drain . S.groupsBy (>) FL.drain
136+
137+{-# INLINE groupsByEq #-}
138+groupsByEq :: MonadIO m => SerialT m Int -> m ()
139+groupsByEq = Common.drain . S.groupsBy (==) FL.drain
140+
141+-- XXX Change this test when the order of comparison is later changed
142+{-# INLINE groupsByRollingLT #-}
143+groupsByRollingLT :: MonadIO m => SerialT m Int -> m ()
144+groupsByRollingLT =
145+ Common.drain . S.groupsByRolling (<) FL.drain
146+
147+{-# INLINE groupsByRollingEq #-}
148+groupsByRollingEq :: MonadIO m => SerialT m Int -> m ()
149+groupsByRollingEq =
150+ Common.drain . S.groupsByRolling (==) FL.drain
151+#endif
32
152
33{-# INLINE foldMany #-}
153{-# INLINE foldMany #-}
34−foldMany :: Monad m => Stream m Int -> m ()
154+foldMany :: Monad m => SerialT m Int -> m ()
35foldMany =
155foldMany =
36− Stream.fold FL.drain
156+ Common.drain
37 . fmap getSum
157 . fmap getSum
38− . Stream.foldMany (FL.take 2 FL.mconcat)
158+ . S.foldMany (FL.take 2 FL.mconcat)
39 . fmap Sum
159 . fmap Sum
40
160
41{-# INLINE foldManyPost #-}
161{-# INLINE foldManyPost #-}
42−foldManyPost :: Monad m => Stream m Int -> m ()
162+foldManyPost :: Monad m => SerialT m Int -> m ()
43foldManyPost =
163foldManyPost =
44− Stream.fold FL.drain
164+ Common.drain
45 . fmap getSum
165 . fmap getSum
46− . Stream.foldManyPost (FL.take 2 FL.mconcat)
166+ . S.foldManyPost (FL.take 2 FL.mconcat)
47 . fmap Sum
167 . fmap Sum
48
168
49{-# INLINE refoldMany #-}
169{-# INLINE refoldMany #-}
50−refoldMany :: Monad m => Stream m Int -> m ()
170+refoldMany :: Monad m => SerialT m Int -> m ()
51refoldMany =
171refoldMany =
52− Stream.fold FL.drain
172+ Common.drain
53 . fmap getSum
173 . fmap getSum
54− . Stream.refoldMany (Refold.take 2 Refold.sconcat) (return mempty)
174+ . S.refoldMany (Refold.take 2 Refold.sconcat) (return mempty)
55 . fmap Sum
175 . fmap Sum
56
176
57{-# INLINE foldIterateM #-}
177{-# INLINE foldIterateM #-}
58−foldIterateM :: Monad m => Stream m Int -> m ()
178+foldIterateM :: Monad m => SerialT m Int -> m ()
59foldIterateM =
179foldIterateM =
60− Stream.fold FL.drain
180+ Common.drain
61 . fmap getSum
181 . fmap getSum
62− . Stream.foldIterateM
182+ . S.foldIterateM
63 (return . FL.take 2 . FL.sconcat) (return (Sum 0))
183 (return . FL.take 2 . FL.sconcat) (return (Sum 0))
64 . fmap Sum
184 . fmap Sum
65
185
66{-# INLINE refoldIterateM #-}
186{-# INLINE refoldIterateM #-}
67−refoldIterateM :: Monad m => Stream m Int -> m ()
187+refoldIterateM :: Monad m => SerialT m Int -> m ()
68refoldIterateM =
188refoldIterateM =
69− Stream.fold FL.drain
189+ Common.drain
70 . fmap getSum
190 . fmap getSum
71− . Stream.refoldIterateM
191+ . S.refoldIterateM
72 (Refold.take 2 Refold.sconcat) (return (Sum 0))
192 (Refold.take 2 Refold.sconcat) (return (Sum 0))
73 . fmap Sum
193 . fmap Sum
74
194
75−{-# INLINE parseMany #-}
76−parseMany :: MonadCatch m => Int -> Stream m Int -> m ()
77−parseMany n =
78− Stream.fold FL.drain
79− . fmap getSum
80− . Stream.parseMany (PR.fromFold $ FL.take n FL.mconcat)
81− . fmap Sum
82−
83−{-# INLINE parseManyD #-}
84−parseManyD :: MonadCatch m => Int -> Stream m Int -> m ()
85−parseManyD n =
86− Stream.fold FL.drain
87− . fmap getSum
88− . Stream.parseManyD (ParserD.fromFold $ FL.take n FL.mconcat)
89− . fmap Sum
90−
91−{-# INLINE parseIterate #-}
92−parseIterate :: MonadCatch m => Int -> Stream m Int -> m ()
93−parseIterate n =
94− Stream.fold FL.drain
95− . fmap getSum
96− . Stream.parseIterate (\_ -> PR.fromFold $ FL.take n FL.mconcat) 0
97− . fmap Sum
98−
99−{-# INLINE arraysOf #-}
100−arraysOf :: (MonadCatch m, MonadIO m) => Int -> Stream m Int -> m ()
101−arraysOf n =
102− Stream.fold FL.drain
103− . Stream.arraysOf n
104−
105o_1_space_grouping :: Int -> [Benchmark]
195o_1_space_grouping :: Int -> [Benchmark]
106o_1_space_grouping value =
196o_1_space_grouping value =
107 -- Buffering operations using heap proportional to group/window sizes.
197 -- Buffering operations using heap proportional to group/window sizes.
108− [ bgroup "reduce"
198+ [ bgroup "grouping"
199+ [
200+#ifdef USE_PRELUDE
201+ benchIOSink value "groups" groups
202+ , benchIOSink value "groupsByGT" groupsByGT
203+ , benchIOSink value "groupsByEq" groupsByEq
204+ , benchIOSink value "groupsByRollingLT" groupsByRollingLT
205+ , benchIOSink value "groupsByRollingEq" groupsByRollingEq
206+ ,
207+#endif
208+ -- XXX parseMany/parseIterate benchmarks are in the Parser/ParserD
209+ -- modules we can bring those here. arraysOf benchmarks are in
210+ -- Parser/ParserD/Array.Stream/FileSystem.Handle.
109− [ benchIOSink value "foldMany" foldMany
211+ benchIOSink value "foldMany" foldMany
110 , benchIOSink value "foldManyPost" foldManyPost
212 , benchIOSink value "foldManyPost" foldManyPost
111 , benchIOSink value "refoldMany" refoldMany
213 , benchIOSink value "refoldMany" refoldMany
112 , benchIOSink value "foldIterateM" foldIterateM
214 , benchIOSink value "foldIterateM" foldIterateM
113 , benchIOSink value "refoldIterateM" refoldIterateM
215 , benchIOSink value "refoldIterateM" refoldIterateM
114− , benchIOSink value "parseMany" $ parseMany value
115− , benchIOSink value "parseManyD" $ parseManyD value
116− , benchIOSink value "parseIterate" $ parseIterate value
117− , benchIOSink value "arraysOf" $ arraysOf value
118 ]
216 ]
119 ]
217 ]
120
218
219+-------------------------------------------------------------------------------
220+-- Size conserving transformations (reordering, buffering, etc.)
221+-------------------------------------------------------------------------------
222+
223+{-# INLINE reverse #-}
224+reverse :: MonadIO m => Int -> SerialT m Int -> m ()
225+reverse n = composeN n S.reverse
226+
227+{-# INLINE reverse' #-}
228+reverse' :: MonadIO m => Int -> SerialT m Int -> m ()
229+reverse' n = composeN n S.reverse'
230+
231+o_n_heap_buffering :: Int -> [Benchmark]
232+o_n_heap_buffering value =
233+ [ bgroup "buffered"
234+ [
235+ -- Reversing a stream
236+ benchIOSink value "reverse" (reverse 1)
237+ , benchIOSink value "reverse'" (reverse' 1)
238+
239+#ifdef USE_PRELUDE
240+ , benchIOSink value "mkAsync" (mkAsync fromSerial)
241+#endif
242+ ]
243+ ]
244+
245+-------------------------------------------------------------------------------
246+-- Grouping/Splitting
247+-------------------------------------------------------------------------------
248+
249+#ifdef USE_PRELUDE
250+{-# INLINE classifySessionsOf #-}
251+classifySessionsOf :: MonadAsync m => (Int -> Int) -> SerialT m Int -> m ()
252+classifySessionsOf getKey =
253+ Common.drain
254+ . S.classifySessionsOf
255+ (const (return False)) 3 (FL.take 10 FL.sum)
256+ . S.timestamped
257+ . fmap (\x -> (getKey x, x))
258+
259+{-# INLINE classifySessionsOfHash #-}
260+classifySessionsOfHash :: MonadAsync m =>
261+ (Int -> Int) -> SerialT m Int -> m ()
262+classifySessionsOfHash getKey =
263+ Common.drain
264+ . S.classifySessionsByGeneric
265+ (Proxy :: Proxy (HashMap k))
266+ 1 False (const (return False)) 3 (FL.take 10 FL.sum)
267+ . S.timestamped
268+ . fmap (\x -> (getKey x, x))
269+
270+o_n_space_grouping :: Int -> [Benchmark]
271+o_n_space_grouping value =
272+ -- Buffering operations using heap proportional to group/window sizes.
273+ [ bgroup "grouping"
274+ [ benchIOSink value "classifySessionsOf (10000 buckets)"
275+ (classifySessionsOf (getKey 10000))
276+ , benchIOSink value "classifySessionsOf (64 buckets)"
277+ (classifySessionsOf (getKey 64))
278+ , benchIOSink value "classifySessionsOfHash (10000 buckets)"
279+ (classifySessionsOfHash (getKey 10000))
280+ , benchIOSink value "classifySessionsOfHash (64 buckets)"
281+ (classifySessionsOfHash (getKey 64))
282+ ]
283+ ]
284+
285+ where
286+
287+ getKey n = (`mod` n)
288+#endif
289+
290+-------------------------------------------------------------------------------
291+-- Mixed Transformation
292+-------------------------------------------------------------------------------
293+
294+{-# INLINE scanMap #-}
295+scanMap :: MonadIO m => Int -> SerialT m Int -> m ()
296+scanMap n = composeN n $ fmap (subtract 1) . Common.scanl' (+) 0
297+
298+{-# INLINE dropMap #-}
299+dropMap :: MonadIO m => Int -> SerialT m Int -> m ()
300+dropMap n = composeN n $ fmap (subtract 1) . S.drop 1
301+
302+{-# INLINE dropScan #-}
303+dropScan :: MonadIO m => Int -> SerialT m Int -> m ()
304+dropScan n = composeN n $ Common.scanl' (+) 0 . S.drop 1
305+
306+{-# INLINE takeDrop #-}
307+takeDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
308+takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)
309+
310+{-# INLINE takeScan #-}
311+takeScan :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
312+takeScan value n = composeN n $ Common.scanl' (+) 0 . S.take (value + 1)
313+
314+{-# INLINE takeMap #-}
315+takeMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
316+takeMap value n = composeN n $ fmap (subtract 1) . S.take (value + 1)
317+
318+{-# INLINE filterDrop #-}
319+filterDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
320+filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1))
321+
322+{-# INLINE filterTake #-}
323+filterTake :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
324+filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))
325+
326+{-# INLINE filterScan #-}
327+filterScan :: MonadIO m => Int -> SerialT m Int -> m ()
328+filterScan n = composeN n $ Common.scanl' (+) 0 . S.filter (<= maxBound)
329+
330+#ifdef USE_PRELUDE
331+{-# INLINE filterScanl1 #-}
332+filterScanl1 :: MonadIO m => Int -> SerialT m Int -> m ()
333+filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
334+#endif
335+
336+{-# INLINE filterMap #-}
337+filterMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
338+filterMap value n = composeN n $ fmap (subtract 1) . S.filter (<= (value + 1))
339+
340+-------------------------------------------------------------------------------
341+-- Scan and fold
342+-------------------------------------------------------------------------------
343+
344+data Pair a b =
345+ Pair !a !b
346+ deriving (Generic, NFData)
347+
348+{-# INLINE sumProductFold #-}
349+sumProductFold :: Monad m => SerialT m Int -> m (Int, Int)
350+sumProductFold = Common.foldl' (\(s, p) x -> (s + x, p * x)) (0, 1)
351+
352+{-# INLINE sumProductScan #-}
353+sumProductScan :: Monad m => SerialT m Int -> m (Pair Int Int)
354+sumProductScan =
355+ Common.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p * x)) (Pair 0 1) .
356+ Common.scanl' (\(s, _) x -> (s + x, x)) (0, 0)
357+
358+{-# INLINE foldl'ReduceMap #-}
359+foldl'ReduceMap :: Monad m => SerialT m Int -> m Int
360+foldl'ReduceMap = fmap (+ 1) . Common.foldl' (+) 0
361+
362+o_1_space_transformations_mixed :: Int -> [Benchmark]
363+o_1_space_transformations_mixed value =
364+ -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl
365+ -- library. If scan/fold followed by a map is efficient enough we may not
366+ -- need monolithic implementations of these.
367+ [ bgroup "mixed"
368+ [ benchIOSink value "scanl-map" (scanMap 1)
369+ , benchIOSink value "foldl-map" foldl'ReduceMap
370+ , benchIOSink value "sum-product-fold" sumProductFold
371+ , benchIOSink value "sum-product-scan" sumProductScan
372+ ]
373+ ]
374+
375+o_1_space_transformations_mixedX4 :: Int -> [Benchmark]
376+o_1_space_transformations_mixedX4 value =
377+ [ bgroup "mixedX4"
378+ [ benchIOSink value "scan-map" (scanMap 4)
379+ , benchIOSink value "drop-map" (dropMap 4)
380+ , benchIOSink value "drop-scan" (dropScan 4)
381+ , benchIOSink value "take-drop" (takeDrop value 4)
382+ , benchIOSink value "take-scan" (takeScan value 4)
383+ , benchIOSink value "take-map" (takeMap value 4)
384+ , benchIOSink value "filter-drop" (filterDrop value 4)
385+ , benchIOSink value "filter-take" (filterTake value 4)
386+ , benchIOSink value "filter-scan" (filterScan 4)
387+#ifdef USE_PRELUDE
388+ , benchIOSink value "filter-scanl1" (filterScanl1 4)
389+#endif
390+ , benchIOSink value "filter-map" (filterMap value 4)
391+ ]
392+ ]
393+
394+-------------------------------------------------------------------------------
395+-- Iterating a transformation over and over again
396+-------------------------------------------------------------------------------
397+
398+-- this is quadratic
399+{-# INLINE iterateScan #-}
400+iterateScan :: MonadAsync m => Int -> Int -> Int -> SerialT m Int
401+iterateScan = iterateSource (Common.scanl' (+) 0)
402+
403+#ifdef USE_PRELUDE
404+-- this is quadratic
405+{-# INLINE iterateScanl1 #-}
406+iterateScanl1 :: MonadAsync m => Int -> Int -> Int -> SerialT m Int
407+iterateScanl1 = iterateSource (S.scanl1' (+))
408+#endif
409+
410+{-# INLINE iterateMapM #-}
411+iterateMapM :: MonadAsync m => Int -> Int -> Int -> SerialT m Int
412+iterateMapM = iterateSource (S.mapM return)
413+
414+{-# INLINE iterateFilterEven #-}
415+iterateFilterEven :: MonadAsync m => Int -> Int -> Int -> SerialT m Int
416+iterateFilterEven = iterateSource (S.filter even)
417+
418+{-# INLINE iterateTakeAll #-}
419+iterateTakeAll :: MonadAsync m => Int -> Int -> Int -> Int -> SerialT m Int
420+iterateTakeAll value = iterateSource (S.take (value + 1))
421+
422+{-# INLINE iterateDropOne #-}
423+iterateDropOne :: MonadAsync m => Int -> Int -> Int -> SerialT m Int
424+iterateDropOne = iterateSource (S.drop 1)
425+
426+{-# INLINE iterateDropWhileFalse #-}
427+iterateDropWhileFalse :: MonadAsync m
428+ => Int -> Int -> Int -> Int -> SerialT m Int
429+iterateDropWhileFalse value = iterateSource (S.dropWhile (> (value + 1)))
430+
431+{-# INLINE iterateDropWhileTrue #-}
432+iterateDropWhileTrue :: MonadAsync m
433+ => Int -> Int -> Int -> Int -> SerialT m Int
434+iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))
435+
436+#ifdef USE_PRELUDE
437+{-# INLINE tail #-}
438+tail :: Monad m => SerialT m a -> m ()
439+tail s = S.tail s >>= mapM_ tail
440+
441+{-# INLINE nullHeadTail #-}
442+nullHeadTail :: Monad m => SerialT m Int -> m ()
443+nullHeadTail s = do
444+ r <- S.null s
445+ when (not r) $ do
446+ _ <- S.head s
447+ S.tail s >>= mapM_ nullHeadTail
448+#endif
449+
450+-- Head recursive operations.
451+o_n_stack_iterated :: Int -> [Benchmark]
452+o_n_stack_iterated value = by10 `seq` by100 `seq`
453+ [ bgroup "iterated"
454+ [ benchIOSrc "mapM (n/10 x 10)" $ iterateMapM by10 10
455+ , benchIOSrc "scanl' (quadratic) (n/100 x 100)" $
456+ iterateScan by100 100
457+#ifdef USE_PRELUDE
458+ , benchIOSrc "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10
459+#endif
460+ , benchIOSrc "filterEven (n/10 x 10)" $
461+ iterateFilterEven by10 10
462+ , benchIOSrc "takeAll (n/10 x 10)" $
463+ iterateTakeAll value by10 10
464+ , benchIOSrc "dropOne (n/10 x 10)" $ iterateDropOne by10 10
465+ , benchIOSrc "dropWhileFalse (n/10 x 10)" $
466+ iterateDropWhileFalse value by10 10
467+ , benchIOSrc "dropWhileTrue (n/10 x 10)" $
468+ iterateDropWhileTrue value by10 10
469+#ifdef USE_PRELUDE
470+ , benchIOSink value "tail" tail
471+ , benchIOSink value "nullHeadTail" nullHeadTail
472+#endif
473+ ]
474+ ]
475+
476+ where
477+
478+ by10 = value `div` 10
479+ by100 = value `div` 100
480+
481+-------------------------------------------------------------------------------
482+-- Pipes
483+-------------------------------------------------------------------------------
484+
485+o_1_space_pipes :: Int -> [Benchmark]
486+o_1_space_pipes value =
487+ [ bgroup "pipes"
488+ [ benchIOSink value "mapM" (transformMapM 1)
489+ , benchIOSink value "compose" (transformComposeMapM 1)
490+ , benchIOSink value "tee" (transformTeeMapM 1)
491+#ifdef DEVBUILD
492+ -- XXX this take 1 GB memory to compile
493+ , benchIOSink value "zip" (transformZipMapM 1)
494+#endif
495+ ]
496+ ]
497+
498+o_1_space_pipesX4 :: Int -> [Benchmark]
499+o_1_space_pipesX4 value =
500+ [ bgroup "pipesX4"
501+ [ benchIOSink value "mapM" (transformMapM 4)
502+ , benchIOSink value "compose" (transformComposeMapM 4)
503+ , benchIOSink value "tee" (transformTeeMapM 4)
504+#ifdef DEVBUILD
505+ -- XXX this take 1 GB memory to compile
506+ , benchIOSink value "zip" (transformZipMapM 4)
507+#endif
508+ ]
509+ ]
510+
511+-------------------------------------------------------------------------------
512+-- Main
513+-------------------------------------------------------------------------------
514+
515+-- In addition to gauge options, the number of elements in the stream can be
516+-- passed using the --stream-size option.
517+--
121benchmarks :: String -> Int -> [Benchmark]
518benchmarks :: String -> Int -> [Benchmark]
122benchmarks moduleName size =
519benchmarks moduleName size =
123− [ bgroup (o_1_space_prefix moduleName) $ o_1_space_grouping size
520+ [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
521+ [ o_1_space_grouping size
522+ , o_1_space_transformations_mixed size
523+ , o_1_space_transformations_mixedX4 size
524+
525+ -- pipes
526+ , o_1_space_pipes size
527+ , o_1_space_pipesX4 size
528+ ]
529+ , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)
530+ , bgroup (o_n_heap_prefix moduleName) $ Prelude.concat
531+ [
532+#ifdef USE_PRELUDE
533+ o_n_space_grouping size
534+ ,
535+#endif
536+ o_n_space_functor size
537+ , o_n_heap_buffering size
538+ ]
124− ]
539+ ]
benchmark/Streamly/Benchmark/Data/Stream/Transformation.hs → benchmark/Streamly/Benchmark/Data/Stream/Transform.hsrenamed+124−184
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Stream.Transformation
2+-- Module : Stream.Transform
3-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -18,36 +18,37 @@
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
19#endif
20
20
21−module Stream.Transformation (benchmarks) where
21+module Stream.Transform (benchmarks) where
22
22
23+import Control.DeepSeq (NFData(..))
23import Control.Monad.IO.Class (MonadIO(..))
24import Control.Monad.IO.Class (MonadIO(..))
25+import Data.Functor.Identity (Identity)
24
26
25import System.Random (randomRIO)
27import System.Random (randomRIO)
26
28
27import qualified Streamly.Internal.Data.Fold as FL
29import qualified Streamly.Internal.Data.Fold as FL
28
30
31+import qualified Prelude
32+import qualified Stream.Common as Common
33+import qualified Streamly.Internal.Data.Unfold as Unfold
29#ifdef USE_PRELUDE
34#ifdef USE_PRELUDE
30−import Streamly.Prelude (fromSerial, MonadAsync)
35+import Streamly.Benchmark.Prelude hiding
31−import Streamly.Benchmark.Prelude
36+ ( benchIOSrc, sourceUnfoldrM, apDiscardFst, apDiscardSnd, apLiftA2, toNullAp
37+ , monadThen, toNullM, toNullM3, filterAllInM, filterAllOutM, filterSome
38+ , breakAfterSome, toListM, toListSome, transformMapM, transformComposeMapM
39+ , transformTeeMapM, transformZipMapM, mapN, mapM)
40+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
32import Streamly.Internal.Data.Time.Units
41import Streamly.Internal.Data.Time.Units
33−import qualified Streamly.Benchmark.Prelude as BP
34−import qualified Streamly.Prelude as S
35−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
36−import qualified Streamly.Internal.Data.Unfold as Unfold
37#else
42#else
38−import Control.DeepSeq (NFData(..))
43+import Streamly.Benchmark.Prelude (benchIO)
39−import Data.Functor.Identity (Identity)
40−import Stream.Common
41import qualified Streamly.Internal.Data.Stream as Stream
44import qualified Streamly.Internal.Data.Stream as Stream
42−import qualified Streamly.Internal.Data.Stream as S
43−import qualified Streamly.Internal.Data.Stream as Internal
44−import qualified Prelude
45#endif
45#endif
46
46
47import Gauge
47import Gauge
48import Streamly.Internal.Data.Stream.Serial (SerialT)
48import Streamly.Internal.Data.Stream.Serial (SerialT)
49+import Stream.Common hiding (scanl')
49import Streamly.Benchmark.Common
50import Streamly.Benchmark.Common
50−import Prelude hiding (sequence, mapM, fmap)
51+import Prelude hiding (sequence, mapM)
51
52
52-------------------------------------------------------------------------------
53-------------------------------------------------------------------------------
53-- Pipelines (stream-to-stream transformations)
54-- Pipelines (stream-to-stream transformations)
@@ -60,7 +61,7 @@ import Prelude hiding (sequence, mapM, fmap)
60-------------------------------------------------------------------------------
61-------------------------------------------------------------------------------
61-- Traversable Instance
62-- Traversable Instance
62-------------------------------------------------------------------------------
63-------------------------------------------------------------------------------
63−#ifndef USE_PRELUDE
64+
64{-# INLINE traversableTraverse #-}
65{-# INLINE traversableTraverse #-}
65traversableTraverse :: SerialT Identity Int -> IO (SerialT Identity Int)
66traversableTraverse :: SerialT Identity Int -> IO (SerialT Identity Int)
66traversableTraverse = traverse return
67traversableTraverse = traverse return
@@ -95,111 +96,89 @@ o_n_space_traversable value =
95 , benchPureSinkIO value "sequence" traversableSequence
96 , benchPureSinkIO value "sequence" traversableSequence
96 ]
97 ]
97 ]
98 ]
98−#endif
99
99
100−#ifdef USE_PRELUDE
101−{-# INLINE composeNG #-}
102−composeNG ::
103− (S.IsStream t, Monad m)
104− => Int
105− -> (t m Int -> S.SerialT m Int)
106− -> t m Int
107− -> m ()
108−composeNG = BP.composeN
109−#else
110−{-# INLINE composeNG #-}
111−composeNG ::
112− (Monad m)
113− => Int
114− -> (SerialT m Int -> SerialT m Int)
115− -> SerialT m Int
116− -> m ()
117−composeNG _n = return $ Stream.fold FL.drain
118−#endif
119-------------------------------------------------------------------------------
100-------------------------------------------------------------------------------
120-- maps and scans
101-- maps and scans
121-------------------------------------------------------------------------------
102-------------------------------------------------------------------------------
122
103
123−
124−{-# INLINE scan #-}
125−scan :: MonadIO m => Int -> SerialT m Int -> m ()
126−scan n = composeNG n $ S.scan FL.sum
127−
128−{-# INLINE tap #-}
129−tap :: MonadIO m => Int -> SerialT m Int -> m ()
130−tap n = composeNG n $ S.tap FL.sum
131−
132#ifdef USE_PRELUDE
104#ifdef USE_PRELUDE
133{-# INLINE scanl' #-}
105{-# INLINE scanl' #-}
134scanl' :: MonadIO m => Int -> SerialT m Int -> m ()
106scanl' :: MonadIO m => Int -> SerialT m Int -> m ()
135−scanl' n = composeNG n $ S.scanl' (+) 0
107+scanl' n = composeN n $ Stream.scanl' (+) 0
136
108
137{-# INLINE scanlM' #-}
109{-# INLINE scanlM' #-}
138scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
110scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
139−scanlM' n = composeNG n $ S.scanlM' (\b a -> return $ b + a) (return 0)
111+scanlM' n = composeN n $ Stream.scanlM' (\b a -> return $ b + a) (return 0)
140
112
141{-# INLINE scanl1' #-}
113{-# INLINE scanl1' #-}
142scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()
114scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()
143−scanl1' n = composeNG n $ S.scanl1' (+)
115+scanl1' n = composeN n $ Stream.scanl1' (+)
144
116
145{-# INLINE scanl1M' #-}
117{-# INLINE scanl1M' #-}
146scanl1M' :: MonadIO m => Int -> SerialT m Int -> m ()
118scanl1M' :: MonadIO m => Int -> SerialT m Int -> m ()
147−scanl1M' n = composeNG n $ S.scanl1M' (\b a -> return $ b + a)
119+scanl1M' n = composeN n $ Stream.scanl1M' (\b a -> return $ b + a)
120+#endif
121+
122+{-# INLINE scan #-}
123+scan :: MonadIO m => Int -> SerialT m Int -> m ()
124+scan n = composeN n $ Stream.scan FL.sum
148
125
126+#ifdef USE_PRELUDE
149{-# INLINE postscanl' #-}
127{-# INLINE postscanl' #-}
150postscanl' :: MonadIO m => Int -> SerialT m Int -> m ()
128postscanl' :: MonadIO m => Int -> SerialT m Int -> m ()
151−postscanl' n = composeNG n $ S.postscanl' (+) 0
129+postscanl' n = composeN n $ Stream.postscanl' (+) 0
152
130
153{-# INLINE postscanlM' #-}
131{-# INLINE postscanlM' #-}
154postscanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
132postscanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
155−postscanlM' n = composeNG n $ S.postscanlM' (\b a -> return $ b + a) (return 0)
133+postscanlM' n = composeN n $ Stream.postscanlM' (\b a -> return $ b + a) (return 0)
156−
134+#endif
157
135
158{-# INLINE postscan #-}
136{-# INLINE postscan #-}
159postscan :: MonadIO m => Int -> SerialT m Int -> m ()
137postscan :: MonadIO m => Int -> SerialT m Int -> m ()
160−postscan n = composeNG n $ S.postscan FL.sum
138+postscan n = composeN n $ Stream.postscan FL.sum
161
139
162{-# INLINE sequence #-}
140{-# INLINE sequence #-}
163−sequence ::
141+sequence :: MonadAsync m => SerialT m (m Int) -> m ()
164− (S.IsStream t, S.MonadAsync m)
165− => (t m Int -> S.SerialT m Int)
166− -> t m (m Int)
167− -> m ()
168−sequence t = S.drain . t . S.sequence
142+sequence = Common.drain . Stream.sequence
143+
144+{-# INLINE tap #-}
145+tap :: MonadIO m => Int -> SerialT m Int -> m ()
146+tap n = composeN n $ Stream.tap FL.sum
169
147
148+#ifdef USE_PRELUDE
170{-# INLINE pollCounts #-}
149{-# INLINE pollCounts #-}
171pollCounts :: Int -> SerialT IO Int -> IO ()
150pollCounts :: Int -> SerialT IO Int -> IO ()
172pollCounts n =
151pollCounts n =
173− composeN n (Internal.pollCounts (const True) f)
152+ composeN n (Stream.pollCounts (const True) f)
174
153
175 where
154 where
176
155
177− f = S.drain . Internal.rollingMap2 (-) . Internal.delayPost 1
156+ f = Stream.drain . Stream.rollingMap2 (-) . Stream.delayPost 1
178
157
179{-# INLINE timestamped #-}
158{-# INLINE timestamped #-}
180−timestamped :: (S.MonadAsync m) => SerialT m Int -> m ()
159+timestamped :: (MonadAsync m) => SerialT m Int -> m ()
181−timestamped = S.drain . Internal.timestamped
160+timestamped = Stream.drain . Stream.timestamped
182−
183−{-# INLINE trace #-}
184−trace :: MonadAsync m => Int -> SerialT m Int -> m ()
185−trace n = composeNG n $ Internal.trace return
186#endif
161#endif
187
162
188{-# INLINE foldrS #-}
163{-# INLINE foldrS #-}
189foldrS :: MonadIO m => Int -> SerialT m Int -> m ()
164foldrS :: MonadIO m => Int -> SerialT m Int -> m ()
190−foldrS n = composeNG n $ Internal.foldrS S.cons S.nil
165+foldrS n = composeN n $ Stream.foldrS Stream.cons Stream.nil
191
166
192{-# INLINE foldrSMap #-}
167{-# INLINE foldrSMap #-}
193foldrSMap :: MonadIO m => Int -> SerialT m Int -> m ()
168foldrSMap :: MonadIO m => Int -> SerialT m Int -> m ()
194−foldrSMap n = composeNG n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
169+foldrSMap n = composeN n $ Stream.foldrS (\x xs -> x + 1 `Stream.cons` xs) Stream.nil
195
170
196{-# INLINE foldrT #-}
171{-# INLINE foldrT #-}
197foldrT :: MonadIO m => Int -> SerialT m Int -> m ()
172foldrT :: MonadIO m => Int -> SerialT m Int -> m ()
198−foldrT n = composeNG n $ Internal.foldrT S.cons S.nil
173+foldrT n = composeN n $ Stream.foldrT Stream.cons Stream.nil
199
174
200{-# INLINE foldrTMap #-}
175{-# INLINE foldrTMap #-}
201foldrTMap :: MonadIO m => Int -> SerialT m Int -> m ()
176foldrTMap :: MonadIO m => Int -> SerialT m Int -> m ()
202−foldrTMap n = composeNG n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
177+foldrTMap n = composeN n $ Stream.foldrT (\x xs -> x + 1 `Stream.cons` xs) Stream.nil
178+
179+{-# INLINE trace #-}
180+trace :: MonadAsync m => Int -> SerialT m Int -> m ()
181+trace n = composeN n $ Stream.trace return
203
182
204o_1_space_mapping :: Int -> [Benchmark]
183o_1_space_mapping :: Int -> [Benchmark]
205o_1_space_mapping value =
184o_1_space_mapping value =
@@ -211,13 +190,14 @@ o_1_space_mapping value =
211 , benchIOSink value "foldrSMap" (foldrSMap 1)
190 , benchIOSink value "foldrSMap" (foldrSMap 1)
212 , benchIOSink value "foldrT" (foldrT 1)
191 , benchIOSink value "foldrT" (foldrT 1)
213 , benchIOSink value "foldrTMap" (foldrTMap 1)
192 , benchIOSink value "foldrTMap" (foldrTMap 1)
214−#ifdef USE_PRELUDE
193+
215 -- Mapping
194 -- Mapping
216− , benchIOSink value "map" (mapN fromSerial 1)
195+ , benchIOSink value "map" (mapN 1)
217 , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
196 , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
218− sequence fromSerial (sourceUnfoldrAction value n)
197+ sequence (sourceUnfoldrAction value n)
219− , benchIOSink value "mapM" (mapM fromSerial 1)
198+ , benchIOSink value "mapM" (mapM 1)
220−
199+ , benchIOSink value "tap" (tap 1)
200+#ifdef USE_PRELUDE
221 , benchIOSink value "pollCounts 1 second" (pollCounts 1)
201 , benchIOSink value "pollCounts 1 second" (pollCounts 1)
222 , benchIOSink value "timestamped" timestamped
202 , benchIOSink value "timestamped" timestamped
223
203
@@ -228,48 +208,46 @@ o_1_space_mapping value =
228 , benchIOSink value "scanl1M'" (scanl1M' 1)
208 , benchIOSink value "scanl1M'" (scanl1M' 1)
229 , benchIOSink value "postscanl'" (postscanl' 1)
209 , benchIOSink value "postscanl'" (postscanl' 1)
230 , benchIOSink value "postscanlM'" (postscanlM' 1)
210 , benchIOSink value "postscanlM'" (postscanlM' 1)
231− , benchIOSink value "postscan" (postscan 1)
232#endif
211#endif
233 , benchIOSink value "scan" (scan 1)
212 , benchIOSink value "scan" (scan 1)
234− , benchIOSink value "tap" (tap 1)
213+ , benchIOSink value "postscan" (postscan 1)
235 ]
214 ]
236 ]
215 ]
237
216
238−
239−#ifdef USE_PRELUDE
240o_1_space_mappingX4 :: Int -> [Benchmark]
217o_1_space_mappingX4 :: Int -> [Benchmark]
241o_1_space_mappingX4 value =
218o_1_space_mappingX4 value =
242 [ bgroup "mappingX4"
219 [ bgroup "mappingX4"
243− [ benchIOSink value "map" (mapN fromSerial 4)
220+ [ benchIOSink value "map" (mapN 4)
244− , benchIOSink value "mapM" (mapM fromSerial 4)
221+ , benchIOSink value "mapM" (mapM 4)
245 , benchIOSink value "trace" (trace 4)
222 , benchIOSink value "trace" (trace 4)
246
223
224+#ifdef USE_PRELUDE
247 , benchIOSink value "scanl'" (scanl' 4)
225 , benchIOSink value "scanl'" (scanl' 4)
248 , benchIOSink value "scanl1'" (scanl1' 4)
226 , benchIOSink value "scanl1'" (scanl1' 4)
249 , benchIOSink value "scanlM'" (scanlM' 4)
227 , benchIOSink value "scanlM'" (scanlM' 4)
250 , benchIOSink value "scanl1M'" (scanl1M' 4)
228 , benchIOSink value "scanl1M'" (scanl1M' 4)
251 , benchIOSink value "postscanl'" (postscanl' 4)
229 , benchIOSink value "postscanl'" (postscanl' 4)
252 , benchIOSink value "postscanlM'" (postscanlM' 4)
230 , benchIOSink value "postscanlM'" (postscanlM' 4)
231+#endif
253 ]
232 ]
254 ]
233 ]
255
234
256−
257{-# INLINE sieveScan #-}
235{-# INLINE sieveScan #-}
258sieveScan :: Monad m => SerialT m Int -> SerialT m Int
236sieveScan :: Monad m => SerialT m Int -> SerialT m Int
259sieveScan =
237sieveScan =
260− S.mapMaybe snd
238+ Stream.mapMaybe snd
261− . S.scanlM' (\(primes, _) n -> do
239+ . Stream.scan (FL.foldlM' (\(primes, _) n -> do
262 return $
240 return $
263 let ps = takeWhile (\p -> p * p <= n) primes
241 let ps = takeWhile (\p -> p * p <= n) primes
264 in if all (\p -> n `mod` p /= 0) ps
242 in if all (\p -> n `mod` p /= 0) ps
265 then (primes ++ [n], Just n)
243 then (primes ++ [n], Just n)
266− else (primes, Nothing)) (return ([2], Just 2))
244+ else (primes, Nothing)) (return ([2], Just 2)))
267
245
268o_n_space_mapping :: Int -> [Benchmark]
246o_n_space_mapping :: Int -> [Benchmark]
269o_n_space_mapping value =
247o_n_space_mapping value =
270 [ bgroup "mapping"
248 [ bgroup "mapping"
271 [ benchIO "naive prime sieve"
249 [ benchIO "naive prime sieve"
272− (\n -> S.sum $ sieveScan $ S.enumerateFromTo 2 (value + n))
250+ (\n -> Stream.fold FL.sum $ sieveScan $ Common.enumerateFromTo 2 (value + n))
273 ]
251 ]
274 ]
252 ]
275
253
@@ -280,64 +258,59 @@ o_n_space_mapping value =
280o_1_space_functor :: Int -> [Benchmark]
258o_1_space_functor :: Int -> [Benchmark]
281o_1_space_functor value =
259o_1_space_functor value =
282 [ bgroup "Functor"
260 [ bgroup "Functor"
283− [ benchIOSink value "fmap" (fmapN fromSerial 1)
261+ [ benchIOSink value "fmap" (mapN 1)
284− , benchIOSink value "fmap x 4" (fmapN fromSerial 4)
262+ , benchIOSink value "fmap x 4" (mapN 4)
285 ]
263 ]
286 ]
264 ]
287−#else
265+
288−{-# INLINE foldFilterEven #-}
289−foldFilterEven :: MonadIO m => SerialT m Int -> m ()
290−foldFilterEven = Stream.fold FL.drain . Stream.foldFilter (FL.satisfy even)
291−#endif
292-------------------------------------------------------------------------------
266-------------------------------------------------------------------------------
293-- Size reducing transformations (filtering)
267-- Size reducing transformations (filtering)
294-------------------------------------------------------------------------------
268-------------------------------------------------------------------------------
295
269
296{-# INLINE filterEven #-}
270{-# INLINE filterEven #-}
297filterEven :: MonadIO m => Int -> SerialT m Int -> m ()
271filterEven :: MonadIO m => Int -> SerialT m Int -> m ()
298−filterEven n = composeNG n $ S.filter even
272+filterEven n = composeN n $ Stream.filter even
299
273
300{-# INLINE filterAllOut #-}
274{-# INLINE filterAllOut #-}
301filterAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
275filterAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
302−filterAllOut value n = composeNG n $ S.filter (> (value + 1))
276+filterAllOut value n = composeN n $ Stream.filter (> (value + 1))
303
277
304{-# INLINE filterAllIn #-}
278{-# INLINE filterAllIn #-}
305filterAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
279filterAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
306−filterAllIn value n = composeNG n $ S.filter (<= (value + 1))
280+filterAllIn value n = composeN n $ Stream.filter (<= (value + 1))
307
281
308{-# INLINE filterMEven #-}
282{-# INLINE filterMEven #-}
309filterMEven :: MonadIO m => Int -> SerialT m Int -> m ()
283filterMEven :: MonadIO m => Int -> SerialT m Int -> m ()
310−filterMEven n = composeNG n $ S.filterM (return . even)
284+filterMEven n = composeN n $ Stream.filterM (return . even)
311
285
312{-# INLINE filterMAllOut #-}
286{-# INLINE filterMAllOut #-}
313filterMAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
287filterMAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
314−filterMAllOut value n = composeNG n $ S.filterM (\x -> return $ x > (value + 1))
288+filterMAllOut value n = composeN n $ Stream.filterM (\x -> return $ x > (value + 1))
315
289
316{-# INLINE filterMAllIn #-}
290{-# INLINE filterMAllIn #-}
317filterMAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
291filterMAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
318−filterMAllIn value n = composeNG n $ S.filterM (\x -> return $ x <= (value + 1))
292+filterMAllIn value n = composeN n $ Stream.filterM (\x -> return $ x <= (value + 1))
319
293
320{-# INLINE _takeOne #-}
294{-# INLINE _takeOne #-}
321_takeOne :: MonadIO m => Int -> SerialT m Int -> m ()
295_takeOne :: MonadIO m => Int -> SerialT m Int -> m ()
322−_takeOne n = composeNG n $ S.take 1
296+_takeOne n = composeN n $ Stream.take 1
323
297
324{-# INLINE takeAll #-}
298{-# INLINE takeAll #-}
325takeAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
299takeAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
326−takeAll value n = composeNG n $ S.take (value + 1)
300+takeAll value n = composeN n $ Stream.take (value + 1)
327
301
328{-# INLINE takeWhileTrue #-}
302{-# INLINE takeWhileTrue #-}
329takeWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
303takeWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
330−takeWhileTrue value n = composeNG n $ S.takeWhile (<= (value + 1))
304+takeWhileTrue value n = composeN n $ Stream.takeWhile (<= (value + 1))
331
305
332{-# INLINE takeWhileMTrue #-}
306{-# INLINE takeWhileMTrue #-}
333takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
307takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
334−takeWhileMTrue value n = composeNG n $ S.takeWhileM (return . (<= (value + 1)))
308+takeWhileMTrue value n = composeN n $ Stream.takeWhileM (return . (<= (value + 1)))
335
309
336#ifdef USE_PRELUDE
310#ifdef USE_PRELUDE
337{-# INLINE takeInterval #-}
311{-# INLINE takeInterval #-}
338takeInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
312takeInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
339−takeInterval i n = composeN n (Internal.takeInterval i)
313+takeInterval i n = composeN n (Stream.takeInterval i)
340−
341
314
342#ifdef INSPECTION
315#ifdef INSPECTION
343-- inspect $ hasNoType 'takeInterval ''SPEC
316-- inspect $ hasNoType 'takeInterval ''SPEC
@@ -348,33 +321,33 @@ inspect $ hasNoTypeClasses 'takeInterval
348
321
349{-# INLINE dropOne #-}
322{-# INLINE dropOne #-}
350dropOne :: MonadIO m => Int -> SerialT m Int -> m ()
323dropOne :: MonadIO m => Int -> SerialT m Int -> m ()
351−dropOne n = composeNG n $ S.drop 1
324+dropOne n = composeN n $ Stream.drop 1
352
325
353{-# INLINE dropAll #-}
326{-# INLINE dropAll #-}
354dropAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
327dropAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
355−dropAll value n = composeNG n $ S.drop (value + 1)
328+dropAll value n = composeN n $ Stream.drop (value + 1)
356
329
357{-# INLINE dropWhileTrue #-}
330{-# INLINE dropWhileTrue #-}
358dropWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
331dropWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
359−dropWhileTrue value n = composeNG n $ S.dropWhile (<= (value + 1))
332+dropWhileTrue value n = composeN n $ Stream.dropWhile (<= (value + 1))
360
333
361{-# INLINE dropWhileMTrue #-}
334{-# INLINE dropWhileMTrue #-}
362dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
335dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
363−dropWhileMTrue value n = composeNG n $ S.dropWhileM (return . (<= (value + 1)))
336+dropWhileMTrue value n = composeN n $ Stream.dropWhileM (return . (<= (value + 1)))
364
337
365{-# INLINE dropWhileFalse #-}
338{-# INLINE dropWhileFalse #-}
366dropWhileFalse :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
339dropWhileFalse :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
367−dropWhileFalse value n = composeNG n $ S.dropWhile (> (value + 1))
340+dropWhileFalse value n = composeN n $ Stream.dropWhile (> (value + 1))
368
341
369#ifdef USE_PRELUDE
342#ifdef USE_PRELUDE
370-- XXX Decide on the time interval
343-- XXX Decide on the time interval
371{-# INLINE _intervalsOfSum #-}
344{-# INLINE _intervalsOfSum #-}
372_intervalsOfSum :: MonadAsync m => Double -> Int -> SerialT m Int -> m ()
345_intervalsOfSum :: MonadAsync m => Double -> Int -> SerialT m Int -> m ()
373−_intervalsOfSum i n = composeN n (S.intervalsOf i FL.sum)
346+_intervalsOfSum i n = composeN n (Stream.intervalsOf i FL.sum)
374
347
375{-# INLINE dropInterval #-}
348{-# INLINE dropInterval #-}
376dropInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
349dropInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
377−dropInterval i n = composeN n (Internal.dropInterval i)
350+dropInterval i n = composeN n (Stream.dropInterval i)
378
351
379#ifdef INSPECTION
352#ifdef INSPECTION
380inspect $ hasNoTypeClasses 'dropInterval
353inspect $ hasNoTypeClasses 'dropInterval
@@ -384,42 +357,40 @@ inspect $ hasNoTypeClasses 'dropInterval
384
357
385{-# INLINE findIndices #-}
358{-# INLINE findIndices #-}
386findIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
359findIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
387−findIndices value n = composeNG n $ S.findIndices (== (value + 1))
360+findIndices value n = composeN n $ Stream.findIndices (== (value + 1))
388
361
389{-# INLINE elemIndices #-}
362{-# INLINE elemIndices #-}
390elemIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
363elemIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
391−elemIndices value n = composeNG n $ S.elemIndices (value + 1)
364+elemIndices value n = composeN n $ Stream.elemIndices (value + 1)
392
365
393{-# INLINE deleteBy #-}
366{-# INLINE deleteBy #-}
394deleteBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
367deleteBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
395−deleteBy value n = composeNG n $ S.deleteBy (>=) (value + 1)
368+deleteBy value n = composeN n $ Stream.deleteBy (>=) (value + 1)
396
369
397-- uniq . uniq == uniq, composeN 2 ~ composeN 1
370-- uniq . uniq == uniq, composeN 2 ~ composeN 1
398{-# INLINE uniq #-}
371{-# INLINE uniq #-}
399uniq :: MonadIO m => Int -> SerialT m Int -> m ()
372uniq :: MonadIO m => Int -> SerialT m Int -> m ()
400−uniq n = composeNG n S.uniq
373+uniq n = composeN n Stream.uniq
401
374
402−#ifdef USE_PRELUDE
403{-# INLINE mapMaybe #-}
375{-# INLINE mapMaybe #-}
404mapMaybe :: MonadIO m => Int -> SerialT m Int -> m ()
376mapMaybe :: MonadIO m => Int -> SerialT m Int -> m ()
405mapMaybe n =
377mapMaybe n =
406− composeNG n $
378+ composeN n $
407− S.mapMaybe
379+ Stream.mapMaybe
408 (\x ->
380 (\x ->
409 if odd x
381 if odd x
410 then Nothing
382 then Nothing
411 else Just x)
383 else Just x)
412
384
413{-# INLINE mapMaybeM #-}
385{-# INLINE mapMaybeM #-}
414−mapMaybeM :: S.MonadAsync m => Int -> SerialT m Int -> m ()
386+mapMaybeM :: MonadAsync m => Int -> SerialT m Int -> m ()
415mapMaybeM n =
387mapMaybeM n =
416− composeNG n $
388+ composeN n $
417− S.mapMaybeM
389+ Stream.mapMaybeM
418 (\x ->
390 (\x ->
419 if odd x
391 if odd x
420 then return Nothing
392 then return Nothing
421 else return $ Just x)
393 else return $ Just x)
422−#endif
423
394
424o_1_space_filtering :: Int -> [Benchmark]
395o_1_space_filtering :: Int -> [Benchmark]
425o_1_space_filtering value =
396o_1_space_filtering value =
@@ -431,9 +402,6 @@ o_1_space_filtering value =
431 , benchIOSink value "filterM-even" (filterMEven 1)
402 , benchIOSink value "filterM-even" (filterMEven 1)
432 , benchIOSink value "filterM-all-out" (filterMAllOut value 1)
403 , benchIOSink value "filterM-all-out" (filterMAllOut value 1)
433 , benchIOSink value "filterM-all-in" (filterMAllIn value 1)
404 , benchIOSink value "filterM-all-in" (filterMAllIn value 1)
434−#ifndef USE_PRELUDE
435− , benchIOSink value "foldFilter-even" foldFilterEven
436−#endif
437
405
438 -- Trimming
406 -- Trimming
439 , benchIOSink value "take-all" (takeAll value 1)
407 , benchIOSink value "take-all" (takeAll value 1)
@@ -460,18 +428,17 @@ o_1_space_filtering value =
460 , benchIOSink value "deleteBy" (deleteBy value 1)
428 , benchIOSink value "deleteBy" (deleteBy value 1)
461
429
462 , benchIOSink value "uniq" (uniq 1)
430 , benchIOSink value "uniq" (uniq 1)
463−#ifdef USE_PRELUDE
431+
464 -- Map and filter
432 -- Map and filter
465 , benchIOSink value "mapMaybe" (mapMaybe 1)
433 , benchIOSink value "mapMaybe" (mapMaybe 1)
466 , benchIOSink value "mapMaybeM" (mapMaybeM 1)
434 , benchIOSink value "mapMaybeM" (mapMaybeM 1)
467−#endif
435+
468 -- Searching (stateful map and filter)
436 -- Searching (stateful map and filter)
469 , benchIOSink value "findIndices" (findIndices value 1)
437 , benchIOSink value "findIndices" (findIndices value 1)
470 , benchIOSink value "elemIndices" (elemIndices value 1)
438 , benchIOSink value "elemIndices" (elemIndices value 1)
471 ]
439 ]
472 ]
440 ]
473
441
474−
475o_1_space_filteringX4 :: Int -> [Benchmark]
442o_1_space_filteringX4 :: Int -> [Benchmark]
476o_1_space_filteringX4 value =
443o_1_space_filteringX4 value =
477 [ bgroup "filteringX4"
444 [ bgroup "filteringX4"
@@ -483,8 +450,6 @@ o_1_space_filteringX4 value =
483 , benchIOSink value "filterM-all-out" (filterMAllOut value 4)
450 , benchIOSink value "filterM-all-out" (filterMAllOut value 4)
484 , benchIOSink value "filterM-all-in" (filterMAllIn value 4)
451 , benchIOSink value "filterM-all-in" (filterMAllIn value 4)
485
452
486− --, benchIOSink value "foldFilter-even" (foldFilterEven 4)
487−
488 -- trimming
453 -- trimming
489 , benchIOSink value "take-all" (takeAll value 4)
454 , benchIOSink value "take-all" (takeAll value 4)
490 , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)
455 , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)
@@ -501,11 +466,10 @@ o_1_space_filteringX4 value =
501
466
502 , benchIOSink value "uniq" (uniq 4)
467 , benchIOSink value "uniq" (uniq 4)
503
468
504−#ifdef USE_PRELUDE
505 -- map and filter
469 -- map and filter
506 , benchIOSink value "mapMaybe" (mapMaybe 4)
470 , benchIOSink value "mapMaybe" (mapMaybe 4)
507 , benchIOSink value "mapMaybeM" (mapMaybeM 4)
471 , benchIOSink value "mapMaybeM" (mapMaybeM 4)
508−#endif
472+
509 -- searching
473 -- searching
510 , benchIOSink value "findIndices" (findIndices value 4)
474 , benchIOSink value "findIndices" (findIndices value 4)
511 , benchIOSink value "elemIndices" (elemIndices value 4)
475 , benchIOSink value "elemIndices" (elemIndices value 4)
@@ -515,29 +479,28 @@ o_1_space_filteringX4 value =
515-------------------------------------------------------------------------------
479-------------------------------------------------------------------------------
516-- Size increasing transformations (insertions)
480-- Size increasing transformations (insertions)
517-------------------------------------------------------------------------------
481-------------------------------------------------------------------------------
518−#ifdef USE_PRELUDE
482+
519{-# INLINE intersperse #-}
483{-# INLINE intersperse #-}
520−intersperse :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
484+intersperse :: MonadAsync m => Int -> Int -> SerialT m Int -> m ()
521−intersperse value n = composeNG n $ S.intersperse (value + 1)
485+intersperse value n = composeN n $ Stream.intersperse (value + 1)
522
486
523{-# INLINE intersperseM #-}
487{-# INLINE intersperseM #-}
524−intersperseM :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
488+intersperseM :: MonadAsync m => Int -> Int -> SerialT m Int -> m ()
525−intersperseM value n = composeNG n $ S.intersperseM (return $ value + 1)
489+intersperseM value n = composeN n $ Stream.intersperseM (return $ value + 1)
490+
491+{-# INLINE insertBy #-}
492+insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
493+insertBy value n = composeN n $ Stream.insertBy compare (value + 1)
526
494
527{-# INLINE interposeSuffix #-}
495{-# INLINE interposeSuffix #-}
528−interposeSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
496+interposeSuffix :: Monad m => Int -> Int -> SerialT m Int -> m ()
529interposeSuffix value n =
497interposeSuffix value n =
530− composeNG n $ Internal.interposeSuffix (value + 1) Unfold.identity
498+ composeN n $ Stream.interposeSuffix (value + 1) Unfold.identity
531
499
532{-# INLINE intercalateSuffix #-}
500{-# INLINE intercalateSuffix #-}
533−intercalateSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
501+intercalateSuffix :: Monad m => Int -> Int -> SerialT m Int -> m ()
534intercalateSuffix value n =
502intercalateSuffix value n =
535− composeNG n $ Internal.intercalateSuffix Unfold.identity (value + 1)
503+ composeN n $ Stream.intercalateSuffix Unfold.identity (value + 1)
536−
537−{-# INLINE insertBy #-}
538−insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
539−insertBy value n = composeNG n $ S.insertBy compare (value + 1)
540−
541
504
542o_1_space_inserting :: Int -> [Benchmark]
505o_1_space_inserting :: Int -> [Benchmark]
543o_1_space_inserting value =
506o_1_space_inserting value =
@@ -554,21 +517,21 @@ o_1_space_insertingX4 :: Int -> [Benchmark]
554o_1_space_insertingX4 value =
517o_1_space_insertingX4 value =
555 [ bgroup "insertingX4"
518 [ bgroup "insertingX4"
556 [ benchIOSink value "intersperse" (intersperse value 4)
519 [ benchIOSink value "intersperse" (intersperse value 4)
557− -- , benchIOSink value "insertBy" (insertBy value 4)
520+ , benchIOSink value "insertBy" (insertBy value 4)
558 ]
521 ]
559 ]
522 ]
560−#endif
523+
561-------------------------------------------------------------------------------
524-------------------------------------------------------------------------------
562-- Indexing
525-- Indexing
563-------------------------------------------------------------------------------
526-------------------------------------------------------------------------------
564−#ifdef USE_PRELUDE
527+
565{-# INLINE indexed #-}
528{-# INLINE indexed #-}
566indexed :: MonadIO m => Int -> SerialT m Int -> m ()
529indexed :: MonadIO m => Int -> SerialT m Int -> m ()
567−indexed n = composeN n (S.map snd . S.indexed)
530+indexed n = composeN n (fmap snd . Stream.indexed)
568
531
569{-# INLINE indexedR #-}
532{-# INLINE indexedR #-}
570indexedR :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
533indexedR :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
571−indexedR value n = composeN n (S.map snd . S.indexedR value)
534+indexedR value n = composeN n (fmap snd . Stream.indexedR value)
572
535
573o_1_space_indexing :: Int -> [Benchmark]
536o_1_space_indexing :: Int -> [Benchmark]
574o_1_space_indexing value =
537o_1_space_indexing value =
@@ -586,24 +549,6 @@ o_1_space_indexingX4 value =
586 ]
549 ]
587 ]
550 ]
588
551
589−#else
590−{-# INLINE indexed #-}
591−indexed :: MonadIO m => SerialT m Int -> m ()
592−indexed = Stream.fold FL.drain . Prelude.fmap snd . Stream.indexed
593−
594−{-# INLINE indexedR #-}
595−indexedR :: MonadIO m => Int -> SerialT m Int -> m ()
596−indexedR value = Stream.fold FL.drain . (Prelude.fmap snd . Stream.indexedR value)
597−
598−o_1_space_indexing :: Int -> [Benchmark]
599−o_1_space_indexing value =
600− [ bgroup "indexing"
601− [ benchIOSink value "indexed" indexed
602− , benchIOSink value "indexedR" (indexedR value)
603− ]
604− ]
605−#endif
606−
607-------------------------------------------------------------------------------
552-------------------------------------------------------------------------------
608-- Main
553-- Main
609-------------------------------------------------------------------------------
554-------------------------------------------------------------------------------
@@ -614,23 +559,18 @@ o_1_space_indexing value =
614benchmarks :: String -> Int -> [Benchmark]
559benchmarks :: String -> Int -> [Benchmark]
615benchmarks moduleName size =
560benchmarks moduleName size =
616 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
561 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
562+ [ o_1_space_functor size
617− [ o_1_space_mapping size
563+ , o_1_space_mapping size
618− , o_1_space_indexing size
564+ , o_1_space_mappingX4 size
619 , o_1_space_filtering size
565 , o_1_space_filtering size
620 , o_1_space_filteringX4 size
566 , o_1_space_filteringX4 size
621−#ifdef USE_PRELUDE
622− , o_1_space_functor size
623− , o_1_space_mappingX4 size
624 , o_1_space_inserting size
567 , o_1_space_inserting size
625 , o_1_space_insertingX4 size
568 , o_1_space_insertingX4 size
569+ , o_1_space_indexing size
626 , o_1_space_indexingX4 size
570 , o_1_space_indexingX4 size
627−#endif
628 ]
571 ]
629−
630− , bgroup (o_n_space_prefix moduleName) $
572+ , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
631−#ifdef USE_PRELUDE
573+ [ o_n_space_traversable size
632− o_n_space_mapping size
574+ , o_n_space_mapping size
633−#else
575+ ]
634− o_n_space_traversable size
635−#endif
636 ]
576 ]
benchmark/streamly-benchmarks.cabal+29−32
@@ -65,9 +65,10 @@ flag bench-core
65 default: False
65 default: False
66
66
67flag use-prelude
67flag use-prelude
68− description: Use Streamly.Prelude instead of Streamly.Data.Stream for serial benchmarks
68+ description: Use Prelude instead of Data.Stream for serial benchmarks
69 manual: True
69 manual: True
70 default: False
70 default: False
71+
71-------------------------------------------------------------------------------
72-------------------------------------------------------------------------------
72-- Common stanzas
73-- Common stanzas
73-------------------------------------------------------------------------------
74-------------------------------------------------------------------------------
@@ -208,6 +209,33 @@ common bench-options-threaded
208-- Serial Streams
209-- Serial Streams
209-------------------------------------------------------------------------------
210-------------------------------------------------------------------------------
210
211
212+benchmark Data.Stream
213+ import: bench-options
214+ type: exitcode-stdio-1.0
215+ hs-source-dirs: Streamly/Benchmark/Data
216+ main-is: Stream.hs
217+ other-modules:
218+ Stream.Generate
219+ Stream.Eliminate
220+ Stream.Transform
221+ Stream.Reduce
222+ Stream.Expand
223+ Stream.Exceptions
224+ Stream.Lift
225+ Stream.Common
226+ if flag(use-prelude)
227+ other-modules:
228+ Stream.Split
229+ if flag(bench-core) || impl(ghcjs)
230+ buildable: False
231+ else
232+ buildable: True
233+ if flag(limit-build-mem)
234+ if flag(dev)
235+ ghc-options: +RTS -M3500M -RTS
236+ else
237+ ghc-options: +RTS -M2500M -RTS
238+
211benchmark Prelude.WSerial
239benchmark Prelude.WSerial
212 import: bench-options
240 import: bench-options
213 type: exitcode-stdio-1.0
241 type: exitcode-stdio-1.0
@@ -387,37 +415,6 @@ benchmark Data.Parser
387-------------------------------------------------------------------------------
415-------------------------------------------------------------------------------
388-- Raw Streams
416-- Raw Streams
389-------------------------------------------------------------------------------
417-------------------------------------------------------------------------------
390−benchmark Data.Stream
391− import: bench-options
392− type: exitcode-stdio-1.0
393− hs-source-dirs: Streamly/Benchmark/Data
394− main-is: Stream.hs
395− other-modules:
396− Stream.Eliminate
397− Stream.Exceptions
398− Stream.Generate
399− Stream.Lift
400− Stream.Transformation
401− if flag(use-prelude)
402− other-modules:
403− Stream.NestedFold
404− Stream.NestedStream
405− Stream.Split
406− else
407− other-modules:
408− Stream.Common
409− Stream.Reduce
410−
411− if flag(bench-core) || impl(ghcjs)
412− buildable: False
413− else
414− buildable: True
415− build-depends: exceptions >= 0.8 && < 0.11
416− if flag(limit-build-mem)
417− if flag(dev)
418− ghc-options: +RTS -M3500M -RTS
419− else
420− ghc-options: +RTS -M2000M -RTS
421
418
422benchmark Data.Stream.StreamD
419benchmark Data.Stream.StreamD
423 import: bench-options
420 import: bench-options
hie.yaml+9−1
@@ -30,7 +30,15 @@ cradle:
30 component: "bench:Data.Stream.StreamD"
30 component: "bench:Data.Stream.StreamD"
31 - path: "./benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs"
31 - path: "./benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs"
32 component: "bench:Data.Stream.StreamK"
32 component: "bench:Data.Stream.StreamK"
33− - path: "./benchmark/Streamly/Benchmark/Data/Stream/*.hs"
33+ - path: "./benchmark/Streamly/Benchmark/Data/Stream/Common.hs"
34+ component: "bench:Data.Stream"
35+ - path: "./benchmark/Streamly/Benchmark/Data/Stream/Expand.hs"
36+ component: "bench:Data.Stream"
37+ - path: "./benchmark/Streamly/Benchmark/Data/Stream/Generate.hs"
38+ component: "bench:Data.Stream"
39+ - path: "./benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs"
40+ component: "bench:Data.Stream"
41+ - path: "./benchmark/Streamly/Benchmark/Data/Stream/Transform.hs"
34 component: "bench:Data.Stream"
42 component: "bench:Data.Stream"
35 - path: "./benchmark/Streamly/Benchmark/Data/Unfold.hs"
43 - path: "./benchmark/Streamly/Benchmark/Data/Unfold.hs"
36 component: "bench:Data.Unfold"
44 component: "bench:Data.Unfold"