git.iko.soy/streamly
on master help sign in
Refactor Prelude benchmarks
129ebafHarendra Kumar
.hlint.yaml+1
compare with master
unifiedsplit
@@ -17,6 +17,7 @@
17- ignore: {name: "Reduce duplication"}
17- ignore: {name: "Reduce duplication"}
18- ignore: {name: "Use <>"}
18- ignore: {name: "Use <>"}
19- ignore: {name: "Use fewer imports"}
19- ignore: {name: "Use fewer imports"}
20+- ignore: {name: "Use camelCase"}
20
21
21
22
22# Specify additional command line arguments
23# Specify additional command line arguments
bench.sh+73−85
@@ -3,94 +3,91 @@
3# Note "_grp" and "_cmp" suffixes are special, do not rename them to something
3# Note "_grp" and "_cmp" suffixes are special, do not rename them to something
4# else.
4# else.
5
5
6+#------------------------------------------------------------------------------
7+# Benchmark groups
8+#------------------------------------------------------------------------------
6base_stream_grp="\
9base_stream_grp="\
7 Data.Stream.StreamD \
10 Data.Stream.StreamD \
8 Data.Stream.StreamK \
11 Data.Stream.StreamK \
9 Data.Stream.StreamDK"
12 Data.Stream.StreamDK"
10−SERIAL_O_1="linear"
11−SERIAL_O_n="serial-o-n-heap serial-o-n-stack serial-o-n-space"
12−serial_grp="$SERIAL_O_1 $SERIAL_O_n"
13
13
14−# parallel benchmark-suite is separated because we run it with a higher
14+prelude_serial_grp="\
15−# heap size limit.
15+ Prelude.Serial \
16−concurrent_grp="linear-async linear-rate nested-concurrent parallel concurrent adaptive"
16+ Prelude.WSerial \
17+ Prelude.ZipSerial"
18+
19+prelude_concurrent_grp="\
20+ Prelude.Async \
21+ Prelude.WAsync \
22+ Prelude.Ahead \
23+ Prelude.Parallel \
24+ Prelude.ZipAsync"
25+
26+prelude_other_grp="\
27+ Prelude.Rate \
28+ Prelude.Concurrent \
29+ Prelude.Adaptive"
17
30
18array_grp="Memory.Array Data.Array Data.Prim.Array Data.SmallArray"
31array_grp="Memory.Array Data.Array Data.Prim.Array Data.SmallArray"
19
32
20base_parser_grp="Data.Parser.ParserD Data.Parser.ParserK"
33base_parser_grp="Data.Parser.ParserD Data.Parser.ParserK"
21parser_grp="Data.Fold Data.Parser"
34parser_grp="Data.Fold Data.Parser"
22
35
23−# XXX We can include SERIAL_O_1 here once "base" also supports --stream-size
36+#------------------------------------------------------------------------------
24−infinite_grp="linear linear-async linear-rate nested-concurrent"
37+# Streaming vs non-streaming
25−finite_grp="$SERIAL_O_n $array_grp fileio parallel concurrent adaptive"
38+#------------------------------------------------------------------------------
39+# The "o-1-space" groups of these benchmarks are run with long stream
40+# sizes when --long option is used.
26
41
27−# Benchmarks that take long time per iteration must run fewer iterations to
42+infinite_grp="\
28−# finish in reasonable time.
43+ $prelude_serial_grp \
29−QUICK_BENCHMARKS="linear-rate concurrent adaptive fileio"
44+ $prelude_concurrent_grp \
45+ Prelude.Rate"
30
46
47+#------------------------------------------------------------------------------
48+# Comparison groups
49+#------------------------------------------------------------------------------
31# *_cmp denotes a comparison benchmarks, the benchmarks provided in *_cmp
50# *_cmp denotes a comparison benchmarks, the benchmarks provided in *_cmp
32# variables are compared with each other
51# variables are compared with each other
33−array_cmp="Memory.Array Data.Prim.Array Data.Array"
34base_stream_cmp="Data.Stream.StreamD Data.Stream.StreamK"
52base_stream_cmp="Data.Stream.StreamD Data.Stream.StreamK"
53+serial_wserial_cmp="Prelude.Serial Prelude.WSerial"
54+serial_async_cmp="Prelude.Serial Prelude.Async"
55+concurrent_cmp="Prelude.Async Prelude.WAsync Prelude.Ahead Prelude.Parallel"
56+array_cmp="Memory.Array Data.Prim.Array Data.Array"
35base_parser_cmp=$base_parser_grp
57base_parser_cmp=$base_parser_grp
58+COMPARISONS="\
36−COMPARISONS="array_cmp base_stream_cmp base_parser_cmp"
59+ base_stream_cmp \
37−
60+ serial_wserial_cmp \
61+ serial_async_cmp \
62+ concurrent_cmp \
63+ array_cmp \
64+ base_parser_cmp"
65+
66+#------------------------------------------------------------------------------
67+# All
68+#------------------------------------------------------------------------------
38# All high level benchmarks
69# All high level benchmarks
39all_grp="\
70all_grp="\
40− $serial_grp \
71+ $prelude_serial_grp \
41− $concurrent_grp \
72+ $prelude_concurrent_grp \
42 $array_grp \
73 $array_grp \
43 $parser_grp \
74 $parser_grp \
44 Data.Unfold"
75 Data.Unfold"
45
76
46ALL_BENCH_GROUPS="\
77ALL_BENCH_GROUPS="\
47 all_grp \
78 all_grp \
48− serial_grp \
79+ prelude_serial_grp \
49− concurrent_grp \
80+ prelude_concurrent_grp \
50 array_grp \
81 array_grp \
51 infinite_grp \
82 infinite_grp \
52− finite_grp \
53 base_stream_grp \
83 base_stream_grp \
54 base_parser_grp"
84 base_parser_grp"
55
85
56−# RTS options that go inside +RTS and -RTS while running the benchmark.
86+#------------------------------------------------------------------------------
57−bench_rts_opts () {
87+# Script
58− case "$1" in
88+#------------------------------------------------------------------------------
59− "linear") echo -n "-T -K36K -M16M" ;;
60− "serial-o-n-stack") echo -n "-T -K1M -M16M" ;;
61− "serial-o-n-heap") echo -n "-T -K36K -M128M" ;;
62− "serial-o-n-space") echo -n "-T -K16M -M64M" ;;
63− Data.SmallArray/o-1-sp*) echo -n "-T -K128K -M16M" ;;
64− */o-1-sp*) echo -n "-T -K36K -M16M" ;;
65− */o-n-h*) echo -n "-T -K36K -M32M" ;;
66− */o-n-st*) echo -n "-T -K1M -M16M" ;;
67− */o-n-sp*) echo -n "-T -K1M -M32M" ;;
68−
69− *) echo -n "" ;;
70− esac
71−}
72
89
73−# The correct executable for the given benchmark name.
90+BENCH_SH_DIR=$(dirname $0)
74−bench_exec () {
75− case "$1" in
76− "linear") echo -n "serial" ;;
77− "serial-o-n-stack") echo -n "serial" ;;
78− "serial-o-n-heap") echo -n "serial" ;;
79− "serial-o-n-space") echo -n "serial" ;;
80− *) echo -n "$1" ;;
81− esac
82−}
83−
84−# Specific gauge options for the given benchmark.
85−bench_gauge_opts () {
86− case "$1" in
87− "linear") echo -n "-m prefix o-1-space" ;;
88− "serial-o-n-stack") echo -n "-m prefix o-n-stack" ;;
89− "serial-o-n-heap") echo -n "-m prefix o-n-heap" ;;
90− "serial-o-n-space") echo -n "-m prefix o-n-space" ;;
91− *) echo -n "" ;;
92− esac
93−}
94
91
95list_benches () {
92list_benches () {
96 echo "Individual benchmarks:"
93 echo "Individual benchmarks:"
@@ -125,7 +122,7 @@ list_comparisons () {
125
122
126print_help () {
123print_help () {
127 echo "Usage: $0 "
124 echo "Usage: $0 "
128− echo " [--benchmarks <"bench1 bench2 ..." | ?>]"
125+ echo " [--benchmarks <"bench1 bench2 ..." | help>]"
129 echo " [--graphs]"
126 echo " [--graphs]"
130 echo " [--no-measure]"
127 echo " [--no-measure]"
131 echo " [--append]"
128 echo " [--append]"
@@ -136,7 +133,7 @@ print_help () {
136 echo " [--compare] [--base <commit>] [--candidate <commit>]"
133 echo " [--compare] [--base <commit>] [--candidate <commit>]"
137 echo " -- <gauge options or benchmarks>"
134 echo " -- <gauge options or benchmarks>"
138 echo
135 echo
139− echo "--benchmarks: benchmarks to run, use '?' for list of benchmarks"
136+ echo "--benchmarks: benchmarks to run, use 'help' for list of benchmarks"
140 echo "--graphs: Generate graphical reports"
137 echo "--graphs: Generate graphical reports"
141 echo "--no-measure: Don't run benchmarks, run reports from previous results"
138 echo "--no-measure: Don't run benchmarks, run reports from previous results"
142 echo "--append: Don't overwrite previous results, append for comparison"
139 echo "--append: Don't overwrite previous results, append for comparison"
@@ -280,10 +277,9 @@ function run_verbose() {
280
277
281run_bench () {
278run_bench () {
282 local bench_name=$1
279 local bench_name=$1
283− local bench_exe=$(bench_exec $bench_name)
280+ local bench_exe=$bench_name
284 local output_file=$(bench_output_file $bench_name)
281 local output_file=$(bench_output_file $bench_name)
285 local bench_prog
282 local bench_prog
286− local quick_bench=0
287 bench_prog=$($GET_BENCH_PROG $bench_exe) || \
283 bench_prog=$($GET_BENCH_PROG $bench_exe) || \
288 die "Cannot find benchmark executable for benchmark $bench_name"
284 die "Cannot find benchmark executable for benchmark $bench_name"
289
285
@@ -291,41 +287,38 @@ run_bench () {
291
287
292 echo "Running benchmark $bench_name ..."
288 echo "Running benchmark $bench_name ..."
293
289
294− for i in $QUICK_BENCHMARKS
295− do
296− if test "$(has_benchmark $i)" = "$bench_name"
297− then
298− quick_bench=1
299− fi
300− done
301−
302 local QUICK_OPTS="--quick --time-limit 1 --min-duration 0"
290 local QUICK_OPTS="--quick --time-limit 1 --min-duration 0"
303 local SPEED_OPTIONS
291 local SPEED_OPTIONS
304 if test "$LONG" -eq 0
292 if test "$LONG" -eq 0
305 then
293 then
306 if test "$SLOW" -eq 0
294 if test "$SLOW" -eq 0
307 then
295 then
308− if test "$QUICK" -eq 0 -a "$quick_bench" -eq 0
296+ export QUICK_MODE
297+ if test "$QUICK_MODE" -eq 0
309 then
298 then
310− # reasonably quick
299+ # default mode, not super quick, not slow
311 SPEED_OPTIONS="$QUICK_OPTS --min-samples 10"
300 SPEED_OPTIONS="$QUICK_OPTS --min-samples 10"
312 else
301 else
313 # super quick but less accurate
302 # super quick but less accurate
314 SPEED_OPTIONS="$QUICK_OPTS --include-first-iter"
303 SPEED_OPTIONS="$QUICK_OPTS --include-first-iter"
315 fi
304 fi
316 else
305 else
306+ # Slow but more accurate mode
317 SPEED_OPTIONS="--min-duration 0"
307 SPEED_OPTIONS="--min-duration 0"
318 fi
308 fi
319 else
309 else
310+ # large stream size, always super quick
311+ GAUGE_ARGS="$GAUGE_ARGS $bench_name/o-1-space"
320 SPEED_OPTIONS="--stream-size 10000000 $QUICK_OPTS --include-first-iter"
312 SPEED_OPTIONS="--stream-size 10000000 $QUICK_OPTS --include-first-iter"
321 fi
313 fi
322
314
315+ export BENCH_EXEC_PATH=$bench_prog
316+ export RTS_OPTIONS
323 run_verbose $bench_prog $SPEED_OPTIONS \
317 run_verbose $bench_prog $SPEED_OPTIONS \
324− +RTS $(bench_rts_opts $GAUGE_ARGS) -RTS \
325 --csvraw=$output_file \
318 --csvraw=$output_file \
326 -v 2 \
319 -v 2 \
327− --measure-with $bench_prog $GAUGE_ARGS \
320+ --measure-with "$BENCH_SH_DIR/bin/bench-exec-one.sh" \
328− $(bench_gauge_opts $bench_name) || die "Benchmarking failed"
321+ $GAUGE_ARGS || die "Benchmarking failed"
329}
322}
330
323
331run_benches() {
324run_benches() {
@@ -407,7 +400,7 @@ run_reports() {
407# Execution starts here
400# Execution starts here
408#-----------------------------------------------------------------------------
401#-----------------------------------------------------------------------------
409
402
410−DEFAULT_BENCHMARKS="linear"
403+DEFAULT_BENCHMARKS="$all_grp"
411
404
412COMPARE=0
405COMPARE=0
413BASE=
406BASE=
@@ -415,13 +408,14 @@ CANDIDATE=
415
408
416APPEND=0
409APPEND=0
417SLOW=0
410SLOW=0
418−QUICK=0
411+QUICK_MODE=0
419LONG=0
412LONG=0
420RAW=0
413RAW=0
421GRAPH=0
414GRAPH=0
422MEASURE=1
415MEASURE=1
423
416
424GAUGE_ARGS=
417GAUGE_ARGS=
418+RTS_OPTIONS=
425BUILD_ONCE=0
419BUILD_ONCE=0
426USE_STACK=0
420USE_STACK=0
427CABAL_BUILD_FLAGS=""
421CABAL_BUILD_FLAGS=""
@@ -445,9 +439,10 @@ do
445 --base) shift; BASE=$1; shift ;;
439 --base) shift; BASE=$1; shift ;;
446 --candidate) shift; CANDIDATE=$1; shift ;;
440 --candidate) shift; CANDIDATE=$1; shift ;;
447 --cabal-build-flags) shift; CABAL_BUILD_FLAGS=$1; shift ;;
441 --cabal-build-flags) shift; CABAL_BUILD_FLAGS=$1; shift ;;
442+ --rtsopts) shift; RTS_OPTIONS=$1; shift ;;
448 # flags
443 # flags
449 --slow) SLOW=1; shift ;;
444 --slow) SLOW=1; shift ;;
450− --quick) QUICK=1; shift ;;
445+ --quick) QUICK_MODE=1; shift ;;
451 --compare) COMPARE=1; shift ;;
446 --compare) COMPARE=1; shift ;;
452 --raw) RAW=1; shift ;;
447 --raw) RAW=1; shift ;;
453 --append) APPEND=1; shift ;;
448 --append) APPEND=1; shift ;;
@@ -479,13 +474,6 @@ only_real_benchmarks () {
479 done
474 done
480}
475}
481
476
482−proper_executables () {
483− for i in $BENCHMARKS
484− do
485− echo -n "$(bench_exec $i) "
486− done
487−}
488−
489has_benchmark () {
477has_benchmark () {
490 for i in $BENCHMARKS_ORIG
478 for i in $BENCHMARKS_ORIG
491 do
479 do
@@ -519,7 +507,7 @@ fi
519BENCHMARKS=$(set_benchmarks)
507BENCHMARKS=$(set_benchmarks)
520BENCHMARKS_ORIG=$BENCHMARKS
508BENCHMARKS_ORIG=$BENCHMARKS
521BENCHMARKS=$(only_real_benchmarks)
509BENCHMARKS=$(only_real_benchmarks)
522−EXECUTABLES=$(proper_executables)
510+EXECUTABLES=$BENCHMARKS
523
511
524echo "Using benchmark suites [$BENCHMARKS]"
512echo "Using benchmark suites [$BENCHMARKS]"
525
513
benchmark/Chart.hs+32−170
@@ -1,18 +1,13 @@
1−{-# LANGUAGE TupleSections #-}
2{-# LANGUAGE RecordWildCards #-}
1{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE ScopedTypeVariables #-}
2{-# LANGUAGE ScopedTypeVariables #-}
4
3
5module Main where
4module Main where
6
5
7−import Control.Exception (handle, catch, SomeException, ErrorCall(..))
6+import Control.Exception (catch, ErrorCall(..))
8import Control.Monad.Trans.State
7import Control.Monad.Trans.State
9import Control.Monad.Trans.Maybe
8import Control.Monad.Trans.Maybe
10import Data.Char (toLower)
9import Data.Char (toLower)
11−import Data.Function (on, (&))
12import Data.List
10import Data.List
13−import Data.List.Split
14−import Data.Maybe (mapMaybe)
15−import Data.Ord (comparing)
16import System.Environment (getArgs)
11import System.Environment (getArgs)
17import Control.Monad.IO.Class (liftIO)
12import Control.Monad.IO.Class (liftIO)
18import Control.Monad (mzero)
13import Control.Monad (mzero)
@@ -24,32 +19,27 @@ import BenchShow
24------------------------------------------------------------------------------
19------------------------------------------------------------------------------
25
20
26data BenchType
21data BenchType
27− = Linear
28− | LinearAsync
29− | LinearRate
30− | NestedConcurrent
31− | FileIO
32− | Concurrent
33− | Parallel
34− | Adaptive
35− | Compare String
22+ = Compare String
36 | Standard String
23 | Standard String
37 deriving Show
24 deriving Show
38
25
39data Options = Options
26data Options = Options
40 { genGraphs :: Bool
27 { genGraphs :: Bool
41− , benchType :: BenchType
28+ , benchType :: Maybe BenchType
42 } deriving Show
29 } deriving Show
43
30
44−defaultOptions = Options False Linear
31+defaultOptions :: Options
32+defaultOptions = Options False Nothing
45
33
34+setGenGraphs :: Monad m => Bool -> StateT (a, Options) m ()
46setGenGraphs val = do
35setGenGraphs val = do
47 (args, opts) <- get
36 (args, opts) <- get
48 put (args, opts { genGraphs = val })
37 put (args, opts { genGraphs = val })
49
38
39+setBenchType :: Monad m => BenchType -> StateT (a, Options) m ()
50setBenchType val = do
40setBenchType val = do
51 (args, opts) <- get
41 (args, opts) <- get
52− put (args, opts { benchType = val })
42+ put (args, opts { benchType = Just val })
53
43
54-- Like the shell "shift" to shift the command line arguments
44-- Like the shell "shift" to shift the command line arguments
55shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
45shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
@@ -63,14 +53,6 @@ parseBench :: StateT ([String], Options) (MaybeT IO) ()
63parseBench = do
53parseBench = do
64 x <- shift
54 x <- shift
65 case x of
55 case x of
66− Just "linear" -> setBenchType Linear
67− Just "linear-async" -> setBenchType LinearAsync
68− Just "linear-rate" -> setBenchType LinearRate
69− Just "nested-concurrent" -> setBenchType NestedConcurrent
70− Just "fileio" -> setBenchType FileIO
71− Just "concurrent" -> setBenchType Concurrent
72− Just "parallel" -> setBenchType Parallel
73− Just "adaptive" -> setBenchType Adaptive
74 Just str | "_cmp" `isSuffixOf` str -> setBenchType (Compare str)
56 Just str | "_cmp" `isSuffixOf` str -> setBenchType (Compare str)
75 Just str -> setBenchType (Standard str)
57 Just str -> setBenchType (Standard str)
76 Nothing -> do
58 Nothing -> do
@@ -101,102 +83,10 @@ parseOptions = do
101 Just opt -> parseOpt opt >> parseLoop
83 Just opt -> parseOpt opt >> parseLoop
102 Nothing -> return ()
84 Nothing -> return ()
103
85
86+ignoringErr :: IO () -> IO ()
104ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
87ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
105 putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")
88 putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")
106
89
107−------------------------------------------------------------------------------
108−-- Linear composition charts
109−------------------------------------------------------------------------------
110−
111−makeLinearGraphs :: Config -> String -> IO ()
112−makeLinearGraphs cfg@Config{..} inputFile = do
113− ignoringErr $ graph inputFile "generation" $ cfg
114− { title = (++) <$> title <*> Just " generation"
115− , classifyBenchmark =
116− fmap ("Streamly",) . stripPrefix "serially/generation/"
117− }
118−
119− ignoringErr $ graph inputFile "elimination" $ cfg
120− { title = (++) <$> title <*> Just " Elimination"
121− , classifyBenchmark =
122− fmap ("Streamly",) . stripPrefix "serially/elimination/"
123− }
124−
125− ignoringErr $ graph inputFile "transformation-zip" $ cfg
126− { title = (++) <$> title <*> Just " Transformation & Zip"
127− , classifyBenchmark = \b ->
128− if "serially/transformation/" `isPrefixOf` b
129− || "serially/zipping" `isPrefixOf` b
130− then Just ("Streamly", last $ splitOn "/" b)
131− else Nothing
132− }
133−
134− ignoringErr $ graph inputFile "filtering" $ cfg
135− { title = (++) <$> title <*> Just " Filtering"
136− , classifyBenchmark =
137− fmap ("Streamly",) . stripPrefix "serially/filtering/"
138− }
139−
140− ignoringErr $ graph inputFile "transformationX4" $ cfg
141− { title = (++) <$> title <*> Just " Transformation x 4"
142− , classifyBenchmark =
143− fmap ("Streamly",) . stripPrefix "serially/transformationX4/"
144− }
145−
146− ignoringErr $ graph inputFile "filteringX4"
147− $ cfg
148− { title = (++) <$> title <*> Just " Filtering x 4"
149− , classifyBenchmark =
150− fmap ("Streamly",) . stripPrefix "serially/filteringX4/"
151− }
152−
153− ignoringErr $ graph inputFile "mixedX4"
154− $ cfg
155− { title = (++) <$> title <*> Just " Mixed x 4"
156− , classifyBenchmark =
157− fmap ("Streamly",) . stripPrefix "serially/mixedX4/"
158− }
159−
160− ignoringErr $ graph inputFile "iterated"
161− $ cfg
162− { title = Just "iterate 10,000 times over 10 elems"
163− , classifyBenchmark =
164− fmap ("Streamly",) . stripPrefix "serially/iterated/"
165− }
166−
167−------------------------------------------------------------------------------
168−-- Stream type based comparison charts
169−------------------------------------------------------------------------------
170−
171−makeStreamComparisonGraphs :: String -> [String] -> Config -> String -> IO ()
172−makeStreamComparisonGraphs outputPrefix benchPrefixes cfg inputFile =
173− ignoringErr $ graph inputFile outputPrefix $ cfg
174− { presentation = Groups Absolute
175− , classifyBenchmark = classifyNested
176− , selectGroups = \gs ->
177− groupBy ((==) `on` snd) gs
178− & fmap (\xs -> mapMaybe (\x -> (x,) <$> lookup x xs) benchPrefixes)
179− & concat
180− }
181−
182− where
183−
184− classifyNested b
185− | "serially/" `isPrefixOf` b =
186− ("serially",) <$> stripPrefix "serially/" b
187− | "asyncly/" `isPrefixOf` b =
188− ("asyncly",) <$> stripPrefix "asyncly/" b
189− | "wAsyncly/" `isPrefixOf` b =
190− ("wAsyncly",) <$> stripPrefix "wAsyncly/" b
191− | "aheadly/" `isPrefixOf` b =
192− ("aheadly",) <$> stripPrefix "aheadly/" b
193− | "parallely/" `isPrefixOf` b =
194− ("parallely",) <$> stripPrefix "parallely/" b
195− | otherwise = Nothing
196−
197−linearAsyncPrefixes = ["asyncly", "wAsyncly", "aheadly", "parallely"]
198−nestedBenchPrefixes = ["serially"] ++ linearAsyncPrefixes
199−
200------------------------------------------------------------------------------
90------------------------------------------------------------------------------
201-- Generic
91-- Generic
202------------------------------------------------------------------------------
92------------------------------------------------------------------------------
@@ -209,6 +99,7 @@ makeGraphs name cfg@Config{..} inputFile =
209-- Arrays
99-- Arrays
210------------------------------------------------------------------------------
100------------------------------------------------------------------------------
211
101
102+showComparisons :: Options -> Config -> FilePath -> FilePath -> IO ()
212showComparisons Options{..} cfg inp out =
103showComparisons Options{..} cfg inp out =
213 let cfg1 = cfg { classifyBenchmark = classifyComparison }
104 let cfg1 = cfg { classifyBenchmark = classifyComparison }
214 in if genGraphs
105 in if genGraphs
@@ -222,7 +113,7 @@ showComparisons Options{..} cfg inp out =
222
113
223 dropComponent = dropWhile (== '/') . dropWhile (/= '/')
114 dropComponent = dropWhile (== '/') . dropWhile (/= '/')
224
115
225− classifyComparison b = Just $
116+ classifyComparison b = Just
226 ( takeWhile (/= '/') b
117 ( takeWhile (/= '/') b
227 , dropComponent b
118 , dropComponent b
228 )
119 )
@@ -242,6 +133,13 @@ selectBench f =
242 (sortOn snd)
133 (sortOn snd)
243 $ f (ColumnIndex 1) (Just PercentDiff)
134 $ f (ColumnIndex 1) (Just PercentDiff)
244
135
136+benchShow ::
137+ Options
138+ -> Config
139+ -> (Config -> String -> IO ())
140+ -> String
141+ -> FilePath
142+ -> IO ()
245benchShow Options{..} cfg func inp out =
143benchShow Options{..} cfg func inp out =
246 if genGraphs
144 if genGraphs
247 then func cfg {outputDir = Just out} inp
145 then func cfg {outputDir = Just out} inp
@@ -256,7 +154,7 @@ main = do
256 ( flip elem ["time" , "mean"
154 ( flip elem ["time" , "mean"
257 , "maxrss", "cputime"
155 , "maxrss", "cputime"
258 ]
156 ]
259− . map toLower
157+ . fmap toLower
260 )
158 )
261 }
159 }
262 res <- parseOptions
160 res <- parseOptions
@@ -267,52 +165,16 @@ main = do
267 return ()
165 return ()
268 Just opts@Options{..} ->
166 Just opts@Options{..} ->
269 case benchType of
167 case benchType of
270− Linear -> benchShow opts cfg
168+ Just (Compare str) ->
271− { title = Just "Linear" }
272− makeLinearGraphs
273− "charts/linear/results.csv"
274− "charts/linear"
275− LinearRate -> benchShow opts cfg
276− { title = Just "Linear Rate" }
277− (makeGraphs "linear-rate")
278− "charts/linear-rate/results.csv"
279− "charts/linear-rate"
280− LinearAsync -> benchShow opts cfg
281− { title = Just "Linear Async" }
282− (makeStreamComparisonGraphs "linear-async" linearAsyncPrefixes)
283− "charts/linear-async/results.csv"
284− "charts/linear-async"
285− NestedConcurrent -> benchShow opts cfg
286− { title = Just "Nested concurrent loops" }
287− (makeStreamComparisonGraphs "nested-concurrent" nestedBenchPrefixes)
288− "charts/nested-concurrent/results.csv"
289− "charts/nested-concurrent"
290− FileIO -> benchShow opts cfg
291− { title = Just "File IO" }
292− (makeGraphs "fileIO")
293− "charts/fileio/results.csv"
294− "charts/fileio"
295− Concurrent -> benchShow opts cfg
296− { title = Just "Concurrent Ops" }
297− (makeGraphs "Concurrent")
298− "charts/concurrent/results.csv"
299− "charts/concurrent"
300− Parallel -> benchShow opts cfg
301− { title = Just "Parallel" }
302− (makeGraphs "parallel")
303− "charts/parallel/results.csv"
304− "charts/parallel"
305− Adaptive -> benchShow opts cfg
306− { title = Just "Adaptive" }
307− (makeGraphs "adaptive")
308− "charts/adaptive/results.csv"
309− "charts/adaptive"
310− Compare str -> showComparisons opts cfg
169+ showComparisons opts cfg
311− { title = Just $ str }
170+ { title = Just str }
312− ("charts/" ++ str ++ "/results.csv")
171+ ("charts/" ++ str ++ "/results.csv")
313− ("charts/" ++ str)
172+ ("charts/" ++ str)
173+ Just (Standard str) ->
314− Standard str -> benchShow opts cfg
174+ benchShow opts cfg
315− { title = Just str }
175+ { title = Just str }
316− (makeGraphs str)
176+ (makeGraphs str)
317− ("charts/" ++ str ++ "/results.csv")
177+ ("charts/" ++ str ++ "/results.csv")
318− ("charts/" ++ str)
178+ ("charts/" ++ str)
179+ Nothing ->
180+ error "Please specify a benchmark using --benchmark."
benchmark/Streamly/Benchmark/Prelude/Ahead.hsnew file+122
@@ -0,0 +1,122 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2018 Harendra Kumar
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+import Prelude hiding (mapM)
9+
10+import Streamly (aheadly, ahead, maxBuffer, maxThreads)
11+
12+import Streamly.Benchmark.Common
13+import Streamly.Benchmark.Prelude
14+
15+import Gauge
16+
17+moduleName :: String
18+moduleName = "Prelude.Ahead"
19+
20+-------------------------------------------------------------------------------
21+-- Benchmark groups
22+-------------------------------------------------------------------------------
23+
24+-- unfoldr and fromFoldable are always serial and therefore the same for
25+-- all stream types. They can be removed to reduce the number of benchmarks.
26+o_1_space_generation :: Int -> [Benchmark]
27+o_1_space_generation value =
28+ [ bgroup "generation"
29+ [ benchIOSrc aheadly "unfoldr" (sourceUnfoldr value)
30+ , benchIOSrc aheadly "unfoldrM" (sourceUnfoldrM value)
31+ -- , benchIOSrc aheadly "fromFoldable" (sourceFromFoldable value)
32+ , benchIOSrc aheadly "fromFoldableM" (sourceFromFoldableM value)
33+ , benchIOSrc aheadly "unfoldrM maxThreads 1"
34+ (maxThreads 1 . sourceUnfoldrM value)
35+ , benchIOSrc aheadly "unfoldrM maxBuffer 1 (x/10 ops)"
36+ (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
37+ ]
38+ ]
39+
40+o_1_space_mapping :: Int -> [Benchmark]
41+o_1_space_mapping value =
42+ [ bgroup "mapping"
43+ [ benchIOSink value "map" $ mapN aheadly 1
44+ , benchIOSink value "fmap" $ fmapN aheadly 1
45+ , benchIOSink value "mapM" $ mapM aheadly 1
46+ ]
47+ ]
48+
49+o_1_space_concatFoldable :: Int -> [Benchmark]
50+o_1_space_concatFoldable value =
51+ [ bgroup
52+ "concat-foldable"
53+ [ benchIOSrc aheadly "foldMapWith" (sourceFoldMapWith value)
54+ , benchIOSrc aheadly "foldMapWithM" (sourceFoldMapWithM value)
55+ , benchIOSrc aheadly "foldMapM" (sourceFoldMapM value)
56+ ]
57+ ]
58+
59+o_1_space_concatMap :: Int -> [Benchmark]
60+o_1_space_concatMap value =
61+ value2 `seq`
62+ [ bgroup "concat"
63+ [ benchIO "concatMapWith (2,x/2)"
64+ (concatStreamsWith ahead 2 (value `div` 2))
65+ , benchIO "concatMapWith (sqrt x,sqrt x)"
66+ (concatStreamsWith ahead value2 value2)
67+ , benchIO "concatMapWith (sqrt x * 2,sqrt x / 2)"
68+ (concatStreamsWith ahead (value2 * 2) (value2 `div` 2))
69+ ]
70+ ]
71+
72+ where
73+
74+ value2 = round $ sqrt (fromIntegral value :: Double)
75+
76+-------------------------------------------------------------------------------
77+-- Monadic outer product
78+-------------------------------------------------------------------------------
79+
80+o_1_space_outerProduct :: Int -> [Benchmark]
81+o_1_space_outerProduct value =
82+ [ bgroup "monad-outer-product"
83+ [ benchIO "toNullAp" $ toNullAp value aheadly
84+ , benchIO "toNull" $ toNullM value aheadly
85+ , benchIO "toNull3" $ toNullM3 value aheadly
86+ , benchIO "filterAllOut" $ filterAllOutM value aheadly
87+ , benchIO "filterAllIn" $ filterAllInM value aheadly
88+ , benchIO "filterSome" $ filterSome value aheadly
89+ , benchIO "breakAfterSome" $ breakAfterSome value aheadly
90+
91+ ]
92+ ]
93+
94+o_n_space_outerProduct :: Int -> [Benchmark]
95+o_n_space_outerProduct value =
96+ [ bgroup "monad-outer-product"
97+ [ benchIO "toList" $ toListM value aheadly
98+ , benchIO "toListSome" $ toListSome value aheadly
99+ ]
100+ ]
101+
102+-------------------------------------------------------------------------------
103+-- Main
104+-------------------------------------------------------------------------------
105+
106+main :: IO ()
107+main = do
108+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
109+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
110+
111+ where
112+
113+ allBenchmarks value =
114+ [ bgroup (o_1_space_prefix moduleName) $ concat
115+ [ o_1_space_generation value
116+ , o_1_space_mapping value
117+ , o_1_space_concatFoldable value
118+ , o_1_space_concatMap value
119+ , o_1_space_outerProduct value
120+ ]
121+ , bgroup (o_n_space_prefix moduleName) (o_n_space_outerProduct value)
122+ ]
benchmark/Streamly/Benchmark/Prelude/Async.hsnew file+127
@@ -0,0 +1,127 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2018 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+import Prelude hiding (mapM)
9+
10+import Streamly (asyncly, async, maxBuffer, maxThreads)
11+
12+import Streamly.Benchmark.Common
13+import Streamly.Benchmark.Prelude
14+
15+import Gauge
16+
17+moduleName :: String
18+moduleName = "Prelude.Async"
19+
20+-------------------------------------------------------------------------------
21+-- Generation
22+-------------------------------------------------------------------------------
23+
24+o_1_space_generation :: Int -> [Benchmark]
25+o_1_space_generation value =
26+ [ bgroup "generation"
27+ [ benchIOSrc asyncly "unfoldr" (sourceUnfoldr value)
28+ , benchIOSrc asyncly "unfoldrM" (sourceUnfoldrM value)
29+ , benchIOSrc asyncly "fromFoldable" (sourceFromFoldable value)
30+ , benchIOSrc asyncly "fromFoldableM" (sourceFromFoldableM value)
31+ , benchIOSrc asyncly "unfoldrM maxThreads 1"
32+ (maxThreads 1 . sourceUnfoldrM value)
33+ , benchIOSrc asyncly "unfoldrM maxBuffer 1 (x/10 ops)"
34+ (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
35+ ]
36+ ]
37+
38+-------------------------------------------------------------------------------
39+-- Mapping
40+-------------------------------------------------------------------------------
41+
42+o_1_space_mapping :: Int -> [Benchmark]
43+o_1_space_mapping value =
44+ [ bgroup "mapping"
45+ [ benchIOSink value "map" $ mapN asyncly 1
46+ , benchIOSink value "fmap" $ fmapN asyncly 1
47+ , benchIOSink value "mapM" $ mapM asyncly 1
48+ ]
49+ ]
50+
51+-------------------------------------------------------------------------------
52+-- Concat
53+-------------------------------------------------------------------------------
54+
55+o_1_space_concatFoldable :: Int -> [Benchmark]
56+o_1_space_concatFoldable value =
57+ [ bgroup "concat-foldable"
58+ [ benchIOSrc asyncly "foldMapWith" (sourceFoldMapWith value)
59+ , benchIOSrc asyncly "foldMapWithM" (sourceFoldMapWithM value)
60+ , benchIOSrc asyncly "foldMapM" (sourceFoldMapM value)
61+ ]
62+ ]
63+
64+o_1_space_concatMap :: Int -> [Benchmark]
65+o_1_space_concatMap value =
66+ value2 `seq`
67+ [ bgroup "concatMap"
68+ [ benchIO "concatMapWith (2,x/2)"
69+ (concatStreamsWith async 2 (value `div` 2))
70+ , benchIO "concatMapWith (sqrt x,sqrt x)"
71+ (concatStreamsWith async value2 value2)
72+ , benchIO "concatMapWith (sqrt x * 2,sqrt x / 2)"
73+ (concatStreamsWith async (value2 * 2) (value2 `div` 2))
74+ ]
75+ ]
76+
77+ where
78+
79+ value2 = round $ sqrt (fromIntegral value :: Double)
80+
81+-------------------------------------------------------------------------------
82+-- Monadic outer product
83+-------------------------------------------------------------------------------
84+
85+o_1_space_outerProduct :: Int -> [Benchmark]
86+o_1_space_outerProduct value =
87+ [ bgroup "monad-outer-product"
88+ [ benchIO "toNullAp" $ toNullAp value asyncly
89+ , benchIO "toNull" $ toNullM value asyncly
90+ , benchIO "toNull3" $ toNullM3 value asyncly
91+ , benchIO "filterAllOut" $ filterAllOutM value asyncly
92+ , benchIO "filterAllIn" $ filterAllInM value asyncly
93+ , benchIO "filterSome" $ filterSome value asyncly
94+ , benchIO "breakAfterSome" $ breakAfterSome value asyncly
95+
96+ ]
97+ ]
98+
99+o_n_space_outerProduct :: Int -> [Benchmark]
100+o_n_space_outerProduct value =
101+ [ bgroup "monad-outer-product"
102+ [ benchIO "toList" $ toListM value asyncly
103+ , benchIO "toListSome" $ toListSome value asyncly
104+ ]
105+ ]
106+
107+-------------------------------------------------------------------------------
108+-- Main
109+-------------------------------------------------------------------------------
110+
111+main :: IO ()
112+main = do
113+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
114+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
115+
116+ where
117+
118+ allBenchmarks value =
119+ [ bgroup (o_1_space_prefix moduleName) $ concat
120+ [ o_1_space_generation value
121+ , o_1_space_mapping value
122+ , o_1_space_concatFoldable value
123+ , o_1_space_concatMap value
124+ , o_1_space_outerProduct value
125+ ]
126+ , bgroup (o_n_space_prefix moduleName) (o_n_space_outerProduct value)
127+ ]
benchmark/Streamly/Benchmark/Prelude/Concurrent.hs+4−5
@@ -1,7 +1,7 @@
1{-# LANGUAGE RankNTypes #-}
1{-# LANGUAGE RankNTypes #-}
2-- |
2-- |
3-- Module : Main
3-- Module : Main
4−-- Copyright : (c) 2018 Harendra Kumar
4+-- Copyright : (c) 2018 Composewell Technologies
5--
5--
6-- License : BSD3
6-- License : BSD3
7-- Maintainer : streamly@composewell.com
7-- Maintainer : streamly@composewell.com
@@ -30,7 +30,7 @@ append buflen tcount d t =
30 $ t
30 $ t
31 $ maxBuffer buflen
31 $ maxBuffer buflen
32 $ maxThreads (-1)
32 $ maxThreads (-1)
33− $ S.fromFoldableM $ map work [1..tcount]
33+ $ S.fromFoldableM $ fmap work [1..tcount]
34
34
35-- | Run @threads@ concurrently, each producing streams of @elems@ elements
35-- | Run @threads@ concurrently, each producing streams of @elems@ elements
36-- with a delay of @d@ microseconds between successive elements, and merge
36-- with a delay of @d@ microseconds between successive elements, and merge
@@ -46,8 +46,7 @@ concated
46 -> (forall a. SerialT IO a -> SerialT IO a -> SerialT IO a)
46 -> (forall a. SerialT IO a -> SerialT IO a -> SerialT IO a)
47 -> IO ()
47 -> IO ()
48concated buflen threads d elems t =
48concated buflen threads d elems t =
49− let work = \i -> S.replicateM i
50− ((when (d /= 0) (threadDelay d)) >> return i)
49+ let work = \i -> S.replicateM i (when (d /= 0) (threadDelay d) >> return i)
51 in S.drain
50 in S.drain
52 $ adapt
51 $ adapt
53 $ maxThreads (-1)
52 $ maxThreads (-1)
@@ -74,7 +73,7 @@ concatGroup buflen threads delay n =
74 ]
73 ]
75
74
76main :: IO ()
75main :: IO ()
77−main = do
76+main =
78 defaultMainWith (defaultConfig
77 defaultMainWith (defaultConfig
79 { timeLimit = Just 0
78 { timeLimit = Just 0
80 , minSamples = Just 1
79 , minSamples = Just 1
benchmark/Streamly/Benchmark/Prelude/LinearAsync.hsdeleted−46
@@ -1,46 +0,0 @@
1−-- |
2−-- Module : Main
3−-- Copyright : (c) 2018 Harendra Kumar
4−--
5−-- License : BSD3
6−-- Maintainer : streamly@composewell.com
7−
8−import Streamly.Benchmark.Common
9−import Streamly.Benchmark.Prelude
10−
11−import Gauge
12−
13−main :: IO ()
14−main = do
15− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
16− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
17− where
18− allBenchmarks value =
19− concat
20− [ async value
21− , wAsync value
22− , ahead value
23− , zipAsync value
24− ]
25− async value =
26− concat
27− [ o_1_space_async_generation value
28− , o_1_space_async_concatFoldable value
29− , o_1_space_async_concatMap value
30− , o_1_space_async_transformation value
31− ]
32− wAsync value =
33− concat
34− [ o_1_space_wAsync_generation value
35− , o_1_space_wAsync_concatFoldable value
36− , o_1_space_wAsync_concatMap value
37− , o_1_space_wAsync_transformation value
38− ]
39− ahead value =
40− concat
41− [ o_1_space_ahead_generation value
42− , o_1_space_ahead_concatFoldable value
43− , o_1_space_ahead_concatMap value
44− , o_1_space_ahead_transformation value
45− ]
46− zipAsync = o_1_space_async_zip
benchmark/Streamly/Benchmark/Prelude/LinearRate.hsdeleted−24
@@ -1,24 +0,0 @@
1−-- |
2−-- Module : Main
3−-- Copyright : (c) 2018 Harendra Kumar
4−--
5−-- License : BSD3
6−-- Maintainer : streamly@composewell.com
7−
8−import Streamly.Benchmark.Common
9−import Streamly.Benchmark.Prelude
10−
11−import Gauge
12−
13−main :: IO ()
14−main = do
15− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
16− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
17−
18− where
19−
20− allBenchmarks value =
21− concat
22− [ o_1_space_async_avgRate value
23− , o_1_space_ahead_avgRate value
24− ]
benchmark/Streamly/Benchmark/Prelude/NestedConcurrent.hsdeleted−84
@@ -1,84 +0,0 @@
1−-- |
2−-- Module : Main
3−-- Copyright : (c) 2018 Harendra Kumar
4−--
5−-- License : BSD3
6−-- Maintainer : streamly@composewell.com
7−
8−import Control.DeepSeq (NFData)
9−import Control.Monad (when)
10−import Data.Functor.Identity (Identity, runIdentity)
11−import System.Random (randomRIO)
12−
13−import Streamly.Benchmark.Common (parseCLIOpts)
14−
15−import Streamly
16−import Gauge
17−
18−import qualified Streamly.Benchmark.Prelude.NestedOps as Ops
19−
20−benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
21−benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
22−
23−_benchId :: (NFData b) => String -> (Int -> Identity b) -> Benchmark
24−_benchId name f = bench name $ nf (\g -> runIdentity (g 1)) f
25−
26−defaultStreamSize :: Int
27−defaultStreamSize = 100000
28−
29−main :: IO ()
30−main = do
31− -- XXX Fix indentation
32− (linearCount, cfg, benches) <- parseCLIOpts defaultStreamSize
33− let finiteCount = min linearCount defaultStreamSize
34− when (finiteCount /= linearCount) $
35− putStrLn $ "Limiting stream size to "
36− ++ show defaultStreamSize
37− ++ " for finite stream operations only"
38−
39− finiteCount `seq` linearCount `seq` runMode (mode cfg) cfg benches
40− [
41− bgroup "aheadly"
42− [ benchIO "toNullAp" $ Ops.toNullAp linearCount aheadly
43− , benchIO "toNull" $ Ops.toNull linearCount aheadly
44− , benchIO "toNull3" $ Ops.toNull3 linearCount aheadly
45− -- , benchIO "toList" $ Ops.toList linearCount aheadly
46− -- XXX consumes too much stack space
47− , benchIO "toListSome" $ Ops.toListSome linearCount aheadly
48− , benchIO "filterAllOut" $ Ops.filterAllOut linearCount aheadly
49− , benchIO "filterAllIn" $ Ops.filterAllIn linearCount aheadly
50− , benchIO "filterSome" $ Ops.filterSome linearCount aheadly
51− , benchIO "breakAfterSome" $ Ops.breakAfterSome linearCount aheadly
52− ]
53−
54− , bgroup "asyncly"
55− [ benchIO "toNullAp" $ Ops.toNullAp linearCount asyncly
56− , benchIO "toNull" $ Ops.toNull linearCount asyncly
57− , benchIO "toNull3" $ Ops.toNull3 linearCount asyncly
58− -- , benchIO "toList" $ Ops.toList linearCount asyncly
59− , benchIO "toListSome" $ Ops.toListSome linearCount asyncly
60− , benchIO "filterAllOut" $ Ops.filterAllOut linearCount asyncly
61− , benchIO "filterAllIn" $ Ops.filterAllIn linearCount asyncly
62− , benchIO "filterSome" $ Ops.filterSome linearCount asyncly
63− , benchIO "breakAfterSome" $ Ops.breakAfterSome linearCount asyncly
64− ]
65−
66− , bgroup "zipAsyncly"
67− [ benchIO "toNullAp" $ Ops.toNullAp linearCount zipAsyncly
68− ]
69−
70− -- Operations that are not scalable to infinite streams
71− , bgroup "finite"
72− [ bgroup "wAsyncly"
73− [ benchIO "toNullAp" $ Ops.toNullAp finiteCount wAsyncly
74− , benchIO "toNull" $ Ops.toNull finiteCount wAsyncly
75− , benchIO "toNull3" $ Ops.toNull3 finiteCount wAsyncly
76− -- , benchIO "toList" $ Ops.toList finiteCount wAsyncly
77− , benchIO "toListSome" $ Ops.toListSome finiteCount wAsyncly
78− , benchIO "filterAllOut" $ Ops.filterAllOut finiteCount wAsyncly
79− -- , benchIO "filterAllIn" $ Ops.filterAllIn finiteCount wAsyncly
80− , benchIO "filterSome" $ Ops.filterSome finiteCount wAsyncly
81− , benchIO "breakAfterSome" $ Ops.breakAfterSome finiteCount wAsyncly
82− ]
83− ]
84− ]
benchmark/Streamly/Benchmark/Prelude/NestedOps.hsdeleted−174
@@ -1,174 +0,0 @@
1−-- |
2−-- Module : BenchmarkOps
3−-- Copyright : (c) 2018 Harendra Kumar
4−--
5−-- License : MIT
6−-- Maintainer : streamly@composewell.com
7−
8−{-# LANGUAGE CPP #-}
9−{-# LANGUAGE FlexibleContexts #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−
12−module Streamly.Benchmark.Prelude.NestedOps where
13−
14−import Control.Exception (try)
15−import GHC.Exception (ErrorCall)
16−
17−import qualified Streamly as S hiding (runStream)
18−import qualified Streamly.Prelude as S
19−
20−-------------------------------------------------------------------------------
21−-- Stream generation and elimination
22−-------------------------------------------------------------------------------
23−
24−type Stream m a = S.SerialT m a
25−
26−{-# INLINE source #-}
27−source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
28−source = sourceUnfoldrM
29−
30−-- Change this to "sourceUnfoldrM value n" for consistency
31−{-# INLINE sourceUnfoldrM #-}
32−sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
33−sourceUnfoldrM n value = S.serially $ S.unfoldrM step n
34− where
35− step cnt =
36− if cnt > n + value
37− then return Nothing
38− else return (Just (cnt, cnt + 1))
39−
40−{-# INLINE sourceUnfoldr #-}
41−sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
42−sourceUnfoldr start n = S.unfoldr step start
43− where
44− step cnt =
45− if cnt > start + n
46− then Nothing
47− else Just (cnt, cnt + 1)
48−
49−{-# INLINE runStream #-}
50−runStream :: Monad m => Stream m a -> m ()
51−runStream = S.drain
52−
53−{-# INLINE runToList #-}
54−runToList :: Monad m => Stream m a -> m [a]
55−runToList = S.toList
56−
57−-------------------------------------------------------------------------------
58−-- Benchmark ops
59−-------------------------------------------------------------------------------
60−
61−{-# INLINE toNullAp #-}
62−toNullAp
63− :: (S.IsStream t, S.MonadAsync m, Applicative (t m))
64− => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
65−toNullAp linearCount t start = runStream . t $
66− (+) <$> source start nestedCount2 <*> source start nestedCount2
67− where
68− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
69−
70−{-# INLINE toNull #-}
71−toNull
72− :: (S.IsStream t, S.MonadAsync m, Monad (t m))
73− => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
74−toNull linearCount t start = runStream . t $ do
75− x <- source start nestedCount2
76− y <- source start nestedCount2
77− return $ x + y
78− where
79− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
80−
81−{-# INLINE toNull3 #-}
82−toNull3
83− :: (S.IsStream t, S.MonadAsync m, Monad (t m))
84− => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
85−toNull3 linearCount t start = runStream . t $ do
86− x <- source start nestedCount3
87− y <- source start nestedCount3
88− z <- source start nestedCount3
89− return $ x + y + z
90− where
91− nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
92−
93−{-# INLINE toList #-}
94−toList
95− :: (S.IsStream t, S.MonadAsync m, Monad (t m))
96− => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
97−toList linearCount t start = runToList . t $ do
98− x <- source start nestedCount2
99− y <- source start nestedCount2
100− return $ x + y
101− where
102− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
103−
104−-- Taking a specified number of elements is very expensive in logict so we have
105−-- a test to measure the same.
106−{-# INLINE toListSome #-}
107−toListSome
108− :: (S.IsStream t, S.MonadAsync m, Monad (t m))
109− => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
110−toListSome linearCount t start =
111− runToList . t $ S.take 10000 $ do
112− x <- source start nestedCount2
113− y <- source start nestedCount2
114− return $ x + y
115− where
116− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
117−
118−{-# INLINE filterAllOut #-}
119−filterAllOut
120− :: (S.IsStream t, S.MonadAsync m, Monad (t m))
121− => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
122−filterAllOut linearCount t start = runStream . t $ do
123− x <- source start nestedCount2
124− y <- source start nestedCount2
125− let s = x + y
126− if s < 0
127− then return s
128− else S.nil
129− where
130− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
131−
132−{-# INLINE filterAllIn #-}
133−filterAllIn
134− :: (S.IsStream t, S.MonadAsync m, Monad (t m))
135− => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
136−filterAllIn linearCount t start = runStream . t $ do
137− x <- source start nestedCount2
138− y <- source start nestedCount2
139− let s = x + y
140− if s > 0
141− then return s
142− else S.nil
143− where
144− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
145−
146−{-# INLINE filterSome #-}
147−filterSome
148− :: (S.IsStream t, S.MonadAsync m, Monad (t m))
149− => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
150−filterSome linearCount t start = runStream . t $ do
151− x <- source start nestedCount2
152− y <- source start nestedCount2
153− let s = x + y
154− if s > 1100000
155− then return s
156− else S.nil
157− where
158− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
159−
160−{-# INLINE breakAfterSome #-}
161−breakAfterSome
162− :: (S.IsStream t, Monad (t IO))
163− => Int -> (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
164−breakAfterSome linearCount t start = do
165− (_ :: Either ErrorCall ()) <- try $ runStream . t $ do
166− x <- source start nestedCount2
167− y <- source start nestedCount2
168− let s = x + y
169− if s > 1100000
170− then error "break"
171− else return s
172− return ()
173− where
174− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
benchmark/Streamly/Benchmark/Prelude/Parallel.hs+177−15
@@ -1,15 +1,182 @@
1-- |
1-- |
2-- Module : Main
2-- Module : Main
3−-- Copyright : (c) 2018 Harendra Kumar
3+-- Copyright : (c) 2018 Composewell Technologies
4--
4--
5-- License : BSD3
5-- License : BSD3
6-- Maintainer : streamly@composewell.com
6-- Maintainer : streamly@composewell.com
7
7
8+{-# LANGUAGE FlexibleContexts #-}
9+
10+import Prelude hiding (mapM)
11+
12+import Streamly (SerialT, parallely, parallel, serially, maxBuffer, maxThreads)
13+
14+import qualified Streamly as S
15+import qualified Streamly.Prelude as S
16+import qualified Streamly.Internal.Data.Fold as FL
17+import qualified Streamly.Internal.Data.Stream.Parallel as Par
18+import qualified Streamly.Internal.Prelude as Internal
19+
8import Streamly.Benchmark.Common
20import Streamly.Benchmark.Common
9import Streamly.Benchmark.Prelude
21import Streamly.Benchmark.Prelude
10
22
11import Gauge
23import Gauge
12
24
25+moduleName :: String
26+moduleName = "Prelude.Parallel"
27+
28+-------------------------------------------------------------------------------
29+-- Merging
30+-------------------------------------------------------------------------------
31+
32+{-# INLINE mergeAsyncByM #-}
33+mergeAsyncByM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
34+mergeAsyncByM count n =
35+ S.mergeAsyncByM
36+ (\a b -> return (a `compare` b))
37+ (sourceUnfoldrMN count n)
38+ (sourceUnfoldrMN count (n + 1))
39+
40+{-# INLINE mergeAsyncBy #-}
41+mergeAsyncBy :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
42+mergeAsyncBy count n =
43+ S.mergeAsyncBy
44+ compare
45+ (sourceUnfoldrMN count n)
46+ (sourceUnfoldrMN count (n + 1))
47+
48+-------------------------------------------------------------------------------
49+-- Application/fold
50+-------------------------------------------------------------------------------
51+
52+{-# INLINE parAppMap #-}
53+parAppMap :: S.MonadAsync m => SerialT m Int -> m ()
54+parAppMap src = S.drain $ S.map (+1) S.|$ src
55+
56+{-# INLINE parAppSum #-}
57+parAppSum :: S.MonadAsync m => SerialT m Int -> m ()
58+parAppSum src = (S.sum S.|$. src) >>= \x -> seq x (return ())
59+
60+-------------------------------------------------------------------------------
61+-- Tapping
62+-------------------------------------------------------------------------------
63+
64+{-# INLINE tapAsyncS #-}
65+tapAsyncS :: S.MonadAsync m => Int -> SerialT m Int -> m ()
66+tapAsyncS n = composeN n $ Par.tapAsync S.sum
67+
68+{-# INLINE tapAsync #-}
69+tapAsync :: S.MonadAsync m => Int -> SerialT m Int -> m ()
70+tapAsync n = composeN n $ Internal.tapAsync FL.sum
71+
72+o_1_space_merge_app_tap :: Int -> [Benchmark]
73+o_1_space_merge_app_tap value =
74+ [ bgroup "merge-app-tap"
75+ [ benchIOSrc serially "mergeAsyncBy (2,x/2)"
76+ (mergeAsyncBy (value `div` 2))
77+ , benchIOSrc serially "mergeAsyncByM (2,x/2)"
78+ (mergeAsyncByM (value `div` 2))
79+ -- Parallel stages in a pipeline
80+ , benchIOSink value "parAppMap" parAppMap
81+ , benchIOSink value "parAppSum" parAppSum
82+ , benchIOSink value "tapAsync" (tapAsync 1)
83+ , benchIOSink value "tapAsyncS" (tapAsyncS 1)
84+ ]
85+ ]
86+
87+-------------------------------------------------------------------------------
88+-- Generation
89+-------------------------------------------------------------------------------
90+
91+o_n_heap_generation :: Int -> [Benchmark]
92+o_n_heap_generation value =
93+ [ bgroup
94+ "generation"
95+ [ benchIOSrc parallely "unfoldr" (sourceUnfoldr value)
96+ , benchIOSrc parallely "unfoldrM" (sourceUnfoldrM value)
97+ , benchIOSrc parallely "fromFoldable" (sourceFromFoldable value)
98+ , benchIOSrc parallely "fromFoldableM" (sourceFromFoldableM value)
99+ , benchIOSrc parallely "unfoldrM maxThreads 1"
100+ (maxThreads 1 . sourceUnfoldrM value)
101+ , benchIOSrc parallely "unfoldrM maxBuffer 1 (x/10 ops)"
102+ (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
103+ ]
104+ ]
105+
106+-------------------------------------------------------------------------------
107+-- Mapping
108+-------------------------------------------------------------------------------
109+
110+o_n_heap_mapping :: Int -> [Benchmark]
111+o_n_heap_mapping value =
112+ [ bgroup "mapping"
113+ [ benchIOSink value "map" $ mapN parallely 1
114+ , benchIOSink value "fmap" $ fmapN parallely 1
115+ , benchIOSink value "mapM" $ mapM parallely 1
116+ ]
117+ ]
118+
119+-------------------------------------------------------------------------------
120+-- Concat
121+-------------------------------------------------------------------------------
122+
123+o_n_heap_concatFoldable :: Int -> [Benchmark]
124+o_n_heap_concatFoldable value =
125+ [ bgroup
126+ "concat-foldable"
127+ [ benchIOSrc parallely "foldMapWith" (sourceFoldMapWith value)
128+ , benchIOSrc parallely "foldMapWithM" (sourceFoldMapWithM value)
129+ , benchIOSrc parallely "foldMapM" (sourceFoldMapM value)
130+ ]
131+ ]
132+
133+o_n_heap_concat :: Int -> [Benchmark]
134+o_n_heap_concat value =
135+ value2 `seq`
136+ [ bgroup "concat"
137+ [ benchIO "concatMapWith (2,x/2)"
138+ (concatStreamsWith parallel 2 (value `div` 2))
139+ , benchIO "concatMapWith (sqrt x,sqrt x)"
140+ (concatStreamsWith parallel value2 value2)
141+ , benchIO "concatMapWith (sqrt x * 2,sqrt x / 2)"
142+ (concatStreamsWith parallel (value2 * 2) (value2 `div` 2))
143+ ]
144+ ]
145+
146+ where
147+
148+ value2 = round $ sqrt (fromIntegral value :: Double)
149+
150+-------------------------------------------------------------------------------
151+-- Monadic outer product
152+-------------------------------------------------------------------------------
153+
154+o_n_heap_outerProduct :: Int -> [Benchmark]
155+o_n_heap_outerProduct value =
156+ [ bgroup "monad-outer-product"
157+ [ benchIO "toNullAp" $ toNullAp value parallely
158+ , benchIO "toNull" $ toNullM value parallely
159+ , benchIO "toNull3" $ toNullM3 value parallely
160+ , benchIO "filterAllOut" $ filterAllOutM value parallely
161+ , benchIO "filterAllIn" $ filterAllInM value parallely
162+ , benchIO "filterSome" $ filterSome value parallely
163+ , benchIO "breakAfterSome" $ breakAfterSome value parallely
164+ ]
165+ ]
166+
167+o_n_space_outerProduct :: Int -> [Benchmark]
168+o_n_space_outerProduct value =
169+ [ bgroup "monad-outer-product"
170+ [ benchIO "toList" $ toListM value parallely
171+ -- XXX disabled due to a bug for now
172+ -- , benchIO "toListSome" $ toListSome value parallely
173+ ]
174+ ]
175+
176+-------------------------------------------------------------------------------
177+-- Main
178+-------------------------------------------------------------------------------
179+
13main :: IO ()
180main :: IO ()
14main = do
181main = do
15 (value, cfg, benches) <- parseCLIOpts defaultStreamSize
182 (value, cfg, benches) <- parseCLIOpts defaultStreamSize
@@ -18,18 +185,13 @@ main = do
18 where
185 where
19
186
20 allBenchmarks value =
187 allBenchmarks value =
21− concat
188+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_merge_app_tap value)
22− [ linear value
189+ , bgroup (o_n_heap_prefix moduleName) $ concat
23− , nested value
190+ [ o_n_heap_generation value
24− ]
191+ , o_n_heap_mapping value
25−
192+ , o_n_heap_concatFoldable value
26− linear value =
193+ , o_n_heap_concat value
27− concat
194+ , o_n_heap_outerProduct value
28− [ o_n_space_parallel_generation value
29− , o_n_space_parallel_concatFoldable value
30− -- , o_n_space_parallel_outerProductStreams2
31− , o_n_space_parallel_concatMap value
32− , o_n_space_parallel_transformation value
33 ]
195 ]
34−
196+ , bgroup (o_n_space_prefix moduleName) (o_n_space_outerProduct value)
35− nested = o_n_space_parallel_outerProductStreams
197+ ]
benchmark/Streamly/Benchmark/Prelude/Rate.hsnew file+73
@@ -0,0 +1,73 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2018 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+import Streamly (asyncly, aheadly, maxThreads)
9+
10+import qualified Streamly as S
11+
12+import Streamly.Benchmark.Common
13+import Streamly.Benchmark.Prelude
14+
15+import Gauge
16+
17+moduleName :: String
18+moduleName = "Prelude.Rate"
19+
20+-------------------------------------------------------------------------------
21+-- Average Rate
22+-------------------------------------------------------------------------------
23+
24+-- XXX arbitrarily large rate should be the same as rate Nothing
25+o_1_space_async_avgRate :: Int -> [Benchmark]
26+o_1_space_async_avgRate value =
27+ [ bgroup "asyncly"
28+ [ bgroup "avgRate"
29+ -- benchIO "unfoldr" $ toNull asyncly
30+ -- benchIOSrc asyncly "unfoldrM" (sourceUnfoldrM value)
31+ [ benchIOSrc asyncly "unfoldrM/Nothing"
32+ (S.rate Nothing . sourceUnfoldrM value)
33+ , benchIOSrc asyncly "unfoldrM/1,000,000"
34+ (S.avgRate 1000000 . sourceUnfoldrM value)
35+ , benchIOSrc asyncly "unfoldrM/3,000,000"
36+ (S.avgRate 3000000 . sourceUnfoldrM value)
37+ , benchIOSrc asyncly "unfoldrM/10,000,000/maxThreads1"
38+ (maxThreads 1 . S.avgRate 10000000 . sourceUnfoldrM value)
39+ , benchIOSrc asyncly "unfoldrM/10,000,000"
40+ (S.avgRate 10000000 . sourceUnfoldrM value)
41+ , benchIOSrc asyncly "unfoldrM/20,000,000"
42+ (S.avgRate 20000000 . sourceUnfoldrM value)
43+ ]
44+ ]
45+ ]
46+
47+o_1_space_ahead_avgRate :: Int -> [Benchmark]
48+o_1_space_ahead_avgRate value =
49+ [ bgroup "aheadly"
50+ [ bgroup "avgRate"
51+ [ benchIOSrc aheadly "unfoldrM/1,000,000"
52+ (S.avgRate 1000000 . sourceUnfoldrM value)
53+ ]
54+ ]
55+ ]
56+
57+-------------------------------------------------------------------------------
58+-- Main
59+-------------------------------------------------------------------------------
60+
61+main :: IO ()
62+main = do
63+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
64+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
65+
66+ where
67+
68+ allBenchmarks value =
69+ [ bgroup (o_1_space_prefix moduleName) $ concat
70+ [ o_1_space_async_avgRate value
71+ , o_1_space_ahead_avgRate value
72+ ]
73+ ]
benchmark/Streamly/Benchmark/Prelude/Serial.hs+1618−45
@@ -1,14 +1,1573 @@
1-- |
1-- |
2-- Module : Main
2-- Module : Main
3−-- Copyright : (c) 2018 Harendra Kumar
3+-- Copyright : (c) 2018 Composewell Technologies
4--
4--
5-- License : BSD3
5-- License : BSD3
6-- Maintainer : streamly@composewell.com
6-- Maintainer : streamly@composewell.com
7
7
8+{-# LANGUAGE CPP #-}
9+{-# LANGUAGE FlexibleContexts #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE DeriveAnyClass #-}
12+{-# LANGUAGE DeriveGeneric #-}
13+{-# LANGUAGE RankNTypes #-}
14+{-# LANGUAGE TupleSections #-}
15+
16+#ifdef __HADDOCK_VERSION__
17+#undef INSPECTION
18+#endif
19+
20+#ifdef INSPECTION
21+{-# LANGUAGE TemplateHaskell #-}
22+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
23+#endif
24+
25+import Control.DeepSeq (NFData(..))
26+import Control.Monad (when)
27+import Control.Monad.IO.Class (MonadIO(..))
28+import Control.Monad.State.Strict (StateT, get, put)
29+import Data.Functor.Identity (Identity, runIdentity)
30+import Data.IORef (newIORef, modifyIORef')
31+import GHC.Generics (Generic)
32+import System.Random (randomRIO)
33+import Prelude hiding (concatMap, mapM_, init, last, elem, notElem, all, any,
34+ and, or, length, sum, product, maximum, minimum, reverse, fmap, map,
35+ sequence, mapM, tail)
36+
37+import qualified Prelude as P
38+import qualified Data.Foldable as F
39+import qualified GHC.Exts as GHC
40+
41+#ifdef INSPECTION
42+import GHC.Types (SPEC(..))
43+import Test.Inspection
44+
45+import qualified Streamly.Internal.Data.Stream.StreamD as D
46+#endif
47+
48+import qualified Streamly as S
49+import qualified Streamly.Prelude as S
50+import qualified Streamly.Internal.Prelude as Internal
51+import qualified Streamly.Internal.Data.Fold as FL
52+import qualified Streamly.Internal.Data.Unfold as UF
53+
54+import Gauge
55+import Streamly
8import Streamly.Benchmark.Common
56import Streamly.Benchmark.Common
9import Streamly.Benchmark.Prelude
57import Streamly.Benchmark.Prelude
58+import Streamly.Internal.Data.Time.Units
10
59
11−import Gauge
60+moduleName :: String
61+moduleName = "Prelude.Serial"
62+
63+-------------------------------------------------------------------------------
64+-- Generation
65+-------------------------------------------------------------------------------
66+
67+-------------------------------------------------------------------------------
68+-- fromList
69+-------------------------------------------------------------------------------
70+
71+{-# INLINE sourceIsList #-}
72+sourceIsList :: Int -> Int -> SerialT Identity Int
73+sourceIsList value n = GHC.fromList [n..n+value]
74+
75+{-# INLINE sourceIsString #-}
76+sourceIsString :: Int -> Int -> SerialT Identity P.Char
77+sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
78+
79+{-# INLINE readInstance #-}
80+readInstance :: P.String -> SerialT Identity Int
81+readInstance str =
82+ let r = P.reads str
83+ in case r of
84+ [(x,"")] -> x
85+ _ -> P.error "readInstance: no parse"
86+
87+-- For comparisons
88+{-# INLINE readInstanceList #-}
89+readInstanceList :: P.String -> [Int]
90+readInstanceList str =
91+ let r = P.reads str
92+ in case r of
93+ [(x,"")] -> x
94+ _ -> P.error "readInstance: no parse"
95+
96+o_1_space_generation :: Int -> [Benchmark]
97+o_1_space_generation value =
98+ [ bgroup "generation"
99+ [ benchIOSrc serially "unfoldr" (sourceUnfoldr value)
100+ , benchIOSrc serially "unfoldrM" (sourceUnfoldrM value)
101+ , benchIOSrc serially "intFromTo" (sourceIntFromTo value)
102+ , benchIOSrc serially "intFromThenTo" (sourceIntFromThenTo value)
103+ , benchIOSrc serially "integerFromStep" (sourceIntegerFromStep value)
104+ , benchIOSrc serially "fracFromThenTo" (sourceFracFromThenTo value)
105+ , benchIOSrc serially "fracFromTo" (sourceFracFromTo value)
106+ , benchIOSrc serially "fromList" (sourceFromList value)
107+ , benchPureSrc "IsList.fromList" (sourceIsList value)
108+ , benchPureSrc "IsString.fromString" (sourceIsString value)
109+ , benchIOSrc serially "fromListM" (sourceFromListM value)
110+
111+ -- These essentially test cons and consM
112+ , benchIOSrc serially "fromFoldable" (sourceFromFoldable value)
113+ , benchIOSrc serially "fromFoldableM" (sourceFromFoldableM value)
114+
115+ , benchIOSrc serially "absTimes" $ absTimes value
116+ ]
117+ ]
118+
119+o_n_heap_generation :: Int -> [Benchmark]
120+o_n_heap_generation value =
121+ [ bgroup "buffered"
122+ -- Buffers the output of show/read.
123+ -- XXX can the outputs be streaming? Can we have special read/show
124+ -- style type classes, readM/showM supporting streaming effects?
125+ [ bench "readsPrec pure streams" $
126+ nf readInstance (mkString value)
127+ , bench "readsPrec Haskell lists" $
128+ nf readInstanceList (mkListString value)
129+ ]
130+ ]
131+
132+-------------------------------------------------------------------------------
133+-- Elimination
134+-------------------------------------------------------------------------------
135+
136+-------------------------------------------------------------------------------
137+-- Foldable Instance
138+-------------------------------------------------------------------------------
139+
140+{-# INLINE foldableFoldl' #-}
141+foldableFoldl' :: Int -> Int -> Int
142+foldableFoldl' value n =
143+ F.foldl' (+) 0 (sourceUnfoldr value n :: S.SerialT Identity Int)
144+
145+{-# INLINE foldableFoldrElem #-}
146+foldableFoldrElem :: Int -> Int -> Bool
147+foldableFoldrElem value n =
148+ F.foldr (\x xs -> x == value || xs)
149+ P.False
150+ (sourceUnfoldr value n :: S.SerialT Identity Int)
151+
152+{-# INLINE foldableSum #-}
153+foldableSum :: Int -> Int -> Int
154+foldableSum value n =
155+ P.sum (sourceUnfoldr value n :: S.SerialT Identity Int)
156+
157+{-# INLINE foldableProduct #-}
158+foldableProduct :: Int -> Int -> Int
159+foldableProduct value n =
160+ P.product (sourceUnfoldr value n :: S.SerialT Identity Int)
161+
162+{-# INLINE _foldableNull #-}
163+_foldableNull :: Int -> Int -> Bool
164+_foldableNull value n =
165+ P.null (sourceUnfoldr value n :: S.SerialT Identity Int)
166+
167+{-# INLINE foldableElem #-}
168+foldableElem :: Int -> Int -> Bool
169+foldableElem value n =
170+ value `P.elem` (sourceUnfoldr value n :: S.SerialT Identity Int)
171+
172+{-# INLINE foldableNotElem #-}
173+foldableNotElem :: Int -> Int -> Bool
174+foldableNotElem value n =
175+ value `P.notElem` (sourceUnfoldr value n :: S.SerialT Identity Int)
176+
177+{-# INLINE foldableFind #-}
178+foldableFind :: Int -> Int -> Maybe Int
179+foldableFind value n =
180+ F.find (== (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
181+
182+{-# INLINE foldableAll #-}
183+foldableAll :: Int -> Int -> Bool
184+foldableAll value n =
185+ P.all (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
186+
187+{-# INLINE foldableAny #-}
188+foldableAny :: Int -> Int -> Bool
189+foldableAny value n =
190+ P.any (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
191+
192+{-# INLINE foldableAnd #-}
193+foldableAnd :: Int -> Int -> Bool
194+foldableAnd value n =
195+ P.and $ S.map
196+ (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
197+
198+{-# INLINE foldableOr #-}
199+foldableOr :: Int -> Int -> Bool
200+foldableOr value n =
201+ P.or $ S.map
202+ (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
203+
204+{-# INLINE foldableLength #-}
205+foldableLength :: Int -> Int -> Int
206+foldableLength value n =
207+ P.length (sourceUnfoldr value n :: S.SerialT Identity Int)
208+
209+{-# INLINE foldableMin #-}
210+foldableMin :: Int -> Int -> Int
211+foldableMin value n =
212+ P.minimum (sourceUnfoldr value n :: S.SerialT Identity Int)
213+
214+{-# INLINE ordInstanceMin #-}
215+ordInstanceMin :: SerialT Identity Int -> SerialT Identity Int
216+ordInstanceMin src = P.min src src
217+
218+{-# INLINE foldableMax #-}
219+foldableMax :: Int -> Int -> Int
220+foldableMax value n =
221+ P.maximum (sourceUnfoldr value n :: S.SerialT Identity Int)
222+
223+{-# INLINE foldableMinBy #-}
224+foldableMinBy :: Int -> Int -> Int
225+foldableMinBy value n =
226+ F.minimumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
227+
228+{-# INLINE foldableListMinBy #-}
229+foldableListMinBy :: Int -> Int -> Int
230+foldableListMinBy value n = F.minimumBy compare [1..value+n]
231+
232+{-# INLINE foldableMaxBy #-}
233+foldableMaxBy :: Int -> Int -> Int
234+foldableMaxBy value n =
235+ F.maximumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
236+
237+{-# INLINE foldableToList #-}
238+foldableToList :: Int -> Int -> [Int]
239+foldableToList value n =
240+ F.toList (sourceUnfoldr value n :: S.SerialT Identity Int)
241+
242+{-# INLINE foldableMapM_ #-}
243+foldableMapM_ :: Monad m => Int -> Int -> m ()
244+foldableMapM_ value n =
245+ F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: S.SerialT Identity Int)
246+
247+{-# INLINE foldableSequence_ #-}
248+foldableSequence_ :: Int -> Int -> IO ()
249+foldableSequence_ value n =
250+ F.sequence_ (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
251+
252+{-# INLINE foldableMsum #-}
253+foldableMsum :: Int -> Int -> IO Int
254+foldableMsum value n =
255+ F.msum (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
256+
257+{-# INLINE showInstance #-}
258+showInstance :: SerialT Identity Int -> P.String
259+showInstance = P.show
260+
261+o_1_space_elimination_foldable :: Int -> [Benchmark]
262+o_1_space_elimination_foldable value =
263+ [ bgroup "foldable"
264+ -- Foldable instance
265+ [ bench "foldl'" $ nf (foldableFoldl' value) 1
266+ , bench "foldrElem" $ nf (foldableFoldrElem value) 1
267+ -- , bench "null" $ nf (_foldableNull value) 1
268+ , bench "elem" $ nf (foldableElem value) 1
269+ , bench "length" $ nf (foldableLength value) 1
270+ , bench "sum" $ nf (foldableSum value) 1
271+ , bench "product" $ nf (foldableProduct value) 1
272+ , bench "minimum" $ nf (foldableMin value) 1
273+ , benchPureSink value "min (ord)" ordInstanceMin
274+ , bench "maximum" $ nf (foldableMax value) 1
275+ , bench "length . toList" $ nf (P.length . foldableToList value) 1
276+ , bench "notElem" $ nf (foldableNotElem value) 1
277+ , bench "find" $ nf (foldableFind value) 1
278+ , bench "all" $ nf (foldableAll value) 1
279+ , bench "any" $ nf (foldableAny value) 1
280+ , bench "and" $ nf (foldableAnd value) 1
281+ , bench "or" $ nf (foldableOr value) 1
282+
283+ -- Applicative and Traversable operations
284+ -- TBD: traverse_
285+ , benchIOSink1 "mapM_" (foldableMapM_ value)
286+ -- TBD: for_
287+ -- TBD: forM_
288+ , benchIOSink1 "sequence_" (foldableSequence_ value)
289+ -- TBD: sequenceA_
290+ -- TBD: asum
291+ , benchIOSink1 "msum" (foldableMsum value)
292+ ]
293+ ]
294+
295+o_n_space_elimination_foldable :: Int -> [Benchmark]
296+o_n_space_elimination_foldable value =
297+ -- Head recursive strict right folds.
298+ [ bgroup "foldl"
299+ -- XXX the definitions of minimumBy and maximumBy in Data.Foldable use
300+ -- foldl1 which does not work in constant memory for our
301+ -- implementation. It works in constant memory for lists but even for
302+ -- lists it takes 15x more time compared to our foldl' based
303+ -- implementation.
304+ [ bench "minimumBy" $ nf (`foldableMinBy` 1) value
305+ , bench "maximumBy" $ nf (`foldableMaxBy` 1) value
306+ , bench "minimumByList" $ nf (`foldableListMinBy` 1) value
307+ ]
308+ ]
309+
310+-------------------------------------------------------------------------------
311+-- Stream folds
312+-------------------------------------------------------------------------------
313+
314+{-# INLINE benchPureSink #-}
315+benchPureSink :: NFData b
316+ => Int -> String -> (SerialT Identity Int -> b) -> Benchmark
317+benchPureSink value name = benchPure name (sourceUnfoldr value)
318+
319+{-# INLINE benchHoistSink #-}
320+benchHoistSink
321+ :: (IsStream t, NFData b)
322+ => Int -> String -> (t Identity Int -> IO b) -> Benchmark
323+benchHoistSink value name f =
324+ bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
325+
326+-- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but
327+-- we can't use it as it requires MonadAsync constraint.
328+{-# INLINE benchIdentitySink #-}
329+benchIdentitySink
330+ :: (IsStream t, NFData b)
331+ => Int -> String -> (t Identity Int -> Identity b) -> Benchmark
332+benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
333+
334+-------------------------------------------------------------------------------
335+-- Reductions
336+-------------------------------------------------------------------------------
337+
338+{-# INLINE uncons #-}
339+uncons :: Monad m => SerialT m Int -> m ()
340+uncons s = do
341+ r <- S.uncons s
342+ case r of
343+ Nothing -> return ()
344+ Just (_, t) -> uncons t
345+
346+{-# INLINE init #-}
347+init :: Monad m => SerialT m a -> m ()
348+init s = S.init s >>= P.mapM_ S.drain
349+
350+{-# INLINE mapM_ #-}
351+mapM_ :: Monad m => SerialT m Int -> m ()
352+mapM_ = S.mapM_ (\_ -> return ())
353+
354+{-# INLINE foldrMElem #-}
355+foldrMElem :: Monad m => Int -> SerialT m Int -> m Bool
356+foldrMElem e =
357+ S.foldrM
358+ (\x xs ->
359+ if x == e
360+ then return P.True
361+ else xs)
362+ (return P.False)
363+
364+{-# INLINE foldrMToStream #-}
365+foldrMToStream :: Monad m => SerialT m Int -> m (SerialT Identity Int)
366+foldrMToStream = S.foldr S.cons S.nil
367+
368+{-# INLINE foldrMBuild #-}
369+foldrMBuild :: Monad m => SerialT m Int -> m [Int]
370+foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])
371+
372+{-# INLINE foldl'Reduce #-}
373+foldl'Reduce :: Monad m => SerialT m Int -> m Int
374+foldl'Reduce = S.foldl' (+) 0
375+
376+{-# INLINE foldl1'Reduce #-}
377+foldl1'Reduce :: Monad m => SerialT m Int -> m (Maybe Int)
378+foldl1'Reduce = S.foldl1' (+)
379+
380+{-# INLINE foldlM'Reduce #-}
381+foldlM'Reduce :: Monad m => SerialT m Int -> m Int
382+foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) 0
383+
384+{-# INLINE last #-}
385+last :: Monad m => SerialT m Int -> m (Maybe Int)
386+last = S.last
387+
388+{-# INLINE _head #-}
389+_head :: Monad m => SerialT m Int -> m (Maybe Int)
390+_head = S.head
391+
392+{-# INLINE elem #-}
393+elem :: Monad m => Int -> SerialT m Int -> m Bool
394+elem value = S.elem (value + 1)
395+
396+{-# INLINE notElem #-}
397+notElem :: Monad m => Int -> SerialT m Int -> m Bool
398+notElem value = S.notElem (value + 1)
399+
400+{-# INLINE length #-}
401+length :: Monad m => SerialT m Int -> m Int
402+length = S.length
403+
404+{-# INLINE all #-}
405+all :: Monad m => Int -> SerialT m Int -> m Bool
406+all value = S.all (<= (value + 1))
407+
408+{-# INLINE any #-}
409+any :: Monad m => Int -> SerialT m Int -> m Bool
410+any value = S.any (> (value + 1))
411+
412+{-# INLINE and #-}
413+and :: Monad m => Int -> SerialT m Int -> m Bool
414+and value = S.and . S.map (<= (value + 1))
415+
416+{-# INLINE or #-}
417+or :: Monad m => Int -> SerialT m Int -> m Bool
418+or value = S.or . S.map (> (value + 1))
419+
420+{-# INLINE find #-}
421+find :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
422+find value = S.find (== (value + 1))
423+
424+{-# INLINE findIndex #-}
425+findIndex :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
426+findIndex value = S.findIndex (== (value + 1))
427+
428+{-# INLINE elemIndex #-}
429+elemIndex :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
430+elemIndex value = S.elemIndex (value + 1)
431+
432+{-# INLINE maximum #-}
433+maximum :: Monad m => SerialT m Int -> m (Maybe Int)
434+maximum = S.maximum
435+
436+{-# INLINE minimum #-}
437+minimum :: Monad m => SerialT m Int -> m (Maybe Int)
438+minimum = S.minimum
439+
440+{-# INLINE sum #-}
441+sum :: Monad m => SerialT m Int -> m Int
442+sum = S.sum
443+
444+{-# INLINE product #-}
445+product :: Monad m => SerialT m Int -> m Int
446+product = S.product
447+
448+{-# INLINE minimumBy #-}
449+minimumBy :: Monad m => SerialT m Int -> m (Maybe Int)
450+minimumBy = S.minimumBy compare
451+
452+{-# INLINE maximumBy #-}
453+maximumBy :: Monad m => SerialT m Int -> m (Maybe Int)
454+maximumBy = S.maximumBy compare
455+
456+o_1_space_elimination_folds :: Int -> [Benchmark]
457+o_1_space_elimination_folds value =
458+ [ bgroup "elimination"
459+ -- Basic folds
460+ [ bgroup "reduce"
461+ [ bgroup
462+ "IO"
463+ [ benchIOSink value "foldl'" foldl'Reduce
464+ , benchIOSink value "foldl1'" foldl1'Reduce
465+ , benchIOSink value "foldlM'" foldlM'Reduce
466+ ]
467+ , bgroup
468+ "Identity"
469+ [ benchIdentitySink value "foldl'" foldl'Reduce
470+ , benchIdentitySink value "foldl1'" foldl1'Reduce
471+ , benchIdentitySink value "foldlM'" foldlM'Reduce
472+ ]
473+ ]
474+ , bgroup "build"
475+ [ bgroup "IO"
476+ [ benchIOSink value "foldrMElem" (foldrMElem value)
477+ ]
478+ , bgroup "Identity"
479+ [ benchIdentitySink value "foldrMElem" (foldrMElem value)
480+ , benchIdentitySink value "foldrMToStreamLength"
481+ (S.length . runIdentity . foldrMToStream)
482+ , benchPureSink value "foldrMToListLength"
483+ (P.length . runIdentity . foldrMBuild)
484+ ]
485+ ]
486+
487+ -- deconstruction
488+ , benchIOSink value "uncons" uncons
489+ , benchIOSink value "init" init
490+
491+ -- draining
492+ , benchIOSink value "drain" $ toNull serially
493+ , benchPureSink value "drain (pure)" P.id
494+ , benchIOSink value "mapM_" mapM_
495+
496+ -- this is too fast, causes all benchmarks reported in ns
497+ -- , benchIOSink value "head" head
498+ , benchIOSink value "last" last
499+ , benchIOSink value "length" length
500+ , benchHoistSink value "length . generally"
501+ (length . Internal.generally)
502+ , benchIOSink value "sum" sum
503+ , benchIOSink value "product" product
504+ , benchIOSink value "maximumBy" maximumBy
505+ , benchIOSink value "maximum" maximum
506+ , benchIOSink value "minimumBy" minimumBy
507+ , benchIOSink value "minimum" minimum
508+
509+ , benchIOSink value "find" (find value)
510+ -- , benchIOSink value "lookup" lookup
511+ , benchIOSink value "findIndex" (findIndex value)
512+ , benchIOSink value "elemIndex" (elemIndex value)
513+ -- this is too fast, causes all benchmarks reported in ns
514+ -- , benchIOSink value "null" S.null
515+ , benchIOSink value "elem" (elem value)
516+ , benchIOSink value "notElem" (notElem value)
517+ , benchIOSink value "all" (all value)
518+ , benchIOSink value "any" (any value)
519+ , benchIOSink value "and" (and value)
520+ , benchIOSink value "or" (or value)
521+
522+ , benchPureSink value "showsPrec pure streams" showInstance
523+ -- length is used to check for foldr/build fusion
524+ , benchPureSink value "length . IsList.toList" (P.length . GHC.toList)
525+ ]
526+ ]
527+
528+-------------------------------------------------------------------------------
529+-- Buffered Transformations by fold
530+-------------------------------------------------------------------------------
531+
532+{-# INLINE foldl'Build #-}
533+foldl'Build :: Monad m => SerialT m Int -> m [Int]
534+foldl'Build = S.foldl' (flip (:)) []
535+
536+{-# INLINE foldlM'Build #-}
537+foldlM'Build :: Monad m => SerialT m Int -> m [Int]
538+foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) []
539+
540+o_n_heap_elimination_foldl :: Int -> [Benchmark]
541+o_n_heap_elimination_foldl value =
542+ [ bgroup "foldl"
543+ -- Left folds for building a structure are inherently non-streaming
544+ -- as the structure cannot be lazily consumed until fully built.
545+ [ benchIOSink value "foldl'/build/IO" foldl'Build
546+ , benchIdentitySink value "foldl'/build/Identity" foldl'Build
547+ , benchIOSink value "foldlM'/build/IO" foldlM'Build
548+ , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build
549+ ]
550+ ]
551+
552+-- For comparisons
553+{-# INLINE showInstanceList #-}
554+showInstanceList :: [Int] -> P.String
555+showInstanceList = P.show
556+
557+o_n_heap_elimination_buffered :: Int -> [Benchmark]
558+o_n_heap_elimination_buffered value =
559+ [ bgroup "buffered"
560+ -- Buffers the output of show/read.
561+ -- XXX can the outputs be streaming? Can we have special read/show
562+ -- style type classes, readM/showM supporting streaming effects?
563+ [ bench "showPrec Haskell lists" $ nf showInstanceList (mkList value)
564+ ]
565+ ]
566+
567+{-# INLINE foldrMReduce #-}
568+foldrMReduce :: Monad m => SerialT m Int -> m Int
569+foldrMReduce = S.foldrM (\x xs -> (x +) <$> xs) (return 0)
570+
571+o_n_space_elimination_foldr :: Int -> [Benchmark]
572+o_n_space_elimination_foldr value =
573+ -- Head recursive strict right folds.
574+ [ bgroup "foldr"
575+ -- accumulation due to strictness of IO monad
576+ [ benchIOSink value "foldrM/build/IO (toList)" foldrMBuild
577+ -- Right folds for reducing are inherently non-streaming as the
578+ -- expression needs to be fully built before it can be reduced.
579+ , benchIdentitySink value "foldrM/reduce/Identity (sum)" foldrMReduce
580+ , benchIOSink value "foldrM/reduce/IO (sum)" foldrMReduce
581+ ]
582+ ]
583+
584+o_n_heap_elimination_toList :: Int -> [Benchmark]
585+o_n_heap_elimination_toList value =
586+ [ bgroup "toList"
587+ -- Converting the stream to a list or pure stream in a strict monad
588+ [ benchIOSink value "toListRev" Internal.toListRev
589+ , benchIOSink value "toPureRev" Internal.toPureRev
590+ ]
591+ ]
592+
593+o_n_space_elimination_toList :: Int -> [Benchmark]
594+o_n_space_elimination_toList value =
595+ [ bgroup "toList"
596+ -- Converting the stream to a list or pure stream in a strict monad
597+ [ benchIOSink value "toList" S.toList
598+ , benchIOSink value "toPure" Internal.toPure
599+ ]
600+ ]
601+
602+-------------------------------------------------------------------------------
603+-- Multi-stream folds
604+-------------------------------------------------------------------------------
605+
606+-------------------------------------------------------------------------------
607+-- Multi-stream pure
608+-------------------------------------------------------------------------------
609+
610+{-# INLINE eqBy' #-}
611+eqBy' :: (Monad m, P.Eq a) => SerialT m a -> m P.Bool
612+eqBy' src = S.eqBy (==) src src
613+
614+{-# INLINE eqByPure #-}
615+eqByPure :: Int -> Int -> Identity Bool
616+eqByPure value n = eqBy' (sourceUnfoldr value n)
617+
618+#ifdef INSPECTION
619+inspect $ hasNoTypeClasses 'eqByPure
620+inspect $ 'eqByPure `hasNoType` ''SPEC
621+inspect $ 'eqByPure `hasNoType` ''D.Step
622+#endif
623+
624+{-# INLINE eqInstance #-}
625+eqInstance :: SerialT Identity Int -> Bool
626+eqInstance src = src == src
627+
628+{-# INLINE eqInstanceNotEq #-}
629+eqInstanceNotEq :: SerialT Identity Int -> Bool
630+eqInstanceNotEq src = src P./= src
631+
632+{-# INLINE cmpBy' #-}
633+cmpBy' :: (Monad m, P.Ord a) => SerialT m a -> m P.Ordering
634+cmpBy' src = S.cmpBy P.compare src src
635+
636+{-# INLINE cmpByPure #-}
637+cmpByPure :: Int -> Int -> Identity P.Ordering
638+cmpByPure value n = cmpBy' (sourceUnfoldr value n)
639+
640+#ifdef INSPECTION
641+inspect $ hasNoTypeClasses 'cmpByPure
642+inspect $ 'cmpByPure `hasNoType` ''SPEC
643+inspect $ 'cmpByPure `hasNoType` ''D.Step
644+#endif
645+
646+{-# INLINE ordInstance #-}
647+ordInstance :: SerialT Identity Int -> Bool
648+ordInstance src = src P.< src
649+
650+o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark]
651+o_1_space_elimination_multi_stream_pure value =
652+ [ bgroup "multi-stream-pure"
653+ [ benchPureSink1 "eqBy" (eqByPure value)
654+ , benchPureSink value "==" eqInstance
655+ , benchPureSink value "/=" eqInstanceNotEq
656+ , benchPureSink1 "cmpBy" (cmpByPure value)
657+ , benchPureSink value "<" ordInstance
658+ ]
659+ ]
660+
661+{-# INLINE isPrefixOf #-}
662+isPrefixOf :: Monad m => SerialT m Int -> m Bool
663+isPrefixOf src = S.isPrefixOf src src
664+
665+{-# INLINE isSubsequenceOf #-}
666+isSubsequenceOf :: Monad m => SerialT m Int -> m Bool
667+isSubsequenceOf src = S.isSubsequenceOf src src
668+
669+{-# INLINE stripPrefix #-}
670+stripPrefix :: Monad m => SerialT m Int -> m ()
671+stripPrefix src = do
672+ _ <- S.stripPrefix src src
673+ return ()
674+
675+{-# INLINE eqBy #-}
676+eqBy :: Int -> Int -> IO Bool
677+eqBy value n = eqBy' (sourceUnfoldrM value n)
678+
679+#ifdef INSPECTION
680+inspect $ hasNoTypeClasses 'eqBy
681+inspect $ 'eqBy `hasNoType` ''SPEC
682+inspect $ 'eqBy `hasNoType` ''D.Step
683+#endif
684+
685+{-# INLINE cmpBy #-}
686+cmpBy :: Int -> Int -> IO P.Ordering
687+cmpBy value n = cmpBy' (sourceUnfoldrM value n)
688+
689+#ifdef INSPECTION
690+inspect $ hasNoTypeClasses 'cmpBy
691+inspect $ 'cmpBy `hasNoType` ''SPEC
692+inspect $ 'cmpBy `hasNoType` ''D.Step
693+#endif
694+
695+o_1_space_elimination_multi_stream :: Int -> [Benchmark]
696+o_1_space_elimination_multi_stream value =
697+ [ bgroup "multi-stream"
698+ [ benchIOSink1 "eqBy" (eqBy value)
699+ , benchIOSink1 "cmpBy" (cmpBy value)
700+ , benchIOSink value "isPrefixOf" isPrefixOf
701+ , benchIOSink value "isSubsequenceOf" isSubsequenceOf
702+ , benchIOSink value "stripPrefix" stripPrefix
703+ ]
704+ ]
705+
706+-------------------------------------------------------------------------------
707+-- Pipelines (stream-to-stream transformations)
708+-------------------------------------------------------------------------------
709+
710+-------------------------------------------------------------------------------
711+-- one-to-one transformations
712+-------------------------------------------------------------------------------
713+
714+-------------------------------------------------------------------------------
715+-- Traversable Instance
716+-------------------------------------------------------------------------------
717+
718+{-# INLINE traversableTraverse #-}
719+traversableTraverse :: SerialT Identity Int -> IO (SerialT Identity Int)
720+traversableTraverse = P.traverse return
721+
722+{-# INLINE traversableSequenceA #-}
723+traversableSequenceA :: SerialT Identity Int -> IO (SerialT Identity Int)
724+traversableSequenceA = P.sequenceA . P.fmap return
725+
726+{-# INLINE traversableMapM #-}
727+traversableMapM :: SerialT Identity Int -> IO (SerialT Identity Int)
728+traversableMapM = P.mapM return
729+
730+{-# INLINE traversableSequence #-}
731+traversableSequence :: SerialT Identity Int -> IO (SerialT Identity Int)
732+traversableSequence = P.sequence . P.fmap return
733+
734+{-# INLINE benchPureSinkIO #-}
735+benchPureSinkIO
736+ :: NFData b
737+ => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
738+benchPureSinkIO value name f =
739+ bench name $ nfIO $ randomRIO (1, 1) >>= f . sourceUnfoldr value
740+
741+o_n_space_traversable :: Int -> [Benchmark]
742+o_n_space_traversable value =
743+ -- Buffering operations using heap proportional to number of elements.
744+ [ bgroup "traversable"
745+ -- Traversable instance
746+ [ benchPureSinkIO value "traverse" traversableTraverse
747+ , benchPureSinkIO value "sequenceA" traversableSequenceA
748+ , benchPureSinkIO value "mapM" traversableMapM
749+ , benchPureSinkIO value "sequence" traversableSequence
750+ ]
751+ ]
752+
753+-------------------------------------------------------------------------------
754+-- maps and scans
755+-------------------------------------------------------------------------------
756+
757+{-# INLINE scan #-}
758+scan :: MonadIO m => Int -> SerialT m Int -> m ()
759+scan n = composeN n $ S.scanl' (+) 0
760+
761+{-# INLINE scanl1' #-}
762+scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()
763+scanl1' n = composeN n $ S.scanl1' (+)
764+
765+{-# INLINE sequence #-}
766+sequence ::
767+ (S.IsStream t, S.MonadAsync m)
768+ => (t m Int -> S.SerialT m Int)
769+ -> t m (m Int)
770+ -> m ()
771+sequence t = S.drain . t . S.sequence
772+
773+{-# INLINE tap #-}
774+tap :: MonadIO m => Int -> SerialT m Int -> m ()
775+tap n = composeN n $ S.tap FL.sum
776+
777+{-# INLINE tapRate #-}
778+tapRate :: Int -> SerialT IO Int -> IO ()
779+tapRate n str = do
780+ cref <- newIORef 0
781+ composeN n (Internal.tapRate 1 (\c -> modifyIORef' cref (c +))) str
782+
783+{-# INLINE pollCounts #-}
784+pollCounts :: Int -> SerialT IO Int -> IO ()
785+pollCounts n =
786+ composeN n (Internal.pollCounts (P.const P.True) f FL.drain)
787+
788+ where
789+
790+ f = Internal.rollingMap (P.-) . Internal.delayPost 1
791+
792+{-# INLINE timestamped #-}
793+timestamped :: (S.MonadAsync m) => SerialT m Int -> m ()
794+timestamped = S.drain . Internal.timestamped
795+
796+{-# INLINE foldrS #-}
797+foldrS :: MonadIO m => Int -> SerialT m Int -> m ()
798+foldrS n = composeN n $ Internal.foldrS S.cons S.nil
799+
800+{-# INLINE foldrSMap #-}
801+foldrSMap :: MonadIO m => Int -> SerialT m Int -> m ()
802+foldrSMap n = composeN n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
803+
804+{-# INLINE foldrT #-}
805+foldrT :: MonadIO m => Int -> SerialT m Int -> m ()
806+foldrT n = composeN n $ Internal.foldrT S.cons S.nil
807+
808+{-# INLINE foldrTMap #-}
809+foldrTMap :: MonadIO m => Int -> SerialT m Int -> m ()
810+foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
811+
812+o_1_space_mapping :: Int -> [Benchmark]
813+o_1_space_mapping value =
814+ [ bgroup
815+ "mapping"
816+ [
817+ -- Right folds
818+ benchIOSink value "foldrS" (foldrS 1)
819+ , benchIOSink value "foldrSMap" (foldrSMap 1)
820+ , benchIOSink value "foldrT" (foldrT 1)
821+ , benchIOSink value "foldrTMap" (foldrTMap 1)
822+
823+ -- Mapping
824+ , benchIOSink value "map" (mapN serially 1)
825+ , benchIOSink value "fmap" (fmapN serially 1)
826+ , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
827+ sequence serially (sourceUnfoldrAction value n)
828+ , benchIOSink value "mapM" (mapM serially 1)
829+ , benchIOSink value "tap" (tap 1)
830+ , benchIOSink value "tapRate 1 second" (tapRate 1)
831+ , benchIOSink value "pollCounts 1 second" (pollCounts 1)
832+ , benchIOSink value "timestamped" timestamped
833+
834+ -- Scanning
835+ , benchIOSink value "scanl'" (scan 1)
836+ , benchIOSink value "scanl1'" (scanl1' 1)
837+
838+ ]
839+ ]
840+
841+o_1_space_mappingX4 :: Int -> [Benchmark]
842+o_1_space_mappingX4 value =
843+ [ bgroup "mappingX4"
844+ [ benchIOSink value "map" (mapN serially 4)
845+ , benchIOSink value "fmap" (fmapN serially 4)
846+ , benchIOSink value "mapM" (mapM serially 4)
847+
848+ , benchIOSink value "scan" (scan 4)
849+ , benchIOSink value "scanl1'" (scanl1' 4)
850+
851+ ]
852+ ]
853+
854+-------------------------------------------------------------------------------
855+-- Size reducing transformations (filtering)
856+-------------------------------------------------------------------------------
857+
858+{-# INLINE filterEven #-}
859+filterEven :: MonadIO m => Int -> SerialT m Int -> m ()
860+filterEven n = composeN n $ S.filter even
861+
862+{-# INLINE filterAllOut #-}
863+filterAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
864+filterAllOut value n = composeN n $ S.filter (> (value + 1))
865+
866+{-# INLINE filterAllIn #-}
867+filterAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
868+filterAllIn value n = composeN n $ S.filter (<= (value + 1))
869+
870+{-# INLINE _takeOne #-}
871+_takeOne :: MonadIO m => Int -> SerialT m Int -> m ()
872+_takeOne n = composeN n $ S.take 1
873+
874+{-# INLINE takeAll #-}
875+takeAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
876+takeAll value n = composeN n $ S.take (value + 1)
877+
878+{-# INLINE takeWhileTrue #-}
879+takeWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
880+takeWhileTrue value n = composeN n $ S.takeWhile (<= (value + 1))
881+
882+{-# INLINE _takeWhileMTrue #-}
883+_takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
884+_takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))
885+
886+{-# INLINE takeByTime #-}
887+takeByTime :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
888+takeByTime i n = composeN n (Internal.takeByTime i)
889+
890+#ifdef INSPECTION
891+-- inspect $ hasNoType 'takeByTime ''SPEC
892+inspect $ hasNoTypeClasses 'takeByTime
893+-- inspect $ 'takeByTime `hasNoType` ''D.Step
894+#endif
895+
896+{-# INLINE dropOne #-}
897+dropOne :: MonadIO m => Int -> SerialT m Int -> m ()
898+dropOne n = composeN n $ S.drop 1
899+
900+{-# INLINE dropAll #-}
901+dropAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
902+dropAll value n = composeN n $ S.drop (value + 1)
903+
904+{-# INLINE dropWhileTrue #-}
905+dropWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
906+dropWhileTrue value n = composeN n $ S.dropWhile (<= (value + 1))
907+
908+{-# INLINE _dropWhileMTrue #-}
909+_dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
910+_dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))
911+
912+{-# INLINE dropWhileFalse #-}
913+dropWhileFalse :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
914+dropWhileFalse value n = composeN n $ S.dropWhile (> (value + 1))
915+
916+{-# INLINE dropByTime #-}
917+dropByTime :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
918+dropByTime i n = composeN n (Internal.dropByTime i)
919+
920+#ifdef INSPECTION
921+inspect $ hasNoTypeClasses 'dropByTime
922+-- inspect $ 'dropByTime `hasNoType` ''D.Step
923+#endif
924+
925+{-# INLINE findIndices #-}
926+findIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
927+findIndices value n = composeN n $ S.findIndices (== (value + 1))
928+
929+{-# INLINE elemIndices #-}
930+elemIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
931+elemIndices value n = composeN n $ S.elemIndices (value + 1)
932+
933+{-# INLINE deleteBy #-}
934+deleteBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
935+deleteBy value n = composeN n $ S.deleteBy (>=) (value + 1)
936+
937+{-# INLINE mapMaybe #-}
938+mapMaybe :: MonadIO m => Int -> SerialT m Int -> m ()
939+mapMaybe n =
940+ composeN n $
941+ S.mapMaybe
942+ (\x ->
943+ if P.odd x
944+ then Nothing
945+ else Just x)
946+
947+{-# INLINE mapMaybeM #-}
948+mapMaybeM :: S.MonadAsync m => Int -> SerialT m Int -> m ()
949+mapMaybeM n =
950+ composeN n $
951+ S.mapMaybeM
952+ (\x ->
953+ if P.odd x
954+ then return Nothing
955+ else return $ Just x)
956+
957+o_1_space_filtering :: Int -> [Benchmark]
958+o_1_space_filtering value =
959+ [ bgroup "filtering"
960+ [ benchIOSink value "filter-even" (filterEven 1)
961+ , benchIOSink value "filter-all-out" (filterAllOut value 1)
962+ , benchIOSink value "filter-all-in" (filterAllIn value 1)
963+
964+ -- Trimming
965+ , benchIOSink value "take-all" (takeAll value 1)
966+ , benchIOSink
967+ value
968+ "takeByTime-all"
969+ (takeByTime (NanoSecond64 maxBound) 1)
970+ , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
971+ -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)
972+ , benchIOSink value "drop-one" (dropOne 1)
973+ , benchIOSink value "drop-all" (dropAll value 1)
974+ , benchIOSink
975+ value
976+ "dropByTime-all"
977+ (dropByTime (NanoSecond64 maxBound) 1)
978+ , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
979+ -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)
980+ , benchIOSink
981+ value
982+ "dropWhile-false"
983+ (dropWhileFalse value 1)
984+ , benchIOSink value "deleteBy" (deleteBy value 1)
985+
986+ -- Map and filter
987+ , benchIOSink value "mapMaybe" (mapMaybe 1)
988+ , benchIOSink value "mapMaybeM" (mapMaybeM 1)
989+
990+ -- Searching (stateful map and filter)
991+ , benchIOSink value "findIndices" (findIndices value 1)
992+ , benchIOSink value "elemIndices" (elemIndices value 1)
993+ ]
994+ ]
995+
996+o_1_space_filteringX4 :: Int -> [Benchmark]
997+o_1_space_filteringX4 value =
998+ [ bgroup "filteringX4"
999+ [ benchIOSink value "filter-even" (filterEven 4)
1000+ , benchIOSink value "filter-all-out" (filterAllOut value 4)
1001+ , benchIOSink value "filter-all-in" (filterAllIn value 4)
1002+
1003+ -- trimming
1004+ , benchIOSink value "take-all" (takeAll value 4)
1005+ , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)
1006+ -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 4)
1007+ , benchIOSink value "drop-one" (dropOne 4)
1008+ , benchIOSink value "drop-all" (dropAll value 4)
1009+ , benchIOSink value "dropWhile-true" (dropWhileTrue value 4)
1010+ -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 4)
1011+ , benchIOSink
1012+ value
1013+ "dropWhile-false"
1014+ (dropWhileFalse value 4)
1015+ , benchIOSink value "deleteBy" (deleteBy value 4)
1016+
1017+ -- map and filter
1018+ , benchIOSink value "mapMaybe" (mapMaybe 4)
1019+ , benchIOSink value "mapMaybeM" (mapMaybeM 4)
1020+
1021+ -- searching
1022+ , benchIOSink value "findIndices" (findIndices value 4)
1023+ , benchIOSink value "elemIndices" (elemIndices value 4)
1024+ ]
1025+ ]
1026+
1027+-------------------------------------------------------------------------------
1028+-- Size increasing transformations (insertions)
1029+-------------------------------------------------------------------------------
1030+
1031+{-# INLINE intersperse #-}
1032+intersperse :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
1033+intersperse value n = composeN n $ S.intersperse (value + 1)
1034+
1035+{-# INLINE insertBy #-}
1036+insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1037+insertBy value n = composeN n $ S.insertBy compare (value + 1)
1038+
1039+o_1_space_inserting :: Int -> [Benchmark]
1040+o_1_space_inserting value =
1041+ [ bgroup "filtering"
1042+ [ benchIOSink value "intersperse" (intersperse value 1)
1043+ , benchIOSink value "insertBy" (insertBy value 1)
1044+ ]
1045+ ]
1046+
1047+o_1_space_insertingX4 :: Int -> [Benchmark]
1048+o_1_space_insertingX4 value =
1049+ [ bgroup "insertingX4"
1050+ [ benchIOSink value "intersperse" (intersperse value 4)
1051+ , benchIOSink value "insertBy" (insertBy value 4)
1052+ ]
1053+ ]
1054+
1055+-------------------------------------------------------------------------------
1056+-- Reordering
1057+-------------------------------------------------------------------------------
1058+
1059+{-# INLINE reverse #-}
1060+reverse :: MonadIO m => Int -> SerialT m Int -> m ()
1061+reverse n = composeN n S.reverse
1062+
1063+{-# INLINE reverse' #-}
1064+reverse' :: MonadIO m => Int -> SerialT m Int -> m ()
1065+reverse' n = composeN n Internal.reverse'
1066+
1067+o_n_heap_reordering :: Int -> [Benchmark]
1068+o_n_heap_reordering value =
1069+ [ bgroup "buffered"
1070+ [
1071+ -- Reversing/sorting a stream
1072+ benchIOSink value "reverse" (reverse 1)
1073+ , benchIOSink value "reverse'" (reverse' 1)
1074+ ]
1075+ ]
1076+
1077+-------------------------------------------------------------------------------
1078+-- Grouping/Splitting
1079+-------------------------------------------------------------------------------
1080+
1081+{-# INLINE classifySessionsOf #-}
1082+classifySessionsOf :: (S.MonadAsync m) => SerialT m Int -> m ()
1083+classifySessionsOf =
1084+ S.drain
1085+ . Internal.classifySessionsOf
1086+ 3 (const (return False)) (P.fmap Right FL.drain)
1087+ . S.map (\(ts,(k,a)) -> (k, a, ts))
1088+ . Internal.timestamped
1089+ . S.concatMap (\x -> S.map (x,) (S.enumerateFromTo 1 (10 :: Int)))
1090+
1091+o_n_space_grouping :: Int -> [Benchmark]
1092+o_n_space_grouping value =
1093+ -- Buffering operations using heap proportional to group/window sizes.
1094+ [ bgroup "grouping"
1095+ [ benchIOSink (value `div` 10) "classifySessionsOf" classifySessionsOf
1096+ ]
1097+ ]
1098+
1099+-------------------------------------------------------------------------------
1100+-- Mixed Transformation
1101+-------------------------------------------------------------------------------
1102+
1103+{-# INLINE scanMap #-}
1104+scanMap :: MonadIO m => Int -> SerialT m Int -> m ()
1105+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
1106+
1107+{-# INLINE dropMap #-}
1108+dropMap :: MonadIO m => Int -> SerialT m Int -> m ()
1109+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
1110+
1111+{-# INLINE dropScan #-}
1112+dropScan :: MonadIO m => Int -> SerialT m Int -> m ()
1113+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
1114+
1115+{-# INLINE takeDrop #-}
1116+takeDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1117+takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)
1118+
1119+{-# INLINE takeScan #-}
1120+takeScan :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1121+takeScan value n = composeN n $ S.scanl' (+) 0 . S.take (value + 1)
1122+
1123+{-# INLINE takeMap #-}
1124+takeMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1125+takeMap value n = composeN n $ S.map (subtract 1) . S.take (value + 1)
1126+
1127+{-# INLINE filterDrop #-}
1128+filterDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1129+filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1))
1130+
1131+{-# INLINE filterTake #-}
1132+filterTake :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1133+filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))
1134+
1135+{-# INLINE filterScan #-}
1136+filterScan :: MonadIO m => Int -> SerialT m Int -> m ()
1137+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
1138+
1139+{-# INLINE filterScanl1 #-}
1140+filterScanl1 :: MonadIO m => Int -> SerialT m Int -> m ()
1141+filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
1142+
1143+{-# INLINE filterMap #-}
1144+filterMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1145+filterMap value n = composeN n $ S.map (subtract 1) . S.filter (<= (value + 1))
1146+
1147+-------------------------------------------------------------------------------
1148+-- Scan and fold
1149+-------------------------------------------------------------------------------
1150+
1151+data Pair a b =
1152+ Pair !a !b
1153+ deriving (Generic, NFData)
1154+
1155+{-# INLINE sumProductFold #-}
1156+sumProductFold :: Monad m => SerialT m Int -> m (Int, Int)
1157+sumProductFold = S.foldl' (\(s, p) x -> (s + x, p P.* x)) (0, 1)
1158+
1159+{-# INLINE sumProductScan #-}
1160+sumProductScan :: Monad m => SerialT m Int -> m (Pair Int Int)
1161+sumProductScan =
1162+ S.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p P.* x)) (Pair 0 1) .
1163+ S.scanl' (\(s, _) x -> (s + x, x)) (0, 0)
1164+
1165+{-# INLINE foldl'ReduceMap #-}
1166+foldl'ReduceMap :: Monad m => SerialT m Int -> m Int
1167+foldl'ReduceMap = P.fmap (+ 1) . S.foldl' (+) 0
1168+
1169+o_1_space_transformations_mixed :: Int -> [Benchmark]
1170+o_1_space_transformations_mixed value =
1171+ -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl
1172+ -- library. If scan/fold followed by a map is efficient enough we may not
1173+ -- need monolithic implementations of these.
1174+ [ bgroup "mixed"
1175+ [ benchIOSink value "scanl-map" (scanMap 1)
1176+ , benchIOSink value "foldl-map" foldl'ReduceMap
1177+ , benchIOSink value "sum-product-fold" sumProductFold
1178+ , benchIOSink value "sum-product-scan" sumProductScan
1179+ ]
1180+ ]
1181+
1182+o_1_space_transformations_mixedX4 :: Int -> [Benchmark]
1183+o_1_space_transformations_mixedX4 value =
1184+ [ bgroup "mixedX4"
1185+ [ benchIOSink value "scan-map" (scanMap 4)
1186+ , benchIOSink value "drop-map" (dropMap 4)
1187+ , benchIOSink value "drop-scan" (dropScan 4)
1188+ , benchIOSink value "take-drop" (takeDrop value 4)
1189+ , benchIOSink value "take-scan" (takeScan value 4)
1190+ , benchIOSink value "take-map" (takeMap value 4)
1191+ , benchIOSink value "filter-drop" (filterDrop value 4)
1192+ , benchIOSink value "filter-take" (filterTake value 4)
1193+ , benchIOSink value "filter-scan" (filterScan 4)
1194+ , benchIOSink value "filter-scanl1" (filterScanl1 4)
1195+ , benchIOSink value "filter-map" (filterMap value 4)
1196+ ]
1197+ ]
1198+
1199+-------------------------------------------------------------------------------
1200+-- Iterating a transformation over and over again
1201+-------------------------------------------------------------------------------
1202+
1203+{-# INLINE iterStreamLen #-}
1204+iterStreamLen :: Int
1205+iterStreamLen = 10
1206+
1207+{-# INLINE maxIters #-}
1208+maxIters :: Int
1209+maxIters = 10000
1210+
1211+{-# INLINE iterateSource #-}
1212+iterateSource ::
1213+ S.MonadAsync m
1214+ => (SerialT m Int -> SerialT m Int)
1215+ -> Int
1216+ -> Int
1217+ -> SerialT m Int
1218+iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
1219+ where
1220+ f (0 :: Int) m = g m
1221+ f x m = g (f (x P.- 1) m)
1222+
1223+-- this is quadratic
1224+{-# INLINE iterateScan #-}
1225+iterateScan :: S.MonadAsync m => Int -> SerialT m Int
1226+iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
1227+
1228+-- this is quadratic
1229+{-# INLINE iterateScanl1 #-}
1230+iterateScanl1 :: S.MonadAsync m => Int -> SerialT m Int
1231+iterateScanl1 = iterateSource (S.scanl1' (+)) (maxIters `div` 10)
1232+
1233+{-# INLINE iterateMapM #-}
1234+iterateMapM :: S.MonadAsync m => Int -> SerialT m Int
1235+iterateMapM = iterateSource (S.mapM return) maxIters
1236+
1237+{-# INLINE iterateFilterEven #-}
1238+iterateFilterEven :: S.MonadAsync m => Int -> SerialT m Int
1239+iterateFilterEven = iterateSource (S.filter even) maxIters
1240+
1241+{-# INLINE iterateTakeAll #-}
1242+iterateTakeAll :: S.MonadAsync m => Int -> Int -> SerialT m Int
1243+iterateTakeAll value = iterateSource (S.take (value + 1)) maxIters
1244+
1245+{-# INLINE iterateDropOne #-}
1246+iterateDropOne :: S.MonadAsync m => Int -> SerialT m Int
1247+iterateDropOne = iterateSource (S.drop 1) maxIters
1248+
1249+{-# INLINE iterateDropWhileFalse #-}
1250+iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> SerialT m Int
1251+iterateDropWhileFalse value =
1252+ iterateSource (S.dropWhile (> (value + 1))) maxIters
1253+
1254+{-# INLINE iterateDropWhileTrue #-}
1255+iterateDropWhileTrue :: S.MonadAsync m => Int -> Int -> SerialT m Int
1256+iterateDropWhileTrue value =
1257+ iterateSource (S.dropWhile (<= (value + 1))) maxIters
1258+
1259+{-# INLINE tail #-}
1260+tail :: Monad m => SerialT m a -> m ()
1261+tail s = S.tail s >>= P.mapM_ tail
1262+
1263+{-# INLINE nullHeadTail #-}
1264+nullHeadTail :: Monad m => SerialT m Int -> m ()
1265+nullHeadTail s = do
1266+ r <- S.null s
1267+ when (not r) $ do
1268+ _ <- S.head s
1269+ S.tail s >>= P.mapM_ nullHeadTail
1270+
1271+-- Head recursive operations.
1272+o_n_stack_iterated :: Int -> [Benchmark]
1273+o_n_stack_iterated value =
1274+ [ bgroup "iterated"
1275+ [ benchIOSrc serially "mapMx10K" iterateMapM
1276+ , benchIOSrc serially "scanx100" iterateScan
1277+ , benchIOSrc serially "scanl1x100" iterateScanl1
1278+ , benchIOSrc serially "filterEvenx10K" iterateFilterEven
1279+ , benchIOSrc serially "takeAllx10K" (iterateTakeAll value)
1280+ , benchIOSrc serially "dropOnex10K" iterateDropOne
1281+ , benchIOSrc serially "dropWhileFalsex10K"
1282+ (iterateDropWhileFalse value)
1283+ , benchIOSrc serially "dropWhileTruex10K"
1284+ (iterateDropWhileTrue value)
1285+ , benchIOSink value "tail" tail
1286+ , benchIOSink value "nullHeadTail" nullHeadTail
1287+ ]
1288+ ]
1289+
1290+-------------------------------------------------------------------------------
1291+-- Pipes
1292+-------------------------------------------------------------------------------
1293+
1294+o_1_space_pipes :: Int -> [Benchmark]
1295+o_1_space_pipes value =
1296+ [ bgroup "pipes"
1297+ [ benchIOSink value "mapM" (transformMapM serially 1)
1298+ , benchIOSink value "compose" (transformComposeMapM serially 1)
1299+ , benchIOSink value "tee" (transformTeeMapM serially 1)
1300+ , benchIOSink value "zip" (transformZipMapM serially 1)
1301+ ]
1302+ ]
1303+
1304+o_1_space_pipesX4 :: Int -> [Benchmark]
1305+o_1_space_pipesX4 value =
1306+ [ bgroup "pipesX4"
1307+ [ benchIOSink value "mapM" (transformMapM serially 4)
1308+ , benchIOSink value "compose" (transformComposeMapM serially 4)
1309+ , benchIOSink value "tee" (transformTeeMapM serially 4)
1310+ , benchIOSink value "zip" (transformZipMapM serially 4)
1311+ ]
1312+ ]
1313+
1314+-------------------------------------------------------------------------------
1315+-- Multi-Stream
1316+-------------------------------------------------------------------------------
1317+
1318+-------------------------------------------------------------------------------
1319+-- Appending
1320+-------------------------------------------------------------------------------
1321+
1322+{-# INLINE serial2 #-}
1323+serial2 :: Int -> Int -> IO ()
1324+serial2 count n =
1325+ S.drain $
1326+ S.serial (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
1327+
1328+{-# INLINE serial4 #-}
1329+serial4 :: Int -> Int -> IO ()
1330+serial4 count n =
1331+ S.drain $
1332+ S.serial
1333+ (S.serial (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1)))
1334+ (S.serial
1335+ (sourceUnfoldrMN count (n + 2))
1336+ (sourceUnfoldrMN count (n + 3)))
1337+
1338+{-# INLINE append2 #-}
1339+append2 :: Int -> Int -> IO ()
1340+append2 count n =
1341+ S.drain $
1342+ Internal.append (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
1343+
1344+{-# INLINE append4 #-}
1345+append4 :: Int -> Int -> IO ()
1346+append4 count n =
1347+ S.drain $
1348+ Internal.append
1349+ (Internal.append
1350+ (sourceUnfoldrMN count n)
1351+ (sourceUnfoldrMN count (n + 1)))
1352+ (Internal.append
1353+ (sourceUnfoldrMN count (n + 2))
1354+ (sourceUnfoldrMN count (n + 3)))
1355+
1356+#ifdef INSPECTION
1357+inspect $ hasNoTypeClasses 'append2
1358+inspect $ 'append2 `hasNoType` ''SPEC
1359+inspect $ 'append2 `hasNoType` ''D.AppendState
1360+#endif
1361+
1362+-------------------------------------------------------------------------------
1363+-- Merging
1364+-------------------------------------------------------------------------------
1365+
1366+{-# INLINE mergeBy #-}
1367+mergeBy :: Int -> Int -> IO ()
1368+mergeBy count n =
1369+ S.drain $
1370+ S.mergeBy
1371+ P.compare
1372+ (sourceUnfoldrMN count n)
1373+ (sourceUnfoldrMN count (n + 1))
1374+
1375+#ifdef INSPECTION
1376+inspect $ hasNoTypeClasses 'mergeBy
1377+inspect $ 'mergeBy `hasNoType` ''SPEC
1378+inspect $ 'mergeBy `hasNoType` ''D.Step
1379+#endif
1380+
1381+o_1_space_joining :: Int -> [Benchmark]
1382+o_1_space_joining value =
1383+ [ bgroup "joining"
1384+ [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))
1385+ , benchIOSrc1 "append (2,x/2)" (append2 (value `div` 2))
1386+ , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
1387+ , benchIOSrc1 "append (2,2,x/4)" (append4 (value `div` 4))
1388+ , benchIOSrc1 "mergeBy (2,x/2)" (mergeBy (value `div` 2))
1389+ ]
1390+ ]
1391+
1392+-------------------------------------------------------------------------------
1393+-- Concat Foldable containers
1394+-------------------------------------------------------------------------------
1395+
1396+o_1_space_concatFoldable :: Int -> [Benchmark]
1397+o_1_space_concatFoldable value =
1398+ [ bgroup "concat-foldable"
1399+ [ benchIOSrc serially "foldMapWith" (sourceFoldMapWith value)
1400+ , benchIOSrc serially "foldMapWithM" (sourceFoldMapWithM value)
1401+ , benchIOSrc serially "foldMapM" (sourceFoldMapM value)
1402+ , benchIOSrc serially "foldWithConcatMapId" (sourceConcatMapId value)
1403+ ]
1404+ ]
1405+
1406+-------------------------------------------------------------------------------
1407+-- Concat
1408+-------------------------------------------------------------------------------
1409+
1410+-- concatMap unfoldrM/unfoldrM
1411+
1412+{-# INLINE concatMap #-}
1413+concatMap :: Int -> Int -> Int -> IO ()
1414+concatMap outer inner n =
1415+ S.drain $ S.concatMap
1416+ (\_ -> sourceUnfoldrMN inner n)
1417+ (sourceUnfoldrMN outer n)
1418+
1419+#ifdef INSPECTION
1420+inspect $ hasNoTypeClasses 'concatMap
1421+inspect $ 'concatMap `hasNoType` ''SPEC
1422+#endif
1423+
1424+-- concatMap unfoldr/unfoldr
1425+
1426+{-# INLINE concatMapPure #-}
1427+concatMapPure :: Int -> Int -> Int -> IO ()
1428+concatMapPure outer inner n =
1429+ S.drain $ S.concatMap
1430+ (\_ -> sourceUnfoldrN inner n)
1431+ (sourceUnfoldrN outer n)
1432+
1433+#ifdef INSPECTION
1434+inspect $ hasNoTypeClasses 'concatMapPure
1435+inspect $ 'concatMapPure `hasNoType` ''SPEC
1436+#endif
1437+
1438+-- concatMap replicate/unfoldrM
1439+
1440+{-# INLINE concatMapRepl4xN #-}
1441+concatMapRepl4xN :: Int -> Int -> IO ()
1442+concatMapRepl4xN value n = S.drain $ S.concatMap (S.replicate 4)
1443+ (sourceUnfoldrMN (value `div` 4) n)
1444+
1445+#ifdef INSPECTION
1446+inspect $ hasNoTypeClasses 'concatMapRepl4xN
1447+inspect $ 'concatMapRepl4xN `hasNoType` ''SPEC
1448+#endif
1449+
1450+-- concatMapWith
1451+
1452+{-# INLINE concatMapWithSerial #-}
1453+concatMapWithSerial :: Int -> Int -> Int -> IO ()
1454+concatMapWithSerial = concatStreamsWith S.serial
1455+
1456+#ifdef INSPECTION
1457+inspect $ hasNoTypeClasses 'concatMapWithSerial
1458+inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
1459+#endif
1460+
1461+{-# INLINE concatMapWithAppend #-}
1462+concatMapWithAppend :: Int -> Int -> Int -> IO ()
1463+concatMapWithAppend = concatStreamsWith Internal.append
1464+
1465+#ifdef INSPECTION
1466+inspect $ hasNoTypeClasses 'concatMapWithAppend
1467+inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
1468+#endif
1469+
1470+-- concatUnfold
1471+
1472+-- concatUnfold replicate/unfoldrM
1473+
1474+{-# INLINE concatUnfoldRepl4xN #-}
1475+concatUnfoldRepl4xN :: Int -> Int -> IO ()
1476+concatUnfoldRepl4xN value n =
1477+ S.drain $ S.concatUnfold
1478+ (UF.replicateM 4)
1479+ (sourceUnfoldrMN (value `div` 4) n)
1480+
1481+#ifdef INSPECTION
1482+inspect $ hasNoTypeClasses 'concatUnfoldRepl4xN
1483+inspect $ 'concatUnfoldRepl4xN `hasNoType` ''D.ConcatMapUState
1484+inspect $ 'concatUnfoldRepl4xN `hasNoType` ''SPEC
1485+#endif
1486+
1487+o_1_space_concat :: Int -> [Benchmark]
1488+o_1_space_concat value =
1489+ [ bgroup "concat"
1490+ [ benchIOSrc1 "concatMapPure (2,x/2)"
1491+ (concatMapPure 2 (value `div` 2))
1492+ , benchIOSrc1 "concatMap (2,x/2)"
1493+ (concatMap 2 (value `div` 2))
1494+ , benchIOSrc1 "concatMap (x/2,2)"
1495+ (concatMap (value `div` 2) 2)
1496+ , benchIOSrc1 "concatMapRepl (x/4,4)"
1497+ (concatMapRepl4xN value)
1498+ , benchIOSrc1 "concatUnfoldRepl (x/4,4)"
1499+ (concatUnfoldRepl4xN value)
1500+ , benchIOSrc1 "concatMapWithSerial (2,x/2)"
1501+ (concatMapWithSerial 2 (value `div` 2))
1502+ , benchIOSrc1 "concatMapWithSerial (x/2,2)"
1503+ (concatMapWithSerial (value `div` 2) 2)
1504+ , benchIOSrc1 "concatMapWithAppend (2,x/2)"
1505+ (concatMapWithAppend 2 (value `div` 2))
1506+ ]
1507+ ]
1508+
1509+-------------------------------------------------------------------------------
1510+-- Monad
1511+-------------------------------------------------------------------------------
1512+
1513+o_1_space_outerProduct :: Int -> [Benchmark]
1514+o_1_space_outerProduct value =
1515+ [ bgroup "monad-outer-product"
1516+ [ benchIO "toNullAp" $ toNullAp value serially
1517+ , benchIO "toNull" $ toNullM value serially
1518+ , benchIO "toNull3" $ toNullM3 value serially
1519+ , benchIO "filterAllOut" $ filterAllOutM value serially
1520+ , benchIO "filterAllIn" $ filterAllInM value serially
1521+ , benchIO "filterSome" $ filterSome value serially
1522+ , benchIO "breakAfterSome" $ breakAfterSome value serially
1523+ ]
1524+ ]
1525+
1526+o_n_space_outerProduct :: Int -> [Benchmark]
1527+o_n_space_outerProduct value =
1528+ [ bgroup "monad-outer-product"
1529+ [ benchIO "toList" $ toListM value serially
1530+ , benchIO "toListSome" $ toListSome value serially
1531+ ]
1532+ ]
1533+
1534+-------------------------------------------------------------------------------
1535+-- Monad transformation (hoisting etc.)
1536+-------------------------------------------------------------------------------
1537+
1538+{-# INLINE sourceUnfoldrState #-}
1539+sourceUnfoldrState :: (S.IsStream t, S.MonadAsync m)
1540+ => Int -> Int -> t (StateT Int m) Int
1541+sourceUnfoldrState value n = S.unfoldrM step n
1542+ where
1543+ step cnt =
1544+ if cnt > n + value
1545+ then return Nothing
1546+ else do
1547+ s <- get
1548+ put (s + 1)
1549+ return (Just (s, cnt + 1))
1550+
1551+{-# INLINE evalStateT #-}
1552+evalStateT :: S.MonadAsync m => Int -> Int -> SerialT m Int
1553+evalStateT value n = Internal.evalStateT 0 (sourceUnfoldrState value n)
1554+
1555+{-# INLINE withState #-}
1556+withState :: S.MonadAsync m => Int -> Int -> SerialT m Int
1557+withState value n =
1558+ Internal.evalStateT (0 :: Int) (Internal.liftInner (sourceUnfoldrM value n))
1559+
1560+o_1_space_hoisting :: Int -> [Benchmark]
1561+o_1_space_hoisting value =
1562+ [ bgroup "hoisting"
1563+ [ benchIOSrc serially "evalState" (evalStateT value)
1564+ , benchIOSrc serially "withState" (withState value)
1565+ ]
1566+ ]
1567+
1568+-------------------------------------------------------------------------------
1569+-- Main
1570+-------------------------------------------------------------------------------
12
1571
13-- In addition to gauge options, the number of elements in the stream can be
1572-- In addition to gauge options, the number of elements in the stream can be
14-- passed using the --stream-size option.
1573-- passed using the --stream-size option.
@@ -16,49 +1575,63 @@ import Gauge
16main :: IO ()
1575main :: IO ()
17main = do
1576main = do
18 (value, cfg, benches) <- parseCLIOpts defaultStreamSize
1577 (value, cfg, benches) <- parseCLIOpts defaultStreamSize
19− size <- limitStreamSize value
20− size `seq` runMode (mode cfg) cfg benches (allBenchmarks size)
1578+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
1579+
21− where
1580+ where
1581+
22 allBenchmarks size =
1582 allBenchmarks size =
23− [ bgroup "o-n-stack" $ o_n_stack_serial_iterated size
1583+ [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
24− , bgroup "o-1-space" $
1584+ [ o_1_space_generation size
25− concat [serial size, wSerial size, zipSerial size]
1585+
26− , bgroup "o-n-heap" $
1586+ -- elimination
27− concat [o_n_heap_serial_foldl size, o_n_heap_serial_buffering size]
1587+ , o_1_space_elimination_foldable size
28− , bgroup "o-n-space" $
1588+ , o_1_space_elimination_folds size
29− concat
1589+ , o_1_space_elimination_multi_stream_pure size
30− [ o_n_space_serial_toList size -- < 2MB
1590+ , o_1_space_elimination_multi_stream size
31− , o_n_space_serial_outerProductStreams size
1591+
32− , o_n_space_wSerial_outerProductStreams size
1592+ -- transformation
33− , o_n_space_serial size -- < 2MB
1593+ , o_1_space_mapping size
34− , o_n_space_serial_foldr size
1594+ , o_1_space_mappingX4 size
35− ]
1595+ , o_1_space_filtering size
36− ]
1596+ , o_1_space_filteringX4 size
37− serial size =
1597+ , o_1_space_inserting size
38− concat
1598+ , o_1_space_insertingX4 size
39− [ o_1_space_serial_pure size
1599+ , o_1_space_transformations_mixed size
40− , o_1_space_serial_foldable size
1600+ , o_1_space_transformations_mixedX4 size
41− , o_1_space_serial_generation size
1601+
42− , o_1_space_serial_elimination size
1602+ -- pipes
43− , o_1_space_serial_foldMultiStream size
1603+ , o_1_space_pipes size
44− , o_1_space_serial_pipes size
1604+ , o_1_space_pipesX4 size
45− , o_1_space_serial_pipesX4 size
1605+
46− , o_1_space_serial_transformer size
1606+ -- multi-stream
47− , o_1_space_serial_transformation size
1607+ , o_1_space_joining size
48− , o_1_space_serial_transformationX4 size
1608+ , o_1_space_concatFoldable size
49− , o_1_space_serial_filtering size
1609+ , o_1_space_concat size
50− , o_1_space_serial_filteringX4 size
1610+ , o_1_space_outerProduct size
51− , o_1_space_serial_joining size
1611+
52− , o_1_space_serial_concatFoldable size
1612+ -- Monad transformation
53− , o_1_space_serial_concatSerial size
1613+ , o_1_space_hoisting size
54− , o_1_space_serial_outerProductStreams size
55− , o_1_space_serial_mixed size
56− , o_1_space_serial_mixedX4 size
57 ]
1614 ]
58− wSerial size =
1615+ , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)
59− concat
1616+ , bgroup (o_n_heap_prefix moduleName) $ Prelude.concat
60− [ o_1_space_wSerial_transformation size
1617+ [ o_n_heap_generation size
61− , o_1_space_wSerial_concatMap size
1618+ , o_n_heap_elimination_foldl size
62− , o_1_space_wSerial_outerProduct size
1619+ , o_n_heap_elimination_toList size
1620+ , o_n_heap_elimination_buffered size
1621+
1622+ -- transformation
1623+ , o_n_heap_reordering size
63 ]
1624 ]
64− zipSerial size = concat [o_1_space_zipSerial_transformation size]
1625+ , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
1626+ [ o_n_space_elimination_foldable size
1627+ , o_n_space_elimination_toList size
1628+ , o_n_space_elimination_foldr size
1629+
1630+ -- transformation
1631+ , o_n_space_traversable size
1632+ , o_n_space_grouping size
1633+
1634+ -- multi-stream
1635+ , o_n_space_outerProduct size
1636+ ]
1637+ ]
benchmark/Streamly/Benchmark/Prelude/WAsync.hsnew file+135
@@ -0,0 +1,135 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2018 Harendra Kumar
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+import Prelude hiding (mapM)
9+
10+import Streamly (wAsyncly, wAsync, maxBuffer, maxThreads)
11+
12+import Streamly.Benchmark.Common
13+import Streamly.Benchmark.Prelude
14+
15+import Gauge
16+
17+moduleName :: String
18+moduleName = "Prelude.WAsync"
19+
20+-------------------------------------------------------------------------------
21+-- Generation
22+-------------------------------------------------------------------------------
23+
24+o_1_space_generation :: Int -> [Benchmark]
25+o_1_space_generation value =
26+ [ bgroup "generation"
27+ [ benchIOSrc wAsyncly "unfoldr" (sourceUnfoldr value)
28+ , benchIOSrc wAsyncly "unfoldrM" (sourceUnfoldrM value)
29+ , benchIOSrc wAsyncly "fromFoldable" (sourceFromFoldable value)
30+ , benchIOSrc wAsyncly "fromFoldableM" (sourceFromFoldableM value)
31+ , benchIOSrc wAsyncly "unfoldrM maxThreads 1"
32+ (maxThreads 1 . sourceUnfoldrM value)
33+ , benchIOSrc wAsyncly "unfoldrM maxBuffer 1 (x/10 ops)"
34+ (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
35+ ]
36+ ]
37+
38+-------------------------------------------------------------------------------
39+-- Mapping
40+-------------------------------------------------------------------------------
41+
42+o_1_space_mapping :: Int -> [Benchmark]
43+o_1_space_mapping value =
44+ [ bgroup "mapping"
45+ [ benchIOSink value "map" $ mapN wAsyncly 1
46+ , benchIOSink value "fmap" $ fmapN wAsyncly 1
47+ , benchIOSink value "mapM" $ mapM wAsyncly 1
48+ ]
49+ ]
50+
51+-------------------------------------------------------------------------------
52+-- Concat
53+-------------------------------------------------------------------------------
54+
55+o_1_space_concatFoldable :: Int -> [Benchmark]
56+o_1_space_concatFoldable value =
57+ [ bgroup "concat-foldable"
58+ [ benchIOSrc wAsyncly "foldMapWith" (sourceFoldMapWith value)
59+ , benchIOSrc wAsyncly "foldMapWithM" (sourceFoldMapWithM value)
60+ , benchIOSrc wAsyncly "foldMapM" (sourceFoldMapM value)
61+ ]
62+ ]
63+
64+-- When we merge streams using wAsync the size of the queue increases
65+-- slowly because of the binary composition adding just one more item
66+-- to the work queue only after every scheduling pass through the
67+-- work queue.
68+--
69+-- We should see the memory consumption increasing slowly if these
70+-- benchmarks are left to run on infinite number of streams of infinite
71+-- sizes.
72+o_1_space_concatMap :: Int -> [Benchmark]
73+o_1_space_concatMap value =
74+ value2 `seq`
75+ [ bgroup "concat"
76+ [ benchIO "concatMapWith (2,x/2)"
77+ (concatStreamsWith wAsync 2 (value `div` 2))
78+ , benchIO "concatMapWith (sqrt x,sqrt x)"
79+ (concatStreamsWith wAsync value2 value2)
80+ , benchIO "concatMapWith (sqrt x * 2,sqrt x / 2)"
81+ (concatStreamsWith wAsync (value2 * 2) (value2 `div` 2))
82+ ]
83+ ]
84+
85+ where
86+
87+ value2 = round $ sqrt (fromIntegral value :: Double)
88+
89+-------------------------------------------------------------------------------
90+-- Monadic outer product
91+-------------------------------------------------------------------------------
92+
93+o_n_heap_outerProduct :: Int -> [Benchmark]
94+o_n_heap_outerProduct value =
95+ [ bgroup "monad-outer-product"
96+ [ benchIO "toNullAp" $ toNullAp value wAsyncly
97+ , benchIO "toNull" $ toNullM value wAsyncly
98+ , benchIO "toNull3" $ toNullM3 value wAsyncly
99+ , benchIO "filterAllOut" $ filterAllOutM value wAsyncly
100+ , benchIO "filterAllIn" $ filterAllInM value wAsyncly
101+ , benchIO "filterSome" $ filterSome value wAsyncly
102+ , benchIO "breakAfterSome" $ breakAfterSome value wAsyncly
103+
104+ ]
105+ ]
106+
107+o_n_space_outerProduct :: Int -> [Benchmark]
108+o_n_space_outerProduct value =
109+ [ bgroup "monad-outer-product"
110+ [ benchIO "toList" $ toListM value wAsyncly
111+ , benchIO "toListSome" $ toListSome value wAsyncly
112+ ]
113+ ]
114+
115+-------------------------------------------------------------------------------
116+-- Main
117+-------------------------------------------------------------------------------
118+
119+main :: IO ()
120+main = do
121+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
122+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
123+
124+ where
125+
126+ allBenchmarks value =
127+ [ bgroup (o_1_space_prefix moduleName) $ concat
128+ [ o_1_space_generation value
129+ , o_1_space_mapping value
130+ , o_1_space_concatFoldable value
131+ , o_1_space_concatMap value
132+ ]
133+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_outerProduct value)
134+ , bgroup (o_n_space_prefix moduleName) (o_n_space_outerProduct value)
135+ ]
benchmark/Streamly/Benchmark/Prelude/WSerial.hsnew file+212
@@ -0,0 +1,212 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2018 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE CPP #-}
9+{-# LANGUAGE FlexibleContexts #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE RankNTypes #-}
12+
13+#ifdef __HADDOCK_VERSION__
14+#undef INSPECTION
15+#endif
16+
17+#ifdef INSPECTION
18+{-# LANGUAGE TemplateHaskell #-}
19+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
20+#endif
21+
22+import Streamly
23+import qualified Streamly.Prelude as S
24+import qualified Streamly.Internal.Prelude as Internal
25+import qualified Streamly.Internal.Data.Unfold as UF
26+
27+import Streamly.Benchmark.Common
28+import Streamly.Benchmark.Prelude
29+
30+import Gauge
31+
32+moduleName :: String
33+moduleName = "Prelude.WSerial"
34+
35+-------------------------------------------------------------------------------
36+-- Mapping
37+-------------------------------------------------------------------------------
38+
39+o_1_space_mapping :: Int -> [Benchmark]
40+o_1_space_mapping value =
41+ [ bgroup "mapping"
42+ [ benchIOSink value "fmap" $ fmapN wSerially 1 ]
43+ ]
44+
45+-------------------------------------------------------------------------------
46+-- Interleaving
47+-------------------------------------------------------------------------------
48+
49+{-# INLINE wSerial2 #-}
50+wSerial2 :: Int -> Int -> IO ()
51+wSerial2 value n =
52+ S.drain $ wSerial
53+ (sourceUnfoldrMN (value `div` 2) n)
54+ (sourceUnfoldrMN (value `div` 2) (n + 1))
55+
56+{-# INLINE interleave2 #-}
57+interleave2 :: Int -> Int -> IO ()
58+interleave2 value n =
59+ S.drain $
60+ Internal.interleave
61+ (sourceUnfoldrMN (value `div` 2) n)
62+ (sourceUnfoldrMN (value `div` 2) (n + 1))
63+
64+#ifdef INSPECTION
65+inspect $ hasNoTypeClasses 'interleave2
66+inspect $ 'interleave2 `hasNoType` ''SPEC
67+inspect $ 'interleave2 `hasNoType` ''D.InterleaveState
68+#endif
69+
70+{-# INLINE roundRobin2 #-}
71+roundRobin2 :: Int -> Int -> IO ()
72+roundRobin2 value n =
73+ S.drain $
74+ Internal.roundrobin
75+ (sourceUnfoldrMN (value `div` 2) n)
76+ (sourceUnfoldrMN (value `div` 2) (n + 1))
77+
78+#ifdef INSPECTION
79+inspect $ hasNoTypeClasses 'roundRobin2
80+inspect $ 'roundRobin2 `hasNoType` ''SPEC
81+inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState
82+#endif
83+
84+o_1_space_joining :: Int -> [Benchmark]
85+o_1_space_joining value =
86+ [ bgroup "joining"
87+ [ benchIOSrc1 "wSerial (2,x/2)" (wSerial2 value)
88+ , benchIOSrc1 "interleave (2,x/2)" (interleave2 value)
89+ , benchIOSrc1 "roundRobin (2,x/2)" (roundRobin2 value)
90+ ]
91+ ]
92+
93+-------------------------------------------------------------------------------
94+-- Concat
95+-------------------------------------------------------------------------------
96+
97+{-# INLINE concatMapWithWSerial #-}
98+concatMapWithWSerial :: Int -> Int -> Int -> IO ()
99+concatMapWithWSerial = concatStreamsWith wSerial
100+
101+#ifdef INSPECTION
102+inspect $ hasNoTypeClasses 'concatMapWithWSerial
103+inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
104+#endif
105+
106+o_1_space_concat :: Int -> [Benchmark]
107+o_1_space_concat value =
108+ [ bgroup "concat"
109+ [ benchIOSrc1
110+ "concatMapWithWSerial (2,x/2)"
111+ (concatMapWithWSerial 2 (value `div` 2))
112+ , benchIOSrc1
113+ "concatMapWithWSerial (x/2,2)"
114+ (concatMapWithWSerial (value `div` 2) 2)
115+ ]
116+ ]
117+
118+{-# INLINE concatUnfoldInterleaveRepl4xN #-}
119+concatUnfoldInterleaveRepl4xN :: Int -> Int -> IO ()
120+concatUnfoldInterleaveRepl4xN value n =
121+ S.drain $ Internal.concatUnfoldInterleave
122+ (UF.replicateM 4)
123+ (sourceUnfoldrMN (value `div` 4) n)
124+
125+#ifdef INSPECTION
126+inspect $ hasNoTypeClasses 'concatUnfoldInterleaveRepl4xN
127+-- inspect $ 'concatUnfoldInterleaveRepl4xN `hasNoType` ''SPEC
128+-- inspect $ 'concatUnfoldInterleaveRepl4xN `hasNoType`
129+-- ''D.ConcatUnfoldInterleaveState
130+#endif
131+
132+{-# INLINE concatUnfoldRoundrobinRepl4xN #-}
133+concatUnfoldRoundrobinRepl4xN :: Int -> Int -> IO ()
134+concatUnfoldRoundrobinRepl4xN value n =
135+ S.drain $ Internal.concatUnfoldRoundrobin
136+ (UF.replicateM 4)
137+ (sourceUnfoldrMN (value `div` 4) n)
138+
139+#ifdef INSPECTION
140+inspect $ hasNoTypeClasses 'concatUnfoldRoundrobinRepl4xN
141+-- inspect $ 'concatUnfoldRoundrobinRepl4xN `hasNoType` ''SPEC
142+-- inspect $ 'concatUnfoldRoundrobinRepl4xN `hasNoType`
143+-- ''D.ConcatUnfoldInterleaveState
144+#endif
145+
146+o_n_heap_concat :: Int -> [Benchmark]
147+o_n_heap_concat value =
148+ [ bgroup "concat"
149+ [
150+ -- interleave x/4 streams of 4 elements each. Needs to buffer
151+ -- proportional to x/4. This is different from WSerial because
152+ -- WSerial expands slowly because of binary interleave behavior and
153+ -- this expands immediately because of Nary interleave behavior.
154+ benchIOSrc1
155+ "concatUnfoldInterleaveRepl (x/4,4)"
156+ (concatUnfoldInterleaveRepl4xN value)
157+ , benchIOSrc1
158+ "concatUnfoldRoundrobinRepl (x/4,4)"
159+ (concatUnfoldRoundrobinRepl4xN value)
160+ ]
161+ ]
162+
163+-------------------------------------------------------------------------------
164+-- Monad
165+-------------------------------------------------------------------------------
166+
167+o_1_space_outerProduct :: Int -> [Benchmark]
168+o_1_space_outerProduct value =
169+ [ bgroup "monad-outer-product"
170+ [ benchIO "toNullAp" $ toNullAp value wSerially
171+ , benchIO "toNullM" $ toNullM value wSerially
172+ , benchIO "toNullM3" $ toNullM3 value wSerially
173+ , benchIO "filterAllOutM" $ filterAllOutM value wSerially
174+ , benchIO "filterAllInM" $ filterAllInM value wSerially
175+ , benchIO "filterSome" $ filterSome value wSerially
176+ , benchIO "breakAfterSome" $ breakAfterSome value wSerially
177+ ]
178+ ]
179+
180+o_n_space_outerProduct :: Int -> [Benchmark]
181+o_n_space_outerProduct value =
182+ [ bgroup
183+ "monad-outer-product"
184+ [ benchIO "toList" $ toListM value wSerially
185+ , benchIO "toListSome" $ toListSome value wSerially
186+ ]
187+ ]
188+
189+-------------------------------------------------------------------------------
190+-- Main
191+-------------------------------------------------------------------------------
192+
193+-- In addition to gauge options, the number of elements in the stream can be
194+-- passed using the --stream-size option.
195+--
196+main :: IO ()
197+main = do
198+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
199+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
200+
201+ where
202+
203+ allBenchmarks size =
204+ [ bgroup (o_1_space_prefix moduleName) $ concat
205+ [ o_1_space_mapping size
206+ , o_1_space_joining size
207+ , o_1_space_concat size
208+ , o_1_space_outerProduct size
209+ ]
210+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_concat size)
211+ , bgroup (o_n_space_prefix moduleName) (o_n_space_outerProduct size)
212+ ]
benchmark/Streamly/Benchmark/Prelude/ZipAsync.hsnew file+82
@@ -0,0 +1,82 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2018 Harendra Kumar
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE FlexibleContexts #-}
9+
10+import Streamly (serially)
11+import qualified Streamly as S
12+import qualified Streamly.Prelude as S
13+
14+import Streamly.Benchmark.Common
15+import Streamly.Benchmark.Prelude
16+
17+import Gauge
18+
19+moduleName :: String
20+moduleName = "Prelude.ZipAsync"
21+
22+-------------------------------------------------------------------------------
23+-- Zipping
24+-------------------------------------------------------------------------------
25+
26+{-# INLINE zipAsync #-}
27+zipAsync :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
28+zipAsync count n =
29+ S.zipAsyncWith (,) (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
30+
31+{-# INLINE zipAsyncM #-}
32+zipAsyncM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
33+zipAsyncM count n =
34+ S.zipAsyncWithM
35+ (curry return)
36+ (sourceUnfoldrMN count n)
37+ (sourceUnfoldrMN count (n + 1))
38+
39+{-# INLINE zipAsyncAp #-}
40+zipAsyncAp :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
41+zipAsyncAp count n =
42+ S.zipAsyncly $
43+ (,) <$> sourceUnfoldrMN count n <*> sourceUnfoldrMN count (n + 1)
44+
45+o_1_space_joining :: Int -> [Benchmark]
46+o_1_space_joining value =
47+ [ bgroup "joining"
48+ [ benchIOSrc serially "zipAsync (2,x/2)" (zipAsync (value `div` 2))
49+ , benchIOSrc serially "zipAsyncM (2,x/2)" (zipAsyncM (value `div` 2))
50+ , benchIOSrc serially "zipAsyncAp (2,x/2)" (zipAsyncAp (value `div` 2))
51+ , benchIOSink value "fmap zipAsyncly" $ fmapN S.zipAsyncly 1
52+ ]
53+ ]
54+
55+-------------------------------------------------------------------------------
56+-- Monad outer product
57+-------------------------------------------------------------------------------
58+
59+o_1_space_outerProduct :: Int -> [Benchmark]
60+o_1_space_outerProduct value =
61+ [ bgroup "monad-outer-product"
62+ [ benchIO "toNullAp" $ toNullAp value S.zipAsyncly
63+ ]
64+ ]
65+
66+-------------------------------------------------------------------------------
67+-- Main
68+-------------------------------------------------------------------------------
69+
70+main :: IO ()
71+main = do
72+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
73+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
74+
75+ where
76+
77+ allBenchmarks size =
78+ [ bgroup (o_1_space_prefix moduleName) $ concat
79+ [ o_1_space_joining size
80+ , o_1_space_outerProduct size
81+ ]
82+ ]
benchmark/Streamly/Benchmark/Prelude/ZipSerial.hsnew file+118
@@ -0,0 +1,118 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2018 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE CPP #-}
9+{-# LANGUAGE FlexibleContexts #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE RankNTypes #-}
12+
13+#ifdef __HADDOCK_VERSION__
14+#undef INSPECTION
15+#endif
16+
17+#ifdef INSPECTION
18+{-# LANGUAGE TemplateHaskell #-}
19+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
20+#endif
21+
22+import Prelude hiding (zip)
23+
24+import Streamly (zipSerially)
25+import qualified Streamly.Prelude as S
26+
27+import Streamly.Benchmark.Common
28+import Streamly.Benchmark.Prelude
29+
30+import Gauge
31+
32+moduleName :: String
33+moduleName = "Prelude.ZipSerial"
34+
35+-------------------------------------------------------------------------------
36+-- Zipping
37+-------------------------------------------------------------------------------
38+
39+{-# INLINE zip #-}
40+zip :: Int -> Int -> IO ()
41+zip count n =
42+ S.drain $
43+ S.zipWith (,) (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
44+
45+#ifdef INSPECTION
46+inspect $ hasNoTypeClasses 'zip
47+inspect $ 'zip `hasNoType` ''SPEC
48+inspect $ 'zip `hasNoType` ''D.Step
49+#endif
50+
51+{-# INLINE zipM #-}
52+zipM :: Int -> Int -> IO ()
53+zipM count n =
54+ S.drain $
55+ S.zipWithM
56+ (curry return)
57+ (sourceUnfoldrMN count n)
58+ (sourceUnfoldrMN count (n + 1))
59+
60+#ifdef INSPECTION
61+inspect $ hasNoTypeClasses 'zipM
62+inspect $ 'zipM `hasNoType` ''SPEC
63+inspect $ 'zipM `hasNoType` ''D.Step
64+#endif
65+
66+o_1_space_joining :: Int -> [Benchmark]
67+o_1_space_joining value =
68+ [ bgroup "joining"
69+ [ benchIOSrc1 "zip (2,x/2)" (zip (value `div` 2))
70+ , benchIOSrc1 "zipM (2,x/2)" (zipM (value `div` 2))
71+ ]
72+ ]
73+
74+-------------------------------------------------------------------------------
75+-- Mapping
76+-------------------------------------------------------------------------------
77+
78+o_1_space_mapping :: Int -> [Benchmark]
79+o_1_space_mapping value =
80+ [ bgroup "mapping"
81+ [ benchIOSink value "fmap" $ fmapN zipSerially 1
82+ ]
83+ ]
84+
85+-------------------------------------------------------------------------------
86+-- Monad outer product
87+-------------------------------------------------------------------------------
88+
89+o_1_space_outerProduct :: Int -> [Benchmark]
90+o_1_space_outerProduct value =
91+ [ bgroup "monad-outer-product"
92+ -- XXX needs fixing
93+ [ benchIO "toNullAp" $ toNullAp value zipSerially
94+ ]
95+ ]
96+
97+-------------------------------------------------------------------------------
98+-- Main
99+-------------------------------------------------------------------------------
100+
101+-- In addition to gauge options, the number of elements in the stream can be
102+-- passed using the --stream-size option.
103+--
104+main :: IO ()
105+main = do
106+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
107+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
108+
109+ where
110+
111+ allBenchmarks size =
112+ [ bgroup (o_1_space_prefix moduleName) $ concat
113+ [ o_1_space_joining size
114+ , o_1_space_mapping size
115+ , o_1_space_outerProduct size
116+ ]
117+ ]
118+
benchmark/lib/Streamly/Benchmark/Common.hs+7−15
@@ -31,7 +31,6 @@ module Streamly.Benchmark.Common
31 , mkListString
31 , mkListString
32
32
33 , defaultStreamSize
33 , defaultStreamSize
34− , limitStreamSize
35 )
34 )
36where
35where
37
36
@@ -40,7 +39,7 @@ import Control.Exception (evaluate)
40import Control.Monad (when)
39import Control.Monad (when)
41import Data.Functor.Identity (Identity, runIdentity)
40import Data.Functor.Identity (Identity, runIdentity)
42import Data.List (scanl')
41import Data.List (scanl')
43−import Data.Maybe (catMaybes)
42+import Data.Maybe (mapMaybe)
44import System.Console.GetOpt
43import System.Console.GetOpt
45 (OptDescr(..), ArgDescr(..), ArgOrder(..), getOpt')
44 (OptDescr(..), ArgDescr(..), ArgOrder(..), getOpt')
46import System.Environment (getArgs, lookupEnv, setEnv)
45import System.Environment (getArgs, lookupEnv, setEnv)
@@ -131,20 +130,11 @@ mkList value = [1..value]
131defaultStreamSize :: Int
130defaultStreamSize :: Int
132defaultStreamSize = 100000
131defaultStreamSize = 100000
133
132
134−limitStreamSize :: Int -> IO Int
135−limitStreamSize value = do
136− let val = min value defaultStreamSize
137− when (val /= value) $
138− putStrLn $ "Limiting stream size to "
139− ++ show defaultStreamSize
140− ++ " for non O(1) space operations"
141− return val
142−
143-------------------------------------------------------------------------------
133-------------------------------------------------------------------------------
144-- Parse custom CLI options
134-- Parse custom CLI options
145-------------------------------------------------------------------------------
135-------------------------------------------------------------------------------
146
136
147−data BenchOpts = StreamSize Int deriving Show
137+newtype BenchOpts = StreamSize Int deriving Show
148
138
149getStreamSize :: String -> Int
139getStreamSize :: String -> Int
150getStreamSize size =
140getStreamSize size =
@@ -186,6 +176,7 @@ parseCLIOpts defStreamSize = do
186 (streamSize, args') <-
176 (streamSize, args') <-
187 case opts of
177 case opts of
188 StreamSize x : _ -> do
178 StreamSize x : _ -> do
179+ putStrLn $ "Stream size: " ++ show x
189 -- When using the gauge "--measure-with" option we need to make
180 -- When using the gauge "--measure-with" option we need to make
190 -- sure that we pass the stream size to child process forked by
181 -- sure that we pass the stream size to child process forked by
191 -- gauge. So we use this env var for that purpose.
182 -- gauge. So we use this env var for that purpose.
@@ -195,8 +186,7 @@ parseCLIOpts defStreamSize = do
195 -- correct order.
186 -- correct order.
196 newArgs <-
187 newArgs <-
197 evaluate
188 evaluate
198− $ catMaybes
189+ $ mapMaybe snd
199− $ map snd
200 $ scanl' deleteOptArgs (Nothing, Nothing) args
190 $ scanl' deleteOptArgs (Nothing, Nothing) args
201 return (x, newArgs)
191 return (x, newArgs)
202 _ -> do
192 _ -> do
@@ -205,7 +195,9 @@ parseCLIOpts defStreamSize = do
205 Just x -> do
195 Just x -> do
206 s <- evaluate $ getStreamSize x
196 s <- evaluate $ getStreamSize x
207 return (s, args)
197 return (s, args)
198+ Nothing -> do
199+ setEnv "STREAM_SIZE" (show defStreamSize)
208− Nothing -> return (defStreamSize, args)
200+ return (defStreamSize, args)
209
201
210 -- Parse gauge options
202 -- Parse gauge options
211 let config = defaultConfig
203 let config = defaultConfig
benchmark/lib/Streamly/Benchmark/Prelude.hs+460−9
@@ -1,16 +1,467 @@
1-- |
1-- |
2-- Module : Streamly.Benchmark.Prelude
2-- Module : Streamly.Benchmark.Prelude
3−-- Copyright : (c) 2018 Harendra Kumar
3+-- Copyright : (c) 2018 Composewell Technologies
4--
4--
5-- License : MIT
5-- License : MIT
6-- Maintainer : streamly@composewell.com
6-- Maintainer : streamly@composewell.com
7
7
8−module Streamly.Benchmark.Prelude
8+{-# LANGUAGE CPP #-}
9− ( module Streamly.Benchmark.Prelude.Generation
9+{-# LANGUAGE FlexibleContexts #-}
10− , module Streamly.Benchmark.Prelude.Elimination
10+{-# LANGUAGE ScopedTypeVariables #-}
11− , module Streamly.Benchmark.Prelude.Transformation
11+{-# LANGUAGE RankNTypes #-}
12− ) where
13
12
14−import Streamly.Benchmark.Prelude.Generation
13+module Streamly.Benchmark.Prelude where
14+
15+import Control.DeepSeq (NFData(..))
16+import Control.Exception (try)
17+import GHC.Exception (ErrorCall)
18+import System.Random (randomRIO)
19+
20+import qualified Data.Foldable as F
21+import qualified Streamly as S
22+import qualified Streamly.Prelude as S
23+import qualified Streamly.Internal.Prelude as Internal
24+import qualified Streamly.Internal.Data.Pipe as Pipe
25+
26+import Gauge
27+import Streamly.Internal.Data.Time.Units
28+
29+-- Common polymorphic stream APIs used across multiple stream modules
30+
31+-------------------------------------------------------------------------------
32+-- Generation
33+-------------------------------------------------------------------------------
34+
35+-------------------------------------------------------------------------------
36+-- enumerate
37+-------------------------------------------------------------------------------
38+
39+{-# INLINE sourceIntFromTo #-}
40+sourceIntFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
41+sourceIntFromTo value n = S.enumerateFromTo n (n + value)
42+
43+{-# INLINE sourceIntFromThenTo #-}
44+sourceIntFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
45+sourceIntFromThenTo value n = S.enumerateFromThenTo n (n + 1) (n + value)
46+
47+{-# INLINE sourceFracFromTo #-}
48+sourceFracFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Double
49+sourceFracFromTo value n =
50+ S.enumerateFromTo (fromIntegral n) (fromIntegral (n + value))
51+
52+{-# INLINE sourceFracFromThenTo #-}
53+sourceFracFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Double
54+sourceFracFromThenTo value n = S.enumerateFromThenTo (fromIntegral n)
55+ (fromIntegral n + 1.0001) (fromIntegral (n + value))
56+
57+{-# INLINE sourceIntegerFromStep #-}
58+sourceIntegerFromStep :: (Monad m, S.IsStream t) => Int -> Int -> t m Integer
59+sourceIntegerFromStep value n =
60+ S.take value $ S.enumerateFromThen (fromIntegral n) (fromIntegral n + 1)
61+
62+-------------------------------------------------------------------------------
63+-- unfold
64+-------------------------------------------------------------------------------
65+
66+{-# INLINE sourceUnfoldr #-}
67+sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
68+sourceUnfoldr count start = S.unfoldr step start
69+ where
70+ step cnt =
71+ if cnt > start + count
72+ then Nothing
73+ else Just (cnt, cnt + 1)
74+
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 #-}
85+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
86+sourceUnfoldrM count start = S.unfoldrM step start
87+ where
88+ step cnt =
89+ if cnt > start + count
90+ then return Nothing
91+ else return (Just (cnt, cnt + 1))
92+
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+-------------------------------------------------------------------------------
103+-- fromIndices
104+-------------------------------------------------------------------------------
105+
106+{-# INLINE _sourceFromIndices #-}
107+_sourceFromIndices :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
108+_sourceFromIndices value n = S.take value $ S.fromIndices (+ n)
109+
110+{-# INLINE _sourceFromIndicesM #-}
111+_sourceFromIndicesM :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
112+_sourceFromIndicesM value n = S.take value $ S.fromIndicesM (fmap return (+ n))
113+
114+-------------------------------------------------------------------------------
115+-- fromList
116+-------------------------------------------------------------------------------
117+
118+{-# INLINE sourceFromList #-}
119+sourceFromList :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
120+sourceFromList value n = S.fromList [n..n+value]
121+
122+{-# INLINE sourceFromListM #-}
123+sourceFromListM :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
124+sourceFromListM value n = S.fromListM (fmap return [n..n+value])
125+
126+-------------------------------------------------------------------------------
127+-- fromFoldable
128+-------------------------------------------------------------------------------
129+
130+{-# INLINE sourceFromFoldable #-}
131+sourceFromFoldable :: S.IsStream t => Int -> Int -> t m Int
132+sourceFromFoldable value n = S.fromFoldable [n..n+value]
133+
134+{-# INLINE sourceFromFoldableM #-}
135+sourceFromFoldableM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
136+sourceFromFoldableM value n = S.fromFoldableM (fmap return [n..n+value])
137+
138+-------------------------------------------------------------------------------
139+-- Time enumeration
140+-------------------------------------------------------------------------------
141+
142+{-# INLINE absTimes #-}
143+absTimes :: (S.IsStream t, S.MonadAsync m, Functor (t m))
144+ => Int -> Int -> t m AbsTime
145+absTimes value _ = S.take value Internal.absTimes
146+
147+-------------------------------------------------------------------------------
15−import Streamly.Benchmark.Prelude.Elimination
148+-- Elimination
16−import Streamly.Benchmark.Prelude.Transformation
149+-------------------------------------------------------------------------------
150+
151+{-# INLINE toNull #-}
152+toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m ()
153+toNull t = S.drain . t
154+
155+-- We need a monadic bind here to make sure that the function f does not get
156+-- completely optimized out by the compiler in some cases.
157+
158+-- | Takes a fold method, and uses it with a default source.
159+{-# INLINE benchIOSink #-}
160+benchIOSink
161+ :: (S.IsStream t, NFData b)
162+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
163+benchIOSink value name f =
164+ bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
165+
166+-- | Takes a source, and uses it with a default drain/fold method.
167+{-# INLINE benchIOSrc #-}
168+benchIOSrc
169+ :: (t IO a -> S.SerialT IO a)
170+ -> String
171+ -> (Int -> t IO a)
172+ -> Benchmark
173+benchIOSrc t name f =
174+ bench name $ nfIO $ randomRIO (1,1) >>= toNull t . f
175+
176+{-# INLINE benchIO #-}
177+benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
178+benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
179+
180+-------------------------------------------------------------------------------
181+-- Mapping
182+-------------------------------------------------------------------------------
183+
184+{-# INLINE sourceUnfoldrAction #-}
185+sourceUnfoldrAction :: (S.IsStream t, Monad m, Monad m1)
186+ => Int -> Int -> t m (m1 Int)
187+sourceUnfoldrAction value n = S.serially $ S.unfoldr step n
188+ where
189+ step cnt =
190+ if cnt > n + value
191+ then Nothing
192+ else Just (return cnt, cnt + 1)
193+
194+{-# INLINE composeN #-}
195+composeN ::
196+ (S.IsStream t, Monad m)
197+ => Int
198+ -> (t m Int -> S.SerialT m Int)
199+ -> t m Int
200+ -> m ()
201+composeN n f =
202+ case n of
203+ 1 -> S.drain . f
204+ 2 -> S.drain . f . S.adapt . f
205+ 3 -> S.drain . f . S.adapt . f . S.adapt . f
206+ 4 -> S.drain . f . S.adapt . f . S.adapt . f . S.adapt . f
207+ _ -> undefined
208+
209+{-# INLINE fmapN #-}
210+fmapN ::
211+ (S.IsStream t, S.MonadAsync m, Functor (t m))
212+ => (t m Int -> S.SerialT m Int)
213+ -> Int
214+ -> t m Int
215+ -> m ()
216+fmapN t n = composeN n $ t . fmap (+ 1)
217+
218+{-# INLINE mapN #-}
219+mapN ::
220+ (S.IsStream t, S.MonadAsync m)
221+ => (t m Int -> S.SerialT m Int)
222+ -> Int
223+ -> t m Int
224+ -> m ()
225+mapN t n = composeN n $ t . S.map (+ 1)
226+
227+{-# INLINE mapM #-}
228+mapM ::
229+ (S.IsStream t, S.MonadAsync m)
230+ => (t m Int -> S.SerialT m Int)
231+ -> Int
232+ -> t m Int
233+ -> m ()
234+mapM t n = composeN n $ t . S.mapM return
235+
236+-------------------------------------------------------------------------------
237+-- Pipes
238+-------------------------------------------------------------------------------
239+
240+{-# INLINE transformMapM #-}
241+transformMapM ::
242+ (S.IsStream t, S.MonadAsync m)
243+ => (t m Int -> S.SerialT m Int)
244+ -> Int
245+ -> t m Int
246+ -> m ()
247+transformMapM t n = composeN n $ t . Internal.transform (Pipe.mapM return)
248+
249+{-# INLINE transformComposeMapM #-}
250+transformComposeMapM ::
251+ (S.IsStream t, S.MonadAsync m)
252+ => (t m Int -> S.SerialT m Int)
253+ -> Int
254+ -> t m Int
255+ -> m ()
256+transformComposeMapM t n =
257+ composeN n $
258+ t .
259+ Internal.transform
260+ (Pipe.mapM (\x -> return (x + 1)) `Pipe.compose`
261+ Pipe.mapM (\x -> return (x + 2)))
262+
263+{-# INLINE transformTeeMapM #-}
264+transformTeeMapM ::
265+ (S.IsStream t, S.MonadAsync m)
266+ => (t m Int -> S.SerialT m Int)
267+ -> Int
268+ -> t m Int
269+ -> m ()
270+transformTeeMapM t n =
271+ composeN n $
272+ t .
273+ Internal.transform
274+ (Pipe.mapM (\x -> return (x + 1)) `Pipe.tee`
275+ Pipe.mapM (\x -> return (x + 2)))
276+
277+{-# INLINE transformZipMapM #-}
278+transformZipMapM ::
279+ (S.IsStream t, S.MonadAsync m)
280+ => (t m Int -> S.SerialT m Int)
281+ -> Int
282+ -> t m Int
283+ -> m ()
284+transformZipMapM t n =
285+ composeN n $
286+ t .
287+ Internal.transform
288+ (Pipe.zipWith
289+ (+)
290+ (Pipe.mapM (\x -> return (x + 1)))
291+ (Pipe.mapM (\x -> return (x + 2))))
292+
293+-------------------------------------------------------------------------------
294+-- Streams of streams
295+-------------------------------------------------------------------------------
296+
297+-------------------------------------------------------------------------------
298+-- Concat foldable
299+-------------------------------------------------------------------------------
300+
301+{-# INLINE sourceFoldMapWith #-}
302+sourceFoldMapWith :: (S.IsStream t, S.Semigroup (t m Int))
303+ => Int -> Int -> t m Int
304+sourceFoldMapWith value n = S.foldMapWith (S.<>) S.yield [n..n+value]
305+
306+{-# INLINE sourceFoldMapWithM #-}
307+sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))
308+ => Int -> Int -> t m Int
309+sourceFoldMapWithM value n =
310+ S.foldMapWith (S.<>) (S.yieldM . return) [n..n+value]
311+
312+{-# INLINE sourceFoldMapM #-}
313+sourceFoldMapM :: (S.IsStream t, Monad m, Monoid (t m Int))
314+ => Int -> Int -> t m Int
315+sourceFoldMapM value n = F.foldMap (S.yieldM . return) [n..n+value]
316+
317+-------------------------------------------------------------------------------
318+-- Concat
319+-------------------------------------------------------------------------------
320+
321+{-# INLINE sourceConcatMapId #-}
322+sourceConcatMapId :: (S.IsStream t, Monad m)
323+ => Int -> Int -> t m Int
324+sourceConcatMapId value n =
325+ S.concatMap id $ S.fromFoldable $ fmap (S.yieldM . return) [n..n+value]
326+
327+-- concatMapWith
328+
329+{-# INLINE concatStreamsWith #-}
330+concatStreamsWith
331+ :: (forall c. S.SerialT IO c -> S.SerialT IO c -> S.SerialT IO c)
332+ -> Int
333+ -> Int
334+ -> Int
335+ -> IO ()
336+concatStreamsWith op outer inner n =
337+ S.drain $ S.concatMapWith op
338+ (sourceUnfoldrMN inner)
339+ (sourceUnfoldrMN outer n)
340+
341+-------------------------------------------------------------------------------
342+-- Monadic outer product
343+-------------------------------------------------------------------------------
344+
345+{-# INLINE runToList #-}
346+runToList :: Monad m => S.SerialT m a -> m [a]
347+runToList = S.toList
348+
349+{-# INLINE toNullAp #-}
350+toNullAp
351+ :: (S.IsStream t, S.MonadAsync m, Applicative (t m))
352+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
353+toNullAp linearCount t start = S.drain . t $
354+ (+) <$> sourceUnfoldrM nestedCount2 start
355+ <*> sourceUnfoldrM nestedCount2 start
356+
357+ where
358+
359+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
360+
361+{-# INLINE toNullM #-}
362+toNullM
363+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
364+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
365+toNullM linearCount t start = S.drain . t $ do
366+ x <- sourceUnfoldrM nestedCount2 start
367+ y <- sourceUnfoldrM nestedCount2 start
368+ return $ x + y
369+
370+ where
371+
372+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
373+
374+{-# INLINE toNullM3 #-}
375+toNullM3
376+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
377+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
378+toNullM3 linearCount t start = S.drain . t $ do
379+ x <- sourceUnfoldrM nestedCount3 start
380+ y <- sourceUnfoldrM nestedCount3 start
381+ z <- sourceUnfoldrM nestedCount3 start
382+ return $ x + y + z
383+ where
384+ nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
385+
386+{-# INLINE toListM #-}
387+toListM
388+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
389+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
390+toListM linearCount t start = runToList . t $ do
391+ x <- sourceUnfoldrM nestedCount2 start
392+ y <- sourceUnfoldrM nestedCount2 start
393+ return $ x + y
394+ where
395+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
396+
397+-- Taking a specified number of elements is very expensive in logict so we have
398+-- a test to measure the same.
399+{-# INLINE toListSome #-}
400+toListSome
401+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
402+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
403+toListSome linearCount t start =
404+ runToList . t $ S.take 10000 $ do
405+ x <- sourceUnfoldrM nestedCount2 start
406+ y <- sourceUnfoldrM nestedCount2 start
407+ return $ x + y
408+ where
409+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
410+
411+{-# INLINE filterAllOutM #-}
412+filterAllOutM
413+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
414+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
415+filterAllOutM linearCount t start = S.drain . t $ do
416+ x <- sourceUnfoldrM nestedCount2 start
417+ y <- sourceUnfoldrM nestedCount2 start
418+ let s = x + y
419+ if s < 0
420+ then return s
421+ else S.nil
422+ where
423+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
424+
425+{-# INLINE filterAllInM #-}
426+filterAllInM
427+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
428+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
429+filterAllInM linearCount t start = S.drain . t $ do
430+ x <- sourceUnfoldrM nestedCount2 start
431+ y <- sourceUnfoldrM nestedCount2 start
432+ let s = x + y
433+ if s > 0
434+ then return s
435+ else S.nil
436+ where
437+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
438+
439+{-# INLINE filterSome #-}
440+filterSome
441+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
442+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
443+filterSome linearCount t start = S.drain . t $ do
444+ x <- sourceUnfoldrM nestedCount2 start
445+ y <- sourceUnfoldrM nestedCount2 start
446+ let s = x + y
447+ if s > 1100000
448+ then return s
449+ else S.nil
450+ where
451+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
452+
453+{-# INLINE breakAfterSome #-}
454+breakAfterSome
455+ :: (S.IsStream t, Monad (t IO))
456+ => Int -> (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
457+breakAfterSome linearCount t start = do
458+ (_ :: Either ErrorCall ()) <- try $ S.drain . t $ do
459+ x <- sourceUnfoldrM nestedCount2 start
460+ y <- sourceUnfoldrM nestedCount2 start
461+ let s = x + y
462+ if s > 1100000
463+ then error "break"
464+ else return s
465+ return ()
466+ where
467+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
benchmark/lib/Streamly/Benchmark/Prelude/Elimination.hsdeleted−795
@@ -1,795 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Prelude
3−-- Copyright : (c) 2018 Harendra Kumar
4−--
5−-- License : MIT
6−-- Maintainer : streamly@composewell.com
7−
8−{-# LANGUAGE CPP #-}
9−{-# LANGUAGE FlexibleContexts #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE DeriveAnyClass #-}
12−{-# LANGUAGE DeriveGeneric #-}
13−{-# LANGUAGE RankNTypes #-}
14−
15−#ifdef __HADDOCK_VERSION__
16−#undef INSPECTION
17−#endif
18−
19−#ifdef INSPECTION
20−{-# LANGUAGE TemplateHaskell #-}
21−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
22−#endif
23−
24−module Streamly.Benchmark.Prelude.Elimination
25− ( o_1_space_serial_pure
26− , o_1_space_serial_foldable
27− , o_1_space_serial_elimination
28− , o_1_space_serial_foldMultiStream
29−
30− , o_n_space_serial_toList
31−
32− , o_n_space_serial_foldr
33− , o_n_heap_serial_foldl
34− ) where
35−
36−import Control.DeepSeq (NFData(..))
37−import Control.Monad.IO.Class (MonadIO(..))
38−import Data.Functor.Identity (Identity, runIdentity)
39−
40−import System.Random (randomRIO)
41−import Prelude
42− (Monad, String, Int, (+), ($), (.), return, (>), (<=), (==),
43− undefined, Maybe(..), Bool, (>>=), IO, compare, flip)
44−import qualified Prelude as P
45−import qualified Data.Foldable as F
46−import qualified GHC.Exts as GHC
47−
48−#ifdef INSPECTION
49−import GHC.Types (SPEC(..))
50−import Test.Inspection
51−
52−import qualified Streamly.Internal.Data.Stream.StreamD as D
53−#endif
54−
55−import qualified Streamly as S hiding (runStream)
56−import qualified Streamly.Prelude as S
57−import qualified Streamly.Internal.Prelude as Internal
58−
59−import qualified Streamly.Internal.Prelude as IP
60−
61−
62−import Gauge
63−import Streamly hiding (runStream)
64−import Streamly.Benchmark.Common
65−
66−type Stream m a = S.SerialT m a
67−
68−
69−-------------------------------------------------------------------------------
70−-- Stream generation
71−-------------------------------------------------------------------------------
72−
73−-- unfoldr
74−
75−{-# INLINE sourceUnfoldr #-}
76−sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
77−sourceUnfoldr value n = S.unfoldr step n
78− where
79− step cnt =
80− if cnt > n + value
81− then Nothing
82− else Just (cnt, cnt + 1)
83−
84−{-# INLINE sourceUnfoldrM #-}
85−sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
86−sourceUnfoldrM value n = S.unfoldrM step n
87− where
88− step cnt =
89− if cnt > n + value
90− then return Nothing
91− else return (Just (cnt, cnt + 1))
92−
93−{-# INLINE source #-}
94−source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
95−source = sourceUnfoldrM
96−
97−{-# INLINE sourceUnfoldrAction #-}
98−sourceUnfoldrAction :: (S.IsStream t, Monad m, Monad m1)
99− => Int -> Int -> t m (m1 Int)
100−sourceUnfoldrAction value n = S.serially $ S.unfoldr step n
101− where
102− step cnt =
103− if cnt > n + value
104− then Nothing
105− else (Just (return cnt, cnt + 1))
106−
107−-- fromIndices
108−
109−{-# INLINE sourceIsList #-}
110−sourceIsList :: Int -> Int -> S.SerialT Identity Int
111−sourceIsList value n = GHC.fromList [n..n+value]
112−
113−{-# INLINE sourceIsString #-}
114−sourceIsString :: Int -> Int -> S.SerialT Identity P.Char
115−sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
116−
117−-------------------------------------------------------------------------------
118−-- Elimination
119−-------------------------------------------------------------------------------
120−
121−{-# INLINE runStream #-}
122−runStream :: Monad m => Stream m a -> m ()
123−runStream = S.drain
124−
125−{-# INLINE toNull #-}
126−toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m ()
127−toNull t = runStream . t
128−
129−{-# INLINE uncons #-}
130−uncons :: Monad m => Stream m Int -> m ()
131−uncons s = do
132− r <- S.uncons s
133− case r of
134− Nothing -> return ()
135− Just (_, t) -> uncons t
136−
137−{-# INLINE init #-}
138−init :: Monad m => Stream m a -> m ()
139−init s = S.init s >>= P.mapM_ S.drain
140−
141−{-# INLINE mapM_ #-}
142−mapM_ :: Monad m => Stream m Int -> m ()
143−mapM_ = S.mapM_ (\_ -> return ())
144−
145−{-# INLINE toList #-}
146−toList :: Monad m => Stream m Int -> m [Int]
147−toList = S.toList
148−
149−{-# INLINE toListRev #-}
150−toListRev :: Monad m => Stream m Int -> m [Int]
151−toListRev = Internal.toListRev
152−
153−{-# INLINE foldrMElem #-}
154−foldrMElem :: Monad m => Int -> Stream m Int -> m Bool
155−foldrMElem e m =
156− S.foldrM
157− (\x xs ->
158− if x == e
159− then return P.True
160− else xs)
161− (return P.False)
162− m
163−
164−{-# INLINE foldrMToStream #-}
165−foldrMToStream :: Monad m => Stream m Int -> m (Stream Identity Int)
166−foldrMToStream = S.foldr S.cons S.nil
167−
168−{-# INLINE foldrMBuild #-}
169−foldrMBuild :: Monad m => Stream m Int -> m [Int]
170−foldrMBuild = S.foldrM (\x xs -> xs >>= return . (x :)) (return [])
171−
172−{-# INLINE foldl'Build #-}
173−foldl'Build :: Monad m => Stream m Int -> m [Int]
174−foldl'Build = S.foldl' (flip (:)) []
175−
176−{-# INLINE foldlM'Build #-}
177−foldlM'Build :: Monad m => Stream m Int -> m [Int]
178−foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) []
179−
180−{-# INLINE foldrMReduce #-}
181−foldrMReduce :: Monad m => Stream m Int -> m Int
182−foldrMReduce = S.foldrM (\x xs -> xs >>= return . (x +)) (return 0)
183−
184−{-# INLINE foldl'Reduce #-}
185−foldl'Reduce :: Monad m => Stream m Int -> m Int
186−foldl'Reduce = S.foldl' (+) 0
187−
188−{-# INLINE foldl1'Reduce #-}
189−foldl1'Reduce :: Monad m => Stream m Int -> m (Maybe Int)
190−foldl1'Reduce = S.foldl1' (+)
191−
192−{-# INLINE foldlM'Reduce #-}
193−foldlM'Reduce :: Monad m => Stream m Int -> m Int
194−foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) 0
195−
196−{-# INLINE last #-}
197−last :: Monad m => Stream m Int -> m (Maybe Int)
198−last = S.last
199−
200−{-# INLINE _null #-}
201−_null :: Monad m => Stream m Int -> m Bool
202−_null = S.null
203−
204−{-# INLINE _head #-}
205−_head :: Monad m => Stream m Int -> m (Maybe Int)
206−_head = S.head
207−
208−{-# INLINE elem #-}
209−elem :: Monad m => Int -> Stream m Int -> m Bool
210−elem value = S.elem (value + 1)
211−
212−{-# INLINE notElem #-}
213−notElem :: Monad m => Int -> Stream m Int -> m Bool
214−notElem value = S.notElem (value + 1)
215−
216−{-# INLINE length #-}
217−length :: Monad m => Stream m Int -> m Int
218−length = S.length
219−
220−{-# INLINE all #-}
221−all :: Monad m => Int -> Stream m Int -> m Bool
222−all value = S.all (<= (value + 1))
223−
224−{-# INLINE any #-}
225−any :: Monad m => Int -> Stream m Int -> m Bool
226−any value = S.any (> (value + 1))
227−
228−{-# INLINE and #-}
229−and :: Monad m => Int -> Stream m Int -> m Bool
230−and value = S.and . S.map (<= (value + 1))
231−
232−{-# INLINE or #-}
233−or :: Monad m => Int -> Stream m Int -> m Bool
234−or value = S.or . S.map (> (value + 1))
235−
236−{-# INLINE find #-}
237−find :: Monad m => Int -> Stream m Int -> m (Maybe Int)
238−find value = S.find (== (value + 1))
239−
240−{-# INLINE findIndex #-}
241−findIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
242−findIndex value = S.findIndex (== (value + 1))
243−
244−{-# INLINE elemIndex #-}
245−elemIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
246−elemIndex value = S.elemIndex (value + 1)
247−
248−{-# INLINE maximum #-}
249−maximum :: Monad m => Stream m Int -> m (Maybe Int)
250−maximum = S.maximum
251−
252−{-# INLINE minimum #-}
253−minimum :: Monad m => Stream m Int -> m (Maybe Int)
254−minimum = S.minimum
255−
256−{-# INLINE sum #-}
257−sum :: Monad m => Stream m Int -> m Int
258−sum = S.sum
259−
260−{-# INLINE product #-}
261−product :: Monad m => Stream m Int -> m Int
262−product = S.product
263−
264−{-# INLINE minimumBy #-}
265−minimumBy :: Monad m => Stream m Int -> m (Maybe Int)
266−minimumBy = S.minimumBy compare
267−
268−{-# INLINE maximumBy #-}
269−maximumBy :: Monad m => Stream m Int -> m (Maybe Int)
270−maximumBy = S.maximumBy compare
271−
272−-------------------------------------------------------------------------------
273−-- Transformation
274−-------------------------------------------------------------------------------
275−
276−{-# INLINE transform #-}
277−transform :: Monad m => Stream m a -> m ()
278−transform = runStream
279−
280−{-# INLINE composeN #-}
281−composeN ::
282− MonadIO m
283− => Int
284− -> (Stream m Int -> Stream m Int)
285− -> Stream m Int
286− -> m ()
287−composeN n f =
288− case n of
289− 1 -> transform . f
290− 2 -> transform . f . f
291− 3 -> transform . f . f . f
292− 4 -> transform . f . f . f . f
293− _ -> undefined
294−
295−{-# INLINE reverse #-}
296−reverse :: MonadIO m => Int -> Stream m Int -> m ()
297−reverse n = composeN n $ S.reverse
298−
299−{-# INLINE reverse' #-}
300−reverse' :: MonadIO m => Int -> Stream m Int -> m ()
301−reverse' n = composeN n $ Internal.reverse'
302−
303−-------------------------------------------------------------------------------
304−-- Multi-stream folds
305−-------------------------------------------------------------------------------
306−
307−{-# INLINE isPrefixOf #-}
308−isPrefixOf :: Monad m => Stream m Int -> m Bool
309−isPrefixOf src = S.isPrefixOf src src
310−
311−{-# INLINE isSubsequenceOf #-}
312−isSubsequenceOf :: Monad m => Stream m Int -> m Bool
313−isSubsequenceOf src = S.isSubsequenceOf src src
314−
315−{-# INLINE stripPrefix #-}
316−stripPrefix :: Monad m => Stream m Int -> m ()
317−stripPrefix src = do
318− _ <- S.stripPrefix src src
319− return ()
320−
321−{-# INLINE eqBy' #-}
322−eqBy' :: (Monad m, P.Eq a) => Stream m a -> m P.Bool
323−eqBy' src = S.eqBy (==) src src
324−
325−{-# INLINE eqBy #-}
326−eqBy :: Int -> Int -> IO Bool
327−eqBy value n = eqBy' (source value n)
328−
329−#ifdef INSPECTION
330−inspect $ hasNoTypeClasses 'eqBy
331−inspect $ 'eqBy `hasNoType` ''SPEC
332−inspect $ 'eqBy `hasNoType` ''D.Step
333−#endif
334−
335−
336−{-# INLINE eqByPure #-}
337−eqByPure :: Int -> Int -> Identity Bool
338−eqByPure value n = eqBy' (sourceUnfoldr value n)
339−
340−#ifdef INSPECTION
341−inspect $ hasNoTypeClasses 'eqByPure
342−inspect $ 'eqByPure `hasNoType` ''SPEC
343−inspect $ 'eqByPure `hasNoType` ''D.Step
344−#endif
345−
346−{-# INLINE cmpBy' #-}
347−cmpBy' :: (Monad m, P.Ord a) => Stream m a -> m P.Ordering
348−cmpBy' src = S.cmpBy P.compare src src
349−
350−{-# INLINE cmpBy #-}
351−cmpBy :: Int -> Int -> IO P.Ordering
352−cmpBy value n = cmpBy' (source value n)
353−
354−#ifdef INSPECTION
355−inspect $ hasNoTypeClasses 'cmpBy
356−inspect $ 'cmpBy `hasNoType` ''SPEC
357−inspect $ 'cmpBy `hasNoType` ''D.Step
358−#endif
359−
360−{-# INLINE cmpByPure #-}
361−cmpByPure :: Int -> Int -> Identity P.Ordering
362−cmpByPure value n = cmpBy' (sourceUnfoldr value n)
363−
364−#ifdef INSPECTION
365−inspect $ hasNoTypeClasses 'cmpByPure
366−inspect $ 'cmpByPure `hasNoType` ''SPEC
367−inspect $ 'cmpByPure `hasNoType` ''D.Step
368−#endif
369−
370−-------------------------------------------------------------------------------
371−-- Type class instances
372−-------------------------------------------------------------------------------
373−
374−{-# INLINE eqInstance #-}
375−eqInstance :: Stream Identity Int -> Bool
376−eqInstance src = src == src
377−
378−{-# INLINE eqInstanceNotEq #-}
379−eqInstanceNotEq :: Stream Identity Int -> Bool
380−eqInstanceNotEq src = src P./= src
381−
382−{-# INLINE ordInstance #-}
383−ordInstance :: Stream Identity Int -> Bool
384−ordInstance src = src P.< src
385−
386−{-# INLINE ordInstanceMin #-}
387−ordInstanceMin :: Stream Identity Int -> Stream Identity Int
388−ordInstanceMin src = P.min src src
389−
390−{-# INLINE showInstance #-}
391−showInstance :: Stream Identity Int -> P.String
392−showInstance src = P.show src
393−
394−-------------------------------------------------------------------------------
395−-- Pure (Identity) streams
396−-------------------------------------------------------------------------------
397−
398−{-# INLINE pureFoldl' #-}
399−pureFoldl' :: Stream Identity Int -> Int
400−pureFoldl' = runIdentity . S.foldl' (+) 0
401−
402−-------------------------------------------------------------------------------
403−-- Foldable Instance
404−-------------------------------------------------------------------------------
405−
406−{-# INLINE foldableFoldl' #-}
407−foldableFoldl' :: Int -> Int -> Int
408−foldableFoldl' value n =
409− F.foldl' (+) 0 (sourceUnfoldr value n :: S.SerialT Identity Int)
410−
411−{-# INLINE foldableFoldrElem #-}
412−foldableFoldrElem :: Int -> Int -> Bool
413−foldableFoldrElem value n =
414− F.foldr (\x xs -> if x == value then P.True else xs)
415− (P.False)
416− (sourceUnfoldr value n :: S.SerialT Identity Int)
417−
418−{-# INLINE foldableSum #-}
419−foldableSum :: Int -> Int -> Int
420−foldableSum value n =
421− P.sum (sourceUnfoldr value n :: S.SerialT Identity Int)
422−
423−{-# INLINE foldableProduct #-}
424−foldableProduct :: Int -> Int -> Int
425−foldableProduct value n =
426− P.product (sourceUnfoldr value n :: S.SerialT Identity Int)
427−
428−{-# INLINE _foldableNull #-}
429−_foldableNull :: Int -> Int -> Bool
430−_foldableNull value n =
431− P.null (sourceUnfoldr value n :: S.SerialT Identity Int)
432−
433−{-# INLINE foldableElem #-}
434−foldableElem :: Int -> Int -> Bool
435−foldableElem value n =
436− P.elem value (sourceUnfoldr value n :: S.SerialT Identity Int)
437−
438−{-# INLINE foldableNotElem #-}
439−foldableNotElem :: Int -> Int -> Bool
440−foldableNotElem value n =
441− P.notElem value (sourceUnfoldr value n :: S.SerialT Identity Int)
442−
443−{-# INLINE foldableFind #-}
444−foldableFind :: Int -> Int -> Maybe Int
445−foldableFind value n =
446− F.find (== (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
447−
448−{-# INLINE foldableAll #-}
449−foldableAll :: Int -> Int -> Bool
450−foldableAll value n =
451− P.all (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
452−
453−{-# INLINE foldableAny #-}
454−foldableAny :: Int -> Int -> Bool
455−foldableAny value n =
456− P.any (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
457−
458−{-# INLINE foldableAnd #-}
459−foldableAnd :: Int -> Int -> Bool
460−foldableAnd value n =
461− P.and $ S.map (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
462−
463−{-# INLINE foldableOr #-}
464−foldableOr :: Int -> Int -> Bool
465−foldableOr value n =
466− P.or $ S.map (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
467−
468−{-# INLINE foldableLength #-}
469−foldableLength :: Int -> Int -> Int
470−foldableLength value n =
471− P.length (sourceUnfoldr value n :: S.SerialT Identity Int)
472−
473−{-# INLINE foldableMin #-}
474−foldableMin :: Int -> Int -> Int
475−foldableMin value n =
476− P.minimum (sourceUnfoldr value n :: S.SerialT Identity Int)
477−
478−{-# INLINE foldableMax #-}
479−foldableMax :: Int -> Int -> Int
480−foldableMax value n =
481− P.maximum (sourceUnfoldr value n :: S.SerialT Identity Int)
482−
483−{-# INLINE foldableMinBy #-}
484−foldableMinBy :: Int -> Int -> Int
485−foldableMinBy value n =
486− F.minimumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
487−
488−{-# INLINE foldableListMinBy #-}
489−foldableListMinBy :: Int -> Int -> Int
490−foldableListMinBy value n = F.minimumBy compare [1..value+n]
491−
492−{-# INLINE foldableMaxBy #-}
493−foldableMaxBy :: Int -> Int -> Int
494−foldableMaxBy value n =
495− F.maximumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
496−
497−{-# INLINE foldableToList #-}
498−foldableToList :: Int -> Int -> [Int]
499−foldableToList value n =
500− F.toList (sourceUnfoldr value n :: S.SerialT Identity Int)
501−
502−{-# INLINE foldableMapM_ #-}
503−foldableMapM_ :: Monad m => Int -> Int -> m ()
504−foldableMapM_ value n =
505− F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: S.SerialT Identity Int)
506−
507−{-# INLINE foldableSequence_ #-}
508−foldableSequence_ :: Int -> Int -> IO ()
509−foldableSequence_ value n =
510− F.sequence_ (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
511−
512−{-# INLINE _foldableMsum #-}
513−_foldableMsum :: Int -> Int -> IO Int
514−_foldableMsum value n =
515− F.msum (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
516−
517−-------------------------------------------------------------------------------
518−-- Benchmark groups
519−-------------------------------------------------------------------------------
520−
521−-- We need a monadic bind here to make sure that the function f does not get
522−-- completely optimized out by the compiler in some cases.
523−
524−-- | Takes a fold method, and uses it with a default source.
525−{-# INLINE benchIOSink #-}
526−benchIOSink
527− :: (IsStream t, NFData b)
528− => Int -> String -> (t IO Int -> IO b) -> Benchmark
529−benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
530−
531−{-# INLINE benchHoistSink #-}
532−benchHoistSink
533− :: (IsStream t, NFData b)
534− => Int -> String -> (t Identity Int -> IO b) -> Benchmark
535−benchHoistSink value name f =
536− bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
537−
538−-- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but
539−-- we can't use it as it requires MonadAsync constraint.
540−{-# INLINE benchIdentitySink #-}
541−benchIdentitySink
542− :: (IsStream t, NFData b)
543− => Int -> String -> (t Identity Int -> Identity b) -> Benchmark
544−benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
545−
546−{-# INLINE benchPureSink #-}
547−benchPureSink :: NFData b => Int -> String -> (SerialT Identity Int -> b) -> Benchmark
548−benchPureSink value name f = benchPure name (sourceUnfoldr value) f
549−
550−-------------------------------------------------------------------------------
551−-- Benchmark groups
552−-------------------------------------------------------------------------------
553−
554−o_1_space_serial_pure :: Int -> [Benchmark]
555−o_1_space_serial_pure value =
556− [ bgroup
557− "serially"
558− [ bgroup
559− "pure"
560− [ benchPureSink value "id" P.id
561− , benchPureSink1 "eqBy" (eqByPure value)
562− , benchPureSink value "==" eqInstance
563− , benchPureSink value "/=" eqInstanceNotEq
564− , benchPureSink1 "cmpBy" (cmpByPure value)
565− , benchPureSink value "<" ordInstance
566− , benchPureSink value "min" ordInstanceMin
567− , benchPureSrc "IsList.fromList" (sourceIsList value)
568− -- length is used to check for foldr/build fusion
569− , benchPureSink
570− value
571− "length . IsList.toList"
572− (P.length . GHC.toList)
573− , benchPureSrc "IsString.fromString" (sourceIsString value)
574− , benchPureSink value "showsPrec pure streams" showInstance
575− , benchPureSink value "foldl'" pureFoldl'
576− ]
577− ]
578− ]
579−
580−
581−o_1_space_serial_foldable :: Int -> [Benchmark]
582−o_1_space_serial_foldable value =
583− [ bgroup
584− "serially"
585− [ bgroup
586− "foldable"
587− -- Foldable instance
588− -- type class operations
589− [ bench "foldl'" $ nf (foldableFoldl' value) 1
590− , bench "foldrElem" $ nf (foldableFoldrElem value) 1
591− -- , bench "null" $ nf (_foldableNull value) 1
592− , bench "elem" $ nf (foldableElem value) 1
593− , bench "length" $ nf (foldableLength value) 1
594− , bench "sum" $ nf (foldableSum value) 1
595− , bench "product" $ nf (foldableProduct value) 1
596− , bench "minimum" $ nf (foldableMin value) 1
597− , bench "maximum" $ nf (foldableMax value) 1
598− , bench "length . toList" $
599− nf (P.length . foldableToList value) 1
600− -- folds
601− , bench "notElem" $ nf (foldableNotElem value) 1
602− , bench "find" $ nf (foldableFind value) 1
603− , bench "all" $ nf (foldableAll value) 1
604− , bench "any" $ nf (foldableAny value) 1
605− , bench "and" $ nf (foldableAnd value) 1
606− , bench "or" $ nf (foldableOr value) 1
607− -- Note: minimumBy/maximumBy do not work in constant memory they are in
608− -- the O(n) group of benchmarks down below in this file.
609− -- Applicative and Traversable operations
610− -- TBD: traverse_
611− , benchIOSink1 "mapM_" (foldableMapM_ value)
612− -- TBD: for_
613− -- TBD: forM_
614− , benchIOSink1 "sequence_" (foldableSequence_ value)
615− -- TBD: sequenceA_
616− -- TBD: asum
617− -- , benchIOSink1 "msum" (_foldableMsum value)
618− ]
619− ]
620− ]
621−
622−
623−o_1_space_serial_elimination :: Int -> [Benchmark]
624−o_1_space_serial_elimination value =
625− [ bgroup
626− "serially"
627− [ bgroup
628− "elimination"
629− [ bgroup
630− "reduce"
631− [ bgroup
632− "IO"
633− [ benchIOSink value "foldl'" foldl'Reduce
634− , benchIOSink value "foldl1'" foldl1'Reduce
635− , benchIOSink value "foldlM'" foldlM'Reduce
636− ]
637− , bgroup
638− "Identity"
639− [ benchIdentitySink value "foldl'" foldl'Reduce
640− , benchIdentitySink
641− value
642− "foldl1'"
643− foldl1'Reduce
644− , benchIdentitySink
645− value
646− "foldlM'"
647− foldlM'Reduce
648− ]
649− ]
650− , bgroup
651− "build"
652− [ bgroup
653− "IO"
654− [ benchIOSink
655− value
656− "foldrMElem"
657− (foldrMElem value)
658− ]
659− , bgroup
660− "Identity"
661− [ benchIdentitySink
662− value
663− "foldrMElem"
664− (foldrMElem value)
665− , benchIdentitySink
666− value
667− "foldrMToStreamLength"
668− (S.length . runIdentity . foldrMToStream)
669− , benchPureSink
670− value
671− "foldrMToListLength"
672− (P.length . runIdentity . foldrMBuild)
673− ]
674− ]
675− , benchIOSink value "uncons" uncons
676− , benchIOSink value "toNull" $ toNull serially
677− , benchIOSink value "mapM_" mapM_
678− , benchIOSink value "init" init
679− -- this is too low and causes all benchmarks reported in ns
680− -- , benchIOSink value "head" head
681− , benchIOSink value "last" last
682− -- , benchIOSink value "lookup" lookup
683− , benchIOSink value "find" (find value)
684− , benchIOSink value "findIndex" (findIndex value)
685− , benchIOSink value "elemIndex" (elemIndex value)
686− -- this is too low and causes all benchmarks reported in ns
687− -- , benchIOSink value "null" null
688− , benchIOSink value "elem" (elem value)
689− , benchIOSink value "notElem" (notElem value)
690− , benchIOSink value "all" (all value)
691− , benchIOSink value "any" (any value)
692− , benchIOSink value "and" (and value)
693− , benchIOSink value "or" (or value)
694− , benchIOSink value "length" length
695− , benchHoistSink
696− value
697− "length . generally"
698− (length . IP.generally)
699− , benchIOSink value "sum" sum
700− , benchIOSink value "product" product
701− , benchIOSink value "maximumBy" maximumBy
702− , benchIOSink value "maximum" maximum
703− , benchIOSink value "minimumBy" minimumBy
704− , benchIOSink value "minimum" minimum
705− ]
706− ]
707− ]
708−
709−
710−
711−o_1_space_serial_foldMultiStream :: Int -> [Benchmark]
712−o_1_space_serial_foldMultiStream value =
713− [ bgroup
714− "serially"
715− [ bgroup
716− "fold-multi-stream"
717− [ benchIOSink1 "eqBy" (eqBy value)
718− , benchIOSink1 "cmpBy" (cmpBy value)
719− , benchIOSink value "isPrefixOf" isPrefixOf
720− , benchIOSink value "isSubsequenceOf" isSubsequenceOf
721− , benchIOSink value "stripPrefix" stripPrefix
722− ]
723− ]
724− ]
725−
726−
727−o_n_space_serial_toList :: Int -> [Benchmark]
728−o_n_space_serial_toList value =
729− [ bgroup
730− "serially"
731− [ bgroup
732− "toList" -- < 2MB
733− -- Converting the stream to a list or pure stream in a strict monad
734− [ benchIOSink value "foldrMToList" foldrMBuild
735− , benchIOSink value "toList" toList
736− , benchIOSink value "toListRev" toListRev
737− -- , benchIOSink value "toPure" toPure
738− -- , benchIOSink value "toPureRev" toPureRev
739− ]
740− ]
741− ]
742−
743−
744−o_n_space_serial_foldr :: Int -> [Benchmark]
745−o_n_space_serial_foldr value =
746− [ bgroup
747− "serially"
748− -- Head recursive strict right folds.
749− [ bgroup
750− "foldr"
751− -- < 2MB
752− -- accumulation due to strictness of IO monad
753− [ benchIOSink value "foldrM/build/IO" foldrMBuild
754− -- Right folds for reducing are inherently non-streaming as the
755− -- expression needs to be fully built before it can be reduced.
756− , benchIdentitySink
757− value
758− "foldrM/reduce/Identity"
759− foldrMReduce
760− -- takes < 4MB
761− , benchIOSink value "foldrM/reduce/IO" foldrMReduce
762− -- XXX the definitions of minimumBy and maximumBy in Data.Foldable use
763− -- foldl1 which does not work in constant memory for our implementation.
764− -- It works in constant memory for lists but even for lists it takes 15x
765− -- more time compared to our foldl' based implementation.
766− -- XXX these take < 16M stack space
767− , bench "minimumBy" $ nf (flip foldableMinBy 1) value
768− , bench "maximumBy" $ nf (flip foldableMaxBy 1) value
769− , bench "minimumByList" $ nf (flip foldableListMinBy 1) value
770− ]
771− ]
772− ]
773−
774−
775−o_n_heap_serial_foldl :: Int -> [Benchmark]
776−o_n_heap_serial_foldl value =
777− [ bgroup
778− "serially"
779− [ bgroup
780− "foldl"
781− -- Left folds for building a structure are inherently non-streaming
782− -- as the structure cannot be lazily consumed until fully built.
783− [ benchIOSink value "foldl'/build/IO" foldl'Build
784− , benchIdentitySink value "foldl'/build/Identity" foldl'Build
785− , benchIOSink value "foldlM'/build/IO" foldlM'Build
786− , benchIdentitySink
787− value
788− "foldlM'/build/Identity"
789− foldlM'Build
790− -- Reversing/sorting a stream
791− , benchIOSink value "reverse" (reverse 1)
792− , benchIOSink value "reverse'" (reverse' 1)
793− ]
794− ]
795− ]
benchmark/lib/Streamly/Benchmark/Prelude/Generation.hsdeleted−1248
@@ -1,1248 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Prelude
3−-- Copyright : (c) 2018 Harendra Kumar
4−--
5−-- License : MIT
6−-- Maintainer : streamly@composewell.com
7−
8−{-# LANGUAGE CPP #-}
9−{-# LANGUAGE FlexibleContexts #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE DeriveAnyClass #-}
12−{-# LANGUAGE DeriveGeneric #-}
13−{-# LANGUAGE RankNTypes #-}
14−{-# LANGUAGE TupleSections #-}
15−
16−#ifdef __HADDOCK_VERSION__
17−#undef INSPECTION
18−#endif
19−
20−#ifdef INSPECTION
21−{-# LANGUAGE TemplateHaskell #-}
22−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
23−#endif
24−
25−module Streamly.Benchmark.Prelude.Generation
26− ( o_1_space_serial_generation
27− , o_1_space_serial_joining
28− , o_1_space_serial_concatFoldable
29− , o_1_space_serial_concatSerial
30− , o_1_space_serial_outerProductStreams
31−
32− , o_1_space_wSerial_concatMap
33− , o_1_space_wSerial_outerProduct
34−
35− , o_n_space_serial_outerProductStreams
36−
37− , o_n_space_wSerial_outerProductStreams
38−
39− , o_n_heap_serial_buffering
40−
41− , o_1_space_async_generation
42− , o_1_space_async_concatFoldable
43− , o_1_space_async_concatMap
44−
45− , o_1_space_wAsync_generation
46− , o_1_space_wAsync_concatFoldable
47− , o_1_space_wAsync_concatMap
48−
49− , o_1_space_ahead_generation
50− , o_1_space_ahead_concatFoldable
51− , o_1_space_ahead_concatMap
52−
53− , o_1_space_async_zip
54−
55− , o_n_space_parallel_generation
56− , o_n_space_parallel_concatFoldable
57− , o_n_space_parallel_concatMap
58− , o_n_space_parallel_outerProductStreams
59− , o_n_space_parallel_outerProductStreams2
60−
61− , o_1_space_async_avgRate
62−
63− , o_1_space_ahead_avgRate
64− ) where
65−
66−
67−import Control.DeepSeq (NFData(..))
68−import Data.Functor.Identity (Identity)
69−import System.Random (randomRIO)
70−import Prelude
71− (Monad, String, Int, (+), ($), (.), return, (>),
72− undefined, Maybe(..), (>>=), curry,
73− div, IO, compare, Double, fromIntegral, Integer, (<$>),
74− (<*>), sqrt, round, (*), seq)
75−import qualified Prelude as P
76−import qualified Data.Foldable as F
77−
78−#ifdef INSPECTION
79−import GHC.Types (SPEC(..))
80−import Test.Inspection
81−
82−import qualified Streamly.Internal.Data.Stream.StreamD as D
83−#endif
84−
85−import qualified Streamly as S hiding (runStream)
86−import qualified Streamly.Prelude as S
87−import qualified Streamly.Internal.Prelude as Internal
88−import qualified Streamly.Internal.Data.Unfold as UF
89−import Streamly.Internal.Data.Time.Units
90−
91−import qualified Streamly.Benchmark.Prelude.NestedOps as Nested
92−
93−import Gauge
94−import Streamly hiding (runStream)
95−import Streamly.Benchmark.Common
96−
97−type Stream m a = S.SerialT m a
98−
99−
100−-------------------------------------------------------------------------------
101−-- Stream generation
102−-------------------------------------------------------------------------------
103−
104−-- enumerate
105−
106−{-# INLINE sourceIntFromTo #-}
107−sourceIntFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
108−sourceIntFromTo value n = S.enumerateFromTo n (n + value)
109−
110−{-# INLINE sourceIntFromThenTo #-}
111−sourceIntFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
112−sourceIntFromThenTo value n = S.enumerateFromThenTo n (n + 1) (n + value)
113−
114−{-# INLINE sourceFracFromTo #-}
115−sourceFracFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Double
116−sourceFracFromTo value n =
117− S.enumerateFromTo (fromIntegral n) (fromIntegral (n + value))
118−
119−{-# INLINE sourceFracFromThenTo #-}
120−sourceFracFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Double
121−sourceFracFromThenTo value n = S.enumerateFromThenTo (fromIntegral n)
122− (fromIntegral n + 1.0001) (fromIntegral (n + value))
123−
124−{-# INLINE sourceIntegerFromStep #-}
125−sourceIntegerFromStep :: (Monad m, S.IsStream t) => Int -> Int -> t m Integer
126−sourceIntegerFromStep value n =
127− S.take value $ S.enumerateFromThen (fromIntegral n) (fromIntegral n + 1)
128−
129−-- unfoldr
130−
131−{-# INLINE sourceUnfoldr #-}
132−sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
133−sourceUnfoldr value n = S.unfoldr step n
134− where
135− step cnt =
136− if cnt > n + value
137− then Nothing
138− else Just (cnt, cnt + 1)
139−
140−{-# INLINE sourceUnfoldrN #-}
141−sourceUnfoldrN :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
142−sourceUnfoldrN upto start = S.unfoldr step start
143− where
144− step cnt =
145− if cnt > start + upto
146− then Nothing
147− else Just (cnt, cnt + 1)
148−
149−{-# INLINE sourceUnfoldrM #-}
150−sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
151−sourceUnfoldrM value n = S.unfoldrM step n
152− where
153− step cnt =
154− if cnt > n + value
155− then return Nothing
156− else return (Just (cnt, cnt + 1))
157−
158−{-# INLINE source #-}
159−source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
160−source = sourceUnfoldrM
161−
162−{-# INLINE sourceUnfoldrMN #-}
163−sourceUnfoldrMN :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
164−sourceUnfoldrMN upto start = S.unfoldrM step start
165− where
166− step cnt =
167− if cnt > start + upto
168− then return Nothing
169− else return (Just (cnt, cnt + 1))
170−
171−-- fromIndices
172−
173−{-# INLINE _sourceFromIndices #-}
174−_sourceFromIndices :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
175−_sourceFromIndices value n = S.take value $ S.fromIndices (+ n)
176−
177−{-# INLINE _sourceFromIndicesM #-}
178−_sourceFromIndicesM :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
179−_sourceFromIndicesM value n = S.take value $ S.fromIndicesM (P.fmap return (+ n))
180−
181−-- fromList
182−
183−{-# INLINE sourceFromList #-}
184−sourceFromList :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
185−sourceFromList value n = S.fromList [n..n+value]
186−
187−{-# INLINE sourceFromListM #-}
188−sourceFromListM :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
189−sourceFromListM value n = S.fromListM (P.fmap return [n..n+value])
190−
191−-- fromFoldable
192−
193−{-# INLINE sourceFromFoldable #-}
194−sourceFromFoldable :: S.IsStream t => Int -> Int -> t m Int
195−sourceFromFoldable value n = S.fromFoldable [n..n+value]
196−
197−{-# INLINE sourceFromFoldableM #-}
198−sourceFromFoldableM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
199−sourceFromFoldableM value n = S.fromFoldableM (P.fmap return [n..n+value])
200−
201−{-# INLINE absTimes #-}
202−absTimes :: (S.IsStream t, S.MonadAsync m, P.Functor (t m))
203− => Int -> Int -> t m AbsTime
204−absTimes value _ = S.take value $ Internal.absTimes
205−
206−-------------------------------------------------------------------------------
207−-- Elimination
208−-------------------------------------------------------------------------------
209−
210−{-# INLINE runStream #-}
211−runStream :: Monad m => Stream m a -> m ()
212−runStream = S.drain
213−
214−{-# INLINE toNull #-}
215−toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m ()
216−toNull t = runStream . t
217−
218−-------------------------------------------------------------------------------
219−-- Transformation
220−-------------------------------------------------------------------------------
221−
222−{-# INLINE transform #-}
223−transform :: Monad m => Stream m a -> m ()
224−transform = runStream
225−
226−-- polymorphic stream version of composeN
227−{-# INLINE composeN' #-}
228−composeN' ::
229− (S.IsStream t, Monad m)
230− => Int
231− -> (t m Int -> Stream m Int)
232− -> t m Int
233− -> m ()
234−composeN' n f =
235− case n of
236− 1 -> transform . f
237− 2 -> transform . f . S.adapt . f
238− 3 -> transform . f . S.adapt . f . S.adapt . f
239− 4 -> transform . f . S.adapt . f . S.adapt . f . S.adapt . f
240− _ -> undefined
241−
242−{-# INLINE fmap' #-}
243−fmap' ::
244− (S.IsStream t, S.MonadAsync m, P.Functor (t m))
245− => (t m Int -> S.SerialT m Int)
246− -> Int
247− -> t m Int
248− -> m ()
249−fmap' t n = composeN' n $ t . P.fmap (+ 1)
250−
251−-------------------------------------------------------------------------------
252−-- Combining streams
253−-------------------------------------------------------------------------------
254−
255−-------------------------------------------------------------------------------
256−-- Appending
257−-------------------------------------------------------------------------------
258−
259−{-# INLINE serial2 #-}
260−serial2 :: Int -> Int -> IO ()
261−serial2 count n =
262− S.drain $ S.serial (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
263−
264−{-# INLINE serial4 #-}
265−serial4 :: Int -> Int -> IO ()
266−serial4 count n =
267− S.drain $
268− S.serial
269− ((S.serial (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))))
270− ((S.serial
271− (sourceUnfoldrMN count (n + 2))
272− (sourceUnfoldrMN count (n + 3))))
273−
274−{-# INLINE append2 #-}
275−append2 :: Int -> Int -> IO ()
276−append2 count n =
277− S.drain $
278− Internal.append (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
279−
280−{-# INLINE append4 #-}
281−append4 :: Int -> Int -> IO ()
282−append4 count n =
283− S.drain $
284− Internal.append
285− ((Internal.append
286− (sourceUnfoldrMN count n)
287− (sourceUnfoldrMN count (n + 1))))
288− ((Internal.append
289− (sourceUnfoldrMN count (n + 2))
290− (sourceUnfoldrMN count (n + 3))))
291−
292−#ifdef INSPECTION
293−inspect $ hasNoTypeClasses 'append2
294−inspect $ 'append2 `hasNoType` ''SPEC
295−inspect $ 'append2 `hasNoType` ''D.AppendState
296−#endif
297−
298−-------------------------------------------------------------------------------
299−-- Interleaving
300−-------------------------------------------------------------------------------
301−
302−{-# INLINE wSerial2 #-}
303−wSerial2 :: Int -> Int -> IO ()
304−wSerial2 value n =
305− S.drain $
306− S.wSerial
307− (sourceUnfoldrMN (value `div` 2) n)
308− (sourceUnfoldrMN (value `div` 2) (n + 1))
309−
310−{-# INLINE interleave2 #-}
311−interleave2 :: Int -> Int -> IO ()
312−interleave2 value n =
313− S.drain $
314− Internal.interleave
315− (sourceUnfoldrMN (value `div` 2) n)
316− (sourceUnfoldrMN (value `div` 2) (n + 1))
317−
318−#ifdef INSPECTION
319−inspect $ hasNoTypeClasses 'interleave2
320−inspect $ 'interleave2 `hasNoType` ''SPEC
321−inspect $ 'interleave2 `hasNoType` ''D.InterleaveState
322−#endif
323−
324−{-# INLINE roundRobin2 #-}
325−roundRobin2 :: Int -> Int -> IO ()
326−roundRobin2 value n =
327− S.drain $
328− Internal.roundrobin
329− (sourceUnfoldrMN (value `div` 2) n)
330− (sourceUnfoldrMN (value `div` 2) (n + 1))
331−
332−#ifdef INSPECTION
333−inspect $ hasNoTypeClasses 'roundRobin2
334−inspect $ 'roundRobin2 `hasNoType` ''SPEC
335−inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState
336−#endif
337−
338−-------------------------------------------------------------------------------
339−-- Merging
340−-------------------------------------------------------------------------------
341−
342−{-# INLINE mergeBy #-}
343−mergeBy :: Int -> Int -> IO ()
344−mergeBy count n =
345− S.drain $
346− S.mergeBy
347− P.compare
348− (sourceUnfoldrMN count n)
349− (sourceUnfoldrMN count (n + 1))
350−
351−#ifdef INSPECTION
352−inspect $ hasNoTypeClasses 'mergeBy
353−inspect $ 'mergeBy `hasNoType` ''SPEC
354−inspect $ 'mergeBy `hasNoType` ''D.Step
355−#endif
356−
357−-------------------------------------------------------------------------------
358−-- Zipping
359−-------------------------------------------------------------------------------
360−
361−{-# INLINE zip #-}
362−zip :: Int -> Int -> IO ()
363−zip count n =
364− S.drain $
365− S.zipWith (,) (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
366−
367−#ifdef INSPECTION
368−inspect $ hasNoTypeClasses 'zip
369−inspect $ 'zip `hasNoType` ''SPEC
370−inspect $ 'zip `hasNoType` ''D.Step
371−#endif
372−
373−{-# INLINE zipM #-}
374−zipM :: Int -> Int -> IO ()
375−zipM count n =
376− S.drain $
377− S.zipWithM
378− (curry return)
379− (sourceUnfoldrMN count n)
380− (sourceUnfoldrMN count (n + 1))
381−
382−#ifdef INSPECTION
383−inspect $ hasNoTypeClasses 'zipM
384−inspect $ 'zipM `hasNoType` ''SPEC
385−inspect $ 'zipM `hasNoType` ''D.Step
386−#endif
387−
388−{-# INLINE zipAsync #-}
389−zipAsync :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
390−zipAsync count n = do
391− S.zipAsyncWith (,) (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
392−
393−{-# INLINE zipAsyncM #-}
394−zipAsyncM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
395−zipAsyncM count n = do
396− S.zipAsyncWithM
397− (curry return)
398− (sourceUnfoldrMN count n)
399− (sourceUnfoldrMN count (n + 1))
400−
401−{-# INLINE zipAsyncAp #-}
402−zipAsyncAp :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
403−zipAsyncAp count n = do
404− S.zipAsyncly $
405− (,) <$> (sourceUnfoldrMN count n) <*> (sourceUnfoldrMN count (n + 1))
406−
407−{-# INLINE mergeAsyncByM #-}
408−mergeAsyncByM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
409−mergeAsyncByM count n = do
410− S.mergeAsyncByM
411− (\a b -> return (a `compare` b))
412− (sourceUnfoldrMN count n)
413− (sourceUnfoldrMN count (n + 1))
414−
415−{-# INLINE mergeAsyncBy #-}
416−mergeAsyncBy :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
417−mergeAsyncBy count n = do
418− S.mergeAsyncBy
419− compare
420− (sourceUnfoldrMN count n)
421− (sourceUnfoldrMN count (n + 1))
422−
423−-------------------------------------------------------------------------------
424−-- Streams of streams
425−-------------------------------------------------------------------------------
426−
427−-- Special cases of concatMap
428−
429−{-# INLINE sourceFoldMapWith #-}
430−sourceFoldMapWith :: (S.IsStream t, S.Semigroup (t m Int))
431− => Int -> Int -> t m Int
432−sourceFoldMapWith value n = S.foldMapWith (S.<>) S.yield [n..n+value]
433−
434−{-# INLINE sourceFoldMapWithM #-}
435−sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))
436− => Int -> Int -> t m Int
437−sourceFoldMapWithM value n = S.foldMapWith (S.<>) (S.yieldM . return) [n..n+value]
438−
439−{-# INLINE sourceFoldMapM #-}
440−sourceFoldMapM :: (S.IsStream t, Monad m, P.Monoid (t m Int))
441− => Int -> Int -> t m Int
442−sourceFoldMapM value n = F.foldMap (S.yieldM . return) [n..n+value]
443−
444−{-# INLINE sourceConcatMapId #-}
445−sourceConcatMapId :: (S.IsStream t, Monad m)
446− => Int -> Int -> t m Int
447−sourceConcatMapId value n =
448− S.concatMap P.id $ S.fromFoldable $ P.map (S.yieldM . return) [n..n+value]
449−
450−-- concatMap unfoldrM/unfoldrM
451−
452−{-# INLINE concatMap #-}
453−concatMap :: Int -> Int -> Int -> IO ()
454−concatMap outer inner n =
455− S.drain $ S.concatMap
456− (\_ -> sourceUnfoldrMN inner n)
457− (sourceUnfoldrMN outer n)
458−
459−#ifdef INSPECTION
460−inspect $ hasNoTypeClasses 'concatMap
461−inspect $ 'concatMap `hasNoType` ''SPEC
462−#endif
463−
464−-- concatMap unfoldr/unfoldr
465−
466−{-# INLINE concatMapPure #-}
467−concatMapPure :: Int -> Int -> Int -> IO ()
468−concatMapPure outer inner n =
469− S.drain $ S.concatMap
470− (\_ -> sourceUnfoldrN inner n)
471− (sourceUnfoldrN outer n)
472−
473−#ifdef INSPECTION
474−inspect $ hasNoTypeClasses 'concatMapPure
475−inspect $ 'concatMapPure `hasNoType` ''SPEC
476−#endif
477−
478−-- concatMap replicate/unfoldrM
479−
480−{-# INLINE concatMapRepl4xN #-}
481−concatMapRepl4xN :: Int -> Int -> IO ()
482−concatMapRepl4xN value n = S.drain $ S.concatMap (S.replicate 4)
483− (sourceUnfoldrMN (value `div` 4) n)
484−
485−#ifdef INSPECTION
486−inspect $ hasNoTypeClasses 'concatMapRepl4xN
487−inspect $ 'concatMapRepl4xN `hasNoType` ''SPEC
488−#endif
489−
490−-- concatMapWith
491−
492−{-# INLINE concatStreamsWith #-}
493−concatStreamsWith
494− :: (forall c. S.SerialT IO c -> S.SerialT IO c -> S.SerialT IO c)
495− -> Int
496− -> Int
497− -> Int
498− -> IO ()
499−concatStreamsWith op outer inner n =
500− S.drain $ S.concatMapWith op
501− (\i -> sourceUnfoldrMN inner i)
502− (sourceUnfoldrMN outer n)
503−
504−{-# INLINE concatMapWithSerial #-}
505−concatMapWithSerial :: Int -> Int -> Int -> IO ()
506−concatMapWithSerial = concatStreamsWith S.serial
507−
508−#ifdef INSPECTION
509−inspect $ hasNoTypeClasses 'concatMapWithSerial
510−inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
511−#endif
512−
513−{-# INLINE concatMapWithAppend #-}
514−concatMapWithAppend :: Int -> Int -> Int -> IO ()
515−concatMapWithAppend = concatStreamsWith Internal.append
516−
517−#ifdef INSPECTION
518−inspect $ hasNoTypeClasses 'concatMapWithAppend
519−inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
520−#endif
521−
522−{-# INLINE concatMapWithWSerial #-}
523−concatMapWithWSerial :: Int -> Int -> Int -> IO ()
524−concatMapWithWSerial = concatStreamsWith S.wSerial
525−
526−#ifdef INSPECTION
527−inspect $ hasNoTypeClasses 'concatMapWithWSerial
528−inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
529−#endif
530−
531−-- concatUnfold
532−
533−-- concatUnfold replicate/unfoldrM
534−
535−{-# INLINE concatUnfoldRepl4xN #-}
536−concatUnfoldRepl4xN :: Int -> Int -> IO ()
537−concatUnfoldRepl4xN value n =
538− S.drain $ S.concatUnfold
539− (UF.replicateM 4)
540− (sourceUnfoldrMN (value `div` 4) n)
541−
542−#ifdef INSPECTION
543−inspect $ hasNoTypeClasses 'concatUnfoldRepl4xN
544−inspect $ 'concatUnfoldRepl4xN `hasNoType` ''D.ConcatMapUState
545−inspect $ 'concatUnfoldRepl4xN `hasNoType` ''SPEC
546−#endif
547−
548−{-# INLINE concatUnfoldInterleaveRepl4xN #-}
549−concatUnfoldInterleaveRepl4xN :: Int -> Int -> IO ()
550−concatUnfoldInterleaveRepl4xN value n =
551− S.drain $ Internal.concatUnfoldInterleave
552− (UF.replicateM 4)
553− (sourceUnfoldrMN (value `div` 4) n)
554−
555−#ifdef INSPECTION
556−inspect $ hasNoTypeClasses 'concatUnfoldInterleaveRepl4xN
557−-- inspect $ 'concatUnfoldInterleaveRepl4xN `hasNoType` ''SPEC
558−-- inspect $ 'concatUnfoldInterleaveRepl4xN `hasNoType` ''D.ConcatUnfoldInterleaveState
559−#endif
560−
561−{-# INLINE concatUnfoldRoundrobinRepl4xN #-}
562−concatUnfoldRoundrobinRepl4xN :: Int -> Int -> IO ()
563−concatUnfoldRoundrobinRepl4xN value n =
564− S.drain $ Internal.concatUnfoldRoundrobin
565− (UF.replicateM 4)
566− (sourceUnfoldrMN (value `div` 4) n)
567−
568−#ifdef INSPECTION
569−inspect $ hasNoTypeClasses 'concatUnfoldRoundrobinRepl4xN
570−-- inspect $ 'concatUnfoldRoundrobinRepl4xN `hasNoType` ''SPEC
571−-- inspect $ 'concatUnfoldRoundrobinRepl4xN `hasNoType` ''D.ConcatUnfoldInterleaveState
572−#endif
573−
574−-------------------------------------------------------------------------------
575−-- Concurrent application/fold
576−-------------------------------------------------------------------------------
577−
578−{-# INLINE parAppMap #-}
579−parAppMap :: S.MonadAsync m => Stream m Int -> m ()
580−parAppMap src = S.drain $ S.map (+1) S.|$ src
581−
582−{-# INLINE parAppSum #-}
583−parAppSum :: S.MonadAsync m => Stream m Int -> m ()
584−parAppSum src = (S.sum S.|$. src) >>= \x -> P.seq x (return ())
585−
586−-------------------------------------------------------------------------------
587−-- Type class instances
588−-------------------------------------------------------------------------------
589−
590−{-# INLINE showInstanceList #-}
591−showInstanceList :: [Int] -> P.String
592−showInstanceList src = P.show src
593−
594−{-# INLINE readInstance #-}
595−readInstance :: P.String -> Stream Identity Int
596−readInstance str =
597− let r = P.reads str
598− in case r of
599− [(x,"")] -> x
600− _ -> P.error "readInstance: no parse"
601−
602−{-# INLINE readInstanceList #-}
603−readInstanceList :: P.String -> [Int]
604−readInstanceList str =
605− let r = P.reads str
606− in case r of
607− [(x,"")] -> x
608− _ -> P.error "readInstance: no parse"
609−
610−-------------------------------------------------------------------------------
611−-- Benchmark groups
612−-------------------------------------------------------------------------------
613−
614−-- We need a monadic bind here to make sure that the function f does not get
615−-- completely optimized out by the compiler in some cases.
616−
617−-- | Takes a fold method, and uses it with a default source.
618−{-# INLINE benchIOSink #-}
619−benchIOSink
620− :: (IsStream t, NFData b)
621− => Int -> String -> (t IO Int -> IO b) -> Benchmark
622−benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
623−
624−-- | Takes a source, and uses it with a default drain/fold method.
625−{-# INLINE benchIOSrc #-}
626−benchIOSrc
627− :: (t IO a -> SerialT IO a)
628− -> String
629− -> (Int -> t IO a)
630− -> Benchmark
631−benchIOSrc t name f =
632− bench name $ nfIO $ randomRIO (1,1) >>= toNull t . f
633−
634−{-# INLINE benchIO #-}
635−benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
636−benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
637−
638−-- | Takes a source, and uses it with a default drain/fold method.
639−{-# INLINE benchSrcIO #-}
640−benchSrcIO
641− :: (t IO a -> SerialT IO a)
642− -> String
643− -> (Int -> t IO a)
644− -> Benchmark
645−benchSrcIO t name f
646− = bench name $ nfIO $ randomRIO (1,1) >>= toNull t . f
647−
648−{-# INLINE benchMonadicSrcIO #-}
649−benchMonadicSrcIO :: String -> (Int -> IO ()) -> Benchmark
650−benchMonadicSrcIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
651−
652−-------------------------------------------------------------------------------
653−-- Benchmark groups
654−-------------------------------------------------------------------------------
655−
656−o_1_space_serial_generation :: Int -> [Benchmark]
657−o_1_space_serial_generation value =
658− [ bgroup
659− "serially"
660− [ bgroup
661− "generation"
662− -- Most basic, barely stream continuations running
663− [ benchIOSrc serially "unfoldr" (sourceUnfoldr value)
664− , benchIOSrc serially "unfoldrM" (sourceUnfoldrM value)
665− , benchIOSrc serially "intFromTo" (sourceIntFromTo value)
666− , benchIOSrc
667− serially
668− "intFromThenTo"
669− (sourceIntFromThenTo value)
670− , benchIOSrc
671− serially
672− "integerFromStep"
673− (sourceIntegerFromStep value)
674− , benchIOSrc
675− serially
676− "fracFromThenTo"
677− (sourceFracFromThenTo value)
678− , benchIOSrc serially "fracFromTo" (sourceFracFromTo value)
679− , benchIOSrc serially "fromList" (sourceFromList value)
680− , benchIOSrc serially "fromListM" (sourceFromListM value)
681− -- These are essentially cons and consM
682− , benchIOSrc
683− serially
684− "fromFoldable"
685− (sourceFromFoldable value)
686− , benchIOSrc
687− serially
688− "fromFoldableM"
689− (sourceFromFoldableM value)
690− , benchIOSrc serially "absTimes" $ absTimes value
691− ]
692− ]
693− ]
694−
695−
696−
697−o_1_space_serial_joining :: Int -> [Benchmark]
698−o_1_space_serial_joining value =
699− [ bgroup
700− "serially"
701− [ bgroup
702− "joining"
703− [ benchIOSrc1 "zip (2,x/2)" (zip (value `div` 2))
704− , benchIOSrc1 "zipM (2,x/2)" (zipM (value `div` 2))
705− , benchIOSrc1 "mergeBy (2,x/2)" (mergeBy (value `div` 2))
706− , benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))
707− , benchIOSrc1 "append (2,x/2)" (append2 (value `div` 2))
708− , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
709− , benchIOSrc1 "append (2,2,x/4)" (append4 (value `div` 4))
710− , benchIOSrc1 "wSerial (2,x/2)" (wSerial2 value) -- XXX Move this elsewhere?
711− , benchIOSrc1 "interleave (2,x/2)" (interleave2 value)
712− , benchIOSrc1 "roundRobin (2,x/2)" (roundRobin2 value)
713− ]
714− ]
715− ]
716−
717−
718−o_1_space_serial_concatFoldable :: Int -> [Benchmark]
719−o_1_space_serial_concatFoldable value =
720− [ bgroup
721− "serially"
722− [ bgroup
723− "concat-foldable"
724− [ benchIOSrc
725− serially
726− "foldMapWith"
727− (sourceFoldMapWith value)
728− , benchIOSrc
729− serially
730− "foldMapWithM"
731− (sourceFoldMapWithM value)
732− , benchIOSrc serially "foldMapM" (sourceFoldMapM value)
733− , benchIOSrc
734− serially
735− "foldWithConcatMapId"
736− (sourceConcatMapId value)
737− ]
738− ]
739− ]
740−
741−o_1_space_serial_concatSerial :: Int -> [Benchmark]
742−o_1_space_serial_concatSerial value =
743− [ bgroup
744− "serially"
745− [ bgroup
746− "concat-serial"
747− [ benchIOSrc1
748− "concatMapPure (2,x/2)"
749− (concatMapPure 2 (value `div` 2))
750− , benchIOSrc1
751− "concatMap (2,x/2)"
752− (concatMap 2 (value `div` 2))
753− , benchIOSrc1
754− "concatMap (x/2,2)"
755− (concatMap (value `div` 2) 2)
756− , benchIOSrc1
757− "concatMapRepl (x/4,4)"
758− (concatMapRepl4xN value)
759− , benchIOSrc1
760− "concatUnfoldRepl (x/4,4)"
761− (concatUnfoldRepl4xN value)
762− , benchIOSrc1
763− "concatMapWithSerial (2,x/2)"
764− (concatMapWithSerial 2 (value `div` 2))
765− , benchIOSrc1
766− "concatMapWithSerial (x/2,2)"
767− (concatMapWithSerial (value `div` 2) 2)
768− , benchIOSrc1
769− "concatMapWithAppend (2,x/2)"
770− (concatMapWithAppend 2 (value `div` 2))
771− ]
772− ]
773− ]
774−
775−o_1_space_serial_outerProductStreams :: Int -> [Benchmark]
776−o_1_space_serial_outerProductStreams value =
777− [ bgroup
778− "serially"
779− [ bgroup
780− "outer-product-streams"
781− [ benchIO "toNullAp" $ Nested.toNullAp value serially
782− , benchIO "toNull" $ Nested.toNull value serially
783− , benchIO "toNull3" $ Nested.toNull3 value serially
784− , benchIO "filterAllOut" $ Nested.filterAllOut value serially
785− , benchIO "filterAllIn" $ Nested.filterAllIn value serially
786− , benchIO "filterSome" $ Nested.filterSome value serially
787− , benchIO "breakAfterSome" $
788− Nested.breakAfterSome value serially
789− ]
790− ]
791− ]
792−
793−
794−o_1_space_wSerial_concatMap :: Int -> [Benchmark]
795−o_1_space_wSerial_concatMap value =
796− [ bgroup
797− "wSerially"
798− [ bgroup
799− "concatMap"
800− [ benchIOSrc1
801− "concatMapWithWSerial (2,x/2)"
802− (concatMapWithWSerial 2 (value `div` 2))
803− , benchIOSrc1
804− "concatMapWithWSerial (x/2,2)"
805− (concatMapWithWSerial (value `div` 2) 2)
806− ]
807− ]
808− ]
809−
810−o_1_space_wSerial_outerProduct :: Int -> [Benchmark]
811−o_1_space_wSerial_outerProduct value =
812− [ bgroup
813− "wSerially"
814− [ bgroup
815− "outer-product"
816− [ benchIO "toNullAp" $ Nested.toNullAp value wSerially
817− , benchIO "toNull" $ Nested.toNull value wSerially
818− , benchIO "toNull3" $ Nested.toNull3 value wSerially
819− , benchIO "filterAllOut" $ Nested.filterAllOut value wSerially
820− , benchIO "filterAllIn" $ Nested.filterAllIn value wSerially
821− , benchIO "filterSome" $ Nested.filterSome value wSerially
822− , benchIO "breakAfterSome" $
823− Nested.breakAfterSome value wSerially
824− ]
825− ]
826− ]
827−
828−
829−o_n_space_serial_outerProductStreams :: Int -> [Benchmark]
830−o_n_space_serial_outerProductStreams value =
831− [ bgroup
832− "serially"
833− [ bgroup
834− "outer-product-streams"
835− [ benchIO "toList" $ Nested.toList value serially
836− , benchIO "toListSome" $ Nested.toListSome value serially
837− ]
838− ]
839− ]
840−
841−o_n_space_wSerial_outerProductStreams :: Int -> [Benchmark]
842−o_n_space_wSerial_outerProductStreams value =
843− [ bgroup
844− "wSerially"
845− [ bgroup
846− "outer-product-streams"
847− [ benchIO "toList" $ Nested.toList value wSerially
848− , benchIO "toListSome" $ Nested.toListSome value wSerially
849− ]
850− ]
851− ]
852−
853−
854−o_n_heap_serial_buffering :: Int -> [Benchmark]
855−o_n_heap_serial_buffering value =
856− [ bgroup
857− "serially"
858− [ bgroup
859− "buffering"
860− -- Buffers the output of show/read.
861− -- XXX can the outputs be streaming? Can we have special read/show
862− -- style type classes, readM/showM supporting streaming effects?
863− [ bench "readsPrec pure streams" $
864− nf readInstance (mkString value)
865− , bench "readsPrec Haskell lists" $
866− nf readInstanceList (mkListString value)
867− , bench "showPrec Haskell lists" $
868− nf showInstanceList (mkList value)
869− -- interleave x/4 streams of 4 elements each. Needs to buffer
870− -- proportional to x/4. This is different from WSerial because
871− -- WSerial expands slowly because of binary interleave behavior and
872− -- this expands immediately because of Nary interleave behavior.
873− , benchIOSrc1
874− "concatUnfoldInterleaveRepl (x/4,4)"
875− (concatUnfoldInterleaveRepl4xN value)
876− , benchIOSrc1
877− "concatUnfoldRoundrobinRepl (x/4,4)"
878− (concatUnfoldRoundrobinRepl4xN value)
879− ]
880− ]
881− ]
882−
883−
884−o_1_space_async_generation :: Int -> [Benchmark]
885−o_1_space_async_generation value =
886− [ bgroup
887− "asyncly"
888− [ bgroup
889− "generation"
890− [ benchSrcIO asyncly "unfoldr" (sourceUnfoldr value)
891− , benchSrcIO asyncly "unfoldrM" (sourceUnfoldrM value)
892− , benchSrcIO asyncly "fromFoldable" (sourceFromFoldable value)
893− , benchSrcIO asyncly "fromFoldableM" (sourceFromFoldableM value)
894− , benchSrcIO
895− asyncly
896− "unfoldrM maxThreads 1"
897− (maxThreads 1 . sourceUnfoldrM value)
898− , benchSrcIO
899− asyncly
900− "unfoldrM maxBuffer 1 (x/10 ops)"
901− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
902− ]
903− ]
904− ]
905−
906−
907−o_1_space_async_concatFoldable :: Int -> [Benchmark]
908−o_1_space_async_concatFoldable value =
909− [ bgroup
910− "asyncly"
911− [ bgroup
912− "concat-foldable"
913− [ benchSrcIO asyncly "foldMapWith" (sourceFoldMapWith value)
914− , benchSrcIO
915− asyncly
916− "foldMapWithM"
917− (sourceFoldMapWithM value)
918− , benchSrcIO asyncly "foldMapM" (sourceFoldMapM value)
919− ]
920− ]
921− ]
922−
923−o_1_space_async_concatMap :: Int -> [Benchmark]
924−o_1_space_async_concatMap value =
925− value2 `seq`
926− [ bgroup
927− "asyncly"
928− [ bgroup
929− "concatMap"
930− [ benchMonadicSrcIO
931− "concatMapWith (2,x/2)"
932− (concatStreamsWith async 2 (value `div` 2))
933− , benchMonadicSrcIO
934− "concatMapWith (sqrt x,sqrt x)"
935− (concatStreamsWith async value2 value2)
936− , benchMonadicSrcIO
937− "concatMapWith (sqrt x * 2,sqrt x / 2)"
938− (concatStreamsWith async (value2 * 2) (value2 `div` 2))
939− ]
940− ]
941− ]
942− where
943− value2 = round $ sqrt $ (fromIntegral value :: Double)
944−
945−
946−o_1_space_wAsync_generation :: Int -> [Benchmark]
947−o_1_space_wAsync_generation value =
948− [ bgroup
949− "wAsyncly"
950− [ bgroup
951− "generation"
952− [ benchSrcIO wAsyncly "unfoldr" (sourceUnfoldr value)
953− , benchSrcIO wAsyncly "unfoldrM" (sourceUnfoldrM value)
954− , benchSrcIO wAsyncly "fromFoldable" (sourceFromFoldable value)
955− , benchSrcIO
956− wAsyncly
957− "fromFoldableM"
958− (sourceFromFoldableM value)
959− , benchSrcIO
960− wAsyncly
961− "unfoldrM maxThreads 1"
962− (maxThreads 1 . sourceUnfoldrM value)
963− , benchSrcIO
964− wAsyncly
965− "unfoldrM maxBuffer 1 (x/10 ops)"
966− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
967− ]
968− ]
969− ]
970−
971−
972−o_1_space_wAsync_concatFoldable :: Int -> [Benchmark]
973−o_1_space_wAsync_concatFoldable value =
974− [ bgroup
975− "wAsyncly"
976− [ bgroup
977− "concat-foldable"
978− [ benchSrcIO wAsyncly "foldMapWith" (sourceFoldMapWith value)
979− , benchSrcIO wAsyncly "foldMapWithM" (sourceFoldMapWithM value)
980− , benchSrcIO wAsyncly "foldMapM" (sourceFoldMapM value)
981− ]
982− ]
983− ]
984−
985−
986−-- When we merge streams using wAsync the size of the queue increases
987−-- slowly because of the binary composition adding just one more item
988−-- to the work queue only after every scheduling pass through the
989−-- work queue.
990−--
991−-- We should see the memory consumption increasing slowly if these
992−-- benchmarks are left to run on infinite number of streams of infinite
993−-- sizes.
994−o_1_space_wAsync_concatMap :: Int -> [Benchmark]
995−o_1_space_wAsync_concatMap value =
996− value2 `seq`
997− [ bgroup
998− "wAsyncly"
999− [ benchMonadicSrcIO
1000− "concatMapWith (2,x/2)"
1001− (concatStreamsWith wAsync 2 (value `div` 2))
1002− , benchMonadicSrcIO
1003− "concatMapWith (sqrt x,sqrt x)"
1004− (concatStreamsWith wAsync value2 value2)
1005− , benchMonadicSrcIO
1006− "concatMapWith (sqrt x * 2,sqrt x / 2)"
1007− (concatStreamsWith wAsync (value2 * 2) (value2 `div` 2))
1008− ]
1009− ]
1010− where
1011− value2 = round $ sqrt $ (fromIntegral value :: Double)
1012−
1013−
1014−-- unfoldr and fromFoldable are always serial and therefore the same for
1015−-- all stream types. They can be removed to reduce the number of benchmarks.
1016−o_1_space_ahead_generation :: Int -> [Benchmark]
1017−o_1_space_ahead_generation value =
1018− [ bgroup
1019− "aheadly"
1020− [ bgroup
1021− "generation"
1022− [ benchSrcIO aheadly "unfoldr" (sourceUnfoldr value)
1023− , benchSrcIO aheadly "unfoldrM" (sourceUnfoldrM value)
1024−-- , benchSrcIO aheadly "fromFoldable" (sourceFromFoldable value)
1025− , benchSrcIO
1026− aheadly
1027− "fromFoldableM"
1028− (sourceFromFoldableM value)
1029− , benchSrcIO
1030− aheadly
1031− "unfoldrM maxThreads 1"
1032− (maxThreads 1 . sourceUnfoldrM value)
1033− , benchSrcIO
1034− aheadly
1035− "unfoldrM maxBuffer 1 (x/10 ops)"
1036− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
1037− ]
1038− ]
1039− ]
1040−
1041−o_1_space_ahead_concatFoldable :: Int -> [Benchmark]
1042−o_1_space_ahead_concatFoldable value =
1043− [ bgroup
1044− "aheadly"
1045− [ bgroup
1046− "concat-foldable"
1047− [ benchSrcIO aheadly "foldMapWith" (sourceFoldMapWith value)
1048− , benchSrcIO aheadly "foldMapWithM" (sourceFoldMapWithM value)
1049− , benchSrcIO aheadly "foldMapM" (sourceFoldMapM value)
1050− ]
1051− ]
1052− ]
1053−
1054−o_1_space_ahead_concatMap :: Int -> [Benchmark]
1055−o_1_space_ahead_concatMap value =
1056− value2 `seq`
1057− [ bgroup
1058− "aheadly"
1059− [ benchMonadicSrcIO
1060− "concatMapWith (2,x/2)"
1061− (concatStreamsWith ahead 2 (value `div` 2))
1062− , benchMonadicSrcIO
1063− "concatMapWith (sqrt x,sqrt x)"
1064− (concatStreamsWith ahead value2 value2)
1065− , benchMonadicSrcIO
1066− "concatMapWith (sqrt x * 2,sqrt x / 2)"
1067− (concatStreamsWith ahead (value2 * 2) (value2 `div` 2))
1068− ]
1069− ]
1070− where
1071− value2 = round $ sqrt $ (fromIntegral value :: Double)
1072−
1073−
1074−o_1_space_async_zip :: Int -> [Benchmark]
1075−o_1_space_async_zip value =
1076− [ bgroup
1077− "asyncly"
1078− [ bgroup
1079− "zip"
1080− [ benchSrcIO
1081− serially
1082− "zipAsync (2,x/2)"
1083− (zipAsync (value `div` 2))
1084− , benchSrcIO
1085− serially
1086− "zipAsyncM (2,x/2)"
1087− (zipAsyncM (value `div` 2))
1088− , benchSrcIO
1089− serially
1090− "zipAsyncAp (2,x/2)"
1091− (zipAsyncAp (value `div` 2))
1092− , benchIOSink value "fmap zipAsyncly" $ fmap' S.zipAsyncly 1
1093− , benchSrcIO
1094− serially
1095− "mergeAsyncBy (2,x/2)"
1096− (mergeAsyncBy (value `div` 2))
1097− , benchSrcIO
1098− serially
1099− "mergeAsyncByM (2,x/2)"
1100− (mergeAsyncByM (value `div` 2))
1101− -- Parallel stages in a pipeline
1102− , benchIOSink value "parAppMap" parAppMap
1103− , benchIOSink value "parAppSum" parAppSum
1104− ]
1105− ]
1106− ]
1107−
1108−o_n_space_parallel_generation :: Int -> [Benchmark]
1109−o_n_space_parallel_generation value =
1110− [ bgroup
1111− "parallely"
1112− [ bgroup
1113− "generation"
1114− [ benchSrcIO parallely "unfoldr" (sourceUnfoldr value)
1115− , benchSrcIO parallely "unfoldrM" (sourceUnfoldrM value)
1116−-- , benchSrcIO parallely "fromFoldable" (sourceFromFoldable value)
1117− , benchSrcIO
1118− parallely
1119− "fromFoldableM"
1120− (sourceFromFoldableM value)
1121− , benchSrcIO
1122− parallely
1123− "unfoldrM maxThreads 1"
1124− (maxThreads 1 . sourceUnfoldrM value)
1125− , benchSrcIO
1126− parallely
1127− "unfoldrM maxBuffer 1 (x/10 ops)"
1128− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
1129− ]
1130− ]
1131− ]
1132−
1133−o_n_space_parallel_concatFoldable :: Int -> [Benchmark]
1134−o_n_space_parallel_concatFoldable value =
1135− [ bgroup
1136− "parallely"
1137− [ bgroup
1138− "concat-foldable"
1139− [ benchSrcIO parallely "foldMapWith" (sourceFoldMapWith value)
1140− , benchSrcIO parallely "foldMapWithM" (sourceFoldMapWithM value)
1141− , benchSrcIO parallely "foldMapM" (sourceFoldMapM value)
1142− ]
1143− ]
1144− ]
1145−
1146−o_n_space_parallel_concatMap :: Int -> [Benchmark]
1147−o_n_space_parallel_concatMap value =
1148− value2 `seq`
1149− [ bgroup
1150− "parallely"
1151− [ benchMonadicSrcIO
1152− "concatMapWith (2,x/2)"
1153− (concatStreamsWith parallel 2 (value `div` 2))
1154− , benchMonadicSrcIO
1155− "concatMapWith (sqrt x,sqrt x)"
1156− (concatStreamsWith parallel value2 value2)
1157− , benchMonadicSrcIO
1158− "concatMapWith (sqrt x * 2,sqrt x / 2)"
1159− (concatStreamsWith parallel (value2 * 2) (value2 `div` 2))
1160− ]
1161− ]
1162− where
1163− value2 = round $ sqrt $ (fromIntegral value :: Double)
1164−
1165−
1166−o_n_space_parallel_outerProductStreams :: Int -> [Benchmark]
1167−o_n_space_parallel_outerProductStreams value =
1168− [ bgroup
1169− "parallely"
1170− [ bgroup
1171− "outer-product-streams"
1172− [ benchIO "toNullAp" $ Nested.toNullAp value parallely
1173− , benchIO "toNull" $ Nested.toNull value parallely
1174− , benchIO "toNull3" $ Nested.toNull3 value parallely
1175− , benchIO "filterAllOut" $ Nested.filterAllOut value parallely
1176− , benchIO "filterAllIn" $ Nested.filterAllIn value parallely
1177− , benchIO "filterSome" $ Nested.filterSome value parallely
1178− , benchIO "breakAfterSome" $
1179− Nested.breakAfterSome value parallely
1180− ]
1181− ]
1182− ]
1183−
1184−o_n_space_parallel_outerProductStreams2 :: Int -> [Benchmark]
1185−o_n_space_parallel_outerProductStreams2 value =
1186− [ bgroup
1187− "parallely"
1188− [ bgroup
1189− "outer-product-streams"
1190− [ benchIO "toList" $ Nested.toList value parallely
1191− , benchIO "toListSome" $ Nested.toListSome value parallely
1192− ]
1193− ]
1194− ]
1195−
1196−
1197−
1198−-- XXX arbitrarily large rate should be the same as rate Nothing
1199−o_1_space_async_avgRate :: Int -> [Benchmark]
1200−o_1_space_async_avgRate value =
1201− [ bgroup
1202− "asyncly"
1203− [ bgroup
1204− "avgRate"
1205− -- benchIO "unfoldr" $ toNull asyncly
1206− -- benchSrcIO asyncly "unfoldrM" (sourceUnfoldrM value)
1207− [ benchSrcIO
1208− asyncly
1209− "unfoldrM/Nothing"
1210− (S.rate Nothing . sourceUnfoldrM value)
1211− , benchSrcIO
1212− asyncly
1213− "unfoldrM/1,000,000"
1214− (S.avgRate 1000000 . sourceUnfoldrM value)
1215− , benchSrcIO
1216− asyncly
1217− "unfoldrM/3,000,000"
1218− (S.avgRate 3000000 . sourceUnfoldrM value)
1219− , benchSrcIO
1220− asyncly
1221− "unfoldrM/10,000,000/maxThreads1"
1222− (maxThreads 1 .
1223− S.avgRate 10000000 . sourceUnfoldrM value)
1224− , benchSrcIO
1225− asyncly
1226− "unfoldrM/10,000,000"
1227− (S.avgRate 10000000 . sourceUnfoldrM value)
1228− , benchSrcIO
1229− asyncly
1230− "unfoldrM/20,000,000"
1231− (S.avgRate 20000000 . sourceUnfoldrM value)
1232− ]
1233− ]
1234− ]
1235−
1236−o_1_space_ahead_avgRate :: Int -> [Benchmark]
1237−o_1_space_ahead_avgRate value =
1238− [ bgroup
1239− "aheadly"
1240− [ bgroup
1241− "avgRate"
1242− [ benchSrcIO
1243− aheadly
1244− "unfoldrM/1,000,000"
1245− (S.avgRate 1000000 . sourceUnfoldrM value)
1246− ]
1247− ]
1248− ]
benchmark/lib/Streamly/Benchmark/Prelude/Transformation.hsdeleted−1013
@@ -1,1013 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Prelude
3−-- Copyright : (c) 2018 Harendra Kumar
4−--
5−-- License : MIT
6−-- Maintainer : streamly@composewell.com
7−
8−{-# LANGUAGE CPP #-}
9−{-# LANGUAGE FlexibleContexts #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE DeriveAnyClass #-}
12−{-# LANGUAGE DeriveGeneric #-}
13−{-# LANGUAGE RankNTypes #-}
14−{-# LANGUAGE TupleSections #-}
15−
16−#ifdef __HADDOCK_VERSION__
17−#undef INSPECTION
18−#endif
19−
20−#ifdef INSPECTION
21−{-# LANGUAGE TemplateHaskell #-}
22−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
23−#endif
24−
25−module Streamly.Benchmark.Prelude.Transformation
26− ( o_1_space_serial_pipes
27− , o_1_space_serial_pipesX4
28− , o_1_space_serial_transformer
29− , o_1_space_serial_transformation
30− , o_1_space_serial_transformationX4
31− , o_1_space_serial_filtering
32− , o_1_space_serial_filteringX4
33− , o_1_space_serial_mixed
34− , o_1_space_serial_mixedX4
35−
36− , o_1_space_wSerial_transformation
37−
38− , o_1_space_zipSerial_transformation
39−
40− , o_n_space_serial
41−
42− , o_n_stack_serial_iterated
43−
44− , o_1_space_async_transformation
45−
46− , o_1_space_wAsync_transformation
47−
48− , o_1_space_ahead_transformation
49−
50− , o_n_space_parallel_transformation
51− ) where
52−
53−import Control.DeepSeq (NFData(..))
54−import Control.Monad (when)
55−import Control.Monad.IO.Class (MonadIO(..))
56−import Control.Monad.State.Strict (StateT, get, put)
57−import Data.Functor.Identity (Identity)
58−import Data.IORef (newIORef, modifyIORef')
59−import GHC.Generics (Generic)
60−import System.Random (randomRIO)
61−import Prelude
62− (Monad, String, Int, (+), ($), (.), return, even, (>), (<=), (==), (>=),
63− undefined, Maybe(..), not, (>>=),
64− maxBound, div, IO, compare, subtract, const, Bool(..), Either(..))
65−import qualified Prelude as P
66−
67−#ifdef INSPECTION
68−import Test.Inspection
69−
70−#endif
71−
72−import qualified Streamly as S hiding (runStream)
73−import qualified Streamly.Prelude as S
74−import qualified Streamly.Internal.Prelude as Internal
75−import qualified Streamly.Internal.Data.Fold as FL
76−import qualified Streamly.Internal.Data.Pipe as Pipe
77−import qualified Streamly.Internal.Data.Stream.Parallel as Par
78−import Streamly.Internal.Data.Time.Units
79−
80−import Gauge
81−import Streamly hiding (runStream)
82−
83−type Stream m a = S.SerialT m a
84−
85−-------------------------------------------------------------------------------
86−-- Stream generation
87−-------------------------------------------------------------------------------
88−
89−-- unfoldr
90−
91−{-# INLINE sourceUnfoldr #-}
92−sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
93−sourceUnfoldr value n = S.unfoldr step n
94− where
95− step cnt =
96− if cnt > n + value
97− then Nothing
98− else Just (cnt, cnt + 1)
99−
100−{-# INLINE sourceUnfoldrM #-}
101−sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
102−sourceUnfoldrM value n = S.unfoldrM step n
103− where
104− step cnt =
105− if cnt > n + value
106− then return Nothing
107− else return (Just (cnt, cnt + 1))
108−
109−{-# INLINE source #-}
110−source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
111−source = sourceUnfoldrM
112−
113−{-# INLINE sourceUnfoldrMN #-}
114−sourceUnfoldrMN :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
115−sourceUnfoldrMN upto start = S.unfoldrM step start
116− where
117− step cnt =
118− if cnt > start + upto
119− then return Nothing
120− else return (Just (cnt, cnt + 1))
121−
122−{-# INLINE sourceUnfoldrMAction #-}
123−sourceUnfoldrMAction :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (m Int)
124−sourceUnfoldrMAction value n = S.serially $ S.unfoldrM step n
125− where
126− step cnt =
127− if cnt > n + value
128− then return Nothing
129− else return (Just (return cnt, cnt + 1))
130−
131−-------------------------------------------------------------------------------
132−-- Elimination
133−-------------------------------------------------------------------------------
134−
135−{-# INLINE runStream #-}
136−runStream :: Monad m => Stream m a -> m ()
137−runStream = S.drain
138−
139−{-# INLINE toNull #-}
140−toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m ()
141−toNull t = runStream . t
142−
143−
144−{-# INLINE tail #-}
145−tail :: Monad m => Stream m a -> m ()
146−tail s = S.tail s >>= P.mapM_ tail
147−
148−
149−{-# INLINE nullHeadTail #-}
150−nullHeadTail :: Monad m => Stream m Int -> m ()
151−nullHeadTail s = do
152− r <- S.null s
153− when (not r) $ do
154− _ <- S.head s
155− S.tail s >>= P.mapM_ nullHeadTail
156−
157−{-# INLINE foldl'ReduceMap #-}
158−foldl'ReduceMap :: Monad m => Stream m Int -> m Int
159−foldl'ReduceMap = P.fmap (+ 1) . S.foldl' (+) 0
160−
161−-------------------------------------------------------------------------------
162−-- Transformation
163−-------------------------------------------------------------------------------
164−
165−{-# INLINE transform #-}
166−transform :: Monad m => Stream m a -> m ()
167−transform = runStream
168−
169−{-# INLINE composeN #-}
170−composeN ::
171− MonadIO m
172− => Int
173− -> (Stream m Int -> Stream m Int)
174− -> Stream m Int
175− -> m ()
176−composeN n f =
177− case n of
178− 1 -> transform . f
179− 2 -> transform . f . f
180− 3 -> transform . f . f . f
181− 4 -> transform . f . f . f . f
182− _ -> undefined
183−
184−-- polymorphic stream version of composeN
185−{-# INLINE composeN' #-}
186−composeN' ::
187− (S.IsStream t, Monad m)
188− => Int
189− -> (t m Int -> Stream m Int)
190− -> t m Int
191− -> m ()
192−composeN' n f =
193− case n of
194− 1 -> transform . f
195− 2 -> transform . f . S.adapt . f
196− 3 -> transform . f . S.adapt . f . S.adapt . f
197− 4 -> transform . f . S.adapt . f . S.adapt . f . S.adapt . f
198− _ -> undefined
199−
200−{-# INLINE scan #-}
201−scan :: MonadIO m => Int -> Stream m Int -> m ()
202−scan n = composeN n $ S.scanl' (+) 0
203−
204−{-# INLINE scanl1' #-}
205−scanl1' :: MonadIO m => Int -> Stream m Int -> m ()
206−scanl1' n = composeN n $ S.scanl1' (+)
207−
208−{-# INLINE fmap #-}
209−fmap :: MonadIO m => Int -> Stream m Int -> m ()
210−fmap n = composeN n $ P.fmap (+ 1)
211−
212−{-# INLINE fmap' #-}
213−fmap' ::
214− (S.IsStream t, S.MonadAsync m, P.Functor (t m))
215− => (t m Int -> S.SerialT m Int)
216− -> Int
217− -> t m Int
218− -> m ()
219−fmap' t n = composeN' n $ t . P.fmap (+ 1)
220−
221−{-# INLINE map #-}
222−map :: MonadIO m => Int -> Stream m Int -> m ()
223−map n = composeN n $ S.map (+ 1)
224−
225−{-# INLINE map' #-}
226−map' ::
227− (S.IsStream t, S.MonadAsync m)
228− => (t m Int -> S.SerialT m Int)
229− -> Int
230− -> t m Int
231− -> m ()
232−map' t n = composeN' n $ t . S.map (+ 1)
233−
234−{-# INLINE mapM #-}
235−mapM ::
236− (S.IsStream t, S.MonadAsync m)
237− => (t m Int -> S.SerialT m Int)
238− -> Int
239− -> t m Int
240− -> m ()
241−mapM t n = composeN' n $ t . S.mapM return
242−
243−{-# INLINE tap #-}
244−tap :: MonadIO m => Int -> Stream m Int -> m ()
245−tap n = composeN n $ S.tap FL.sum
246−
247−{-# INLINE tapRate #-}
248−tapRate :: Int -> Stream IO Int -> IO ()
249−tapRate n str = do
250− cref <- newIORef 0
251− composeN n (Internal.tapRate 1 (\c -> modifyIORef' cref (c +))) str
252−
253−{-# INLINE pollCounts #-}
254−pollCounts :: Int -> Stream IO Int -> IO ()
255−pollCounts n str = do
256− composeN n (Internal.pollCounts (P.const P.True) f FL.drain) str
257− where
258− f = Internal.rollingMap (P.-) . Internal.delayPost 1
259−
260−{-# INLINE tapAsyncS #-}
261−tapAsyncS :: S.MonadAsync m => Int -> Stream m Int -> m ()
262−tapAsyncS n = composeN n $ Par.tapAsync S.sum
263−
264−{-# INLINE tapAsync #-}
265−tapAsync :: S.MonadAsync m => Int -> Stream m Int -> m ()
266−tapAsync n = composeN n $ Internal.tapAsync FL.sum
267−
268−{-# INLINE timestamped #-}
269−timestamped :: (S.MonadAsync m) => Stream m Int -> m ()
270−timestamped = transform . Internal.timestamped
271−
272−{-# INLINE classifySessionsOf #-}
273−classifySessionsOf :: (S.MonadAsync m) => Stream m Int -> m ()
274−classifySessionsOf =
275− transform
276− . Internal.classifySessionsOf
277− 3 (const (return False)) (P.fmap Right FL.drain)
278− . S.map (\(ts,(k,a)) -> (k, a, ts))
279− . Internal.timestamped
280− . S.concatMap (\x -> S.map (x,) (S.enumerateFromTo 1 (10 :: Int)))
281−
282−{-# INLINE mapMaybe #-}
283−mapMaybe :: MonadIO m => Int -> Stream m Int -> m ()
284−mapMaybe n =
285− composeN n $
286− S.mapMaybe
287− (\x ->
288− if P.odd x
289− then Nothing
290− else Just x)
291−
292−{-# INLINE mapMaybeM #-}
293−mapMaybeM :: S.MonadAsync m => Int -> Stream m Int -> m ()
294−mapMaybeM n =
295− composeN n $
296− S.mapMaybeM
297− (\x ->
298− if P.odd x
299− then return Nothing
300− else return $ Just x)
301−
302−{-# INLINE sequence #-}
303−sequence ::
304− (S.IsStream t, S.MonadAsync m)
305− => (t m Int -> S.SerialT m Int)
306− -> t m (m Int)
307− -> m ()
308−sequence t = transform . t . S.sequence
309−
310−{-# INLINE filterEven #-}
311−filterEven :: MonadIO m => Int -> Stream m Int -> m ()
312−filterEven n = composeN n $ S.filter even
313−
314−{-# INLINE filterAllOut #-}
315−filterAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()
316−filterAllOut value n = composeN n $ S.filter (> (value + 1))
317−
318−{-# INLINE filterAllIn #-}
319−filterAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()
320−filterAllIn value n = composeN n $ S.filter (<= (value + 1))
321−
322−{-# INLINE _takeOne #-}
323−_takeOne :: MonadIO m => Int -> Stream m Int -> m ()
324−_takeOne n = composeN n $ S.take 1
325−
326−{-# INLINE takeAll #-}
327−takeAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
328−takeAll value n = composeN n $ S.take (value + 1)
329−
330−{-# INLINE takeWhileTrue #-}
331−takeWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
332−takeWhileTrue value n = composeN n $ S.takeWhile (<= (value + 1))
333−
334−{-# INLINE _takeWhileMTrue #-}
335−_takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
336−_takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))
337−
338−{-# INLINE dropOne #-}
339−dropOne :: MonadIO m => Int -> Stream m Int -> m ()
340−dropOne n = composeN n $ S.drop 1
341−
342−{-# INLINE dropAll #-}
343−dropAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
344−dropAll value n = composeN n $ S.drop (value + 1)
345−
346−{-# INLINE dropWhileTrue #-}
347−dropWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
348−dropWhileTrue value n = composeN n $ S.dropWhile (<= (value + 1))
349−
350−{-# INLINE _dropWhileMTrue #-}
351−_dropWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
352−_dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))
353−
354−{-# INLINE dropWhileFalse #-}
355−dropWhileFalse :: MonadIO m => Int -> Int -> Stream m Int -> m ()
356−dropWhileFalse value n = composeN n $ S.dropWhile (> (value + 1))
357−
358−{-# INLINE findIndices #-}
359−findIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
360−findIndices value n = composeN n $ S.findIndices (== (value + 1))
361−
362−{-# INLINE elemIndices #-}
363−elemIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
364−elemIndices value n = composeN n $ S.elemIndices (value + 1)
365−
366−{-# INLINE intersperse #-}
367−intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
368−intersperse value n = composeN n $ S.intersperse (value + 1)
369−
370−{-# INLINE insertBy #-}
371−insertBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
372−insertBy value n = composeN n $ S.insertBy compare (value + 1)
373−
374−{-# INLINE deleteBy #-}
375−deleteBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
376−deleteBy value n = composeN n $ S.deleteBy (>=) (value + 1)
377−
378−{-# INLINE foldrS #-}
379−foldrS :: MonadIO m => Int -> Stream m Int -> m ()
380−foldrS n = composeN n $ Internal.foldrS S.cons S.nil
381−
382−{-# INLINE foldrSMap #-}
383−foldrSMap :: MonadIO m => Int -> Stream m Int -> m ()
384−foldrSMap n = composeN n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
385−
386−{-# INLINE foldrT #-}
387−foldrT :: MonadIO m => Int -> Stream m Int -> m ()
388−foldrT n = composeN n $ Internal.foldrT S.cons S.nil
389−
390−{-# INLINE foldrTMap #-}
391−foldrTMap :: MonadIO m => Int -> Stream m Int -> m ()
392−foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
393−
394−{-# INLINE takeByTime #-}
395−takeByTime :: NanoSecond64 -> Int -> Stream IO Int -> IO ()
396−takeByTime i n = composeN n (Internal.takeByTime i)
397−
398−#ifdef INSPECTION
399−-- inspect $ hasNoType 'takeByTime ''SPEC
400−inspect $ hasNoTypeClasses 'takeByTime
401−-- inspect $ 'takeByTime `hasNoType` ''D.Step
402−#endif
403−
404−{-# INLINE dropByTime #-}
405−dropByTime :: NanoSecond64 -> Int -> Stream IO Int -> IO ()
406−dropByTime i n = composeN n (Internal.dropByTime i)
407−
408−#ifdef INSPECTION
409−inspect $ hasNoTypeClasses 'dropByTime
410−-- inspect $ 'dropByTime `hasNoType` ''D.Step
411−#endif
412−
413−-------------------------------------------------------------------------------
414−-- Pipes
415−-------------------------------------------------------------------------------
416−
417−{-# INLINE transformMapM #-}
418−transformMapM ::
419− (S.IsStream t, S.MonadAsync m)
420− => (t m Int -> S.SerialT m Int)
421− -> Int
422− -> t m Int
423− -> m ()
424−transformMapM t n = composeN' n $ t . Internal.transform (Pipe.mapM return)
425−
426−{-# INLINE transformComposeMapM #-}
427−transformComposeMapM ::
428− (S.IsStream t, S.MonadAsync m)
429− => (t m Int -> S.SerialT m Int)
430− -> Int
431− -> t m Int
432− -> m ()
433−transformComposeMapM t n =
434− composeN' n $
435− t .
436− Internal.transform
437− (Pipe.mapM (\x -> return (x + 1)) `Pipe.compose`
438− Pipe.mapM (\x -> return (x + 2)))
439−
440−{-# INLINE transformTeeMapM #-}
441−transformTeeMapM ::
442− (S.IsStream t, S.MonadAsync m)
443− => (t m Int -> S.SerialT m Int)
444− -> Int
445− -> t m Int
446− -> m ()
447−transformTeeMapM t n =
448− composeN' n $
449− t .
450− Internal.transform
451− (Pipe.mapM (\x -> return (x + 1)) `Pipe.tee`
452− Pipe.mapM (\x -> return (x + 2)))
453−
454−{-# INLINE transformZipMapM #-}
455−transformZipMapM ::
456− (S.IsStream t, S.MonadAsync m)
457− => (t m Int -> S.SerialT m Int)
458− -> Int
459− -> t m Int
460− -> m ()
461−transformZipMapM t n =
462− composeN' n $
463− t .
464− Internal.transform
465− (Pipe.zipWith
466− (+)
467− (Pipe.mapM (\x -> return (x + 1)))
468− (Pipe.mapM (\x -> return (x + 2))))
469−
470−
471−-------------------------------------------------------------------------------
472−-- Mixed Transformation
473−-------------------------------------------------------------------------------
474−
475−{-# INLINE scanMap #-}
476−scanMap :: MonadIO m => Int -> Stream m Int -> m ()
477−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
478−
479−{-# INLINE dropMap #-}
480−dropMap :: MonadIO m => Int -> Stream m Int -> m ()
481−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
482−
483−{-# INLINE dropScan #-}
484−dropScan :: MonadIO m => Int -> Stream m Int -> m ()
485−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
486−
487−{-# INLINE takeDrop #-}
488−takeDrop :: MonadIO m => Int -> Int -> Stream m Int -> m ()
489−takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)
490−
491−{-# INLINE takeScan #-}
492−takeScan :: MonadIO m => Int -> Int -> Stream m Int -> m ()
493−takeScan value n = composeN n $ S.scanl' (+) 0 . S.take (value + 1)
494−
495−{-# INLINE takeMap #-}
496−takeMap :: MonadIO m => Int -> Int -> Stream m Int -> m ()
497−takeMap value n = composeN n $ S.map (subtract 1) . S.take (value + 1)
498−
499−{-# INLINE filterDrop #-}
500−filterDrop :: MonadIO m => Int -> Int -> Stream m Int -> m ()
501−filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1))
502−
503−{-# INLINE filterTake #-}
504−filterTake :: MonadIO m => Int -> Int -> Stream m Int -> m ()
505−filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))
506−
507−{-# INLINE filterScan #-}
508−filterScan :: MonadIO m => Int -> Stream m Int -> m ()
509−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
510−
511−{-# INLINE filterScanl1 #-}
512−filterScanl1 :: MonadIO m => Int -> Stream m Int -> m ()
513−filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
514−
515−{-# INLINE filterMap #-}
516−filterMap :: MonadIO m => Int -> Int -> Stream m Int -> m ()
517−filterMap value n = composeN n $ S.map (subtract 1) . S.filter (<= (value + 1))
518−
519−-------------------------------------------------------------------------------
520−-- Scan and fold
521−-------------------------------------------------------------------------------
522−
523−data Pair a b =
524− Pair !a !b
525− deriving (Generic, NFData)
526−
527−{-# INLINE sumProductFold #-}
528−sumProductFold :: Monad m => Stream m Int -> m (Int, Int)
529−sumProductFold = S.foldl' (\(s, p) x -> (s + x, p P.* x)) (0, 1)
530−
531−{-# INLINE sumProductScan #-}
532−sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)
533−sumProductScan =
534− S.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p P.* x)) (Pair 0 1) .
535− S.scanl' (\(s, _) x -> (s + x, x)) (0, 0)
536−
537−-------------------------------------------------------------------------------
538−-- Iteration
539−-------------------------------------------------------------------------------
540−
541−{-# INLINE iterStreamLen #-}
542−iterStreamLen :: Int
543−iterStreamLen = 10
544−
545−{-# INLINE maxIters #-}
546−maxIters :: Int
547−maxIters = 10000
548−
549−{-# INLINE iterateSource #-}
550−iterateSource ::
551− S.MonadAsync m
552− => (Stream m Int -> Stream m Int)
553− -> Int
554− -> Int
555− -> Stream m Int
556−iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
557− where
558− f (0 :: Int) m = g m
559− f x m = g (f (x P.- 1) m)
560−
561−-- this is quadratic
562−{-# INLINE iterateScan #-}
563−iterateScan :: S.MonadAsync m => Int -> Stream m Int
564−iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
565−
566−-- this is quadratic
567−{-# INLINE iterateScanl1 #-}
568−iterateScanl1 :: S.MonadAsync m => Int -> Stream m Int
569−iterateScanl1 = iterateSource (S.scanl1' (+)) (maxIters `div` 10)
570−
571−{-# INLINE iterateMapM #-}
572−iterateMapM :: S.MonadAsync m => Int -> Stream m Int
573−iterateMapM = iterateSource (S.mapM return) maxIters
574−
575−{-# INLINE iterateFilterEven #-}
576−iterateFilterEven :: S.MonadAsync m => Int -> Stream m Int
577−iterateFilterEven = iterateSource (S.filter even) maxIters
578−
579−{-# INLINE iterateTakeAll #-}
580−iterateTakeAll :: S.MonadAsync m => Int -> Int -> Stream m Int
581−iterateTakeAll value = iterateSource (S.take (value + 1)) maxIters
582−
583−{-# INLINE iterateDropOne #-}
584−iterateDropOne :: S.MonadAsync m => Int -> Stream m Int
585−iterateDropOne = iterateSource (S.drop 1) maxIters
586−
587−{-# INLINE iterateDropWhileFalse #-}
588−iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Stream m Int
589−iterateDropWhileFalse value =
590− iterateSource (S.dropWhile (> (value + 1))) maxIters
591−
592−{-# INLINE iterateDropWhileTrue #-}
593−iterateDropWhileTrue :: S.MonadAsync m => Int -> Int -> Stream m Int
594−iterateDropWhileTrue value =
595− iterateSource (S.dropWhile (<= (value + 1))) maxIters
596−
597−-------------------------------------------------------------------------------
598−-- Monad transformation (hoisting etc.)
599−-------------------------------------------------------------------------------
600−
601−{-# INLINE sourceUnfoldrState #-}
602−sourceUnfoldrState :: (S.IsStream t, S.MonadAsync m)
603− => Int -> Int -> t (StateT Int m) Int
604−sourceUnfoldrState value n = S.unfoldrM step n
605− where
606− step cnt =
607− if cnt > n + value
608− then return Nothing
609− else do
610− s <- get
611− put (s + 1)
612− return (Just (s, cnt + 1))
613−
614−{-# INLINE evalStateT #-}
615−evalStateT :: S.MonadAsync m => Int -> Int -> Stream m Int
616−evalStateT value n = Internal.evalStateT 0 (sourceUnfoldrState value n)
617−
618−{-# INLINE withState #-}
619−withState :: S.MonadAsync m => Int -> Int -> Stream m Int
620−withState value n =
621− Internal.evalStateT (0 :: Int) (Internal.liftInner (sourceUnfoldrM value n))
622−
623−-------------------------------------------------------------------------------
624−-- Traversable Instance
625−-------------------------------------------------------------------------------
626−
627−{-# INLINE traversableTraverse #-}
628−traversableTraverse :: Stream Identity Int -> IO (Stream Identity Int)
629−traversableTraverse = P.traverse return
630−
631−{-# INLINE traversableSequenceA #-}
632−traversableSequenceA :: Stream Identity Int -> IO (Stream Identity Int)
633−traversableSequenceA = P.sequenceA . P.fmap return
634−
635−{-# INLINE traversableMapM #-}
636−traversableMapM :: Stream Identity Int -> IO (Stream Identity Int)
637−traversableMapM = P.mapM return
638−
639−{-# INLINE traversableSequence #-}
640−traversableSequence :: Stream Identity Int -> IO (Stream Identity Int)
641−traversableSequence = P.sequence . P.fmap return
642−
643−-------------------------------------------------------------------------------
644−-- Benchmark groups
645−-------------------------------------------------------------------------------
646−
647−-- We need a monadic bind here to make sure that the function f does not get
648−-- completely optimized out by the compiler in some cases.
649−
650−-- | Takes a fold method, and uses it with a default source.
651−{-# INLINE benchIOSink #-}
652−benchIOSink
653− :: (IsStream t, NFData b)
654− => Int -> String -> (t IO Int -> IO b) -> Benchmark
655−benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
656−
657−-- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but
658−-- we can't use it as it requires MonadAsync constraint.
659−
660−-- | Takes a source, and uses it with a default drain/fold method.
661−{-# INLINE benchIOSrc #-}
662−benchIOSrc
663− :: (t IO a -> SerialT IO a)
664− -> String
665− -> (Int -> t IO a)
666− -> Benchmark
667−benchIOSrc t name f =
668− bench name $ nfIO $ randomRIO (1,1) >>= toNull t . f
669−
670−{-# INLINE benchPureSinkIO #-}
671−benchPureSinkIO
672− :: NFData b
673− => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
674−benchPureSinkIO value name f =
675− bench name $ nfIO $ randomRIO (1, 1) >>= f . sourceUnfoldr value
676−
677−-------------------------------------------------------------------------------
678−-- Benchmark groups
679−-------------------------------------------------------------------------------
680−
681−o_1_space_serial_pipes :: Int -> [Benchmark]
682−o_1_space_serial_pipes value =
683− [ bgroup
684− "serially"
685− [ bgroup
686− "pipes"
687− [ benchIOSink value "mapM" (transformMapM serially 1)
688− , benchIOSink
689− value
690− "compose"
691− (transformComposeMapM serially 1)
692− , benchIOSink value "tee" (transformTeeMapM serially 1)
693− , benchIOSink value "zip" (transformZipMapM serially 1)
694− ]
695− ]
696− ]
697−
698−o_1_space_serial_pipesX4 :: Int -> [Benchmark]
699−o_1_space_serial_pipesX4 value =
700− [ bgroup
701− "serially"
702− [ bgroup
703− "pipesX4"
704− [ benchIOSink value "mapM" (transformMapM serially 4)
705− , benchIOSink
706− value
707− "compose"
708− (transformComposeMapM serially 4)
709− , benchIOSink value "tee" (transformTeeMapM serially 4)
710− , benchIOSink value "zip" (transformZipMapM serially 4)
711− ]
712− ]
713− ]
714−
715−
716−o_1_space_serial_transformer :: Int -> [Benchmark]
717−o_1_space_serial_transformer value =
718− [ bgroup
719− "serially"
720− [ bgroup
721− "transformer"
722− [ benchIOSrc serially "evalState" (evalStateT value)
723− , benchIOSrc serially "withState" (withState value)
724− ]
725− ]
726− ]
727−
728−o_1_space_serial_transformation :: Int -> [Benchmark]
729−o_1_space_serial_transformation value =
730− [ bgroup
731− "serially"
732− [ bgroup
733− "transformation"
734− [ benchIOSink value "scanl" (scan 1)
735− , benchIOSink value "scanl1'" (scanl1' 1)
736− , benchIOSink value "map" (map 1)
737− , benchIOSink value "fmap" (fmap 1)
738− , benchIOSink value "mapM" (mapM serially 1)
739− , benchIOSink value "mapMaybe" (mapMaybe 1)
740− , benchIOSink value "mapMaybeM" (mapMaybeM 1)
741− , bench "sequence" $
742− nfIO $
743− randomRIO (1, 1000) >>= \n ->
744− sequence serially (sourceUnfoldrMAction value n)
745− , benchIOSink value "findIndices" (findIndices value 1)
746− , benchIOSink value "elemIndices" (elemIndices value 1)
747− , benchIOSink value "foldrS" (foldrS 1)
748− , benchIOSink value "foldrSMap" (foldrSMap 1)
749− , benchIOSink value "foldrT" (foldrT 1)
750− , benchIOSink value "foldrTMap" (foldrTMap 1)
751− , benchIOSink value "tap" (tap 1)
752− , benchIOSink value "tapRate 1 second" (tapRate 1)
753− , benchIOSink value "pollCounts 1 second" (pollCounts 1)
754− , benchIOSink value "tapAsync" (tapAsync 1)
755− , benchIOSink value "tapAsyncS" (tapAsyncS 1)
756− , benchIOSink value "timestamped" timestamped
757− ]
758− ]
759− ]
760−
761−o_1_space_serial_transformationX4 :: Int -> [Benchmark]
762−o_1_space_serial_transformationX4 value =
763− [ bgroup
764− "serially"
765− [ bgroup
766− "transformationX4"
767− [ benchIOSink value "scan" (scan 4)
768− , benchIOSink value "scanl1'" (scanl1' 4)
769− , benchIOSink value "map" (map 4)
770− , benchIOSink value "fmap" (fmap 4)
771− , benchIOSink value "mapM" (mapM serially 4)
772− , benchIOSink value "mapMaybe" (mapMaybe 4)
773− , benchIOSink value "mapMaybeM" (mapMaybeM 4)
774− -- , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->
775− -- sequence serially (sourceUnfoldrMAction n)
776− , benchIOSink value "findIndices" (findIndices value 4)
777− , benchIOSink value "elemIndices" (elemIndices value 4)
778− ]
779− ]
780− ]
781−
782−o_1_space_serial_filtering :: Int -> [Benchmark]
783−o_1_space_serial_filtering value =
784− [ bgroup
785− "serially"
786− [ bgroup
787− "filtering"
788− [ benchIOSink value "filter-even" (filterEven 1)
789− , benchIOSink value "filter-all-out" (filterAllOut value 1)
790− , benchIOSink value "filter-all-in" (filterAllIn value 1)
791− , benchIOSink value "take-all" (takeAll value 1)
792− , benchIOSink
793− value
794− "takeByTime-all"
795− (takeByTime (NanoSecond64 maxBound) 1)
796− , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
797− --, benchIOSink value "takeWhileM-true" (_takeWhileMTrue 1)
798− -- "drop-one" is dual to "last"
799− , benchIOSink value "drop-one" (dropOne 1)
800− , benchIOSink value "drop-all" (dropAll value 1)
801− , benchIOSink
802− value
803− "dropByTime-all"
804− (dropByTime (NanoSecond64 maxBound) 1)
805− , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
806− --, benchIOSink value "dropWhileM-true" (_dropWhileMTrue 1)
807− , benchIOSink
808− value
809− "dropWhile-false"
810− (dropWhileFalse value 1)
811− , benchIOSink value "deleteBy" (deleteBy value 1)
812− , benchIOSink value "intersperse" (intersperse value 1)
813− , benchIOSink value "insertBy" (insertBy value 1)
814− ]
815− ]
816− ]
817−
818−o_1_space_serial_filteringX4 :: Int -> [Benchmark]
819−o_1_space_serial_filteringX4 value =
820− [ bgroup
821− "serially"
822− [ bgroup
823− "filteringX4"
824− [ benchIOSink value "filter-even" (filterEven 4)
825− , benchIOSink value "filter-all-out" (filterAllOut value 4)
826− , benchIOSink value "filter-all-in" (filterAllIn value 4)
827− , benchIOSink value "take-all" (takeAll value 4)
828− , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)
829− --, benchIOSink value "takeWhileM-true" (_takeWhileMTrue 4)
830− , benchIOSink value "drop-one" (dropOne 4)
831− , benchIOSink value "drop-all" (dropAll value 4)
832− , benchIOSink value "dropWhile-true" (dropWhileTrue value 4)
833− --, benchIOSink value "dropWhileM-true" (_dropWhileMTrue 4)
834− , benchIOSink
835− value
836− "dropWhile-false"
837− (dropWhileFalse value 4)
838− , benchIOSink value "deleteBy" (deleteBy value 4)
839− , benchIOSink value "intersperse" (intersperse value 4)
840− , benchIOSink value "insertBy" (insertBy value 4)
841− ]
842− ]
843− ]
844−
845−
846−o_1_space_serial_mixed :: Int -> [Benchmark]
847−o_1_space_serial_mixed value =
848− [ bgroup
849− "serially"
850− -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl
851− -- library. If scan/fold followed by a map is efficient enough we may not
852− -- need monolithic implementations of these.
853− [ bgroup
854− "mixed"
855− [ benchIOSink value "scanl-map" (scanMap 1)
856− , benchIOSink value "foldl-map" foldl'ReduceMap
857− , benchIOSink value "sum-product-fold" sumProductFold
858− , benchIOSink value "sum-product-scan" sumProductScan
859− ]
860− ]
861− ]
862−
863−o_1_space_serial_mixedX4 :: Int -> [Benchmark]
864−o_1_space_serial_mixedX4 value =
865− [ bgroup
866− "serially"
867− [ bgroup
868− "mixedX4"
869− [ benchIOSink value "scan-map" (scanMap 4)
870− , benchIOSink value "drop-map" (dropMap 4)
871− , benchIOSink value "drop-scan" (dropScan 4)
872− , benchIOSink value "take-drop" (takeDrop value 4)
873− , benchIOSink value "take-scan" (takeScan value 4)
874− , benchIOSink value "take-map" (takeMap value 4)
875− , benchIOSink value "filter-drop" (filterDrop value 4)
876− , benchIOSink value "filter-take" (filterTake value 4)
877− , benchIOSink value "filter-scan" (filterScan 4)
878− , benchIOSink value "filter-scanl1" (filterScanl1 4)
879− , benchIOSink value "filter-map" (filterMap value 4)
880− ]
881− ]
882− ]
883−
884−o_1_space_wSerial_transformation :: Int -> [Benchmark]
885−o_1_space_wSerial_transformation value =
886− [ bgroup
887− "wSerially"
888− [ bgroup
889− "transformation"
890− [benchIOSink value "fmap" $ fmap' wSerially 1]
891− ]
892− ]
893−
894−o_1_space_zipSerial_transformation :: Int -> [Benchmark]
895−o_1_space_zipSerial_transformation value =
896− [ bgroup
897− "zipSerially"
898− [ bgroup
899− "transformation"
900− [benchIOSink value "fmap" $ fmap' zipSerially 1]
901− -- XXX needs fixing
902− {-
903− , bgroup "outer-product"
904− [ benchIO "toNullAp" $ Nested.toNullAp value zipSerially
905− ]
906− -}
907− ]
908− ]
909−
910−
911−o_n_space_serial :: Int -> [Benchmark]
912−o_n_space_serial value =
913− [ bgroup
914− "serially"
915− -- Buffering operations using heap proportional to number of elements.
916− [ bgroup
917− "traversable" -- < 2MB
918− -- Traversable instance
919− [ benchPureSinkIO value "traverse" traversableTraverse
920− , benchPureSinkIO value "sequenceA" traversableSequenceA
921− , benchPureSinkIO value "mapM" traversableMapM
922− , benchPureSinkIO value "sequence" traversableSequence
923− ]
924− , benchIOSink (value `div` 10) "classifySessionsOf"
925− classifySessionsOf
926− ]
927− ]
928−
929−
930−-- Head recursive operations.
931−o_n_stack_serial_iterated :: Int -> [Benchmark]
932−o_n_stack_serial_iterated value =
933− [ bgroup
934− "serially"
935− [ bgroup
936− "iterated"
937− [ benchIOSrc serially "mapMx10K" iterateMapM
938− , benchIOSrc serially "scanx100" iterateScan
939− , benchIOSrc serially "scanl1x100" iterateScanl1
940− , benchIOSrc serially "filterEvenx10K" iterateFilterEven
941− , benchIOSrc serially "takeAllx10K" (iterateTakeAll value)
942− , benchIOSrc serially "dropOnex10K" iterateDropOne
943− , benchIOSrc
944− serially
945− "dropWhileFalsex10K"
946− (iterateDropWhileFalse value)
947− , benchIOSrc
948− serially
949− "dropWhileTruex10K"
950− (iterateDropWhileTrue value)
951− , benchIOSink value "tail" tail
952− , benchIOSink value "nullHeadTail" nullHeadTail
953− ]
954− ]
955− ]
956−
957−
958−o_1_space_async_transformation :: Int -> [Benchmark]
959−o_1_space_async_transformation value =
960− [ bgroup
961− "asyncly"
962− [ bgroup
963− "transformation"
964− [ benchIOSink value "map" $ map' asyncly 1
965− , benchIOSink value "fmap" $ fmap' asyncly 1
966− , benchIOSink value "mapM" $ mapM asyncly 1
967− ]
968− ]
969− ]
970−
971−
972−o_1_space_wAsync_transformation :: Int -> [Benchmark]
973−o_1_space_wAsync_transformation value =
974− [ bgroup
975− "wAsyncly"
976− [ bgroup
977− "transformation"
978− [ benchIOSink value "map" $ map' wAsyncly 1
979− , benchIOSink value "fmap" $ fmap' wAsyncly 1
980− , benchIOSink value "mapM" $ mapM wAsyncly 1
981− ]
982− ]
983− ]
984−
985−
986−
987−o_1_space_ahead_transformation :: Int -> [Benchmark]
988−o_1_space_ahead_transformation value =
989− [ bgroup
990− "aheadly"
991− [ bgroup
992− "transformation"
993− [ benchIOSink value "map" $ map' aheadly 1
994− , benchIOSink value "fmap" $ fmap' aheadly 1
995− , benchIOSink value "mapM" $ mapM aheadly 1
996− ]
997− ]
998− ]
999−
1000−
1001−
1002−o_n_space_parallel_transformation :: Int -> [Benchmark]
1003−o_n_space_parallel_transformation value =
1004− [ bgroup
1005− "parallely"
1006− [ bgroup
1007− "transformation"
1008− [ benchIOSink value "map" $ map' parallely 1
1009− , benchIOSink value "fmap" $ fmap' parallely 1
1010− , benchIOSink value "mapM" $ mapM parallely 1
1011− ]
1012− ]
1013− ]
benchmark/streamly-benchmarks.cabal+81−70
@@ -128,27 +128,9 @@ common bench-depends
128
128
129library
129library
130 import: lib-options, bench-depends
130 import: lib-options, bench-depends
131− hs-source-dirs: lib
131+ hs-source-dirs: lib
132− exposed-modules:
133− Streamly.Benchmark.Common
134−
135−library lib-prelude
136− import: lib-options, bench-depends
137− hs-source-dirs: lib, .
138− exposed-modules:
139− Streamly.Benchmark.Prelude
140− other-modules: Streamly.Benchmark.Common
132+ exposed-modules: Streamly.Benchmark.Common
141− , Streamly.Benchmark.Prelude.NestedOps
142− , Streamly.Benchmark.Prelude.Generation
143− , Streamly.Benchmark.Prelude.Elimination
144− , Streamly.Benchmark.Prelude.Transformation
133+ , Streamly.Benchmark.Prelude
145−
146− -- XXX GHCJS build fails for this library.
147− if impl(ghcjs)
148− buildable: False
149− else
150− build-depends: ghc-prim
151− buildable: True
152
134
153-------------------------------------------------------------------------------
135-------------------------------------------------------------------------------
154-- Benchmarks
136-- Benchmarks
@@ -161,25 +143,21 @@ library lib-prelude
161common bench-options
143common bench-options
162 import: compile-options, optimization-options, bench-depends
144 import: compile-options, optimization-options, bench-depends
163 ghc-options: -rtsopts
145 ghc-options: -rtsopts
164− build-depends: streamly-benchmarks
146+ build-depends: streamly-benchmarks == 0.0.0
165
147
166-- Some benchmarks are threaded some are not
148-- Some benchmarks are threaded some are not
167common bench-options-threaded
149common bench-options-threaded
168 import: compile-options, optimization-options, bench-depends
150 import: compile-options, optimization-options, bench-depends
169 -- -threaded and -N2 is important because some GC and space leak issues
151 -- -threaded and -N2 is important because some GC and space leak issues
170 -- trigger only with these options.
152 -- trigger only with these options.
171− ghc-options: -threaded -with-rtsopts "-T -N2 -K32K -M16M"
153+ ghc-options: -threaded -rtsopts -with-rtsopts "-N2"
172− build-depends: streamly-benchmarks
154+ build-depends: streamly-benchmarks == 0.0.0
173−
174−-- XXX the individual modules can just export a bunch of gauge Benchmark
175−-- grouped by space usage and then we can combine the groups in just four
176−-- different top level drivers.
177
155
178-------------------------------------------------------------------------------
156-------------------------------------------------------------------------------
179-- Serial Streams
157-- Serial Streams
180-------------------------------------------------------------------------------
158-------------------------------------------------------------------------------
181
159
182−benchmark serial
160+benchmark Prelude.Serial
183 import: bench-options
161 import: bench-options
184 type: exitcode-stdio-1.0
162 type: exitcode-stdio-1.0
185 hs-source-dirs: Streamly/Benchmark/Prelude
163 hs-source-dirs: Streamly/Benchmark/Prelude
@@ -187,7 +165,76 @@ benchmark serial
187 if impl(ghcjs)
165 if impl(ghcjs)
188 buildable: False
166 buildable: False
189 else
167 else
190− build-depends: lib-prelude
168+ buildable: True
169+
170+benchmark Prelude.WSerial
171+ import: bench-options
172+ type: exitcode-stdio-1.0
173+ hs-source-dirs: Streamly/Benchmark/Prelude
174+ main-is: WSerial.hs
175+ if impl(ghcjs)
176+ buildable: False
177+ else
178+ buildable: True
179+
180+benchmark Prelude.ZipSerial
181+ import: bench-options
182+ type: exitcode-stdio-1.0
183+ hs-source-dirs: Streamly/Benchmark/Prelude
184+ main-is: ZipSerial.hs
185+ if impl(ghcjs)
186+ buildable: False
187+ else
188+ buildable: True
189+
190+benchmark Prelude.ZipAsync
191+ import: bench-options
192+ type: exitcode-stdio-1.0
193+ hs-source-dirs: Streamly/Benchmark/Prelude
194+ main-is: ZipAsync.hs
195+ if impl(ghcjs)
196+ buildable: False
197+ else
198+ buildable: True
199+
200+benchmark Prelude.Ahead
201+ import: bench-options-threaded
202+ type: exitcode-stdio-1.0
203+ hs-source-dirs: Streamly/Benchmark/Prelude
204+ main-is: Ahead.hs
205+ if impl(ghcjs)
206+ buildable: False
207+ else
208+ buildable: True
209+
210+benchmark Prelude.Async
211+ import: bench-options-threaded
212+ type: exitcode-stdio-1.0
213+ hs-source-dirs: Streamly/Benchmark/Prelude
214+ main-is: Async.hs
215+ if impl(ghcjs)
216+ buildable: False
217+ else
218+ buildable: True
219+
220+benchmark Prelude.WAsync
221+ import: bench-options-threaded
222+ type: exitcode-stdio-1.0
223+ hs-source-dirs: Streamly/Benchmark/Prelude
224+ main-is: WAsync.hs
225+ if impl(ghcjs)
226+ buildable: False
227+ else
228+ buildable: True
229+
230+benchmark Prelude.Parallel
231+ import: bench-options-threaded
232+ type: exitcode-stdio-1.0
233+ hs-source-dirs: Streamly/Benchmark/Prelude
234+ main-is: Parallel.hs
235+ if impl(ghcjs)
236+ buildable: False
237+ else
191 buildable: True
238 buildable: True
192
239
193benchmark Data.Unfold
240benchmark Data.Unfold
@@ -291,47 +338,13 @@ executable nano-bench
291-- Concurrent Streams
338-- Concurrent Streams
292-------------------------------------------------------------------------------
339-------------------------------------------------------------------------------
293
340
294−benchmark linear-async
341+benchmark Prelude.Concurrent
295− import: bench-options-threaded
296− type: exitcode-stdio-1.0
297− ghc-options: -with-rtsopts "-T -N2 -K64K -M16M"
298− hs-source-dirs: Streamly/Benchmark/Prelude
299− main-is: LinearAsync.hs
300− if impl(ghcjs)
301− buildable: False
302− else
303− build-depends: lib-prelude
304− buildable: True
305−
306−benchmark nested-concurrent
307− import: bench-options-threaded
308− type: exitcode-stdio-1.0
309− -- XXX this can be lowered once we split out the finite benchmarks
310− ghc-options: -with-rtsopts "-T -N2 -K256K -M128M"
311− hs-source-dirs: ., Streamly/Benchmark/Prelude
312− main-is: NestedConcurrent.hs
313− other-modules: Streamly.Benchmark.Prelude.NestedOps
314−
315−benchmark parallel
316− import: bench-options-threaded
317− type: exitcode-stdio-1.0
318− ghc-options: -with-rtsopts "-T -N2 -K128K -M256M"
319− hs-source-dirs: Streamly/Benchmark/Prelude
320− main-is: Parallel.hs
321− if impl(ghcjs)
322− buildable: False
323− else
324− build-depends: lib-prelude
325− buildable: True
326−
327−benchmark concurrent
328 import: bench-options-threaded
342 import: bench-options-threaded
329 type: exitcode-stdio-1.0
343 type: exitcode-stdio-1.0
330 hs-source-dirs: Streamly/Benchmark/Prelude
344 hs-source-dirs: Streamly/Benchmark/Prelude
331 main-is: Concurrent.hs
345 main-is: Concurrent.hs
332− ghc-options: -with-rtsopts "-T -N2 -K256K -M384M"
333
346
334−benchmark adaptive
347+benchmark Prelude.Adaptive
335 import: bench-options-threaded
348 import: bench-options-threaded
336 type: exitcode-stdio-1.0
349 type: exitcode-stdio-1.0
337 hs-source-dirs: Streamly/Benchmark/Prelude
350 hs-source-dirs: Streamly/Benchmark/Prelude
@@ -341,15 +354,14 @@ benchmark adaptive
341 else
354 else
342 buildable: True
355 buildable: True
343
356
344−benchmark linear-rate
357+benchmark Prelude.Rate
345 import: bench-options-threaded
358 import: bench-options-threaded
346 type: exitcode-stdio-1.0
359 type: exitcode-stdio-1.0
347 hs-source-dirs: Streamly/Benchmark/Prelude
360 hs-source-dirs: Streamly/Benchmark/Prelude
348− main-is: LinearRate.hs
361+ main-is: Rate.hs
349 if impl(ghcjs)
362 if impl(ghcjs)
350 buildable: False
363 buildable: False
351 else
364 else
352− build-depends: lib-prelude
353 buildable: True
365 buildable: True
354
366
355-------------------------------------------------------------------------------
367-------------------------------------------------------------------------------
@@ -412,7 +424,6 @@ executable chart
412 build-Depends:
424 build-Depends:
413 base >= 4.8 && < 5
425 base >= 4.8 && < 5
414 , bench-show >= 0.3 && < 0.4
426 , bench-show >= 0.3 && < 0.4
415− , split
416 , transformers >= 0.4 && < 0.6
427 , transformers >= 0.4 && < 0.6
417 else
428 else
418 buildable: False
429 buildable: False
bin/bench-exec-one.shnew file+133
@@ -0,0 +1,133 @@
1+#!/bin/bash
2+
3+# Environment passed:
4+# BENCH_EXEC_PATH: the benchmark executable
5+# RTS_OPTIONS: additional RTS options
6+# QUICK_MODE: whether we are in quick mode
7+
8+#------------------------------------------------------------------------------
9+# RTS Options
10+#------------------------------------------------------------------------------
11+
12+# RTS options based on the benchmark executable
13+bench_exe_rts_opts () {
14+ case "$1" in
15+ Prelude.Concurrent*) echo -n "-K256K -M384M" ;;
16+ *) echo -n "" ;;
17+ esac
18+}
19+
20+# General RTS options for different classes of benchmarks
21+bench_rts_opts_default () {
22+ case "$1" in
23+ */o-1-sp*) echo -n "-K36K -M16M" ;;
24+ */o-n-h*) echo -n "-K36K -M32M" ;;
25+ */o-n-st*) echo -n "-K1M -M16M" ;;
26+ */o-n-sp*) echo -n "-K1M -M32M" ;;
27+ *) echo -n "" ;;
28+ esac
29+}
30+
31+# Overrides for specific benchmarks
32+bench_rts_opts_specific () {
33+ case "$1" in
34+ Prelude.Parallel/o-n-heap/mapping/mapM) echo -n "-M256M" ;;
35+ #Prelude.Parallel/o-n-heap/monad-outer-product/toList) echo -n "-K-M256M" ;;
36+ Prelude.Parallel/o-n-heap/monad-outer-product/*) echo -n "-M256M" ;;
37+ Prelude.Parallel/o-n-space/monad-outer-product/*) echo -n "-K4M -M256M" ;;
38+ Prelude.Serial/o-n-space/grouping/*) echo -n "" ;;
39+ Prelude.Serial/o-n-space/*) echo -n "-K4M" ;;
40+ Prelude.WSerial/o-n-space/*) echo -n "-K4M" ;;
41+
42+ Prelude.Async/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
43+ Prelude.Ahead/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
44+
45+ Prelude.WAsync/o-n-heap/monad-outer-product/toNull3) echo -n "-M64M" ;;
46+ Prelude.WAsync/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
47+
48+ # XXX need to investigate these, taking too much stack
49+ Data.Parser.ParserD/o-1-space/some) echo -n "-K1M" ;;
50+ Data.Parser/o-1-space/some) echo -n "-K1M" ;;
51+ Data.Parser.ParserD/o-1-space/manyTill) echo -n "-K4M" ;;
52+ Data.Parser/o-1-space/manyTill) echo -n "-K4M" ;;
53+
54+ Data.SmallArray/o-1-sp*) echo -n "-K128K" ;;
55+ *) echo -n "" ;;
56+ esac
57+}
58+
59+#------------------------------------------------------------------------------
60+# Speed options
61+#------------------------------------------------------------------------------
62+
63+if test "$QUICK_MODE" -eq 0
64+then
65+QUICK_OPTIONS="--min-samples 3"
66+fi
67+SUPER_QUICK_OPTIONS="--min-samples 1 --include-first-iter"
68+
69+bench_exe_quick_opts () {
70+ case "$1" in
71+ Prelude.Concurrent) echo -n "$SUPER_QUICK_OPTIONS" ;;
72+ Prelude.Rate) echo -n "$SUPER_QUICK_OPTIONS" ;;
73+ Prelude.Adaptive) echo -n "$SUPER_QUICK_OPTIONS" ;;
74+ fileio) echo -n "$SUPER_QUICK_OPTIONS" ;;
75+ *) echo -n "" ;;
76+ esac
77+}
78+
79+# Use quick options for benchmarks that take too long
80+bench_quick_opts () {
81+ case "$1" in
82+ Prelude.Parallel/o-n-heap/mapping/mapM)
83+ echo -n "$SUPER_QUICK_OPTIONS" ;;
84+ Prelude.Parallel/o-n-heap/monad-outer-product/*)
85+ echo -n "$SUPER_QUICK_OPTIONS" ;;
86+ Prelude.Parallel/o-n-space/monad-outer-product/*)
87+ echo -n "$SUPER_QUICK_OPTIONS" ;;
88+ Prelude.Parallel/o-n-heap/generation/*) echo -n "$QUICK_OPTIONS" ;;
89+ Prelude.Parallel/o-n-heap/mapping/*) echo -n "$QUICK_OPTIONS" ;;
90+ Prelude.Parallel/o-n-heap/concat-foldable/*) echo -n "$QUICK_OPTIONS" ;;
91+
92+ Prelude.Async/o-1-space/monad-outer-product/*) echo -n "$QUICK_OPTIONS" ;;
93+ Prelude.Async/o-n-space/monad-outer-product/*) echo -n "$QUICK_OPTIONS" ;;
94+
95+ Prelude.Ahead/o-1-space/monad-outer-product/*) echo -n "$QUICK_OPTIONS" ;;
96+ Prelude.Ahead/o-n-space/monad-outer-product/*) echo -n "$QUICK_OPTIONS" ;;
97+
98+ Prelude.WAsync/o-n-heap/monad-outer-product/*) echo -n "$QUICK_OPTIONS" ;;
99+ Prelude.WAsync/o-n-space/monad-outer-product/*) echo -n "$QUICK_OPTIONS" ;;
100+ *) echo -n "" ;;
101+ esac
102+}
103+
104+last=""
105+for i in "$@"
106+do
107+ BENCH_NAME="$last"
108+ last="$i"
109+done
110+
111+RTS_OPTIONS=\
112+"+RTS -T \
113+$(bench_exe_rts_opts $(basename $BENCH_EXEC_PATH)) \
114+$(bench_rts_opts_default $BENCH_NAME) \
115+$(bench_rts_opts_specific $BENCH_NAME) \
116+$RTS_OPTIONS \
117+-RTS"
118+
119+QUICK_BENCH_OPTIONS="\
120+$(bench_exe_quick_opts $(basename $BENCH_EXEC_PATH)) \
121+$(bench_quick_opts $BENCH_NAME)"
122+
123+if test -n "$STREAM_SIZE"
124+then
125+ STREAM_LEN=$(env LC_ALL=en_US.UTF-8 printf "\--stream-size %'.f\n" $STREAM_SIZE)
126+fi
127+
128+echo "$BENCH_NAME: \
129+$STREAM_LEN \
130+$QUICK_BENCH_OPTIONS \
131+$RTS_OPTIONS"
132+
133+$BENCH_EXEC_PATH $RTS_OPTIONS "$@" $QUICK_BENCH_OPTIONS
streamly.cabal−1
@@ -138,7 +138,6 @@ extra-source-files:
138 benchmark/README.md
138 benchmark/README.md
139 benchmark/*.hs
139 benchmark/*.hs
140 benchmark/lib/Streamly/Benchmark/*.hs
140 benchmark/lib/Streamly/Benchmark/*.hs
141− benchmark/lib/Streamly/Benchmark/Prelude/*.hs
142 benchmark/Streamly/Benchmark/Memory/*.hs
141 benchmark/Streamly/Benchmark/Memory/*.hs
143 benchmark/Streamly/Benchmark/Data/*.hs
142 benchmark/Streamly/Benchmark/Data/*.hs
144 benchmark/Streamly/Benchmark/Data/Prim/*.hs
143 benchmark/Streamly/Benchmark/Data/Prim/*.hs