git.iko.soy/streamly
on master help sign in
Elaborate concatMap, async benchmarks
c0bd11dHarendra Kumar
benchmark/Streamly/Benchmark/Data/Stream/StreamD.hs+96−18
compare with master
unifiedsplit
@@ -5,9 +5,19 @@
5-- License : BSD3
5-- License : BSD3
6-- Maintainer : streamly@composewell.com
6-- Maintainer : streamly@composewell.com
7
7
8+{-# LANGUAGE CPP #-}
8{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
10
11
12+#ifdef __HADDOCK_VERSION__
13+#undef INSPECTION
14+#endif
15+
16+#ifdef INSPECTION
17+{-# LANGUAGE TemplateHaskell #-}
18+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19+#endif
20+
11module Main (main) where
21module Main (main) where
12
22
13import Control.Monad (when)
23import Control.Monad (when)
@@ -22,6 +32,11 @@ import qualified Streamly.Internal.Data.Unfold as UF
22
32
23import Streamly.Benchmark.Common
33import Streamly.Benchmark.Common
24
34
35+#ifdef INSPECTION
36+import GHC.Types (SPEC(..))
37+import Test.Inspection
38+#endif
39+
25-- We try to keep the total number of iterations same irrespective of nesting
40-- We try to keep the total number of iterations same irrespective of nesting
26-- of the loops so that the overhead is easy to compare.
41-- of the loops so that the overhead is easy to compare.
27value, value2, value3, value16, maxValue :: Int
42value, value2, value3, value16, maxValue :: Int
@@ -174,12 +189,11 @@ composeN n f =
174{-# INLINE dropWhileFalse #-}
189{-# INLINE dropWhileFalse #-}
175{-# INLINE _foldrS #-}
190{-# INLINE _foldrS #-}
176{-# INLINE _foldlS #-}
191{-# INLINE _foldlS #-}
177−{-# INLINE concatMap #-}
178{-# INLINE intersperse #-}
192{-# INLINE intersperse #-}
179scan, map, fmapD, mapM, mapMaybe, mapMaybeM, filterEven, filterAllOut,
193scan, map, fmapD, mapM, mapMaybe, mapMaybeM, filterEven, filterAllOut,
180 filterAllIn, _takeOne, takeAll, takeWhileTrue, _takeWhileMTrue, dropOne,
194 filterAllIn, _takeOne, takeAll, takeWhileTrue, _takeWhileMTrue, dropOne,
181 dropAll, dropWhileTrue, _dropWhileMTrue, dropWhileFalse, _foldrS, _foldlS,
195 dropAll, dropWhileTrue, _dropWhileMTrue, dropWhileFalse, _foldrS, _foldlS,
182− concatMap, intersperse
196+ intersperse
183 :: Monad m
197 :: Monad m
184 => Int -> Stream m Int -> m ()
198 => Int -> Stream m Int -> m ()
185
199
@@ -205,7 +219,6 @@ _dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))
205dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)
219dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)
206_foldrS n = composeN n $ S.foldrS S.cons S.nil
220_foldrS n = composeN n $ S.foldrS S.cons S.nil
207_foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
221_foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
208−concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)
209intersperse n = composeN n $ S.intersperse maxValue
222intersperse n = composeN n $ S.intersperse maxValue
210
223
211-------------------------------------------------------------------------------
224-------------------------------------------------------------------------------
@@ -253,7 +266,7 @@ iterateM :: Monad m => Int -> Stream m Int
253iterateM i = S.take maxIters (S.iterateM (\x -> return (x + 1)) (return i))
266iterateM i = S.take maxIters (S.iterateM (\x -> return (x + 1)) (return i))
254
267
255-------------------------------------------------------------------------------
268-------------------------------------------------------------------------------
256−-- Zipping and concat
269+-- Zipping
257-------------------------------------------------------------------------------
270-------------------------------------------------------------------------------
258
271
259{-# INLINE eqBy #-}
272{-# INLINE eqBy #-}
@@ -268,14 +281,6 @@ cmpBy src = S.cmpBy P.compare src src
268zip :: Monad m => Stream m Int -> m ()
281zip :: Monad m => Stream m Int -> m ()
269zip src = transform $ S.zipWith (,) src src
282zip src = transform $ S.zipWith (,) src src
270
283
271−{-# INLINE concatMapRepl4xN #-}
272−concatMapRepl4xN :: Monad m => Stream m Int -> m ()
273−concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)
274−
275−{-# INLINE concatMapURepl4xN #-}
276−concatMapURepl4xN :: Monad m => Stream m Int -> m ()
277−concatMapURepl4xN src = transform $ S.concatMapU (UF.replicateM 4) src
278−
279-------------------------------------------------------------------------------
284-------------------------------------------------------------------------------
280-- Mixed Composition
285-- Mixed Composition
281-------------------------------------------------------------------------------
286-------------------------------------------------------------------------------
@@ -353,6 +358,63 @@ filterAllInNested str = runStream $ do
353 then return s
358 then return s
354 else S.nil
359 else S.nil
355
360
361+-------------------------------------------------------------------------------
362+-- ConcatMap
363+-------------------------------------------------------------------------------
364+
365+-- concatMap unfoldrM/unfoldrM
366+
367+{-# INLINE concatMap #-}
368+concatMap :: Int -> Int -> Int -> IO ()
369+concatMap outer inner n =
370+ S.drain $ S.concatMap
371+ (\_ -> sourceUnfoldrMN inner n)
372+ (sourceUnfoldrMN outer n)
373+
374+#ifdef INSPECTION
375+inspect $ hasNoTypeClasses 'concatMap
376+inspect $ 'concatMap `hasNoType` ''SPEC
377+#endif
378+
379+-- concatMap unfoldr/unfoldr
380+
381+{-# INLINE concatMapPure #-}
382+concatMapPure :: Int -> Int -> Int -> IO ()
383+concatMapPure outer inner n =
384+ S.drain $ S.concatMap
385+ (\_ -> sourceUnfoldrN inner n)
386+ (sourceUnfoldrN outer n)
387+
388+#ifdef INSPECTION
389+inspect $ hasNoTypeClasses 'concatMapPure
390+inspect $ 'concatMapPure `hasNoType` ''SPEC
391+#endif
392+
393+-- concatMap replicate/unfoldrM
394+
395+{-# INLINE concatMapRepl #-}
396+concatMapRepl :: Int -> Int -> Int -> IO ()
397+concatMapRepl outer inner n =
398+ S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrMN outer n)
399+
400+#ifdef INSPECTION
401+inspect $ hasNoTypeClasses 'concatMapRepl
402+inspect $ 'concatMapRepl `hasNoType` ''SPEC
403+#endif
404+
405+-- concatUnfold replicate/unfoldrM
406+
407+{-# INLINE concatUnfoldRepl #-}
408+concatUnfoldRepl :: Int -> Int -> Int -> IO ()
409+concatUnfoldRepl outer inner n =
410+ S.drain $ S.concatMapU (UF.replicateM inner) (sourceUnfoldrMN outer n)
411+
412+#ifdef INSPECTION
413+inspect $ hasNoTypeClasses 'concatUnfoldRepl
414+inspect $ 'concatUnfoldRepl `hasNoType` ''S.ConcatMapUState
415+inspect $ 'concatUnfoldRepl `hasNoType` ''SPEC
416+#endif
417+
356-------------------------------------------------------------------------------
418-------------------------------------------------------------------------------
357-- Benchmarks
419-- Benchmarks
358-------------------------------------------------------------------------------
420-------------------------------------------------------------------------------
@@ -396,12 +458,6 @@ o_1_space =
396 , benchFold "mapM" (mapM 1) sourceUnfoldrM
458 , benchFold "mapM" (mapM 1) sourceUnfoldrM
397 , benchFold "mapMaybe" (mapMaybe 1) sourceUnfoldrM
459 , benchFold "mapMaybe" (mapMaybe 1) sourceUnfoldrM
398 , benchFold "mapMaybeM" (mapMaybeM 1) sourceUnfoldrM
460 , benchFold "mapMaybeM" (mapMaybeM 1) sourceUnfoldrM
399− , benchFold "concatMapNxN" (concatMap 1) (sourceUnfoldrMN value2)
400− , benchFold "concatMapRepl4xN" concatMapRepl4xN
401− (sourceUnfoldrMN (value `div` 4))
402− , benchFold "concatMapPureNxN" (concatMap 1) (sourceUnfoldrN value2)
403− , benchFold "concatMapURepl4xN" concatMapURepl4xN
404− (sourceUnfoldrMN (value `div` 4))
405 ]
461 ]
406 , bgroup "transformationX4"
462 , bgroup "transformationX4"
407 [ benchFold "scan" (scan 4) sourceUnfoldrM
463 [ benchFold "scan" (scan 4) sourceUnfoldrM
@@ -413,6 +469,28 @@ o_1_space =
413 -- XXX this is horribly slow
469 -- XXX this is horribly slow
414 -- , benchFold "concatMap" (concatMap 4) (sourceUnfoldrMN value16)
470 -- , benchFold "concatMap" (concatMap 4) (sourceUnfoldrMN value16)
415 ]
471 ]
472+
473+ , bgroup "concat"
474+ [ benchIOSrc1 "concatMapPure (n of 1)"
475+ (concatMapPure value 1)
476+ , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
477+ (concatMapPure value2 value2)
478+ , benchIOSrc1 "concatMapPure (1 of n)"
479+ (concatMapPure 1 value)
480+
481+ , benchIOSrc1 "concatMap (n of 1)"
482+ (concatMap value 1)
483+ , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
484+ (concatMap value2 value2)
485+ , benchIOSrc1 "concatMap (1 of n)"
486+ (concatMap 1 value)
487+
488+ -- concatMap vs concatUnfold
489+ , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
490+ (concatMapRepl value2 value2)
491+ , benchIOSrc1 "concatUnfoldRepl (sqrt n of sqrt n)"
492+ (concatUnfoldRepl value2 value2)
493+ ]
416 , bgroup "filtering"
494 , bgroup "filtering"
417 [ benchFold "filter-even" (filterEven 1) sourceUnfoldrM
495 [ benchFold "filter-even" (filterEven 1) sourceUnfoldrM
418 , benchFold "filter-all-out" (filterAllOut 1) sourceUnfoldrM
496 , benchFold "filter-all-out" (filterAllOut 1) sourceUnfoldrM
benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs+101−15
@@ -5,9 +5,19 @@
5-- License : BSD3
5-- License : BSD3
6-- Maintainer : streamly@composewell.com
6-- Maintainer : streamly@composewell.com
7
7
8+{-# LANGUAGE CPP #-}
8{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
10
11
12+#ifdef __HADDOCK_VERSION__
13+#undef INSPECTION
14+#endif
15+
16+#ifdef INSPECTION
17+{-# LANGUAGE TemplateHaskell #-}
18+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19+#endif
20+
11module Main (main) where
21module Main (main) where
12
22
13import Control.Monad (when)
23import Control.Monad (when)
@@ -27,6 +37,10 @@ import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)
27
37
28import Streamly.Benchmark.Common
38import Streamly.Benchmark.Common
29
39
40+#ifdef INSPECTION
41+import Test.Inspection
42+#endif
43+
30value, value2, value3, value16, maxValue :: Int
44value, value2, value3, value16, maxValue :: Int
31value = 100000
45value = 100000
32value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
46value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
@@ -190,10 +204,9 @@ composeN n f =
190{-# INLINE dropWhileFalse #-}
204{-# INLINE dropWhileFalse #-}
191{-# INLINE foldrS #-}
205{-# INLINE foldrS #-}
192{-# INLINE foldlS #-}
206{-# INLINE foldlS #-}
193−{-# INLINE concatMap #-}
194scan, map, fmapK, filterEven, filterAllOut,
207scan, map, fmapK, filterEven, filterAllOut,
195 filterAllIn, _takeOne, takeAll, takeWhileTrue, dropAll, dropOne,
208 filterAllIn, _takeOne, takeAll, takeWhileTrue, dropAll, dropOne,
196− dropWhileTrue, dropWhileFalse, foldrS, foldlS, concatMap
209+ dropWhileTrue, dropWhileFalse, foldrS, foldlS
197 :: Monad m
210 :: Monad m
198 => Int -> Stream m Int -> m ()
211 => Int -> Stream m Int -> m ()
199
212
@@ -220,9 +233,6 @@ dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
220dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
233dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
221foldrS n = composeN n $ S.foldrS S.cons S.nil
234foldrS n = composeN n $ S.foldrS S.cons S.nil
222foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
235foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
223−-- We use a (sqrt n) element stream as source and then concat the same stream
224−-- for each element to produce an n element stream.
225−concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)
226intersperse n = composeN n $ S.intersperse maxValue
236intersperse n = composeN n $ S.intersperse maxValue
227
237
228-------------------------------------------------------------------------------
238-------------------------------------------------------------------------------
@@ -266,15 +276,11 @@ iterateDropOne = iterateSource (S.drop 1) maxIters
266iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
276iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
267
277
268-------------------------------------------------------------------------------
278-------------------------------------------------------------------------------
269−-- Zipping and concat
279+-- Zipping
270-------------------------------------------------------------------------------
280-------------------------------------------------------------------------------
271
281
272zip src = transform $ S.zipWith (,) src src
282zip src = transform $ S.zipWith (,) src src
273
283
274−{-# INLINE concatMapRepl4xN #-}
275−concatMapRepl4xN :: Monad m => Stream m Int -> m ()
276−concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)
277−
278-------------------------------------------------------------------------------
284-------------------------------------------------------------------------------
279-- Mixed Composition
285-- Mixed Composition
280-------------------------------------------------------------------------------
286-------------------------------------------------------------------------------
@@ -304,6 +310,62 @@ filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
304filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
310filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
305filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
311filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
306
312
313+-------------------------------------------------------------------------------
314+-- ConcatMap
315+-------------------------------------------------------------------------------
316+
317+-- concatMap unfoldrM/unfoldrM
318+
319+{-# INLINE concatMap #-}
320+concatMap :: Int -> Int -> Int -> IO ()
321+concatMap outer inner n =
322+ S.drain $ S.concatMap
323+ (\_ -> sourceUnfoldrMN inner n)
324+ (sourceUnfoldrMN outer n)
325+
326+#ifdef INSPECTION
327+inspect $ hasNoTypeClasses 'concatMap
328+#endif
329+
330+-- concatMap unfoldr/unfoldr
331+
332+{-# INLINE concatMapPure #-}
333+concatMapPure :: Int -> Int -> Int -> IO ()
334+concatMapPure outer inner n =
335+ S.drain $ S.concatMap
336+ (\_ -> sourceUnfoldrN inner n)
337+ (sourceUnfoldrN outer n)
338+
339+#ifdef INSPECTION
340+inspect $ hasNoTypeClasses 'concatMapPure
341+#endif
342+
343+-- concatMap replicate/unfoldrM
344+
345+{-# INLINE concatMapRepl #-}
346+concatMapRepl :: Int -> Int -> Int -> IO ()
347+concatMapRepl outer inner n =
348+ S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrMN outer n)
349+
350+#ifdef INSPECTION
351+inspect $ hasNoTypeClasses 'concatMapRepl
352+#endif
353+
354+-- concatMapWith
355+
356+{-# INLINE sourceConcatMapId #-}
357+sourceConcatMapId :: Monad m
358+ => Int -> Int -> Stream m (Stream m Int)
359+sourceConcatMapId val n =
360+ S.fromFoldable $ fmap (S.yieldM . return) [n..n+val]
361+
362+{-# INLINE concatStreamsWith #-}
363+concatStreamsWith :: Int -> Int -> Int -> IO ()
364+concatStreamsWith outer inner n =
365+ S.drain $ S.concatMapBy S.serial
366+ (sourceUnfoldrMN inner)
367+ (sourceUnfoldrMN outer n)
368+
307-------------------------------------------------------------------------------
369-------------------------------------------------------------------------------
308-- Nested Composition
370-- Nested Composition
309-------------------------------------------------------------------------------
371-------------------------------------------------------------------------------
@@ -452,11 +514,6 @@ o_1_space =
452 , benchFold "fmap" (fmapK 1) sourceUnfoldrM
514 , benchFold "fmap" (fmapK 1) sourceUnfoldrM
453 , benchFold "mapM" (mapM 1) sourceUnfoldrM
515 , benchFold "mapM" (mapM 1) sourceUnfoldrM
454 , benchFold "mapMSerial" (mapMSerial 1) sourceUnfoldrM
516 , benchFold "mapMSerial" (mapMSerial 1) sourceUnfoldrM
455− -- , benchFoldSrcK "concatMap" concatMap
456− , benchFold "concatMapNxN" (concatMap 1) (sourceUnfoldrMN value2)
457− , benchFold "concatMapPureNxN" (concatMap 1) (sourceUnfoldrN value2)
458− , benchFold "concatMapRepl4xN" concatMapRepl4xN
459− (sourceUnfoldrMN (value `div` 4))
460 ]
517 ]
461 , bgroup "transformationX4"
518 , bgroup "transformationX4"
462 [ benchFold "scan" (scan 4) sourceUnfoldrM
519 [ benchFold "scan" (scan 4) sourceUnfoldrM
@@ -467,6 +524,35 @@ o_1_space =
467 -- XXX this is horribly slow
524 -- XXX this is horribly slow
468 -- , benchFold "concatMap" (concatMap 4) (sourceUnfoldrMN value16)
525 -- , benchFold "concatMap" (concatMap 4) (sourceUnfoldrMN value16)
469 ]
526 ]
527+ , bgroup "concat"
528+ [ benchIOSrc1 "concatMapPure (n of 1)"
529+ (concatMapPure value 1)
530+ , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
531+ (concatMapPure value2 value2)
532+ , benchIOSrc1 "concatMapPure (1 of n)"
533+ (concatMapPure 1 value)
534+
535+ , benchIOSrc1 "concatMap (n of 1)"
536+ (concatMap value 1)
537+ , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
538+ (concatMap value2 value2)
539+ , benchIOSrc1 "concatMap (1 of n)"
540+ (concatMap 1 value)
541+
542+ , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
543+ (concatMapRepl value2 value2)
544+
545+ -- This is for comparison with foldMapWith
546+ , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
547+ (S.drain . S.concatMapBy S.serial id . sourceConcatMapId value)
548+
549+ , benchIOSrc1 "concatMapWith (n of 1)"
550+ (concatStreamsWith value 1)
551+ , benchIOSrc1 "concatMapWith (sqrt n of sqrt n)"
552+ (concatStreamsWith value2 value2)
553+ , benchIOSrc1 "concatMapWith (1 of n)"
554+ (concatStreamsWith 1 value)
555+ ]
470 , bgroup "filtering"
556 , bgroup "filtering"
471 [ benchFold "filter-even" (filterEven 1) sourceUnfoldrM
557 [ benchFold "filter-even" (filterEven 1) sourceUnfoldrM
472 , benchFold "filter-all-out" (filterAllOut 1) sourceUnfoldrM
558 , benchFold "filter-all-out" (filterAllOut 1) sourceUnfoldrM
benchmark/Streamly/Benchmark/Prelude/Ahead.hs+23−14
@@ -7,7 +7,8 @@
7
7
8import Prelude hiding (mapM)
8import Prelude hiding (mapM)
9
9
10−import Streamly (aheadly, ahead, maxBuffer, maxThreads)
10+import Streamly (aheadly, serially, ahead, maxBuffer, maxThreads)
11+import qualified Streamly.Prelude as S
11
12
12import Streamly.Benchmark.Common
13import Streamly.Benchmark.Common
13import Streamly.Benchmark.Prelude
14import Streamly.Benchmark.Prelude
@@ -28,12 +29,12 @@ o_1_space_generation value =
28 [ bgroup "generation"
29 [ bgroup "generation"
29 [ benchIOSrc aheadly "unfoldr" (sourceUnfoldr value)
30 [ benchIOSrc aheadly "unfoldr" (sourceUnfoldr value)
30 , benchIOSrc aheadly "unfoldrM" (sourceUnfoldrM value)
31 , benchIOSrc aheadly "unfoldrM" (sourceUnfoldrM value)
31− -- , benchIOSrc aheadly "fromFoldable" (sourceFromFoldable value)
32+ , benchIOSrc aheadly "fromFoldable" (sourceFromFoldable value)
32 , benchIOSrc aheadly "fromFoldableM" (sourceFromFoldableM value)
33 , benchIOSrc aheadly "fromFoldableM" (sourceFromFoldableM value)
33 , benchIOSrc aheadly "unfoldrM maxThreads 1"
34 , benchIOSrc aheadly "unfoldrM maxThreads 1"
34 (maxThreads 1 . sourceUnfoldrM value)
35 (maxThreads 1 . sourceUnfoldrM value)
35 , benchIOSrc aheadly "unfoldrM maxBuffer 1 (x/10 ops)"
36 , benchIOSrc aheadly "unfoldrM maxBuffer 1 (x/10 ops)"
36− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
37+ (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
37 ]
38 ]
38 ]
39 ]
39
40
@@ -42,7 +43,7 @@ o_1_space_mapping value =
42 [ bgroup "mapping"
43 [ bgroup "mapping"
43 [ benchIOSink value "map" $ mapN aheadly 1
44 [ benchIOSink value "map" $ mapN aheadly 1
44 , benchIOSink value "fmap" $ fmapN aheadly 1
45 , benchIOSink value "fmap" $ fmapN aheadly 1
45− , benchIOSink value "mapM" $ mapM aheadly 1
46+ , benchIOSink value "mapM" $ mapM aheadly 1 . serially
46 ]
47 ]
47 ]
48 ]
48
49
@@ -50,9 +51,13 @@ o_1_space_concatFoldable :: Int -> [Benchmark]
50o_1_space_concatFoldable value =
51o_1_space_concatFoldable value =
51 [ bgroup
52 [ bgroup
52 "concat-foldable"
53 "concat-foldable"
53− [ benchIOSrc aheadly "foldMapWith" (sourceFoldMapWith value)
54+ [ benchIOSrc aheadly "foldMapWith (<>) (List)"
55+ (sourceFoldMapWith value)
56+ , benchIOSrc aheadly "foldMapWith (<>) (Stream)"
57+ (sourceFoldMapWithStream value)
58+ , benchIOSrc aheadly "foldMapWithM (<>) (List)"
54− , benchIOSrc aheadly "foldMapWithM" (sourceFoldMapWithM value)
59+ (sourceFoldMapWithM value)
55− , benchIOSrc aheadly "foldMapM" (sourceFoldMapM value)
60+ , benchIOSrc aheadly "foldMapM (List)" (sourceFoldMapM value)
56 ]
61 ]
57 ]
62 ]
58
63
@@ -60,13 +65,17 @@ o_1_space_concatMap :: Int -> [Benchmark]
60o_1_space_concatMap value =
65o_1_space_concatMap value =
61 value2 `seq`
66 value2 `seq`
62 [ bgroup "concat"
67 [ bgroup "concat"
63− [ benchIO "concatMapWith (2,x/2)"
68+ -- This is for comparison with foldMapWith
64− (concatStreamsWith ahead 2 (value `div` 2))
69+ [ benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
70+ (S.concatMapWith ahead id . sourceConcatMapId value)
71+
65− , benchIO "concatMapWith (sqrt x,sqrt x)"
72+ , benchIO "concatMapWith (n of 1)"
66− (concatStreamsWith ahead value2 value2)
73+ (concatStreamsWith ahead value 1)
67− , benchIO "concatMapWith (sqrt x * 2,sqrt x / 2)"
74+ , benchIO "concatMapWith (sqrt x of sqrt x)"
68− (concatStreamsWith ahead (value2 * 2) (value2 `div` 2))
75+ (concatStreamsWith ahead value2 value2)
76+ , benchIO "concatMapWith (1 of n)"
77+ (concatStreamsWith ahead 1 value)
69− ]
78+ ]
70 ]
79 ]
71
80
72 where
81 where
benchmark/Streamly/Benchmark/Prelude/Async.hs+87−14
@@ -7,7 +7,9 @@
7
7
8import Prelude hiding (mapM)
8import Prelude hiding (mapM)
9
9
10−import Streamly (asyncly, async, maxBuffer, maxThreads)
10+import Streamly (asyncly, async, maxBuffer, maxThreads, serially)
11+import qualified Streamly.Prelude as S
12+import qualified Streamly.Internal.Prelude as Internal
11
13
12import Streamly.Benchmark.Common
14import Streamly.Benchmark.Common
13import Streamly.Benchmark.Prelude
15import Streamly.Benchmark.Prelude
@@ -23,15 +25,17 @@ moduleName = "Prelude.Async"
23
25
24o_1_space_generation :: Int -> [Benchmark]
26o_1_space_generation :: Int -> [Benchmark]
25o_1_space_generation value =
27o_1_space_generation value =
28+ -- These basically test the performance of consMAsync
26 [ bgroup "generation"
29 [ bgroup "generation"
27 [ benchIOSrc asyncly "unfoldr" (sourceUnfoldr value)
30 [ benchIOSrc asyncly "unfoldr" (sourceUnfoldr value)
28 , benchIOSrc asyncly "unfoldrM" (sourceUnfoldrM value)
31 , benchIOSrc asyncly "unfoldrM" (sourceUnfoldrM value)
32+ , benchIOSrc asyncly "fromListM" (sourceFromListM value)
29− , benchIOSrc asyncly "fromFoldable" (sourceFromFoldable value)
33+ , benchIOSrc asyncly "fromFoldable (List)" (sourceFromFoldable value)
30− , benchIOSrc asyncly "fromFoldableM" (sourceFromFoldableM value)
34+ , benchIOSrc asyncly "fromFoldableM (List)" (sourceFromFoldableM value)
31 , benchIOSrc asyncly "unfoldrM maxThreads 1"
35 , benchIOSrc asyncly "unfoldrM maxThreads 1"
32 (maxThreads 1 . sourceUnfoldrM value)
36 (maxThreads 1 . sourceUnfoldrM value)
33 , benchIOSrc asyncly "unfoldrM maxBuffer 1 (x/10 ops)"
37 , benchIOSrc asyncly "unfoldrM maxBuffer 1 (x/10 ops)"
34− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
38+ (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
35 ]
39 ]
36 ]
40 ]
37
41
@@ -39,12 +43,69 @@ o_1_space_generation value =
39-- Mapping
43-- Mapping
40-------------------------------------------------------------------------------
44-------------------------------------------------------------------------------
41
45
46+-- XXX this should be same as mapM return
47+-- XXX this has quadratic slowdown with async, but works well on serial
48+-- streams.
49+{-# INLINE foldrS #-}
50+foldrS :: Int -> Int -> IO ()
51+foldrS count n =
52+ S.drain
53+ $ asyncly
54+ $ Internal.foldrS (\x xs -> S.consM (return x) xs) S.nil
55+ $ serially
56+ $ sourceUnfoldrM count n
57+
42o_1_space_mapping :: Int -> [Benchmark]
58o_1_space_mapping :: Int -> [Benchmark]
43o_1_space_mapping value =
59o_1_space_mapping value =
44 [ bgroup "mapping"
60 [ bgroup "mapping"
45 [ benchIOSink value "map" $ mapN asyncly 1
61 [ benchIOSink value "map" $ mapN asyncly 1
46 , benchIOSink value "fmap" $ fmapN asyncly 1
62 , benchIOSink value "fmap" $ fmapN asyncly 1
63+ -- This basically tests the performance of consMAsync
47− , benchIOSink value "mapM" $ mapM asyncly 1
64+ , benchIOSink value "mapM" $ mapM asyncly 1 . serially
65+ ]
66+ ]
67+
68+o_n_heap_mapping :: Int -> [Benchmark]
69+o_n_heap_mapping _value =
70+ [ bgroup "mapping"
71+ [ benchIOSrc1 "foldrS (600)" (foldrS 600)
72+ ]
73+ ]
74+
75+-------------------------------------------------------------------------------
76+-- Joining
77+-------------------------------------------------------------------------------
78+
79+{-# INLINE async2 #-}
80+async2 :: Int -> Int -> IO ()
81+async2 count n =
82+ S.drain $
83+ (sourceUnfoldrM count n) `async` (sourceUnfoldrM count (n + 1))
84+
85+{-# INLINE async4 #-}
86+async4 :: Int -> Int -> IO ()
87+async4 count n =
88+ S.drain $
89+ (sourceUnfoldrM count (n + 0))
90+ `async` (sourceUnfoldrM count (n + 1))
91+ `async` (sourceUnfoldrM count (n + 2))
92+ `async` (sourceUnfoldrM count (n + 3))
93+
94+{-# INLINE async2n2 #-}
95+async2n2 :: Int -> Int -> IO ()
96+async2n2 count n =
97+ S.drain $
98+ ((sourceUnfoldrM count (n + 0))
99+ `async` (sourceUnfoldrM count (n + 1)))
100+ `async` ((sourceUnfoldrM count (n + 2))
101+ `async` (sourceUnfoldrM count (n + 3)))
102+
103+o_1_space_joining :: Int -> [Benchmark]
104+o_1_space_joining value =
105+ [ bgroup "joining"
106+ [ benchIOSrc1 "async (2 of n/2)" (async2 (value `div` 2))
107+ , benchIOSrc1 "async (4 of n/4)" (async4 (value `div` 4))
108+ , benchIOSrc1 "async (2 of (2 of n/4)" (async2n2 (value `div` 4))
48 ]
109 ]
49 ]
110 ]
50
111
@@ -52,25 +113,35 @@ o_1_space_mapping value =
52-- Concat
113-- Concat
53-------------------------------------------------------------------------------
114-------------------------------------------------------------------------------
54
115
116+-- These basically test the performance of folding streams with `async`
55o_1_space_concatFoldable :: Int -> [Benchmark]
117o_1_space_concatFoldable :: Int -> [Benchmark]
56o_1_space_concatFoldable value =
118o_1_space_concatFoldable value =
57 [ bgroup "concat-foldable"
119 [ bgroup "concat-foldable"
58− [ benchIOSrc asyncly "foldMapWith" (sourceFoldMapWith value)
120+ [ benchIOSrc asyncly "foldMapWith (<>) (List)"
121+ (sourceFoldMapWith value)
122+ , benchIOSrc asyncly "foldMapWith (<>) (Stream)"
123+ (sourceFoldMapWithStream value)
124+ , benchIOSrc asyncly "foldMapWithM (<>) (List)"
59− , benchIOSrc asyncly "foldMapWithM" (sourceFoldMapWithM value)
125+ (sourceFoldMapWithM value)
60− , benchIOSrc asyncly "foldMapM" (sourceFoldMapM value)
126+ , benchIOSrc asyncly "foldMapM (List)" (sourceFoldMapM value)
61 ]
127 ]
62 ]
128 ]
63
129
130+-- These basically test the performance of concating streams with `async`
64o_1_space_concatMap :: Int -> [Benchmark]
131o_1_space_concatMap :: Int -> [Benchmark]
65o_1_space_concatMap value =
132o_1_space_concatMap value =
66 value2 `seq`
133 value2 `seq`
67− [ bgroup "concatMap"
134+ [ bgroup "concat"
135+ -- This is for comparison with foldMapWith
136+ [ benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
137+ (S.concatMapWith async id . sourceConcatMapId value)
138+
68− [ benchIO "concatMapWith (2,x/2)"
139+ , benchIO "concatMapWith (n of 1)"
69− (concatStreamsWith async 2 (value `div` 2))
140+ (concatStreamsWith async value 1)
70− , benchIO "concatMapWith (sqrt x,sqrt x)"
141+ , benchIO "concatMapWith (sqrt x of sqrt x)"
71 (concatStreamsWith async value2 value2)
142 (concatStreamsWith async value2 value2)
72− , benchIO "concatMapWith (sqrt x * 2,sqrt x / 2)"
143+ , benchIO "concatMapWith (1 of n)"
73− (concatStreamsWith async (value2 * 2) (value2 `div` 2))
144+ (concatStreamsWith async 1 value)
74 ]
145 ]
75 ]
146 ]
76
147
@@ -122,6 +193,8 @@ main = do
122 , o_1_space_concatFoldable value
193 , o_1_space_concatFoldable value
123 , o_1_space_concatMap value
194 , o_1_space_concatMap value
124 , o_1_space_outerProduct value
195 , o_1_space_outerProduct value
196+ , o_1_space_joining value
125 ]
197 ]
198+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_mapping value)
126 , bgroup (o_n_space_prefix moduleName) (o_n_space_outerProduct value)
199 , bgroup (o_n_space_prefix moduleName) (o_n_space_outerProduct value)
127 ]
200 ]
benchmark/Streamly/Benchmark/Prelude/Parallel.hs+23−15
@@ -34,16 +34,16 @@ mergeAsyncByM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
34mergeAsyncByM count n =
34mergeAsyncByM count n =
35 S.mergeAsyncByM
35 S.mergeAsyncByM
36 (\a b -> return (a `compare` b))
36 (\a b -> return (a `compare` b))
37− (sourceUnfoldrMN count n)
37+ (sourceUnfoldrM count n)
38− (sourceUnfoldrMN count (n + 1))
38+ (sourceUnfoldrM count (n + 1))
39
39
40{-# INLINE mergeAsyncBy #-}
40{-# INLINE mergeAsyncBy #-}
41mergeAsyncBy :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
41mergeAsyncBy :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
42mergeAsyncBy count n =
42mergeAsyncBy count n =
43 S.mergeAsyncBy
43 S.mergeAsyncBy
44 compare
44 compare
45− (sourceUnfoldrMN count n)
45+ (sourceUnfoldrM count n)
46− (sourceUnfoldrMN count (n + 1))
46+ (sourceUnfoldrM count (n + 1))
47
47
48-------------------------------------------------------------------------------
48-------------------------------------------------------------------------------
49-- Application/fold
49-- Application/fold
@@ -99,7 +99,7 @@ o_n_heap_generation value =
99 , benchIOSrc parallely "unfoldrM maxThreads 1"
99 , benchIOSrc parallely "unfoldrM maxThreads 1"
100 (maxThreads 1 . sourceUnfoldrM value)
100 (maxThreads 1 . sourceUnfoldrM value)
101 , benchIOSrc parallely "unfoldrM maxBuffer 1 (x/10 ops)"
101 , benchIOSrc parallely "unfoldrM maxBuffer 1 (x/10 ops)"
102− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
102+ (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
103 ]
103 ]
104 ]
104 ]
105
105
@@ -112,7 +112,7 @@ o_n_heap_mapping value =
112 [ bgroup "mapping"
112 [ bgroup "mapping"
113 [ benchIOSink value "map" $ mapN parallely 1
113 [ benchIOSink value "map" $ mapN parallely 1
114 , benchIOSink value "fmap" $ fmapN parallely 1
114 , benchIOSink value "fmap" $ fmapN parallely 1
115− , benchIOSink value "mapM" $ mapM parallely 1
115+ , benchIOSink value "mapM" $ mapM parallely 1 . serially
116 ]
116 ]
117 ]
117 ]
118
118
@@ -124,9 +124,13 @@ o_n_heap_concatFoldable :: Int -> [Benchmark]
124o_n_heap_concatFoldable value =
124o_n_heap_concatFoldable value =
125 [ bgroup
125 [ bgroup
126 "concat-foldable"
126 "concat-foldable"
127− [ benchIOSrc parallely "foldMapWith" (sourceFoldMapWith value)
127+ [ benchIOSrc parallely "foldMapWith (<>) (List)"
128+ (sourceFoldMapWith value)
129+ , benchIOSrc parallely "foldMapWith (<>) (Stream)"
130+ (sourceFoldMapWithStream value)
131+ , benchIOSrc parallely "foldMapWithM (<>) (List)"
128− , benchIOSrc parallely "foldMapWithM" (sourceFoldMapWithM value)
132+ (sourceFoldMapWithM value)
129− , benchIOSrc parallely "foldMapM" (sourceFoldMapM value)
133+ , benchIOSrc parallely "foldMapM (List)" (sourceFoldMapM value)
130 ]
134 ]
131 ]
135 ]
132
136
@@ -134,12 +138,16 @@ o_n_heap_concat :: Int -> [Benchmark]
134o_n_heap_concat value =
138o_n_heap_concat value =
135 value2 `seq`
139 value2 `seq`
136 [ bgroup "concat"
140 [ bgroup "concat"
137− [ benchIO "concatMapWith (2,x/2)"
141+ -- This is for comparison with foldMapWith
138− (concatStreamsWith parallel 2 (value `div` 2))
142+ [ benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
143+ (S.concatMapWith parallel id . sourceConcatMapId value)
144+
139− , benchIO "concatMapWith (sqrt x,sqrt x)"
145+ , benchIO "concatMapWith (n of 1)"
140− (concatStreamsWith parallel value2 value2)
146+ (concatStreamsWith parallel value 1)
141− , benchIO "concatMapWith (sqrt x * 2,sqrt x / 2)"
147+ , benchIO "concatMapWith (sqrt x of sqrt x)"
142− (concatStreamsWith parallel (value2 * 2) (value2 `div` 2))
148+ (concatStreamsWith parallel value2 value2)
149+ , benchIO "concatMapWith (1 of n)"
150+ (concatStreamsWith parallel 1 value)
143 ]
151 ]
144 ]
152 ]
145
153
benchmark/Streamly/Benchmark/Prelude/Serial.hs+78−51
@@ -1216,7 +1216,7 @@ iterateSource ::
1216 -> Int
1216 -> Int
1217 -> Int
1217 -> Int
1218 -> SerialT m Int
1218 -> SerialT m Int
1219−iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
1219+iterateSource g i n = f i (sourceUnfoldrM iterStreamLen n)
1220 where
1220 where
1221 f (0 :: Int) m = g m
1221 f (0 :: Int) m = g m
1222 f x m = g (f (x P.- 1) m)
1222 f x m = g (f (x P.- 1) m)
@@ -1324,23 +1324,23 @@ o_1_space_pipesX4 value =
1324serial2 :: Int -> Int -> IO ()
1324serial2 :: Int -> Int -> IO ()
1325serial2 count n =
1325serial2 count n =
1326 S.drain $
1326 S.drain $
1327− S.serial (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
1327+ S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
1328
1328
1329{-# INLINE serial4 #-}
1329{-# INLINE serial4 #-}
1330serial4 :: Int -> Int -> IO ()
1330serial4 :: Int -> Int -> IO ()
1331serial4 count n =
1331serial4 count n =
1332 S.drain $
1332 S.drain $
1333 S.serial
1333 S.serial
1334− (S.serial (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1)))
1334+ (S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)))
1335 (S.serial
1335 (S.serial
1336− (sourceUnfoldrMN count (n + 2))
1336+ (sourceUnfoldrM count (n + 2))
1337− (sourceUnfoldrMN count (n + 3)))
1337+ (sourceUnfoldrM count (n + 3)))
1338
1338
1339{-# INLINE append2 #-}
1339{-# INLINE append2 #-}
1340append2 :: Int -> Int -> IO ()
1340append2 :: Int -> Int -> IO ()
1341append2 count n =
1341append2 count n =
1342 S.drain $
1342 S.drain $
1343− Internal.append (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
1343+ Internal.append (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
1344
1344
1345{-# INLINE append4 #-}
1345{-# INLINE append4 #-}
1346append4 :: Int -> Int -> IO ()
1346append4 :: Int -> Int -> IO ()
@@ -1348,11 +1348,11 @@ append4 count n =
1348 S.drain $
1348 S.drain $
1349 Internal.append
1349 Internal.append
1350 (Internal.append
1350 (Internal.append
1351− (sourceUnfoldrMN count n)
1351+ (sourceUnfoldrM count n)
1352− (sourceUnfoldrMN count (n + 1)))
1352+ (sourceUnfoldrM count (n + 1)))
1353 (Internal.append
1353 (Internal.append
1354− (sourceUnfoldrMN count (n + 2))
1354+ (sourceUnfoldrM count (n + 2))
1355− (sourceUnfoldrMN count (n + 3)))
1355+ (sourceUnfoldrM count (n + 3)))
1356
1356
1357#ifdef INSPECTION
1357#ifdef INSPECTION
1358inspect $ hasNoTypeClasses 'append2
1358inspect $ hasNoTypeClasses 'append2
@@ -1370,8 +1370,8 @@ mergeBy count n =
1370 S.drain $
1370 S.drain $
1371 S.mergeBy
1371 S.mergeBy
1372 P.compare
1372 P.compare
1373− (sourceUnfoldrMN count n)
1373+ (sourceUnfoldrM count n)
1374− (sourceUnfoldrMN count (n + 1))
1374+ (sourceUnfoldrM count (n + 1))
1375
1375
1376#ifdef INSPECTION
1376#ifdef INSPECTION
1377inspect $ hasNoTypeClasses 'mergeBy
1377inspect $ hasNoTypeClasses 'mergeBy
@@ -1397,10 +1397,13 @@ o_1_space_joining value =
1397o_1_space_concatFoldable :: Int -> [Benchmark]
1397o_1_space_concatFoldable :: Int -> [Benchmark]
1398o_1_space_concatFoldable value =
1398o_1_space_concatFoldable value =
1399 [ bgroup "concat-foldable"
1399 [ bgroup "concat-foldable"
1400− [ benchIOSrc serially "foldMapWith" (sourceFoldMapWith value)
1400+ [ benchIOSrc serially "foldMapWith (<>) (List)"
1401+ (sourceFoldMapWith value)
1402+ , benchIOSrc serially "foldMapWith (<>) (Stream)"
1403+ (sourceFoldMapWithStream value)
1404+ , benchIOSrc serially "foldMapWithM (<>) (List)"
1401− , benchIOSrc serially "foldMapWithM" (sourceFoldMapWithM value)
1405+ (sourceFoldMapWithM value)
1402− , benchIOSrc serially "foldMapM" (sourceFoldMapM value)
1406+ , benchIOSrc serially "foldMapM (List)" (sourceFoldMapM value)
1403− , benchIOSrc serially "foldWithConcatMapId" (sourceConcatMapId value)
1404 ]
1407 ]
1405 ]
1408 ]
1406
1409
@@ -1414,8 +1417,8 @@ o_1_space_concatFoldable value =
1414concatMap :: Int -> Int -> Int -> IO ()
1417concatMap :: Int -> Int -> Int -> IO ()
1415concatMap outer inner n =
1418concatMap outer inner n =
1416 S.drain $ S.concatMap
1419 S.drain $ S.concatMap
1417− (\_ -> sourceUnfoldrMN inner n)
1420+ (\_ -> sourceUnfoldrM inner n)
1418− (sourceUnfoldrMN outer n)
1421+ (sourceUnfoldrM outer n)
1419
1422
1420#ifdef INSPECTION
1423#ifdef INSPECTION
1421inspect $ hasNoTypeClasses 'concatMap
1424inspect $ hasNoTypeClasses 'concatMap
@@ -1428,8 +1431,8 @@ inspect $ 'concatMap `hasNoType` ''SPEC
1428concatMapPure :: Int -> Int -> Int -> IO ()
1431concatMapPure :: Int -> Int -> Int -> IO ()
1429concatMapPure outer inner n =
1432concatMapPure outer inner n =
1430 S.drain $ S.concatMap
1433 S.drain $ S.concatMap
1431− (\_ -> sourceUnfoldrN inner n)
1434+ (\_ -> sourceUnfoldr inner n)
1432− (sourceUnfoldrN outer n)
1435+ (sourceUnfoldr outer n)
1433
1436
1434#ifdef INSPECTION
1437#ifdef INSPECTION
1435inspect $ hasNoTypeClasses 'concatMapPure
1438inspect $ hasNoTypeClasses 'concatMapPure
@@ -1438,14 +1441,14 @@ inspect $ 'concatMapPure `hasNoType` ''SPEC
1438
1441
1439-- concatMap replicate/unfoldrM
1442-- concatMap replicate/unfoldrM
1440
1443
1441−{-# INLINE concatMapRepl4xN #-}
1444+{-# INLINE concatMapRepl #-}
1442−concatMapRepl4xN :: Int -> Int -> IO ()
1445+concatMapRepl :: Int -> Int -> Int -> IO ()
1446+concatMapRepl outer inner n =
1443−concatMapRepl4xN value n = S.drain $ S.concatMap (S.replicate 4)
1447+ S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrM outer n)
1444− (sourceUnfoldrMN (value `div` 4) n)
1445
1448
1446#ifdef INSPECTION
1449#ifdef INSPECTION
1447−inspect $ hasNoTypeClasses 'concatMapRepl4xN
1450+inspect $ hasNoTypeClasses 'concatMapRepl
1448−inspect $ 'concatMapRepl4xN `hasNoType` ''SPEC
1451+inspect $ 'concatMapRepl `hasNoType` ''SPEC
1449#endif
1452#endif
1450
1453
1451-- concatMapWith
1454-- concatMapWith
@@ -1472,41 +1475,65 @@ inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
1472
1475
1473-- concatUnfold replicate/unfoldrM
1476-- concatUnfold replicate/unfoldrM
1474
1477
1475−{-# INLINE concatUnfoldRepl4xN #-}
1478+{-# INLINE concatUnfoldRepl #-}
1476−concatUnfoldRepl4xN :: Int -> Int -> IO ()
1479+concatUnfoldRepl :: Int -> Int -> Int -> IO ()
1477−concatUnfoldRepl4xN value n =
1480+concatUnfoldRepl outer inner n =
1478− S.drain $ S.concatUnfold
1481+ S.drain $ S.concatUnfold (UF.replicateM inner) (sourceUnfoldrM outer n)
1479− (UF.replicateM 4)
1480− (sourceUnfoldrMN (value `div` 4) n)
1481
1482
1482#ifdef INSPECTION
1483#ifdef INSPECTION
1483−inspect $ hasNoTypeClasses 'concatUnfoldRepl4xN
1484+inspect $ hasNoTypeClasses 'concatUnfoldRepl
1484−inspect $ 'concatUnfoldRepl4xN `hasNoType` ''D.ConcatMapUState
1485+inspect $ 'concatUnfoldRepl `hasNoType` ''D.ConcatMapUState
1485−inspect $ 'concatUnfoldRepl4xN `hasNoType` ''SPEC
1486+inspect $ 'concatUnfoldRepl `hasNoType` ''SPEC
1486#endif
1487#endif
1487
1488
1488o_1_space_concat :: Int -> [Benchmark]
1489o_1_space_concat :: Int -> [Benchmark]
1489−o_1_space_concat value =
1490+o_1_space_concat value = sqrtVal `seq`
1490 [ bgroup "concat"
1491 [ bgroup "concat"
1491− [ benchIOSrc1 "concatMapPure (2,x/2)"
1492+ [ benchIOSrc1 "concatMapPure (n of 1)"
1492− (concatMapPure 2 (value `div` 2))
1493+ (concatMapPure value 1)
1494+ , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
1495+ (concatMapPure sqrtVal sqrtVal)
1493− , benchIOSrc1 "concatMap (2,x/2)"
1496+ , benchIOSrc1 "concatMapPure (1 of n)"
1494− (concatMap 2 (value `div` 2))
1497+ (concatMapPure 1 value)
1498+
1499+ -- This is for comparison with foldMapWith
1500+ , benchIOSrc serially "concatMapId (n of 1) (fromFoldable)"
1501+ (S.concatMap id . sourceConcatMapId value)
1502+
1495− , benchIOSrc1 "concatMap (x/2,2)"
1503+ , benchIOSrc1 "concatMap (n of 1)"
1496− (concatMap (value `div` 2) 2)
1504+ (concatMap value 1)
1505+ , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
1506+ (concatMap sqrtVal sqrtVal)
1497− , benchIOSrc1 "concatMapRepl (x/4,4)"
1507+ , benchIOSrc1 "concatMap (1 of n)"
1498− (concatMapRepl4xN value)
1508+ (concatMap 1 value)
1499− , benchIOSrc1 "concatUnfoldRepl (x/4,4)"
1509+
1500− (concatUnfoldRepl4xN value)
1510+ -- This is for comparison with foldMapWith
1501− , benchIOSrc1 "concatMapWithSerial (2,x/2)"
1511+ , benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
1512+ (S.concatMapWith serial id . sourceConcatMapId value)
1513+
1514+ , benchIOSrc1 "concatMapWith (n of 1)"
1502− (concatMapWithSerial 2 (value `div` 2))
1515+ (concatMapWithSerial value 1)
1503− , benchIOSrc1 "concatMapWithSerial (x/2,2)"
1516+ , benchIOSrc1 "concatMapWith (sqrt n of sqrt n)"
1517+ (concatMapWithSerial sqrtVal sqrtVal)
1518+ , benchIOSrc1 "concatMapWith (1 of n)"
1504− (concatMapWithSerial (value `div` 2) 2)
1519+ (concatMapWithSerial 1 value)
1520+
1521+ -- quadratic with number of outer streams
1505− , benchIOSrc1 "concatMapWithAppend (2,x/2)"
1522+ , benchIOSrc1 "concatMapWithAppend (2 of n/2)"
1506 (concatMapWithAppend 2 (value `div` 2))
1523 (concatMapWithAppend 2 (value `div` 2))
1524+
1525+ -- concatMap vs concatUnfold
1526+ , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
1527+ (concatMapRepl sqrtVal sqrtVal)
1528+ , benchIOSrc1 "concatUnfoldRepl (sqrt n of sqrt n)"
1529+ (concatUnfoldRepl sqrtVal sqrtVal)
1507 ]
1530 ]
1508 ]
1531 ]
1509
1532
1533+ where
1534+
1535+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
1536+
1510-------------------------------------------------------------------------------
1537-------------------------------------------------------------------------------
1511-- Monad
1538-- Monad
1512-------------------------------------------------------------------------------
1539-------------------------------------------------------------------------------
benchmark/Streamly/Benchmark/Prelude/WAsync.hs+22−13
@@ -7,7 +7,8 @@
7
7
8import Prelude hiding (mapM)
8import Prelude hiding (mapM)
9
9
10−import Streamly (wAsyncly, wAsync, maxBuffer, maxThreads)
10+import Streamly (wAsyncly, serially, wAsync, maxBuffer, maxThreads)
11+import qualified Streamly.Prelude as S
11
12
12import Streamly.Benchmark.Common
13import Streamly.Benchmark.Common
13import Streamly.Benchmark.Prelude
14import Streamly.Benchmark.Prelude
@@ -31,7 +32,7 @@ o_1_space_generation value =
31 , benchIOSrc wAsyncly "unfoldrM maxThreads 1"
32 , benchIOSrc wAsyncly "unfoldrM maxThreads 1"
32 (maxThreads 1 . sourceUnfoldrM value)
33 (maxThreads 1 . sourceUnfoldrM value)
33 , benchIOSrc wAsyncly "unfoldrM maxBuffer 1 (x/10 ops)"
34 , benchIOSrc wAsyncly "unfoldrM maxBuffer 1 (x/10 ops)"
34− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
35+ (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
35 ]
36 ]
36 ]
37 ]
37
38
@@ -44,7 +45,7 @@ o_1_space_mapping value =
44 [ bgroup "mapping"
45 [ bgroup "mapping"
45 [ benchIOSink value "map" $ mapN wAsyncly 1
46 [ benchIOSink value "map" $ mapN wAsyncly 1
46 , benchIOSink value "fmap" $ fmapN wAsyncly 1
47 , benchIOSink value "fmap" $ fmapN wAsyncly 1
47− , benchIOSink value "mapM" $ mapM wAsyncly 1
48+ , benchIOSink value "mapM" $ mapM wAsyncly 1 . serially
48 ]
49 ]
49 ]
50 ]
50
51
@@ -55,9 +56,13 @@ o_1_space_mapping value =
55o_1_space_concatFoldable :: Int -> [Benchmark]
56o_1_space_concatFoldable :: Int -> [Benchmark]
56o_1_space_concatFoldable value =
57o_1_space_concatFoldable value =
57 [ bgroup "concat-foldable"
58 [ bgroup "concat-foldable"
58− [ benchIOSrc wAsyncly "foldMapWith" (sourceFoldMapWith value)
59+ [ benchIOSrc wAsyncly "foldMapWith (<>) (List)"
60+ (sourceFoldMapWith value)
61+ , benchIOSrc wAsyncly "foldMapWith (<>) (Stream)"
62+ (sourceFoldMapWithStream value)
63+ , benchIOSrc wAsyncly "foldMapWithM (<>) (List)"
59− , benchIOSrc wAsyncly "foldMapWithM" (sourceFoldMapWithM value)
64+ (sourceFoldMapWithM value)
60− , benchIOSrc wAsyncly "foldMapM" (sourceFoldMapM value)
65+ , benchIOSrc wAsyncly "foldMapM (List)" (sourceFoldMapM value)
61 ]
66 ]
62 ]
67 ]
63
68
@@ -73,13 +78,17 @@ o_1_space_concatMap :: Int -> [Benchmark]
73o_1_space_concatMap value =
78o_1_space_concatMap value =
74 value2 `seq`
79 value2 `seq`
75 [ bgroup "concat"
80 [ bgroup "concat"
76− [ benchIO "concatMapWith (2,x/2)"
81+ -- This is for comparison with foldMapWith
77− (concatStreamsWith wAsync 2 (value `div` 2))
82+ [ benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
83+ (S.concatMapWith wAsync id . sourceConcatMapId value)
84+
78− , benchIO "concatMapWith (sqrt x,sqrt x)"
85+ , benchIO "concatMapWith (n of 1)"
79− (concatStreamsWith wAsync value2 value2)
86+ (concatStreamsWith wAsync value 1)
80− , benchIO "concatMapWith (sqrt x * 2,sqrt x / 2)"
87+ , benchIO "concatMapWith (sqrt x of sqrt x)"
81− (concatStreamsWith wAsync (value2 * 2) (value2 `div` 2))
88+ (concatStreamsWith wAsync value2 value2)
89+ , benchIO "concatMapWith (1 of n)"
90+ (concatStreamsWith wAsync 1 value)
82− ]
91+ ]
83 ]
92 ]
84
93
85 where
94 where
benchmark/Streamly/Benchmark/Prelude/WSerial.hs+8−8
@@ -57,16 +57,16 @@ o_1_space_mapping value =
57wSerial2 :: Int -> Int -> IO ()
57wSerial2 :: Int -> Int -> IO ()
58wSerial2 value n =
58wSerial2 value n =
59 S.drain $ wSerial
59 S.drain $ wSerial
60− (sourceUnfoldrMN (value `div` 2) n)
60+ (sourceUnfoldrM (value `div` 2) n)
61− (sourceUnfoldrMN (value `div` 2) (n + 1))
61+ (sourceUnfoldrM (value `div` 2) (n + 1))
62
62
63{-# INLINE interleave2 #-}
63{-# INLINE interleave2 #-}
64interleave2 :: Int -> Int -> IO ()
64interleave2 :: Int -> Int -> IO ()
65interleave2 value n =
65interleave2 value n =
66 S.drain $
66 S.drain $
67 Internal.interleave
67 Internal.interleave
68− (sourceUnfoldrMN (value `div` 2) n)
68+ (sourceUnfoldrM (value `div` 2) n)
69− (sourceUnfoldrMN (value `div` 2) (n + 1))
69+ (sourceUnfoldrM (value `div` 2) (n + 1))
70
70
71#ifdef INSPECTION
71#ifdef INSPECTION
72inspect $ hasNoTypeClasses 'interleave2
72inspect $ hasNoTypeClasses 'interleave2
@@ -79,8 +79,8 @@ roundRobin2 :: Int -> Int -> IO ()
79roundRobin2 value n =
79roundRobin2 value n =
80 S.drain $
80 S.drain $
81 Internal.roundrobin
81 Internal.roundrobin
82− (sourceUnfoldrMN (value `div` 2) n)
82+ (sourceUnfoldrM (value `div` 2) n)
83− (sourceUnfoldrMN (value `div` 2) (n + 1))
83+ (sourceUnfoldrM (value `div` 2) (n + 1))
84
84
85#ifdef INSPECTION
85#ifdef INSPECTION
86inspect $ hasNoTypeClasses 'roundRobin2
86inspect $ hasNoTypeClasses 'roundRobin2
@@ -127,7 +127,7 @@ concatUnfoldInterleaveRepl4xN :: Int -> Int -> IO ()
127concatUnfoldInterleaveRepl4xN value n =
127concatUnfoldInterleaveRepl4xN value n =
128 S.drain $ Internal.concatUnfoldInterleave
128 S.drain $ Internal.concatUnfoldInterleave
129 (UF.replicateM 4)
129 (UF.replicateM 4)
130− (sourceUnfoldrMN (value `div` 4) n)
130+ (sourceUnfoldrM (value `div` 4) n)
131
131
132#ifdef INSPECTION
132#ifdef INSPECTION
133inspect $ hasNoTypeClasses 'concatUnfoldInterleaveRepl4xN
133inspect $ hasNoTypeClasses 'concatUnfoldInterleaveRepl4xN
@@ -141,7 +141,7 @@ concatUnfoldRoundrobinRepl4xN :: Int -> Int -> IO ()
141concatUnfoldRoundrobinRepl4xN value n =
141concatUnfoldRoundrobinRepl4xN value n =
142 S.drain $ Internal.concatUnfoldRoundrobin
142 S.drain $ Internal.concatUnfoldRoundrobin
143 (UF.replicateM 4)
143 (UF.replicateM 4)
144− (sourceUnfoldrMN (value `div` 4) n)
144+ (sourceUnfoldrM (value `div` 4) n)
145
145
146#ifdef INSPECTION
146#ifdef INSPECTION
147inspect $ hasNoTypeClasses 'concatUnfoldRoundrobinRepl4xN
147inspect $ hasNoTypeClasses 'concatUnfoldRoundrobinRepl4xN
benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs+4−4
@@ -26,21 +26,21 @@ moduleName = "Prelude.ZipAsync"
26{-# INLINE zipAsync #-}
26{-# INLINE zipAsync #-}
27zipAsync :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
27zipAsync :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
28zipAsync count n =
28zipAsync count n =
29− S.zipAsyncWith (,) (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
29+ S.zipAsyncWith (,) (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
30
30
31{-# INLINE zipAsyncM #-}
31{-# INLINE zipAsyncM #-}
32zipAsyncM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
32zipAsyncM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
33zipAsyncM count n =
33zipAsyncM count n =
34 S.zipAsyncWithM
34 S.zipAsyncWithM
35 (curry return)
35 (curry return)
36− (sourceUnfoldrMN count n)
36+ (sourceUnfoldrM count n)
37− (sourceUnfoldrMN count (n + 1))
37+ (sourceUnfoldrM count (n + 1))
38
38
39{-# INLINE zipAsyncAp #-}
39{-# INLINE zipAsyncAp #-}
40zipAsyncAp :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
40zipAsyncAp :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
41zipAsyncAp count n =
41zipAsyncAp count n =
42 S.zipAsyncly $
42 S.zipAsyncly $
43− (,) <$> sourceUnfoldrMN count n <*> sourceUnfoldrMN count (n + 1)
43+ (,) <$> sourceUnfoldrM count n <*> sourceUnfoldrM count (n + 1)
44
44
45o_1_space_joining :: Int -> [Benchmark]
45o_1_space_joining :: Int -> [Benchmark]
46o_1_space_joining value =
46o_1_space_joining value =
benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs+10−7
@@ -26,7 +26,7 @@ import qualified Streamly as S
26import qualified Streamly.Prelude as S
26import qualified Streamly.Prelude as S
27
27
28import Streamly.Benchmark.Common
28import Streamly.Benchmark.Common
29−import Streamly.Benchmark.Prelude hiding (sourceUnfoldrMN)
29+import Streamly.Benchmark.Prelude hiding (sourceUnfoldrM)
30
30
31import Gauge
31import Gauge
32
32
@@ -46,9 +46,9 @@ moduleName = "Prelude.ZipSerial"
46
46
47-- XXX somehow copying this definition here instead of importing it performs
47-- XXX somehow copying this definition here instead of importing it performs
48-- better. Need to investigate why.
48-- better. Need to investigate why.
49−{-# INLINE sourceUnfoldrMN #-}
49+{-# INLINE sourceUnfoldrM #-}
50−sourceUnfoldrMN :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
50+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
51−sourceUnfoldrMN count start = S.unfoldrM step start
51+sourceUnfoldrM count start = S.unfoldrM step start
52 where
52 where
53 step cnt =
53 step cnt =
54 if cnt > start + count
54 if cnt > start + count
@@ -59,7 +59,10 @@ sourceUnfoldrMN count start = S.unfoldrM step start
59zip :: Int -> Int -> IO ()
59zip :: Int -> Int -> IO ()
60zip count n =
60zip count n =
61 S.drain $
61 S.drain $
62− S.zipWith (,) (S.serially $ sourceUnfoldrMN count n) (S.serially $ sourceUnfoldrMN count (n + 1))
62+ S.zipWith
63+ (,)
64+ (S.serially $ sourceUnfoldrM count n)
65+ (S.serially $ sourceUnfoldrM count (n + 1))
63
66
64#ifdef INSPECTION
67#ifdef INSPECTION
65inspect $ hasNoTypeClasses 'zip
68inspect $ hasNoTypeClasses 'zip
@@ -73,8 +76,8 @@ zipM count n =
73 S.drain $
76 S.drain $
74 S.zipWithM
77 S.zipWithM
75 (curry return)
78 (curry return)
76− (sourceUnfoldrMN count n)
79+ (sourceUnfoldrM count n)
77− (sourceUnfoldrMN count (n + 1))
80+ (sourceUnfoldrM count (n + 1))
78
81
79#ifdef INSPECTION
82#ifdef INSPECTION
80inspect $ hasNoTypeClasses 'zipM
83inspect $ hasNoTypeClasses 'zipM
benchmark/lib/Streamly/Benchmark/Prelude.hs+11−22
@@ -14,6 +14,7 @@ module Streamly.Benchmark.Prelude where
14
14
15import Control.DeepSeq (NFData(..))
15import Control.DeepSeq (NFData(..))
16import Control.Exception (try)
16import Control.Exception (try)
17+import Data.Functor.Identity (Identity)
17import GHC.Exception (ErrorCall)
18import GHC.Exception (ErrorCall)
18import System.Random (randomRIO)
19import System.Random (randomRIO)
19
20
@@ -72,15 +73,6 @@ sourceUnfoldr count start = S.unfoldr step start
72 then Nothing
73 then Nothing
73 else Just (cnt, cnt + 1)
74 else Just (cnt, cnt + 1)
74
75
75−{-# INLINE sourceUnfoldrN #-}
76−sourceUnfoldrN :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
77−sourceUnfoldrN count start = S.unfoldr step start
78− where
79− step cnt =
80− if cnt > start + count
81− then Nothing
82− else Just (cnt, cnt + 1)
83−
84{-# INLINE sourceUnfoldrM #-}
76{-# INLINE sourceUnfoldrM #-}
85sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
77sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
86sourceUnfoldrM count start = S.unfoldrM step start
78sourceUnfoldrM count start = S.unfoldrM step start
@@ -90,15 +82,6 @@ sourceUnfoldrM count start = S.unfoldrM step start
90 then return Nothing
82 then return Nothing
91 else return (Just (cnt, cnt + 1))
83 else return (Just (cnt, cnt + 1))
92
84
93−{-# INLINE sourceUnfoldrMN #-}
94−sourceUnfoldrMN :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
95−sourceUnfoldrMN count start = S.unfoldrM step start
96− where
97− step cnt =
98− if cnt > start + count
99− then return Nothing
100− else return (Just (cnt, cnt + 1))
101−
102-------------------------------------------------------------------------------
85-------------------------------------------------------------------------------
103-- fromIndices
86-- fromIndices
104-------------------------------------------------------------------------------
87-------------------------------------------------------------------------------
@@ -303,6 +286,12 @@ sourceFoldMapWith :: (S.IsStream t, S.Semigroup (t m Int))
303 => Int -> Int -> t m Int
286 => Int -> Int -> t m Int
304sourceFoldMapWith value n = S.foldMapWith (S.<>) S.yield [n..n+value]
287sourceFoldMapWith value n = S.foldMapWith (S.<>) S.yield [n..n+value]
305
288
289+{-# INLINE sourceFoldMapWithStream #-}
290+sourceFoldMapWithStream :: (S.IsStream t, S.Semigroup (t m Int))
291+ => Int -> Int -> t m Int
292+sourceFoldMapWithStream value n = S.foldMapWith (S.<>) S.yield
293+ $ (S.enumerateFromTo n (n + value) :: S.SerialT Identity Int)
294+
306{-# INLINE sourceFoldMapWithM #-}
295{-# INLINE sourceFoldMapWithM #-}
307sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))
296sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))
308 => Int -> Int -> t m Int
297 => Int -> Int -> t m Int
@@ -320,9 +309,9 @@ sourceFoldMapM value n = F.foldMap (S.yieldM . return) [n..n+value]
320
309
321{-# INLINE sourceConcatMapId #-}
310{-# INLINE sourceConcatMapId #-}
322sourceConcatMapId :: (S.IsStream t, Monad m)
311sourceConcatMapId :: (S.IsStream t, Monad m)
323− => Int -> Int -> t m Int
312+ => Int -> Int -> t m (t m Int)
324sourceConcatMapId value n =
313sourceConcatMapId value n =
325− S.concatMap id $ S.fromFoldable $ fmap (S.yieldM . return) [n..n+value]
314+ S.fromFoldable $ fmap (S.yieldM . return) [n..n+value]
326
315
327-- concatMapWith
316-- concatMapWith
328
317
@@ -335,8 +324,8 @@ concatStreamsWith
335 -> IO ()
324 -> IO ()
336concatStreamsWith op outer inner n =
325concatStreamsWith op outer inner n =
337 S.drain $ S.concatMapWith op
326 S.drain $ S.concatMapWith op
338− (sourceUnfoldrMN inner)
327+ (S.serially . sourceUnfoldrM inner)
339− (sourceUnfoldrMN outer n)
328+ (S.serially $ sourceUnfoldrM outer n)
340
329
341-------------------------------------------------------------------------------
330-------------------------------------------------------------------------------
342-- Monadic outer product
331-- Monadic outer product