From 169dd814272fe77c13cab97930d6cfe075bfc349 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sat, 13 Jun 2026 02:03:31 +0530 Subject: [PATCH 01/20] Fix stream benchmark renaming in bench-runner --- benchmark/bench-runner/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/benchmark/bench-runner/Main.hs b/benchmark/bench-runner/Main.hs index e36d32a036..6210e52794 100644 --- a/benchmark/bench-runner/Main.hs +++ b/benchmark/bench-runner/Main.hs @@ -75,7 +75,7 @@ rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific] `isPrefixOf` benchName = "-K512K" -- GHC-9.6 requires 64M, earlier it was 32M - | "Data.Stream/o-n-heap.buffered.showPrec Haskell lists" + | "Data.Stream/o-n-heap.buffered.showsPrec Haskell lists" == benchName = "-M64M" -- GHC-9.6 requires 64M, earlier it was 32M | "Data.Stream/o-n-heap.buffered.readsPrec pure streams" From 09a093ab8c9f26f762627a1b636d0c9f30cfe1b0 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sat, 13 Jun 2026 03:47:05 +0530 Subject: [PATCH 02/20] Remove nested bench groups in Data.Stream benchmarks --- .../Benchmark/Data/Stream/Eliminate.hs | 32 +- .../Benchmark/Data/Stream/Exceptions.hs | 14 +- .../Benchmark/Data/Stream/Generate.hs | 2 - .../Streamly/Benchmark/Data/Stream/Lift.hs | 2 - .../Streamly/Benchmark/Data/Stream/Nesting.hs | 32 +- .../Benchmark/Data/Stream/Parse/Group.hs | 2 - .../Benchmark/Data/Stream/Parse/Split.hs | 15 +- .../Data/Stream/Parse/SplitChunks.hs | 2 - .../Benchmark/Data/Stream/Transform/Basic.hs | 231 +++++---- .../Data/Stream/Transform/Composed.hs | 146 +++--- .../Streamly/Benchmark/Data/Stream/Type.hs | 443 ++++++++---------- benchmark/bench-runner/Main.hs | 14 +- 12 files changed, 392 insertions(+), 543 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs b/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs index 096f142292..f570a5dae7 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs @@ -303,20 +303,9 @@ inspect $ 'lookupNever `hasNoType` ''SPEC o_1_space_elimination_folds :: Int -> [Benchmark] o_1_space_elimination_folds value = - [ bgroup "elimination" -- Basic folds - [ - bgroup "reduce" - [ bgroup - "IO" - [ benchIO "foldl1'" $ foldl1'Reduce value - ] - - , bgroup - "Identity" - [ benchIO "foldl1'" $ foldl1'ReduceIdentity value - ] - ] + [ benchIO "foldl1'/IO" $ foldl1'Reduce value + , benchIO "foldl1'/Identity" $ foldl1'ReduceIdentity value -- deconstruction , benchIO "mapM_" $ mapM_ value @@ -346,7 +335,6 @@ o_1_space_elimination_folds value = , benchIO "and" $ and value , benchIO "or" $ or value ] - ] {-# INLINE toListRev #-} toListRev :: Int -> IO [Int] @@ -359,12 +347,10 @@ toStreamRev value = withStream value (S.fold Fold.toStreamRev) o_n_heap_elimination_toList :: Int -> [Benchmark] o_n_heap_elimination_toList value = - [ bgroup "toList" -- Converting the stream to a list or pure stream in a strict monad [ benchIO "toListRev" $ toListRev value , benchIO "toStreamRev" $ toStreamRev value ] - ] -- NOTE: this is a Fold benchmark, used here only for comparison with ToList {-# INLINE toStream #-} @@ -373,11 +359,9 @@ toStream value = withStream value (S.fold Fold.toStream) o_n_space_elimination_toList :: Int -> [Benchmark] o_n_space_elimination_toList value = - [ bgroup "toList" -- Converting the stream to a list or pure stream in a strict monad [ benchIO "toStream" $ toStream value ] - ] ------------------------------------------------------------------------------- -- Multi-stream folds @@ -420,12 +404,10 @@ inspect $ 'stripPrefix `hasNoType` ''SPEC o_1_space_elimination_multi_stream :: Int -> [Benchmark] o_1_space_elimination_multi_stream value = - [ bgroup "multi-stream" [ benchIO "isPrefixOf" $ isPrefixOf value , benchIO "isSubsequenceOf" $ isSubsequenceOf value , benchIO "stripPrefix" $ stripPrefix value ] - ] ------------------------------------------------------------------------------- -- Iterating using tail @@ -462,13 +444,11 @@ headTail value = withStream value go o_n_stack_iterated :: Int -> [Benchmark] o_n_stack_iterated value = - [ bgroup "iterated" - [ benchIO "tail" $ tail value - , benchIO "nullTail" $ nullTail value - , benchIO "headTail" $ headTail value - , benchIO "nullHeadTail" $ nullHeadTail value + [ benchIO "iterated/tail" $ tail value + , benchIO "iterated/nullTail" $ nullTail value + , benchIO "iterated/headTail" $ headTail value + , benchIO "iterated/nullHeadTail" $ nullHeadTail value ] - ] ------------------------------------------------------------------------------- -- Main diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs b/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs index aa228b7f0e..e53f456cdd 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs @@ -94,7 +94,6 @@ readWriteAfter_Stream inh devNull = o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark] o_1_space_copy_stream_exceptions env = - [ bgroup "exceptions" [ mkBenchSmall "Stream.onException" env $ \inh _ -> readWriteOnExceptionStream inh (nullH env) , mkBenchSmall "Stream.handle" env $ \inh _ -> @@ -103,12 +102,9 @@ o_1_space_copy_stream_exceptions env = readWriteFinally_Stream inh (nullH env) , mkBenchSmall "Stream.after_" env $ \inh _ -> readWriteAfter_Stream inh (nullH env) - ] - , bgroup "exceptions/fromToBytes" - [ mkBenchSmall "Stream.bracket_" env $ \inh _ -> + , mkBenchSmall "Stream.bracket_ (fromToBytes)" env $ \inh _ -> fromToBytesBracket_Stream inh (nullH env) - ] - ] + ] ------------------------------------------------------------------------------- -- Exceptions readChunks @@ -128,13 +124,11 @@ readChunksBracket_ inh devNull = o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark] o_1_space_copy_exceptions_readChunks env = - [ bgroup "exceptions/readChunks" [ mkBench "UF.onException" env $ \inH _ -> readChunksOnException inH (nullH env) , mkBench "UF.bracket_" env $ \inH _ -> readChunksBracket_ inH (nullH env) ] - ] ------------------------------------------------------------------------------- -- Exceptions toChunks @@ -213,11 +207,9 @@ inspect $ 'toChunksBracket_ `hasNoType` ''SPEC o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark] o_1_space_copy_exceptions_toChunks env = - [ bgroup "exceptions/toChunks" - [ mkBench "Stream.bracket_" env $ \inH _ -> + [ mkBench "Stream.bracket_ (toChunks)" env $ \inH _ -> toChunksBracket_ inH (nullH env) ] - ] benchmarks :: BenchEnv -> Int -> [(SpaceComplexity, Benchmark)] benchmarks _env _size = diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs b/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs index 906388943a..fa96a42ea1 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs @@ -266,7 +266,6 @@ _absTimes value _ = Stream.take value Stream.absTimes o_1_space_generation :: Int -> [Benchmark] o_1_space_generation value = - [ bgroup "generation" -- 'sourceUnfoldr', 'sourceUnfoldrM', and 'repeat' are from Stream.Common. [ benchIO "unfoldr" $ withDrain (sourceUnfoldr value) , benchIO "unfoldrM" $ withDrain (sourceUnfoldrM value) @@ -298,7 +297,6 @@ o_1_space_generation value = -- XXX tasty-bench hangs benchmarking this -- , benchIO "absTimes" $ _absTimes value ] - ] ------------------------------------------------------------------------------- -- Main diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs b/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs index 24ed58209c..8812518897 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs @@ -114,13 +114,11 @@ generalizeInnerIO value = withRandomIntIO $ \n -> o_1_space_hoisting :: Int -> [Benchmark] o_1_space_hoisting value = - [ bgroup "hoisting" [ benchIO "evalState" $ evalStateTIO value , benchIO "withState" $ withStateIO value , benchIO "length . generalizeInner" $ generalizeInner value , benchIO "generalizeInner" $ generalizeInnerIO value ] - ] ------------------------------------------------------------------------------- -- Main diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs b/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs index b6f6f17512..3fc9644d9e 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs @@ -185,7 +185,6 @@ inspect $ 'unfoldSched `hasNoType` ''SPEC o_1_space_joining :: Int -> [Benchmark] o_1_space_joining value = - [ bgroup "joining (2 of n/2)" [ benchIO "interleave" $ interleave2 (value `div` 2) , benchIO "roundRobin" $ roundRobin2 (value `div` 2) , benchIO "mergeBy compare" $ mergeBy compare (value `div` 2) @@ -198,11 +197,9 @@ o_1_space_joining value = , benchIO "altBfsUnfoldEach" $ altBfsUnfoldEach 2 (value `div` 2) , benchIO "unfoldSched" $ unfoldSched 2 (value `div` 2) ] - ] o_n_heap_concat :: Int -> [Benchmark] o_n_heap_concat value = sqrtVal `seq` - [ bgroup "concat" [ benchIO "bfsUnfoldEach (n of 1)" $ bfsUnfoldEach value 1 , benchIO "bfsUnfoldEach (sqrtVal of sqrtVal)" $ bfsUnfoldEach sqrtVal sqrtVal , benchIO "altBfsUnfoldEach (n of 1)" $ altBfsUnfoldEach value 1 @@ -210,7 +207,6 @@ o_n_heap_concat value = sqrtVal `seq` , benchIO "unfoldSched (n of 1)" $ unfoldSched value 1 , benchIO "unfoldSched (sqrtVal of sqrtVal)" $ unfoldSched sqrtVal sqrtVal ] - ] where @@ -369,22 +365,20 @@ fairUnfoldSchedInfinite maxVal = withRandomIntIO $ \n -> -- Solve simultaneous equations by exploring all possibilities o_1_space_equations :: Int -> [Benchmark] o_1_space_equations value = - [ bgroup "equations" - [ benchIO "fairConcatFor (bounded)" $ fairConcatForBounded sqrtVal - , benchIO "fairConcatForK (bounded)" $ fairConcatForKBounded sqrtVal - , benchIO "fairConcatFor (infinite)" $ fairConcatForInfinite sqrtVal - , benchIO "fairSchedFor (bounded)" $ fairSchedForBounded sqrtVal - , benchIO "fairSchedFor (infinite)" $ fairSchedForInfinite sqrtVal - , benchIO "unfoldCross (bounded)" $ unfoldCrossBounded sqrtVal - , benchIO "fairUnfoldCross (bounded)" $ fairUnfoldCrossBounded sqrtVal - , benchIO "fairUnfoldCross (infinite)" $ fairUnfoldCrossInfinite sqrtVal - , benchIO "fairUnfoldEach (bounded)" $ fairUnfoldEachBounded sqrtVal - , benchIO "fairUnfoldEach (infinite)" $ fairUnfoldEachInfinite sqrtVal - , benchIO "unfoldSched (bounded)" $ unfoldSchedBounded sqrtVal - , benchIO "fairUnfoldSched (bounded)" $ fairUnfoldSchedBounded sqrtVal - , benchIO "fairUnfoldSched (infinite)" $ fairUnfoldSchedInfinite sqrtVal + [ benchIO "equations/fairConcatFor (bounded)" $ fairConcatForBounded sqrtVal + , benchIO "equations/fairConcatForK (bounded)" $ fairConcatForKBounded sqrtVal + , benchIO "equations/fairConcatFor (infinite)" $ fairConcatForInfinite sqrtVal + , benchIO "equations/fairSchedFor (bounded)" $ fairSchedForBounded sqrtVal + , benchIO "equations/fairSchedFor (infinite)" $ fairSchedForInfinite sqrtVal + , benchIO "equations/unfoldCross (bounded)" $ unfoldCrossBounded sqrtVal + , benchIO "equations/fairUnfoldCross (bounded)" $ fairUnfoldCrossBounded sqrtVal + , benchIO "equations/fairUnfoldCross (infinite)" $ fairUnfoldCrossInfinite sqrtVal + , benchIO "equations/fairUnfoldEach (bounded)" $ fairUnfoldEachBounded sqrtVal + , benchIO "equations/fairUnfoldEach (infinite)" $ fairUnfoldEachInfinite sqrtVal + , benchIO "equations/unfoldSched (bounded)" $ unfoldSchedBounded sqrtVal + , benchIO "equations/fairUnfoldSched (bounded)" $ fairUnfoldSchedBounded sqrtVal + , benchIO "equations/fairUnfoldSched (infinite)" $ fairUnfoldSchedInfinite sqrtVal ] - ] where diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs index 897a590743..13b4664fa4 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs @@ -116,7 +116,6 @@ inspect $ 'foldIterateM `hasNoType` ''SPEC o_1_space_grouping :: Int -> [Benchmark] o_1_space_grouping value = -- Buffering operations using heap proportional to group/window sizes. - [ bgroup "grouping" [ benchIO "groups" $ groups value , benchIO "groupsWhileLT" $ groupsWhileLT value @@ -129,7 +128,6 @@ o_1_space_grouping value = -- Parser/ParserD/Array.Stream/FileSystem.Handle. , benchIO "foldIterateM" $ foldIterateM value ] - ] ------------------------------------------------------------------------------- -- Main diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Split.hs b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Split.hs index bad4f252ca..cd671869f3 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Split.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Split.hs @@ -242,14 +242,11 @@ inspect $ 'splitWithSuffixSeq `hasNoType` ''SPEC o_1_space_reduce_read_split :: BenchEnv -> [Benchmark] o_1_space_reduce_read_split env = -- NOTE: keep the benchmark names consistent with Data.Fold.takeEndBy* - [ bgroup "FileSplitElem" [ mkBench "splitOn infix lf" env $ \inh _ -> splitOn inh - ] - -- splitting on a sequence - , bgroup "FileSplitSeq" - [ - mkBench "wordsBy infix isSpace" env $ \inh _ -> + + -- splitting on a sequence + , mkBench "wordsBy infix isSpace" env $ \inh _ -> wordsBy inh -- Infix @@ -295,10 +292,7 @@ o_1_space_reduce_read_split env = splitWithSuffixSeq "abcdefghi" inh , mkBenchSmall "splitWithSuffixSeq KR suffix abcdefghijklmnopqrstuvwxyz" env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh - ] - , bgroup "FileTakeSeq" - [ {- mkBench "takeEndBySeq empty" env $ \inh _ -> takeEndBySeq "" inh @@ -306,7 +300,7 @@ o_1_space_reduce_read_split env = -- IMPORTANT: the pattern must contain a, because we filter a's out -- from the stream so that we do not terminate too early and -- unpredictably. - mkBench "takeEndBy" env $ \inh _ -> + , mkBench "takeEndBy" env $ \inh _ -> takeEndBy (fromIntegral $ ord 'a') inh , mkBench "takeEndBy_" env $ \inh _ -> takeEndBy_ (fromIntegral $ ord 'a') inh @@ -350,7 +344,6 @@ o_1_space_reduce_read_split env = , mkBench "takeEndBySeq_ KR 100k long pattern" env $ \inh _ -> takeEndBySeq_100k inh ] - ] benchmarks :: BenchEnv -> [(SpaceComplexity, Benchmark)] benchmarks env = diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Parse/SplitChunks.hs b/benchmark/Streamly/Benchmark/Data/Stream/Parse/SplitChunks.hs index adffa1b8fe..df10f6b830 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Parse/SplitChunks.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Parse/SplitChunks.hs @@ -68,13 +68,11 @@ inspect $ 'splitOnSeqUtf8 `hasNoType` ''SPEC o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark] o_1_space_reduce_toChunks_split env = - [ bgroup "FileSplitSeqUtf8" [ mkBenchSmall "splitOnSeqUtf8 word abcdefgh" env $ \inh _ -> splitOnSeqUtf8 "abcdefgh" inh , mkBenchSmall "splitOnSeqUtf8 KR abcdefghijklmnopqrstuvwxyz" env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh ] - ] benchmarks :: BenchEnv -> [(SpaceComplexity, Benchmark)] benchmarks env = diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs index 48de62216b..e28446c09c 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs @@ -307,43 +307,38 @@ inspect $ 'trace4 `hasNoType` ''SPEC o_1_space_mapping :: Int -> [Benchmark] o_1_space_mapping value = - [ bgroup - "mapping" - [ - -- , benchIOSink value "foldrT" (foldrT 1) - -- , benchIOSink value "foldrTMap" (foldrTMap 1) - - -- Mapping - benchIO "sequence" $ sequence1 value - , benchIO "tap" $ tap1 value - -- XXX tasty-bench hangs benchmarking this - -- , benchIOSink value "timestamped" _timestamped - -- Scanning - , benchIO "scanl'" $ scanl'1 value - , benchIO "scanl1'" $ scanl1'1 value - , benchIO "scanlM'" $ scanlM'1 value - , benchIO "scanl1M'" $ scanl1M'1 value - , benchIO "postscanl'" $ postscanl'1 value - , benchIO "postscanlM'" $ postscanlM'1 value - , benchIO "scan" $ scan1 value - , benchIO "postscan" $ postscan1 value - ] + [ + -- , benchIOSink value "foldrT" (foldrT 1) + -- , benchIOSink value "foldrTMap" (foldrTMap 1) + + -- Mapping + benchIO "sequence" $ sequence1 value + , benchIO "tap" $ tap1 value + -- XXX tasty-bench hangs benchmarking this + -- , benchIOSink value "timestamped" _timestamped + -- Scanning + , benchIO "scanl'" $ scanl'1 value + , benchIO "scanl1'" $ scanl1'1 value + , benchIO "scanlM'" $ scanlM'1 value + , benchIO "scanl1M'" $ scanl1M'1 value + , benchIO "postscanl'" $ postscanl'1 value + , benchIO "postscanlM'" $ postscanlM'1 value + , benchIO "scan" $ scan1 value + , benchIO "postscan" $ postscan1 value ] o_1_space_mappingX4 :: Int -> [Benchmark] o_1_space_mappingX4 value = - [ bgroup "mappingX4" - [ benchIO "trace" $ trace4 value - - , benchIO "scanl'" $ scanl'4 value - , benchIO "scanl1'" $ scanl1'4 value - , benchIO "scanlM'" $ scanlM'4 value - , benchIO "scanl1M'" $ scanl1M'4 value - , benchIO "postscanl'" $ postscanl'4 value - , benchIO "postscanlM'" $ postscanlM'4 value - , benchIO "scan" $ scan4 value - , benchIO "postscan" $ postscan4 value - ] + [ benchIO "trace x 4" $ trace4 value + + , benchIO "scanl' x 4" $ scanl'4 value + , benchIO "scanl1' x 4" $ scanl1'4 value + , benchIO "scanlM' x 4" $ scanlM'4 value + , benchIO "scanl1M' x 4" $ scanl1M'4 value + , benchIO "postscanl' x 4" $ postscanl'4 value + , benchIO "postscanlM' x 4" $ postscanlM'4 value + , benchIO "scan x 4" $ scan4 value + , benchIO "postscan x 4" $ postscan4 value ] ------------------------------------------------------------------------------- @@ -400,17 +395,15 @@ iterateFmap value = withRandomIntIO $ drain . iterateSingleton (fmap . (+)) valu o_n_space_iterated :: Int -> [Benchmark] o_n_space_iterated value = - [ bgroup "iterated" - [ benchIO "(+) (n times) (baseline)" $ iteratePlusBaseline value - , benchIO "(<$) (n times)" $ iterateSubMap value - , benchIO "fmap (n times)" $ iterateFmap value - {- - , benchIOSrc fromSerial "_(<$) (n times)" $ - _iterateSingleton (<$) value - , benchIOSrc fromSerial "_fmap (n times)" $ - _iterateSingleton (fmap . (+)) value - -} - ] + [ benchIO "iterated/(+) (n times) (baseline)" $ iteratePlusBaseline value + , benchIO "iterated/(<$) (n times)" $ iterateSubMap value + , benchIO "iterated/fmap (n times)" $ iterateFmap value + {- + , benchIOSrc fromSerial "_(<$) (n times)" $ + _iterateSingleton (<$) value + , benchIOSrc fromSerial "_fmap (n times)" $ + _iterateSingleton (fmap . (+)) value + -} ] ------------------------------------------------------------------------------- @@ -890,65 +883,61 @@ inspect $ 'mapMaybeM4 `hasNoType` ''SPEC o_1_space_filtering :: Int -> [Benchmark] o_1_space_filtering value = - [ bgroup "filtering" - [ benchIO "filter-even" $ filterEven1 value - , benchIO "filter-all-out" $ filterAllOut1 value - , benchIO "filter-all-in" $ filterAllIn1 value - - , benchIO "filterM-even" $ filterMEven1 value - , benchIO "filterM-all-out" $ filterMAllOut1 value - , benchIO "filterM-all-in" $ filterMAllIn1 value - - , benchIO "drop-one" $ dropOne1 value - , benchIO "drop-all" $ dropAll1 value - , benchIO "dropWhile-true" $ dropWhileTrue1 value - -- , benchIO "dropWhileM-true" ... - , benchIO "dropWhile-false" $ dropWhileFalse1 value - , benchIO "deleteBy" $ deleteBy1 value - - , benchIO "uniq" $ uniq1 value - - -- Map and filter - , benchIO "mapMaybe" $ mapMaybe1 value - , benchIO "mapMaybeM" $ mapMaybeM1 value - - -- Searching (stateful map and filter) - , benchIO "findIndices" $ findIndices1 value - , benchIO "elemIndices" $ elemIndices1 value - , benchIO "findIndex" $ findIndex value - , benchIO "elemIndex" $ elemIndex value - ] + [ benchIO "filter-even" $ filterEven1 value + , benchIO "filter-all-out" $ filterAllOut1 value + , benchIO "filter-all-in" $ filterAllIn1 value + + , benchIO "filterM-even" $ filterMEven1 value + , benchIO "filterM-all-out" $ filterMAllOut1 value + , benchIO "filterM-all-in" $ filterMAllIn1 value + + , benchIO "drop-one" $ dropOne1 value + , benchIO "drop-all" $ dropAll1 value + , benchIO "dropWhile-true" $ dropWhileTrue1 value + -- , benchIO "dropWhileM-true" ... + , benchIO "dropWhile-false" $ dropWhileFalse1 value + , benchIO "deleteBy" $ deleteBy1 value + + , benchIO "uniq" $ uniq1 value + + -- Map and filter + , benchIO "mapMaybe" $ mapMaybe1 value + , benchIO "mapMaybeM" $ mapMaybeM1 value + + -- Searching (stateful map and filter) + , benchIO "findIndices" $ findIndices1 value + , benchIO "elemIndices" $ elemIndices1 value + , benchIO "findIndex" $ findIndex value + , benchIO "elemIndex" $ elemIndex value ] o_1_space_filteringX4 :: Int -> [Benchmark] o_1_space_filteringX4 value = - [ bgroup "filteringX4" - [ benchIO "filter-even" $ filterEven4 value - , benchIO "filter-all-out" $ filterAllOut4 value - , benchIO "filter-all-in" $ filterAllIn4 value - - , benchIO "filterM-even" $ filterMEven4 value - , benchIO "filterM-all-out" $ filterMAllOut4 value - , benchIO "filterM-all-in" $ filterMAllIn4 value - - , benchIO "drop-one" $ dropOne4 value - , benchIO "drop-all" $ dropAll4 value - , benchIO "dropWhile-true" $ dropWhileTrue4 value - , benchIO "dropWhileM-true" $ dropWhileMTrue4 value - -- XXX requires @-fspec-constr-recursive=12@. - , benchIO "dropWhile-false" $ dropWhileFalse4 value - , benchIO "deleteBy" $ deleteBy4 value - - , benchIO "uniq" $ uniq4 value - - -- map and filter - , benchIO "mapMaybe" $ mapMaybe4 value - , benchIO "mapMaybeM" $ mapMaybeM4 value - - -- searching - , benchIO "findIndices" $ findIndices4 value - , benchIO "elemIndices" $ elemIndices4 value - ] + [ benchIO "filter-even x 4" $ filterEven4 value + , benchIO "filter-all-out x 4" $ filterAllOut4 value + , benchIO "filter-all-in x 4" $ filterAllIn4 value + + , benchIO "filterM-even x 4" $ filterMEven4 value + , benchIO "filterM-all-out x 4" $ filterMAllOut4 value + , benchIO "filterM-all-in x 4" $ filterMAllIn4 value + + , benchIO "drop-one x 4" $ dropOne4 value + , benchIO "drop-all x 4" $ dropAll4 value + , benchIO "dropWhile-true x 4" $ dropWhileTrue4 value + , benchIO "dropWhileM-true x 4" $ dropWhileMTrue4 value + -- XXX requires @-fspec-constr-recursive=12@. + , benchIO "dropWhile-false x 4" $ dropWhileFalse4 value + , benchIO "deleteBy x 4" $ deleteBy4 value + + , benchIO "uniq x 4" $ uniq4 value + + -- map and filter + , benchIO "mapMaybe x 4" $ mapMaybe4 value + , benchIO "mapMaybeM x 4" $ mapMaybeM4 value + + -- searching + , benchIO "findIndices x 4" $ findIndices4 value + , benchIO "elemIndices x 4" $ elemIndices4 value ] ------------------------------------------------------------------------------- @@ -1062,23 +1051,19 @@ inspect $ 'intercalateSuffix1 `hasNoType` ''SPEC o_1_space_inserting :: Int -> [Benchmark] o_1_space_inserting value = - [ bgroup "inserting" - [ benchIO "intersperse" $ intersperse1 value - , benchIO "intersperseM" $ intersperseM1 value - , benchIO "insertBy" $ insertBy1 value - , benchIO "interposeSuffix" $ interposeSuffix1 value - , benchIO "intercalateSuffix" $ intercalateSuffix1 value - ] + [ benchIO "intersperse" $ intersperse1 value + , benchIO "intersperseM" $ intersperseM1 value + , benchIO "insertBy" $ insertBy1 value + , benchIO "interposeSuffix" $ interposeSuffix1 value + , benchIO "intercalateSuffix" $ intercalateSuffix1 value ] o_1_space_insertingX4 :: Int -> [Benchmark] o_1_space_insertingX4 value = - [ bgroup "insertingX4" - [ - -- XXX requires @-fspec-constr-recursive=16@. - benchIO "intersperse" $ intersperse4 value - , benchIO "insertBy" $ insertBy4 value - ] + [ + -- XXX requires @-fspec-constr-recursive=16@. + benchIO "intersperse x 4" $ intersperse4 value + , benchIO "insertBy x 4" $ insertBy4 value ] ------------------------------------------------------------------------------- @@ -1139,18 +1124,14 @@ inspect $ 'indexedR4 `hasNoType` ''SPEC o_1_space_indexing :: Int -> [Benchmark] o_1_space_indexing value = - [ bgroup "indexing" - [ benchIO "indexed" $ indexed1 value - , benchIO "indexedR" $ indexedR1 value - ] + [ benchIO "indexed" $ indexed1 value + , benchIO "indexedR" $ indexedR1 value ] o_1_space_indexingX4 :: Int -> [Benchmark] o_1_space_indexingX4 value = - [ bgroup "indexingx4" - [ benchIO "indexed" $ indexed4 value - , benchIO "indexedR" $ indexedR4 value - ] + [ benchIO "indexed x 4" $ indexed4 value + , benchIO "indexedR x 4" $ indexedR4 value ] ------------------------------------------------------------------------------- @@ -1179,12 +1160,10 @@ inspect $ hasNoTypeClasses 'reverse' o_n_heap_buffering :: Int -> [Benchmark] o_n_heap_buffering value = - [ bgroup "buffered" - [ - -- Reversing a stream - benchIO "reverse" $ reverse value - , benchIO "reverse'" $ reverse' value - ] + [ + -- Reversing a stream + benchIO "reverse" $ reverse value + , benchIO "reverse'" $ reverse' value ] ------------------------------------------------------------------------------- diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs index 4a1c23ce3c..11824eeceb 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs @@ -528,55 +528,49 @@ o_1_space_transformations_mixed value = -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl -- library. If scan/fold followed by a map is efficient enough we may not -- need monolithic implementations of these. - [ bgroup "mixed" - [ benchIO "scanl-map" $ scanMap1 value - , benchIO "drop-map" $ dropMap1 value - , benchIO "drop-scan" $ dropScan1 value - , benchIO "take-drop" $ takeDrop1 value - , benchIO "take-scan" $ takeScan1 value - , benchIO "take-map" $ takeMap1 value - , benchIO "filter-drop" $ filterDrop1 value - , benchIO "filter-take" $ filterTake1 value - , benchIO "filter-scan" $ filterScan1 value - , benchIO "filter-map" $ filterMap1 value - , benchIO "foldl-map" $ foldl'ReduceMap value - , benchIO "sum-product-fold" $ sumProductFold value - , benchIO "sum-product-scan" $ sumProductScan value - ] + [ benchIO "scanl-map" $ scanMap1 value + , benchIO "drop-map" $ dropMap1 value + , benchIO "drop-scan" $ dropScan1 value + , benchIO "take-drop" $ takeDrop1 value + , benchIO "take-scan" $ takeScan1 value + , benchIO "take-map" $ takeMap1 value + , benchIO "filter-drop" $ filterDrop1 value + , benchIO "filter-take" $ filterTake1 value + , benchIO "filter-scan" $ filterScan1 value + , benchIO "filter-map" $ filterMap1 value + , benchIO "foldl-map" $ foldl'ReduceMap value + , benchIO "sum-product-fold" $ sumProductFold value + , benchIO "sum-product-scan" $ sumProductScan value ] o_1_space_transformations_mixedX2 :: Int -> [Benchmark] o_1_space_transformations_mixedX2 value = - [ bgroup "mixedX2" - [ benchIO "scan-map" $ scanMap2 value - , benchIO "drop-map" $ dropMap2 value - , benchIO "drop-scan" $ dropScan2 value - , benchIO "take-drop" $ takeDrop2 value - , benchIO "take-scan" $ takeScan2 value - , benchIO "take-map" $ takeMap2 value - , benchIO "filter-drop" $ filterDrop2 value - , benchIO "filter-take" $ filterTake2 value - , benchIO "filter-scan" $ filterScan2 value - , benchIO "filter-scanl1" $ filterScanl12 value - , benchIO "filter-map" $ filterMap2 value - ] + [ benchIO "scan-map x 2" $ scanMap2 value + , benchIO "drop-map x 2" $ dropMap2 value + , benchIO "drop-scan x 2" $ dropScan2 value + , benchIO "take-drop x 2" $ takeDrop2 value + , benchIO "take-scan x 2" $ takeScan2 value + , benchIO "take-map x 2" $ takeMap2 value + , benchIO "filter-drop x 2" $ filterDrop2 value + , benchIO "filter-take x 2" $ filterTake2 value + , benchIO "filter-scan x 2" $ filterScan2 value + , benchIO "filter-scanl1 x 2" $ filterScanl12 value + , benchIO "filter-map x 2" $ filterMap2 value ] o_1_space_transformations_mixedX4 :: Int -> [Benchmark] o_1_space_transformations_mixedX4 value = - [ bgroup "mixedX4" - [ benchIO "scan-map" $ scanMap4 value - , benchIO "drop-map" $ dropMap4 value - , benchIO "drop-scan" $ dropScan4 value - , benchIO "take-drop" $ takeDrop4 value - , benchIO "take-scan" $ takeScan4 value - , benchIO "take-map" $ takeMap4 value - , benchIO "filter-drop" $ filterDrop4 value - , benchIO "filter-take" $ filterTake4 value - , benchIO "filter-scan" $ filterScan4 value - , benchIO "filter-scanl1" $ filterScanl14 value - , benchIO "filter-map" $ filterMap4 value - ] + [ benchIO "scan-map x 4" $ scanMap4 value + , benchIO "drop-map x 4" $ dropMap4 value + , benchIO "drop-scan x 4" $ dropScan4 value + , benchIO "take-drop x 4" $ takeDrop4 value + , benchIO "take-scan x 4" $ takeScan4 value + , benchIO "take-map x 4" $ takeMap4 value + , benchIO "filter-drop x 4" $ filterDrop4 value + , benchIO "filter-take x 4" $ filterTake4 value + , benchIO "filter-scan x 4" $ filterScan4 value + , benchIO "filter-scanl1 x 4" $ filterScanl14 value + , benchIO "filter-map x 4" $ filterMap4 value ] ------------------------------------------------------------------------------- @@ -630,16 +624,14 @@ iterateDropWhileFalse value iterCount = o_n_stack_iterated :: Int -> [Benchmark] o_n_stack_iterated value = - [ bgroup "iterated" - [ benchIO "mapM (n/10 x 10)" $ iterateMapM value 10 - , benchIO "scanl' (quadratic) (n/100 x 100)" $ iterateScan value 100 - , benchIO "scanl1' (n/10 x 10)" $ iterateScanl1 value 10 - , benchIO "filterEven (n/10 x 10)" $ iterateFilterEven value 10 - , benchIO "takeAll (n/10 x 10)" $ iterateTakeAll value 10 - , benchIO "dropOne (n/10 x 10)" $ iterateDropOne value 10 - , benchIO "dropWhileTrue (n/10 x 10)" $ iterateDropWhileTrue value 10 - , benchIO "dropWhileFalse (n/10 x 10)" $ iterateDropWhileFalse value 10 - ] + [ benchIO "iterated/mapM (n/10 x 10)" $ iterateMapM value 10 + , benchIO "iterated/scanl' (quadratic) (n/100 x 100)" $ iterateScan value 100 + , benchIO "iterated/scanl1' (n/10 x 10)" $ iterateScanl1 value 10 + , benchIO "iterated/filterEven (n/10 x 10)" $ iterateFilterEven value 10 + , benchIO "iterated/takeAll (n/10 x 10)" $ iterateTakeAll value 10 + , benchIO "iterated/dropOne (n/10 x 10)" $ iterateDropOne value 10 + , benchIO "iterated/dropWhileTrue (n/10 x 10)" $ iterateDropWhileTrue value 10 + , benchIO "iterated/dropWhileFalse (n/10 x 10)" $ iterateDropWhileFalse value 10 ] ------------------------------------------------------------------------------- @@ -758,31 +750,24 @@ inspect $ 'pipeTeeX4 `hasNoType` ''FL.Step inspect $ 'pipeTeeX4 `hasNoType` ''SPEC #endif +-- XXX these should move to Data.Pipe benchmarks o_1_space_pipes :: Int -> [Benchmark] o_1_space_pipes value = - [ bgroup "pipes" - [ benchIO "mapM" $ pipeMapM value - , benchIO "compose" $ pipeCompose value - , benchIO "tee" $ pipeTee value -#ifdef DEVBUILD - -- XXX this take 1 GB memory to compile - -- , benchIO "zip" $ pipeZip value -#endif - ] + [ benchIO "pipe/mapM" $ pipeMapM value + , benchIO "pipe/compose" $ pipeCompose value + , benchIO "pipe/tee" $ pipeTee value + -- XXX this take 1 GB memory to compile + -- , benchIO "zip" $ pipeZip value ] o_1_space_pipesX4 :: Int -> [Benchmark] o_1_space_pipesX4 value = - [ bgroup "pipesX4" - [ benchIO "mapM" $ pipeMapMX4 value - , benchIO "compose" $ pipeComposeX4 value - -- XXX requires @-fspec-constr-recursive=16@. - , benchIO "tee" $ pipeTeeX4 value -#ifdef DEVBUILD - -- XXX this take 1 GB memory to compile - -- , benchIO "zip" $ pipeZipX4 value -#endif - ] + [ benchIO "pipe/mapM x 4" $ pipeMapMX4 value + , benchIO "pipe/compose x 4" $ pipeComposeX4 value + -- XXX requires @-fspec-constr-recursive=16@. + , benchIO "pipe/tee x 4" $ pipeTeeX4 value + -- XXX this take 1 GB memory to compile + -- , benchIO "zip x 4" $ pipeZipX4 value ] ------------------------------------------------------------------------------- @@ -861,22 +846,19 @@ inspect $ 'scansTeeX4 `hasNoType` ''FL.Step inspect $ 'scansTeeX4 `hasNoType` ''SPEC #endif +-- XXX These should move to the Data.Scan module o_1_space_scans :: Int -> [Benchmark] o_1_space_scans value = - [ bgroup "scans" - [ benchIO "mapM" $ scansMapM value - , benchIO "compose" $ scansCompose value - , benchIO "tee" $ scansTee value - ] + [ benchIO "scan/mapM" $ scansMapM value + , benchIO "scan/compose" $ scansCompose value + , benchIO "scan/tee" $ scansTee value ] o_1_space_scansX4 :: Int -> [Benchmark] o_1_space_scansX4 value = - [ bgroup "scansX4" - [ benchIO "mapM" $ scansMapMX4 value - , benchIO "compose" $ scansComposeX4 value - , benchIO "tee" $ scansTeeX4 value - ] + [ benchIO "scan/mapM x 4" $ scansMapMX4 value + , benchIO "scan/compose x 4" $ scansComposeX4 value + , benchIO "scan/tee x 4" $ scansTeeX4 value ] ------------------------------------------------------------------------------- @@ -902,9 +884,7 @@ naivePrimeSieve value = o_n_space_mapping :: Int -> [Benchmark] o_n_space_mapping value = - [ bgroup "mapping" - [ benchIO "naive prime sieve" $ naivePrimeSieve value - ] + [ benchIO "naive prime sieve" $ naivePrimeSieve value ] ------------------------------------------------------------------------------- diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Type.hs b/benchmark/Streamly/Benchmark/Data/Stream/Type.hs index 2a3597c695..877096bb7d 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Type.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Type.hs @@ -448,41 +448,39 @@ _foldableMsum value n = o_1_space_elimination_foldable :: Int -> [Benchmark] o_1_space_elimination_foldable value = - [ bgroup "foldable" - -- Foldable instance - [ benchIO "foldl'" $ withRandomInt (foldableFoldl' value) - , benchIO "foldrElem" $ withRandomInt (foldableFoldrElem value) - -- , benchIO "null" $ withRandomInt (_foldableNull value) - , benchIO "elem" $ withRandomInt (foldableElem value) - , benchIO "length" $ withRandomInt (foldableLength value) - , benchIO "sum" $ withRandomInt (foldableSum value) - , benchIO "product" $ withRandomInt (foldableProduct value) - , benchIO "minimum" $ withRandomInt (foldableMin value) - , benchIO "min (ord)" $ withRandomInt (ordInstanceMin value) - , benchIO "maximum" $ withRandomInt (foldableMax value) - , benchIO "minimumBy" $ withRandomInt (foldableMinBy value) - , benchIO "maximumBy" $ withRandomInt (foldableMaxBy value) - , benchIO "minimumByList" $ withRandomInt (foldableListMinBy value) - , benchIO "length . toList" $ - withRandomInt (Prelude.length . foldableToList value) - , benchIO "notElem" $ withRandomInt (foldableNotElem value) - , benchIO "find" $ withRandomInt (foldableFind value) - , benchIO "all" $ withRandomInt (foldableAll value) - , benchIO "any" $ withRandomInt (foldableAny value) - , benchIO "and" $ withRandomInt (foldableAnd value) - , benchIO "or" $ withRandomInt (foldableOr value) - - -- Applicative and Traversable operations - -- TBD: traverse_ - , benchIO "mapM_" $ withRandomIntIO (foldableMapM_ value) - -- TBD: for_ - -- TBD: forM_ - , benchIO "sequence_" $ withRandomIntIO (foldableSequence_ value) - -- TBD: sequenceA_ - -- TBD: asum - -- XXX needs to be fixed, results are in ns - -- , benchIOSink1 "msum" (foldableMsum value) - ] + -- Foldable instance + [ benchIO "Foldable/foldl'" $ withRandomInt (foldableFoldl' value) + , benchIO "Foldable/foldrElem" $ withRandomInt (foldableFoldrElem value) + -- , benchIO "Foldable/null" $ withRandomInt (_foldableNull value) + , benchIO "Foldable/elem" $ withRandomInt (foldableElem value) + , benchIO "Foldable/length" $ withRandomInt (foldableLength value) + , benchIO "Foldable/sum" $ withRandomInt (foldableSum value) + , benchIO "Foldable/product" $ withRandomInt (foldableProduct value) + , benchIO "Foldable/minimum" $ withRandomInt (foldableMin value) + , benchIO "Foldable/min (ord)" $ withRandomInt (ordInstanceMin value) + , benchIO "Foldable/maximum" $ withRandomInt (foldableMax value) + , benchIO "Foldable/minimumBy" $ withRandomInt (foldableMinBy value) + , benchIO "Foldable/maximumBy" $ withRandomInt (foldableMaxBy value) + , benchIO "Foldable/minimumByList" $ withRandomInt (foldableListMinBy value) + , benchIO "Foldable/length . toList" $ + withRandomInt (Prelude.length . foldableToList value) + , benchIO "Foldable/notElem" $ withRandomInt (foldableNotElem value) + , benchIO "Foldable/find" $ withRandomInt (foldableFind value) + , benchIO "Foldable/all" $ withRandomInt (foldableAll value) + , benchIO "Foldable/any" $ withRandomInt (foldableAny value) + , benchIO "Foldable/and" $ withRandomInt (foldableAnd value) + , benchIO "Foldable/or" $ withRandomInt (foldableOr value) + + -- Applicative and Traversable operations + -- TBD: traverse_ + , benchIO "Foldable/mapM_" $ withRandomIntIO (foldableMapM_ value) + -- TBD: for_ + -- TBD: forM_ + , benchIO "Foldable/sequence_" $ withRandomIntIO (foldableSequence_ value) + -- TBD: sequenceA_ + -- TBD: asum + -- XXX needs to be fixed, results are in ns + -- , benchIOSink1 "Foldable/msum" (foldableMsum value) ] ------------------------------------------------------------------------------- @@ -499,14 +497,12 @@ showInstanceList = show o_n_heap_elimination_show :: Int -> [Benchmark] o_n_heap_elimination_show value = - [ bgroup "buffered" - -- Buffers the output of show/read. - -- XXX can the outputs be streaming? Can we have special read/show - -- style type classes, readM/showM supporting streaming effects? - [ bench "showsPrec Haskell lists" $ nf showInstanceList (mkList value) - -- XXX This is not o-1-space for GHC-8.10 - , benchIO "showsPrec pure streams" $ showInstance value - ] + -- Buffers the output of show/read. + -- XXX can the outputs be streaming? Can we have special read/show + -- style type classes, readM/showM supporting streaming effects? + [ bench "showsPrec Haskell lists" $ nf showInstanceList (mkList value) + -- XXX This is not o-1-space for GHC-8.10 + , benchIO "showsPrec pure streams" $ showInstance value ] ------------------------------------------------------------------------------- @@ -552,25 +548,21 @@ inspect $ 'ordInstance `hasNoType` ''SPEC o_1_space_generation :: Int -> [Benchmark] o_1_space_generation value = - [ bgroup "generation" - [ benchIO "fromList" $ sourceFromList value - , benchIO "fromTuple" $ sourceFromTuple value - , benchIO "IsList.fromList" $ sourceIsList value - , benchIO "IsString.fromString" $ sourceIsString value - ] + [ benchIO "fromList" $ sourceFromList value + , benchIO "fromTuple" $ sourceFromTuple value + , benchIO "IsList.fromList" $ sourceIsList value + , benchIO "IsString.fromString" $ sourceIsString value ] o_n_heap_generation :: Int -> [Benchmark] o_n_heap_generation value = - [ bgroup "buffered" -- Buffers the output of show/read. -- XXX can the outputs be streaming? Can we have special read/show -- style type classes, readM/showM supporting streaming effects? - [ bench "readsPrec pure streams" $ - nf (readInstance . mkString) value - , bench "readsPrec Haskell lists" $ - nf (readInstanceList . mkListString) value - ] + [ bench "readsPrec pure streams" $ + nf (readInstance . mkString) value + , bench "readsPrec Haskell lists" $ + nf (readInstanceList . mkListString) value ] ------------------------------------------------------------------------------- @@ -722,47 +714,32 @@ inspect $ 'drainN `hasNoType` ''SPEC o_1_space_elimination_folds :: Int -> [Benchmark] o_1_space_elimination_folds value = - [ bgroup "elimination" - [ - bgroup "reduce" - [ bgroup - "IO" - [ benchIO "foldl'" $ foldl'Reduce value - , benchIO "foldlM'" $ foldlM'Reduce value - ] - - , bgroup - "Identity" - [ benchIO "foldl'" $ foldl'ReduceIdentity value - , benchIO "foldlM'" $ foldlM'ReduceIdentity value - ] - ] , - bgroup "build" - [ bgroup "IO" - [ benchIO "foldrMElem" $ foldrMElem value - ] - , bgroup "Identity" - [ benchIO "foldrMElem" $ foldrMElemIdentity value - , benchIO "foldrMToList" $ foldrMToListIdentity value - ] - ] - - -- this is too fast, causes all benchmarks reported in ns + [ benchIO "foldl'/IO" $ foldl'Reduce value + , benchIO "foldlM'/IO" $ foldlM'Reduce value + + , benchIO "foldl'/Identity" $ foldl'ReduceIdentity value + , benchIO "foldlM'/Identity" $ foldlM'ReduceIdentity value + + , benchIO "foldrMElem/IO" $ foldrMElem value + + , benchIO "foldrMElem/Identity" $ foldrMElemIdentity value + , benchIO "foldrMToList" $ foldrMToListIdentity value + + -- this is too fast, causes all benchmarks reported in ns -- , benchIO "null" $ ... - -- deconstruction - , benchIO "uncons" $ uncons value - , benchIO "foldBreak" $ foldBreak value + -- deconstruction + , benchIO "uncons" $ uncons value + , benchIO "foldBreak" $ foldBreak value - -- draining - , benchIO "toNull" $ toNull value - , benchIO "drainN" $ drainN value - , benchIO "drain (pure)" $ drainPure value + -- draining + , benchIO "toNull" $ toNull value + , benchIO "drainN" $ drainN value + , benchIO "drain (pure)" $ drainPure value - -- length is used to check for foldr/build fusion - , benchIO "length . IsList.toList" $ - withPureStream value (Prelude.length . GHC.toList) - ] + -- length is used to check for foldr/build fusion + , benchIO "length . IsList.toList" $ + withPureStream value (Prelude.length . GHC.toList) ] {-# INLINE foldl'Build #-} @@ -787,14 +764,12 @@ foldlM'BuildIdentity value = o_n_heap_elimination_foldl :: Int -> [Benchmark] o_n_heap_elimination_foldl value = - [ bgroup "foldl" - -- Left folds for building a structure are inherently non-streaming - -- as the structure cannot be lazily consumed until fully built. - [ benchIO "foldl'/build/IO" $ foldl'Build value - , benchIO "foldl'/build/Identity" $ foldl'BuildIdentity value - , benchIO "foldlM'/build/IO" $ foldlM'Build value - , benchIO "foldlM'/build/Identity" $ foldlM'BuildIdentity value - ] + -- Left folds for building a structure are inherently non-streaming + -- as the structure cannot be lazily consumed until fully built. + [ benchIO "foldl'/build/IO" $ foldl'Build value + , benchIO "foldl'/build/Identity" $ foldl'BuildIdentity value + , benchIO "foldlM'/build/IO" $ foldlM'Build value + , benchIO "foldlM'/build/Identity" $ foldlM'BuildIdentity value ] {-# INLINE foldrMToSum #-} @@ -811,14 +786,12 @@ foldrMToSumIdentity value = o_n_space_elimination_foldr :: Int -> [Benchmark] o_n_space_elimination_foldr value = -- Head recursive strict right folds. - [ bgroup "foldr" - -- accumulation due to strictness of IO monad - [ benchIO "foldrM/build/IO (toList)" $ foldrMToList value - -- Right folds for reducing are inherently non-streaming as the - -- expression needs to be fully built before it can be reduced. - , benchIO "foldrM/reduce/Identity (sum)" $ foldrMToSumIdentity value - , benchIO "foldrM/reduce/IO (sum)" $ foldrMToSum value - ] + -- accumulation due to strictness of IO monad + [ benchIO "foldrM/build/IO (toList)" $ foldrMToList value + -- Right folds for reducing are inherently non-streaming as the + -- expression needs to be fully built before it can be reduced. + , benchIO "foldrM/reduce/Identity (sum)" $ foldrMToSumIdentity value + , benchIO "foldrM/reduce/IO (sum)" $ foldrMToSum value ] {-# INLINE toList' #-} @@ -827,10 +800,8 @@ toList' value = withStream value S.toList o_n_space_elimination_toList :: Int -> [Benchmark] o_n_space_elimination_toList value = - [ bgroup "toList" - -- Converting the stream to a list or pure stream in a strict monad - [ benchIO "toList" $ toList' value - ] + -- Converting the stream to a list or pure stream in a strict monad + [ benchIO "toList" $ toList' value ] {-# INLINE eqByPure #-} @@ -859,13 +830,11 @@ inspect $ 'cmpByPure `hasNoType` ''Fold.Step o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark] o_1_space_elimination_multi_stream_pure value = - [ bgroup "multi-stream-pure" - [ benchIO "==" $ eqInstance value - , benchIO "/=" $ eqInstanceNotEq value - , benchIO "<" $ ordInstance value - , benchIO "eqBy" $ eqByPure value - , benchIO "cmpBy" $ cmpByPure value - ] + [ benchIO "==" $ eqInstance value + , benchIO "/=" $ eqInstanceNotEq value + , benchIO "<" $ ordInstance value + , benchIO "eqBy (pure)" $ eqByPure value + , benchIO "cmpBy (pure)" $ cmpByPure value ] {-# INLINE eqBy #-} @@ -892,10 +861,8 @@ inspect $ 'cmpBy `hasNoType` ''Fold.Step o_1_space_elimination_multi_stream :: Int -> [Benchmark] o_1_space_elimination_multi_stream value = - [ bgroup "multi-stream" - [ benchIO "eqBy" $ eqBy value - , benchIO "cmpBy" $ cmpBy value - ] + [ benchIO "eqBy" $ eqBy value + , benchIO "cmpBy" $ cmpBy value ] ------------------------------------------------------------------------------- @@ -956,26 +923,20 @@ inspect $ 'mapM4 `hasNoType` ''SPEC o_1_space_functor :: Int -> [Benchmark] o_1_space_functor value = - [ bgroup "Functor" - [ benchIO "fmap" $ map1 value - , benchIO "fmap x 4" $ mapN4 value - ] + [ benchIO "fmap" $ map1 value + , benchIO "fmap x 4" $ mapN4 value ] o_1_space_mapping :: Int -> [Benchmark] o_1_space_mapping value = - [ bgroup "mapping" - [ benchIO "map" $ map1 value - , benchIO "mapM" $ mapM1 value - ] + [ benchIO "map" $ map1 value + , benchIO "mapM" $ mapM1 value ] o_1_space_mappingX4 :: Int -> [Benchmark] o_1_space_mappingX4 value = - [ bgroup "mappingX4" - [ benchIO "map" $ mapN4 value - , benchIO "mapM" $ mapM4 value - ] + [ benchIO "map x 4" $ mapN4 value + , benchIO "mapM x 4" $ mapM4 value ] ------------------------------------------------------------------------------- @@ -1055,22 +1016,18 @@ inspect $ 'takeWhileMTrue4 `hasNoType` ''SPEC o_1_space_filtering :: Int -> [Benchmark] o_1_space_filtering value = - [ bgroup "filtering" - [ -- Trimming - benchIO "take-all" $ takeAll1 value - , benchIO "takeWhile-true" $ takeWhileTrue1 value - -- , benchIO "takeWhileM-true" ... - ] + [ -- Trimming + benchIO "take-all" $ takeAll1 value + , benchIO "takeWhile-true" $ takeWhileTrue1 value + -- , benchIO "takeWhileM-true" ... ] o_1_space_filteringX4 :: Int -> [Benchmark] o_1_space_filteringX4 value = - [ bgroup "filteringX4" - [ -- trimming - benchIO "take-all" $ takeAll4 value - , benchIO "takeWhile-true" $ takeWhileTrue4 value - , benchIO "takeWhileM-true" $ takeWhileMTrue4 value - ] + [ -- trimming + benchIO "take-all x 4" $ takeAll4 value + , benchIO "takeWhile-true x 4" $ takeWhileTrue4 value + , benchIO "takeWhileM-true x 4" $ takeWhileMTrue4 value ] ------------------------------------------------------------------------------- @@ -1147,13 +1104,11 @@ inspect $ 'zipWithM `hasNoType` ''Fold.Step o_1_space_joining :: Int -> [Benchmark] o_1_space_joining value = - [ bgroup "joining (2 of n/2)" - [ benchIO "serial" $ serial2 (value `div` 2) - , benchIO "serial (2,2,x/4)" $ serial4 (value `div` 4) - , benchIO "zipWith" $ zipWith value - , benchIO "zipWithM" $ zipWithM value - , benchIO "concatMap" $ concatMap 2 (value `div` 2) - ] + [ benchIO "serial" $ serial2 (value `div` 2) + , benchIO "serial (2,2,x/4)" $ serial4 (value `div` 4) + , benchIO "zipWith" $ zipWith value + , benchIO "zipWithM" $ zipWithM value + , benchIO "concatMap" $ concatMap 2 (value `div` 2) ] ------------------------------------------------------------------------------- @@ -1328,51 +1283,49 @@ inspect $ 'unfoldCross `hasNoType` ''SPEC o_1_space_concat :: Int -> [Benchmark] o_1_space_concat value = sqrtVal `seq` - [ bgroup "concat" - [ benchIO "concatMap unfoldr outer=Max inner=1" $ concatMapPure value 1 - , benchIO "concatMap unfoldr outer=inner=(sqrt Max)" $ concatMapPure sqrtVal sqrtVal - , benchIO "concatMap unfoldr outer=1 inner=Max" $ concatMapPure 1 value - - , benchIO "concatMap unfoldrM outer=max inner=1" $ concatMap value 1 - , benchIO "concatMap unfoldrM outer=inner=(sqrt Max)" $ concatMap sqrtVal sqrtVal - , benchIO "concatMap unfoldrM outer=1 inner=Max" $ concatMap 1 value - - -- Using boxed values/streams may have entirely different perf profile - , benchIO "concatMap Streams fromPure outer=max inner=1" $ - concatMapSingletonStreams value - , benchIO "concatMap Streams unfoldr outer=max inner=1" $ - concatMapStreams value 1 - , benchIO "concatMap Streams unfoldr outer=inner=(sqrt Max)" $ - concatMapStreams sqrtVal sqrtVal - , benchIO "concatMap Streams unfoldr outer=1 inner=Max" $ - concatMapStreams 1 value - - , benchIO "concatMapM unfoldrM outer=max inner=1" $ concatMapM value 1 - , benchIO "concatMapM unfoldrM outer=inner=(sqrt Max)" $ concatMapM sqrtVal sqrtVal - , benchIO "concatMapM unfoldrM outer=1 inner=Max" $ concatMapM 1 value - - , benchIO "concatMapM2 fromPure" $ concatMapM2 sqrtVal - , benchIO "concatMapM3 fromPure" $ concatMapM3 cubertVal - - , benchIO "concatMapViaUnfoldEach outer=max inner=1" $ concatMapViaUnfoldEach value 1 - , benchIO "concatMapViaUnfoldEach outer=inner=(sqrt Max)" $ concatMapViaUnfoldEach sqrtVal sqrtVal - , benchIO "concatMapViaUnfoldEach outer=1 inner=Max" $ concatMapViaUnfoldEach 1 value - - , benchIO "unfoldCross outer=max inner=1" $ unfoldCross value 1 - , benchIO "unfoldCross outer=inner=(sqrt Max)" $ unfoldCross sqrtVal sqrtVal - , benchIO "unfoldCross outer=1 inner=Max" $ unfoldCross 1 value - - -- concatMap vs unfoldEach - , benchIO "unfoldEach outer=Max inner=1" $ unfoldEach value 1 - , benchIO "unfoldEach outer=inner=(sqrt Max)" $ unfoldEach sqrtVal sqrtVal - , benchIO "unfoldEach outer=1 inner=Max" $ unfoldEach 1 value - - , benchIO "unfoldEach2 outer=Max inner=1" $ unfoldEach2 value 1 - , benchIO "unfoldEach2 outer=inner=(sqrt Max)" $ unfoldEach2 sqrtVal sqrtVal - , benchIO "unfoldEach2 outer=1 inner=Max" $ unfoldEach2 1 value - - , benchIO "unfoldEach3 outer=inner=(cubert Max)" $ unfoldEach3 value - ] + [ benchIO "concatMap unfoldr outer=Max inner=1" $ concatMapPure value 1 + , benchIO "concatMap unfoldr outer=inner=(sqrt Max)" $ concatMapPure sqrtVal sqrtVal + , benchIO "concatMap unfoldr outer=1 inner=Max" $ concatMapPure 1 value + + , benchIO "concatMap unfoldrM outer=max inner=1" $ concatMap value 1 + , benchIO "concatMap unfoldrM outer=inner=(sqrt Max)" $ concatMap sqrtVal sqrtVal + , benchIO "concatMap unfoldrM outer=1 inner=Max" $ concatMap 1 value + + -- Using boxed values/streams may have entirely different perf profile + , benchIO "concatMap Streams fromPure outer=max inner=1" $ + concatMapSingletonStreams value + , benchIO "concatMap Streams unfoldr outer=max inner=1" $ + concatMapStreams value 1 + , benchIO "concatMap Streams unfoldr outer=inner=(sqrt Max)" $ + concatMapStreams sqrtVal sqrtVal + , benchIO "concatMap Streams unfoldr outer=1 inner=Max" $ + concatMapStreams 1 value + + , benchIO "concatMapM unfoldrM outer=max inner=1" $ concatMapM value 1 + , benchIO "concatMapM unfoldrM outer=inner=(sqrt Max)" $ concatMapM sqrtVal sqrtVal + , benchIO "concatMapM unfoldrM outer=1 inner=Max" $ concatMapM 1 value + + , benchIO "concatMapM2 fromPure" $ concatMapM2 sqrtVal + , benchIO "concatMapM3 fromPure" $ concatMapM3 cubertVal + + , benchIO "concatMapViaUnfoldEach outer=max inner=1" $ concatMapViaUnfoldEach value 1 + , benchIO "concatMapViaUnfoldEach outer=inner=(sqrt Max)" $ concatMapViaUnfoldEach sqrtVal sqrtVal + , benchIO "concatMapViaUnfoldEach outer=1 inner=Max" $ concatMapViaUnfoldEach 1 value + + , benchIO "unfoldCross outer=max inner=1" $ unfoldCross value 1 + , benchIO "unfoldCross outer=inner=(sqrt Max)" $ unfoldCross sqrtVal sqrtVal + , benchIO "unfoldCross outer=1 inner=Max" $ unfoldCross 1 value + + -- concatMap vs unfoldEach + , benchIO "unfoldEach outer=Max inner=1" $ unfoldEach value 1 + , benchIO "unfoldEach outer=inner=(sqrt Max)" $ unfoldEach sqrtVal sqrtVal + , benchIO "unfoldEach outer=1 inner=Max" $ unfoldEach 1 value + + , benchIO "unfoldEach2 outer=Max inner=1" $ unfoldEach2 value 1 + , benchIO "unfoldEach2 outer=inner=(sqrt Max)" $ unfoldEach2 sqrtVal sqrtVal + , benchIO "unfoldEach2 outer=1 inner=Max" $ unfoldEach2 1 value + + , benchIO "unfoldEach3 outer=inner=(cubert Max)" $ unfoldEach3 value ] where @@ -1491,17 +1444,15 @@ crossApplySnd linearCount = withRandomIntIO $ \start -> drain $ o_1_space_applicative :: Int -> [Benchmark] o_1_space_applicative value = - [ bgroup "Applicative" - [ benchIO "(*>)" $ withRandomIntIO (apDiscardFst value) - , benchIO "(<*)" $ withRandomIntIO (apDiscardSnd value) - , benchIO "(<*>)" $ withRandomIntIO (toNullAp value) - , benchIO "liftA2" $ withRandomIntIO (apLiftA2 value) - , benchIO "crossApply" $ crossApply value - , benchIO "crossApplyFst" $ crossApplyFst value - , benchIO "crossApplySnd" $ crossApplySnd value - , benchIO "pureDrain2" $ withRandomIntIO (toNullApPure value) - , benchIO "pureCross2" $ cross2 value - ] + [ benchIO "(*>)" $ withRandomIntIO (apDiscardFst value) + , benchIO "(<*)" $ withRandomIntIO (apDiscardSnd value) + , benchIO "(<*>)" $ withRandomIntIO (toNullAp value) + , benchIO "liftA2" $ withRandomIntIO (apLiftA2 value) + , benchIO "crossApply" $ crossApply value + , benchIO "crossApplyFst" $ crossApplyFst value + , benchIO "crossApplySnd" $ crossApplySnd value + , benchIO "pureDrain2" $ withRandomIntIO (toNullApPure value) + , benchIO "pureCross2" $ cross2 value ] ------------------------------------------------------------------------------- @@ -1510,27 +1461,23 @@ o_1_space_applicative value = o_1_space_monad :: Int -> [Benchmark] o_1_space_monad value = - [ bgroup "Monad" - [ benchIO "then2" $ withRandomIntIO (monadThen value) - , benchIO "drain2" $ withRandomIntIO (toNullM value) - , benchIO "drain3" $ withRandomIntIO (toNullM3 value) - , benchIO "filterAllOut2" $ withRandomIntIO (filterAllOutM value) - , benchIO "filterAllIn2" $ withRandomIntIO (filterAllInM value) - , benchIO "filterSome2" $ withRandomIntIO (filterSome value) - , benchIO "breakAfterSome2" $ withRandomIntIO (breakAfterSome value) - , benchIO "pureDrain2" $ withRandomIntIO (toNullMPure value) - , benchIO "pureDrain3" $ withRandomIntIO (toNullM3Pure value) - , benchIO "pureFilterAllIn2" $ withRandomIntIO (filterAllInMPure value) - , benchIO "pureFilterAllOut2" $ withRandomIntIO (filterAllOutMPure value) - ] + [ benchIO "then2M" $ withRandomIntIO (monadThen value) + , benchIO "drain2M" $ withRandomIntIO (toNullM value) + , benchIO "drain3M" $ withRandomIntIO (toNullM3 value) + , benchIO "filterAllOut2M" $ withRandomIntIO (filterAllOutM value) + , benchIO "filterAllIn2M" $ withRandomIntIO (filterAllInM value) + , benchIO "filterSome2M" $ withRandomIntIO (filterSome value) + , benchIO "breakAfterSome2M" $ withRandomIntIO (breakAfterSome value) + , benchIO "pureDrain2M" $ withRandomIntIO (toNullMPure value) + , benchIO "pureDrain3M" $ withRandomIntIO (toNullM3Pure value) + , benchIO "pureFilterAllIn2M" $ withRandomIntIO (filterAllInMPure value) + , benchIO "pureFilterAllOut2M" $ withRandomIntIO (filterAllOutMPure value) ] o_n_space_monad :: Int -> [Benchmark] o_n_space_monad value = - [ bgroup "Monad" - [ benchIO "toList2" $ withRandomIntIO (toListM value) - , benchIO "toListSome2" $ withRandomIntIO (toListSome value) - ] + [ benchIO "toList2M" $ withRandomIntIO (toListM value) + , benchIO "toListSome2M" $ withRandomIntIO (toListSome value) ] {-# INLINE drainConcatFor1 #-} @@ -1618,17 +1565,15 @@ filterAllOutConcatFor count = withStream count $ \s -> o_1_space_bind :: Int -> [Benchmark] o_1_space_bind streamLen = - [ bgroup "concatFor" - [ benchIO "drain1" $ drainConcatFor1 streamLen - , benchIO "drain2" $ drainConcatFor streamLen2 - , benchIO "drain3" $ drainConcatFor3 streamLen3 - , benchIO "drain4" $ drainConcatFor4 streamLen4 - , benchIO "drain5" $ drainConcatFor5 streamLen5 - , benchIO "drainM2" $ drainConcatForM streamLen2 - , benchIO "drainM3" $ drainConcatFor3M streamLen3 - , benchIO "filterAllIn2" $ filterAllInConcatFor streamLen2 - , benchIO "filterAllOut2" $ filterAllOutConcatFor streamLen2 - ] + [ benchIO "concatFor/drain1" $ drainConcatFor1 streamLen + , benchIO "concatFor/drain2" $ drainConcatFor streamLen2 + , benchIO "concatFor/drain3" $ drainConcatFor3 streamLen3 + , benchIO "concatFor/drain4" $ drainConcatFor4 streamLen4 + , benchIO "concatFor/drain5" $ drainConcatFor5 streamLen5 + , benchIO "concatFor/drainM2" $ drainConcatForM streamLen2 + , benchIO "concatFor/drainM3" $ drainConcatFor3M streamLen3 + , benchIO "concatFor/filterAllIn2" $ filterAllInConcatFor streamLen2 + , benchIO "concatFor/filterAllOut2" $ filterAllOutConcatFor streamLen2 ] where @@ -1741,13 +1686,11 @@ unfoldEachBounded maxVal = withRandomIntIO $ \n -> -- Solve simultaneous equations by exploring all possibilities o_1_space_equations :: Int -> [Benchmark] o_1_space_equations value = - [ bgroup "equations" - [ benchIO "concatFor (bounded)" $ concatForBounded sqrtVal - , benchIO "streamCross (bounded)" $ streamCrossBounded sqrtVal - , benchIO "fairStreamCross (bounded)" $ fairStreamCrossBounded sqrtVal - , benchIO "fairStreamCross (infinite)" $ fairStreamCrossInfinite sqrtVal - , benchIO "unfoldEach (bounded)" $ unfoldEachBounded sqrtVal - ] + [ benchIO "equations/concatFor (bounded)" $ concatForBounded sqrtVal + , benchIO "equations/streamCross (bounded)" $ streamCrossBounded sqrtVal + , benchIO "equations/fairStreamCross (bounded)" $ fairStreamCrossBounded sqrtVal + , benchIO "equations/fairStreamCross (infinite)" $ fairStreamCrossInfinite sqrtVal + , benchIO "equations/unfoldEach (bounded)" $ unfoldEachBounded sqrtVal ] where @@ -1830,12 +1773,10 @@ inspect $ 'refoldIterateM `hasNoType` ''SPEC o_1_space_grouping :: Int -> [Benchmark] o_1_space_grouping value = - [ bgroup "grouping" - [ benchIO "foldMany" $ foldMany value - , benchIO "foldMany1" $ foldMany1 value - , benchIO "refoldMany" $ refoldMany value - , benchIO "refoldIterateM" $ refoldIterateM value - ] + [ benchIO "foldMany" $ foldMany value + , benchIO "foldMany1" $ foldMany1 value + , benchIO "refoldMany" $ refoldMany value + , benchIO "refoldIterateM" $ refoldIterateM value ] ------------------------------------------------------------------------------- diff --git a/benchmark/bench-runner/Main.hs b/benchmark/bench-runner/Main.hs index 6210e52794..a826046015 100644 --- a/benchmark/bench-runner/Main.hs +++ b/benchmark/bench-runner/Main.hs @@ -71,23 +71,21 @@ rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific] ----------------------------------------------------------------------- - | "Data.Stream/o-1-space.grouping.classifySessionsOf" + | "Data.Stream/o-1-space.classifySessionsOf" `isPrefixOf` benchName = "-K512K" -- GHC-9.6 requires 64M, earlier it was 32M - | "Data.Stream/o-n-heap.buffered.showsPrec Haskell lists" + | "Data.Stream/o-n-heap.showsPrec Haskell lists" == benchName = "-M64M" -- GHC-9.6 requires 64M, earlier it was 32M - | "Data.Stream/o-n-heap.buffered.readsPrec pure streams" + | "Data.Stream/o-n-heap.readsPrec pure streams" == benchName = "-M64M" - | "Data.Stream/o-n-space.foldr.foldrM/" + | "Data.Stream/o-n-space.foldrM/" `isPrefixOf` benchName = "-K4M" - | "Data.Stream/o-n-space.iterated." + | "Data.Stream/o-n-space.iterated/" `isPrefixOf` benchName = "-K4M" - | "Data.Stream/o-n-space.toList.toList" - `isPrefixOf` benchName = "-K2M" - | "Data.Stream/o-n-space.Monad.toList" + | "Data.Stream/o-n-space.toList" `isPrefixOf` benchName = "-K2M" ----------------------------------------------------------------------- From 880197795a6e7619f4560d6698498a547700d384 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sat, 13 Jun 2026 18:26:34 +0530 Subject: [PATCH 03/20] Flatten Data.Stream benchmarks into single list per module --- .../Benchmark/Data/Stream/Eliminate.hs | 118 ++-- .../Benchmark/Data/Stream/Exceptions.hs | 50 +- .../Benchmark/Data/Stream/Generate.hs | 69 +-- .../Streamly/Benchmark/Data/Stream/Lift.hs | 17 +- .../Streamly/Benchmark/Data/Stream/Nesting.hs | 110 ++-- .../Benchmark/Data/Stream/Parse/Group.hs | 29 +- .../Benchmark/Data/Stream/Parse/Split.hs | 210 ++++--- .../Data/Stream/Parse/SplitChunks.hs | 14 +- .../Benchmark/Data/Stream/Transform/Basic.hs | 264 ++++----- .../Data/Stream/Transform/Composed.hs | 188 +++--- .../Streamly/Benchmark/Data/Stream/Type.hs | 556 +++++++----------- 11 files changed, 659 insertions(+), 966 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs b/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs index f570a5dae7..c1d7a65e66 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs @@ -301,41 +301,6 @@ inspect $ 'lookupNever `hasNoType` ''Fold.Step inspect $ 'lookupNever `hasNoType` ''SPEC #endif -o_1_space_elimination_folds :: Int -> [Benchmark] -o_1_space_elimination_folds value = - -- Basic folds - [ benchIO "foldl1'/IO" $ foldl1'Reduce value - , benchIO "foldl1'/Identity" $ foldl1'ReduceIdentity value - - -- deconstruction - , benchIO "mapM_" $ mapM_ value - , benchIO "last" $ streamLast value - , benchIO "init" $ streamInit value - - -- this is too fast, causes all benchmarks reported in ns - -- , benchIO "head" $ ... - , benchIO "length" $ length value - , benchIO "sum" $ sum value - , benchIO "product" $ product value - , benchIO "maximumBy" $ maximumBy value - , benchIO "maximum" $ maximum value - , benchIO "minimumBy" $ minimumBy value - , benchIO "minimum" $ minimum value - - , benchIO "the" $ the value - , benchIO "find" $ find value - , benchIO "findM" $ findM value - -- , benchIO "lookupFirst" $ ... - , benchIO "lookupNever" $ lookupNever value - , benchIO "(!!)" $ indexOp value - , benchIO "elem" $ elem value - , benchIO "notElem" $ notElem value - , benchIO "all" $ all value - , benchIO "any" $ any value - , benchIO "and" $ and value - , benchIO "or" $ or value - ] - {-# INLINE toListRev #-} toListRev :: Int -> IO [Int] toListRev value = withStream value S.toListRev @@ -345,24 +310,11 @@ toListRev value = withStream value S.toListRev toStreamRev :: Int -> IO (Stream Identity Int) toStreamRev value = withStream value (S.fold Fold.toStreamRev) -o_n_heap_elimination_toList :: Int -> [Benchmark] -o_n_heap_elimination_toList value = - -- Converting the stream to a list or pure stream in a strict monad - [ benchIO "toListRev" $ toListRev value - , benchIO "toStreamRev" $ toStreamRev value - ] - -- NOTE: this is a Fold benchmark, used here only for comparison with ToList {-# INLINE toStream #-} toStream :: Int -> IO (Stream Identity Int) toStream value = withStream value (S.fold Fold.toStream) -o_n_space_elimination_toList :: Int -> [Benchmark] -o_n_space_elimination_toList value = - -- Converting the stream to a list or pure stream in a strict monad - [ benchIO "toStream" $ toStream value - ] - ------------------------------------------------------------------------------- -- Multi-stream folds ------------------------------------------------------------------------------- @@ -402,13 +354,6 @@ inspect $ 'stripPrefix `hasNoType` ''Fold.Step inspect $ 'stripPrefix `hasNoType` ''SPEC #endif -o_1_space_elimination_multi_stream :: Int -> [Benchmark] -o_1_space_elimination_multi_stream value = - [ benchIO "isPrefixOf" $ isPrefixOf value - , benchIO "isSubsequenceOf" $ isSubsequenceOf value - , benchIO "stripPrefix" $ stripPrefix value - ] - ------------------------------------------------------------------------------- -- Iterating using tail ------------------------------------------------------------------------------- @@ -442,14 +387,6 @@ headTail value = withStream value go h <- S.head s when (isJust h) $ S.tail s >>= Prelude.mapM_ go -o_n_stack_iterated :: Int -> [Benchmark] -o_n_stack_iterated value = - [ benchIO "iterated/tail" $ tail value - , benchIO "iterated/nullTail" $ nullTail value - , benchIO "iterated/headTail" $ headTail value - , benchIO "iterated/nullHeadTail" $ nullHeadTail value - ] - ------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- @@ -459,10 +396,51 @@ o_n_stack_iterated value = -- benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = - map (SpaceO_1,) (concat - [ o_1_space_elimination_folds size - , o_1_space_elimination_multi_stream size - ]) - ++ map (HeapO_n,) (o_n_heap_elimination_toList size) - ++ map (SpaceO_n,) (o_n_space_elimination_toList size) - ++ map (StackO_n,) (o_n_stack_iterated size) + -- Basic folds + [ (SpaceO_1, benchIO "foldl1'/IO" $ foldl1'Reduce size) + , (SpaceO_1, benchIO "foldl1'/Identity" $ foldl1'ReduceIdentity size) + + -- deconstruction + , (SpaceO_1, benchIO "mapM_" $ mapM_ size) + , (SpaceO_1, benchIO "last" $ streamLast size) + , (SpaceO_1, benchIO "init" $ streamInit size) + + -- this is too fast, causes all benchmarks reported in ns + -- , benchIO "head" $ ... + , (SpaceO_1, benchIO "length" $ length size) + , (SpaceO_1, benchIO "sum" $ sum size) + , (SpaceO_1, benchIO "product" $ product size) + , (SpaceO_1, benchIO "maximumBy" $ maximumBy size) + , (SpaceO_1, benchIO "maximum" $ maximum size) + , (SpaceO_1, benchIO "minimumBy" $ minimumBy size) + , (SpaceO_1, benchIO "minimum" $ minimum size) + + , (SpaceO_1, benchIO "the" $ the size) + , (SpaceO_1, benchIO "find" $ find size) + , (SpaceO_1, benchIO "findM" $ findM size) + -- , benchIO "lookupFirst" $ ... + , (SpaceO_1, benchIO "lookupNever" $ lookupNever size) + , (SpaceO_1, benchIO "(!!)" $ indexOp size) + , (SpaceO_1, benchIO "elem" $ elem size) + , (SpaceO_1, benchIO "notElem" $ notElem size) + , (SpaceO_1, benchIO "all" $ all size) + , (SpaceO_1, benchIO "any" $ any size) + , (SpaceO_1, benchIO "and" $ and size) + , (SpaceO_1, benchIO "or" $ or size) + + , (SpaceO_1, benchIO "isPrefixOf" $ isPrefixOf size) + , (SpaceO_1, benchIO "isSubsequenceOf" $ isSubsequenceOf size) + , (SpaceO_1, benchIO "stripPrefix" $ stripPrefix size) + + -- Converting the stream to a list or pure stream in a strict monad + , (HeapO_n, benchIO "toListRev" $ toListRev size) + , (HeapO_n, benchIO "toStreamRev" $ toStreamRev size) + + -- Converting the stream to a list or pure stream in a strict monad + , (SpaceO_n, benchIO "toStream" $ toStream size) + + , (StackO_n, benchIO "iterated/tail" $ tail size) + , (StackO_n, benchIO "iterated/nullTail" $ nullTail size) + , (StackO_n, benchIO "iterated/headTail" $ headTail size) + , (StackO_n, benchIO "iterated/nullHeadTail" $ nullHeadTail size) + ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs b/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs index e53f456cdd..767ccff181 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs @@ -92,20 +92,6 @@ readWriteAfter_Stream inh devNull = let readEx = Stream.afterUnsafe (hClose inh) (Stream.unfold FH.reader inh) in Stream.fold (FH.write devNull) readEx -o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark] -o_1_space_copy_stream_exceptions env = - [ mkBenchSmall "Stream.onException" env $ \inh _ -> - readWriteOnExceptionStream inh (nullH env) - , mkBenchSmall "Stream.handle" env $ \inh _ -> - readWriteHandleExceptionStream inh (nullH env) - , mkBenchSmall "Stream.finally_" env $ \inh _ -> - readWriteFinally_Stream inh (nullH env) - , mkBenchSmall "Stream.after_" env $ \inh _ -> - readWriteAfter_Stream inh (nullH env) - , mkBenchSmall "Stream.bracket_ (fromToBytes)" env $ \inh _ -> - fromToBytesBracket_Stream inh (nullH env) - ] - ------------------------------------------------------------------------------- -- Exceptions readChunks ------------------------------------------------------------------------------- @@ -122,14 +108,6 @@ readChunksBracket_ inh devNull = let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.chunkReader in IUF.fold (IFH.writeChunks devNull) readEx inh -o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark] -o_1_space_copy_exceptions_readChunks env = - [ mkBench "UF.onException" env $ \inH _ -> - readChunksOnException inH (nullH env) - , mkBench "UF.bracket_" env $ \inH _ -> - readChunksBracket_ inH (nullH env) - ] - ------------------------------------------------------------------------------- -- Exceptions toChunks ------------------------------------------------------------------------------- @@ -205,16 +183,22 @@ inspect $ 'toChunksBracket_ `hasNoType` ''FL.Step inspect $ 'toChunksBracket_ `hasNoType` ''SPEC #endif -o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark] -o_1_space_copy_exceptions_toChunks env = - [ mkBench "Stream.bracket_ (toChunks)" env $ \inH _ -> - toChunksBracket_ inH (nullH env) - ] - benchmarks :: BenchEnv -> Int -> [(SpaceComplexity, Benchmark)] benchmarks _env _size = - map (SpaceO_1,) $ concat - [ o_1_space_copy_exceptions_readChunks _env - , o_1_space_copy_exceptions_toChunks _env - , o_1_space_copy_stream_exceptions _env - ] + [ (SpaceO_1, mkBench "UF.onException" _env $ \inH _ -> + readChunksOnException inH (nullH _env)) + , (SpaceO_1, mkBench "UF.bracket_" _env $ \inH _ -> + readChunksBracket_ inH (nullH _env)) + , (SpaceO_1, mkBench "Stream.bracket_ (toChunks)" _env $ \inH _ -> + toChunksBracket_ inH (nullH _env)) + , (SpaceO_1, mkBenchSmall "Stream.onException" _env $ \inh _ -> + readWriteOnExceptionStream inh (nullH _env)) + , (SpaceO_1, mkBenchSmall "Stream.handle" _env $ \inh _ -> + readWriteHandleExceptionStream inh (nullH _env)) + , (SpaceO_1, mkBenchSmall "Stream.finally_" _env $ \inh _ -> + readWriteFinally_Stream inh (nullH _env)) + , (SpaceO_1, mkBenchSmall "Stream.after_" _env $ \inh _ -> + readWriteAfter_Stream inh (nullH _env)) + , (SpaceO_1, mkBenchSmall "Stream.bracket_ (fromToBytes)" _env $ \inh _ -> + fromToBytesBracket_Stream inh (nullH _env)) + ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs b/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs index fa96a42ea1..e443016961 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs @@ -264,47 +264,40 @@ inspect $ 'fromIndicesM `hasNoType` ''SPEC _absTimes :: MonadIO m => Int -> Int -> Stream m AbsTime _absTimes value _ = Stream.take value Stream.absTimes -o_1_space_generation :: Int -> [Benchmark] -o_1_space_generation value = - -- 'sourceUnfoldr', 'sourceUnfoldrM', and 'repeat' are from Stream.Common. - [ benchIO "unfoldr" $ withDrain (sourceUnfoldr value) - , benchIO "unfoldrM" $ withDrain (sourceUnfoldrM value) - , benchIO "repeat" $ withDrain (repeat value) - , benchIO "replicate" $ replicate value - , benchIO "iterate" $ iterate value - , benchIO "iterateM" $ iterateM value - , benchIO "intFromTo" $ sourceIntFromTo value - , benchIO "intFromThenTo" $ sourceIntFromThenTo value - , benchIO "integerFromStep" $ sourceIntegerFromStep value - , benchIO "fracFromThenTo" $ sourceFracFromThenTo value - , benchIO "fracFromTo" $ sourceFracFromTo value - , benchIO "fromListM" $ sourceFromListM value - , benchIO "enumerateFrom" $ enumerateFrom value - , benchIO "enumerateFromTo" $ enumerateFromTo value - , benchIO "enumerateFromThen" $ enumerateFromThen value - , benchIO "enumerateFromThenTo" $ enumerateFromThenTo value - , benchIO "enumerate" $ enumerate value - , benchIO "enumerateTo" $ enumerateTo value - , benchIO "repeatM" $ repeatM value - , benchIO "replicateM" $ replicateM value - , benchIO "fromIndices" $ fromIndices value - , benchIO "fromIndicesM" $ fromIndicesM value - - -- fromFoldable essentially tests cons and consM which does not scale - -- for the Stream type. - -- , benchIO "fromFoldable 16" (sourceFromFoldable 16) - -- , benchIO "fromFoldableM 16" (sourceFromFoldableM 16) - -- XXX tasty-bench hangs benchmarking this - -- , benchIO "absTimes" $ _absTimes value - ] - ------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- --- In addition to gauge options, the number of elements in the stream can be --- passed using the --stream-size option. --- benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = - map (SpaceO_1,) (o_1_space_generation size) + -- 'sourceUnfoldr', 'sourceUnfoldrM', and 'repeat' are from Stream.Common. + [ (SpaceO_1, benchIO "unfoldr" $ withDrain (sourceUnfoldr size)) + , (SpaceO_1, benchIO "unfoldrM" $ withDrain (sourceUnfoldrM size)) + , (SpaceO_1, benchIO "repeat" $ withDrain (repeat size)) + , (SpaceO_1, benchIO "replicate" $ replicate size) + , (SpaceO_1, benchIO "iterate" $ iterate size) + , (SpaceO_1, benchIO "iterateM" $ iterateM size) + , (SpaceO_1, benchIO "intFromTo" $ sourceIntFromTo size) + , (SpaceO_1, benchIO "intFromThenTo" $ sourceIntFromThenTo size) + , (SpaceO_1, benchIO "integerFromStep" $ sourceIntegerFromStep size) + , (SpaceO_1, benchIO "fracFromThenTo" $ sourceFracFromThenTo size) + , (SpaceO_1, benchIO "fracFromTo" $ sourceFracFromTo size) + , (SpaceO_1, benchIO "fromListM" $ sourceFromListM size) + , (SpaceO_1, benchIO "enumerateFrom" $ enumerateFrom size) + , (SpaceO_1, benchIO "enumerateFromTo" $ enumerateFromTo size) + , (SpaceO_1, benchIO "enumerateFromThen" $ enumerateFromThen size) + , (SpaceO_1, benchIO "enumerateFromThenTo" $ enumerateFromThenTo size) + , (SpaceO_1, benchIO "enumerate" $ enumerate size) + , (SpaceO_1, benchIO "enumerateTo" $ enumerateTo size) + , (SpaceO_1, benchIO "repeatM" $ repeatM size) + , (SpaceO_1, benchIO "replicateM" $ replicateM size) + , (SpaceO_1, benchIO "fromIndices" $ fromIndices size) + , (SpaceO_1, benchIO "fromIndicesM" $ fromIndicesM size) + + -- fromFoldable essentially tests cons and consM which does not scale + -- for the Stream type. + -- , benchIO "fromFoldable 16" (sourceFromFoldable 16) + -- , benchIO "fromFoldableM 16" (sourceFromFoldableM 16) + -- XXX tasty-bench hangs benchmarking this + -- , benchIO "absTimes" $ _absTimes value + ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs b/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs index 8812518897..075e3b3e75 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs @@ -112,21 +112,14 @@ generalizeInnerIO value = withRandomIntIO $ \n -> Stream.fold Fold.length (Stream.generalizeInner (sourceUnfoldr value n) :: Stream IO Int) -o_1_space_hoisting :: Int -> [Benchmark] -o_1_space_hoisting value = - [ benchIO "evalState" $ evalStateTIO value - , benchIO "withState" $ withStateIO value - , benchIO "length . generalizeInner" $ generalizeInner value - , benchIO "generalizeInner" $ generalizeInnerIO value - ] - ------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- --- In addition to gauge options, the number of elements in the stream can be --- passed using the --stream-size option. --- benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = - map (SpaceO_1,) (o_1_space_hoisting size) + [ (SpaceO_1, benchIO "evalState" $ evalStateTIO size) + , (SpaceO_1, benchIO "withState" $ withStateIO size) + , (SpaceO_1, benchIO "length . generalizeInner" $ generalizeInner size) + , (SpaceO_1, benchIO "generalizeInner" $ generalizeInnerIO size) + ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs b/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs index 3fc9644d9e..536366d7ec 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs @@ -183,35 +183,6 @@ inspect $ 'unfoldSched `hasNoType` ''Fold.Step inspect $ 'unfoldSched `hasNoType` ''SPEC #endif -o_1_space_joining :: Int -> [Benchmark] -o_1_space_joining value = - [ benchIO "interleave" $ interleave2 (value `div` 2) - , benchIO "roundRobin" $ roundRobin2 (value `div` 2) - , benchIO "mergeBy compare" $ mergeBy compare (value `div` 2) - , benchIO "mergeByM compare" $ mergeByM compare (value `div` 2) - , benchIO "mergeBy (flip compare)" $ mergeBy (flip compare) (value `div` 2) - , benchIO "mergeByM (flip compare)" $ mergeByM (flip compare) (value `div` 2) - - -- join 2 streams using n-ary ops - , benchIO "bfsUnfoldEach" $ bfsUnfoldEach 2 (value `div` 2) - , benchIO "altBfsUnfoldEach" $ altBfsUnfoldEach 2 (value `div` 2) - , benchIO "unfoldSched" $ unfoldSched 2 (value `div` 2) - ] - -o_n_heap_concat :: Int -> [Benchmark] -o_n_heap_concat value = sqrtVal `seq` - [ benchIO "bfsUnfoldEach (n of 1)" $ bfsUnfoldEach value 1 - , benchIO "bfsUnfoldEach (sqrtVal of sqrtVal)" $ bfsUnfoldEach sqrtVal sqrtVal - , benchIO "altBfsUnfoldEach (n of 1)" $ altBfsUnfoldEach value 1 - , benchIO "altBfsUnfoldEach (sqrtVal of sqrtVal)" $ altBfsUnfoldEach sqrtVal sqrtVal - , benchIO "unfoldSched (n of 1)" $ unfoldSched value 1 - , benchIO "unfoldSched (sqrtVal of sqrtVal)" $ unfoldSched sqrtVal sqrtVal - ] - - where - - sqrtVal = round $ sqrt (fromIntegral value :: Double) - ------------------------------------------------------------------------------- -- Monad ------------------------------------------------------------------------------- @@ -362,32 +333,11 @@ fairUnfoldSchedInfinite :: Int -> IO () fairUnfoldSchedInfinite maxVal = withRandomIntIO $ \n -> fairUnfoldSchedEqn maxVal (infiniteIntsUnfold maxVal 0) (Type.infiniteInts maxVal n) --- Solve simultaneous equations by exploring all possibilities -o_1_space_equations :: Int -> [Benchmark] -o_1_space_equations value = - [ benchIO "equations/fairConcatFor (bounded)" $ fairConcatForBounded sqrtVal - , benchIO "equations/fairConcatForK (bounded)" $ fairConcatForKBounded sqrtVal - , benchIO "equations/fairConcatFor (infinite)" $ fairConcatForInfinite sqrtVal - , benchIO "equations/fairSchedFor (bounded)" $ fairSchedForBounded sqrtVal - , benchIO "equations/fairSchedFor (infinite)" $ fairSchedForInfinite sqrtVal - , benchIO "equations/unfoldCross (bounded)" $ unfoldCrossBounded sqrtVal - , benchIO "equations/fairUnfoldCross (bounded)" $ fairUnfoldCrossBounded sqrtVal - , benchIO "equations/fairUnfoldCross (infinite)" $ fairUnfoldCrossInfinite sqrtVal - , benchIO "equations/fairUnfoldEach (bounded)" $ fairUnfoldEachBounded sqrtVal - , benchIO "equations/fairUnfoldEach (infinite)" $ fairUnfoldEachInfinite sqrtVal - , benchIO "equations/unfoldSched (bounded)" $ unfoldSchedBounded sqrtVal - , benchIO "equations/fairUnfoldSched (bounded)" $ fairUnfoldSchedBounded sqrtVal - , benchIO "equations/fairUnfoldSched (infinite)" $ fairUnfoldSchedInfinite sqrtVal - ] - - where - - sqrtVal = round $ sqrt (fromIntegral value :: Double) - ------------------------------------------------------------------------------- -- Joining ------------------------------------------------------------------------------- +-- XXX this should be moved to the Top module {- toKv :: Int -> (Int, Int) toKv p = (p, p) @@ -449,21 +399,47 @@ o_n_heap_buffering value = -- Main ------------------------------------------------------------------------------- --- In addition to gauge options, the number of elements in the stream can be --- passed using the --stream-size option. --- -{-# ANN benchmarks "HLint: ignore" #-} benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = - map (SpaceO_1,) (Prelude.concat - [ - -- multi-stream - o_1_space_joining size - , o_1_space_equations size - ]) - ++ map (HeapO_n,) - {- - -- multi-stream - (o_n_heap_buffering size) - -} - (o_n_heap_concat size) + -- NOTE: List concatenation reduce build time memory requirement + -- multi-stream + [ (SpaceO_1, benchIO "interleave" $ interleave2 (size `div` 2)) + , (SpaceO_1, benchIO "roundRobin" $ roundRobin2 (size `div` 2)) + , (SpaceO_1, benchIO "mergeBy compare" $ mergeBy compare (size `div` 2)) + , (SpaceO_1, benchIO "mergeByM compare" $ mergeByM compare (size `div` 2)) + , (SpaceO_1, benchIO "mergeBy (flip compare)" $ mergeBy (flip compare) (size `div` 2)) + , (SpaceO_1, benchIO "mergeByM (flip compare)" $ mergeByM (flip compare) (size `div` 2)) + + -- join 2 streams using n-ary ops + , (SpaceO_1, benchIO "bfsUnfoldEach" $ bfsUnfoldEach 2 (size `div` 2)) + , (SpaceO_1, benchIO "altBfsUnfoldEach" $ altBfsUnfoldEach 2 (size `div` 2)) + , (SpaceO_1, benchIO "unfoldSched" $ unfoldSched 2 (size `div` 2)) + ] ++ + + -- Solve simultaneous equations by exploring all possibilities + [ (SpaceO_1, benchIO "equations/fairConcatFor (bounded)" $ fairConcatForBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairConcatForK (bounded)" $ fairConcatForKBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairConcatFor (infinite)" $ fairConcatForInfinite sqrtVal) + , (SpaceO_1, benchIO "equations/fairSchedFor (bounded)" $ fairSchedForBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairSchedFor (infinite)" $ fairSchedForInfinite sqrtVal) + , (SpaceO_1, benchIO "equations/unfoldCross (bounded)" $ unfoldCrossBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairUnfoldCross (bounded)" $ fairUnfoldCrossBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairUnfoldCross (infinite)" $ fairUnfoldCrossInfinite sqrtVal) + , (SpaceO_1, benchIO "equations/fairUnfoldEach (bounded)" $ fairUnfoldEachBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairUnfoldEach (infinite)" $ fairUnfoldEachInfinite sqrtVal) + , (SpaceO_1, benchIO "equations/unfoldSched (bounded)" $ unfoldSchedBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairUnfoldSched (bounded)" $ fairUnfoldSchedBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairUnfoldSched (infinite)" $ fairUnfoldSchedInfinite sqrtVal) + ] ++ + [ + (HeapO_n, benchIO "bfsUnfoldEach (n of 1)" $ bfsUnfoldEach size 1) + , (HeapO_n, benchIO "bfsUnfoldEach (sqrtVal of sqrtVal)" $ bfsUnfoldEach sqrtVal sqrtVal) + , (HeapO_n, benchIO "altBfsUnfoldEach (n of 1)" $ altBfsUnfoldEach size 1) + , (HeapO_n, benchIO "altBfsUnfoldEach (sqrtVal of sqrtVal)" $ altBfsUnfoldEach sqrtVal sqrtVal) + , (HeapO_n, benchIO "unfoldSched (n of 1)" $ unfoldSched size 1) + , (HeapO_n, benchIO "unfoldSched (sqrtVal of sqrtVal)" $ unfoldSched sqrtVal sqrtVal) + ] + + where + + sqrtVal = round $ sqrt (fromIntegral size :: Double) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs index 13b4664fa4..b07813677d 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs @@ -113,26 +113,21 @@ inspect $ 'foldIterateM `hasNoType` ''FL.Step inspect $ 'foldIterateM `hasNoType` ''SPEC #endif -o_1_space_grouping :: Int -> [Benchmark] -o_1_space_grouping value = - -- Buffering operations using heap proportional to group/window sizes. - [ - benchIO "groups" $ groups value - , benchIO "groupsWhileLT" $ groupsWhileLT value - , benchIO "groupsWhileEq" $ groupsWhileEq value - , benchIO "groupsByRollingLT" $ groupsByRollingLT value - , benchIO "groupsByRollingEq" $ groupsByRollingEq value - - -- XXX parseMany/parseIterate benchmarks are in the Parser/ParserD - -- modules we can bring those here. chunksOf benchmarks are in - -- Parser/ParserD/Array.Stream/FileSystem.Handle. - , benchIO "foldIterateM" $ foldIterateM value - ] - ------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = - map (SpaceO_1,) (o_1_space_grouping size) + -- Buffering operations using heap proportional to group/window sizes. + [ (SpaceO_1, benchIO "groups" $ groups size) + , (SpaceO_1, benchIO "groupsWhileLT" $ groupsWhileLT size) + , (SpaceO_1, benchIO "groupsWhileEq" $ groupsWhileEq size) + , (SpaceO_1, benchIO "groupsByRollingLT" $ groupsByRollingLT size) + , (SpaceO_1, benchIO "groupsByRollingEq" $ groupsByRollingEq size) + + -- XXX parseMany/parseIterate benchmarks are in the Parser/ParserD + -- modules we can bring those here. chunksOf benchmarks are in + -- Parser/ParserD/Array.Stream/FileSystem.Handle. + , (SpaceO_1, benchIO "foldIterateM" $ foldIterateM size) + ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Split.hs b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Split.hs index cd671869f3..3f4230f702 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Split.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Split.hs @@ -239,112 +239,108 @@ inspect $ 'splitWithSuffixSeq `hasNoType` ''Fold.Step inspect $ 'splitWithSuffixSeq `hasNoType` ''SPEC #endif -o_1_space_reduce_read_split :: BenchEnv -> [Benchmark] -o_1_space_reduce_read_split env = - -- NOTE: keep the benchmark names consistent with Data.Fold.takeEndBy* - [ mkBench "splitOn infix lf" env $ \inh _ -> - splitOn inh - - -- splitting on a sequence - , mkBench "wordsBy infix isSpace" env $ \inh _ -> - wordsBy inh - - -- Infix - , mkBench "splitOnSeq empty infix" env $ \inh _ -> - splitOnSeq "" inh - , mkBench "splitOnSeq single infix lf" env $ \inh _ -> - splitOnSeq "\n" inh - , mkBench "splitOnSeq single infix a" env $ \inh _ -> - splitOnSeq "a" inh - , mkBench "splitOnSeq word infix crlf" env $ \inh _ -> - splitOnSeq "\r\n" inh - , mkBench "splitOnSeq word infix aa" env $ \inh _ -> - splitOnSeq "aa" inh - , mkBench "splitOnSeq word infix aaaa" env $ \inh _ -> - splitOnSeq "aaaa" inh - , mkBench "splitOnSeq word infix abcdefgh" env $ \inh _ -> - splitOnSeq "abcdefgh" inh - , mkBench "splitOnSeq KR infix abcdefghi" env $ \inh _ -> - splitOnSeq "abcdefghi" inh - , mkBench "splitOnSeq KR infix catcatcatcatcat" env $ \inh _ -> - splitOnSeq "catcatcatcatcat" inh - , mkBench "splitOnSeq KR infix abcdefghijklmnopqrstuvwxyz" - env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh - , mkBench "splitOnSeq KR infix 100k long pattern" - env $ \inh _ -> splitOnSeq100k inh - - -- Suffix - , mkBench "splitOnSuffixSeq empty suffix" env $ \inh _ -> - splitOnSuffixSeq "" inh - , mkBench "splitOnSuffixSeq single suffix lf" env $ \inh _ -> - splitOnSuffixSeq "\n" inh - , mkBench "splitOnSuffixSeq word suffix crlf" env $ \inh _ -> - splitOnSuffixSeq "\r\n" inh - , mkBenchSmall "splitOnSuffixSeq KR suffix abcdefghijklmnopqrstuvwxyz" - env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh - - -- Suffix with separator - , mkBench "splitWithSuffixSeq single suffix lf" env $ \inh _ -> - splitWithSuffixSeq "\n" inh - , mkBench "splitWithSuffixSeq word suffix crlf" env $ \inh _ -> - splitWithSuffixSeq "\r\n" inh - , mkBench "splitWithSuffixSeq KR suffix abcdefghi" env $ \inh _ -> - splitWithSuffixSeq "abcdefghi" inh - , mkBenchSmall "splitWithSuffixSeq KR suffix abcdefghijklmnopqrstuvwxyz" - env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh - - {- - mkBench "takeEndBySeq empty" env $ \inh _ -> - takeEndBySeq "" inh - -} - -- IMPORTANT: the pattern must contain a, because we filter a's out - -- from the stream so that we do not terminate too early and - -- unpredictably. - , mkBench "takeEndBy" env $ \inh _ -> - takeEndBy (fromIntegral $ ord 'a') inh - , mkBench "takeEndBy_" env $ \inh _ -> - takeEndBy_ (fromIntegral $ ord 'a') inh - , mkBench "takeEndBySeq single a" env $ \inh _ -> - takeEndBySeq "a" inh - , mkBench "takeEndBySeq word aa" env $ \inh _ -> - takeEndBySeq "aa" inh - , mkBench "takeEndBySeq word aaaa" env $ \inh _ -> - takeEndBySeq "aaaa" inh - , mkBench "takeEndBySeq word abcdefgh" env $ \inh _ -> - takeEndBySeq "abcdefgh" inh - - -- XXX takeEndBySeq KR requires @-fspec-constr-recursive=12@. - , mkBench "takeEndBySeq KR abcdefghi" env $ \inh _ -> - takeEndBySeq "abcdefghi" inh - , mkBench "takeEndBySeq KR catcatcatcatcat" env $ \inh _ -> - takeEndBySeq "catcatcatcatcat" inh - , mkBench "takeEndBySeq KR abcdefghijklmnopqrstuvwxyz" - env $ \inh _ -> takeEndBySeq "abcdefghijklmnopqrstuvwxyz" inh - , mkBench "takeEndBySeq KR 100k long pattern" - env $ \inh _ -> takeEndBySeq100k inh - - {- - , mkBench "takeEndBySeq_ empty" env $ \inh _ -> - takeEndBySeq_ "" inh - -} - , mkBench "takeEndBySeq_ single a" env $ \inh _ -> - takeEndBySeq_ "a" inh - , mkBench "takeEndBySeq_ word aa" env $ \inh _ -> - takeEndBySeq_ "aa" inh - , mkBench "takeEndBySeq_ word aaaa" env $ \inh _ -> - takeEndBySeq_ "aaaa" inh - , mkBench "takeEndBySeq_ word abcdefgh" env $ \inh _ -> - takeEndBySeq_ "abcdefgh" inh - , mkBench "takeEndBySeq_ KR abcdefghi" env $ \inh _ -> - takeEndBySeq_ "abcdefghi" inh - , mkBench "takeEndBySeq_ KR catcatcatcatcat" env $ \inh _ -> - takeEndBySeq_ "catcatcatcatcat" inh - , mkBench "takeEndBySeq_ KR abcdefghijklmnopqrstuvwxyz" - env $ \inh _ -> takeEndBySeq_ "abcdefghijklmnopqrstuvwxyz" inh - , mkBench "takeEndBySeq_ KR 100k long pattern" - env $ \inh _ -> takeEndBySeq_100k inh - ] - benchmarks :: BenchEnv -> [(SpaceComplexity, Benchmark)] benchmarks env = - map (SpaceO_1,) (o_1_space_reduce_read_split env) + -- NOTE: keep the benchmark names consistent with Data.Fold.takeEndBy* + [ (SpaceO_1, mkBench "splitOn infix lf" env $ \inh _ -> + splitOn inh) + + -- splitting on a sequence + , (SpaceO_1, mkBench "wordsBy infix isSpace" env $ \inh _ -> + wordsBy inh) + + -- Infix + , (SpaceO_1, mkBench "splitOnSeq empty infix" env $ \inh _ -> + splitOnSeq "" inh) + , (SpaceO_1, mkBench "splitOnSeq single infix lf" env $ \inh _ -> + splitOnSeq "\n" inh) + , (SpaceO_1, mkBench "splitOnSeq single infix a" env $ \inh _ -> + splitOnSeq "a" inh) + , (SpaceO_1, mkBench "splitOnSeq word infix crlf" env $ \inh _ -> + splitOnSeq "\r\n" inh) + , (SpaceO_1, mkBench "splitOnSeq word infix aa" env $ \inh _ -> + splitOnSeq "aa" inh) + , (SpaceO_1, mkBench "splitOnSeq word infix aaaa" env $ \inh _ -> + splitOnSeq "aaaa" inh) + , (SpaceO_1, mkBench "splitOnSeq word infix abcdefgh" env $ \inh _ -> + splitOnSeq "abcdefgh" inh) + , (SpaceO_1, mkBench "splitOnSeq KR infix abcdefghi" env $ \inh _ -> + splitOnSeq "abcdefghi" inh) + , (SpaceO_1, mkBench "splitOnSeq KR infix catcatcatcatcat" env $ \inh _ -> + splitOnSeq "catcatcatcatcat" inh) + , (SpaceO_1, mkBench "splitOnSeq KR infix abcdefghijklmnopqrstuvwxyz" + env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh) + , (SpaceO_1, mkBench "splitOnSeq KR infix 100k long pattern" + env $ \inh _ -> splitOnSeq100k inh) + + -- Suffix + , (SpaceO_1, mkBench "splitOnSuffixSeq empty suffix" env $ \inh _ -> + splitOnSuffixSeq "" inh) + , (SpaceO_1, mkBench "splitOnSuffixSeq single suffix lf" env $ \inh _ -> + splitOnSuffixSeq "\n" inh) + , (SpaceO_1, mkBench "splitOnSuffixSeq word suffix crlf" env $ \inh _ -> + splitOnSuffixSeq "\r\n" inh) + , (SpaceO_1, mkBenchSmall "splitOnSuffixSeq KR suffix abcdefghijklmnopqrstuvwxyz" + env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh) + + -- Suffix with separator + , (SpaceO_1, mkBench "splitWithSuffixSeq single suffix lf" env $ \inh _ -> + splitWithSuffixSeq "\n" inh) + , (SpaceO_1, mkBench "splitWithSuffixSeq word suffix crlf" env $ \inh _ -> + splitWithSuffixSeq "\r\n" inh) + , (SpaceO_1, mkBench "splitWithSuffixSeq KR suffix abcdefghi" env $ \inh _ -> + splitWithSuffixSeq "abcdefghi" inh) + , (SpaceO_1, mkBenchSmall "splitWithSuffixSeq KR suffix abcdefghijklmnopqrstuvwxyz" + env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh) + + {- + mkBench "takeEndBySeq empty" env $ \inh _ -> + takeEndBySeq "" inh + -} + -- IMPORTANT: the pattern must contain a, because we filter a's out + -- from the stream so that we do not terminate too early and + -- unpredictably. + , (SpaceO_1, mkBench "takeEndBy" env $ \inh _ -> + takeEndBy (fromIntegral $ ord 'a') inh) + , (SpaceO_1, mkBench "takeEndBy_" env $ \inh _ -> + takeEndBy_ (fromIntegral $ ord 'a') inh) + , (SpaceO_1, mkBench "takeEndBySeq single a" env $ \inh _ -> + takeEndBySeq "a" inh) + , (SpaceO_1, mkBench "takeEndBySeq word aa" env $ \inh _ -> + takeEndBySeq "aa" inh) + , (SpaceO_1, mkBench "takeEndBySeq word aaaa" env $ \inh _ -> + takeEndBySeq "aaaa" inh) + , (SpaceO_1, mkBench "takeEndBySeq word abcdefgh" env $ \inh _ -> + takeEndBySeq "abcdefgh" inh) + + -- XXX takeEndBySeq KR requires @-fspec-constr-recursive=12@. + , (SpaceO_1, mkBench "takeEndBySeq KR abcdefghi" env $ \inh _ -> + takeEndBySeq "abcdefghi" inh) + , (SpaceO_1, mkBench "takeEndBySeq KR catcatcatcatcat" env $ \inh _ -> + takeEndBySeq "catcatcatcatcat" inh) + , (SpaceO_1, mkBench "takeEndBySeq KR abcdefghijklmnopqrstuvwxyz" + env $ \inh _ -> takeEndBySeq "abcdefghijklmnopqrstuvwxyz" inh) + , (SpaceO_1, mkBench "takeEndBySeq KR 100k long pattern" + env $ \inh _ -> takeEndBySeq100k inh) + + {- + , mkBench "takeEndBySeq_ empty" env $ \inh _ -> + takeEndBySeq_ "" inh + -} + , (SpaceO_1, mkBench "takeEndBySeq_ single a" env $ \inh _ -> + takeEndBySeq_ "a" inh) + , (SpaceO_1, mkBench "takeEndBySeq_ word aa" env $ \inh _ -> + takeEndBySeq_ "aa" inh) + , (SpaceO_1, mkBench "takeEndBySeq_ word aaaa" env $ \inh _ -> + takeEndBySeq_ "aaaa" inh) + , (SpaceO_1, mkBench "takeEndBySeq_ word abcdefgh" env $ \inh _ -> + takeEndBySeq_ "abcdefgh" inh) + , (SpaceO_1, mkBench "takeEndBySeq_ KR abcdefghi" env $ \inh _ -> + takeEndBySeq_ "abcdefghi" inh) + , (SpaceO_1, mkBench "takeEndBySeq_ KR catcatcatcatcat" env $ \inh _ -> + takeEndBySeq_ "catcatcatcatcat" inh) + , (SpaceO_1, mkBench "takeEndBySeq_ KR abcdefghijklmnopqrstuvwxyz" + env $ \inh _ -> takeEndBySeq_ "abcdefghijklmnopqrstuvwxyz" inh) + , (SpaceO_1, mkBench "takeEndBySeq_ KR 100k long pattern" + env $ \inh _ -> takeEndBySeq_100k inh) + ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Parse/SplitChunks.hs b/benchmark/Streamly/Benchmark/Data/Stream/Parse/SplitChunks.hs index df10f6b830..1723471e6f 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Parse/SplitChunks.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Parse/SplitChunks.hs @@ -66,14 +66,10 @@ inspect $ 'splitOnSeqUtf8 `hasNoType` ''SPEC -- inspect $ 'splitOnSeqUtf8 `hasNoType` ''Unfold.ConcatState -- decodeUtf8Chunks #endif -o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark] -o_1_space_reduce_toChunks_split env = - [ mkBenchSmall "splitOnSeqUtf8 word abcdefgh" - env $ \inh _ -> splitOnSeqUtf8 "abcdefgh" inh - , mkBenchSmall "splitOnSeqUtf8 KR abcdefghijklmnopqrstuvwxyz" - env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh - ] - benchmarks :: BenchEnv -> [(SpaceComplexity, Benchmark)] benchmarks env = - map (SpaceO_1,) (o_1_space_reduce_toChunks_split env) + [ (SpaceO_1, mkBenchSmall "splitOnSeqUtf8 word abcdefgh" + env $ \inh _ -> splitOnSeqUtf8 "abcdefgh" inh) + , (SpaceO_1, mkBenchSmall "splitOnSeqUtf8 KR abcdefghijklmnopqrstuvwxyz" + env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh) + ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs index e28446c09c..4aadc9381e 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs @@ -305,42 +305,6 @@ inspect $ 'trace4 `hasNoType` ''FL.Step inspect $ 'trace4 `hasNoType` ''SPEC #endif -o_1_space_mapping :: Int -> [Benchmark] -o_1_space_mapping value = - [ - -- , benchIOSink value "foldrT" (foldrT 1) - -- , benchIOSink value "foldrTMap" (foldrTMap 1) - - -- Mapping - benchIO "sequence" $ sequence1 value - , benchIO "tap" $ tap1 value - -- XXX tasty-bench hangs benchmarking this - -- , benchIOSink value "timestamped" _timestamped - -- Scanning - , benchIO "scanl'" $ scanl'1 value - , benchIO "scanl1'" $ scanl1'1 value - , benchIO "scanlM'" $ scanlM'1 value - , benchIO "scanl1M'" $ scanl1M'1 value - , benchIO "postscanl'" $ postscanl'1 value - , benchIO "postscanlM'" $ postscanlM'1 value - , benchIO "scan" $ scan1 value - , benchIO "postscan" $ postscan1 value - ] - -o_1_space_mappingX4 :: Int -> [Benchmark] -o_1_space_mappingX4 value = - [ benchIO "trace x 4" $ trace4 value - - , benchIO "scanl' x 4" $ scanl'4 value - , benchIO "scanl1' x 4" $ scanl1'4 value - , benchIO "scanlM' x 4" $ scanlM'4 value - , benchIO "scanl1M' x 4" $ scanl1M'4 value - , benchIO "postscanl' x 4" $ postscanl'4 value - , benchIO "postscanlM' x 4" $ postscanlM'4 value - , benchIO "scan x 4" $ scan4 value - , benchIO "postscan x 4" $ postscan4 value - ] - ------------------------------------------------------------------------------- -- Iteration/looping utilities ------------------------------------------------------------------------------- @@ -393,19 +357,6 @@ iterateSubMap value = withRandomIntIO $ drain . iterateSingleton (<$) value iterateFmap :: Int -> IO () iterateFmap value = withRandomIntIO $ drain . iterateSingleton (fmap . (+)) value -o_n_space_iterated :: Int -> [Benchmark] -o_n_space_iterated value = - [ benchIO "iterated/(+) (n times) (baseline)" $ iteratePlusBaseline value - , benchIO "iterated/(<$) (n times)" $ iterateSubMap value - , benchIO "iterated/fmap (n times)" $ iterateFmap value - {- - , benchIOSrc fromSerial "_(<$) (n times)" $ - _iterateSingleton (<$) value - , benchIOSrc fromSerial "_fmap (n times)" $ - _iterateSingleton (fmap . (+)) value - -} - ] - ------------------------------------------------------------------------------- -- Size reducing transformations (filtering) ------------------------------------------------------------------------------- @@ -881,65 +832,6 @@ inspect $ 'mapMaybeM4 `hasNoType` ''FL.Step inspect $ 'mapMaybeM4 `hasNoType` ''SPEC #endif -o_1_space_filtering :: Int -> [Benchmark] -o_1_space_filtering value = - [ benchIO "filter-even" $ filterEven1 value - , benchIO "filter-all-out" $ filterAllOut1 value - , benchIO "filter-all-in" $ filterAllIn1 value - - , benchIO "filterM-even" $ filterMEven1 value - , benchIO "filterM-all-out" $ filterMAllOut1 value - , benchIO "filterM-all-in" $ filterMAllIn1 value - - , benchIO "drop-one" $ dropOne1 value - , benchIO "drop-all" $ dropAll1 value - , benchIO "dropWhile-true" $ dropWhileTrue1 value - -- , benchIO "dropWhileM-true" ... - , benchIO "dropWhile-false" $ dropWhileFalse1 value - , benchIO "deleteBy" $ deleteBy1 value - - , benchIO "uniq" $ uniq1 value - - -- Map and filter - , benchIO "mapMaybe" $ mapMaybe1 value - , benchIO "mapMaybeM" $ mapMaybeM1 value - - -- Searching (stateful map and filter) - , benchIO "findIndices" $ findIndices1 value - , benchIO "elemIndices" $ elemIndices1 value - , benchIO "findIndex" $ findIndex value - , benchIO "elemIndex" $ elemIndex value - ] - -o_1_space_filteringX4 :: Int -> [Benchmark] -o_1_space_filteringX4 value = - [ benchIO "filter-even x 4" $ filterEven4 value - , benchIO "filter-all-out x 4" $ filterAllOut4 value - , benchIO "filter-all-in x 4" $ filterAllIn4 value - - , benchIO "filterM-even x 4" $ filterMEven4 value - , benchIO "filterM-all-out x 4" $ filterMAllOut4 value - , benchIO "filterM-all-in x 4" $ filterMAllIn4 value - - , benchIO "drop-one x 4" $ dropOne4 value - , benchIO "drop-all x 4" $ dropAll4 value - , benchIO "dropWhile-true x 4" $ dropWhileTrue4 value - , benchIO "dropWhileM-true x 4" $ dropWhileMTrue4 value - -- XXX requires @-fspec-constr-recursive=12@. - , benchIO "dropWhile-false x 4" $ dropWhileFalse4 value - , benchIO "deleteBy x 4" $ deleteBy4 value - - , benchIO "uniq x 4" $ uniq4 value - - -- map and filter - , benchIO "mapMaybe x 4" $ mapMaybe4 value - , benchIO "mapMaybeM x 4" $ mapMaybeM4 value - - -- searching - , benchIO "findIndices x 4" $ findIndices4 value - , benchIO "elemIndices x 4" $ elemIndices4 value - ] - ------------------------------------------------------------------------------- -- Size increasing transformations (insertions) ------------------------------------------------------------------------------- @@ -1049,23 +941,6 @@ inspect $ 'intercalateSuffix1 `hasNoType` ''FL.Step inspect $ 'intercalateSuffix1 `hasNoType` ''SPEC #endif -o_1_space_inserting :: Int -> [Benchmark] -o_1_space_inserting value = - [ benchIO "intersperse" $ intersperse1 value - , benchIO "intersperseM" $ intersperseM1 value - , benchIO "insertBy" $ insertBy1 value - , benchIO "interposeSuffix" $ interposeSuffix1 value - , benchIO "intercalateSuffix" $ intercalateSuffix1 value - ] - -o_1_space_insertingX4 :: Int -> [Benchmark] -o_1_space_insertingX4 value = - [ - -- XXX requires @-fspec-constr-recursive=16@. - benchIO "intersperse x 4" $ intersperse4 value - , benchIO "insertBy x 4" $ insertBy4 value - ] - ------------------------------------------------------------------------------- -- Indexing ------------------------------------------------------------------------------- @@ -1122,18 +997,6 @@ inspect $ 'indexedR4 `hasNoType` ''FL.Step inspect $ 'indexedR4 `hasNoType` ''SPEC #endif -o_1_space_indexing :: Int -> [Benchmark] -o_1_space_indexing value = - [ benchIO "indexed" $ indexed1 value - , benchIO "indexedR" $ indexedR1 value - ] - -o_1_space_indexingX4 :: Int -> [Benchmark] -o_1_space_indexingX4 value = - [ benchIO "indexed x 4" $ indexed4 value - , benchIO "indexedR x 4" $ indexedR4 value - ] - ------------------------------------------------------------------------------- -- Size conserving transformations (reordering, buffering, etc.) ------------------------------------------------------------------------------- @@ -1158,32 +1021,113 @@ inspect $ hasNoTypeClasses 'reverse' -- inspect $ 'reverse' `hasNoType` ''Stream.Step #endif -o_n_heap_buffering :: Int -> [Benchmark] -o_n_heap_buffering value = - [ - -- Reversing a stream - benchIO "reverse" $ reverse value - , benchIO "reverse'" $ reverse' value - ] - ------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- --- In addition to gauge options, the number of elements in the stream can be --- passed using the --stream-size option. --- benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = - map (SpaceO_1,) (Prelude.concat - [ o_1_space_mapping size - , o_1_space_mappingX4 size - , o_1_space_filtering size - , o_1_space_filteringX4 size - , o_1_space_inserting size - , o_1_space_insertingX4 size - , o_1_space_indexing size - , o_1_space_indexingX4 size - ]) - ++ map (SpaceO_n,) (o_n_space_iterated size) - ++ map (HeapO_n,) (o_n_heap_buffering size) + [ + -- , benchIOSink value "foldrT" (foldrT 1) + -- , benchIOSink value "foldrTMap" (foldrTMap 1) + + -- Mapping + (SpaceO_1, benchIO "sequence" $ sequence1 size) + , (SpaceO_1, benchIO "tap" $ tap1 size) + -- XXX tasty-bench hangs benchmarking this + -- , benchIOSink value "timestamped" _timestamped + -- Scanning + , (SpaceO_1, benchIO "scanl'" $ scanl'1 size) + , (SpaceO_1, benchIO "scanl1'" $ scanl1'1 size) + , (SpaceO_1, benchIO "scanlM'" $ scanlM'1 size) + , (SpaceO_1, benchIO "scanl1M'" $ scanl1M'1 size) + , (SpaceO_1, benchIO "postscanl'" $ postscanl'1 size) + , (SpaceO_1, benchIO "postscanlM'" $ postscanlM'1 size) + , (SpaceO_1, benchIO "scan" $ scan1 size) + , (SpaceO_1, benchIO "postscan" $ postscan1 size) + , (SpaceO_1, benchIO "trace x 4" $ trace4 size) + + , (SpaceO_1, benchIO "scanl' x 4" $ scanl'4 size) + , (SpaceO_1, benchIO "scanl1' x 4" $ scanl1'4 size) + , (SpaceO_1, benchIO "scanlM' x 4" $ scanlM'4 size) + , (SpaceO_1, benchIO "scanl1M' x 4" $ scanl1M'4 size) + , (SpaceO_1, benchIO "postscanl' x 4" $ postscanl'4 size) + , (SpaceO_1, benchIO "postscanlM' x 4" $ postscanlM'4 size) + , (SpaceO_1, benchIO "scan x 4" $ scan4 size) + , (SpaceO_1, benchIO "postscan x 4" $ postscan4 size) + , (SpaceO_1, benchIO "filter-even" $ filterEven1 size) + , (SpaceO_1, benchIO "filter-all-out" $ filterAllOut1 size) + , (SpaceO_1, benchIO "filter-all-in" $ filterAllIn1 size) + + , (SpaceO_1, benchIO "filterM-even" $ filterMEven1 size) + , (SpaceO_1, benchIO "filterM-all-out" $ filterMAllOut1 size) + , (SpaceO_1, benchIO "filterM-all-in" $ filterMAllIn1 size) + + , (SpaceO_1, benchIO "drop-one" $ dropOne1 size) + , (SpaceO_1, benchIO "drop-all" $ dropAll1 size) + , (SpaceO_1, benchIO "dropWhile-true" $ dropWhileTrue1 size) + -- , (SpaceO_1, benchIO "dropWhileM-true" ...) + , (SpaceO_1, benchIO "dropWhile-false" $ dropWhileFalse1 size) + , (SpaceO_1, benchIO "deleteBy" $ deleteBy1 size) + + , (SpaceO_1, benchIO "uniq" $ uniq1 size) + + -- Map and filter + , (SpaceO_1, benchIO "mapMaybe" $ mapMaybe1 size) + , (SpaceO_1, benchIO "mapMaybeM" $ mapMaybeM1 size) + + -- Searching (stateful map and filter) + , (SpaceO_1, benchIO "findIndices" $ findIndices1 size) + , (SpaceO_1, benchIO "elemIndices" $ elemIndices1 size) + , (SpaceO_1, benchIO "findIndex" $ findIndex size) + , (SpaceO_1, benchIO "elemIndex" $ elemIndex size) + , (SpaceO_1, benchIO "filter-even x 4" $ filterEven4 size) + , (SpaceO_1, benchIO "filter-all-out x 4" $ filterAllOut4 size) + , (SpaceO_1, benchIO "filter-all-in x 4" $ filterAllIn4 size) + + , (SpaceO_1, benchIO "filterM-even x 4" $ filterMEven4 size) + , (SpaceO_1, benchIO "filterM-all-out x 4" $ filterMAllOut4 size) + , (SpaceO_1, benchIO "filterM-all-in x 4" $ filterMAllIn4 size) + + , (SpaceO_1, benchIO "drop-one x 4" $ dropOne4 size) + , (SpaceO_1, benchIO "drop-all x 4" $ dropAll4 size) + , (SpaceO_1, benchIO "dropWhile-true x 4" $ dropWhileTrue4 size) + , (SpaceO_1, benchIO "dropWhileM-true x 4" $ dropWhileMTrue4 size) + -- XXX requires @-fspec-constr-recursive=12@. + , (SpaceO_1, benchIO "dropWhile-false x 4" $ dropWhileFalse4 size) + , (SpaceO_1, benchIO "deleteBy x 4" $ deleteBy4 size) + + , (SpaceO_1, benchIO "uniq x 4" $ uniq4 size) + + -- map and filter + , (SpaceO_1, benchIO "mapMaybe x 4" $ mapMaybe4 size) + , (SpaceO_1, benchIO "mapMaybeM x 4" $ mapMaybeM4 size) + + -- searching + , (SpaceO_1, benchIO "findIndices x 4" $ findIndices4 size) + , (SpaceO_1, benchIO "elemIndices x 4" $ elemIndices4 size) + , (SpaceO_1, benchIO "intersperse" $ intersperse1 size) + , (SpaceO_1, benchIO "intersperseM" $ intersperseM1 size) + , (SpaceO_1, benchIO "insertBy" $ insertBy1 size) + , (SpaceO_1, benchIO "interposeSuffix" $ interposeSuffix1 size) + , (SpaceO_1, benchIO "intercalateSuffix" $ intercalateSuffix1 size) + -- XXX requires @-fspec-constr-recursive=16@. + , (SpaceO_1, benchIO "intersperse x 4" $ intersperse4 size) + , (SpaceO_1, benchIO "insertBy x 4" $ insertBy4 size) + , (SpaceO_1, benchIO "indexed" $ indexed1 size) + , (SpaceO_1, benchIO "indexedR" $ indexedR1 size) + , (SpaceO_1, benchIO "indexed x 4" $ indexed4 size) + , (SpaceO_1, benchIO "indexedR x 4" $ indexedR4 size) + , (SpaceO_n, benchIO "iterated/(+) (n times) (baseline)" $ iteratePlusBaseline size) + , (SpaceO_n, benchIO "iterated/(<$) (n times)" $ iterateSubMap size) + , (SpaceO_n, benchIO "iterated/fmap (n times)" $ iterateFmap size) + {- + , benchIOSrc fromSerial "_(<$) (n times)" $ + _iterateSingleton (<$) value + , benchIOSrc fromSerial "_fmap (n times)" $ + _iterateSingleton (fmap . (+)) value + -} + -- Reversing a stream + , (HeapO_n, benchIO "reverse" $ reverse size) + , (HeapO_n, benchIO "reverse'" $ reverse' size) + ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs index 11824eeceb..4da5ee0ffb 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs @@ -523,56 +523,6 @@ inspect $ 'foldl'ReduceMap `hasNoType` ''FL.Step inspect $ 'foldl'ReduceMap `hasNoType` ''SPEC #endif -o_1_space_transformations_mixed :: Int -> [Benchmark] -o_1_space_transformations_mixed value = - -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl - -- library. If scan/fold followed by a map is efficient enough we may not - -- need monolithic implementations of these. - [ benchIO "scanl-map" $ scanMap1 value - , benchIO "drop-map" $ dropMap1 value - , benchIO "drop-scan" $ dropScan1 value - , benchIO "take-drop" $ takeDrop1 value - , benchIO "take-scan" $ takeScan1 value - , benchIO "take-map" $ takeMap1 value - , benchIO "filter-drop" $ filterDrop1 value - , benchIO "filter-take" $ filterTake1 value - , benchIO "filter-scan" $ filterScan1 value - , benchIO "filter-map" $ filterMap1 value - , benchIO "foldl-map" $ foldl'ReduceMap value - , benchIO "sum-product-fold" $ sumProductFold value - , benchIO "sum-product-scan" $ sumProductScan value - ] - -o_1_space_transformations_mixedX2 :: Int -> [Benchmark] -o_1_space_transformations_mixedX2 value = - [ benchIO "scan-map x 2" $ scanMap2 value - , benchIO "drop-map x 2" $ dropMap2 value - , benchIO "drop-scan x 2" $ dropScan2 value - , benchIO "take-drop x 2" $ takeDrop2 value - , benchIO "take-scan x 2" $ takeScan2 value - , benchIO "take-map x 2" $ takeMap2 value - , benchIO "filter-drop x 2" $ filterDrop2 value - , benchIO "filter-take x 2" $ filterTake2 value - , benchIO "filter-scan x 2" $ filterScan2 value - , benchIO "filter-scanl1 x 2" $ filterScanl12 value - , benchIO "filter-map x 2" $ filterMap2 value - ] - -o_1_space_transformations_mixedX4 :: Int -> [Benchmark] -o_1_space_transformations_mixedX4 value = - [ benchIO "scan-map x 4" $ scanMap4 value - , benchIO "drop-map x 4" $ dropMap4 value - , benchIO "drop-scan x 4" $ dropScan4 value - , benchIO "take-drop x 4" $ takeDrop4 value - , benchIO "take-scan x 4" $ takeScan4 value - , benchIO "take-map x 4" $ takeMap4 value - , benchIO "filter-drop x 4" $ filterDrop4 value - , benchIO "filter-take x 4" $ filterTake4 value - , benchIO "filter-scan x 4" $ filterScan4 value - , benchIO "filter-scanl1 x 4" $ filterScanl14 value - , benchIO "filter-map x 4" $ filterMap4 value - ] - ------------------------------------------------------------------------------- -- Iterating a transformation over and over again ------------------------------------------------------------------------------- @@ -622,18 +572,6 @@ iterateDropWhileFalse value iterCount = withRandomIntIO $ Common.drain . iterateSource (S.dropWhile (> (value + 1))) (value `div` iterCount) iterCount -o_n_stack_iterated :: Int -> [Benchmark] -o_n_stack_iterated value = - [ benchIO "iterated/mapM (n/10 x 10)" $ iterateMapM value 10 - , benchIO "iterated/scanl' (quadratic) (n/100 x 100)" $ iterateScan value 100 - , benchIO "iterated/scanl1' (n/10 x 10)" $ iterateScanl1 value 10 - , benchIO "iterated/filterEven (n/10 x 10)" $ iterateFilterEven value 10 - , benchIO "iterated/takeAll (n/10 x 10)" $ iterateTakeAll value 10 - , benchIO "iterated/dropOne (n/10 x 10)" $ iterateDropOne value 10 - , benchIO "iterated/dropWhileTrue (n/10 x 10)" $ iterateDropWhileTrue value 10 - , benchIO "iterated/dropWhileFalse (n/10 x 10)" $ iterateDropWhileFalse value 10 - ] - ------------------------------------------------------------------------------- -- Pipes ------------------------------------------------------------------------------- @@ -750,26 +688,6 @@ inspect $ 'pipeTeeX4 `hasNoType` ''FL.Step inspect $ 'pipeTeeX4 `hasNoType` ''SPEC #endif --- XXX these should move to Data.Pipe benchmarks -o_1_space_pipes :: Int -> [Benchmark] -o_1_space_pipes value = - [ benchIO "pipe/mapM" $ pipeMapM value - , benchIO "pipe/compose" $ pipeCompose value - , benchIO "pipe/tee" $ pipeTee value - -- XXX this take 1 GB memory to compile - -- , benchIO "zip" $ pipeZip value - ] - -o_1_space_pipesX4 :: Int -> [Benchmark] -o_1_space_pipesX4 value = - [ benchIO "pipe/mapM x 4" $ pipeMapMX4 value - , benchIO "pipe/compose x 4" $ pipeComposeX4 value - -- XXX requires @-fspec-constr-recursive=16@. - , benchIO "pipe/tee x 4" $ pipeTeeX4 value - -- XXX this take 1 GB memory to compile - -- , benchIO "zip x 4" $ pipeZipX4 value - ] - ------------------------------------------------------------------------------- -- Scans ------------------------------------------------------------------------------- @@ -846,21 +764,6 @@ inspect $ 'scansTeeX4 `hasNoType` ''FL.Step inspect $ 'scansTeeX4 `hasNoType` ''SPEC #endif --- XXX These should move to the Data.Scan module -o_1_space_scans :: Int -> [Benchmark] -o_1_space_scans value = - [ benchIO "scan/mapM" $ scansMapM value - , benchIO "scan/compose" $ scansCompose value - , benchIO "scan/tee" $ scansTee value - ] - -o_1_space_scansX4 :: Int -> [Benchmark] -o_1_space_scansX4 value = - [ benchIO "scan/mapM x 4" $ scansMapMX4 value - , benchIO "scan/compose x 4" $ scansComposeX4 value - , benchIO "scan/tee x 4" $ scansTeeX4 value - ] - ------------------------------------------------------------------------------- -- Composed transformations (scan + mapMaybe) ------------------------------------------------------------------------------- @@ -882,11 +785,6 @@ naivePrimeSieve value = withRandomIntIO $ \n -> Stream.fold FL.sum $ sieveScan $ Stream.enumerateFromTo 2 (value + n) -o_n_space_mapping :: Int -> [Benchmark] -o_n_space_mapping value = - [ benchIO "naive prime sieve" $ naivePrimeSieve value - ] - ------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- @@ -896,18 +794,74 @@ o_n_space_mapping value = -- benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = - map (SpaceO_1,) (Prelude.concat - [ o_1_space_transformations_mixed size - , o_1_space_transformations_mixedX2 size - , o_1_space_transformations_mixedX4 size - - -- pipes - , o_1_space_pipes size - , o_1_space_pipesX4 size - - -- scans - , o_1_space_scans size - , o_1_space_scansX4 size - ]) - ++ map (StackO_n,) (o_n_stack_iterated size) - ++ map (SpaceO_n,) (o_n_space_mapping size) + -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl + -- library. If scan/fold followed by a map is efficient enough we may not + -- need monolithic implementations of these. + [ (SpaceO_1, benchIO "scanl-map" $ scanMap1 size) + , (SpaceO_1, benchIO "drop-map" $ dropMap1 size) + , (SpaceO_1, benchIO "drop-scan" $ dropScan1 size) + , (SpaceO_1, benchIO "take-drop" $ takeDrop1 size) + , (SpaceO_1, benchIO "take-scan" $ takeScan1 size) + , (SpaceO_1, benchIO "take-map" $ takeMap1 size) + , (SpaceO_1, benchIO "filter-drop" $ filterDrop1 size) + , (SpaceO_1, benchIO "filter-take" $ filterTake1 size) + , (SpaceO_1, benchIO "filter-scan" $ filterScan1 size) + , (SpaceO_1, benchIO "filter-map" $ filterMap1 size) + , (SpaceO_1, benchIO "foldl-map" $ foldl'ReduceMap size) + , (SpaceO_1, benchIO "sum-product-fold" $ sumProductFold size) + , (SpaceO_1, benchIO "sum-product-scan" $ sumProductScan size) + , (SpaceO_1, benchIO "scan-map x 2" $ scanMap2 size) + , (SpaceO_1, benchIO "drop-map x 2" $ dropMap2 size) + , (SpaceO_1, benchIO "drop-scan x 2" $ dropScan2 size) + , (SpaceO_1, benchIO "take-drop x 2" $ takeDrop2 size) + , (SpaceO_1, benchIO "take-scan x 2" $ takeScan2 size) + , (SpaceO_1, benchIO "take-map x 2" $ takeMap2 size) + , (SpaceO_1, benchIO "filter-drop x 2" $ filterDrop2 size) + , (SpaceO_1, benchIO "filter-take x 2" $ filterTake2 size) + , (SpaceO_1, benchIO "filter-scan x 2" $ filterScan2 size) + , (SpaceO_1, benchIO "filter-scanl1 x 2" $ filterScanl12 size) + , (SpaceO_1, benchIO "filter-map x 2" $ filterMap2 size) + , (SpaceO_1, benchIO "scan-map x 4" $ scanMap4 size) + , (SpaceO_1, benchIO "drop-map x 4" $ dropMap4 size) + , (SpaceO_1, benchIO "drop-scan x 4" $ dropScan4 size) + , (SpaceO_1, benchIO "take-drop x 4" $ takeDrop4 size) + , (SpaceO_1, benchIO "take-scan x 4" $ takeScan4 size) + , (SpaceO_1, benchIO "take-map x 4" $ takeMap4 size) + , (SpaceO_1, benchIO "filter-drop x 4" $ filterDrop4 size) + , (SpaceO_1, benchIO "filter-take x 4" $ filterTake4 size) + , (SpaceO_1, benchIO "filter-scan x 4" $ filterScan4 size) + , (SpaceO_1, benchIO "filter-scanl1 x 4" $ filterScanl14 size) + , (SpaceO_1, benchIO "filter-map x 4" $ filterMap4 size) + + -- pipes + -- XXX these should move to Data.Pipe benchmarks + , (SpaceO_1, benchIO "pipe/mapM" $ pipeMapM size) + , (SpaceO_1, benchIO "pipe/compose" $ pipeCompose size) + , (SpaceO_1, benchIO "pipe/tee" $ pipeTee size) + -- XXX this take 1 GB memory to compile + -- , (SpaceO_1, benchIO "zip" $ pipeZip size) + , (SpaceO_1, benchIO "pipe/mapM x 4" $ pipeMapMX4 size) + , (SpaceO_1, benchIO "pipe/compose x 4" $ pipeComposeX4 size) + -- XXX requires @-fspec-constr-recursive=16@. + , (SpaceO_1, benchIO "pipe/tee x 4" $ pipeTeeX4 size) + -- XXX this take 1 GB memory to compile + -- , (SpaceO_1, benchIO "zip x 4" $ pipeZipX4 size) + -- XXX These should move to the Data.Scan module + -- scans + , (SpaceO_1, benchIO "scan/mapM" $ scansMapM size) + , (SpaceO_1, benchIO "scan/compose" $ scansCompose size) + , (SpaceO_1, benchIO "scan/tee" $ scansTee size) + , (SpaceO_1, benchIO "scan/mapM x 4" $ scansMapMX4 size) + , (SpaceO_1, benchIO "scan/compose x 4" $ scansComposeX4 size) + , (SpaceO_1, benchIO "scan/tee x 4" $ scansTeeX4 size) + + , (StackO_n, benchIO "iterated/mapM (n/10 x 10)" $ iterateMapM size 10) + , (StackO_n, benchIO "iterated/scanl' (quadratic) (n/100 x 100)" $ iterateScan size 100) + , (StackO_n, benchIO "iterated/scanl1' (n/10 x 10)" $ iterateScanl1 size 10) + , (StackO_n, benchIO "iterated/filterEven (n/10 x 10)" $ iterateFilterEven size 10) + , (StackO_n, benchIO "iterated/takeAll (n/10 x 10)" $ iterateTakeAll size 10) + , (StackO_n, benchIO "iterated/dropOne (n/10 x 10)" $ iterateDropOne size 10) + , (StackO_n, benchIO "iterated/dropWhileTrue (n/10 x 10)" $ iterateDropWhileTrue size 10) + , (StackO_n, benchIO "iterated/dropWhileFalse (n/10 x 10)" $ iterateDropWhileFalse size 10) + , (SpaceO_n, benchIO "naive prime sieve" $ naivePrimeSieve size) + ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Type.hs b/benchmark/Streamly/Benchmark/Data/Stream/Type.hs index 877096bb7d..7a6bfcdde9 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Type.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Type.hs @@ -446,43 +446,6 @@ _foldableMsum :: Int -> Int -> IO Int _foldableMsum value n = F.msum (sourceUnfoldrAction value n :: Stream Identity (IO Int)) -o_1_space_elimination_foldable :: Int -> [Benchmark] -o_1_space_elimination_foldable value = - -- Foldable instance - [ benchIO "Foldable/foldl'" $ withRandomInt (foldableFoldl' value) - , benchIO "Foldable/foldrElem" $ withRandomInt (foldableFoldrElem value) - -- , benchIO "Foldable/null" $ withRandomInt (_foldableNull value) - , benchIO "Foldable/elem" $ withRandomInt (foldableElem value) - , benchIO "Foldable/length" $ withRandomInt (foldableLength value) - , benchIO "Foldable/sum" $ withRandomInt (foldableSum value) - , benchIO "Foldable/product" $ withRandomInt (foldableProduct value) - , benchIO "Foldable/minimum" $ withRandomInt (foldableMin value) - , benchIO "Foldable/min (ord)" $ withRandomInt (ordInstanceMin value) - , benchIO "Foldable/maximum" $ withRandomInt (foldableMax value) - , benchIO "Foldable/minimumBy" $ withRandomInt (foldableMinBy value) - , benchIO "Foldable/maximumBy" $ withRandomInt (foldableMaxBy value) - , benchIO "Foldable/minimumByList" $ withRandomInt (foldableListMinBy value) - , benchIO "Foldable/length . toList" $ - withRandomInt (Prelude.length . foldableToList value) - , benchIO "Foldable/notElem" $ withRandomInt (foldableNotElem value) - , benchIO "Foldable/find" $ withRandomInt (foldableFind value) - , benchIO "Foldable/all" $ withRandomInt (foldableAll value) - , benchIO "Foldable/any" $ withRandomInt (foldableAny value) - , benchIO "Foldable/and" $ withRandomInt (foldableAnd value) - , benchIO "Foldable/or" $ withRandomInt (foldableOr value) - - -- Applicative and Traversable operations - -- TBD: traverse_ - , benchIO "Foldable/mapM_" $ withRandomIntIO (foldableMapM_ value) - -- TBD: for_ - -- TBD: forM_ - , benchIO "Foldable/sequence_" $ withRandomIntIO (foldableSequence_ value) - -- TBD: sequenceA_ - -- TBD: asum - -- XXX needs to be fixed, results are in ns - -- , benchIOSink1 "Foldable/msum" (foldableMsum value) - ] - ------------------------------------------------------------------------------- -- Show instance ------------------------------------------------------------------------------- @@ -495,16 +458,6 @@ showInstance value = withPureStream value show showInstanceList :: [Int] -> String showInstanceList = show -o_n_heap_elimination_show :: Int -> [Benchmark] -o_n_heap_elimination_show value = - -- Buffers the output of show/read. - -- XXX can the outputs be streaming? Can we have special read/show - -- style type classes, readM/showM supporting streaming effects? - [ bench "showsPrec Haskell lists" $ nf showInstanceList (mkList value) - -- XXX This is not o-1-space for GHC-8.10 - , benchIO "showsPrec pure streams" $ showInstance value - ] - ------------------------------------------------------------------------------- -- Eq and Ord instances ------------------------------------------------------------------------------- @@ -542,29 +495,6 @@ inspect $ 'ordInstance `hasNoType` ''Fold.Step inspect $ 'ordInstance `hasNoType` ''SPEC #endif -------------------------------------------------------------------------------- --- Generation -------------------------------------------------------------------------------- - -o_1_space_generation :: Int -> [Benchmark] -o_1_space_generation value = - [ benchIO "fromList" $ sourceFromList value - , benchIO "fromTuple" $ sourceFromTuple value - , benchIO "IsList.fromList" $ sourceIsList value - , benchIO "IsString.fromString" $ sourceIsString value - ] - -o_n_heap_generation :: Int -> [Benchmark] -o_n_heap_generation value = - -- Buffers the output of show/read. - -- XXX can the outputs be streaming? Can we have special read/show - -- style type classes, readM/showM supporting streaming effects? - [ bench "readsPrec pure streams" $ - nf (readInstance . mkString) value - , bench "readsPrec Haskell lists" $ - nf (readInstanceList . mkListString) value - ] - ------------------------------------------------------------------------------- -- Reductions ------------------------------------------------------------------------------- @@ -712,36 +642,6 @@ inspect $ 'drainN `hasNoType` ''Fold.Step inspect $ 'drainN `hasNoType` ''SPEC #endif -o_1_space_elimination_folds :: Int -> [Benchmark] -o_1_space_elimination_folds value = - [ benchIO "foldl'/IO" $ foldl'Reduce value - , benchIO "foldlM'/IO" $ foldlM'Reduce value - - , benchIO "foldl'/Identity" $ foldl'ReduceIdentity value - , benchIO "foldlM'/Identity" $ foldlM'ReduceIdentity value - - , benchIO "foldrMElem/IO" $ foldrMElem value - - , benchIO "foldrMElem/Identity" $ foldrMElemIdentity value - , benchIO "foldrMToList" $ foldrMToListIdentity value - - -- this is too fast, causes all benchmarks reported in ns - -- , benchIO "null" $ ... - - -- deconstruction - , benchIO "uncons" $ uncons value - , benchIO "foldBreak" $ foldBreak value - - -- draining - , benchIO "toNull" $ toNull value - , benchIO "drainN" $ drainN value - , benchIO "drain (pure)" $ drainPure value - - -- length is used to check for foldr/build fusion - , benchIO "length . IsList.toList" $ - withPureStream value (Prelude.length . GHC.toList) - ] - {-# INLINE foldl'Build #-} foldl'Build :: Int -> IO [Int] foldl'Build value = withStream value (S.foldl' (flip (:)) []) @@ -762,16 +662,6 @@ foldlM'BuildIdentity value = withPureStream value (runIdentity . S.foldlM' (\xs x -> return $ x : xs) (return [])) -o_n_heap_elimination_foldl :: Int -> [Benchmark] -o_n_heap_elimination_foldl value = - -- Left folds for building a structure are inherently non-streaming - -- as the structure cannot be lazily consumed until fully built. - [ benchIO "foldl'/build/IO" $ foldl'Build value - , benchIO "foldl'/build/Identity" $ foldl'BuildIdentity value - , benchIO "foldlM'/build/IO" $ foldlM'Build value - , benchIO "foldlM'/build/Identity" $ foldlM'BuildIdentity value - ] - {-# INLINE foldrMToSum #-} foldrMToSum :: Int -> IO Int foldrMToSum value = @@ -783,27 +673,10 @@ foldrMToSumIdentity value = withPureStream value (runIdentity . S.foldrM (\x xs -> (x +) <$> xs) (return 0)) -o_n_space_elimination_foldr :: Int -> [Benchmark] -o_n_space_elimination_foldr value = - -- Head recursive strict right folds. - -- accumulation due to strictness of IO monad - [ benchIO "foldrM/build/IO (toList)" $ foldrMToList value - -- Right folds for reducing are inherently non-streaming as the - -- expression needs to be fully built before it can be reduced. - , benchIO "foldrM/reduce/Identity (sum)" $ foldrMToSumIdentity value - , benchIO "foldrM/reduce/IO (sum)" $ foldrMToSum value - ] - {-# INLINE toList' #-} toList' :: Int -> IO [Int] toList' value = withStream value S.toList -o_n_space_elimination_toList :: Int -> [Benchmark] -o_n_space_elimination_toList value = - -- Converting the stream to a list or pure stream in a strict monad - [ benchIO "toList" $ toList' value - ] - {-# INLINE eqByPure #-} eqByPure :: Int -> IO Bool eqByPure value = @@ -828,15 +701,6 @@ inspect $ 'cmpByPure `hasNoType` ''S.Step inspect $ 'cmpByPure `hasNoType` ''Fold.Step #endif -o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark] -o_1_space_elimination_multi_stream_pure value = - [ benchIO "==" $ eqInstance value - , benchIO "/=" $ eqInstanceNotEq value - , benchIO "<" $ ordInstance value - , benchIO "eqBy (pure)" $ eqByPure value - , benchIO "cmpBy (pure)" $ cmpByPure value - ] - {-# INLINE eqBy #-} eqBy :: Int -> IO Bool eqBy value = withStream value $ \src -> S.eqBy (==) src src @@ -859,12 +723,6 @@ inspect $ 'cmpBy `hasNoType` ''S.Step inspect $ 'cmpBy `hasNoType` ''Fold.Step #endif -o_1_space_elimination_multi_stream :: Int -> [Benchmark] -o_1_space_elimination_multi_stream value = - [ benchIO "eqBy" $ eqBy value - , benchIO "cmpBy" $ cmpBy value - ] - ------------------------------------------------------------------------------- -- Mapping ------------------------------------------------------------------------------- @@ -921,24 +779,6 @@ inspect $ 'mapM4 `hasNoType` ''FL.Step inspect $ 'mapM4 `hasNoType` ''SPEC #endif -o_1_space_functor :: Int -> [Benchmark] -o_1_space_functor value = - [ benchIO "fmap" $ map1 value - , benchIO "fmap x 4" $ mapN4 value - ] - -o_1_space_mapping :: Int -> [Benchmark] -o_1_space_mapping value = - [ benchIO "map" $ map1 value - , benchIO "mapM" $ mapM1 value - ] - -o_1_space_mappingX4 :: Int -> [Benchmark] -o_1_space_mappingX4 value = - [ benchIO "map x 4" $ mapN4 value - , benchIO "mapM x 4" $ mapM4 value - ] - ------------------------------------------------------------------------------- -- Filtering ------------------------------------------------------------------------------- @@ -1014,22 +854,6 @@ inspect $ 'takeWhileMTrue4 `hasNoType` ''FL.Step inspect $ 'takeWhileMTrue4 `hasNoType` ''SPEC #endif -o_1_space_filtering :: Int -> [Benchmark] -o_1_space_filtering value = - [ -- Trimming - benchIO "take-all" $ takeAll1 value - , benchIO "takeWhile-true" $ takeWhileTrue1 value - -- , benchIO "takeWhileM-true" ... - ] - -o_1_space_filteringX4 :: Int -> [Benchmark] -o_1_space_filteringX4 value = - [ -- trimming - benchIO "take-all x 4" $ takeAll4 value - , benchIO "takeWhile-true x 4" $ takeWhileTrue4 value - , benchIO "takeWhileM-true x 4" $ takeWhileMTrue4 value - ] - ------------------------------------------------------------------------------- -- Multi-stream ------------------------------------------------------------------------------- @@ -1102,15 +926,6 @@ inspect $ 'zipWithM `hasNoType` ''SPEC inspect $ 'zipWithM `hasNoType` ''Fold.Step #endif -o_1_space_joining :: Int -> [Benchmark] -o_1_space_joining value = - [ benchIO "serial" $ serial2 (value `div` 2) - , benchIO "serial (2,2,x/4)" $ serial4 (value `div` 4) - , benchIO "zipWith" $ zipWith value - , benchIO "zipWithM" $ zipWithM value - , benchIO "concatMap" $ concatMap 2 (value `div` 2) - ] - ------------------------------------------------------------------------------- -- Concat ------------------------------------------------------------------------------- @@ -1281,58 +1096,6 @@ inspect $ 'unfoldCross `hasNoType` ''Fold.Step inspect $ 'unfoldCross `hasNoType` ''SPEC #endif -o_1_space_concat :: Int -> [Benchmark] -o_1_space_concat value = sqrtVal `seq` - [ benchIO "concatMap unfoldr outer=Max inner=1" $ concatMapPure value 1 - , benchIO "concatMap unfoldr outer=inner=(sqrt Max)" $ concatMapPure sqrtVal sqrtVal - , benchIO "concatMap unfoldr outer=1 inner=Max" $ concatMapPure 1 value - - , benchIO "concatMap unfoldrM outer=max inner=1" $ concatMap value 1 - , benchIO "concatMap unfoldrM outer=inner=(sqrt Max)" $ concatMap sqrtVal sqrtVal - , benchIO "concatMap unfoldrM outer=1 inner=Max" $ concatMap 1 value - - -- Using boxed values/streams may have entirely different perf profile - , benchIO "concatMap Streams fromPure outer=max inner=1" $ - concatMapSingletonStreams value - , benchIO "concatMap Streams unfoldr outer=max inner=1" $ - concatMapStreams value 1 - , benchIO "concatMap Streams unfoldr outer=inner=(sqrt Max)" $ - concatMapStreams sqrtVal sqrtVal - , benchIO "concatMap Streams unfoldr outer=1 inner=Max" $ - concatMapStreams 1 value - - , benchIO "concatMapM unfoldrM outer=max inner=1" $ concatMapM value 1 - , benchIO "concatMapM unfoldrM outer=inner=(sqrt Max)" $ concatMapM sqrtVal sqrtVal - , benchIO "concatMapM unfoldrM outer=1 inner=Max" $ concatMapM 1 value - - , benchIO "concatMapM2 fromPure" $ concatMapM2 sqrtVal - , benchIO "concatMapM3 fromPure" $ concatMapM3 cubertVal - - , benchIO "concatMapViaUnfoldEach outer=max inner=1" $ concatMapViaUnfoldEach value 1 - , benchIO "concatMapViaUnfoldEach outer=inner=(sqrt Max)" $ concatMapViaUnfoldEach sqrtVal sqrtVal - , benchIO "concatMapViaUnfoldEach outer=1 inner=Max" $ concatMapViaUnfoldEach 1 value - - , benchIO "unfoldCross outer=max inner=1" $ unfoldCross value 1 - , benchIO "unfoldCross outer=inner=(sqrt Max)" $ unfoldCross sqrtVal sqrtVal - , benchIO "unfoldCross outer=1 inner=Max" $ unfoldCross 1 value - - -- concatMap vs unfoldEach - , benchIO "unfoldEach outer=Max inner=1" $ unfoldEach value 1 - , benchIO "unfoldEach outer=inner=(sqrt Max)" $ unfoldEach sqrtVal sqrtVal - , benchIO "unfoldEach outer=1 inner=Max" $ unfoldEach 1 value - - , benchIO "unfoldEach2 outer=Max inner=1" $ unfoldEach2 value 1 - , benchIO "unfoldEach2 outer=inner=(sqrt Max)" $ unfoldEach2 sqrtVal sqrtVal - , benchIO "unfoldEach2 outer=1 inner=Max" $ unfoldEach2 1 value - - , benchIO "unfoldEach3 outer=inner=(cubert Max)" $ unfoldEach3 value - ] - - where - - sqrtVal = round $ sqrt (fromIntegral value :: Double) - cubertVal = round (fromIntegral value**(1/3::Double)) -- triple nested loop - ------------------------------------------------------------------------------- -- Applicative ------------------------------------------------------------------------------- @@ -1442,44 +1205,10 @@ crossApplySnd linearCount = withRandomIntIO $ \start -> drain $ nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) -o_1_space_applicative :: Int -> [Benchmark] -o_1_space_applicative value = - [ benchIO "(*>)" $ withRandomIntIO (apDiscardFst value) - , benchIO "(<*)" $ withRandomIntIO (apDiscardSnd value) - , benchIO "(<*>)" $ withRandomIntIO (toNullAp value) - , benchIO "liftA2" $ withRandomIntIO (apLiftA2 value) - , benchIO "crossApply" $ crossApply value - , benchIO "crossApplyFst" $ crossApplyFst value - , benchIO "crossApplySnd" $ crossApplySnd value - , benchIO "pureDrain2" $ withRandomIntIO (toNullApPure value) - , benchIO "pureCross2" $ cross2 value - ] - ------------------------------------------------------------------------------- -- Monad ------------------------------------------------------------------------------- -o_1_space_monad :: Int -> [Benchmark] -o_1_space_monad value = - [ benchIO "then2M" $ withRandomIntIO (monadThen value) - , benchIO "drain2M" $ withRandomIntIO (toNullM value) - , benchIO "drain3M" $ withRandomIntIO (toNullM3 value) - , benchIO "filterAllOut2M" $ withRandomIntIO (filterAllOutM value) - , benchIO "filterAllIn2M" $ withRandomIntIO (filterAllInM value) - , benchIO "filterSome2M" $ withRandomIntIO (filterSome value) - , benchIO "breakAfterSome2M" $ withRandomIntIO (breakAfterSome value) - , benchIO "pureDrain2M" $ withRandomIntIO (toNullMPure value) - , benchIO "pureDrain3M" $ withRandomIntIO (toNullM3Pure value) - , benchIO "pureFilterAllIn2M" $ withRandomIntIO (filterAllInMPure value) - , benchIO "pureFilterAllOut2M" $ withRandomIntIO (filterAllOutMPure value) - ] - -o_n_space_monad :: Int -> [Benchmark] -o_n_space_monad value = - [ benchIO "toList2M" $ withRandomIntIO (toListM value) - , benchIO "toListSome2M" $ withRandomIntIO (toListSome value) - ] - {-# INLINE drainConcatFor1 #-} drainConcatFor1 :: Int -> IO () drainConcatFor1 count = withStream count $ \s -> @@ -1563,26 +1292,6 @@ filterAllOutConcatFor count = withStream count $ \s -> then Stream.fromPure s1 else Stream.nil -o_1_space_bind :: Int -> [Benchmark] -o_1_space_bind streamLen = - [ benchIO "concatFor/drain1" $ drainConcatFor1 streamLen - , benchIO "concatFor/drain2" $ drainConcatFor streamLen2 - , benchIO "concatFor/drain3" $ drainConcatFor3 streamLen3 - , benchIO "concatFor/drain4" $ drainConcatFor4 streamLen4 - , benchIO "concatFor/drain5" $ drainConcatFor5 streamLen5 - , benchIO "concatFor/drainM2" $ drainConcatForM streamLen2 - , benchIO "concatFor/drainM3" $ drainConcatFor3M streamLen3 - , benchIO "concatFor/filterAllIn2" $ filterAllInConcatFor streamLen2 - , benchIO "concatFor/filterAllOut2" $ filterAllOutConcatFor streamLen2 - ] - - where - - streamLen2 = round (fromIntegral streamLen**(1/2::Double)) -- double nested loop - streamLen3 = round (fromIntegral streamLen**(1/3::Double)) -- triple nested loop - streamLen4 = round (fromIntegral streamLen**(1/4::Double)) -- 4 times nested loop - streamLen5 = round (fromIntegral streamLen**(1/5::Double)) -- 5 times nested loop - -- search space |x| = 1000, |y| = 1000 {-# INLINE boundedInts #-} boundedInts :: Monad m => Int -> Int -> Stream m Int @@ -1683,20 +1392,6 @@ unfoldEachBounded :: Int -> IO () unfoldEachBounded maxVal = withRandomIntIO $ \n -> unfoldEachEqn maxVal (boundedIntsUnfold maxVal 0) (boundedInts maxVal n) --- Solve simultaneous equations by exploring all possibilities -o_1_space_equations :: Int -> [Benchmark] -o_1_space_equations value = - [ benchIO "equations/concatFor (bounded)" $ concatForBounded sqrtVal - , benchIO "equations/streamCross (bounded)" $ streamCrossBounded sqrtVal - , benchIO "equations/fairStreamCross (bounded)" $ fairStreamCrossBounded sqrtVal - , benchIO "equations/fairStreamCross (infinite)" $ fairStreamCrossInfinite sqrtVal - , benchIO "equations/unfoldEach (bounded)" $ unfoldEachBounded sqrtVal - ] - - where - - sqrtVal = round $ sqrt (fromIntegral value :: Double) - ------------------------------------------------------------------------------- -- Fold Many ------------------------------------------------------------------------------- @@ -1771,14 +1466,6 @@ inspect $ 'refoldIterateM `hasNoType` ''Refold.Tuple'Fused inspect $ 'refoldIterateM `hasNoType` ''SPEC #endif -o_1_space_grouping :: Int -> [Benchmark] -o_1_space_grouping value = - [ benchIO "foldMany" $ foldMany value - , benchIO "foldMany1" $ foldMany1 value - , benchIO "refoldMany" $ refoldMany value - , benchIO "refoldIterateM" $ refoldIterateM value - ] - ------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- @@ -1790,31 +1477,228 @@ o_1_space_grouping value = benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = -- Construction - map (SpaceO_1,) (o_1_space_generation size) - ++ map (HeapO_n,) (o_n_heap_generation size) + [ (SpaceO_1, benchIO "fromList" $ sourceFromList size) + , (SpaceO_1, benchIO "fromTuple" $ sourceFromTuple size) + , (SpaceO_1, benchIO "IsList.fromList" $ sourceIsList size) + , (SpaceO_1, benchIO "IsString.fromString" $ sourceIsString size) + -- Buffers the output of show/read. + -- XXX can the outputs be streaming? Can we have special read/show + -- style type classes, readM/showM supporting streaming effects? + , (HeapO_n, bench "readsPrec pure streams" $ + nf (readInstance . mkString) size) + , (HeapO_n, bench "readsPrec Haskell lists" $ + nf (readInstanceList . mkListString) size) -- Elimination - ++ map (SpaceO_1,) (o_1_space_elimination_foldable size) - ++ map (SpaceO_1,) (o_1_space_elimination_folds size) - ++ map (HeapO_n,) (o_n_heap_elimination_foldl size) - ++ map (HeapO_n,) (o_n_heap_elimination_show size) - ++ map (SpaceO_n,) (o_n_space_elimination_foldr size) - ++ map (SpaceO_n,) (o_n_space_elimination_toList size) - ++ map (SpaceO_1,) (o_1_space_elimination_multi_stream_pure size) - ++ map (SpaceO_1,) (o_1_space_elimination_multi_stream size) + -- Foldable instance + , (SpaceO_1, benchIO "Foldable/foldl'" $ withRandomInt (foldableFoldl' size)) + , (SpaceO_1, benchIO "Foldable/foldrElem" $ withRandomInt (foldableFoldrElem size)) + -- , (SpaceO_1, benchIO "Foldable/null" $ withRandomInt (_foldableNull size)) + , (SpaceO_1, benchIO "Foldable/elem" $ withRandomInt (foldableElem size)) + , (SpaceO_1, benchIO "Foldable/length" $ withRandomInt (foldableLength size)) + , (SpaceO_1, benchIO "Foldable/sum" $ withRandomInt (foldableSum size)) + , (SpaceO_1, benchIO "Foldable/product" $ withRandomInt (foldableProduct size)) + , (SpaceO_1, benchIO "Foldable/minimum" $ withRandomInt (foldableMin size)) + , (SpaceO_1, benchIO "Foldable/min (ord)" $ withRandomInt (ordInstanceMin size)) + , (SpaceO_1, benchIO "Foldable/maximum" $ withRandomInt (foldableMax size)) + , (SpaceO_1, benchIO "Foldable/minimumBy" $ withRandomInt (foldableMinBy size)) + , (SpaceO_1, benchIO "Foldable/maximumBy" $ withRandomInt (foldableMaxBy size)) + , (SpaceO_1, benchIO "Foldable/minimumByList" $ withRandomInt (foldableListMinBy size)) + , (SpaceO_1, benchIO "Foldable/length . toList" $ + withRandomInt (Prelude.length . foldableToList size)) + , (SpaceO_1, benchIO "Foldable/notElem" $ withRandomInt (foldableNotElem size)) + , (SpaceO_1, benchIO "Foldable/find" $ withRandomInt (foldableFind size)) + , (SpaceO_1, benchIO "Foldable/all" $ withRandomInt (foldableAll size)) + , (SpaceO_1, benchIO "Foldable/any" $ withRandomInt (foldableAny size)) + , (SpaceO_1, benchIO "Foldable/and" $ withRandomInt (foldableAnd size)) + , (SpaceO_1, benchIO "Foldable/or" $ withRandomInt (foldableOr size)) + + -- Applicative and Traversable operations + -- TBD: traverse_ + , (SpaceO_1, benchIO "Foldable/mapM_" $ withRandomIntIO (foldableMapM_ size)) + -- TBD: for_ + -- TBD: forM_ + , (SpaceO_1, benchIO "Foldable/sequence_" $ withRandomIntIO (foldableSequence_ size)) + -- TBD: sequenceA_ + -- TBD: asum + -- XXX needs to be fixed, results are in ns + -- , (SpaceO_1, benchIOSink1 "Foldable/msum" (foldableMsum size)) + , (SpaceO_1, benchIO "foldl'/IO" $ foldl'Reduce size) + , (SpaceO_1, benchIO "foldlM'/IO" $ foldlM'Reduce size) + + , (SpaceO_1, benchIO "foldl'/Identity" $ foldl'ReduceIdentity size) + , (SpaceO_1, benchIO "foldlM'/Identity" $ foldlM'ReduceIdentity size) + + , (SpaceO_1, benchIO "foldrMElem/IO" $ foldrMElem size) + + , (SpaceO_1, benchIO "foldrMElem/Identity" $ foldrMElemIdentity size) + , (SpaceO_1, benchIO "foldrMToList" $ foldrMToListIdentity size) + + -- this is too fast, causes all benchmarks reported in ns + -- , (SpaceO_1, benchIO "null" $ ...) + + -- deconstruction + , (SpaceO_1, benchIO "uncons" $ uncons size) + , (SpaceO_1, benchIO "foldBreak" $ foldBreak size) + + -- draining + , (SpaceO_1, benchIO "toNull" $ toNull size) + , (SpaceO_1, benchIO "drainN" $ drainN size) + , (SpaceO_1, benchIO "drain (pure)" $ drainPure size) + + -- length is used to check for foldr/build fusion + , (SpaceO_1, benchIO "length . IsList.toList" $ + withPureStream size (Prelude.length . GHC.toList)) + -- Left folds for building a structure are inherently non-streaming + -- as the structure cannot be lazily consumed until fully built. + , (HeapO_n, benchIO "foldl'/build/IO" $ foldl'Build size) + , (HeapO_n, benchIO "foldl'/build/Identity" $ foldl'BuildIdentity size) + , (HeapO_n, benchIO "foldlM'/build/IO" $ foldlM'Build size) + , (HeapO_n, benchIO "foldlM'/build/Identity" $ foldlM'BuildIdentity size) + -- Buffers the output of show/read. + -- XXX can the outputs be streaming? Can we have special read/show + -- style type classes, readM/showM supporting streaming effects? + , (HeapO_n, bench "showsPrec Haskell lists" $ nf showInstanceList (mkList size)) + -- XXX This is not o-1-space for GHC-8.10 + , (HeapO_n, benchIO "showsPrec pure streams" $ showInstance size) + -- Head recursive strict right folds. + -- accumulation due to strictness of IO monad + , (SpaceO_n, benchIO "foldrM/build/IO (toList)" $ foldrMToList size) + -- Right folds for reducing are inherently non-streaming as the + -- expression needs to be fully built before it can be reduced. + , (SpaceO_n, benchIO "foldrM/reduce/Identity (sum)" $ foldrMToSumIdentity size) + , (SpaceO_n, benchIO "foldrM/reduce/IO (sum)" $ foldrMToSum size) + -- Converting the stream to a list or pure stream in a strict monad + , (SpaceO_n, benchIO "toList" $ toList' size) + , (SpaceO_1, benchIO "==" $ eqInstance size) + , (SpaceO_1, benchIO "/=" $ eqInstanceNotEq size) + , (SpaceO_1, benchIO "<" $ ordInstance size) + , (SpaceO_1, benchIO "eqBy (pure)" $ eqByPure size) + , (SpaceO_1, benchIO "cmpBy (pure)" $ cmpByPure size) + , (SpaceO_1, benchIO "eqBy" $ eqBy size) + , (SpaceO_1, benchIO "cmpBy" $ cmpBy size) -- Mapping - ++ map (SpaceO_1,) (o_1_space_functor size) - ++ map (SpaceO_1,) (o_1_space_mapping size) - ++ map (SpaceO_1,) (o_1_space_mappingX4 size) + , (SpaceO_1, benchIO "fmap" $ map1 size) + , (SpaceO_1, benchIO "fmap x 4" $ mapN4 size) + , (SpaceO_1, benchIO "map" $ map1 size) + , (SpaceO_1, benchIO "mapM" $ mapM1 size) + , (SpaceO_1, benchIO "map x 4" $ mapN4 size) + , (SpaceO_1, benchIO "mapM x 4" $ mapM4 size) -- Filtering - ++ map (SpaceO_1,) (o_1_space_filtering size) - ++ map (SpaceO_1,) (o_1_space_filteringX4 size) + -- Trimming + , (SpaceO_1, benchIO "take-all" $ takeAll1 size) + , (SpaceO_1, benchIO "takeWhile-true" $ takeWhileTrue1 size) + -- , (SpaceO_1, benchIO "takeWhileM-true" ...) + -- trimming + , (SpaceO_1, benchIO "take-all x 4" $ takeAll4 size) + , (SpaceO_1, benchIO "takeWhile-true x 4" $ takeWhileTrue4 size) + , (SpaceO_1, benchIO "takeWhileM-true x 4" $ takeWhileMTrue4 size) -- Multi-stream - ++ map (SpaceO_1,) (o_1_space_joining size) - ++ map (SpaceO_1,) (o_1_space_concat size) - ++ map (SpaceO_1,) (o_1_space_applicative size) - ++ map (SpaceO_1,) (o_1_space_monad size) - ++ map (SpaceO_n,) (o_n_space_monad size) - ++ map (SpaceO_1,) (o_1_space_bind size) - ++ map (SpaceO_1,) (o_1_space_equations size) + , (SpaceO_1, benchIO "serial" $ serial2 (size `div` 2)) + , (SpaceO_1, benchIO "serial (2,2,x/4)" $ serial4 (size `div` 4)) + , (SpaceO_1, benchIO "zipWith" $ zipWith size) + , (SpaceO_1, benchIO "zipWithM" $ zipWithM size) + , (SpaceO_1, benchIO "concatMap" $ concatMap 2 (size `div` 2)) + , (SpaceO_1, benchIO "concatMap unfoldr outer=Max inner=1" $ + concatMapPure size 1) + , (SpaceO_1, benchIO "concatMap unfoldr outer=inner=(sqrt Max)" $ + concatMapPure sqrtVal sqrtVal) + , (SpaceO_1, benchIO "concatMap unfoldr outer=1 inner=Max" $ + concatMapPure 1 size) + , (SpaceO_1, benchIO "concatMap unfoldrM outer=max inner=1" $ + concatMap size 1) + , (SpaceO_1, benchIO "concatMap unfoldrM outer=inner=(sqrt Max)" $ + concatMap sqrtVal sqrtVal) + , (SpaceO_1, benchIO "concatMap unfoldrM outer=1 inner=Max" $ + concatMap 1 size) + -- Using boxed values/streams may have entirely different perf profile + , (SpaceO_1, benchIO "concatMap Streams fromPure outer=max inner=1" $ + concatMapSingletonStreams size) + , (SpaceO_1, benchIO "concatMap Streams unfoldr outer=max inner=1" $ + concatMapStreams size 1) + , (SpaceO_1, benchIO "concatMap Streams unfoldr outer=inner=(sqrt Max)" $ + concatMapStreams sqrtVal sqrtVal) + , (SpaceO_1, benchIO "concatMap Streams unfoldr outer=1 inner=Max" $ + concatMapStreams 1 size) + , (SpaceO_1, benchIO "concatMapM unfoldrM outer=max inner=1" $ + concatMapM size 1) + , (SpaceO_1, benchIO "concatMapM unfoldrM outer=inner=(sqrt Max)" $ + concatMapM sqrtVal sqrtVal) + , (SpaceO_1, benchIO "concatMapM unfoldrM outer=1 inner=Max" $ + concatMapM 1 size) + , (SpaceO_1, benchIO "concatMapM2 fromPure" $ concatMapM2 sqrtVal) + , (SpaceO_1, benchIO "concatMapM3 fromPure" $ concatMapM3 cubertVal) + , (SpaceO_1, benchIO "concatMapViaUnfoldEach outer=max inner=1" $ + concatMapViaUnfoldEach size 1) + , (SpaceO_1, benchIO "concatMapViaUnfoldEach outer=inner=(sqrt Max)" $ + concatMapViaUnfoldEach sqrtVal sqrtVal) + , (SpaceO_1, benchIO "concatMapViaUnfoldEach outer=1 inner=Max" $ + concatMapViaUnfoldEach 1 size) + , (SpaceO_1, benchIO "unfoldCross outer=max inner=1" $ unfoldCross size 1) + , (SpaceO_1, benchIO "unfoldCross outer=inner=(sqrt Max)" $ + unfoldCross sqrtVal sqrtVal) + , (SpaceO_1, benchIO "unfoldCross outer=1 inner=Max" $ unfoldCross 1 size) + -- concatMap vs unfoldEach + , (SpaceO_1, benchIO "unfoldEach outer=Max inner=1" $ unfoldEach size 1) + , (SpaceO_1, benchIO "unfoldEach outer=inner=(sqrt Max)" $ + unfoldEach sqrtVal sqrtVal) + , (SpaceO_1, benchIO "unfoldEach outer=1 inner=Max" $ unfoldEach 1 size) + , (SpaceO_1, benchIO "unfoldEach2 outer=Max inner=1" $ unfoldEach2 size 1) + , (SpaceO_1, benchIO "unfoldEach2 outer=inner=(sqrt Max)" $ + unfoldEach2 sqrtVal sqrtVal) + , (SpaceO_1, benchIO "unfoldEach2 outer=1 inner=Max" $ unfoldEach2 1 size) + , (SpaceO_1, benchIO "unfoldEach3 outer=inner=(cubert Max)" $ unfoldEach3 size) + , (SpaceO_1, benchIO "(*>)" $ withRandomIntIO (apDiscardFst size)) + , (SpaceO_1, benchIO "(<*)" $ withRandomIntIO (apDiscardSnd size)) + , (SpaceO_1, benchIO "(<*>)" $ withRandomIntIO (toNullAp size)) + , (SpaceO_1, benchIO "liftA2" $ withRandomIntIO (apLiftA2 size)) + , (SpaceO_1, benchIO "crossApply" $ crossApply size) + , (SpaceO_1, benchIO "crossApplyFst" $ crossApplyFst size) + , (SpaceO_1, benchIO "crossApplySnd" $ crossApplySnd size) + , (SpaceO_1, benchIO "pureDrain2" $ withRandomIntIO (toNullApPure size)) + , (SpaceO_1, benchIO "pureCross2" $ cross2 size) + , (SpaceO_1, benchIO "then2M" $ withRandomIntIO (monadThen size)) + , (SpaceO_1, benchIO "drain2M" $ withRandomIntIO (toNullM size)) + , (SpaceO_1, benchIO "drain3M" $ withRandomIntIO (toNullM3 size)) + , (SpaceO_1, benchIO "filterAllOut2M" $ withRandomIntIO (filterAllOutM size)) + , (SpaceO_1, benchIO "filterAllIn2M" $ withRandomIntIO (filterAllInM size)) + , (SpaceO_1, benchIO "filterSome2M" $ withRandomIntIO (filterSome size)) + , (SpaceO_1, benchIO "breakAfterSome2M" $ withRandomIntIO (breakAfterSome size)) + , (SpaceO_1, benchIO "pureDrain2M" $ withRandomIntIO (toNullMPure size)) + , (SpaceO_1, benchIO "pureDrain3M" $ withRandomIntIO (toNullM3Pure size)) + , (SpaceO_1, benchIO "pureFilterAllIn2M" $ withRandomIntIO (filterAllInMPure size)) + , (SpaceO_1, benchIO "pureFilterAllOut2M" $ withRandomIntIO (filterAllOutMPure size)) + , (SpaceO_n, benchIO "toList2M" $ withRandomIntIO (toListM size)) + , (SpaceO_n, benchIO "toListSome2M" $ withRandomIntIO (toListSome size)) + , (SpaceO_1, benchIO "concatFor/drain1" $ drainConcatFor1 size) + , (SpaceO_1, benchIO "concatFor/drain2" $ drainConcatFor sqrtVal) + , (SpaceO_1, benchIO "concatFor/drain3" $ drainConcatFor3 cubertVal) + , (SpaceO_1, benchIO "concatFor/drain4" $ drainConcatFor4 size4) + , (SpaceO_1, benchIO "concatFor/drain5" $ drainConcatFor5 size5) + , (SpaceO_1, benchIO "concatFor/drainM2" $ drainConcatForM sqrtVal) + , (SpaceO_1, benchIO "concatFor/drainM3" $ drainConcatFor3M cubertVal) + , (SpaceO_1, benchIO "concatFor/filterAllIn2" $ filterAllInConcatFor sqrtVal) + , (SpaceO_1, benchIO "concatFor/filterAllOut2" $ filterAllOutConcatFor sqrtVal) + -- Solve simultaneous equations by exploring all possibilities + , (SpaceO_1, benchIO "equations/concatFor (bounded)" $ + concatForBounded sqrtVal) + , (SpaceO_1, benchIO "equations/streamCross (bounded)" $ + streamCrossBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairStreamCross (bounded)" $ + fairStreamCrossBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairStreamCross (infinite)" $ + fairStreamCrossInfinite sqrtVal) + , (SpaceO_1, benchIO "equations/unfoldEach (bounded)" $ + unfoldEachBounded sqrtVal) -- Fold Many - ++ map (SpaceO_1,) (o_1_space_grouping size) + , (SpaceO_1, benchIO "foldMany" $ foldMany size) + , (SpaceO_1, benchIO "foldMany1" $ foldMany1 size) + , (SpaceO_1, benchIO "refoldMany" $ refoldMany size) + , (SpaceO_1, benchIO "refoldIterateM" $ refoldIterateM size) + ] + + where + + sqrtVal = round $ sqrt (fromIntegral size :: Double) -- double nested loop + cubertVal = round (fromIntegral size**(1/3::Double)) -- triple nested loop + size4 = round (fromIntegral size**(1/4::Double)) -- 4 times nested loop + size5 = round (fromIntegral size**(1/5::Double)) -- 5 times nested loop From ec8b558aa66afb3bd37c68d27eba4c8ddc6c1eb8 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sat, 13 Jun 2026 19:10:07 +0530 Subject: [PATCH 04/20] Remove INLINE from IO action benchmarks in Data.Stream --- .../Benchmark/Data/Stream/Eliminate.hs | 31 -------- .../Benchmark/Data/Stream/Generate.hs | 19 ----- .../Streamly/Benchmark/Data/Stream/Lift.hs | 4 - .../Streamly/Benchmark/Data/Stream/Nesting.hs | 33 +++------ .../Benchmark/Data/Stream/Parse/Group.hs | 6 -- .../Benchmark/Data/Stream/Transform/Basic.hs | 70 ------------------ .../Data/Stream/Transform/Composed.hs | 56 -------------- .../Streamly/Benchmark/Data/Stream/Type.hs | 73 ------------------- 8 files changed, 10 insertions(+), 282 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs b/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs index c1d7a65e66..bd617e79d3 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs @@ -50,7 +50,6 @@ import qualified Prelude -- Reductions ------------------------------------------------------------------------------- -{-# INLINE streamInit #-} streamInit :: Int -> IO () streamInit value = withStream value (S.init >=> Prelude.mapM_ S.drain) @@ -61,7 +60,6 @@ inspect $ 'streamInit `hasNoType` ''Fold.Step inspect $ 'streamInit `hasNoType` ''SPEC #endif -{-# INLINE mapM_ #-} mapM_ :: Int -> IO () mapM_ value = withStream value (S.mapM_ (\_ -> return ())) @@ -72,7 +70,6 @@ inspect $ 'mapM_ `hasNoType` ''Fold.Step inspect $ 'mapM_ `hasNoType` ''SPEC #endif -{-# INLINE streamLast #-} streamLast :: Int -> IO (Maybe Int) streamLast value = withStream value S.last @@ -83,7 +80,6 @@ inspect $ 'streamLast `hasNoType` ''Fold.Step inspect $ 'streamLast `hasNoType` ''SPEC #endif -{-# INLINE foldl1'Reduce #-} foldl1'Reduce :: Int -> IO (Maybe Int) foldl1'Reduce value = withStream value (S.fold (Fold.foldl1' (+))) @@ -92,7 +88,6 @@ inspect $ hasNoTypeClasses 'foldl1'Reduce inspect $ 'foldl1'Reduce `hasNoType` ''S.Step #endif -{-# INLINE foldl1'ReduceIdentity #-} foldl1'ReduceIdentity :: Int -> IO (Maybe Int) foldl1'ReduceIdentity value = withPureStream value (runIdentity . S.fold (Fold.foldl1' (+))) @@ -102,7 +97,6 @@ inspect $ hasNoTypeClasses 'foldl1'ReduceIdentity inspect $ 'foldl1'ReduceIdentity `hasNoType` ''S.Step #endif -{-# INLINE elem #-} elem :: Int -> IO Bool elem value = withStream value (S.elem (value + 1)) @@ -113,7 +107,6 @@ inspect $ 'elem `hasNoType` ''Fold.Step inspect $ 'elem `hasNoType` ''SPEC #endif -{-# INLINE notElem #-} notElem :: Int -> IO Bool notElem value = withStream value (S.notElem (value + 1)) @@ -124,7 +117,6 @@ inspect $ 'notElem `hasNoType` ''Fold.Step inspect $ 'notElem `hasNoType` ''SPEC #endif -{-# INLINE length #-} length :: Int -> IO Int length value = withStream value (S.fold Fold.length) @@ -135,7 +127,6 @@ inspect $ 'length `hasNoType` ''Fold.Step inspect $ 'length `hasNoType` ''SPEC #endif -{-# INLINE all #-} all :: Int -> IO Bool all value = withStream value (S.all (<= (value + 1))) @@ -146,7 +137,6 @@ inspect $ 'all `hasNoType` ''Fold.Step inspect $ 'all `hasNoType` ''SPEC #endif -{-# INLINE any #-} any :: Int -> IO Bool any value = withStream value (S.any (> (value + 1))) @@ -157,7 +147,6 @@ inspect $ 'any `hasNoType` ''Fold.Step inspect $ 'any `hasNoType` ''SPEC #endif -{-# INLINE and #-} and :: Int -> IO Bool and value = withStream value (S.fold Fold.and . S.map (<= (value + 1))) @@ -168,7 +157,6 @@ inspect $ 'and `hasNoType` ''Fold.Step inspect $ 'and `hasNoType` ''SPEC #endif -{-# INLINE or #-} or :: Int -> IO Bool or value = withStream value (S.fold Fold.or . S.map (> (value + 1))) @@ -179,7 +167,6 @@ inspect $ 'or `hasNoType` ''Fold.Step inspect $ 'or `hasNoType` ''SPEC #endif -{-# INLINE find #-} find :: Int -> IO (Maybe Int) find value = withStream value (S.find (== (value + 1))) @@ -190,7 +177,6 @@ inspect $ 'find `hasNoType` ''Fold.Step inspect $ 'find `hasNoType` ''SPEC #endif -{-# INLINE findM #-} findM :: Int -> IO (Maybe Int) findM value = withStream value (S.findM (\z -> return $ z == (value + 1))) @@ -201,7 +187,6 @@ inspect $ 'findM `hasNoType` ''Fold.Step inspect $ 'findM `hasNoType` ''SPEC #endif -{-# INLINE maximum #-} maximum :: Int -> IO (Maybe Int) maximum value = withStream value S.maximum @@ -212,7 +197,6 @@ inspect $ 'maximum `hasNoType` ''Fold.Step inspect $ 'maximum `hasNoType` ''SPEC #endif -{-# INLINE minimum #-} minimum :: Int -> IO (Maybe Int) minimum value = withStream value S.minimum @@ -223,7 +207,6 @@ inspect $ 'minimum `hasNoType` ''Fold.Step inspect $ 'minimum `hasNoType` ''SPEC #endif -{-# INLINE sum #-} sum :: Int -> IO Int sum value = withStream value (S.fold Fold.sum) @@ -234,7 +217,6 @@ inspect $ 'sum `hasNoType` ''Fold.Step inspect $ 'sum `hasNoType` ''SPEC #endif -{-# INLINE product #-} product :: Int -> IO Int product value = withStream value (S.fold Fold.product) @@ -245,7 +227,6 @@ inspect $ 'product `hasNoType` ''Fold.Step inspect $ 'product `hasNoType` ''SPEC #endif -{-# INLINE minimumBy #-} minimumBy :: Int -> IO (Maybe Int) minimumBy value = withStream value (S.minimumBy compare) @@ -256,7 +237,6 @@ inspect $ 'minimumBy `hasNoType` ''Fold.Step inspect $ 'minimumBy `hasNoType` ''SPEC #endif -{-# INLINE maximumBy #-} maximumBy :: Int -> IO (Maybe Int) maximumBy value = withStream value (S.maximumBy compare) @@ -267,7 +247,6 @@ inspect $ 'maximumBy `hasNoType` ''Fold.Step inspect $ 'maximumBy `hasNoType` ''SPEC #endif -{-# INLINE the #-} the :: Int -> IO (Maybe Int) the value = randomRIO (1, 1) >>= S.the . repeat value @@ -278,7 +257,6 @@ inspect $ 'the `hasNoType` ''Fold.Step inspect $ 'the `hasNoType` ''SPEC #endif -{-# INLINE indexOp #-} indexOp :: Int -> IO (Maybe Int) indexOp value = withStream value (S.!! value) @@ -289,7 +267,6 @@ inspect $ 'indexOp `hasNoType` ''Fold.Step inspect $ 'indexOp `hasNoType` ''SPEC #endif -{-# INLINE lookupNever #-} lookupNever :: Int -> IO (Maybe Int) lookupNever value = withStream value (S.lookup (value + 1) . S.map (\x -> (x, x))) @@ -301,17 +278,14 @@ inspect $ 'lookupNever `hasNoType` ''Fold.Step inspect $ 'lookupNever `hasNoType` ''SPEC #endif -{-# INLINE toListRev #-} toListRev :: Int -> IO [Int] toListRev value = withStream value S.toListRev -- NOTE: this is a Fold benchmark, used here only for comparison with toListRev -{-# INLINE toStreamRev #-} toStreamRev :: Int -> IO (Stream Identity Int) toStreamRev value = withStream value (S.fold Fold.toStreamRev) -- NOTE: this is a Fold benchmark, used here only for comparison with ToList -{-# INLINE toStream #-} toStream :: Int -> IO (Stream Identity Int) toStream value = withStream value (S.fold Fold.toStream) @@ -319,7 +293,6 @@ toStream value = withStream value (S.fold Fold.toStream) -- Multi-stream folds ------------------------------------------------------------------------------- -{-# INLINE isPrefixOf #-} isPrefixOf :: Int -> IO Bool isPrefixOf value = withStream value (\src -> S.isPrefixOf src src) @@ -330,7 +303,6 @@ inspect $ 'isPrefixOf `hasNoType` ''Fold.Step inspect $ 'isPrefixOf `hasNoType` ''SPEC #endif -{-# INLINE isSubsequenceOf #-} isSubsequenceOf :: Int -> IO Bool isSubsequenceOf value = withStream value (\src -> S.isSubsequenceOf src src) @@ -341,7 +313,6 @@ inspect $ 'isSubsequenceOf `hasNoType` ''Fold.Step inspect $ 'isSubsequenceOf `hasNoType` ''SPEC #endif -{-# INLINE stripPrefix #-} stripPrefix :: Int -> IO () stripPrefix value = withStream value (\src -> do _ <- S.stripPrefix src src @@ -358,12 +329,10 @@ inspect $ 'stripPrefix `hasNoType` ''SPEC -- Iterating using tail ------------------------------------------------------------------------------- -{-# INLINE tail #-} tail :: Int -> IO () tail value = withStream value go where go s = S.tail s >>= Prelude.mapM_ go -{-# INLINE nullHeadTail #-} nullHeadTail :: Int -> IO () nullHeadTail value = withStream value go where diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs b/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs index e443016961..03e75916a9 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs @@ -44,7 +44,6 @@ import Prelude hiding (repeat, replicate, iterate) fromListM :: Monad m => [m a] -> Stream m a fromListM = Stream.sequence . Stream.fromList -{-# INLINE sourceFromListM #-} sourceFromListM :: Int -> IO () sourceFromListM value = withDrain $ \n -> fromListM (fmap return [n..n+value]) @@ -55,7 +54,6 @@ inspect $ 'sourceFromListM `hasNoType` ''Fold.Step inspect $ 'sourceFromListM `hasNoType` ''SPEC #endif -{-# INLINE replicate #-} replicate :: Int -> IO () replicate value = withDrain (Stream.replicate value) @@ -70,7 +68,6 @@ inspect $ 'replicate `hasNoType` ''SPEC -- enumerate ------------------------------------------------------------------------------- -{-# INLINE sourceIntFromTo #-} sourceIntFromTo :: Int -> IO () sourceIntFromTo value = withDrain $ \n -> Stream.enumerateFromTo n (n + value) @@ -81,7 +78,6 @@ inspect $ 'sourceIntFromTo `hasNoType` ''Fold.Step inspect $ 'sourceIntFromTo `hasNoType` ''SPEC #endif -{-# INLINE sourceIntFromThenTo #-} sourceIntFromThenTo :: Int -> IO () sourceIntFromThenTo value = withDrain $ \n -> Stream.enumerateFromThenTo n (n + 1) (n + value) @@ -94,7 +90,6 @@ inspect $ 'sourceIntFromThenTo `hasNoType` ''Fold.Step inspect $ 'sourceIntFromThenTo `hasNoType` ''SPEC #endif -{-# INLINE sourceFracFromTo #-} sourceFracFromTo :: Int -> IO () sourceFracFromTo value = withDrain $ \n -> Stream.enumerateFromTo (fromIntegral n :: Double) (fromIntegral (n + value)) @@ -106,7 +101,6 @@ inspect $ 'sourceFracFromTo `hasNoType` ''Fold.Step inspect $ 'sourceFracFromTo `hasNoType` ''SPEC #endif -{-# INLINE sourceFracFromThenTo #-} sourceFracFromThenTo :: Int -> IO () sourceFracFromThenTo value = withDrain $ \n -> Stream.enumerateFromThenTo @@ -119,7 +113,6 @@ inspect $ 'sourceFracFromThenTo `hasNoType` ''Fold.Step inspect $ 'sourceFracFromThenTo `hasNoType` ''SPEC #endif -{-# INLINE sourceIntegerFromStep #-} sourceIntegerFromStep :: Int -> IO () sourceIntegerFromStep value = withDrain $ \n -> Stream.take value @@ -132,7 +125,6 @@ inspect $ 'sourceIntegerFromStep `hasNoType` ''Fold.Step inspect $ 'sourceIntegerFromStep `hasNoType` ''SPEC #endif -{-# INLINE enumerateFrom #-} enumerateFrom :: Int -> IO () enumerateFrom count = withDrain (Stream.take count . Stream.enumerateFrom) @@ -143,13 +135,11 @@ inspect $ 'enumerateFrom `hasNoType` ''Fold.Step inspect $ 'enumerateFrom `hasNoType` ''SPEC #endif -{-# INLINE enumerateFromTo #-} enumerateFromTo :: Int -> IO () enumerateFromTo = sourceIntFromTo -- 'enumerateFromTo' is an alias for 'sourceIntFromTo', already covered above. -{-# INLINE enumerateFromThen #-} enumerateFromThen :: Int -> IO () enumerateFromThen count = withDrain $ \n -> Stream.take count $ Stream.enumerateFromThen n (n + 1) @@ -161,14 +151,12 @@ inspect $ 'enumerateFromThen `hasNoType` ''Fold.Step inspect $ 'enumerateFromThen `hasNoType` ''SPEC #endif -{-# INLINE enumerateFromThenTo #-} enumerateFromThenTo :: Int -> IO () enumerateFromThenTo = sourceIntFromThenTo -- 'enumerateFromThenTo' is an alias for 'sourceIntFromThenTo', already covered above. -- n ~ 1 -{-# INLINE enumerate #-} enumerate :: Int -> IO () enumerate count = withDrain $ \n -> Stream.take (count + n) Stream.enumerate :: Stream IO Int @@ -181,7 +169,6 @@ inspect $ 'enumerate `hasNoType` ''SPEC #endif -- n ~ 1 -{-# INLINE enumerateTo #-} enumerateTo :: Int -> IO () enumerateTo count = withDrain $ \n -> Stream.enumerateTo (minBound + count + n) @@ -192,7 +179,6 @@ inspect $ 'enumerateTo `hasNoType` ''Fold.Step inspect $ 'enumerateTo `hasNoType` ''SPEC #endif -{-# INLINE iterate #-} iterate :: Int -> IO () iterate count = withDrain (Stream.take count . Stream.iterate (+1)) @@ -203,7 +189,6 @@ inspect $ 'iterate `hasNoType` ''Fold.Step inspect $ 'iterate `hasNoType` ''SPEC #endif -{-# INLINE iterateM #-} iterateM :: Int -> IO () iterateM count = withDrain (Stream.take count . Stream.iterateM (return . (+1)) . return) @@ -215,7 +200,6 @@ inspect $ 'iterateM `hasNoType` ''Fold.Step inspect $ 'iterateM `hasNoType` ''SPEC #endif -{-# INLINE repeatM #-} repeatM :: Int -> IO () repeatM count = withDrain (Stream.take count . Stream.repeatM . return) @@ -226,7 +210,6 @@ inspect $ 'repeatM `hasNoType` ''Fold.Step inspect $ 'repeatM `hasNoType` ''SPEC #endif -{-# INLINE replicateM #-} replicateM :: Int -> IO () replicateM count = withDrain (Stream.replicateM count . return) @@ -237,7 +220,6 @@ inspect $ 'replicateM `hasNoType` ''Fold.Step inspect $ 'replicateM `hasNoType` ''SPEC #endif -{-# INLINE fromIndices #-} fromIndices :: Int -> IO () fromIndices value = withDrain $ \n -> Stream.take value $ Stream.fromIndices (+ n) @@ -248,7 +230,6 @@ inspect $ 'fromIndices `hasNoType` ''Fold.Step inspect $ 'fromIndices `hasNoType` ''SPEC #endif -{-# INLINE fromIndicesM #-} fromIndicesM :: Int -> IO () fromIndicesM value = withDrain $ \n -> Stream.take value $ Stream.fromIndicesM (return <$> (+ n)) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs b/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs index 075e3b3e75..3055140fac 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs @@ -69,7 +69,6 @@ withState value n = Stream.evalStateT (return (0 :: Int)) (Stream.liftInner (sourceUnfoldrM value n)) -{-# INLINE evalStateTIO #-} evalStateTIO :: Int -> IO () evalStateTIO value = withRandomIntIO $ \n -> Stream.fold Fold.drain (evalStateT value n :: Stream IO Int) @@ -81,7 +80,6 @@ inspect $ 'evalStateTIO `hasNoType` ''Fold.Step inspect $ 'evalStateTIO `hasNoType` ''SPEC #endif -{-# INLINE withStateIO #-} withStateIO :: Int -> IO () withStateIO value = withRandomIntIO $ \n -> Stream.fold Fold.drain (withState value n :: Stream IO Int) @@ -93,7 +91,6 @@ inspect $ 'withStateIO `hasNoType` ''Fold.Step inspect $ 'withStateIO `hasNoType` ''SPEC #endif -{-# INLINE generalizeInner #-} generalizeInner :: Int -> IO Int generalizeInner value = withPureStream value $ @@ -106,7 +103,6 @@ inspect $ 'generalizeInner `hasNoType` ''Fold.Step inspect $ 'generalizeInner `hasNoType` ''SPEC #endif -{-# INLINE generalizeInnerIO #-} generalizeInnerIO :: Int -> IO Int generalizeInnerIO value = withRandomIntIO $ \n -> Stream.fold Fold.length diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs b/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs index 536366d7ec..328d6382d3 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs @@ -51,7 +51,6 @@ import Prelude hiding (concatMap, zipWith) -- Appending ------------------------------------------------------------------------------- -{-# INLINE interleave2 #-} interleave2 :: Int -> IO () interleave2 count = withRandomIntIO $ \n -> drain $ @@ -67,7 +66,6 @@ inspect $ 'interleave2 `hasNoType` ''S.Step inspect $ 'interleave2 `hasNoType` ''Fold.Step #endif -{-# INLINE roundRobin2 #-} roundRobin2 :: Int -> IO () roundRobin2 count = withRandomIntIO $ \n -> S.drain $ @@ -87,12 +85,11 @@ inspect $ 'roundRobin2 `hasNoType` ''Fold.Step -- Merging ------------------------------------------------------------------------------- -{-# INLINE mergeBy #-} -mergeBy :: (Int -> Int -> Ordering) -> Int -> IO () -mergeBy cmp count = withRandomIntIO $ \n -> +mergeBy :: Int -> IO () +mergeBy count = withRandomIntIO $ \n -> Stream.drain $ Stream.mergeBy - cmp + compare (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)) @@ -103,12 +100,11 @@ inspect $ 'mergeBy `hasNoType` ''SPEC inspect $ 'mergeBy `hasNoType` ''Fold.Step #endif -{-# INLINE mergeByM #-} -mergeByM :: (Int -> Int -> Ordering) -> Int -> IO () -mergeByM cmp count = withRandomIntIO $ \n -> +mergeByM :: Int -> IO () +mergeByM count = withRandomIntIO $ \n -> Stream.drain $ Stream.mergeByM - (\a b -> return $ cmp a b) + (\a b -> return $ compare a b) (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)) @@ -138,7 +134,6 @@ sourceUnfoldrMUF count = UF.unfoldrM step then Nothing else Just (cnt, (cnt + 1, start)) -{-# INLINE bfsUnfoldEach #-} bfsUnfoldEach :: Int -> Int -> IO () bfsUnfoldEach outer inner = withRandomIntIO $ \n -> S.drain $ S.bfsUnfoldEach @@ -153,7 +148,6 @@ inspect $ 'bfsUnfoldEach `hasNoType` ''Fold.Step inspect $ 'bfsUnfoldEach `hasNoType` ''SPEC #endif -{-# INLINE altBfsUnfoldEach #-} altBfsUnfoldEach :: Int -> Int -> IO () altBfsUnfoldEach outer inner = withRandomIntIO $ \n -> S.drain $ S.altBfsUnfoldEach @@ -168,7 +162,6 @@ inspect $ 'altBfsUnfoldEach `hasNoType` ''Fold.Step -- inspect $ 'altBfsUnfoldEach `hasNoType` ''SPEC #endif -{-# INLINE unfoldSched #-} unfoldSched :: Int -> Int -> IO () unfoldSched outer inner = withRandomIntIO $ \n -> S.drain $ S.unfoldSched @@ -401,23 +394,19 @@ o_n_heap_buffering value = benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = - -- NOTE: List concatenation reduce build time memory requirement -- multi-stream [ (SpaceO_1, benchIO "interleave" $ interleave2 (size `div` 2)) , (SpaceO_1, benchIO "roundRobin" $ roundRobin2 (size `div` 2)) - , (SpaceO_1, benchIO "mergeBy compare" $ mergeBy compare (size `div` 2)) - , (SpaceO_1, benchIO "mergeByM compare" $ mergeByM compare (size `div` 2)) - , (SpaceO_1, benchIO "mergeBy (flip compare)" $ mergeBy (flip compare) (size `div` 2)) - , (SpaceO_1, benchIO "mergeByM (flip compare)" $ mergeByM (flip compare) (size `div` 2)) + , (SpaceO_1, benchIO "mergeBy compare" $ mergeBy (size `div` 2)) + , (SpaceO_1, benchIO "mergeByM compare" $ mergeByM (size `div` 2)) -- join 2 streams using n-ary ops , (SpaceO_1, benchIO "bfsUnfoldEach" $ bfsUnfoldEach 2 (size `div` 2)) , (SpaceO_1, benchIO "altBfsUnfoldEach" $ altBfsUnfoldEach 2 (size `div` 2)) , (SpaceO_1, benchIO "unfoldSched" $ unfoldSched 2 (size `div` 2)) - ] ++ -- Solve simultaneous equations by exploring all possibilities - [ (SpaceO_1, benchIO "equations/fairConcatFor (bounded)" $ fairConcatForBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairConcatFor (bounded)" $ fairConcatForBounded sqrtVal) , (SpaceO_1, benchIO "equations/fairConcatForK (bounded)" $ fairConcatForKBounded sqrtVal) , (SpaceO_1, benchIO "equations/fairConcatFor (infinite)" $ fairConcatForInfinite sqrtVal) , (SpaceO_1, benchIO "equations/fairSchedFor (bounded)" $ fairSchedForBounded sqrtVal) @@ -430,9 +419,7 @@ benchmarks size = , (SpaceO_1, benchIO "equations/unfoldSched (bounded)" $ unfoldSchedBounded sqrtVal) , (SpaceO_1, benchIO "equations/fairUnfoldSched (bounded)" $ fairUnfoldSchedBounded sqrtVal) , (SpaceO_1, benchIO "equations/fairUnfoldSched (infinite)" $ fairUnfoldSchedInfinite sqrtVal) - ] ++ - [ - (HeapO_n, benchIO "bfsUnfoldEach (n of 1)" $ bfsUnfoldEach size 1) + , (HeapO_n, benchIO "bfsUnfoldEach (n of 1)" $ bfsUnfoldEach size 1) , (HeapO_n, benchIO "bfsUnfoldEach (sqrtVal of sqrtVal)" $ bfsUnfoldEach sqrtVal sqrtVal) , (HeapO_n, benchIO "altBfsUnfoldEach (n of 1)" $ altBfsUnfoldEach size 1) , (HeapO_n, benchIO "altBfsUnfoldEach (sqrtVal of sqrtVal)" $ altBfsUnfoldEach sqrtVal sqrtVal) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs index b07813677d..caeb25ec94 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs @@ -38,7 +38,6 @@ import Stream.Type (benchIO, withStream) -- Grouping transformations ------------------------------------------------------------------------------- -{-# INLINE groups #-} groups :: Int -> IO () groups value = withStream value $ Common.drain . S.groupsWhile (==) FL.drain @@ -49,7 +48,6 @@ inspect $ 'groups `hasNoType` ''FL.Step inspect $ 'groups `hasNoType` ''SPEC #endif -{-# INLINE groupsWhileLT #-} groupsWhileLT :: Int -> IO () groupsWhileLT value = withStream value $ Common.drain . S.groupsWhile (<) FL.drain @@ -60,7 +58,6 @@ inspect $ 'groupsWhileLT `hasNoType` ''FL.Step inspect $ 'groupsWhileLT `hasNoType` ''SPEC #endif -{-# INLINE groupsWhileEq #-} groupsWhileEq :: Int -> IO () groupsWhileEq value = withStream value $ Common.drain . S.groupsWhile (==) FL.drain @@ -71,7 +68,6 @@ inspect $ 'groupsWhileEq `hasNoType` ''FL.Step inspect $ 'groupsWhileEq `hasNoType` ''SPEC #endif -{-# INLINE groupsByRollingLT #-} groupsByRollingLT :: Int -> IO () groupsByRollingLT value = withStream value $ Common.drain . S.groupsRollingBy (<) FL.drain @@ -83,7 +79,6 @@ inspect $ 'groupsByRollingLT `hasNoType` ''FL.Step inspect $ 'groupsByRollingLT `hasNoType` ''SPEC #endif -{-# INLINE groupsByRollingEq #-} groupsByRollingEq :: Int -> IO () groupsByRollingEq value = withStream value $ Common.drain . S.groupsRollingBy (==) FL.drain @@ -95,7 +90,6 @@ inspect $ 'groupsByRollingEq `hasNoType` ''FL.Step inspect $ 'groupsByRollingEq `hasNoType` ''SPEC #endif -{-# INLINE foldIterateM #-} foldIterateM :: Int -> IO () foldIterateM value = withStream value $ diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs index 4aadc9381e..65b0c4a190 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs @@ -60,7 +60,6 @@ import Prelude hiding (sequence, mapM, reverse) scanl' :: MonadIO m => Int -> Stream m Int -> m () scanl' n = composeN n $ Stream.scanl' (+) 0 -{-# INLINE scanl'1 #-} scanl'1 :: Int -> IO () scanl'1 value = withStream value (scanl' 1) @@ -69,7 +68,6 @@ inspect $ hasNoTypeClasses 'scanl'1 inspect $ 'scanl'1 `hasNoType` ''Stream.Step #endif -{-# INLINE scanl'4 #-} scanl'4 :: Int -> IO () scanl'4 value = withStream value (scanl' 4) @@ -82,7 +80,6 @@ inspect $ 'scanl'4 `hasNoType` ''Stream.Step scanlM' :: MonadIO m => Int -> Stream m Int -> m () scanlM' n = composeN n $ Stream.scanlM' (\b a -> return $ b + a) (return 0) -{-# INLINE scanlM'1 #-} scanlM'1 :: Int -> IO () scanlM'1 value = withStream value (scanlM' 1) @@ -91,7 +88,6 @@ inspect $ hasNoTypeClasses 'scanlM'1 inspect $ 'scanlM'1 `hasNoType` ''Stream.Step #endif -{-# INLINE scanlM'4 #-} scanlM'4 :: Int -> IO () scanlM'4 value = withStream value (scanlM' 4) @@ -104,7 +100,6 @@ inspect $ 'scanlM'4 `hasNoType` ''Stream.Step scanl1' :: MonadIO m => Int -> Stream m Int -> m () scanl1' n = composeN n $ Stream.scanl1' (+) -{-# INLINE scanl1'1 #-} scanl1'1 :: Int -> IO () scanl1'1 value = withStream value (scanl1' 1) @@ -113,7 +108,6 @@ inspect $ hasNoTypeClasses 'scanl1'1 inspect $ 'scanl1'1 `hasNoType` ''Stream.Step #endif -{-# INLINE scanl1'4 #-} scanl1'4 :: Int -> IO () scanl1'4 value = withStream value (scanl1' 4) @@ -126,7 +120,6 @@ inspect $ 'scanl1'4 `hasNoType` ''Stream.Step scanl1M' :: MonadIO m => Int -> Stream m Int -> m () scanl1M' n = composeN n $ Stream.scanl1M' (\b a -> return $ b + a) -{-# INLINE scanl1M'1 #-} scanl1M'1 :: Int -> IO () scanl1M'1 value = withStream value (scanl1M' 1) @@ -135,7 +128,6 @@ inspect $ hasNoTypeClasses 'scanl1M'1 inspect $ 'scanl1M'1 `hasNoType` ''Stream.Step #endif -{-# INLINE scanl1M'4 #-} scanl1M'4 :: Int -> IO () scanl1M'4 value = withStream value (scanl1M' 4) @@ -148,7 +140,6 @@ inspect $ 'scanl1M'4 `hasNoType` ''Stream.Step scan :: MonadIO m => Int -> Stream m Int -> m () scan n = composeN n $ Stream.scanl Scanl.sum -{-# INLINE scan1 #-} scan1 :: Int -> IO () scan1 value = withStream value (scan 1) @@ -160,7 +151,6 @@ inspect $ 'scan1 `hasNoType` ''FL.Step inspect $ 'scan1 `hasNoType` ''SPEC #endif -{-# INLINE scan4 #-} scan4 :: Int -> IO () scan4 value = withStream value (scan 4) @@ -176,7 +166,6 @@ inspect $ 'scan4 `hasNoType` ''SPEC postscan :: MonadIO m => Int -> Stream m Int -> m () postscan n = composeN n $ Stream.postscanl Scanl.sum -{-# INLINE postscan1 #-} postscan1 :: Int -> IO () postscan1 value = withStream value (postscan 1) @@ -188,7 +177,6 @@ inspect $ 'postscan1 `hasNoType` ''FL.Step inspect $ 'postscan1 `hasNoType` ''SPEC #endif -{-# INLINE postscan4 #-} postscan4 :: Int -> IO () postscan4 value = withStream value (postscan 4) @@ -204,7 +192,6 @@ inspect $ 'postscan4 `hasNoType` ''SPEC postscanl' :: MonadIO m => Int -> Stream m Int -> m () postscanl' n = composeN n $ Stream.postscanl' (+) 0 -{-# INLINE postscanl'1 #-} postscanl'1 :: Int -> IO () postscanl'1 value = withStream value (postscanl' 1) @@ -213,7 +200,6 @@ inspect $ hasNoTypeClasses 'postscanl'1 inspect $ 'postscanl'1 `hasNoType` ''Stream.Step #endif -{-# INLINE postscanl'4 #-} postscanl'4 :: Int -> IO () postscanl'4 value = withStream value (postscanl' 4) @@ -226,7 +212,6 @@ inspect $ hasNoTypeClasses 'postscanl'4 postscanlM' :: MonadIO m => Int -> Stream m Int -> m () postscanlM' n = composeN n $ Stream.postscanlM' (\b a -> return $ b + a) (return 0) -{-# INLINE postscanlM'1 #-} postscanlM'1 :: Int -> IO () postscanlM'1 value = withStream value (postscanlM' 1) @@ -235,7 +220,6 @@ inspect $ hasNoTypeClasses 'postscanlM'1 inspect $ 'postscanlM'1 `hasNoType` ''Stream.Step #endif -{-# INLINE postscanlM'4 #-} postscanlM'4 :: Int -> IO () postscanlM'4 value = withStream value (postscanlM' 4) @@ -248,7 +232,6 @@ inspect $ 'postscanlM'4 `hasNoType` ''Stream.Step sequence :: MonadAsync m => Stream m (m Int) -> m () sequence = Common.drain . Stream.sequence -{-# INLINE sequence1 #-} sequence1 :: Int -> IO () sequence1 value = withRandomIntIO $ sequence . sourceUnfoldrAction value @@ -263,7 +246,6 @@ inspect $ 'sequence1 `hasNoType` ''SPEC tap :: MonadIO m => Int -> Stream m Int -> m () tap n = composeN n $ Stream.tap FL.sum -{-# INLINE tap1 #-} tap1 :: Int -> IO () tap1 value = withStream value (tap 1) @@ -294,7 +276,6 @@ foldrTMap n = composeN n $ Stream.foldrT (\x xs -> x + 1 `Stream.cons` xs) Strea trace :: MonadAsync m => Int -> Stream m Int -> m () trace n = composeN n $ Stream.trace return -{-# INLINE trace4 #-} trace4 :: Int -> IO () trace4 value = withStream value (trace 4) @@ -343,17 +324,14 @@ _iterateSingleton :: _iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n -} -{-# INLINE iteratePlusBaseline #-} iteratePlusBaseline :: Int -> IO Int iteratePlusBaseline value = withRandomIntIO $ \i0 -> iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value -{-# INLINE iterateSubMap #-} iterateSubMap :: Int -> IO () iterateSubMap value = withRandomIntIO $ drain . iterateSingleton (<$) value -{-# INLINE iterateFmap #-} iterateFmap :: Int -> IO () iterateFmap value = withRandomIntIO $ drain . iterateSingleton (fmap . (+)) value @@ -365,7 +343,6 @@ iterateFmap value = withRandomIntIO $ drain . iterateSingleton (fmap . (+)) valu filterEven :: MonadIO m => Int -> Stream m Int -> m () filterEven n = composeN n $ Stream.filter even -{-# INLINE filterEven1 #-} filterEven1 :: Int -> IO () filterEven1 value = withStream value (filterEven 1) @@ -376,7 +353,6 @@ inspect $ 'filterEven1 `hasNoType` ''FL.Step inspect $ 'filterEven1 `hasNoType` ''SPEC #endif -{-# INLINE filterEven4 #-} filterEven4 :: Int -> IO () filterEven4 value = withStream value (filterEven 4) @@ -391,7 +367,6 @@ inspect $ 'filterEven4 `hasNoType` ''SPEC filterAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m () filterAllOut value n = composeN n $ Stream.filter (> (value + 1)) -{-# INLINE filterAllOut1 #-} filterAllOut1 :: Int -> IO () filterAllOut1 value = withStream value (filterAllOut value 1) @@ -402,7 +377,6 @@ inspect $ 'filterAllOut1 `hasNoType` ''FL.Step inspect $ 'filterAllOut1 `hasNoType` ''SPEC #endif -{-# INLINE filterAllOut4 #-} filterAllOut4 :: Int -> IO () filterAllOut4 value = withStream value (filterAllOut value 4) @@ -417,7 +391,6 @@ inspect $ 'filterAllOut4 `hasNoType` ''SPEC filterAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m () filterAllIn value n = composeN n $ Stream.filter (<= (value + 1)) -{-# INLINE filterAllIn1 #-} filterAllIn1 :: Int -> IO () filterAllIn1 value = withStream value (filterAllIn value 1) @@ -428,7 +401,6 @@ inspect $ 'filterAllIn1 `hasNoType` ''FL.Step inspect $ 'filterAllIn1 `hasNoType` ''SPEC #endif -{-# INLINE filterAllIn4 #-} filterAllIn4 :: Int -> IO () filterAllIn4 value = withStream value (filterAllIn value 4) @@ -443,7 +415,6 @@ inspect $ 'filterAllIn4 `hasNoType` ''SPEC filterMEven :: MonadIO m => Int -> Stream m Int -> m () filterMEven n = composeN n $ Stream.filterM (return . even) -{-# INLINE filterMEven1 #-} filterMEven1 :: Int -> IO () filterMEven1 value = withStream value (filterMEven 1) @@ -454,7 +425,6 @@ inspect $ 'filterMEven1 `hasNoType` ''FL.Step inspect $ 'filterMEven1 `hasNoType` ''SPEC #endif -{-# INLINE filterMEven4 #-} filterMEven4 :: Int -> IO () filterMEven4 value = withStream value (filterMEven 4) @@ -469,7 +439,6 @@ inspect $ 'filterMEven4 `hasNoType` ''SPEC filterMAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m () filterMAllOut value n = composeN n $ Stream.filterM (\x -> return $ x > (value + 1)) -{-# INLINE filterMAllOut1 #-} filterMAllOut1 :: Int -> IO () filterMAllOut1 value = withStream value (filterMAllOut value 1) @@ -480,7 +449,6 @@ inspect $ 'filterMAllOut1 `hasNoType` ''FL.Step inspect $ 'filterMAllOut1 `hasNoType` ''SPEC #endif -{-# INLINE filterMAllOut4 #-} filterMAllOut4 :: Int -> IO () filterMAllOut4 value = withStream value (filterMAllOut value 4) @@ -495,7 +463,6 @@ inspect $ 'filterMAllOut4 `hasNoType` ''SPEC filterMAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m () filterMAllIn value n = composeN n $ Stream.filterM (\x -> return $ x <= (value + 1)) -{-# INLINE filterMAllIn1 #-} filterMAllIn1 :: Int -> IO () filterMAllIn1 value = withStream value (filterMAllIn value 1) @@ -506,7 +473,6 @@ inspect $ 'filterMAllIn1 `hasNoType` ''FL.Step inspect $ 'filterMAllIn1 `hasNoType` ''SPEC #endif -{-# INLINE filterMAllIn4 #-} filterMAllIn4 :: Int -> IO () filterMAllIn4 value = withStream value (filterMAllIn value 4) @@ -521,7 +487,6 @@ inspect $ 'filterMAllIn4 `hasNoType` ''SPEC dropOne :: MonadIO m => Int -> Stream m Int -> m () dropOne n = composeN n $ Stream.drop 1 -{-# INLINE dropOne1 #-} dropOne1 :: Int -> IO () dropOne1 value = withStream value (dropOne 1) @@ -532,7 +497,6 @@ inspect $ 'dropOne1 `hasNoType` ''FL.Step inspect $ 'dropOne1 `hasNoType` ''SPEC #endif -{-# INLINE dropOne4 #-} dropOne4 :: Int -> IO () dropOne4 value = withStream value (dropOne 4) @@ -547,7 +511,6 @@ inspect $ 'dropOne4 `hasNoType` ''SPEC dropAll :: MonadIO m => Int -> Int -> Stream m Int -> m () dropAll value n = composeN n $ Stream.drop (value + 1) -{-# INLINE dropAll1 #-} dropAll1 :: Int -> IO () dropAll1 value = withStream value (dropAll value 1) @@ -558,7 +521,6 @@ inspect $ 'dropAll1 `hasNoType` ''FL.Step inspect $ 'dropAll1 `hasNoType` ''SPEC #endif -{-# INLINE dropAll4 #-} dropAll4 :: Int -> IO () dropAll4 value = withStream value (dropAll value 4) @@ -573,7 +535,6 @@ inspect $ 'dropAll4 `hasNoType` ''SPEC dropWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m () dropWhileTrue value n = composeN n $ Stream.dropWhile (<= (value + 1)) -{-# INLINE dropWhileTrue1 #-} dropWhileTrue1 :: Int -> IO () dropWhileTrue1 value = withStream value (dropWhileTrue value 1) @@ -585,7 +546,6 @@ inspect $ 'dropWhileTrue1 `hasNoType` ''FL.Step inspect $ 'dropWhileTrue1 `hasNoType` ''SPEC #endif -{-# INLINE dropWhileTrue4 #-} dropWhileTrue4 :: Int -> IO () dropWhileTrue4 value = withStream value (dropWhileTrue value 4) @@ -601,7 +561,6 @@ inspect $ 'dropWhileTrue4 `hasNoType` ''SPEC dropWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m () dropWhileMTrue value n = composeN n $ Stream.dropWhileM (return . (<= (value + 1))) -{-# INLINE dropWhileMTrue4 #-} dropWhileMTrue4 :: Int -> IO () dropWhileMTrue4 value = withStream value (dropWhileMTrue value 4) @@ -617,7 +576,6 @@ inspect $ 'dropWhileMTrue4 `hasNoType` ''SPEC dropWhileFalse :: MonadIO m => Int -> Int -> Stream m Int -> m () dropWhileFalse value n = composeN n $ Stream.dropWhile (> (value + 1)) -{-# INLINE dropWhileFalse1 #-} dropWhileFalse1 :: Int -> IO () dropWhileFalse1 value = withStream value (dropWhileFalse value 1) @@ -629,7 +587,6 @@ inspect $ 'dropWhileFalse1 `hasNoType` ''FL.Step inspect $ 'dropWhileFalse1 `hasNoType` ''SPEC #endif -{-# INLINE dropWhileFalse4 #-} dropWhileFalse4 :: Int -> IO () dropWhileFalse4 value = withStream value (dropWhileFalse value 4) @@ -645,7 +602,6 @@ inspect $ 'dropWhileFalse4 `hasNoType` ''SPEC findIndices :: MonadIO m => Int -> Int -> Stream m Int -> m () findIndices value n = composeN n $ Stream.findIndices (== (value + 1)) -{-# INLINE findIndices1 #-} findIndices1 :: Int -> IO () findIndices1 value = withStream value (findIndices value 1) @@ -656,7 +612,6 @@ inspect $ 'findIndices1 `hasNoType` ''FL.Step inspect $ 'findIndices1 `hasNoType` ''SPEC #endif -{-# INLINE findIndices4 #-} findIndices4 :: Int -> IO () findIndices4 value = withStream value (findIndices value 4) @@ -671,7 +626,6 @@ inspect $ 'findIndices4 `hasNoType` ''SPEC elemIndices :: MonadIO m => Int -> Int -> Stream m Int -> m () elemIndices value n = composeN n $ Stream.elemIndices (value + 1) -{-# INLINE elemIndices1 #-} elemIndices1 :: Int -> IO () elemIndices1 value = withStream value (elemIndices value 1) @@ -682,7 +636,6 @@ inspect $ 'elemIndices1 `hasNoType` ''FL.Step inspect $ 'elemIndices1 `hasNoType` ''SPEC #endif -{-# INLINE elemIndices4 #-} elemIndices4 :: Int -> IO () elemIndices4 value = withStream value (elemIndices value 4) @@ -693,7 +646,6 @@ inspect $ 'elemIndices4 `hasNoType` ''FL.Step inspect $ 'elemIndices4 `hasNoType` ''SPEC #endif -{-# INLINE findIndex #-} findIndex :: Int -> IO (Maybe Int) findIndex value = withStream value (Stream.head . Stream.findIndices (== (value + 1))) @@ -704,7 +656,6 @@ inspect $ 'findIndex `hasNoType` ''FL.Step inspect $ 'findIndex `hasNoType` ''SPEC #endif -{-# INLINE elemIndex #-} elemIndex :: Int -> IO (Maybe Int) elemIndex value = withStream value (Stream.head . Stream.elemIndices (value + 1)) @@ -719,7 +670,6 @@ inspect $ 'elemIndex `hasNoType` ''SPEC deleteBy :: MonadIO m => Int -> Int -> Stream m Int -> m () deleteBy value n = composeN n $ Stream.deleteBy (>=) (value + 1) -{-# INLINE deleteBy1 #-} deleteBy1 :: Int -> IO () deleteBy1 value = withStream value (deleteBy value 1) @@ -730,7 +680,6 @@ inspect $ 'deleteBy1 `hasNoType` ''FL.Step inspect $ 'deleteBy1 `hasNoType` ''SPEC #endif -{-# INLINE deleteBy4 #-} deleteBy4 :: Int -> IO () deleteBy4 value = withStream value (deleteBy value 4) @@ -746,7 +695,6 @@ inspect $ 'deleteBy4 `hasNoType` ''SPEC uniq :: MonadIO m => Int -> Stream m Int -> m () uniq n = composeN n Stream.uniq -{-# INLINE uniq1 #-} uniq1 :: Int -> IO () uniq1 value = withStream value (uniq 1) @@ -757,7 +705,6 @@ inspect $ 'uniq1 `hasNoType` ''FL.Step inspect $ 'uniq1 `hasNoType` ''SPEC #endif -{-# INLINE uniq4 #-} uniq4 :: Int -> IO () uniq4 value = withStream value (uniq 4) @@ -778,7 +725,6 @@ mapMaybe n = then Nothing else Just x) -{-# INLINE mapMaybe1 #-} mapMaybe1 :: Int -> IO () mapMaybe1 value = withStream value (mapMaybe 1) @@ -789,7 +735,6 @@ inspect $ 'mapMaybe1 `hasNoType` ''FL.Step inspect $ 'mapMaybe1 `hasNoType` ''SPEC #endif -{-# INLINE mapMaybe4 #-} mapMaybe4 :: Int -> IO () mapMaybe4 value = withStream value (mapMaybe 4) @@ -810,7 +755,6 @@ mapMaybeM n = then return Nothing else return $ Just x) -{-# INLINE mapMaybeM1 #-} mapMaybeM1 :: Int -> IO () mapMaybeM1 value = withStream value (mapMaybeM 1) @@ -821,7 +765,6 @@ inspect $ 'mapMaybeM1 `hasNoType` ''FL.Step inspect $ 'mapMaybeM1 `hasNoType` ''SPEC #endif -{-# INLINE mapMaybeM4 #-} mapMaybeM4 :: Int -> IO () mapMaybeM4 value = withStream value (mapMaybeM 4) @@ -840,7 +783,6 @@ inspect $ 'mapMaybeM4 `hasNoType` ''SPEC intersperse :: MonadAsync m => Int -> Int -> Stream m Int -> m () intersperse value n = composeN n $ Stream.intersperse (value + 1) -{-# INLINE intersperse1 #-} intersperse1 :: Int -> IO () intersperse1 value = withStream value (intersperse value 1) @@ -852,7 +794,6 @@ inspect $ 'intersperse1 `hasNoType` ''FL.Step inspect $ 'intersperse1 `hasNoType` ''SPEC #endif -{-# INLINE intersperse4 #-} intersperse4 :: Int -> IO () intersperse4 value = withStream value (intersperse value 4) @@ -868,7 +809,6 @@ inspect $ 'intersperse4 `hasNoType` ''FL.Step intersperseM :: MonadAsync m => Int -> Int -> Stream m Int -> m () intersperseM value n = composeN n $ Stream.intersperseM (return $ value + 1) -{-# INLINE intersperseM1 #-} intersperseM1 :: Int -> IO () intersperseM1 value = withStream value (intersperseM value 1) @@ -884,7 +824,6 @@ inspect $ 'intersperseM1 `hasNoType` ''SPEC insertBy :: MonadIO m => Int -> Int -> Stream m Int -> m () insertBy value n = composeN n $ Stream.insertBy compare (value + 1) -{-# INLINE insertBy1 #-} insertBy1 :: Int -> IO () insertBy1 value = withStream value (insertBy value 1) @@ -895,7 +834,6 @@ inspect $ 'insertBy1 `hasNoType` ''FL.Step inspect $ 'insertBy1 `hasNoType` ''SPEC #endif -{-# INLINE insertBy4 #-} insertBy4 :: Int -> IO () insertBy4 value = withStream value (insertBy value 4) @@ -911,7 +849,6 @@ interposeSuffix :: Monad m => Int -> Int -> Stream m Int -> m () interposeSuffix value n = composeN n $ Stream.unfoldEachSepBy (value + 1) Unfold.identity -{-# INLINE interposeSuffix1 #-} interposeSuffix1 :: Int -> IO () interposeSuffix1 value = withStream value (interposeSuffix value 1) @@ -928,7 +865,6 @@ intercalateSuffix :: Monad m => Int -> Int -> Stream m Int -> m () intercalateSuffix value n = composeN n $ Stream.unfoldEachSepBySeq (value + 1) Unfold.identity -{-# INLINE intercalateSuffix1 #-} intercalateSuffix1 :: Int -> IO () intercalateSuffix1 value = withStream value (intercalateSuffix value 1) @@ -949,7 +885,6 @@ inspect $ 'intercalateSuffix1 `hasNoType` ''SPEC indexed :: MonadIO m => Int -> Stream m Int -> m () indexed n = composeN n (fmap snd . Stream.indexed) -{-# INLINE indexed1 #-} indexed1 :: Int -> IO () indexed1 value = withStream value (indexed 1) @@ -960,7 +895,6 @@ inspect $ 'indexed1 `hasNoType` ''FL.Step inspect $ 'indexed1 `hasNoType` ''SPEC #endif -{-# INLINE indexed4 #-} indexed4 :: Int -> IO () indexed4 value = withStream value (indexed 4) @@ -975,7 +909,6 @@ inspect $ 'indexed4 `hasNoType` ''SPEC indexedR :: MonadIO m => Int -> Int -> Stream m Int -> m () indexedR value n = composeN n (fmap snd . Stream.indexedR value) -{-# INLINE indexedR1 #-} indexedR1 :: Int -> IO () indexedR1 value = withStream value (indexedR value 1) @@ -986,7 +919,6 @@ inspect $ 'indexedR1 `hasNoType` ''FL.Step inspect $ 'indexedR1 `hasNoType` ''SPEC #endif -{-# INLINE indexedR4 #-} indexedR4 :: Int -> IO () indexedR4 value = withStream value (indexedR value 4) @@ -1001,7 +933,6 @@ inspect $ 'indexedR4 `hasNoType` ''SPEC -- Size conserving transformations (reordering, buffering, etc.) ------------------------------------------------------------------------------- -{-# INLINE reverse #-} reverse :: Int -> IO () reverse value = withStream value (composeN 1 Stream.reverse) @@ -1012,7 +943,6 @@ inspect $ 'reverse `hasNoType` ''FL.Step -- inspect $ 'reverse `hasNoType` ''SPEC #endif -{-# INLINE reverse' #-} reverse' :: Int -> IO () reverse' value = withStream value (composeN 1 Stream.reverseUnbox) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs index 4da5ee0ffb..ed0d9e324d 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs @@ -70,7 +70,6 @@ iterateSource g count len n = f count (sourceUnfoldrM len n) scanMap :: MonadIO m => Int -> Stream m Int -> m () scanMap n = composeN n $ fmap (subtract 1) . Common.scanl' (+) 0 -{-# INLINE scanMap1 #-} scanMap1 :: Int -> IO () scanMap1 value = withStream value (scanMap 1) @@ -82,7 +81,6 @@ inspect $ 'scanMap1 `hasNoType` ''FL.Step inspect $ 'scanMap1 `hasNoType` ''SPEC #endif -{-# INLINE scanMap2 #-} scanMap2 :: Int -> IO () scanMap2 value = withStream value (scanMap 2) @@ -94,7 +92,6 @@ inspect $ 'scanMap2 `hasNoType` ''FL.Step inspect $ 'scanMap2 `hasNoType` ''SPEC #endif -{-# INLINE scanMap4 #-} scanMap4 :: Int -> IO () scanMap4 value = withStream value (scanMap 4) @@ -110,7 +107,6 @@ inspect $ 'scanMap4 `hasNoType` ''SPEC dropMap :: MonadIO m => Int -> Stream m Int -> m () dropMap n = composeN n $ fmap (subtract 1) . S.drop 1 -{-# INLINE dropMap1 #-} dropMap1 :: Int -> IO () dropMap1 value = withStream value (dropMap 1) @@ -121,7 +117,6 @@ inspect $ 'dropMap1 `hasNoType` ''FL.Step inspect $ 'dropMap1 `hasNoType` ''SPEC #endif -{-# INLINE dropMap2 #-} dropMap2 :: Int -> IO () dropMap2 value = withStream value (dropMap 2) @@ -132,7 +127,6 @@ inspect $ 'dropMap2 `hasNoType` ''FL.Step inspect $ 'dropMap2 `hasNoType` ''SPEC #endif -{-# INLINE dropMap4 #-} dropMap4 :: Int -> IO () dropMap4 value = withStream value (dropMap 4) @@ -147,7 +141,6 @@ inspect $ 'dropMap4 `hasNoType` ''SPEC dropScan :: MonadIO m => Int -> Stream m Int -> m () dropScan n = composeN n $ Common.scanl' (+) 0 . S.drop 1 -{-# INLINE dropScan1 #-} dropScan1 :: Int -> IO () dropScan1 value = withStream value (dropScan 1) @@ -159,7 +152,6 @@ inspect $ 'dropScan1 `hasNoType` ''FL.Step inspect $ 'dropScan1 `hasNoType` ''SPEC #endif -{-# INLINE dropScan2 #-} dropScan2 :: Int -> IO () dropScan2 value = withStream value (dropScan 2) @@ -171,7 +163,6 @@ inspect $ 'dropScan2 `hasNoType` ''FL.Step inspect $ 'dropScan2 `hasNoType` ''SPEC #endif -{-# INLINE dropScan4 #-} dropScan4 :: Int -> IO () dropScan4 value = withStream value (dropScan 4) @@ -187,7 +178,6 @@ inspect $ 'dropScan4 `hasNoType` ''SPEC takeDrop :: MonadIO m => Int -> Int -> Stream m Int -> m () takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1) -{-# INLINE takeDrop1 #-} takeDrop1 :: Int -> IO () takeDrop1 value = withStream value (takeDrop value 1) @@ -198,7 +188,6 @@ inspect $ 'takeDrop1 `hasNoType` ''FL.Step inspect $ 'takeDrop1 `hasNoType` ''SPEC #endif -{-# INLINE takeDrop2 #-} takeDrop2 :: Int -> IO () takeDrop2 value = withStream value (takeDrop value 2) @@ -209,7 +198,6 @@ inspect $ 'takeDrop2 `hasNoType` ''FL.Step inspect $ 'takeDrop2 `hasNoType` ''SPEC #endif -{-# INLINE takeDrop4 #-} takeDrop4 :: Int -> IO () takeDrop4 value = withStream value (takeDrop value 4) @@ -224,7 +212,6 @@ inspect $ 'takeDrop4 `hasNoType` ''SPEC takeScan :: MonadIO m => Int -> Int -> Stream m Int -> m () takeScan value n = composeN n $ Common.scanl' (+) 0 . S.take (value + 1) -{-# INLINE takeScan1 #-} takeScan1 :: Int -> IO () takeScan1 value = withStream value (takeScan value 1) @@ -236,7 +223,6 @@ inspect $ 'takeScan1 `hasNoType` ''FL.Step inspect $ 'takeScan1 `hasNoType` ''SPEC #endif -{-# INLINE takeScan2 #-} takeScan2 :: Int -> IO () takeScan2 value = withStream value (takeScan value 2) @@ -248,7 +234,6 @@ inspect $ 'takeScan2 `hasNoType` ''FL.Step inspect $ 'takeScan2 `hasNoType` ''SPEC #endif -{-# INLINE takeScan4 #-} takeScan4 :: Int -> IO () takeScan4 value = withStream value (takeScan value 4) @@ -264,7 +249,6 @@ inspect $ 'takeScan4 `hasNoType` ''SPEC takeMap :: MonadIO m => Int -> Int -> Stream m Int -> m () takeMap value n = composeN n $ fmap (subtract 1) . S.take (value + 1) -{-# INLINE takeMap1 #-} takeMap1 :: Int -> IO () takeMap1 value = withStream value (takeMap value 1) @@ -275,7 +259,6 @@ inspect $ 'takeMap1 `hasNoType` ''FL.Step inspect $ 'takeMap1 `hasNoType` ''SPEC #endif -{-# INLINE takeMap2 #-} takeMap2 :: Int -> IO () takeMap2 value = withStream value (takeMap value 2) @@ -286,7 +269,6 @@ inspect $ 'takeMap2 `hasNoType` ''FL.Step inspect $ 'takeMap2 `hasNoType` ''SPEC #endif -{-# INLINE takeMap4 #-} takeMap4 :: Int -> IO () takeMap4 value = withStream value (takeMap value 4) @@ -301,7 +283,6 @@ inspect $ 'takeMap4 `hasNoType` ''SPEC filterDrop :: MonadIO m => Int -> Int -> Stream m Int -> m () filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1)) -{-# INLINE filterDrop1 #-} filterDrop1 :: Int -> IO () filterDrop1 value = withStream value (filterDrop value 1) @@ -312,7 +293,6 @@ inspect $ 'filterDrop1 `hasNoType` ''FL.Step inspect $ 'filterDrop1 `hasNoType` ''SPEC #endif -{-# INLINE filterDrop2 #-} filterDrop2 :: Int -> IO () filterDrop2 value = withStream value (filterDrop value 2) @@ -323,7 +303,6 @@ inspect $ 'filterDrop2 `hasNoType` ''FL.Step inspect $ 'filterDrop2 `hasNoType` ''SPEC #endif -{-# INLINE filterDrop4 #-} filterDrop4 :: Int -> IO () filterDrop4 value = withStream value (filterDrop value 4) @@ -338,7 +317,6 @@ inspect $ 'filterDrop4 `hasNoType` ''SPEC filterTake :: MonadIO m => Int -> Int -> Stream m Int -> m () filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1)) -{-# INLINE filterTake1 #-} filterTake1 :: Int -> IO () filterTake1 value = withStream value (filterTake value 1) @@ -349,7 +327,6 @@ inspect $ 'filterTake1 `hasNoType` ''FL.Step inspect $ 'filterTake1 `hasNoType` ''SPEC #endif -{-# INLINE filterTake2 #-} filterTake2 :: Int -> IO () filterTake2 value = withStream value (filterTake value 2) @@ -360,7 +337,6 @@ inspect $ 'filterTake2 `hasNoType` ''FL.Step inspect $ 'filterTake2 `hasNoType` ''SPEC #endif -{-# INLINE filterTake4 #-} filterTake4 :: Int -> IO () filterTake4 value = withStream value (filterTake value 4) @@ -375,7 +351,6 @@ inspect $ 'filterTake4 `hasNoType` ''SPEC filterScan :: MonadIO m => Int -> Stream m Int -> m () filterScan n = composeN n $ Common.scanl' (+) 0 . S.filter (<= maxBound) -{-# INLINE filterScan1 #-} filterScan1 :: Int -> IO () filterScan1 value = withStream value (filterScan 1) @@ -387,7 +362,6 @@ inspect $ 'filterScan1 `hasNoType` ''FL.Step inspect $ 'filterScan1 `hasNoType` ''SPEC #endif -{-# INLINE filterScan2 #-} filterScan2 :: Int -> IO () filterScan2 value = withStream value (filterScan 2) @@ -399,7 +373,6 @@ inspect $ 'filterScan2 `hasNoType` ''FL.Step inspect $ 'filterScan2 `hasNoType` ''SPEC #endif -{-# INLINE filterScan4 #-} filterScan4 :: Int -> IO () filterScan4 value = withStream value (filterScan 4) @@ -415,7 +388,6 @@ inspect $ 'filterScan4 `hasNoType` ''SPEC filterScanl1 :: MonadIO m => Int -> Stream m Int -> m () filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound) -{-# INLINE filterScanl12 #-} filterScanl12 :: Int -> IO () filterScanl12 value = withStream value (filterScanl1 2) @@ -427,7 +399,6 @@ inspect $ 'filterScanl12 `hasNoType` ''FL.Step inspect $ 'filterScanl12 `hasNoType` ''SPEC #endif -{-# INLINE filterScanl14 #-} filterScanl14 :: Int -> IO () filterScanl14 value = withStream value (filterScanl1 4) @@ -443,7 +414,6 @@ inspect $ 'filterScanl14 `hasNoType` ''SPEC filterMap :: MonadIO m => Int -> Int -> Stream m Int -> m () filterMap value n = composeN n $ fmap (subtract 1) . S.filter (<= (value + 1)) -{-# INLINE filterMap1 #-} filterMap1 :: Int -> IO () filterMap1 value = withStream value (filterMap value 1) @@ -454,7 +424,6 @@ inspect $ 'filterMap1 `hasNoType` ''FL.Step inspect $ 'filterMap1 `hasNoType` ''SPEC #endif -{-# INLINE filterMap2 #-} filterMap2 :: Int -> IO () filterMap2 value = withStream value (filterMap value 2) @@ -465,7 +434,6 @@ inspect $ 'filterMap2 `hasNoType` ''FL.Step inspect $ 'filterMap2 `hasNoType` ''SPEC #endif -{-# INLINE filterMap4 #-} filterMap4 :: Int -> IO () filterMap4 value = withStream value (filterMap value 4) @@ -484,7 +452,6 @@ data Pair a b = Pair !a !b deriving (Generic, NFData) -{-# INLINE sumProductFold #-} sumProductFold :: Int -> IO (Pair Int Int) sumProductFold value = withStream value $ @@ -497,7 +464,6 @@ inspect $ 'sumProductFold `hasNoType` ''FL.Step inspect $ 'sumProductFold `hasNoType` ''SPEC #endif -{-# INLINE sumProductScan #-} sumProductScan :: Int -> IO (Pair Int Int) sumProductScan value = withStream value $ @@ -512,7 +478,6 @@ inspect $ 'sumProductScan `hasNoType` ''FL.Step inspect $ 'sumProductScan `hasNoType` ''SPEC #endif -{-# INLINE foldl'ReduceMap #-} foldl'ReduceMap :: Int -> IO Int foldl'ReduceMap value = withStream value $ fmap (+ 1) . Common.foldl' (+) 0 @@ -528,45 +493,37 @@ inspect $ 'foldl'ReduceMap `hasNoType` ''SPEC ------------------------------------------------------------------------------- -- this is quadratic -{-# INLINE iterateScan #-} iterateScan :: Int -> Int -> IO () iterateScan value iterCount = withRandomIntIO $ Common.drain . iterateSource (Common.scanl' (+) 0) (value `div` iterCount) iterCount -- this is quadratic -{-# INLINE iterateScanl1 #-} iterateScanl1 :: Int -> Int -> IO () iterateScanl1 value iterCount = withRandomIntIO $ Common.drain . iterateSource (S.scanl1' (+)) (value `div` iterCount) iterCount -{-# INLINE iterateMapM #-} iterateMapM :: Int -> Int -> IO () iterateMapM value iterCount = withRandomIntIO $ Common.drain . iterateSource (S.mapM return) (value `div` iterCount) iterCount -{-# INLINE iterateFilterEven #-} iterateFilterEven :: Int -> Int -> IO () iterateFilterEven value iterCount = withRandomIntIO $ Common.drain . iterateSource (S.filter even) (value `div` iterCount) iterCount -{-# INLINE iterateTakeAll #-} iterateTakeAll :: Int -> Int -> IO () iterateTakeAll value iterCount = withRandomIntIO $ Common.drain . iterateSource (S.take (value + 1)) (value `div` iterCount) iterCount -{-# INLINE iterateDropOne #-} iterateDropOne :: Int -> Int -> IO () iterateDropOne value iterCount = withRandomIntIO $ Common.drain . iterateSource (S.drop 1) (value `div` iterCount) iterCount -{-# INLINE iterateDropWhileTrue #-} iterateDropWhileTrue :: Int -> Int -> IO () iterateDropWhileTrue value iterCount = withRandomIntIO $ Common.drain . iterateSource (S.dropWhile (<= (value + 1))) (value `div` iterCount) iterCount -{-# INLINE iterateDropWhileFalse #-} iterateDropWhileFalse :: Int -> Int -> IO () iterateDropWhileFalse value iterCount = withRandomIntIO @@ -616,7 +573,6 @@ scanTeeMapM n = (Scan.teeWith (+) (Scan.functionM (\x -> return (x + 1))) (Scan.functionM (\x -> return (x + 2)))) -{-# INLINE pipeMapM #-} pipeMapM :: Int -> IO () pipeMapM value = withStream value (transformMapM 1) @@ -628,7 +584,6 @@ inspect $ 'pipeMapM `hasNoType` ''FL.Step inspect $ 'pipeMapM `hasNoType` ''SPEC #endif -{-# INLINE pipeCompose #-} pipeCompose :: Int -> IO () pipeCompose value = withStream value (transformComposeMapM 1) @@ -640,7 +595,6 @@ inspect $ 'pipeCompose `hasNoType` ''FL.Step inspect $ 'pipeCompose `hasNoType` ''SPEC #endif -{-# INLINE pipeTee #-} pipeTee :: Int -> IO () pipeTee value = withStream value (transformTeeMapM 1) @@ -652,7 +606,6 @@ inspect $ 'pipeTee `hasNoType` ''FL.Step inspect $ 'pipeTee `hasNoType` ''SPEC #endif -{-# INLINE pipeMapMX4 #-} pipeMapMX4 :: Int -> IO () pipeMapMX4 value = withStream value (transformMapM 4) @@ -664,7 +617,6 @@ inspect $ 'pipeMapMX4 `hasNoType` ''FL.Step inspect $ 'pipeMapMX4 `hasNoType` ''SPEC #endif -{-# INLINE pipeComposeX4 #-} pipeComposeX4 :: Int -> IO () pipeComposeX4 value = withStream value (transformComposeMapM 4) @@ -676,7 +628,6 @@ inspect $ 'pipeComposeX4 `hasNoType` ''FL.Step inspect $ 'pipeComposeX4 `hasNoType` ''SPEC #endif -{-# INLINE pipeTeeX4 #-} pipeTeeX4 :: Int -> IO () pipeTeeX4 value = withStream value (transformTeeMapM 4) @@ -692,7 +643,6 @@ inspect $ 'pipeTeeX4 `hasNoType` ''SPEC -- Scans ------------------------------------------------------------------------------- -{-# INLINE scansMapM #-} scansMapM :: Int -> IO () scansMapM value = withStream value (scanMapM 1) @@ -704,7 +654,6 @@ inspect $ 'scansMapM `hasNoType` ''FL.Step inspect $ 'scansMapM `hasNoType` ''SPEC #endif -{-# INLINE scansCompose #-} scansCompose :: Int -> IO () scansCompose value = withStream value (scanComposeMapM 1) @@ -716,7 +665,6 @@ inspect $ 'scansCompose `hasNoType` ''FL.Step inspect $ 'scansCompose `hasNoType` ''SPEC #endif -{-# INLINE scansTee #-} scansTee :: Int -> IO () scansTee value = withStream value (scanTeeMapM 1) @@ -728,7 +676,6 @@ inspect $ 'scansTee `hasNoType` ''FL.Step inspect $ 'scansTee `hasNoType` ''SPEC #endif -{-# INLINE scansMapMX4 #-} scansMapMX4 :: Int -> IO () scansMapMX4 value = withStream value (scanMapM 4) @@ -740,7 +687,6 @@ inspect $ 'scansMapMX4 `hasNoType` ''FL.Step inspect $ 'scansMapMX4 `hasNoType` ''SPEC #endif -{-# INLINE scansComposeX4 #-} scansComposeX4 :: Int -> IO () scansComposeX4 value = withStream value (scanComposeMapM 4) @@ -752,7 +698,6 @@ inspect $ 'scansComposeX4 `hasNoType` ''FL.Step inspect $ 'scansComposeX4 `hasNoType` ''SPEC #endif -{-# INLINE scansTeeX4 #-} scansTeeX4 :: Int -> IO () scansTeeX4 value = withStream value (scanTeeMapM 4) @@ -779,7 +724,6 @@ sieveScan = then (primes ++ [n], Just n) else (primes, Nothing)) (return ([2], Just 2))) -{-# INLINE naivePrimeSieve #-} naivePrimeSieve :: Int -> IO Int naivePrimeSieve value = withRandomIntIO $ \n -> diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Type.hs b/benchmark/Streamly/Benchmark/Data/Stream/Type.hs index 7a6bfcdde9..98c6d0a778 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Type.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Type.hs @@ -109,7 +109,6 @@ unCross = Stream.unNested -- fromList ------------------------------------------------------------------------------- -{-# INLINE sourceFromList #-} sourceFromList :: Int -> IO () sourceFromList value = withDrain $ \n -> Stream.fromList [n..n+value] @@ -124,7 +123,6 @@ inspect $ 'sourceFromList `hasNoType` ''SPEC -- elements we generate value/2 tuples and reduce each tuple's 'fromTuple' -- stream with a light 'sum' fold (avoiding a heavy, non-fusible 'concatMap' -- that would mask the cost of 'fromTuple'). -{-# INLINE sourceFromTuple #-} sourceFromTuple :: Int -> IO () sourceFromTuple value = withDrain $ \n -> Stream.mapM (Stream.fold Fold.sum . Stream.fromTuple) @@ -138,7 +136,6 @@ inspect $ 'sourceFromTuple `hasNoType` ''Fold.Step inspect $ 'sourceFromTuple `hasNoType` ''SPEC #endif -{-# INLINE sourceIsList #-} sourceIsList :: Int -> IO () sourceIsList value = withDrainPure $ \n -> GHC.fromList [n..n+value] @@ -149,7 +146,6 @@ inspect $ 'sourceIsList `hasNoType` ''Fold.Step inspect $ 'sourceIsList `hasNoType` ''SPEC #endif -{-# INLINE sourceIsString #-} sourceIsString :: Int -> IO () sourceIsString value = withDrainPure $ \n -> GHC.fromString (Prelude.replicate (n + value) 'a') @@ -450,7 +446,6 @@ _foldableMsum value n = -- Show instance ------------------------------------------------------------------------------- -{-# INLINE showInstance #-} showInstance :: Int -> IO String showInstance value = withPureStream value show @@ -462,7 +457,6 @@ showInstanceList = show -- Eq and Ord instances ------------------------------------------------------------------------------- -{-# INLINE eqInstance #-} eqInstance :: Int -> IO Bool eqInstance value = withPureStream value $ \src -> src == src @@ -473,7 +467,6 @@ inspect $ 'eqInstance `hasNoType` ''Fold.Step inspect $ 'eqInstance `hasNoType` ''SPEC #endif -{-# INLINE eqInstanceNotEq #-} eqInstanceNotEq :: Int -> IO Bool eqInstanceNotEq value = withPureStream value $ \src -> src /= src @@ -484,7 +477,6 @@ inspect $ 'eqInstanceNotEq `hasNoType` ''Fold.Step inspect $ 'eqInstanceNotEq `hasNoType` ''SPEC #endif -{-# INLINE ordInstance #-} ordInstance :: Int -> IO Bool ordInstance value = withPureStream value $ \src -> src < src @@ -499,7 +491,6 @@ inspect $ 'ordInstance `hasNoType` ''SPEC -- Reductions ------------------------------------------------------------------------------- -{-# INLINE uncons #-} uncons :: Int -> IO () uncons value = withStream value go @@ -518,7 +509,6 @@ inspect $ 'uncons `hasNoType` ''Fold.Step inspect $ 'uncons `hasNoType` ''SPEC #endif -{-# INLINE foldBreak #-} foldBreak :: Int -> IO () foldBreak value = withStream value go @@ -535,7 +525,6 @@ inspect $ 'foldBreak `hasNoType` ''Fold.Step inspect $ 'foldBreak `hasNoType` ''SPEC #endif -{-# INLINE foldrMElem #-} foldrMElem :: Int -> IO Bool foldrMElem value = withStream value @@ -550,7 +539,6 @@ inspect $ 'foldrMElem `hasNoType` ''Fold.Step inspect $ 'foldrMElem `hasNoType` ''SPEC #endif -{-# INLINE foldrMElemIdentity #-} foldrMElemIdentity :: Int -> IO Bool foldrMElemIdentity value = withPureStream value $ @@ -565,18 +553,15 @@ inspect $ 'foldrMElemIdentity `hasNoType` ''Fold.Step inspect $ 'foldrMElemIdentity `hasNoType` ''SPEC #endif -{-# INLINE foldrMToList #-} foldrMToList :: Int -> IO [Int] foldrMToList value = withStream value $ S.foldrM (\x xs -> (x :) <$> xs) (return []) -{-# INLINE foldrMToListIdentity #-} foldrMToListIdentity :: Int -> IO [Int] foldrMToListIdentity value = withPureStream value (runIdentity . S.foldrM (\x xs -> (x :) <$> xs) (return [])) -{-# INLINE foldl'Reduce #-} foldl'Reduce :: Int -> IO Int foldl'Reduce value = withStream value (S.foldl' (+) 0) @@ -585,7 +570,6 @@ inspect $ hasNoTypeClasses 'foldl'Reduce inspect $ 'foldl'Reduce `hasNoType` ''S.Step #endif -{-# INLINE foldl'ReduceIdentity #-} foldl'ReduceIdentity :: Int -> IO Int foldl'ReduceIdentity value = withPureStream value $ runIdentity . S.foldl' (+) 0 @@ -595,7 +579,6 @@ inspect $ hasNoTypeClasses 'foldl'ReduceIdentity inspect $ 'foldl'ReduceIdentity `hasNoType` ''S.Step #endif -{-# INLINE foldlM'Reduce #-} foldlM'Reduce :: Int -> IO Int foldlM'Reduce value = withStream value (S.foldlM' (\xs a -> return $ a + xs) (return 0)) @@ -605,7 +588,6 @@ inspect $ hasNoTypeClasses 'foldlM'Reduce inspect $ 'foldlM'Reduce `hasNoType` ''S.Step #endif -{-# INLINE foldlM'ReduceIdentity #-} foldlM'ReduceIdentity :: Int -> IO Int foldlM'ReduceIdentity value = withPureStream value $ @@ -616,7 +598,6 @@ inspect $ hasNoTypeClasses 'foldlM'ReduceIdentity inspect $ 'foldlM'ReduceIdentity `hasNoType` ''S.Step #endif -{-# INLINE toNull #-} toNull :: Int -> IO () toNull value = withStream value S.drain @@ -627,11 +608,9 @@ inspect $ 'toNull `hasNoType` ''Fold.Step inspect $ 'toNull `hasNoType` ''SPEC #endif -{-# INLINE drainPure #-} drainPure :: Int -> IO () drainPure value = withPureStream value $ runIdentity . drain -{-# INLINE drainN #-} drainN :: Int -> IO () drainN value = withStream value (S.fold (Fold.drainN value)) @@ -642,42 +621,34 @@ inspect $ 'drainN `hasNoType` ''Fold.Step inspect $ 'drainN `hasNoType` ''SPEC #endif -{-# INLINE foldl'Build #-} foldl'Build :: Int -> IO [Int] foldl'Build value = withStream value (S.foldl' (flip (:)) []) -{-# INLINE foldl'BuildIdentity #-} foldl'BuildIdentity :: Int -> IO [Int] foldl'BuildIdentity value = withPureStream value (runIdentity . S.foldl' (flip (:)) []) -{-# INLINE foldlM'Build #-} foldlM'Build :: Int -> IO [Int] foldlM'Build value = withStream value (S.foldlM' (\xs x -> return $ x : xs) (return [])) -{-# INLINE foldlM'BuildIdentity #-} foldlM'BuildIdentity :: Int -> IO [Int] foldlM'BuildIdentity value = withPureStream value (runIdentity . S.foldlM' (\xs x -> return $ x : xs) (return [])) -{-# INLINE foldrMToSum #-} foldrMToSum :: Int -> IO Int foldrMToSum value = withStream value (S.foldrM (\x xs -> (x +) <$> xs) (return 0)) -{-# INLINE foldrMToSumIdentity #-} foldrMToSumIdentity :: Int -> IO Int foldrMToSumIdentity value = withPureStream value (runIdentity . S.foldrM (\x xs -> (x +) <$> xs) (return 0)) -{-# INLINE toList' #-} toList' :: Int -> IO [Int] toList' value = withStream value S.toList -{-# INLINE eqByPure #-} eqByPure :: Int -> IO Bool eqByPure value = withPureStream value $ \src -> runIdentity $ S.eqBy (==) src src @@ -689,7 +660,6 @@ inspect $ 'eqByPure `hasNoType` ''S.Step inspect $ 'eqByPure `hasNoType` ''Fold.Step #endif -{-# INLINE cmpByPure #-} cmpByPure :: Int -> IO Ordering cmpByPure value = withPureStream value $ \src -> runIdentity $ S.cmpBy compare src src @@ -701,7 +671,6 @@ inspect $ 'cmpByPure `hasNoType` ''S.Step inspect $ 'cmpByPure `hasNoType` ''Fold.Step #endif -{-# INLINE eqBy #-} eqBy :: Int -> IO Bool eqBy value = withStream value $ \src -> S.eqBy (==) src src @@ -712,7 +681,6 @@ inspect $ 'eqBy `hasNoType` ''S.Step inspect $ 'eqBy `hasNoType` ''Fold.Step #endif -{-# INLINE cmpBy #-} cmpBy :: Int -> IO Ordering cmpBy value = withStream value $ \src -> S.cmpBy compare src src @@ -735,7 +703,6 @@ mapN n = composeN n $ fmap (+ 1) mapM :: MonadAsync m => Int -> Stream m Int -> m () mapM n = composeN n $ Stream.mapM return -{-# INLINE map1 #-} map1 :: Int -> IO () map1 value = withStream value (mapN 1) @@ -746,7 +713,6 @@ inspect $ 'map1 `hasNoType` ''FL.Step inspect $ 'map1 `hasNoType` ''SPEC #endif -{-# INLINE mapM1 #-} mapM1 :: Int -> IO () mapM1 value = withStream value (mapM 1) @@ -757,7 +723,6 @@ inspect $ 'mapM1 `hasNoType` ''FL.Step inspect $ 'mapM1 `hasNoType` ''SPEC #endif -{-# INLINE mapN4 #-} mapN4 :: Int -> IO () mapN4 value = withStream value (mapN 4) @@ -768,7 +733,6 @@ inspect $ 'mapN4 `hasNoType` ''FL.Step inspect $ 'mapN4 `hasNoType` ''SPEC #endif -{-# INLINE mapM4 #-} mapM4 :: Int -> IO () mapM4 value = withStream value (mapM 4) @@ -791,7 +755,6 @@ _takeOne n = composeN n $ Stream.take 1 takeAll :: MonadIO m => Int -> Int -> Stream m Int -> m () takeAll value n = composeN n $ Stream.take (value + 1) -{-# INLINE takeAll1 #-} takeAll1 :: Int -> IO () takeAll1 value = withStream value (takeAll value 1) @@ -802,7 +765,6 @@ inspect $ 'takeAll1 `hasNoType` ''FL.Step inspect $ 'takeAll1 `hasNoType` ''SPEC #endif -{-# INLINE takeAll4 #-} takeAll4 :: Int -> IO () takeAll4 value = withStream value (takeAll value 4) @@ -817,7 +779,6 @@ inspect $ 'takeAll4 `hasNoType` ''SPEC takeWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m () takeWhileTrue value n = composeN n $ Stream.takeWhile (<= (value + 1)) -{-# INLINE takeWhileTrue1 #-} takeWhileTrue1 :: Int -> IO () takeWhileTrue1 value = withStream value (takeWhileTrue value 1) @@ -828,7 +789,6 @@ inspect $ 'takeWhileTrue1 `hasNoType` ''FL.Step inspect $ 'takeWhileTrue1 `hasNoType` ''SPEC #endif -{-# INLINE takeWhileTrue4 #-} takeWhileTrue4 :: Int -> IO () takeWhileTrue4 value = withStream value (takeWhileTrue value 4) @@ -843,7 +803,6 @@ inspect $ 'takeWhileTrue4 `hasNoType` ''SPEC takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m () takeWhileMTrue value n = composeN n $ Stream.takeWhileM (return . (<= (value + 1))) -{-# INLINE takeWhileMTrue4 #-} takeWhileMTrue4 :: Int -> IO () takeWhileMTrue4 value = withStream value (takeWhileMTrue value 4) @@ -862,7 +821,6 @@ inspect $ 'takeWhileMTrue4 `hasNoType` ''SPEC -- Appending ------------------------------------------------------------------------------- -{-# INLINE serial2 #-} serial2 :: Int -> IO () serial2 count = withRandomIntIO $ \n -> drain $ @@ -878,7 +836,6 @@ inspect $ 'serial2 `hasNoType` ''S.Step inspect $ 'serial2 `hasNoType` ''Fold.Step #endif -{-# INLINE serial4 #-} serial4 :: Int -> IO () serial4 count = withRandomIntIO $ \n -> drain $ @@ -902,7 +859,6 @@ inspect $ 'serial4 `hasNoType` ''Fold.Step -- Zipping ------------------------------------------------------------------------------- -{-# INLINE zipWith #-} zipWith :: Int -> IO () zipWith value = withRandomIntIO $ \n -> let src = sourceUnfoldrM value n @@ -914,7 +870,6 @@ inspect $ 'zipWith `hasNoType` ''SPEC inspect $ 'zipWith `hasNoType` ''Fold.Step #endif -{-# INLINE zipWithM #-} zipWithM :: Int -> IO () zipWithM value = withRandomIntIO $ \n -> let src = sourceUnfoldrM value n @@ -940,7 +895,6 @@ sourceConcatMapStreams :: Monad m => Int -> Int -> Int -> Stream m (Stream m Int sourceConcatMapStreams outer inner start = fmap (sourceUnfoldr inner) $ sourceUnfoldr outer start -{-# INLINE concatMap #-} concatMap :: Int -> Int -> IO () concatMap outer inner = withRandomIntIO $ \n -> drain $ S.concatMap @@ -954,7 +908,6 @@ inspect $ 'concatMap `hasNoType` ''SPEC inspect $ 'concatMap `hasNoType` ''Fold.Step #endif -{-# INLINE concatMapM2 #-} concatMapM2 :: Int -> IO () concatMapM2 value = withStream value $ \s -> drain $ do @@ -962,7 +915,6 @@ concatMapM2 value = withStream value $ \s -> pure $ Stream.concatMapM (\y -> pure $ Stream.fromPure $ x + y) s) s -{-# INLINE concatMapM3 #-} concatMapM3 :: Int -> IO () concatMapM3 value = withStream value $ \s -> drain $ do @@ -971,7 +923,6 @@ concatMapM3 value = withStream value $ \s -> pure $ Stream.concatMapM (\z -> pure $ Stream.fromPure $ x + y + z) s) s) s -{-# INLINE concatMapViaUnfoldEach #-} concatMapViaUnfoldEach :: Int -> Int -> IO () concatMapViaUnfoldEach outer inner = withRandomIntIO $ \n -> drain $ cmap @@ -982,7 +933,6 @@ concatMapViaUnfoldEach outer inner = withRandomIntIO $ \n -> cmap f = Stream.unfoldEach (UF.lmap f UF.fromStream) -{-# INLINE concatMapM #-} concatMapM :: Int -> Int -> IO () concatMapM outer inner = withRandomIntIO $ \n -> drain $ S.concatMapM @@ -991,19 +941,16 @@ concatMapM outer inner = withRandomIntIO $ \n -> -- concatMap Streams -{-# INLINE concatMapSingletonStreams #-} concatMapSingletonStreams :: Int -> IO () concatMapSingletonStreams value = withRandomIntIO (drain . S.concatMap id . sourceConcatMapSingletonStreams value) -{-# INLINE concatMapStreams #-} concatMapStreams :: Int -> Int -> IO () concatMapStreams outer inner = withRandomIntIO (S.drain . S.concatMap id . sourceConcatMapStreams outer inner) -- concatMap unfoldr/unfoldr -{-# INLINE concatMapPure #-} concatMapPure :: Int -> Int -> IO () concatMapPure outer inner = withRandomIntIO $ \n -> drain $ S.concatMap @@ -1033,7 +980,6 @@ sourceUnfoldrMUnfold size start = UF.unfoldrM step then Just (i, i + 1) else Nothing -{-# INLINE unfoldEach #-} unfoldEach :: Int -> Int -> IO () unfoldEach outer inner = withRandomIntIO $ \start -> drain $ S.unfoldEach (sourceUnfoldrMUnfold inner start) @@ -1047,7 +993,6 @@ inspect $ 'unfoldEach `hasNoType` ''S.Step inspect $ 'unfoldEach `hasNoType` ''Fold.Step #endif -{-# INLINE unfoldEach2 #-} unfoldEach2 :: Int -> Int -> IO () unfoldEach2 outer inner = withRandomIntIO $ \start -> drain $ S.unfoldEach (UF.carryInput (sourceUnfoldrMUnfold inner start)) @@ -1061,7 +1006,6 @@ inspect $ 'unfoldEach2 `hasNoType` ''Fold.Step inspect $ 'unfoldEach2 `hasNoType` ''SPEC #endif -{-# INLINE unfoldEach3 #-} unfoldEach3 :: Int -> IO () unfoldEach3 linearCount = withRandomIntIO $ \start -> drain $ do S.unfoldEach (UF.carryInput (UF.lmap snd (sourceUnfoldrMUnfold nestedCount3 start))) @@ -1079,7 +1023,6 @@ inspect $ 'unfoldEach3 `hasNoType` ''Fold.Step inspect $ 'unfoldEach3 `hasNoType` ''SPEC #endif -{-# INLINE unfoldCross #-} unfoldCross :: Int -> Int -> IO () unfoldCross outer inner = withRandomIntIO $ \start -> drain $ Stream.unfoldCross @@ -1161,7 +1104,6 @@ filterAllInMPure linearCount start = drain $ unCross $ do nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) -{-# INLINE cross2 #-} cross2 :: Int -> IO () cross2 linearCount = withRandomIntIO $ \start -> drain $ Stream.crossWith (+) @@ -1172,7 +1114,6 @@ cross2 linearCount = withRandomIntIO $ \start -> drain $ nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) -{-# INLINE crossApply #-} crossApply :: Int -> IO () crossApply linearCount = withRandomIntIO $ \start -> drain $ Stream.crossApply @@ -1183,7 +1124,6 @@ crossApply linearCount = withRandomIntIO $ \start -> drain $ nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) -{-# INLINE crossApplyFst #-} crossApplyFst :: Int -> IO () crossApplyFst linearCount = withRandomIntIO $ \start -> drain $ Stream.crossApplyFst @@ -1194,7 +1134,6 @@ crossApplyFst linearCount = withRandomIntIO $ \start -> drain $ nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) -{-# INLINE crossApplySnd #-} crossApplySnd :: Int -> IO () crossApplySnd linearCount = withRandomIntIO $ \start -> drain $ Stream.crossApplySnd @@ -1209,13 +1148,11 @@ crossApplySnd linearCount = withRandomIntIO $ \start -> drain $ -- Monad ------------------------------------------------------------------------------- -{-# INLINE drainConcatFor1 #-} drainConcatFor1 :: Int -> IO () drainConcatFor1 count = withStream count $ \s -> drain $ Stream.concatFor s $ \x -> Stream.fromPure $ x + 1 -{-# INLINE drainConcatFor #-} drainConcatFor :: Int -> IO () drainConcatFor count = withStream count $ \s -> drain $ do @@ -1223,7 +1160,6 @@ drainConcatFor count = withStream count $ \s -> Stream.concatFor s $ \y -> Stream.fromPure $ x + y -{-# INLINE drainConcatForM #-} drainConcatForM :: Int -> IO () drainConcatForM count = withStream count $ \s -> drain $ do @@ -1231,7 +1167,6 @@ drainConcatForM count = withStream count $ \s -> pure $ Stream.concatForM s $ \y -> pure $ Stream.fromPure $ x + y -{-# INLINE drainConcatFor3 #-} drainConcatFor3 :: Int -> IO () drainConcatFor3 count = withStream count $ \s -> drain $ do @@ -1240,7 +1175,6 @@ drainConcatFor3 count = withStream count $ \s -> Stream.concatFor s $ \z -> Stream.fromPure $ x + y + z -{-# INLINE drainConcatFor4 #-} drainConcatFor4 :: Int -> IO () drainConcatFor4 count = withStream count $ \s -> drain $ do @@ -1250,7 +1184,6 @@ drainConcatFor4 count = withStream count $ \s -> Stream.concatFor s $ \w -> Stream.fromPure $ x + y + z + w -{-# INLINE drainConcatFor5 #-} drainConcatFor5 :: Int -> IO () drainConcatFor5 count = withStream count $ \s -> drain $ do @@ -1261,7 +1194,6 @@ drainConcatFor5 count = withStream count $ \s -> Stream.concatFor s $ \u -> Stream.fromPure $ x + y + z + w + u -{-# INLINE drainConcatFor3M #-} drainConcatFor3M :: Int -> IO () drainConcatFor3M count = withStream count $ \s -> drain $ do @@ -1270,7 +1202,6 @@ drainConcatFor3M count = withStream count $ \s -> pure $ Stream.concatForM s $ \z -> pure $ Stream.fromPure $ x + y + z -{-# INLINE filterAllInConcatFor #-} filterAllInConcatFor :: Int -> IO () filterAllInConcatFor count = withStream count $ \s -> drain $ do @@ -1281,7 +1212,6 @@ filterAllInConcatFor count = withStream count $ \s -> then Stream.fromPure s1 else Stream.nil -{-# INLINE filterAllOutConcatFor #-} filterAllOutConcatFor :: Int -> IO () filterAllOutConcatFor count = withStream count $ \s -> drain $ do @@ -1396,7 +1326,6 @@ unfoldEachBounded maxVal = withRandomIntIO $ \n -> -- Fold Many ------------------------------------------------------------------------------- -{-# INLINE foldMany #-} foldMany :: Int -> IO () foldMany value = withStream value $ @@ -1413,7 +1342,6 @@ inspect $ 'foldMany `hasNoType` ''FL.Step inspect $ 'foldMany `hasNoType` ''SPEC #endif -{-# INLINE foldMany1 #-} foldMany1 :: Int -> IO () foldMany1 value = withStream value $ @@ -1430,7 +1358,6 @@ inspect $ 'foldMany1 `hasNoType` ''FL.Step inspect $ 'foldMany1 `hasNoType` ''SPEC #endif -{-# INLINE refoldMany #-} refoldMany :: Int -> IO () refoldMany value = withStream value $ From 94fe45026cd58e7aa3bfca7b9f48678b8b18d609 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sun, 14 Jun 2026 04:48:13 +0530 Subject: [PATCH 05/20] Disable Unicode.Utf8 benchmark It is broken. --- benchmark/streamly-benchmarks.cabal | 19 ++++++++++--------- targets/Targets.hs | 2 +- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index 66297535a2..7fe4946df0 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -667,12 +667,13 @@ benchmark Unicode.Stream else buildable: True -benchmark Unicode.Utf8 - import: bench-options - type: exitcode-stdio-1.0 - hs-source-dirs: Streamly/Benchmark/Unicode - main-is: Utf8.hs - if flag(use-streamly-core) - buildable: False - else - buildable: True +-- XXX this is broken +-- benchmark Unicode.Utf8 +-- import: bench-options +-- type: exitcode-stdio-1.0 +-- hs-source-dirs: Streamly/Benchmark/Unicode +-- main-is: Utf8.hs +-- if flag(use-streamly-core) +-- buildable: False +-- else +-- buildable: True diff --git a/targets/Targets.hs b/targets/Targets.hs index 596420c1e5..3a776bf0d8 100644 --- a/targets/Targets.hs +++ b/targets/Targets.hs @@ -271,6 +271,6 @@ targets = , ("Unicode.Char", ["testDevOnly"]) , ("Unicode.Parser", ["streamly_core_grp"]) , ("Unicode.Stream", []) - , ("Unicode.Utf8", ["noTest"]) + -- , ("Unicode.Utf8", ["noTest"]) , ("version-bounds", ["noBench"]) ] From b4a8856c15d001b3fc80cb8c9f4f046df57b2a3e Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sun, 14 Jun 2026 05:15:28 +0530 Subject: [PATCH 06/20] Flatten bgroup (bench groups) in all benchmarks --- benchmark/Streamly/Benchmark/Data/Array.hs | 25 +- .../Streamly/Benchmark/Data/Array/Common.hs | 57 +- .../Streamly/Benchmark/Data/Array/Generic.hs | 19 +- .../Benchmark/Data/Array/SmallArray.hs | 5 +- .../Streamly/Benchmark/Data/Array/Stream.hs | 42 +- benchmark/Streamly/Benchmark/Data/Fold.hs | 299 ++++---- .../Streamly/Benchmark/Data/Fold/Prelood.hs | 26 +- .../Streamly/Benchmark/Data/Fold/Window.hs | 197 +++-- benchmark/Streamly/Benchmark/Data/MutArray.hs | 53 +- benchmark/Streamly/Benchmark/Data/Scanl.hs | 10 +- .../Benchmark/Data/Scanl/Concurrent.hs | 4 +- .../Streamly/Benchmark/Data/Scanl/Window.hs | 94 ++- .../Data/Stream/Prelude/ConcurrentCommon.hs | 133 ++-- .../Data/Stream/Prelude/Exceptions.hs | 61 +- .../Data/Stream/Transform/Composed.hs | 3 +- benchmark/Streamly/Benchmark/Data/StreamK.hs | 688 +++++++++--------- .../Benchmark/Data/Unfold/Prelude1.hs | 10 +- .../Benchmark/FileSystem/Handle/Read.hs | 132 ++-- .../Benchmark/FileSystem/Handle/ReadWrite.hs | 40 +- .../Streamly/Benchmark/Unicode/Stream.hs | 74 +- benchmark/Streamly/Benchmark/Unicode/Utf8.hs | 2 +- benchmark/bench-runner/Main.hs | 22 +- 22 files changed, 923 insertions(+), 1073 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Array.hs b/benchmark/Streamly/Benchmark/Data/Array.hs index 0dd8c7139d..1dd43d6a05 100644 --- a/benchmark/Streamly/Benchmark/Data/Array.hs +++ b/benchmark/Streamly/Benchmark/Data/Array.hs @@ -85,29 +85,22 @@ createOfLastMax value = withStream value (S.fold (IA.createOfLast (value + 1))) o_1_space_generation :: Int -> [Benchmark] o_1_space_generation value = - [ bgroup - "generation" - [ benchIO "write . intFromTo" $ sourceIntFromToFromStream value - , benchIO "read" $ readInstance value - , benchIO "writeN . IsList.fromList" $ sourceIsList value - , benchIO "writeN . IsString.fromString" $ sourceIsString value - ] + [ benchIO "write . intFromTo" $ sourceIntFromToFromStream value + , benchIO "read" $ readInstance value + , benchIO "writeN . IsList.fromList" $ sourceIsList value + , benchIO "writeN . IsString.fromString" $ sourceIsString value ] o_1_space_elimination :: Int -> [Benchmark] o_1_space_elimination value = - [ bgroup "elimination" - [ benchIO "length . IsList.toList" $ toListLength value - , benchIO "createOfLast.1" $ createOfLast1 value - , benchIO "createOfLast.10" $ createOfLast10 value - ] - ] + [ benchIO "length . IsList.toList" $ toListLength value + , benchIO "createOfLast.1" $ createOfLast1 value + , benchIO "createOfLast.10" $ createOfLast10 value + ] o_n_heap_serial :: Int -> [Benchmark] o_n_heap_serial value = - [ bgroup "elimination" - [ benchIO "createOfLast.Max" $ createOfLastMax value - ] + [ benchIO "createOfLast.Max" $ createOfLastMax value ] moduleName :: String diff --git a/benchmark/Streamly/Benchmark/Data/Array/Common.hs b/benchmark/Streamly/Benchmark/Data/Array/Common.hs index 5c2cc66629..02f8d2cbbd 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Common.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Common.hs @@ -142,54 +142,43 @@ writeN value = withStream value (S.fold (A.createOf value)) common_o_1_space_generation :: Int -> [Benchmark] common_o_1_space_generation value = - [ bgroup - "generation" - [ benchIO "writeN . intFromTo" $ sourceIntFromTo value - , benchIO "fromList . intFromTo" $ sourceIntFromToFromList value - , benchIO "writeN . unfoldr" $ sourceUnfoldr value - , benchIO "writeN . fromList" $ sourceFromList value - , benchIO "show" $ showStream value - ] + [ benchIO "writeN . intFromTo" $ sourceIntFromTo value + , benchIO "fromList . intFromTo" $ sourceIntFromToFromList value + , benchIO "writeN . unfoldr" $ sourceUnfoldr value + , benchIO "writeN . fromList" $ sourceFromList value + , benchIO "show" $ showStream value ] common_o_1_space_elimination :: Int -> [Benchmark] common_o_1_space_elimination value = - [ bgroup "elimination" - [ benchIO "id" $ idArr value - , benchIO "==" $ eqInstance value - , benchIO "/=" $ eqInstanceNotEq value - , benchIO "<" $ ordInstance value - , benchIO "min" $ ordInstanceMin value - , benchIO "foldl'" $ pureFoldl' value - , benchIO "read" $ unfoldReadDrain value - , benchIO "toStreamRev" $ toStreamRevDrain value - ] - ] + [ benchIO "id" $ idArr value + , benchIO "==" $ eqInstance value + , benchIO "/=" $ eqInstanceNotEq value + , benchIO "<" $ ordInstance value + , benchIO "min" $ ordInstanceMin value + , benchIO "foldl'" $ pureFoldl' value + , benchIO "unfoldRead" $ unfoldReadDrain value + , benchIO "toStreamRev" $ toStreamRevDrain value + ] common_o_n_heap_serial :: Int -> [Benchmark] common_o_n_heap_serial value = - [ bgroup "elimination" - [ benchIO "writeN" $ writeN value - ] + [ benchIO "writeN" $ writeN value ] common_o_1_space_transformation :: Int -> [Benchmark] common_o_1_space_transformation value = - [ bgroup "transformation" - [ benchIO "scanl'" $ scanl' value - , benchIO "scanl1'" $ scanl1' value - , benchIO "map" $ map value - ] - ] + [ benchIO "scanl'" $ scanl' value + , benchIO "scanl1'" $ scanl1' value + , benchIO "map" $ map value + ] common_o_1_space_transformationX4 :: Int -> [Benchmark] common_o_1_space_transformationX4 value = - [ bgroup "transformationX4" - [ benchIO "scanl'" $ scanl'X4 value - , benchIO "scanl1'" $ scanl1'X4 value - , benchIO "map" $ mapX4 value - ] - ] + [ benchIO "scanl'X4" $ scanl'X4 value + , benchIO "scanl1'X4" $ scanl1'X4 value + , benchIO "mapX4" $ mapX4 value + ] commonBenchmarks :: Int -> [(SpaceComplexity, Benchmark)] commonBenchmarks size = diff --git a/benchmark/Streamly/Benchmark/Data/Array/Generic.hs b/benchmark/Streamly/Benchmark/Data/Array/Generic.hs index 58f6d5f780..57184fbcef 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Generic.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Generic.hs @@ -73,26 +73,19 @@ createOfLastMax value = withStream value (S.fold (IA.createOfLast (value + 1))) o_1_space_generation :: Int -> [Benchmark] o_1_space_generation value = - [ bgroup - "generation" - [ benchIO "write . intFromTo" $ sourceIntFromToFromStream value - , benchIO "read" $ readInstance value - ] + [ benchIO "write . intFromTo" $ sourceIntFromToFromStream value + , benchIO "read" $ readInstance value ] o_1_space_elimination :: Int -> [Benchmark] o_1_space_elimination value = - [ bgroup "elimination" - [ benchIO "createOfLast.1" $ createOfLast1 value - , benchIO "createOfLast.10" $ createOfLast10 value - ] - ] + [ benchIO "createOfLast.1" $ createOfLast1 value + , benchIO "createOfLast.10" $ createOfLast10 value + ] o_n_heap_serial :: Int -> [Benchmark] o_n_heap_serial value = - [ bgroup "elimination" - [ benchIO "createOfLast.Max" $ createOfLastMax value - ] + [ benchIO "createOfLast.Max" $ createOfLastMax value ] moduleName :: String diff --git a/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs b/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs index cb4dae3fa4..44e25eb3f3 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs @@ -51,10 +51,7 @@ foldableSum = P.sum o_1_space_generation :: Int -> [Benchmark] o_1_space_generation value = - [ bgroup - "generation" - [ benchIO "read" $ readInstance value - ] + [ benchIO "read" $ readInstance value ] {- diff --git a/benchmark/Streamly/Benchmark/Data/Array/Stream.hs b/benchmark/Streamly/Benchmark/Data/Array/Stream.hs index 40699895f4..8df6876b93 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Stream.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Stream.hs @@ -160,23 +160,21 @@ inspect $ 'toChunksSplitOn `hasNoType` ''Step o_1_space_read_chunked :: BenchEnv -> [Benchmark] o_1_space_read_chunked env = -- read using toChunks instead of read - [ bgroup "reduce/toChunks" - [ mkBench "Stream.last" env $ \inH _ -> - toChunksLast inH - -- Note: this cannot be fairly compared with GNU wc -c or wc -m as - -- wc uses lseek to just determine the file size rather than reading - -- and counting characters. - , mkBench "Stream.sum . Stream.map Array.length" env $ \inH _ -> - toChunksSumLengths inH - , mkBench "splitOnSuffix" env $ \inH _ -> - toChunksSplitOnSuffix inH - , mkBench "splitOn" env $ \inH _ -> - toChunksSplitOn inH - , mkBench "countBytes" env $ \inH _ -> - toChunksCountBytes inH - , mkBenchSmall "decodeUtf8Arrays" env $ \inH _ -> - toChunksDecodeUtf8Arrays inH - ] + [ mkBench "Stream.last" env $ \inH _ -> + toChunksLast inH + -- Note: this cannot be fairly compared with GNU wc -c or wc -m as + -- wc uses lseek to just determine the file size rather than reading + -- and counting characters. + , mkBench "Stream.sum . Stream.map Array.length" env $ \inH _ -> + toChunksSumLengths inH + , mkBench "splitOnSuffix" env $ \inH _ -> + toChunksSplitOnSuffix inH + , mkBench "splitOn" env $ \inH _ -> + toChunksSplitOn inH + , mkBench "countBytes" env $ \inH _ -> + toChunksCountBytes inH + , mkBenchSmall "decodeUtf8Arrays" env $ \inH _ -> + toChunksDecodeUtf8Arrays inH ] ------------------------------------------------------------------------------- @@ -213,12 +211,10 @@ inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark] o_1_space_copy_toChunks_group_ungroup env = - [ bgroup "copy/toChunks/group-ungroup" - [ mkBench "interposeSuffix . splitOnSuffix" env $ \inh outh -> - copyChunksSplitInterposeSuffix inh outh - , mkBenchSmall "interpose . splitOn" env $ \inh outh -> - copyChunksSplitInterpose inh outh - ] + [ mkBench "interposeSuffix . splitOnSuffix" env $ \inh outh -> + copyChunksSplitInterposeSuffix inh outh + , mkBenchSmall "interpose . splitOn" env $ \inh outh -> + copyChunksSplitInterpose inh outh ] ------------------------------------------------------------------------------- diff --git a/benchmark/Streamly/Benchmark/Data/Fold.hs b/benchmark/Streamly/Benchmark/Data/Fold.hs index b12cf4d7df..732bddc89f 100644 --- a/benchmark/Streamly/Benchmark/Data/Fold.hs +++ b/benchmark/Streamly/Benchmark/Data/Fold.hs @@ -637,62 +637,56 @@ o_1_space_reduce_read_split :: BenchEnv -> [(SpaceComplexity, Benchmark)] o_1_space_reduce_read_split env = -- NOTE: keep the benchmark names consistent with Data.Stream.split* fmap (SpaceO_1,) - [ bgroup "FileSplitElem" - -- Splitting on single element - [ - mkBench "takeEndBy_ infix (splitOn)" env $ \inh _ -> - fileInfixTakeEndBy_ inh - , mkBench "takeEndBy_ suffix (splitOnSuffix)" env $ \inh _ -> - fileSuffixTakeEndBy_ inh - , mkBench "takeEndBy_ suffix parseMany (splitOnSuffix)" env - $ \inh _ -> parseFileSuffixTakeEndBy_ inh - , mkBench "takeEndBy suffix (splitWithSuffix)" env $ \inh _ -> - fileSuffixTakeEndBy inh - ] + -- Splitting on single element + [ mkBench "takeEndBy_ infix (splitOn)" env $ \inh _ -> + fileInfixTakeEndBy_ inh + , mkBench "takeEndBy_ suffix (splitOnSuffix)" env $ \inh _ -> + fileSuffixTakeEndBy_ inh + , mkBench "takeEndBy_ suffix parseMany (splitOnSuffix)" env + $ \inh _ -> parseFileSuffixTakeEndBy_ inh + , mkBench "takeEndBy suffix (splitWithSuffix)" env $ \inh _ -> + fileSuffixTakeEndBy inh -- Splitting on sequence - , bgroup "FileSplitSeq" - [ - -- Infix takeEndBySeq_ - mkBench "takeEndBySeq_ infix empty pattern" env $ \inh _ -> - splitOnSeq "" inh - , mkBench "takeEndBySeq_ infix lf" env $ \inh _ -> - splitOnSeq "\n" inh - , mkBench "takeEndBySeq_ infix a" env $ \inh _ -> - splitOnSeq "a" inh - , mkBench "takeEndBySeq_ infix crlf" env $ \inh _ -> - splitOnSeq "\r\n" inh - , mkBench "takeEndBySeq_ infix aa" env $ \inh _ -> - splitOnSeq "aa" inh - , mkBench "takeEndBySeq_ infix aaaa" env $ \inh _ -> - splitOnSeq "aaaa" inh - , mkBench "takeEndBySeq_ infix abcdefgh" env $ \inh _ -> - splitOnSeq "abcdefgh" inh - , mkBench "takeEndBySeq_ infix abcdefghi" env $ \inh _ -> - splitOnSeq "abcdefghi" inh - , mkBench "takeEndBySeq_ infix catcatcatcatcat" env $ \inh _ -> - splitOnSeq "catcatcatcatcat" inh - , mkBench "takeEndBySeq_ infix abcdefghijklmnopqrstuvwxyz" - env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh - , mkBench "takeEndBySeq_ infix 100k long pattern" - env $ \inh _ -> splitOnSeq100k inh - - -- Suffix takeEndBySeq_ - , mkBench "takeEndBySeq_ suffix empty pattern" env $ \inh _ -> - splitOnSuffixSeq "" inh - , mkBench "takeEndBySeq_ suffix lf" env $ \inh _ -> - splitOnSuffixSeq "\n" inh - , mkBench "takeEndBySeq_ suffix crlf" env $ \inh _ -> - splitOnSuffixSeq "\r\n" inh - , mkBenchSmall "takeEndBySeq_ suffix abcdefghijklmnopqrstuvwxyz" - env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh - - -- Suffix takeEndBySeq - , mkBench "takeEndBySeq suffix crlf" env $ \inh _ -> - splitWithSuffixSeq "\r\n" inh - , mkBenchSmall "takeEndBySeq suffix abcdefghijklmnopqrstuvwxyz" - env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh - ] + -- Infix takeEndBySeq_ + , mkBench "takeEndBySeq_ infix empty pattern" env $ \inh _ -> + splitOnSeq "" inh + , mkBench "takeEndBySeq_ infix lf" env $ \inh _ -> + splitOnSeq "\n" inh + , mkBench "takeEndBySeq_ infix a" env $ \inh _ -> + splitOnSeq "a" inh + , mkBench "takeEndBySeq_ infix crlf" env $ \inh _ -> + splitOnSeq "\r\n" inh + , mkBench "takeEndBySeq_ infix aa" env $ \inh _ -> + splitOnSeq "aa" inh + , mkBench "takeEndBySeq_ infix aaaa" env $ \inh _ -> + splitOnSeq "aaaa" inh + , mkBench "takeEndBySeq_ infix abcdefgh" env $ \inh _ -> + splitOnSeq "abcdefgh" inh + , mkBench "takeEndBySeq_ infix abcdefghi" env $ \inh _ -> + splitOnSeq "abcdefghi" inh + , mkBench "takeEndBySeq_ infix catcatcatcatcat" env $ \inh _ -> + splitOnSeq "catcatcatcatcat" inh + , mkBench "takeEndBySeq_ infix abcdefghijklmnopqrstuvwxyz" + env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh + , mkBench "takeEndBySeq_ infix 100k long pattern" + env $ \inh _ -> splitOnSeq100k inh + + -- Suffix takeEndBySeq_ + , mkBench "takeEndBySeq_ suffix empty pattern" env $ \inh _ -> + splitOnSuffixSeq "" inh + , mkBench "takeEndBySeq_ suffix lf" env $ \inh _ -> + splitOnSuffixSeq "\n" inh + , mkBench "takeEndBySeq_ suffix crlf" env $ \inh _ -> + splitOnSuffixSeq "\r\n" inh + , mkBenchSmall "takeEndBySeq_ suffix abcdefghijklmnopqrstuvwxyz" + env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh + + -- Suffix takeEndBySeq + , mkBench "takeEndBySeq suffix crlf" env $ \inh _ -> + splitWithSuffixSeq "\r\n" inh + , mkBenchSmall "takeEndBySeq suffix abcdefghijklmnopqrstuvwxyz" + env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh ] -- | Infix split on a character sequence. @@ -708,12 +702,10 @@ splitOnSeqUtf8 str inh = o_1_space_reduce_toChunks_split :: BenchEnv -> [(SpaceComplexity, Benchmark)] o_1_space_reduce_toChunks_split env = fmap (SpaceO_1,) - [ bgroup "FileSplitSeqUtf8" - [ mkBenchSmall "takeEndBySeq_ infix abcdefgh" - env $ \inh _ -> splitOnSeqUtf8 "abcdefgh" inh - , mkBenchSmall "takeEndBySeq_ infix abcdefghijklmnopqrstuvwxyz" - env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh - ] + [ mkBenchSmall "takeEndBySeq_ infix abcdefgh (Utf8)" + env $ \inh _ -> splitOnSeqUtf8 "abcdefgh" inh + , mkBenchSmall "takeEndBySeq_ infix abcdefghijklmnopqrstuvwxyz (Utf8)" + env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh ] ------------------------------------------------------------------------------- @@ -1066,97 +1058,90 @@ instance NFData a => NFData (Stream Identity a) where o_1_space_serial_elimination :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_serial_elimination value = fmap (SpaceO_1,) - [ bgroup "elimination" - [ benchIO "drain" $ drain value - , benchIO "drainBy" $ drainBy value - , benchIO "drainN" $ drainN value - , benchIO "last" $ last value - , benchIO "length" $ length value - , benchIO "top" $ top value - , benchIO "bottom" $ bottom value - , benchIO "sum" $ sum value - , benchIO "sum (foldMap)" $ foldMapSum value - , benchIO "product" $ product value - , benchIO "maximumBy" $ maximumBy value - , benchIO "maximum" $ maximum value - , benchIO "minimumBy" $ minimumBy value - , benchIO "minimum" $ minimum value - , benchIO "mean" $ mean value + [ benchIO "drain" $ drain value + , benchIO "drainBy" $ drainBy value + , benchIO "drainN" $ drainN value + , benchIO "last" $ last value + , benchIO "length" $ length value + , benchIO "top" $ top value + , benchIO "bottom" $ bottom value + , benchIO "sum" $ sum value + , benchIO "sum (foldMap)" $ foldMapSum value + , benchIO "product" $ product value + , benchIO "maximumBy" $ maximumBy value + , benchIO "maximum" $ maximum value + , benchIO "minimumBy" $ minimumBy value + , benchIO "minimum" $ minimum value + , benchIO "mean" $ mean value {- - -- These are already benchmarked in streamly-statistics package. If we - -- still want to keep these tests here, perhaps we should move them to a - -- different module so we can remove -fno-warn-warnings-deprecations. + -- These are already benchmarked in streamly-statistics package. If we + -- still want to keep these tests here, perhaps we should move them to a + -- different module so we can remove -fno-warn-warnings-deprecations. - , benchIO "variance" $ variance value - , benchIO "stdDev" $ stdDev value + , benchIO "variance" $ variance value + , benchIO "stdDev" $ stdDev value -} - , benchIO "mconcat" $ mconcat value - , benchIO "foldMap" $ foldMap value - , benchIO "foldMapM" $ foldMapM value - , benchIO "index" $ index value - -- , benchIO "head" $ head value - , benchIO "find" $ find value - , benchIO "lookup" $ lookup value - , benchIO "findIndex" $ findIndex value - , benchIO "elemIndex" $ elemIndex value - -- , benchIO "null" $ null value - , benchIO "elem" $ elem value - , benchIO "notElem" $ notElem value - , benchIO "all" $ all value - , benchIO "any" $ any value - , benchIO "take" $ take value - , benchIO "takeEndBy_" $ takeEndBy_ value - , benchIO "and" $ and value - , benchIO "or" $ or value - ] + , benchIO "mconcat" $ mconcat value + , benchIO "foldMap" $ foldMap value + , benchIO "foldMapM" $ foldMapM value + , benchIO "index" $ index value + -- , benchIO "head" $ head value + , benchIO "find" $ find value + , benchIO "lookup" $ lookup value + , benchIO "findIndex" $ findIndex value + , benchIO "elemIndex" $ elemIndex value + -- , benchIO "null" $ null value + , benchIO "elem" $ elem value + , benchIO "notElem" $ notElem value + , benchIO "all" $ all value + , benchIO "any" $ any value + , benchIO "take" $ take value + , benchIO "takeEndBy_" $ takeEndBy_ value + , benchIO "and" $ and value + , benchIO "or" $ or value ] o_1_space_serial_transformation :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_serial_transformation value = fmap (SpaceO_1,) - [ bgroup "transformation" - [ benchIO "map" $ map value - , benchIO "mapMaybe" $ mapMaybe value - , benchIO "rsequence" $ rsequence value - , benchIO "rmapM" $ rmapM value - , benchIO "pipe-mapM" $ pipeMapM value + [ benchIO "map" $ map value + , benchIO "mapMaybe" $ mapMaybe value + , benchIO "rsequence" $ rsequence value + , benchIO "rmapM" $ rmapM value + , benchIO "pipe-mapM" $ pipeMapM value {- - , benchIO "fold-runScan" $ foldRunScan value + , benchIO "fold-runScan" $ foldRunScan value -} - , benchIO "fold-scan" $ foldScanl value - , benchIO "fold-scanMany" $ foldScanlMany value - , benchIO "fold-postscan" $ foldPostscanl value - ] + , benchIO "fold-scan" $ foldScanl value + , benchIO "fold-scanMany" $ foldScanlMany value + , benchIO "fold-postscan" $ foldPostscanl value ] o_1_space_serial_composition :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_serial_composition value = fmap (SpaceO_1,) - [ bgroup - "composition" - [ benchIO "filter even" $ filter value - , benchIO "scanMaybe even" $ scanMaybe value - , benchIO "scanMaybe even, odd" $ scanMaybe2 value - , benchIO "foldBreak (recursive)" $ foldBreak value - , benchIO "splitWith (all, any)" $ splitAllAny value - , benchIO "split_ (all, any)" $ split_ value - , benchIO "tee (all, any)" $ teeAllAny value - , benchIO "many drain (take 1)" $ many value - , benchIO "unfoldMany" $ unfoldMany value - , benchIO "shortest (sum, length)" $ shortest value - , benchIO "longest (sum, length)" $ longest value - , benchIO "tee (sum, length)" $ teeSumLength value - , benchIO "teeWithFst (sum, length)" $ teeWithFst value - , benchIO "teeWithMin (sum, length)" $ teeWithMin value - , benchIO "distribute [sum, length]" $ distribute value - , benchIO "partition (sum, length)" $ partition value - , benchIO "partitionByFstM (sum, length)" $ partitionByFstM value - , benchIO "partitionByMinM (sum, length)" $ partitionByMinM value - , benchIO "unzip (sum, length)" $ unzip value - , benchIO "unzipWithFstM (sum, length)" $ unzipWithFstM value - , benchIO "unzipWithMinM (sum, length)" $ unzipWithMinM value - ] - ] + [ benchIO "filter even" $ filter value + , benchIO "scanMaybe even" $ scanMaybe value + , benchIO "scanMaybe even, odd" $ scanMaybe2 value + , benchIO "foldBreak (recursive)" $ foldBreak value + , benchIO "splitWith (all, any)" $ splitAllAny value + , benchIO "split_ (all, any)" $ split_ value + , benchIO "tee (all, any)" $ teeAllAny value + , benchIO "many drain (take 1)" $ many value + , benchIO "unfoldMany" $ unfoldMany value + , benchIO "shortest (sum, length)" $ shortest value + , benchIO "longest (sum, length)" $ longest value + , benchIO "tee (sum, length)" $ teeSumLength value + , benchIO "teeWithFst (sum, length)" $ teeWithFst value + , benchIO "teeWithMin (sum, length)" $ teeWithMin value + , benchIO "distribute [sum, length]" $ distribute value + , benchIO "partition (sum, length)" $ partition value + , benchIO "partitionByFstM (sum, length)" $ partitionByFstM value + , benchIO "partitionByMinM (sum, length)" $ partitionByMinM value + , benchIO "unzip (sum, length)" $ unzip value + , benchIO "unzipWithFstM (sum, length)" $ unzipWithFstM value + , benchIO "unzipWithMinM (sum, length)" $ unzipWithMinM value + ] o_n_space_serial :: Int -> [(SpaceComplexity, Benchmark)] o_n_space_serial value = @@ -1166,30 +1151,24 @@ o_n_space_serial value = o_n_heap_serial :: Int -> [(SpaceComplexity, Benchmark)] o_n_heap_serial value = fmap (HeapO_n,) - [ bgroup "elimination" - -- Left folds for building a structure are inherently non-streaming - -- as the structure cannot be lazily consumed until fully built. - [ benchIO "toList" $ toList value - , benchIO "toListRev" $ toListRev value - , benchIO "toStream" $ toStream value - , benchIO "toStreamRev" $ toStreamRev value - , benchIO "nub" $ nub value - ] - , bgroup "key-value" - [ benchIO "demuxToMap (64 buckets) [sum, length]" $ demuxToMap64 value - , benchIO "demuxToIntMap (64 buckets) [sum, length]" $ demuxToIntMap64 value - , benchIO "demuxToMapIO (64 buckets) [sum, length]" $ demuxToMapIO64 value - - -- classify: immutable - , benchIO "toMap (64 buckets) sum" $ toMap64 value - , benchIO "toIntMap (64 buckets) sum" $ toIntMap64 value - - -- classify: mutable cells - , benchIO "toMapIO (single bucket) sum" $ toMapIO1 value - , benchIO "toMapIO (64 buckets) sum" $ toMapIO64 value - , benchIO "toMapIO (max buckets) sum" $ toMapIOMax value - , benchIO "toIntMapIO (64 buckets) sum" $ toIntMapIO64 value - ] + -- Left folds for building a structure are inherently non-streaming + -- as the structure cannot be lazily consumed until fully built. + [ benchIO "toList" $ toList value + , benchIO "toListRev" $ toListRev value + , benchIO "toStream" $ toStream value + , benchIO "toStreamRev" $ toStreamRev value + , benchIO "nub" $ nub value + , benchIO "demuxToMap (64 buckets) [sum, length]" $ demuxToMap64 value + , benchIO "demuxToIntMap (64 buckets) [sum, length]" $ demuxToIntMap64 value + , benchIO "demuxToMapIO (64 buckets) [sum, length]" $ demuxToMapIO64 value + -- classify: immutable + , benchIO "toMap (64 buckets) sum" $ toMap64 value + , benchIO "toIntMap (64 buckets) sum" $ toIntMap64 value + -- classify: mutable cells + , benchIO "toMapIO (single bucket) sum" $ toMapIO1 value + , benchIO "toMapIO (64 buckets) sum" $ toMapIO64 value + , benchIO "toMapIO (max buckets) sum" $ toMapIOMax value + , benchIO "toIntMapIO (64 buckets) sum" $ toIntMapIO64 value ] ------------------------------------------------------------------------------- diff --git a/benchmark/Streamly/Benchmark/Data/Fold/Prelood.hs b/benchmark/Streamly/Benchmark/Data/Fold/Prelood.hs index a6357635de..b9e077db2b 100644 --- a/benchmark/Streamly/Benchmark/Data/Fold/Prelood.hs +++ b/benchmark/Streamly/Benchmark/Data/Fold/Prelood.hs @@ -111,21 +111,17 @@ instance NFData a => NFData (Stream Identity a) where o_n_heap_serial :: Int -> [(SpaceComplexity, Benchmark)] o_n_heap_serial value = - [ (HeapO_n, bgroup "key-value" - [ - benchIOSink value "demuxToHashMap (64 buckets) [sum, length]" - $ demuxToHashMap (getKey 64) (getFold . getKey 64) - , benchIOSink value "demuxToHashMapIO (64 buckets) [sum, length]" - $ demuxToHashMapIO (getKey 64) (getFold . getKey 64) - - -- classify: mutable cells - , benchIOSink value "toHashMapIO (single bucket) sum" - $ toHashMapIO (getKey 1) - , benchIOSink value "toHashMapIO (64 buckets) sum" - $ toHashMapIO (getKey 64) - , benchIOSink value "toHashMapIO (max buckets) sum" - $ toHashMapIO (getKey value) - ]) + [ (HeapO_n, benchIOSink value "demuxToHashMap (64 buckets) [sum, length]" + $ demuxToHashMap (getKey 64) (getFold . getKey 64)) + , (HeapO_n, benchIOSink value "demuxToHashMapIO (64 buckets) [sum, length]" + $ demuxToHashMapIO (getKey 64) (getFold . getKey 64)) + -- classify: mutable cells + , (HeapO_n, benchIOSink value "toHashMapIO (single bucket) sum" + $ toHashMapIO (getKey 1)) + , (HeapO_n, benchIOSink value "toHashMapIO (64 buckets) sum" + $ toHashMapIO (getKey 64)) + , (HeapO_n, benchIOSink value "toHashMapIO (max buckets) sum" + $ toHashMapIO (getKey value)) ] where diff --git a/benchmark/Streamly/Benchmark/Data/Fold/Window.hs b/benchmark/Streamly/Benchmark/Data/Fold/Window.hs index e7e83820f3..b9335a3e87 100644 --- a/benchmark/Streamly/Benchmark/Data/Fold/Window.hs +++ b/benchmark/Streamly/Benchmark/Data/Fold/Window.hs @@ -68,111 +68,106 @@ benchWithPostscan = benchScanWith source o_1_space_folds :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_folds numElements = - [ (SpaceO_1, bgroup "fold" - [ benchWithFold numElements "minimum (window size 100)" - (Window.windowMinimum 100) - , benchWithFold numElements "minimum (window size 1000)" - (Window.windowMinimum 1000) - , benchWith sourceDescendingInt numElements - "minimum descending (window size 1000)" - (Window.windowMinimum 1000) - - , benchWithFold numElements "maximum (window size 100)" - (Window.windowMaximum 100) - , benchWithFold numElements "maximum (window size 1000)" - (Window.windowMaximum 1000) - , benchWith sourceDescendingInt numElements - "maximum descending (window size 1000)" - (Window.windowMaximum 1000) - - , benchWithFold numElements "range (window size 100)" - (Window.windowRange 100) - , benchWithFold numElements "range (window size 1000)" - (Window.windowRange 1000) - , benchWith sourceDescendingInt numElements - "range descending (window size 1000)" - (Window.windowRange 1000) - - , benchWithFoldInt numElements "sumInt (window size 100)" - (RingArray.slidingWindow 100 Window.windowSumInt) - , benchWithFoldInt numElements "sum for Int (window size 100)" - (RingArray.slidingWindow 100 Window.windowSum) - , benchWithFold numElements "sum (window size 100)" - (RingArray.slidingWindow 100 Window.windowSum) - , benchWithFold numElements "sum (window size 1000)" - (RingArray.slidingWindow 1000 Window.windowSum) - , benchWithFold numElements "sum (entire stream)" - (Window.cumulative Window.windowSum) - , benchWithFold numElements "sum (Data.Fold)" - Fold.sum - - , benchWithFold numElements "mean (window size 100)" - (RingArray.slidingWindow 100 Window.windowMean) - , benchWithFold numElements "mean (window size 1000)" - (RingArray.slidingWindow 1000 Window.windowMean) - , benchWithFold numElements "mean (entire stream)" - (Window.cumulative Window.windowMean) - , benchWithFold numElements "mean (Data.Fold)" - Fold.mean - - , benchWithFold numElements "powerSum 2 (window size 100)" - (RingArray.slidingWindow 100 (Window.windowPowerSum 2)) - , benchWithFold numElements "powerSum 2 (entire stream)" - (Window.cumulative (Window.windowPowerSum 2)) - - ]) + [ (SpaceO_1, benchWithFold numElements "fold minimum (window size 100)" + (Window.windowMinimum 100)) + , (SpaceO_1, benchWithFold numElements "fold minimum (window size 1000)" + (Window.windowMinimum 1000)) + , (SpaceO_1, benchWith sourceDescendingInt numElements + "fold minimum descending (window size 1000)" + (Window.windowMinimum 1000)) + + , (SpaceO_1, benchWithFold numElements "fold maximum (window size 100)" + (Window.windowMaximum 100)) + , (SpaceO_1, benchWithFold numElements "fold maximum (window size 1000)" + (Window.windowMaximum 1000)) + , (SpaceO_1, benchWith sourceDescendingInt numElements + "fold maximum descending (window size 1000)" + (Window.windowMaximum 1000)) + + , (SpaceO_1, benchWithFold numElements "fold range (window size 100)" + (Window.windowRange 100)) + , (SpaceO_1, benchWithFold numElements "fold range (window size 1000)" + (Window.windowRange 1000)) + , (SpaceO_1, benchWith sourceDescendingInt numElements + "fold range descending (window size 1000)" + (Window.windowRange 1000)) + + , (SpaceO_1, benchWithFoldInt numElements "fold sumInt (window size 100)" + (RingArray.slidingWindow 100 Window.windowSumInt)) + , (SpaceO_1, benchWithFoldInt numElements "fold sum for Int (window size 100)" + (RingArray.slidingWindow 100 Window.windowSum)) + , (SpaceO_1, benchWithFold numElements "fold sum (window size 100)" + (RingArray.slidingWindow 100 Window.windowSum)) + , (SpaceO_1, benchWithFold numElements "fold sum (window size 1000)" + (RingArray.slidingWindow 1000 Window.windowSum)) + , (SpaceO_1, benchWithFold numElements "fold sum (entire stream)" + (Window.cumulative Window.windowSum)) + , (SpaceO_1, benchWithFold numElements "fold sum (Data.Fold)" + Fold.sum) + + , (SpaceO_1, benchWithFold numElements "fold mean (window size 100)" + (RingArray.slidingWindow 100 Window.windowMean)) + , (SpaceO_1, benchWithFold numElements "fold mean (window size 1000)" + (RingArray.slidingWindow 1000 Window.windowMean)) + , (SpaceO_1, benchWithFold numElements "fold mean (entire stream)" + (Window.cumulative Window.windowMean)) + , (SpaceO_1, benchWithFold numElements "fold mean (Data.Fold)" + Fold.mean) + + , (SpaceO_1, benchWithFold numElements "fold powerSum 2 (window size 100)" + (RingArray.slidingWindow 100 (Window.windowPowerSum 2))) + , (SpaceO_1, benchWithFold numElements "fold powerSum 2 (entire stream)" + (Window.cumulative (Window.windowPowerSum 2))) ] o_1_space_scans :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_scans numElements = - [ (SpaceO_1, bgroup "scan" - [ benchWithPostscan numElements "minimum (window size 10)" - (Window.windowMinimum 10) - -- Below window size 30 the linear search based impl performs better - -- than the dequeue based implementation. - , benchWithPostscan numElements "minimum (window size 30)" - (Window.windowMinimum 30) - , benchWithPostscan numElements "minimum (window size 1000)" - (Window.windowMinimum 1000) - , benchScanWith sourceDescendingInt numElements - "minimum descending (window size 1000)" - (Window.windowMinimum 1000) - - , benchWithPostscan numElements "maximum (window size 10)" - (Window.windowMaximum 10) - , benchWithPostscan numElements "maximum (window size 30)" - (Window.windowMaximum 30) - , benchWithPostscan numElements "maximum (window size 1000)" - (Window.windowMaximum 1000) - , benchScanWith sourceDescendingInt numElements - "maximum descending (window size 1000)" - (Window.windowMaximum 1000) - - , benchWithPostscan numElements "range (window size 10)" - (Window.windowRange 10) - , benchWithPostscan numElements "range (window size 30)" - (Window.windowRange 30) - , benchWithPostscan numElements "range (window size 1000)" - (Window.windowRange 1000) - , benchScanWith sourceDescendingInt numElements - "range descending (window size 1000)" - (Window.windowRange 1000) - - , benchWithPostscan numElements "sum (window size 100)" - (RingArray.slidingWindow 100 Window.windowSum) - , benchWithPostscan numElements "sum (window size 1000)" - (RingArray.slidingWindow 1000 Window.windowSum) - - , benchWithPostscan numElements "mean (window size 100)" - (RingArray.slidingWindow 100 Window.windowMean) - , benchWithPostscan numElements "mean (window size 1000)" - (RingArray.slidingWindow 1000 Window.windowMean) - - , benchWithPostscan numElements "powerSum 2 (window size 100)" - (RingArray.slidingWindow 100 (Window.windowPowerSum 2)) - , benchWithPostscan numElements "powerSum 2 (window size 1000)" - (RingArray.slidingWindow 1000 (Window.windowPowerSum 2)) - ]) + [ (SpaceO_1, benchWithPostscan numElements "scan minimum (window size 10)" + (Window.windowMinimum 10)) + -- Below window size 30 the linear search based impl performs better + -- than the dequeue based implementation. + , (SpaceO_1, benchWithPostscan numElements "scan minimum (window size 30)" + (Window.windowMinimum 30)) + , (SpaceO_1, benchWithPostscan numElements "scan minimum (window size 1000)" + (Window.windowMinimum 1000)) + , (SpaceO_1, benchScanWith sourceDescendingInt numElements + "scan minimum descending (window size 1000)" + (Window.windowMinimum 1000)) + + , (SpaceO_1, benchWithPostscan numElements "scan maximum (window size 10)" + (Window.windowMaximum 10)) + , (SpaceO_1, benchWithPostscan numElements "scan maximum (window size 30)" + (Window.windowMaximum 30)) + , (SpaceO_1, benchWithPostscan numElements "scan maximum (window size 1000)" + (Window.windowMaximum 1000)) + , (SpaceO_1, benchScanWith sourceDescendingInt numElements + "scan maximum descending (window size 1000)" + (Window.windowMaximum 1000)) + + , (SpaceO_1, benchWithPostscan numElements "scan range (window size 10)" + (Window.windowRange 10)) + , (SpaceO_1, benchWithPostscan numElements "scan range (window size 30)" + (Window.windowRange 30)) + , (SpaceO_1, benchWithPostscan numElements "scan range (window size 1000)" + (Window.windowRange 1000)) + , (SpaceO_1, benchScanWith sourceDescendingInt numElements + "scan range descending (window size 1000)" + (Window.windowRange 1000)) + + , (SpaceO_1, benchWithPostscan numElements "scan sum (window size 100)" + (RingArray.slidingWindow 100 Window.windowSum)) + , (SpaceO_1, benchWithPostscan numElements "scan sum (window size 1000)" + (RingArray.slidingWindow 1000 Window.windowSum)) + + , (SpaceO_1, benchWithPostscan numElements "scan mean (window size 100)" + (RingArray.slidingWindow 100 Window.windowMean)) + , (SpaceO_1, benchWithPostscan numElements "scan mean (window size 1000)" + (RingArray.slidingWindow 1000 Window.windowMean)) + + , (SpaceO_1, benchWithPostscan numElements "scan powerSum 2 (window size 100)" + (RingArray.slidingWindow 100 (Window.windowPowerSum 2))) + , (SpaceO_1, benchWithPostscan numElements "scan powerSum 2 (window size 1000)" + (RingArray.slidingWindow 1000 (Window.windowPowerSum 2))) ] moduleName :: String diff --git a/benchmark/Streamly/Benchmark/Data/MutArray.hs b/benchmark/Streamly/Benchmark/Data/MutArray.hs index d1e7fd737a..97220d22cb 100644 --- a/benchmark/Streamly/Benchmark/Data/MutArray.hs +++ b/benchmark/Streamly/Benchmark/Data/MutArray.hs @@ -216,52 +216,41 @@ writeN value = withStream value (Stream.fold (MArray.createOf value)) o_1_space_generation :: Int -> [Benchmark] o_1_space_generation value = - [ bgroup - "generation" - [ benchIO "createOf . intFromTo" $ sourceIntFromTo value - , benchIO "fromList . intFromTo" $ sourceIntFromToFromList value - , benchIO "createOf . unfoldr" $ sourceUnfoldr value - , benchIO "createOf . fromList" $ sourceFromList value - , benchIO "write . intFromTo" $ sourceIntFromToFromStream value - ] + [ benchIO "createOf . intFromTo" $ sourceIntFromTo value + , benchIO "fromList . intFromTo" $ sourceIntFromToFromList value + , benchIO "createOf . unfoldr" $ sourceUnfoldr value + , benchIO "createOf . fromList" $ sourceFromList value + , benchIO "write . intFromTo" $ sourceIntFromToFromStream value ] o_1_space_elimination :: Int -> [Benchmark] o_1_space_elimination value = - [ bgroup "elimination" - [ benchIO "id" $ idArr value - , benchIO "foldl'" $ unfoldFold value - , benchIO "read" $ unfoldReadDrain value - , benchIO "readRev" $ unfoldReadRevDrain value - , benchIO "toStream" $ toStreamDDrain value - , benchIO "toStreamRev" $ toStreamDRevDrain value - ] - ] + [ benchIO "id" $ idArr value + , benchIO "foldl'" $ unfoldFold value + , benchIO "read" $ unfoldReadDrain value + , benchIO "readRev" $ unfoldReadRevDrain value + , benchIO "toStream" $ toStreamDDrain value + , benchIO "toStreamRev" $ toStreamDRevDrain value + ] o_n_heap_serial :: Int -> [Benchmark] o_n_heap_serial value = - [ bgroup "elimination" - [ benchIO "createOf" $ writeN value - ] + [ benchIO "createOf" $ writeN value ] o_1_space_transformation :: Int -> [Benchmark] o_1_space_transformation value = - [ bgroup "transformation" - [ benchIO "scanl'" $ scanl' value - , benchIO "scanl1'" $ scanl1' value - , benchIO "map" $ map value - ] - ] + [ benchIO "scanl'" $ scanl' value + , benchIO "scanl1'" $ scanl1' value + , benchIO "map" $ map value + ] o_1_space_transformationX4 :: Int -> [Benchmark] o_1_space_transformationX4 value = - [ bgroup "transformationX4" - [ benchIO "scanl'" $ scanl'X4 value - , benchIO "scanl1'" $ scanl1'X4 value - , benchIO "map" $ mapX4 value - ] - ] + [ benchIO "scanl'X4" $ scanl'X4 value + , benchIO "scanl1'X4" $ scanl1'X4 value + , benchIO "mapX4" $ mapX4 value + ] o_1_space_serial_marray :: Int -> (MutArray Int, Array.Array Int) -> [Benchmark] diff --git a/benchmark/Streamly/Benchmark/Data/Scanl.hs b/benchmark/Streamly/Benchmark/Data/Scanl.hs index c54538b860..e837806db2 100644 --- a/benchmark/Streamly/Benchmark/Data/Scanl.hs +++ b/benchmark/Streamly/Benchmark/Data/Scanl.hs @@ -167,12 +167,10 @@ inspect $ 'classifySum `hasNoType` ''SPEC o_1_space_serial :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_serial value = - [ (SpaceO_1, bgroup "key-value" - [ benchIO "demuxIO (1-shot) (64 buckets) [sum 100]" $ demuxIOOneShot value - , benchIO "demuxIO (64 buckets) [sum]" $ demuxSum value - , benchIO "classifyIO (64 buckets) [sum 100]" $ classifyLimitedSum value - , benchIO "classifyIO (64 buckets) [sum]" $ classifySum value - ]) + [ (SpaceO_1, benchIO "demuxIO (1-shot) (64 buckets) [sum 100]" $ demuxIOOneShot value) + , (SpaceO_1, benchIO "demuxIO (64 buckets) [sum]" $ demuxSum value) + , (SpaceO_1, benchIO "classifyIO (64 buckets) [sum 100]" $ classifyLimitedSum value) + , (SpaceO_1, benchIO "classifyIO (64 buckets) [sum]" $ classifySum value) ] ------------------------------------------------------------------------------- diff --git a/benchmark/Streamly/Benchmark/Data/Scanl/Concurrent.hs b/benchmark/Streamly/Benchmark/Data/Scanl/Concurrent.hs index 523f23d778..8dfb1db9fa 100644 --- a/benchmark/Streamly/Benchmark/Data/Scanl/Concurrent.hs +++ b/benchmark/Streamly/Benchmark/Data/Scanl/Concurrent.hs @@ -52,9 +52,7 @@ parDistributeScanM len seed = do o_1_space_scans :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_scans numElements = - [ (SpaceO_1, bgroup "scan" - [ mkBench "parDistributeScanM" (parDistributeScanM numElements) - ]) + [ (SpaceO_1, mkBench "parDistributeScanM" (parDistributeScanM numElements)) ] -------------------------------------------------------------------------------- diff --git a/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs b/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs index e774cbf944..416fe6aa31 100644 --- a/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs +++ b/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs @@ -48,54 +48,52 @@ benchWithPostscan = benchScanWith source o_1_space_scans :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_scans numElements = - [ (SpaceO_1, bgroup "scan" - [ benchWithPostscan numElements "minimum (window size 10)" - (Scanl.windowMinimum 10) - -- Below window size 30 the linear search based impl performs better - -- than the dequeue based implementation. - , benchWithPostscan numElements "minimum (window size 30)" - (Scanl.windowMinimum 30) - , benchWithPostscan numElements "minimum (window size 1000)" - (Scanl.windowMinimum 1000) - , benchScanWith sourceDescendingInt numElements - "minimum descending (window size 1000)" - (Scanl.windowMinimum 1000) - - , benchWithPostscan numElements "maximum (window size 10)" - (Scanl.windowMaximum 10) - , benchWithPostscan numElements "maximum (window size 30)" - (Scanl.windowMaximum 30) - , benchWithPostscan numElements "maximum (window size 1000)" - (Scanl.windowMaximum 1000) - , benchScanWith sourceDescendingInt numElements - "maximum descending (window size 1000)" - (Scanl.windowMaximum 1000) - - , benchWithPostscan numElements "range (window size 10)" - (Scanl.windowRange 10) - , benchWithPostscan numElements "range (window size 30)" - (Scanl.windowRange 30) - , benchWithPostscan numElements "range (window size 1000)" - (Scanl.windowRange 1000) - , benchScanWith sourceDescendingInt numElements - "range descending (window size 1000)" - (Scanl.windowRange 1000) - - , benchWithPostscan numElements "sum (window size 100)" - (Scanl.incrScan 100 Scanl.incrSum) - , benchWithPostscan numElements "sum (window size 1000)" - (Scanl.incrScan 1000 Scanl.incrSum) - - , benchWithPostscan numElements "mean (window size 100)" - (Scanl.incrScan 100 Scanl.incrMean) - , benchWithPostscan numElements "mean (window size 1000)" - (Scanl.incrScan 1000 Scanl.incrMean) - - , benchWithPostscan numElements "powerSum 2 (window size 100)" - (Scanl.incrScan 100 (Scanl.incrPowerSum 2)) - , benchWithPostscan numElements "powerSum 2 (window size 1000)" - (Scanl.incrScan 1000 (Scanl.incrPowerSum 2)) - ]) + [ (SpaceO_1, benchWithPostscan numElements "minimum (window size 10)" + (Scanl.windowMinimum 10)) + -- Below window size 30 the linear search based impl performs better + -- than the dequeue based implementation. + , (SpaceO_1, benchWithPostscan numElements "minimum (window size 30)" + (Scanl.windowMinimum 30)) + , (SpaceO_1, benchWithPostscan numElements "minimum (window size 1000)" + (Scanl.windowMinimum 1000)) + , (SpaceO_1, benchScanWith sourceDescendingInt numElements + "minimum descending (window size 1000)" + (Scanl.windowMinimum 1000)) + + , (SpaceO_1, benchWithPostscan numElements "maximum (window size 10)" + (Scanl.windowMaximum 10)) + , (SpaceO_1, benchWithPostscan numElements "maximum (window size 30)" + (Scanl.windowMaximum 30)) + , (SpaceO_1, benchWithPostscan numElements "maximum (window size 1000)" + (Scanl.windowMaximum 1000)) + , (SpaceO_1, benchScanWith sourceDescendingInt numElements + "maximum descending (window size 1000)" + (Scanl.windowMaximum 1000)) + + , (SpaceO_1, benchWithPostscan numElements "range (window size 10)" + (Scanl.windowRange 10)) + , (SpaceO_1, benchWithPostscan numElements "range (window size 30)" + (Scanl.windowRange 30)) + , (SpaceO_1, benchWithPostscan numElements "range (window size 1000)" + (Scanl.windowRange 1000)) + , (SpaceO_1, benchScanWith sourceDescendingInt numElements + "range descending (window size 1000)" + (Scanl.windowRange 1000)) + + , (SpaceO_1, benchWithPostscan numElements "sum (window size 100)" + (Scanl.incrScan 100 Scanl.incrSum)) + , (SpaceO_1, benchWithPostscan numElements "sum (window size 1000)" + (Scanl.incrScan 1000 Scanl.incrSum)) + + , (SpaceO_1, benchWithPostscan numElements "mean (window size 100)" + (Scanl.incrScan 100 Scanl.incrMean)) + , (SpaceO_1, benchWithPostscan numElements "mean (window size 1000)" + (Scanl.incrScan 1000 Scanl.incrMean)) + + , (SpaceO_1, benchWithPostscan numElements "powerSum 2 (window size 100)" + (Scanl.incrScan 100 (Scanl.incrPowerSum 2))) + , (SpaceO_1, benchWithPostscan numElements "powerSum 2 (window size 1000)" + (Scanl.incrScan 1000 (Scanl.incrPowerSum 2))) ] moduleName :: String diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Prelude/ConcurrentCommon.hs b/benchmark/Streamly/Benchmark/Data/Stream/Prelude/ConcurrentCommon.hs index 6746c8146f..62ad15d8b6 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Prelude/ConcurrentCommon.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Prelude/ConcurrentCommon.hs @@ -55,25 +55,21 @@ mapM :: -> m () mapM f n = composeN n $ Async.parMapM f return -o_1_space_mapping :: Int -> (Config -> Config) -> [Benchmark] +o_1_space_mapping :: Int -> (Config -> Config) -> [(SpaceComplexity, Benchmark)] o_1_space_mapping value f = - [ bgroup "mapping" - [ benchIOSink value "mapM" $ mapM f 1 - ] + [ (SpaceO_1, benchIOSink value "mapM" $ mapM f 1) ] ------------------------------------------------------------------------------- -- Size conserving transformations (reordering, buffering, etc.) ------------------------------------------------------------------------------- -o_n_heap_benchmarks :: Int -> (Config -> Config) -> [Benchmark] +o_n_heap_benchmarks :: Int -> (Config -> Config) -> [(SpaceComplexity, Benchmark)] o_n_heap_benchmarks value f = - [ bgroup "buffered" - [ benchIOSink value "parBuffered" - (Stream.fold Fold.drain . Async.parBuffered f) - , benchIOSink value "fmap parBuffered" - (Stream.fold Fold.drain . fmap (+1) . Async.parBuffered f) - ] + [ (HeapO_n, benchIOSink value "parBuffered" + (Stream.fold Fold.drain . Async.parBuffered f)) + , (HeapO_n, benchIOSink value "fmap parBuffered" + (Stream.fold Fold.drain . fmap (+1) . Async.parBuffered f)) ] ------------------------------------------------------------------------------- @@ -149,19 +145,17 @@ parTap f count n = Stream.fold Fold.drain $ Stream.tap (Fold.parBuffered f Fold.sum) (sourceUnfoldrM count n) -o_1_space_joining :: Int -> (Config -> Config) -> [Benchmark] +o_1_space_joining :: Int -> (Config -> Config) -> [(SpaceComplexity, Benchmark)] o_1_space_joining value f = - [ bgroup "joining (2 of n/2)" - [ benchIOSrc1 "parTwo" (async2 f (value `div` 2)) - , benchIOSrc1 "parConcat" (concatAsync2 f (value `div` 2)) - , benchIOSrc1 "parMergeByM" (parMergeByM f (value `div` 2)) - , benchIOSrc1 "parMergeBy" (parMergeBy f (value `div` 2)) - , benchIOSrc1 "parZipWithM" (parZipWithM f (value `div` 2)) - , benchIOSrc1 "parZipWith" (parZipWith f (value `div` 2)) - , benchIO "parZipApplicative" $ zipApplicative value - ] + [ (SpaceO_1, benchIOSrc1 "parTwo" (async2 f (value `div` 2))) + , (SpaceO_1, benchIOSrc1 "parConcat" (concatAsync2 f (value `div` 2))) + , (SpaceO_1, benchIOSrc1 "parMergeByM" (parMergeByM f (value `div` 2))) + , (SpaceO_1, benchIOSrc1 "parMergeBy" (parMergeBy f (value `div` 2))) + , (SpaceO_1, benchIOSrc1 "parZipWithM" (parZipWithM f (value `div` 2))) + , (SpaceO_1, benchIOSrc1 "parZipWith" (parZipWith f (value `div` 2))) + , (SpaceO_1, benchIO "parZipApplicative" $ zipApplicative value) -- XXX use configurable modifier, put this in concurrent fold benchmarks - , benchIOSrc1 "tap (Fold.parBuffered id Fold.sum)" (parTap id value) + , (SpaceO_1, benchIOSrc1 "tap (Fold.parBuffered id Fold.sum)" (parTap id value)) ] ------------------------------------------------------------------------------- @@ -189,16 +183,14 @@ concatFoldableWith f value n = list = List.unfoldr step n in Async.parConcat f (Stream.fromList list) -o_1_space_concatFoldable :: Int -> (Config -> Config) -> [Benchmark] +o_1_space_concatFoldable :: Int -> (Config -> Config) -> [(SpaceComplexity, Benchmark)] o_1_space_concatFoldable value f = - [ bgroup "concat-foldable" - [ benchIOSrc "foldMapWith (<>) (List)" - (sourceFoldMapWith f value) - , benchIOSrc "foldMapWith (<>) (Stream)" - (sourceFoldMapWithStream f value) - , benchIOSrc "S.concatFoldableWith (<>) (List)" - (concatFoldableWith f value) - ] + [ (SpaceO_1, benchIOSrc "foldMapWith (<>) (List)" + (sourceFoldMapWith f value)) + , (SpaceO_1, benchIOSrc "foldMapWith (<>) (Stream)" + (sourceFoldMapWithStream f value)) + , (SpaceO_1, benchIOSrc "S.concatFoldableWith (<>) (List)" + (concatFoldableWith f value)) ] {-# INLINE concatMapStreamsWith #-} @@ -224,26 +216,24 @@ concatFmapStreamsWith f outer inner n = $ Async.parConcat f $ fmap (sourceUnfoldrM inner) (sourceUnfoldrM outer n) -o_1_space_concatMap :: String -> Int -> (Config -> Config) -> [Benchmark] +o_1_space_concatMap :: String -> Int -> (Config -> Config) -> [(SpaceComplexity, Benchmark)] o_1_space_concatMap label value f = value2 `seq` - [ bgroup ("concat" ++ label) - [ benchIO "parConcatMap (n of 1)" - (concatMapStreamsWith f value 1) - , benchIO "parConcatMap (sqrt n of sqrt n)" - (concatMapStreamsWith f value2 value2) - , benchIO "parConcatMap (1 of n)" - (concatMapStreamsWith f 1 value) - , benchIO "concat . fmap (n of 1)" - (concatFmapStreamsWith f value 1) - ] + [ (SpaceO_1, benchIO ("concat" ++ label ++ " parConcatMap (n of 1)") + (concatMapStreamsWith f value 1)) + , (SpaceO_1, benchIO ("concat" ++ label ++ " parConcatMap (sqrt n of sqrt n)") + (concatMapStreamsWith f value2 value2)) + , (SpaceO_1, benchIO ("concat" ++ label ++ " parConcatMap (1 of n)") + (concatMapStreamsWith f 1 value)) + , (SpaceO_1, benchIO ("concat" ++ label ++ " fmap (n of 1)") + (concatFmapStreamsWith f value 1)) ] where value2 = round $ sqrt (fromIntegral value :: Double) -o_1_space_benchmarks :: Int -> (Config -> Config) -> [Benchmark] +o_1_space_benchmarks :: Int -> (Config -> Config) -> [(SpaceComplexity, Benchmark)] o_1_space_benchmarks value modifier = concat [ o_1_space_mapping value modifier @@ -406,30 +396,29 @@ monadBreak mk un linearCount start = -} crossBenchmarks :: Monad (t IO) => - Bool + SpaceComplexity + -> Bool -> (Stream IO Int -> t IO Int) -> (t IO Int -> Stream IO Int) - -> Int -> (Stream.Config -> Stream.Config) -> [Benchmark] -crossBenchmarks wide mk un len f = - [ bgroup "cross-product" ( - [ benchIO "monad2FilterAllOut" $ monadFilterAllOut mk un len - - -- High heap requirement for eager/wide streams - , benchIO (suf "parCrossApply") $ parCrossApply f len2 - , benchIO (suf "monadAp") $ applicative mk un len2 - , benchIO (suf "monad2Levels") $ monad2 mk un len2 - , benchIO (suf "monad3Levels") $ monad3 mk un len2 - , benchIO (suf "monad2FilterAllIn") $ monadFilterAllIn mk un len2 - , benchIO (suf "monad2FilterSome") $ monadFilterSome mk un len2 - -- , benchIO "monad2Break" $ monadBreak mk un len - ] - ++ - -- XXX this takes too much heap in Eager case, because "take" does - -- not reduce eagerness. Pass "eager" arg to remove this only for eager - -- and not for "wide" case. - [benchIO "monad2TakeSome" $ monadTakeSome mk un len | not wide] - ) + -> Int -> (Stream.Config -> Stream.Config) -> [(SpaceComplexity, Benchmark)] +crossBenchmarks space wide mk un len f = + fmap (space,) $ + [ benchIO "monad2FilterAllOut" $ monadFilterAllOut mk un len + + -- High heap requirement for eager/wide streams + , benchIO (suf "parCrossApply") $ parCrossApply f len2 + , benchIO (suf "monadAp") $ applicative mk un len2 + , benchIO (suf "monad2Levels") $ monad2 mk un len2 + , benchIO (suf "monad3Levels") $ monad3 mk un len2 + , benchIO (suf "monad2FilterAllIn") $ monadFilterAllIn mk un len2 + , benchIO (suf "monad2FilterSome") $ monadFilterSome mk un len2 + -- , benchIO "monad2Break" $ monadBreak mk un len ] + ++ + -- XXX this takes too much heap in Eager case, because "take" does + -- not reduce eagerness. Pass "eager" arg to remove this only for eager + -- and not for "wide" case. + [benchIO "monad2TakeSome" $ monadTakeSome mk un len | not wide] where @@ -447,10 +436,14 @@ allBenchmarks :: Monad (t IO) => -> (t IO Int -> Stream IO Int) -> String -> Bool -> (Config -> Config) -> Int -> [Benchmark] allBenchmarks mk un moduleName wide modifier value = - [ bgroup (o_1_space_prefix moduleName) $ - o_1_space_benchmarks value modifier - ++ if wide then [] else crossBenchmarks wide mk un value modifier - , bgroup (o_n_heap_prefix moduleName) $ - o_n_heap_benchmarks value modifier - ++ if wide then crossBenchmarks wide mk un value modifier else [] + let allBenches = concat + [ o_1_space_benchmarks value modifier + , if wide then [] else crossBenchmarks SpaceO_1 wide mk un value modifier + , o_n_heap_benchmarks value modifier + , if wide then crossBenchmarks HeapO_n wide mk un value modifier else [] + ] + get x = map snd $ filter ((==) x . fst) allBenches + in + [ bgroup (o_1_space_prefix moduleName) (get SpaceO_1) + , bgroup (o_n_heap_prefix moduleName) (get HeapO_n) ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Prelude/Exceptions.hs b/benchmark/Streamly/Benchmark/Data/Stream/Prelude/Exceptions.hs index e639237893..2601a7d1a8 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Prelude/Exceptions.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Prelude/Exceptions.hs @@ -119,13 +119,10 @@ retryUnknown length from = do o_1_space_serial_exceptions :: Int -> [Benchmark] o_1_space_serial_exceptions length = - [ bgroup - "exceptions/serial" - [ benchIOSrc1 "retryNoneSimple" (retryNoneSimple length) - , benchIOSrc1 "retryNone" (retryNone length) - , benchIOSrc1 "retryAll" (retryAll length) - , benchIOSrc1 "retryUnknown" (retryUnknown length) - ] + [ benchIOSrc1 "retryNoneSimple" (retryNoneSimple length) + , benchIOSrc1 "retryNone" (retryNone length) + , benchIOSrc1 "retryAll" (retryAll length) + , benchIOSrc1 "retryUnknown" (retryUnknown length) ] -- XXX Move these to FileSystem.Handle benchmarks @@ -167,18 +164,14 @@ inspect $ 'readWriteAfterStream `hasNoType` ''Stream.Step o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark] o_1_space_copy_stream_exceptions env = - [ bgroup "exceptions" - [ mkBenchSmall "Stream.finally" env $ \inh _ -> - readWriteFinallyStream inh (nullH env) - , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ -> - readWriteBeforeAfterStream inh (nullH env) - , mkBenchSmall "Stream.after" env $ \inh _ -> - readWriteAfterStream inh (nullH env) - ] - , bgroup "exceptions/fromToBytes" - [ mkBenchSmall "Stream.bracket" env $ \inh _ -> - fromToBytesBracketStream inh (nullH env) - ] + [ mkBenchSmall "Stream.finally" env $ \inh _ -> + readWriteFinallyStream inh (nullH env) + , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ -> + readWriteBeforeAfterStream inh (nullH env) + , mkBenchSmall "Stream.after" env $ \inh _ -> + readWriteAfterStream inh (nullH env) + , mkBenchSmall "Stream.bracket fromToBytes" env $ \inh _ -> + fromToBytesBracketStream inh (nullH env) ] ------------------------------------------------------------------------------- @@ -192,10 +185,8 @@ readChunksBracket inh devNull = o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark] o_1_space_copy_exceptions_readChunks env = - [ bgroup "exceptions/readChunks" - [ mkBench "UF.bracket" env $ \inH _ -> - readChunksBracket inH (nullH env) - ] + [ mkBench "UF.bracket" env $ \inH _ -> + readChunksBracket inH (nullH env) ] ------------------------------------------------------------------------------- @@ -212,10 +203,8 @@ toChunksBracket inh devNull = o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark] o_1_space_copy_exceptions_toChunks env = - [ bgroup "exceptions/toChunks" - [ mkBench "Stream.bracket" env $ \inH _ -> - toChunksBracket inH (nullH env) - ] + [ mkBench "Stream.bracket toChunks" env $ \inH _ -> + toChunksBracket inH (nullH env) ] excBenchmarks :: BenchEnv -> Int -> [Benchmark] @@ -298,16 +287,14 @@ classifySessionsOfHash getKey = o_1_space_grouping :: BenchEnv -> Int -> [Benchmark] o_1_space_grouping _env value = -- Buffering operations using heap proportional to group/window sizes. - [ bgroup "grouping" - [ benchIOSink value "classifySessionsOf (10000 buckets)" - (classifySessionsOf (getKey 10000)) - , benchIOSink value "classifySessionsOf (64 buckets)" - (classifySessionsOf (getKey 64)) - , benchIOSink value "classifySessionsOfHash (10000 buckets)" - (classifySessionsOfHash (getKey 10000)) - , benchIOSink value "classifySessionsOfHash (64 buckets)" - (classifySessionsOfHash (getKey 64)) - ] + [ benchIOSink value "classifySessionsOf (10000 buckets)" + (classifySessionsOf (getKey 10000)) + , benchIOSink value "classifySessionsOf (64 buckets)" + (classifySessionsOf (getKey 64)) + , benchIOSink value "classifySessionsOfHash (10000 buckets)" + (classifySessionsOfHash (getKey 10000)) + , benchIOSink value "classifySessionsOfHash (64 buckets)" + (classifySessionsOfHash (getKey 64)) ] where diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs index ed0d9e324d..5e1a6b61ae 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs @@ -806,6 +806,7 @@ benchmarks size = , (StackO_n, benchIO "iterated/takeAll (n/10 x 10)" $ iterateTakeAll size 10) , (StackO_n, benchIO "iterated/dropOne (n/10 x 10)" $ iterateDropOne size 10) , (StackO_n, benchIO "iterated/dropWhileTrue (n/10 x 10)" $ iterateDropWhileTrue size 10) - , (StackO_n, benchIO "iterated/dropWhileFalse (n/10 x 10)" $ iterateDropWhileFalse size 10) + -- XXX tasty-bench hangs on this sometimes + -- , (StackO_n, benchIO "iterated/dropWhileFalse (n/10 x 10)" $ iterateDropWhileFalse size 10) , (SpaceO_n, benchIO "naive prime sieve" $ naivePrimeSieve size) ] diff --git a/benchmark/Streamly/Benchmark/Data/StreamK.hs b/benchmark/Streamly/Benchmark/Data/StreamK.hs index e89c369bb9..5985048a27 100644 --- a/benchmark/Streamly/Benchmark/Data/StreamK.hs +++ b/benchmark/Streamly/Benchmark/Data/StreamK.hs @@ -864,445 +864,417 @@ moduleName = "Data.StreamK" benchIO :: NFData b => String -> IO b -> Benchmark benchIO name = bench name . nfIO -o_1_space_generation :: Int -> Benchmark +o_1_space_generation :: Int -> [Benchmark] o_1_space_generation streamLen = - bgroup "generation" - [ benchIO "unfoldr" $ unfoldr streamLen - , benchIO "unfoldrM" $ unfoldrM streamLen - , benchIO "repeat" $ repeat streamLen - , benchIO "repeatM" $ repeatM streamLen - , benchIO "replicate" $ replicate streamLen - , benchIO "replicateM" $ replicateM streamLen - , benchIO "iterate" $ iterate streamLen - , benchIO "iterateM" $ iterateM streamLen - - , benchIO "fromFoldable" $ fromFoldable streamLen - , benchIO "fromFoldableM" $ fromFoldableM streamLen - - -- appends - , benchIO "concatMapFoldableWith" $ concatMapFoldableWith streamLen - , benchIO "concatMapFoldableWithM" $ concatMapFoldableWithM streamLen - ] + [ benchIO "unfoldr" $ unfoldr streamLen + , benchIO "unfoldrM" $ unfoldrM streamLen + , benchIO "repeat" $ repeat streamLen + , benchIO "repeatM" $ repeatM streamLen + , benchIO "replicate" $ replicate streamLen + , benchIO "replicateM" $ replicateM streamLen + , benchIO "iterate" $ iterate streamLen + , benchIO "iterateM" $ iterateM streamLen + + , benchIO "fromFoldable" $ fromFoldable streamLen + , benchIO "fromFoldableM" $ fromFoldableM streamLen + + -- appends + , benchIO "concatMapFoldableWith" $ concatMapFoldableWith streamLen + , benchIO "concatMapFoldableWithM" $ concatMapFoldableWithM streamLen + ] -o_1_space_elimination :: Int -> Benchmark +o_1_space_elimination :: Int -> [Benchmark] o_1_space_elimination streamLen = - bgroup "elimination" - [ benchIO "toNull" $ toNull streamLen - , benchIO "mapM_" $ mapM_ streamLen - , benchIO "uncons" $ uncons streamLen - , benchIO "init" $ init streamLen - , benchIO "foldl'" $ foldl' streamLen - , benchIO "foldlM'" $ foldlM' streamLen - , benchIO "last" $ last streamLen - ] + [ benchIO "toNull" $ toNull streamLen + , benchIO "mapM_" $ mapM_ streamLen + , benchIO "uncons" $ uncons streamLen + , benchIO "init" $ init streamLen + , benchIO "foldl'" $ foldl' streamLen + , benchIO "foldlM'" $ foldlM' streamLen + , benchIO "last" $ last streamLen + ] -o_1_space_ap :: Int -> Benchmark +o_1_space_ap :: Int -> [Benchmark] o_1_space_ap streamLen = - bgroup "Applicative" - [ benchIO "drain2" $ drainApplicative streamLen2 - , benchIO "pureDrain2" $ drainApplicativeUnfoldr streamLen2 - ] + [ benchIO "ap drain2" $ drainApplicative streamLen2 + , benchIO "ap pureDrain2" $ drainApplicativeUnfoldr streamLen2 + ] where streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop -o_1_space_monad :: Int -> Benchmark +o_1_space_monad :: Int -> [Benchmark] o_1_space_monad streamLen = - bgroup "Monad" - [ benchIO "drain2" $ drainMonad streamLen2 - , benchIO "drain3" $ drainMonad3 streamLen3 - , benchIO "filterAllIn2" $ filterAllInMonad streamLen2 - , benchIO "filterAllOut2" $ filterAllOutMonad streamLen2 - , benchIO "pureDrain2" $ drainMonadUnfoldr streamLen2 - , benchIO "pureDrain3" $ drainMonad3Unfoldr streamLen3 - , benchIO "pureFilterAllIn2" $ filterAllInMonadUnfoldr streamLen2 - , benchIO "pureFilterAllOut2" $ filterAllOutMonadUnfoldr streamLen2 - ] + [ benchIO "monad drain2" $ drainMonad streamLen2 + , benchIO "monad drain3" $ drainMonad3 streamLen3 + , benchIO "monad filterAllIn2" $ filterAllInMonad streamLen2 + , benchIO "monad filterAllOut2" $ filterAllOutMonad streamLen2 + , benchIO "monad pureDrain2" $ drainMonadUnfoldr streamLen2 + , benchIO "monad pureDrain3" $ drainMonad3Unfoldr streamLen3 + , benchIO "monad pureFilterAllIn2" $ filterAllInMonadUnfoldr streamLen2 + , benchIO "monad pureFilterAllOut2" $ filterAllOutMonadUnfoldr streamLen2 + ] where streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop -o_1_space_bind :: Int -> Benchmark +o_1_space_bind :: Int -> [Benchmark] o_1_space_bind streamLen = - bgroup "concatFor" - [ benchIO "drain1" $ drainConcatFor1 streamLen - , benchIO "drain2" $ drainConcatFor streamLen2 - , benchIO "drainM2" $ drainConcatForM streamLen2 - , benchIO "drain3" $ drainConcatFor3 streamLen3 - , benchIO "drain4" $ drainConcatFor4 streamLen4 - , benchIO "drain5" $ drainConcatFor5 streamLen5 - , benchIO "drainM3" $ drainConcatFor3M streamLen3 - , benchIO "filterAllIn2" $ filterAllInConcatFor streamLen2 - , benchIO "filterAllOut2" $ filterAllOutConcatFor streamLen2 - ] + [ benchIO "concatFor drain1" $ drainConcatFor1 streamLen + , benchIO "concatFor drain2" $ drainConcatFor streamLen2 + , benchIO "concatFor drainM2" $ drainConcatForM streamLen2 + , benchIO "concatFor drain3" $ drainConcatFor3 streamLen3 + , benchIO "concatFor drain4" $ drainConcatFor4 streamLen4 + , benchIO "concatFor drain5" $ drainConcatFor5 streamLen5 + , benchIO "concatFor drainM3" $ drainConcatFor3M streamLen3 + , benchIO "concatFor filterAllIn2" $ filterAllInConcatFor streamLen2 + , benchIO "concatFor filterAllOut2" $ filterAllOutConcatFor streamLen2 + ] where streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop streamLen4 = round (P.fromIntegral streamLen**(1/4::P.Double)) -- 4 times nested loop streamLen5 = round (P.fromIntegral streamLen**(1/5::P.Double)) -- 5 times nested loop -o_1_space_transformation :: Int -> Benchmark +o_1_space_transformation :: Int -> [Benchmark] o_1_space_transformation streamLen = - bgroup "transformation" - [ benchIO "foldrS" $ foldrS 1 streamLen - , benchIO "scanl'" $ scanl' 1 streamLen - , benchIO "map" $ map 1 streamLen - , benchIO "fmap" $ fmapK 1 streamLen - , benchIO "mapM" $ mapM 1 streamLen - , benchIO "mapMSerial" $ mapMSerial 1 streamLen - ] + [ benchIO "foldrS" $ foldrS 1 streamLen + , benchIO "scanl'" $ scanl' 1 streamLen + , benchIO "map" $ map 1 streamLen + , benchIO "fmap" $ fmapK 1 streamLen + , benchIO "mapM" $ mapM 1 streamLen + , benchIO "mapMSerial" $ mapMSerial 1 streamLen + ] -o_1_space_transformationX4 :: Int -> Benchmark +o_1_space_transformationX4 :: Int -> [Benchmark] o_1_space_transformationX4 streamLen = - bgroup "transformationX4" - [ benchIO "scanl'" $ scanl' 4 streamLen - , benchIO "map" $ map 4 streamLen - , benchIO "fmap" $ fmapK 4 streamLen - , benchIO "mapM" $ mapM 4 streamLen - , benchIO "mapMSerial" $ mapMSerial 4 streamLen - -- XXX this is horribly slow - -- , benchIO "concatMap" $ concatMap 4 streamLen16 - ] + [ benchIO "scanl'X4" $ scanl' 4 streamLen + , benchIO "mapX4" $ map 4 streamLen + , benchIO "fmapX4" $ fmapK 4 streamLen + , benchIO "mapMX4" $ mapM 4 streamLen + , benchIO "mapMSerialX4" $ mapMSerial 4 streamLen + -- XXX this is horribly slow + -- , benchIO "concatMap" $ concatMap 4 streamLen16 + ] -o_1_space_joining :: Int -> Benchmark +o_1_space_joining :: Int -> [Benchmark] o_1_space_joining streamLen = - bgroup "joining (2 of n/2)" - [ benchIO "interleave" $ interleave2 streamLen - - , benchIO "mergeBy compare" - $ mergeBy compare (streamLen `div` 2) - , benchIO "mergeByM compare" - $ mergeByM compare (streamLen `div` 2) - , benchIO "mergeBy (flip compare)" - $ mergeBy (flip compare) (streamLen `div` 2) - , benchIO "mergeByM (flip compare)" - $ mergeByM (flip compare) (streamLen `div` 2) - - , benchIO "zipWith" $ zipWith streamLen - , benchIO "zipWithM" $ zipWithM streamLen - - -- join 2 streams using concatMapWith - , benchIO "concatMapWith interleave" - $ concatMapWith StreamK.interleave 2 (streamLen `div` 2) - , benchIO "concatMapWith D.interleave" - $ concatMapWithD Stream.interleave 2 (streamLen `div` 2) - , benchIO "concatMapWith D.roundRobin" - $ concatMapWithD Stream.roundRobin 2 (streamLen `div` 2) - - -- join 2 streams using mergeMapWith - , benchIO "mergeMapWith interleave" - $ mergeMapWith StreamK.interleave 2 (streamLen `div` 2) - , benchIO "mergeMapWith D.interleave" - $ mergeMapWithD Stream.interleave 2 (streamLen `div` 2) - , benchIO "mergeMapWith D.roundRobin" - $ mergeMapWithD Stream.roundRobin 2 (streamLen `div` 2) - - , benchIO "mergeMapWith (mergeBy compare)" - $ mergeMapWith (StreamK.mergeBy compare) 2 (streamLen `div` 2) - , benchIO "mergeMapWith (mergeBy (flip compare))" - $ mergeMapWith (StreamK.mergeBy (flip compare)) 2 (streamLen `div` 2) - , benchIO "mergeMapWithD (D.mergeBy compare)" - $ mergeMapWithD (Stream.mergeBy compare) 2 (streamLen `div` 2) - , benchIO "mergeMapWithD (D.mergeBy (flip compare))" - $ mergeMapWithD (Stream.mergeBy (flip compare)) 2 (streamLen `div` 2) - - , benchIO "mergeMapWith (zipWith (+))" - $ mergeMapWith (StreamK.zipWith (+)) 2 (streamLen `div` 2) - ] + [ benchIO "interleave" $ interleave2 streamLen + + , benchIO "mergeBy compare" + $ mergeBy compare (streamLen `div` 2) + , benchIO "mergeByM compare" + $ mergeByM compare (streamLen `div` 2) + , benchIO "mergeBy (flip compare)" + $ mergeBy (flip compare) (streamLen `div` 2) + , benchIO "mergeByM (flip compare)" + $ mergeByM (flip compare) (streamLen `div` 2) + + , benchIO "zipWith" $ zipWith streamLen + , benchIO "zipWithM" $ zipWithM streamLen + + -- join 2 streams using concatMapWith + , benchIO "concatMapWith interleave" + $ concatMapWith StreamK.interleave 2 (streamLen `div` 2) + , benchIO "concatMapWith D.interleave" + $ concatMapWithD Stream.interleave 2 (streamLen `div` 2) + , benchIO "concatMapWith D.roundRobin" + $ concatMapWithD Stream.roundRobin 2 (streamLen `div` 2) + + -- join 2 streams using mergeMapWith + , benchIO "mergeMapWith interleave" + $ mergeMapWith StreamK.interleave 2 (streamLen `div` 2) + , benchIO "mergeMapWith D.interleave" + $ mergeMapWithD Stream.interleave 2 (streamLen `div` 2) + , benchIO "mergeMapWith D.roundRobin" + $ mergeMapWithD Stream.roundRobin 2 (streamLen `div` 2) + + , benchIO "mergeMapWith (mergeBy compare)" + $ mergeMapWith (StreamK.mergeBy compare) 2 (streamLen `div` 2) + , benchIO "mergeMapWith (mergeBy (flip compare))" + $ mergeMapWith (StreamK.mergeBy (flip compare)) 2 (streamLen `div` 2) + , benchIO "mergeMapWithD (D.mergeBy compare)" + $ mergeMapWithD (Stream.mergeBy compare) 2 (streamLen `div` 2) + , benchIO "mergeMapWithD (D.mergeBy (flip compare))" + $ mergeMapWithD (Stream.mergeBy (flip compare)) 2 (streamLen `div` 2) + + , benchIO "mergeMapWith (zipWith (+))" + $ mergeMapWith (StreamK.zipWith (+)) 2 (streamLen `div` 2) + ] -o_1_space_concat :: Int -> Benchmark +o_1_space_concat :: Int -> [Benchmark] o_1_space_concat streamLen = - bgroup "concat" - [ benchIO "concatMapUnfoldr outer=Max inner=1" - $ concatMapUnfoldr streamLen 1 - , benchIO "concatMapUnfoldr outer=inner=(sqrt Max)" - $ concatMapUnfoldr streamLen2 streamLen2 - , benchIO "concatMapUnfoldr outer=1 inner=Max" - $ concatMapUnfoldr 1 streamLen - - , benchIO "concatMap outer=Max inner=1" - $ concatMap streamLen 1 - , benchIO "concatMap outer=inner=(sqrt Max)" - $ concatMap streamLen2 streamLen2 - , benchIO "concatMap outer=1 inner=Max" - $ concatMap 1 streamLen - - , benchIO "concatMapRepl outer=inner=(sqrt Max)" - $ concatMapRepl streamLen2 streamLen2 - - -- This is for comparison with concatMapFoldableWith - , benchIO "concatMapWithId outer=Max inner=1 (fromFoldable)" - $ concatMapWithId streamLen - - , benchIO "concatMapWith append outer=Max inner=1" - $ concatMapWith StreamK.append streamLen 1 - , benchIO "concatMapWith append outer=inner=(sqrt Max)" - $ concatMapWith StreamK.append streamLen2 streamLen2 - , benchIO "concatMapWith append outer=1 inner=Max" - $ concatMapWith StreamK.append 1 streamLen - - -- interleave with concatMapWith is O(1) - , benchIO "concatMapWith interleave outer=Max inner=1" - $ concatMapWith StreamK.interleave streamLen 1 - , benchIO "concatMapWith interleave outer=inner=(sqrt Max)" - $ concatMapWith StreamK.interleave streamLen2 streamLen2 - , benchIO "concatMapWith interleave outer=1 inner=Max" - $ concatMapWith StreamK.interleave 1 streamLen - ] + [ benchIO "concatMapUnfoldr outer=Max inner=1" + $ concatMapUnfoldr streamLen 1 + , benchIO "concatMapUnfoldr outer=inner=(sqrt Max)" + $ concatMapUnfoldr streamLen2 streamLen2 + , benchIO "concatMapUnfoldr outer=1 inner=Max" + $ concatMapUnfoldr 1 streamLen + + , benchIO "concatMap outer=Max inner=1" + $ concatMap streamLen 1 + , benchIO "concatMap outer=inner=(sqrt Max)" + $ concatMap streamLen2 streamLen2 + , benchIO "concatMap outer=1 inner=Max" + $ concatMap 1 streamLen + + , benchIO "concatMapRepl outer=inner=(sqrt Max)" + $ concatMapRepl streamLen2 streamLen2 + + -- This is for comparison with concatMapFoldableWith + , benchIO "concatMapWithId outer=Max inner=1 (fromFoldable)" + $ concatMapWithId streamLen + + , benchIO "concatMapWith append outer=Max inner=1" + $ concatMapWith StreamK.append streamLen 1 + , benchIO "concatMapWith append outer=inner=(sqrt Max)" + $ concatMapWith StreamK.append streamLen2 streamLen2 + , benchIO "concatMapWith append outer=1 inner=Max" + $ concatMapWith StreamK.append 1 streamLen + + -- interleave with concatMapWith is O(1) + , benchIO "concatMapWith interleave outer=Max inner=1" + $ concatMapWith StreamK.interleave streamLen 1 + , benchIO "concatMapWith interleave outer=inner=(sqrt Max)" + $ concatMapWith StreamK.interleave streamLen2 streamLen2 + , benchIO "concatMapWith interleave outer=1 inner=Max" + $ concatMapWith StreamK.interleave 1 streamLen + ] where streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop -o_n_space_concat :: Int -> Benchmark +o_n_space_concat :: Int -> [Benchmark] o_n_space_concat streamLen = - bgroup "concat" - [ - -- concatMapWith using StreamD versions of interleave operations are - -- all quadratic, we just measure the sqrtVal benchmark for comparison. - benchIO "concatMapWithD D.interleave outer=inner=(sqrt Max)" - $ concatMapWithD Stream.interleave streamLen2 streamLen2 - , benchIO "concatMapWithD D.roundRobin outer=inner=(sqrt Max)" - $ concatMapWithD Stream.roundRobin streamLen2 streamLen2 - ] + -- concatMapWith using StreamD versions of interleave operations are + -- all quadratic, we just measure the sqrtVal benchmark for comparison. + [ benchIO "concatMapWithD D.interleave outer=inner=(sqrt Max)" + $ concatMapWithD Stream.interleave streamLen2 streamLen2 + , benchIO "concatMapWithD D.roundRobin outer=inner=(sqrt Max)" + $ concatMapWithD Stream.roundRobin streamLen2 streamLen2 + ] where streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop -o_n_heap_concat :: Int -> Benchmark +o_n_heap_concat :: Int -> [Benchmark] o_n_heap_concat streamLen = - bgroup "concat" - [ - benchIO "mergeMapWith interleave outer=Max inner=1" - $ mergeMapWith StreamK.interleave streamLen 1 - , benchIO "mergeMapWith interleave outer=inner=(sqrt Max)" - $ mergeMapWith StreamK.interleave streamLen2 streamLen2 - , benchIO "mergeMapWith interleave outer=1 inner=Max" - $ mergeMapWith StreamK.interleave 1 streamLen - - , benchIO "mergeMapWithD D.interleave outer=inner=(sqrt Max)" - $ mergeMapWithD Stream.interleave streamLen2 streamLen2 - , benchIO "mergeMapWithD D.roundRobin outer=inner=(sqrt Max)" - $ mergeMapWithD Stream.roundRobin streamLen2 streamLen2 - - , benchIO "mergeMapWith (mergeBy compare) outer=Max inner=1" - $ mergeMapWith (StreamK.mergeBy compare) streamLen 1 - , benchIO "mergeMapWith (mergeBy compare) outer=inner=(sqrt Max)" - $ mergeMapWith (StreamK.mergeBy compare) streamLen2 streamLen2 - , benchIO "mergeMapWith (mergeBy compare) outer=1 inner=Max" - $ mergeMapWith (StreamK.mergeBy compare) 1 streamLen - - , benchIO "mergeMapWith (mergeBy (flip compare)) outer=Max inner=1" - $ mergeMapWith (StreamK.mergeBy (flip compare)) streamLen 1 - , benchIO "mergeMapWith (mergeBy (flip compare)) outer=inner=(sqrt Max)" - $ mergeMapWith (StreamK.mergeBy (flip compare)) streamLen2 streamLen2 - , benchIO "mergeMapWith (mergeBy (flip compare)) outer=1 inner=Max" - $ mergeMapWith (StreamK.mergeBy (flip compare)) 1 streamLen - - {- -- This fails with stack overflow. - benchIO "concatMapWithZip (n of 1)" - (concatMapWithZip value 1) - -- Not correct because of nil stream at end issue. - , benchIO "concatMapWithZip (sqrtVal of sqrtVal)" - (concatMapWithZip sqrtVal sqrtVal) - -} - , benchIO "mergeMapWith (zipWith (+)) outer=Max inner=1" - $ mergeMapWith (StreamK.zipWith (+)) streamLen 1 - , benchIO "mergeMapWith (zipWith (+)) outer=inner=(sqrt Max)" - $ mergeMapWith (StreamK.zipWith (+)) streamLen2 streamLen2 - ] + [ benchIO "mergeMapWith interleave outer=Max inner=1" + $ mergeMapWith StreamK.interleave streamLen 1 + , benchIO "mergeMapWith interleave outer=inner=(sqrt Max)" + $ mergeMapWith StreamK.interleave streamLen2 streamLen2 + , benchIO "mergeMapWith interleave outer=1 inner=Max" + $ mergeMapWith StreamK.interleave 1 streamLen + + , benchIO "mergeMapWithD D.interleave outer=inner=(sqrt Max)" + $ mergeMapWithD Stream.interleave streamLen2 streamLen2 + , benchIO "mergeMapWithD D.roundRobin outer=inner=(sqrt Max)" + $ mergeMapWithD Stream.roundRobin streamLen2 streamLen2 + + , benchIO "mergeMapWith (mergeBy compare) outer=Max inner=1" + $ mergeMapWith (StreamK.mergeBy compare) streamLen 1 + , benchIO "mergeMapWith (mergeBy compare) outer=inner=(sqrt Max)" + $ mergeMapWith (StreamK.mergeBy compare) streamLen2 streamLen2 + , benchIO "mergeMapWith (mergeBy compare) outer=1 inner=Max" + $ mergeMapWith (StreamK.mergeBy compare) 1 streamLen + + , benchIO "mergeMapWith (mergeBy (flip compare)) outer=Max inner=1" + $ mergeMapWith (StreamK.mergeBy (flip compare)) streamLen 1 + , benchIO "mergeMapWith (mergeBy (flip compare)) outer=inner=(sqrt Max)" + $ mergeMapWith (StreamK.mergeBy (flip compare)) streamLen2 streamLen2 + , benchIO "mergeMapWith (mergeBy (flip compare)) outer=1 inner=Max" + $ mergeMapWith (StreamK.mergeBy (flip compare)) 1 streamLen + + {- -- This fails with stack overflow. + benchIO "concatMapWithZip (n of 1)" + (concatMapWithZip value 1) + -- Not correct because of nil stream at end issue. + , benchIO "concatMapWithZip (sqrtVal of sqrtVal)" + (concatMapWithZip sqrtVal sqrtVal) + -} + , benchIO "mergeMapWith (zipWith (+)) outer=Max inner=1" + $ mergeMapWith (StreamK.zipWith (+)) streamLen 1 + , benchIO "mergeMapWith (zipWith (+)) outer=inner=(sqrt Max)" + $ mergeMapWith (StreamK.zipWith (+)) streamLen2 streamLen2 + ] where streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop {- HLINT ignore "Use sort" -} -o_n_heap_sorting :: Int -> Benchmark +o_n_heap_sorting :: Int -> [Benchmark] o_n_heap_sorting streamLen = - bgroup "sorting" - [ benchIO "sortBy compare" $ sortBy compare streamLen - , benchIO "sortBy (flip compare)" $ sortBy (flip compare) streamLen - , benchIO "sortBy compare randomized" $ sortByCompareRandomized streamLen - , bench "List.sortBy compare" - $ nf (\x -> List.sortBy compare [1..x]) streamLen - , bench "List.sortBy (flip compare)" - $ nf (\x -> List.sortBy (flip compare) [1..x]) streamLen - , bench "sortByLists compare randomized" - $ nf (\x -> List.sortBy compare - (List.map (\n -> if even n then n + 2 else n) [1..x]) - ) - streamLen - ] + [ benchIO "sortBy compare" $ sortBy compare streamLen + , benchIO "sortBy (flip compare)" $ sortBy (flip compare) streamLen + , benchIO "sortBy compare randomized" $ sortByCompareRandomized streamLen + , bench "List.sortBy compare" + $ nf (\x -> List.sortBy compare [1..x]) streamLen + , bench "List.sortBy (flip compare)" + $ nf (\x -> List.sortBy (flip compare) [1..x]) streamLen + , bench "sortByLists compare randomized" + $ nf (\x -> List.sortBy compare + (List.map (\n -> if even n then n + 2 else n) [1..x]) + ) + streamLen + ] -o_1_space_filtering :: Int -> Benchmark +o_1_space_filtering :: Int -> [Benchmark] o_1_space_filtering streamLen = - bgroup "filtering" - [ benchIO "filter-even" $ filterEven 1 streamLen - , benchIO "filter-all-out" $ filterAllOut 1 streamLen - , benchIO "filter-all-in" $ filterAllIn 1 streamLen - , benchIO "take-all" $ takeAll 1 streamLen - , benchIO "takeWhile-true" $ takeWhileTrue 1 streamLen - , benchIO "drop-one" $ dropOne 1 streamLen - , benchIO "drop-all" $ dropAll 1 streamLen - , benchIO "dropWhile-true" $ dropWhileTrue 1 streamLen - , benchIO "dropWhile-false" $ dropWhileFalse 1 streamLen - ] + [ benchIO "filter-even" $ filterEven 1 streamLen + , benchIO "filter-all-out" $ filterAllOut 1 streamLen + , benchIO "filter-all-in" $ filterAllIn 1 streamLen + , benchIO "take-all" $ takeAll 1 streamLen + , benchIO "takeWhile-true" $ takeWhileTrue 1 streamLen + , benchIO "drop-one" $ dropOne 1 streamLen + , benchIO "drop-all" $ dropAll 1 streamLen + , benchIO "dropWhile-true" $ dropWhileTrue 1 streamLen + , benchIO "dropWhile-false" $ dropWhileFalse 1 streamLen + ] -o_1_space_filteringX4 :: Int -> Benchmark +o_1_space_filteringX4 :: Int -> [Benchmark] o_1_space_filteringX4 streamLen = - bgroup "filteringX4" - [ benchIO "filter-even" $ filterEven 4 streamLen - , benchIO "filter-all-out" $ filterAllOut 4 streamLen - , benchIO "filter-all-in" $ filterAllIn 4 streamLen - , benchIO "take-all" $ takeAll 4 streamLen - , benchIO "takeWhile-true" $ takeWhileTrue 4 streamLen - , benchIO "drop-one" $ dropOne 4 streamLen - , benchIO "drop-all" $ dropAll 4 streamLen - , benchIO "dropWhile-true" $ dropWhileTrue 4 streamLen - , benchIO "dropWhile-false" $ dropWhileFalse 4 streamLen - ] + [ benchIO "filter-evenX4" $ filterEven 4 streamLen + , benchIO "filter-all-outX4" $ filterAllOut 4 streamLen + , benchIO "filter-all-inX4" $ filterAllIn 4 streamLen + , benchIO "take-allX4" $ takeAll 4 streamLen + , benchIO "takeWhile-trueX4" $ takeWhileTrue 4 streamLen + , benchIO "drop-oneX4" $ dropOne 4 streamLen + , benchIO "drop-allX4" $ dropAll 4 streamLen + , benchIO "dropWhile-trueX4" $ dropWhileTrue 4 streamLen + , benchIO "dropWhile-falseX4" $ dropWhileFalse 4 streamLen + ] -o_1_space_mixed :: Int -> Benchmark +o_1_space_mixed :: Int -> [Benchmark] o_1_space_mixed streamLen = - bgroup "mixed" - [ benchIO "scan-map" $ scanMap 1 streamLen - , benchIO "drop-map" $ dropMap 1 streamLen - , benchIO "drop-scan" $ dropScan 1 streamLen - , benchIO "take-drop" $ takeDrop 1 streamLen - , benchIO "take-scan" $ takeScan 1 streamLen - , benchIO "take-map" $ takeMap 1 streamLen - , benchIO "filter-drop" $ filterDrop 1 streamLen - , benchIO "filter-take" $ filterTake 1 streamLen - , benchIO "filter-scan" $ filterScan 1 streamLen - , benchIO "filter-map" $ filterMap 1 streamLen - ] + [ benchIO "scan-map" $ scanMap 1 streamLen + , benchIO "drop-map" $ dropMap 1 streamLen + , benchIO "drop-scan" $ dropScan 1 streamLen + , benchIO "take-drop" $ takeDrop 1 streamLen + , benchIO "take-scan" $ takeScan 1 streamLen + , benchIO "take-map" $ takeMap 1 streamLen + , benchIO "filter-drop" $ filterDrop 1 streamLen + , benchIO "filter-take" $ filterTake 1 streamLen + , benchIO "filter-scan" $ filterScan 1 streamLen + , benchIO "filter-map" $ filterMap 1 streamLen + ] -o_1_space_mixedX2 :: Int -> Benchmark +o_1_space_mixedX2 :: Int -> [Benchmark] o_1_space_mixedX2 streamLen = - bgroup "mixedX2" - [ benchIO "scan-map" $ scanMap 2 streamLen - , benchIO "drop-map" $ dropMap 2 streamLen - , benchIO "drop-scan" $ dropScan 2 streamLen - , benchIO "take-drop" $ takeDrop 2 streamLen - , benchIO "take-scan" $ takeScan 2 streamLen - , benchIO "take-map" $ takeMap 2 streamLen - , benchIO "filter-drop" $ filterDrop 2 streamLen - , benchIO "filter-take" $ filterTake 2 streamLen - , benchIO "filter-scan" $ filterScan 2 streamLen - , benchIO "filter-map" $ filterMap 2 streamLen - ] + [ benchIO "scan-mapX2" $ scanMap 2 streamLen + , benchIO "drop-mapX2" $ dropMap 2 streamLen + , benchIO "drop-scanX2" $ dropScan 2 streamLen + , benchIO "take-dropX2" $ takeDrop 2 streamLen + , benchIO "take-scanX2" $ takeScan 2 streamLen + , benchIO "take-mapX2" $ takeMap 2 streamLen + , benchIO "filter-dropX2" $ filterDrop 2 streamLen + , benchIO "filter-takeX2" $ filterTake 2 streamLen + , benchIO "filter-scanX2" $ filterScan 2 streamLen + , benchIO "filter-mapX2" $ filterMap 2 streamLen + ] -o_1_space_mixedX4 :: Int -> Benchmark +o_1_space_mixedX4 :: Int -> [Benchmark] o_1_space_mixedX4 streamLen = - bgroup "mixedX4" - [ benchIO "scan-map" $ scanMap 4 streamLen - , benchIO "drop-map" $ dropMap 4 streamLen - , benchIO "drop-scan" $ dropScan 4 streamLen - , benchIO "take-drop" $ takeDrop 4 streamLen - , benchIO "take-scan" $ takeScan 4 streamLen - , benchIO "take-map" $ takeMap 4 streamLen - , benchIO "filter-drop" $ filterDrop 4 streamLen - , benchIO "filter-take" $ filterTake 4 streamLen - , benchIO "filter-scan" $ filterScan 4 streamLen - , benchIO "filter-map" $ filterMap 4 streamLen - ] + [ benchIO "scan-mapX4" $ scanMap 4 streamLen + , benchIO "drop-mapX4" $ dropMap 4 streamLen + , benchIO "drop-scanX4" $ dropScan 4 streamLen + , benchIO "take-dropX4" $ takeDrop 4 streamLen + , benchIO "take-scanX4" $ takeScan 4 streamLen + , benchIO "take-mapX4" $ takeMap 4 streamLen + , benchIO "filter-dropX4" $ filterDrop 4 streamLen + , benchIO "filter-takeX4" $ filterTake 4 streamLen + , benchIO "filter-scanX4" $ filterScan 4 streamLen + , benchIO "filter-mapX4" $ filterMap 4 streamLen + ] -o_1_space_list :: Int -> Benchmark +o_1_space_list :: Int -> [Benchmark] o_1_space_list streamLen = - bgroup "list" - [ bgroup "elimination" - [ benchIO "last" $ lastList streamLen - ] - , bgroup "Applicative" - [ benchIO "drain2" $ listApDrain2 streamLen2 - ] - , bgroup "Monad" - [ benchIO "drain2" $ listMonadDrain2 streamLen2 - , benchIO "drain3" $ listMonadDrain3 streamLen3 - , benchIO "filterAllIn2" $ listMonadFilterAllIn2 streamLen2 - , benchIO "filterAllOut2" $ listMonadFilterAllOut2 streamLen2 - ] - ] + [ benchIO "list last" $ lastList streamLen + , benchIO "list ap drain2" $ listApDrain2 streamLen2 + , benchIO "list monad drain2" $ listMonadDrain2 streamLen2 + , benchIO "list monad drain3" $ listMonadDrain3 streamLen3 + , benchIO "list monad filterAllIn2" $ listMonadFilterAllIn2 streamLen2 + , benchIO "list monad filterAllOut2" $ listMonadFilterAllOut2 streamLen2 + ] where streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop -o_n_heap_transformation :: Int -> Benchmark +o_n_heap_transformation :: Int -> [Benchmark] o_n_heap_transformation streamLen = - bgroup "transformation" - [ benchIO "foldlS" $ foldlS 1 streamLen - ] + [ benchIO "foldlS" $ foldlS 1 streamLen + ] -o_n_stack_transformation :: Int -> Benchmark +o_n_stack_transformation :: Int -> [Benchmark] o_n_stack_transformation streamLen = - bgroup "transformation" - [ - -- XXX why do these need so much stack - benchIO "intersperse" $ intersperse streamLen 1 streamLen2 - , benchIO "interspersePure" $ interspersePure streamLen 1 streamLen2 - ] + -- XXX why do these need so much stack + [ benchIO "intersperse" $ intersperse streamLen 1 streamLen2 + , benchIO "interspersePure" $ interspersePure streamLen 1 streamLen2 + ] where streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -o_n_stack_transformationX4 :: Int -> Benchmark +o_n_stack_transformationX4 :: Int -> [Benchmark] o_n_stack_transformationX4 streamLen = - bgroup "transformationX4" - [ - benchIO "intersperse" $ intersperse streamLen 4 streamLen16 - ] + [ benchIO "intersperseX4" $ intersperse streamLen 4 streamLen16 + ] where streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -o_n_stack_iterated :: Int -> Int -> Int -> Benchmark +o_n_stack_iterated :: Int -> Int -> Int -> [Benchmark] o_n_stack_iterated streamLen iterStreamLen maxIters = - bgroup "iterated" - [ benchIO "mapM" $ iterateMapM iterStreamLen maxIters - , benchIO "scan(1/10)" $ iterateScan iterStreamLen maxIters - , benchIO "filterEven" $ iterateFilterEven iterStreamLen maxIters - , benchIO "takeAll" $ iterateTakeAll streamLen iterStreamLen maxIters - , benchIO "dropOne" $ iterateDropOne iterStreamLen maxIters - , benchIO "dropWhileFalse(1/10)" $ iterateDropWhileFalse streamLen iterStreamLen maxIters - , benchIO "dropWhileTrue" $ iterateDropWhileTrue streamLen iterStreamLen maxIters - ] + [ benchIO "iterated mapM" $ iterateMapM iterStreamLen maxIters + , benchIO "iterated scan(1/10)" $ iterateScan iterStreamLen maxIters + , benchIO "iterated filterEven" $ iterateFilterEven iterStreamLen maxIters + , benchIO "iterated takeAll" $ iterateTakeAll streamLen iterStreamLen maxIters + , benchIO "iterated dropOne" $ iterateDropOne iterStreamLen maxIters + , benchIO "iterated dropWhileFalse(1/10)" $ iterateDropWhileFalse streamLen iterStreamLen maxIters + , benchIO "iterated dropWhileTrue" $ iterateDropWhileTrue streamLen iterStreamLen maxIters + ] benchmarks :: Int -> Int -> Int -> [(SpaceComplexity, Benchmark)] benchmarks streamLen iterStreamLen maxIters = -- O(1) space - [ (SpaceO_1, o_1_space_generation streamLen) - , (SpaceO_1, o_1_space_elimination streamLen) - , (SpaceO_1, o_1_space_ap streamLen) - , (SpaceO_1, o_1_space_monad streamLen) - , (SpaceO_1, o_1_space_bind streamLen) - , (SpaceO_1, o_1_space_transformation streamLen) - , (SpaceO_1, o_1_space_transformationX4 streamLen) - , (SpaceO_1, o_1_space_concat streamLen) - , (SpaceO_1, o_1_space_filtering streamLen) - , (SpaceO_1, o_1_space_filteringX4 streamLen) - , (SpaceO_1, o_1_space_joining streamLen) - , (SpaceO_1, o_1_space_mixed streamLen) - , (SpaceO_1, o_1_space_mixedX2 streamLen) - , (SpaceO_1, o_1_space_mixedX4 streamLen) - , (SpaceO_1, o_1_space_list streamLen) + fmap (SpaceO_1,) (concat + [ o_1_space_generation streamLen + , o_1_space_elimination streamLen + , o_1_space_ap streamLen + , o_1_space_monad streamLen + , o_1_space_bind streamLen + , o_1_space_transformation streamLen + , o_1_space_transformationX4 streamLen + , o_1_space_concat streamLen + , o_1_space_filtering streamLen + , o_1_space_filteringX4 streamLen + , o_1_space_joining streamLen + , o_1_space_mixed streamLen + , o_1_space_mixedX2 streamLen + , o_1_space_mixedX4 streamLen + , o_1_space_list streamLen + ]) -- O(n) heap - , (HeapO_n, o_n_heap_transformation streamLen) - , (HeapO_n, o_n_heap_concat streamLen) - , (HeapO_n, o_n_heap_sorting streamLen) + ++ fmap (HeapO_n,) (concat + [ o_n_heap_transformation streamLen + , o_n_heap_concat streamLen + , o_n_heap_sorting streamLen + ]) -- O(n) stack - , (StackO_n, bgroup "elimination" - [ benchIO "tail" $ tail streamLen - , benchIO "nullTail" $ nullTail streamLen - , benchIO "headTail" $ headTail streamLen - ]) - , (StackO_n, o_n_stack_transformation streamLen) - , (StackO_n, o_n_stack_transformationX4 streamLen) - , (StackO_n, o_n_stack_iterated streamLen iterStreamLen maxIters) + ++ fmap (StackO_n,) + ( [ benchIO "tail" $ tail streamLen + , benchIO "nullTail" $ nullTail streamLen + , benchIO "headTail" $ headTail streamLen + ] + ++ o_n_stack_transformation streamLen + ++ o_n_stack_transformationX4 streamLen + ++ o_n_stack_iterated streamLen iterStreamLen maxIters + ) -- O(n) space - , (SpaceO_n, bgroup "elimination" - [ benchIO "toList" $ toList streamLen - ]) - , (SpaceO_n, o_n_space_concat streamLen) - ] + ++ fmap (SpaceO_n,) + ( [ benchIO "toList" $ toList streamLen ] + ++ o_n_space_concat streamLen + ) main :: IO () main = do diff --git a/benchmark/Streamly/Benchmark/Data/Unfold/Prelude1.hs b/benchmark/Streamly/Benchmark/Data/Unfold/Prelude1.hs index a7cd374e48..20981dd993 100644 --- a/benchmark/Streamly/Benchmark/Data/Unfold/Prelude1.hs +++ b/benchmark/Streamly/Benchmark/Data/Unfold/Prelude1.hs @@ -30,12 +30,10 @@ readWriteBracketUnfold inh devNull = o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark] o_1_space_copy_read_exceptions env = - [ bgroup "exceptions" - [ mkBenchSmall "UF.finally" env $ \inh _ -> - readWriteFinallyUnfold inh (nullH env) - , mkBenchSmall "UF.bracket" env $ \inh _ -> - readWriteBracketUnfold inh (nullH env) - ] + [ mkBenchSmall "UF.finally" env $ \inh _ -> + readWriteFinallyUnfold inh (nullH env) + , mkBenchSmall "UF.bracket" env $ \inh _ -> + readWriteBracketUnfold inh (nullH env) ] moduleName :: String diff --git a/benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs b/benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs index a081eafb85..9a4794fba0 100644 --- a/benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs +++ b/benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs @@ -153,29 +153,27 @@ inspect $ hasNoTypeClasses 'readDecodeUtf8 o_1_space_reduce_read :: BenchEnv -> [Benchmark] o_1_space_reduce_read env = - [ bgroup "reduce/read" - [ -- read raw bytes without any decoding - mkBench "S.drain" env $ \inh _ -> - readDrain inh - , mkBench "S.last" env $ \inh _ -> - readLast inh - , mkBench "S.sum" env $ \inh _ -> - readSumBytes inh - - -- read with Latin1 decoding - , mkBench "SS.decodeLatin1" env $ \inh _ -> - readDecodeLatin1 inh - , mkBench "S.length" env $ \inh _ -> - readCountBytes inh - , mkBench "US.lines . SS.decodeLatin1" env $ \inh _ -> - readCountLines inh - , mkBench "US.words . SS.decodeLatin1" env $ \inh _ -> - readCountWords inh - - -- read with utf8 decoding - , mkBenchSmall "SS.decodeUtf8" env $ \inh _ -> - readDecodeUtf8 inh - ] + -- read raw bytes without any decoding + [ mkBench "S.drain" env $ \inh _ -> + readDrain inh + , mkBench "S.last" env $ \inh _ -> + readLast inh + , mkBench "S.sum" env $ \inh _ -> + readSumBytes inh + + -- read with Latin1 decoding + , mkBench "SS.decodeLatin1" env $ \inh _ -> + readDecodeLatin1 inh + , mkBench "S.length" env $ \inh _ -> + readCountBytes inh + , mkBench "US.lines . SS.decodeLatin1" env $ \inh _ -> + readCountLines inh + , mkBench "US.words . SS.decodeLatin1" env $ \inh _ -> + readCountWords inh + + -- read with utf8 decoding + , mkBenchSmall "SS.decodeUtf8" env $ \inh _ -> + readDecodeUtf8 inh ] ------------------------------------------------------------------------------- @@ -199,10 +197,8 @@ inspect $ 'getChunksConcatUnfoldCountLines `hasNoType` ''Producer.ConcatState o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark] o_1_space_reduce_toBytes env = - [ bgroup "reduce/toBytes" - [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ -> - getChunksConcatUnfoldCountLines inh - ] + [ mkBench "toBytes/US.lines . SS.decodeLatin1" env $ \inh _ -> + getChunksConcatUnfoldCountLines inh ] ------------------------------------------------------------------------------- @@ -251,48 +247,46 @@ chunksOf n inh = -- XXX all these require @-fspec-constr-recursive=12@. o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark] o_1_space_reduce_read_grouped env = - [ bgroup "reduce/read/chunks" - [ mkBench ("S.groupsOf " ++ show (bigSize env) ++ " FL.sum") env $ - \inh _ -> - chunksOfSum (bigSize env) inh - , mkBench "S.groupsOf 1 FL.sum" env $ \inh _ -> - chunksOfSum 1 inh - - -- XXX investigate why we need inline/noinline in these cases (GHC) - -- Chunk using parsers - , mkBench - ("S.foldMany1 (FL.take " ++ show (bigSize env) ++ " FL.sum)") - env - $ \inh _ -> noinline foldMany1ChunksOfSum (bigSize env) inh - , mkBench - "S.foldMany1 (FL.take 1 FL.sum)" - env - $ \inh _ -> inline foldMany1ChunksOfSum 1 inh - , mkBench - ("S.foldMany (FL.take " ++ show (bigSize env) ++ " FL.sum)") - env - $ \inh _ -> noinline foldManyChunksOfSum (bigSize env) inh - , mkBench - "S.foldMany (FL.take 1 FL.sum)" - env - $ \inh _ -> inline foldManyChunksOfSum 1 inh - - -- folding chunks to arrays - , mkBenchSmall "S.groupsOf 1" env $ \inh _ -> - groupsOf 1 inh - , mkBench "S.groupsOf 10" env $ \inh _ -> - groupsOf 10 inh - , mkBench "S.groupsOf 1000" env $ \inh _ -> - groupsOf 1000 inh - - -- chunksOf may use a different impl than groupsOf - , mkBenchSmall "A.chunksOf 1" env $ \inh _ -> - chunksOf 1 inh - , mkBench "A.chunksOf 10" env $ \inh _ -> - chunksOf 10 inh - , mkBench "A.chunksOf 1000" env $ \inh _ -> - chunksOf 1000 inh - ] + [ mkBench ("S.groupsOf " ++ show (bigSize env) ++ " FL.sum") env $ + \inh _ -> + chunksOfSum (bigSize env) inh + , mkBench "S.groupsOf 1 FL.sum" env $ \inh _ -> + chunksOfSum 1 inh + + -- XXX investigate why we need inline/noinline in these cases (GHC) + -- Chunk using parsers + , mkBench + ("S.foldMany1 (FL.take " ++ show (bigSize env) ++ " FL.sum)") + env + $ \inh _ -> noinline foldMany1ChunksOfSum (bigSize env) inh + , mkBench + "S.foldMany1 (FL.take 1 FL.sum)" + env + $ \inh _ -> inline foldMany1ChunksOfSum 1 inh + , mkBench + ("S.foldMany (FL.take " ++ show (bigSize env) ++ " FL.sum)") + env + $ \inh _ -> noinline foldManyChunksOfSum (bigSize env) inh + , mkBench + "S.foldMany (FL.take 1 FL.sum)" + env + $ \inh _ -> inline foldManyChunksOfSum 1 inh + + -- folding chunks to arrays + , mkBenchSmall "S.groupsOf 1" env $ \inh _ -> + groupsOf 1 inh + , mkBench "S.groupsOf 10" env $ \inh _ -> + groupsOf 10 inh + , mkBench "S.groupsOf 1000" env $ \inh _ -> + groupsOf 1000 inh + + -- chunksOf may use a different impl than groupsOf + , mkBenchSmall "A.chunksOf 1" env $ \inh _ -> + chunksOf 1 inh + , mkBench "A.chunksOf 10" env $ \inh _ -> + chunksOf 10 inh + , mkBench "A.chunksOf 1000" env $ \inh _ -> + chunksOf 1000 inh ] allBenchmarks :: BenchEnv -> [Benchmark] diff --git a/benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs b/benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs index c2518ae0d6..ab1fc51400 100644 --- a/benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs +++ b/benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs @@ -62,12 +62,10 @@ inspect $ 'copyChunks `hasNoType` ''Step o_1_space_copy_chunked :: BenchEnv -> [Benchmark] o_1_space_copy_chunked env = - [ bgroup "copy/getChunks" - [ mkBench "toNull" env $ \inH _ -> - copyChunks inH (nullH env) - , mkBench "raw" env $ \inH outH -> - copyChunks inH outH - ] + [ mkBench "toNull" env $ \inH _ -> + copyChunks inH (nullH env) + , mkBench "raw" env $ \inH outH -> + copyChunks inH outH ] ------------------------------------------------------------------------------- @@ -89,12 +87,10 @@ inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/chunksOf o_1_space_copy_read :: BenchEnv -> [Benchmark] o_1_space_copy_read env = - [ bgroup "copy/read" - [ mkBench "rawToNull" env $ \inh _ -> - copyStream inh (nullH env) - , mkBench "rawToFile" env $ \inh outh -> - copyStream inh outh - ] + [ mkBench "rawToNull" env $ \inh _ -> + copyStream inh (nullH env) + , mkBench "rawToFile" env $ \inh outh -> + copyStream inh outh ] ------------------------------------------------------------------------------- @@ -149,12 +145,10 @@ _readChunksWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh) o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark] o_1_space_copy_fromBytes env = - [ bgroup "copy/putBytes" - [ mkBench "rawToNull" env $ \inh _ -> - readFromBytesNull inh (nullH env) - , mkBench "FH.readWith" env $ \inh _ -> - readWithFromBytesNull inh (nullH env) - ] + [ mkBench "putBytes rawToNull" env $ \inh _ -> + readFromBytesNull inh (nullH env) + , mkBench "FH.readWith" env $ \inh _ -> + readWithFromBytesNull inh (nullH env) ] -- | Send the file contents ('defaultChunkSize') to /dev/null @@ -193,12 +187,10 @@ inspect $ 'writeRead `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe o_1_space_copy :: BenchEnv -> [Benchmark] o_1_space_copy env = - [ bgroup "copy" - [ mkBench "FH.write . FH.read" env $ \inh _ -> - writeRead inh (nullH env) - , mkBench "FH.writeWith . FH.readWith" env $ \inh _ -> - writeReadWith inh (nullH env) - ] + [ mkBench "FH.write . FH.read" env $ \inh _ -> + writeRead inh (nullH env) + , mkBench "FH.writeWith . FH.readWith" env $ \inh _ -> + writeReadWith inh (nullH env) ] ------------------------------------------------------------------------------- diff --git a/benchmark/Streamly/Benchmark/Unicode/Stream.hs b/benchmark/Streamly/Benchmark/Unicode/Stream.hs index fafb44d004..9755e85e25 100644 --- a/benchmark/Streamly/Benchmark/Unicode/Stream.hs +++ b/benchmark/Streamly/Benchmark/Unicode/Stream.hs @@ -73,11 +73,8 @@ inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient o_1_space_decode_encode_chunked :: BenchEnv -> [Benchmark] o_1_space_decode_encode_chunked env = - [ bgroup "decode-encode/toChunks" - [ - mkBenchSmall "encodeUtf8' . decodeUtf8Arrays" env $ \inH outH -> - copyCodecUtf8ArraysLenient inH outH - ] + [ mkBenchSmall "encodeUtf8' . decodeUtf8Arrays" env $ \inH outH -> + copyCodecUtf8ArraysLenient inH outH ] ------------------------------------------------------------------------------- @@ -193,21 +190,19 @@ wordsUnwordsCharArrayCopy inh outh = -- XXX all these require @-fspec-constr-recursive=12@. o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark] o_1_space_copy_read_group_ungroup env = - [ bgroup "ungroup-group" - [ mkBenchSmall "unlines . splitOnSuffix ([Word8])" env - $ \inh outh -> linesUnlinesCopy inh outh - , mkBenchSmall "interposeSuffix . splitOnSuffix (Array Word8)" env - $ \inh outh -> linesUnlinesArrayWord8Copy inh outh - , mkBenchSmall "UnicodeArr.unlines . UnicodeArr.lines (Array Char)" env - $ \inh outh -> linesUnlinesArrayCharCopy inh outh - - , mkBenchSmall "interposeSuffix . wordsBy ([Word8])" env - $ \inh outh -> wordsUnwordsCopyWord8 inh outh - , mkBenchSmall "unwords . wordsBy ([Char])" env - $ \inh outh -> wordsUnwordsCopy inh outh - , mkBenchSmall "UnicodeArr.unwords . UnicodeArr.words (Array Char)" env - $ \inh outh -> wordsUnwordsCharArrayCopy inh outh - ] + [ mkBenchSmall "unlines . splitOnSuffix ([Word8])" env + $ \inh outh -> linesUnlinesCopy inh outh + , mkBenchSmall "interposeSuffix . splitOnSuffix (Array Word8)" env + $ \inh outh -> linesUnlinesArrayWord8Copy inh outh + , mkBenchSmall "UnicodeArr.unlines . UnicodeArr.lines (Array Char)" env + $ \inh outh -> linesUnlinesArrayCharCopy inh outh + + , mkBenchSmall "interposeSuffix . wordsBy ([Word8])" env + $ \inh outh -> wordsUnwordsCopyWord8 inh outh + , mkBenchSmall "unwords . wordsBy ([Char])" env + $ \inh outh -> wordsUnwordsCopy inh outh + , mkBenchSmall "UnicodeArr.unwords . UnicodeArr.words (Array Char)" env + $ \inh outh -> wordsUnwordsCharArrayCopy inh outh ] ------------------------------------------------------------------------------- @@ -322,29 +317,26 @@ _copyStreamUtf8Parser inh outh = -- XXX all these require @-fspec-constr-recursive=12@. o_1_space_decode_encode_read :: BenchEnv -> [Benchmark] o_1_space_decode_encode_read env = - [ bgroup "decode-encode" - [ - -- This needs an ascii file, as decode just errors out. - mkBench "encodeLatin1' . decodeLatin1" env $ \inh outh -> - copyStreamLatin1' inh outh - , mkBench "encodeLatin1 . decodeLatin1" env $ \inh outh -> - copyStreamLatin1 inh outh + -- This needs an ascii file, as decode just errors out. + [ mkBench "encodeLatin1' . decodeLatin1" env $ \inh outh -> + copyStreamLatin1' inh outh + , mkBench "encodeLatin1 . decodeLatin1" env $ \inh outh -> + copyStreamLatin1 inh outh #ifdef INCLUDE_STRICT_UTF8 - -- Requires valid unicode input - , mkBench "encodeUtf8' . decodeUtf8'" env $ \inh outh -> - _copyStreamUtf8' inh outh - , mkBench "encodeUtf8' . foldMany writeCharUtf8'" env $ \inh outh -> - _copyStreamUtf8'Fold inh outh + -- Requires valid unicode input + , mkBench "encodeUtf8' . decodeUtf8'" env $ \inh outh -> + _copyStreamUtf8' inh outh + , mkBench "encodeUtf8' . foldMany writeCharUtf8'" env $ \inh outh -> + _copyStreamUtf8'Fold inh outh #endif - , mkBenchSmall "encodeUtf8 . parseMany parseCharUtf8" env - $ \inh outh -> _copyStreamUtf8Parser inh outh - , mkBenchSmall "encodeUtf8 . decodeUtf8" env $ \inh outh -> - copyStreamUtf8 inh outh - {- - , mkBenchSmall "encodeUtf16 . decodeUtf16" env $ \inh outh -> - copyStreamUtf16 inh outh - -} - ] + , mkBenchSmall "encodeUtf8 . parseMany parseCharUtf8" env + $ \inh outh -> _copyStreamUtf8Parser inh outh + , mkBenchSmall "encodeUtf8 . decodeUtf8" env $ \inh outh -> + copyStreamUtf8 inh outh + {- + , mkBenchSmall "encodeUtf16 . decodeUtf16" env $ \inh outh -> + copyStreamUtf16 inh outh + -} ] main :: IO () diff --git a/benchmark/Streamly/Benchmark/Unicode/Utf8.hs b/benchmark/Streamly/Benchmark/Unicode/Utf8.hs index d0ea1c04d6..e7534e75e4 100644 --- a/benchmark/Streamly/Benchmark/Unicode/Utf8.hs +++ b/benchmark/Streamly/Benchmark/Unicode/Utf8.hs @@ -23,7 +23,7 @@ import qualified Streamly.Internal.Unicode.Utf8 as Utf8 -------------------------------------------------------------------------------- moduleName :: String -moduleName = "Unicode.Stream" +moduleName = "Unicode.Utf8" -------------------------------------------------------------------------------- -- Benchmarks diff --git a/benchmark/bench-runner/Main.hs b/benchmark/bench-runner/Main.hs index a826046015..2d06ec3b44 100644 --- a/benchmark/bench-runner/Main.hs +++ b/benchmark/bench-runner/Main.hs @@ -33,12 +33,12 @@ rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific] benchSpecific | "Data.Array" `isPrefixOf` benchName - && "/o-1-space.generation.read" `isSuffixOf` benchName = "-M32M" + && "/o-1-space.read" `isSuffixOf` benchName = "-M64M" -- XXX GHC 9.6 onwards needs 64M, earlier it was 32M | "Data.Array" `isPrefixOf` benchName - && "/o-1-space.generation.show" `isSuffixOf` benchName = "-M64M" + && "/o-1-space.show" `isSuffixOf` benchName = "-M64M" -- XXX GHC 9.6 onwards needs 64M, earlier it was 32M - | "Data.Array.Generic/o-1-space.transformationX4.map" + | "Data.Array.Generic/o-1-space.mapX4" `isPrefixOf` benchName = "-M64M" -- XXX For --long option, need to check why so much heap is required. @@ -50,7 +50,7 @@ rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific] ---------------------------------------------------------------------- -- GHC-9.6 requires 64M, earlier it was 16M - | "Data.Fold/o-n-heap.key-value.toHashMapIO (max buckets) sum" + | "Data.Fold/o-n-heap.toHashMapIO (max buckets) sum" == benchName = "-M64M" ---------------------------------------------------------------------- @@ -90,26 +90,26 @@ rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific] ----------------------------------------------------------------------- - | "Data.StreamK/o-n-space.elimination.toList" + | "Data.StreamK/o-n-space.toList" == benchName = "-K2M" - -- XXX Memory required for these has increased in streamly-core 0.3 - | "Data.StreamK/o-1-space.list.nested" - `isPrefixOf` benchName = "-M500M" ---------------------------------------------------------------------- -- Concurrent streams ---------------------------------------------------------------------- - | "Data.Stream.ConcurrentInterleaved/o-n-heap.cross-product.monad3" + | "Data.Stream.ConcurrentInterleaved/o-n-heap.monad3" `isPrefixOf` benchName = "-M128M" | "Data.Stream.ConcurrentEager/o-1-space." `isPrefixOf` benchName = "-M128M" - | "Data.Stream.ConcurrentEager/o-n-heap.cross-product" + | "Data.Stream.ConcurrentEager/o-n-heap.monad" + `isPrefixOf` benchName = "-M500M" + + | "Data.Stream.ConcurrentEager/o-n-heap.parCross" `isPrefixOf` benchName = "-M500M" - | "Data.Stream.ConcurrentOrdered/o-1-space.concat-foldable.foldMapWith" + | "Data.Stream.ConcurrentOrdered/o-1-space.foldMapWith" `isPrefixOf` benchName = "-K128K" ----------------------------------------------------------------------- From 559f91d81ccc52b2d2fefc8bcebb3fbd79f479b6 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sun, 14 Jun 2026 06:08:50 +0530 Subject: [PATCH 07/20] Flatten Array, StreamK benchmark lists into a single List --- benchmark/Streamly/Benchmark/Data/Array.hs | 34 +- .../Streamly/Benchmark/Data/Array/Common.hs | 72 +- .../Streamly/Benchmark/Data/Array/Generic.hs | 28 +- .../Benchmark/Data/Array/SmallArray.hs | 9 +- .../Streamly/Benchmark/Data/Array/Stream.hs | 85 +-- benchmark/Streamly/Benchmark/Data/MutArray.hs | 104 +-- benchmark/Streamly/Benchmark/Data/StreamK.hs | 695 ++++++++---------- 7 files changed, 409 insertions(+), 618 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Array.hs b/benchmark/Streamly/Benchmark/Data/Array.hs index 1dd43d6a05..9ed09c1ac5 100644 --- a/benchmark/Streamly/Benchmark/Data/Array.hs +++ b/benchmark/Streamly/Benchmark/Data/Array.hs @@ -83,26 +83,6 @@ createOfLastMax value = withStream value (S.fold (IA.createOfLast (value + 1))) -- Bench groups ------------------------------------------------------------------------------- -o_1_space_generation :: Int -> [Benchmark] -o_1_space_generation value = - [ benchIO "write . intFromTo" $ sourceIntFromToFromStream value - , benchIO "read" $ readInstance value - , benchIO "writeN . IsList.fromList" $ sourceIsList value - , benchIO "writeN . IsString.fromString" $ sourceIsString value - ] - -o_1_space_elimination :: Int -> [Benchmark] -o_1_space_elimination value = - [ benchIO "length . IsList.toList" $ toListLength value - , benchIO "createOfLast.1" $ createOfLast1 value - , benchIO "createOfLast.10" $ createOfLast10 value - ] - -o_n_heap_serial :: Int -> [Benchmark] -o_n_heap_serial value = - [ benchIO "createOfLast.Max" $ createOfLastMax value - ] - moduleName :: String moduleName = "Data.Array" @@ -111,9 +91,17 @@ defStreamSize = defaultStreamSize benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = - fmap (SpaceO_1,) - (o_1_space_generation size ++ o_1_space_elimination size) - ++ fmap (HeapO_n,) (o_n_heap_serial size) + [ (SpaceO_1, benchIO "write . intFromTo" $ sourceIntFromToFromStream size) + , (SpaceO_1, benchIO "read" $ readInstance size) + , (SpaceO_1, benchIO "writeN . IsList.fromList" $ sourceIsList size) + , (SpaceO_1, benchIO "writeN . IsString.fromString" $ sourceIsString size) + + , (SpaceO_1, benchIO "length . IsList.toList" $ toListLength size) + , (SpaceO_1, benchIO "createOfLast.1" $ createOfLast1 size) + , (SpaceO_1, benchIO "createOfLast.10" $ createOfLast10 size) + + , (HeapO_n, benchIO "createOfLast.Max" $ createOfLastMax size) + ] ++ commonBenchmarks size main :: IO () diff --git a/benchmark/Streamly/Benchmark/Data/Array/Common.hs b/benchmark/Streamly/Benchmark/Data/Array/Common.hs index 02f8d2cbbd..5466d9cafb 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Common.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Common.hs @@ -140,52 +140,30 @@ writeN value = withStream value (S.fold (A.createOf value)) -- Bench groups ------------------------------------------------------------------------------- -common_o_1_space_generation :: Int -> [Benchmark] -common_o_1_space_generation value = - [ benchIO "writeN . intFromTo" $ sourceIntFromTo value - , benchIO "fromList . intFromTo" $ sourceIntFromToFromList value - , benchIO "writeN . unfoldr" $ sourceUnfoldr value - , benchIO "writeN . fromList" $ sourceFromList value - , benchIO "show" $ showStream value - ] - -common_o_1_space_elimination :: Int -> [Benchmark] -common_o_1_space_elimination value = - [ benchIO "id" $ idArr value - , benchIO "==" $ eqInstance value - , benchIO "/=" $ eqInstanceNotEq value - , benchIO "<" $ ordInstance value - , benchIO "min" $ ordInstanceMin value - , benchIO "foldl'" $ pureFoldl' value - , benchIO "unfoldRead" $ unfoldReadDrain value - , benchIO "toStreamRev" $ toStreamRevDrain value - ] - -common_o_n_heap_serial :: Int -> [Benchmark] -common_o_n_heap_serial value = - [ benchIO "writeN" $ writeN value - ] - -common_o_1_space_transformation :: Int -> [Benchmark] -common_o_1_space_transformation value = - [ benchIO "scanl'" $ scanl' value - , benchIO "scanl1'" $ scanl1' value - , benchIO "map" $ map value - ] - -common_o_1_space_transformationX4 :: Int -> [Benchmark] -common_o_1_space_transformationX4 value = - [ benchIO "scanl'X4" $ scanl'X4 value - , benchIO "scanl1'X4" $ scanl1'X4 value - , benchIO "mapX4" $ mapX4 value - ] - commonBenchmarks :: Int -> [(SpaceComplexity, Benchmark)] commonBenchmarks size = - fmap (SpaceO_1,) (concat - [ common_o_1_space_generation size - , common_o_1_space_elimination size - , common_o_1_space_transformation size - , common_o_1_space_transformationX4 size - ]) - ++ fmap (HeapO_n,) (common_o_n_heap_serial size) + [ (SpaceO_1, benchIO "writeN . intFromTo" $ sourceIntFromTo size) + , (SpaceO_1, benchIO "fromList . intFromTo" $ sourceIntFromToFromList size) + , (SpaceO_1, benchIO "writeN . unfoldr" $ sourceUnfoldr size) + , (SpaceO_1, benchIO "writeN . fromList" $ sourceFromList size) + , (SpaceO_1, benchIO "show" $ showStream size) + + , (SpaceO_1, benchIO "id" $ idArr size) + , (SpaceO_1, benchIO "==" $ eqInstance size) + , (SpaceO_1, benchIO "/=" $ eqInstanceNotEq size) + , (SpaceO_1, benchIO "<" $ ordInstance size) + , (SpaceO_1, benchIO "min" $ ordInstanceMin size) + , (SpaceO_1, benchIO "foldl'" $ pureFoldl' size) + , (SpaceO_1, benchIO "unfoldRead" $ unfoldReadDrain size) + , (SpaceO_1, benchIO "toStreamRev" $ toStreamRevDrain size) + + , (SpaceO_1, benchIO "scanl'" $ scanl' size) + , (SpaceO_1, benchIO "scanl1'" $ scanl1' size) + , (SpaceO_1, benchIO "map" $ map size) + + , (SpaceO_1, benchIO "scanl'X4" $ scanl'X4 size) + , (SpaceO_1, benchIO "scanl1'X4" $ scanl1'X4 size) + , (SpaceO_1, benchIO "mapX4" $ mapX4 size) + + , (HeapO_n, benchIO "writeN" $ writeN size) + ] diff --git a/benchmark/Streamly/Benchmark/Data/Array/Generic.hs b/benchmark/Streamly/Benchmark/Data/Array/Generic.hs index 57184fbcef..50f3473405 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Generic.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Generic.hs @@ -71,23 +71,6 @@ createOfLastMax value = withStream value (S.fold (IA.createOfLast (value + 1))) -- Bench groups ------------------------------------------------------------------------------- -o_1_space_generation :: Int -> [Benchmark] -o_1_space_generation value = - [ benchIO "write . intFromTo" $ sourceIntFromToFromStream value - , benchIO "read" $ readInstance value - ] - -o_1_space_elimination :: Int -> [Benchmark] -o_1_space_elimination value = - [ benchIO "createOfLast.1" $ createOfLast1 value - , benchIO "createOfLast.10" $ createOfLast10 value - ] - -o_n_heap_serial :: Int -> [Benchmark] -o_n_heap_serial value = - [ benchIO "createOfLast.Max" $ createOfLastMax value - ] - moduleName :: String moduleName = "Data.Array.Generic" @@ -96,9 +79,14 @@ defStreamSize = defaultStreamSize benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = - fmap (SpaceO_1,) - (o_1_space_generation size ++ o_1_space_elimination size) - ++ fmap (HeapO_n,) (o_n_heap_serial size) + [ (SpaceO_1, benchIO "write . intFromTo" $ sourceIntFromToFromStream size) + , (SpaceO_1, benchIO "read" $ readInstance size) + + , (SpaceO_1, benchIO "createOfLast.1" $ createOfLast1 size) + , (SpaceO_1, benchIO "createOfLast.10" $ createOfLast10 size) + + , (HeapO_n, benchIO "createOfLast.Max" $ createOfLastMax size) + ] ++ commonBenchmarks size main :: IO () diff --git a/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs b/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs index 44e25eb3f3..01461471ff 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs @@ -49,11 +49,6 @@ foldableSum = P.sum -- Bench groups ------------------------------------------------------------------------------- -o_1_space_generation :: Int -> [Benchmark] -o_1_space_generation value = - [ benchIO "read" $ readInstance value - ] - {- o_1_space_elimination :: Int -> [Benchmark] o_1_space_elimination value = @@ -77,7 +72,9 @@ defStreamSize = 128 benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = - fmap (SpaceO_1,) (o_1_space_generation size) ++ commonBenchmarks size + [ (SpaceO_1, benchIO "read" $ readInstance size) + ] + ++ commonBenchmarks size main :: IO () main = runWithCLIOpts defStreamSize allBenchmarks diff --git a/benchmark/Streamly/Benchmark/Data/Array/Stream.hs b/benchmark/Streamly/Benchmark/Data/Array/Stream.hs index 8df6876b93..ab5a947807 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Stream.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Stream.hs @@ -157,25 +157,6 @@ inspect $ hasNoTypeClasses 'toChunksSplitOn inspect $ 'toChunksSplitOn `hasNoType` ''Step #endif -o_1_space_read_chunked :: BenchEnv -> [Benchmark] -o_1_space_read_chunked env = - -- read using toChunks instead of read - [ mkBench "Stream.last" env $ \inH _ -> - toChunksLast inH - -- Note: this cannot be fairly compared with GNU wc -c or wc -m as - -- wc uses lseek to just determine the file size rather than reading - -- and counting characters. - , mkBench "Stream.sum . Stream.map Array.length" env $ \inH _ -> - toChunksSumLengths inH - , mkBench "splitOnSuffix" env $ \inH _ -> - toChunksSplitOnSuffix inH - , mkBench "splitOn" env $ \inH _ -> - toChunksSplitOn inH - , mkBench "countBytes" env $ \inH _ -> - toChunksCountBytes inH - , mkBenchSmall "decodeUtf8Arrays" env $ \inH _ -> - toChunksDecodeUtf8Arrays inH - ] ------------------------------------------------------------------------------- -- copy with group/ungroup transformations @@ -209,13 +190,6 @@ inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Unbox] inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step #endif -o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark] -o_1_space_copy_toChunks_group_ungroup env = - [ mkBench "interposeSuffix . splitOnSuffix" env $ \inh outh -> - copyChunksSplitInterposeSuffix inh outh - , mkBenchSmall "interpose . splitOn" env $ \inh outh -> - copyChunksSplitInterpose inh outh - ] ------------------------------------------------------------------------------- -- Parsers @@ -254,24 +228,6 @@ parseBreak s = do (Left _, _) -> return () (Right _, s1) -> parseBreak s1 -o_1_space_serial_array :: - Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark] -o_1_space_serial_array bound arraysSmall arraysBig = - [ benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold - , benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold - , benchIO - "foldBreak (recursive, small arrays)" - (\_ -> Stream.fromList arraysSmall) - (foldBreak . StreamK.fromStream) - , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall) - $ parse bound - , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig) - $ parse bound - , benchIO - "parseBreak (recursive, small arrays)" - (\_ -> Stream.fromList arraysSmall) - (parseBreak . StreamK.fromStream) - ] ------------------------------------------------------------------------------- -- Driver @@ -298,10 +254,43 @@ main = do benchmarks env arrays value = let (arraysSmall, arraysBig) = arrays - in map (SpaceO_1,) $ Prelude.concat - [ o_1_space_read_chunked env - , o_1_space_serial_array value arraysSmall arraysBig - , o_1_space_copy_toChunks_group_ungroup env + in + -- read using toChunks instead of read + [ (SpaceO_1, mkBench "Stream.last" env $ \inH _ -> + toChunksLast inH) + -- Note: this cannot be fairly compared with GNU wc -c or wc -m as + -- wc uses lseek to just determine the file size rather than reading + -- and counting characters. + , (SpaceO_1, mkBench "Stream.sum . Stream.map Array.length" env $ \inH _ -> + toChunksSumLengths inH) + , (SpaceO_1, mkBench "splitOnSuffix" env $ \inH _ -> + toChunksSplitOnSuffix inH) + , (SpaceO_1, mkBench "splitOn" env $ \inH _ -> + toChunksSplitOn inH) + , (SpaceO_1, mkBench "countBytes" env $ \inH _ -> + toChunksCountBytes inH) + , (SpaceO_1, mkBenchSmall "decodeUtf8Arrays" env $ \inH _ -> + toChunksDecodeUtf8Arrays inH) + + , (SpaceO_1, benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold) + , (SpaceO_1, benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold) + , (SpaceO_1, benchIO + "foldBreak (recursive, small arrays)" + (\_ -> Stream.fromList arraysSmall) + (foldBreak . StreamK.fromStream)) + , (SpaceO_1, benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall) + $ parse value) + , (SpaceO_1, benchIO "parse (single)" (\_ -> Stream.fromList arraysBig) + $ parse value) + , (SpaceO_1, benchIO + "parseBreak (recursive, small arrays)" + (\_ -> Stream.fromList arraysSmall) + (parseBreak . StreamK.fromStream)) + + , (SpaceO_1, mkBench "interposeSuffix . splitOnSuffix" env $ \inh outh -> + copyChunksSplitInterposeSuffix inh outh) + , (SpaceO_1, mkBenchSmall "interpose . splitOn" env $ \inh outh -> + copyChunksSplitInterpose inh outh) ] allBenchmarks env arrays value = diff --git a/benchmark/Streamly/Benchmark/Data/MutArray.hs b/benchmark/Streamly/Benchmark/Data/MutArray.hs index 97220d22cb..25ea401b6c 100644 --- a/benchmark/Streamly/Benchmark/Data/MutArray.hs +++ b/benchmark/Streamly/Benchmark/Data/MutArray.hs @@ -38,8 +38,6 @@ import Prelude , ($) , (.) , (||) - , (++) - , concat , filter , fmap , fst @@ -214,61 +212,6 @@ writeN value = withStream value (Stream.fold (MArray.createOf value)) -- Bench groups ------------------------------------------------------------------------------- -o_1_space_generation :: Int -> [Benchmark] -o_1_space_generation value = - [ benchIO "createOf . intFromTo" $ sourceIntFromTo value - , benchIO "fromList . intFromTo" $ sourceIntFromToFromList value - , benchIO "createOf . unfoldr" $ sourceUnfoldr value - , benchIO "createOf . fromList" $ sourceFromList value - , benchIO "write . intFromTo" $ sourceIntFromToFromStream value - ] - -o_1_space_elimination :: Int -> [Benchmark] -o_1_space_elimination value = - [ benchIO "id" $ idArr value - , benchIO "foldl'" $ unfoldFold value - , benchIO "read" $ unfoldReadDrain value - , benchIO "readRev" $ unfoldReadRevDrain value - , benchIO "toStream" $ toStreamDDrain value - , benchIO "toStreamRev" $ toStreamDRevDrain value - ] - -o_n_heap_serial :: Int -> [Benchmark] -o_n_heap_serial value = - [ benchIO "createOf" $ writeN value - ] - -o_1_space_transformation :: Int -> [Benchmark] -o_1_space_transformation value = - [ benchIO "scanl'" $ scanl' value - , benchIO "scanl1'" $ scanl1' value - , benchIO "map" $ map value - ] - -o_1_space_transformationX4 :: Int -> [Benchmark] -o_1_space_transformationX4 value = - [ benchIO "scanl'X4" $ scanl'X4 value - , benchIO "scanl1'X4" $ scanl1'X4 value - , benchIO "mapX4" $ mapX4 value - ] - -o_1_space_serial_marray :: - Int -> (MutArray Int, Array.Array Int) -> [Benchmark] -o_1_space_serial_marray value ~(array, indices) = - [ benchIO "partitionBy (< 0)" $ MArray.partitionBy (< 0) array - , benchIO "partitionBy (> 0)" $ MArray.partitionBy (> 0) array - , benchIO "partitionBy (< value/2)" $ - MArray.partitionBy (< (value `div` 2)) array - , benchIO "partitionBy (> value/2)" $ - MArray.partitionBy (> (value `div` 2)) array - , benchIO "strip (< value/2 || > value/2)" $ - MArray.dropAround (\x -> x < value `div` 2 || x > value `div` 2) array - , benchIO "strip (> 0)" $ MArray.dropAround (> 0) array - , benchIO "modifyIndices (+ 1)" $ - Stream.fold (MArray.modifyIndices array (\_idx val -> val + 1)) - $ Stream.unfold Array.reader indices - ] - ------------------------------------------------------------------------------- -- Driver ------------------------------------------------------------------------------- @@ -278,16 +221,43 @@ moduleName = "Data.MutArray" benchmarks :: (MutArray Int, Array.Array Int) -> Int -> [(SpaceComplexity, Benchmark)] -benchmarks array value = - fmap (SpaceO_1,) - (concat - [ o_1_space_serial_marray value array - , o_1_space_generation value - , o_1_space_elimination value - , o_1_space_transformation value - , o_1_space_transformationX4 value - ]) - ++ fmap (HeapO_n,) (o_n_heap_serial value) +benchmarks ~(array, indices) value = + [ (SpaceO_1, benchIO "partitionBy (< 0)" $ MArray.partitionBy (< 0) array) + , (SpaceO_1, benchIO "partitionBy (> 0)" $ MArray.partitionBy (> 0) array) + , (SpaceO_1, benchIO "partitionBy (< value/2)" $ + MArray.partitionBy (< (value `div` 2)) array) + , (SpaceO_1, benchIO "partitionBy (> value/2)" $ + MArray.partitionBy (> (value `div` 2)) array) + , (SpaceO_1, benchIO "strip (< value/2 || > value/2)" $ + MArray.dropAround (\x -> x < value `div` 2 || x > value `div` 2) array) + , (SpaceO_1, benchIO "strip (> 0)" $ MArray.dropAround (> 0) array) + , (SpaceO_1, benchIO "modifyIndices (+ 1)" $ + Stream.fold (MArray.modifyIndices array (\_idx val -> val + 1)) + $ Stream.unfold Array.reader indices) + + , (SpaceO_1, benchIO "createOf . intFromTo" $ sourceIntFromTo value) + , (SpaceO_1, benchIO "fromList . intFromTo" $ sourceIntFromToFromList value) + , (SpaceO_1, benchIO "createOf . unfoldr" $ sourceUnfoldr value) + , (SpaceO_1, benchIO "createOf . fromList" $ sourceFromList value) + , (SpaceO_1, benchIO "write . intFromTo" $ sourceIntFromToFromStream value) + + , (SpaceO_1, benchIO "id" $ idArr value) + , (SpaceO_1, benchIO "foldl'" $ unfoldFold value) + , (SpaceO_1, benchIO "read" $ unfoldReadDrain value) + , (SpaceO_1, benchIO "readRev" $ unfoldReadRevDrain value) + , (SpaceO_1, benchIO "toStream" $ toStreamDDrain value) + , (SpaceO_1, benchIO "toStreamRev" $ toStreamDRevDrain value) + + , (SpaceO_1, benchIO "scanl'" $ scanl' value) + , (SpaceO_1, benchIO "scanl1'" $ scanl1' value) + , (SpaceO_1, benchIO "map" $ map value) + + , (SpaceO_1, benchIO "scanl'X4" $ scanl'X4 value) + , (SpaceO_1, benchIO "scanl1'X4" $ scanl1'X4 value) + , (SpaceO_1, benchIO "mapX4" $ mapX4 value) + + , (HeapO_n, benchIO "createOf" $ writeN value) + ] main :: IO () main = do diff --git a/benchmark/Streamly/Benchmark/Data/StreamK.hs b/benchmark/Streamly/Benchmark/Data/StreamK.hs index 5985048a27..5924d3f6ee 100644 --- a/benchmark/Streamly/Benchmark/Data/StreamK.hs +++ b/benchmark/Streamly/Benchmark/Data/StreamK.hs @@ -864,417 +864,298 @@ moduleName = "Data.StreamK" benchIO :: NFData b => String -> IO b -> Benchmark benchIO name = bench name . nfIO -o_1_space_generation :: Int -> [Benchmark] -o_1_space_generation streamLen = - [ benchIO "unfoldr" $ unfoldr streamLen - , benchIO "unfoldrM" $ unfoldrM streamLen - , benchIO "repeat" $ repeat streamLen - , benchIO "repeatM" $ repeatM streamLen - , benchIO "replicate" $ replicate streamLen - , benchIO "replicateM" $ replicateM streamLen - , benchIO "iterate" $ iterate streamLen - , benchIO "iterateM" $ iterateM streamLen - - , benchIO "fromFoldable" $ fromFoldable streamLen - , benchIO "fromFoldableM" $ fromFoldableM streamLen - - -- appends - , benchIO "concatMapFoldableWith" $ concatMapFoldableWith streamLen - , benchIO "concatMapFoldableWithM" $ concatMapFoldableWithM streamLen - ] - -o_1_space_elimination :: Int -> [Benchmark] -o_1_space_elimination streamLen = - [ benchIO "toNull" $ toNull streamLen - , benchIO "mapM_" $ mapM_ streamLen - , benchIO "uncons" $ uncons streamLen - , benchIO "init" $ init streamLen - , benchIO "foldl'" $ foldl' streamLen - , benchIO "foldlM'" $ foldlM' streamLen - , benchIO "last" $ last streamLen - ] - -o_1_space_ap :: Int -> [Benchmark] -o_1_space_ap streamLen = - [ benchIO "ap drain2" $ drainApplicative streamLen2 - , benchIO "ap pureDrain2" $ drainApplicativeUnfoldr streamLen2 - ] - where - streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop - -o_1_space_monad :: Int -> [Benchmark] -o_1_space_monad streamLen = - [ benchIO "monad drain2" $ drainMonad streamLen2 - , benchIO "monad drain3" $ drainMonad3 streamLen3 - , benchIO "monad filterAllIn2" $ filterAllInMonad streamLen2 - , benchIO "monad filterAllOut2" $ filterAllOutMonad streamLen2 - , benchIO "monad pureDrain2" $ drainMonadUnfoldr streamLen2 - , benchIO "monad pureDrain3" $ drainMonad3Unfoldr streamLen3 - , benchIO "monad pureFilterAllIn2" $ filterAllInMonadUnfoldr streamLen2 - , benchIO "monad pureFilterAllOut2" $ filterAllOutMonadUnfoldr streamLen2 - ] - where - streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop - streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop - -o_1_space_bind :: Int -> [Benchmark] -o_1_space_bind streamLen = - [ benchIO "concatFor drain1" $ drainConcatFor1 streamLen - , benchIO "concatFor drain2" $ drainConcatFor streamLen2 - , benchIO "concatFor drainM2" $ drainConcatForM streamLen2 - , benchIO "concatFor drain3" $ drainConcatFor3 streamLen3 - , benchIO "concatFor drain4" $ drainConcatFor4 streamLen4 - , benchIO "concatFor drain5" $ drainConcatFor5 streamLen5 - , benchIO "concatFor drainM3" $ drainConcatFor3M streamLen3 - , benchIO "concatFor filterAllIn2" $ filterAllInConcatFor streamLen2 - , benchIO "concatFor filterAllOut2" $ filterAllOutConcatFor streamLen2 - ] - where - streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop - streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop - streamLen4 = round (P.fromIntegral streamLen**(1/4::P.Double)) -- 4 times nested loop - streamLen5 = round (P.fromIntegral streamLen**(1/5::P.Double)) -- 5 times nested loop - -o_1_space_transformation :: Int -> [Benchmark] -o_1_space_transformation streamLen = - [ benchIO "foldrS" $ foldrS 1 streamLen - , benchIO "scanl'" $ scanl' 1 streamLen - , benchIO "map" $ map 1 streamLen - , benchIO "fmap" $ fmapK 1 streamLen - , benchIO "mapM" $ mapM 1 streamLen - , benchIO "mapMSerial" $ mapMSerial 1 streamLen - ] - -o_1_space_transformationX4 :: Int -> [Benchmark] -o_1_space_transformationX4 streamLen = - [ benchIO "scanl'X4" $ scanl' 4 streamLen - , benchIO "mapX4" $ map 4 streamLen - , benchIO "fmapX4" $ fmapK 4 streamLen - , benchIO "mapMX4" $ mapM 4 streamLen - , benchIO "mapMSerialX4" $ mapMSerial 4 streamLen - -- XXX this is horribly slow - -- , benchIO "concatMap" $ concatMap 4 streamLen16 - ] - -o_1_space_joining :: Int -> [Benchmark] -o_1_space_joining streamLen = - [ benchIO "interleave" $ interleave2 streamLen - - , benchIO "mergeBy compare" - $ mergeBy compare (streamLen `div` 2) - , benchIO "mergeByM compare" - $ mergeByM compare (streamLen `div` 2) - , benchIO "mergeBy (flip compare)" - $ mergeBy (flip compare) (streamLen `div` 2) - , benchIO "mergeByM (flip compare)" - $ mergeByM (flip compare) (streamLen `div` 2) - - , benchIO "zipWith" $ zipWith streamLen - , benchIO "zipWithM" $ zipWithM streamLen - - -- join 2 streams using concatMapWith - , benchIO "concatMapWith interleave" - $ concatMapWith StreamK.interleave 2 (streamLen `div` 2) - , benchIO "concatMapWith D.interleave" - $ concatMapWithD Stream.interleave 2 (streamLen `div` 2) - , benchIO "concatMapWith D.roundRobin" - $ concatMapWithD Stream.roundRobin 2 (streamLen `div` 2) - - -- join 2 streams using mergeMapWith - , benchIO "mergeMapWith interleave" - $ mergeMapWith StreamK.interleave 2 (streamLen `div` 2) - , benchIO "mergeMapWith D.interleave" - $ mergeMapWithD Stream.interleave 2 (streamLen `div` 2) - , benchIO "mergeMapWith D.roundRobin" - $ mergeMapWithD Stream.roundRobin 2 (streamLen `div` 2) - - , benchIO "mergeMapWith (mergeBy compare)" - $ mergeMapWith (StreamK.mergeBy compare) 2 (streamLen `div` 2) - , benchIO "mergeMapWith (mergeBy (flip compare))" - $ mergeMapWith (StreamK.mergeBy (flip compare)) 2 (streamLen `div` 2) - , benchIO "mergeMapWithD (D.mergeBy compare)" - $ mergeMapWithD (Stream.mergeBy compare) 2 (streamLen `div` 2) - , benchIO "mergeMapWithD (D.mergeBy (flip compare))" - $ mergeMapWithD (Stream.mergeBy (flip compare)) 2 (streamLen `div` 2) - - , benchIO "mergeMapWith (zipWith (+))" - $ mergeMapWith (StreamK.zipWith (+)) 2 (streamLen `div` 2) - ] - -o_1_space_concat :: Int -> [Benchmark] -o_1_space_concat streamLen = - [ benchIO "concatMapUnfoldr outer=Max inner=1" - $ concatMapUnfoldr streamLen 1 - , benchIO "concatMapUnfoldr outer=inner=(sqrt Max)" - $ concatMapUnfoldr streamLen2 streamLen2 - , benchIO "concatMapUnfoldr outer=1 inner=Max" - $ concatMapUnfoldr 1 streamLen - - , benchIO "concatMap outer=Max inner=1" - $ concatMap streamLen 1 - , benchIO "concatMap outer=inner=(sqrt Max)" - $ concatMap streamLen2 streamLen2 - , benchIO "concatMap outer=1 inner=Max" - $ concatMap 1 streamLen - - , benchIO "concatMapRepl outer=inner=(sqrt Max)" - $ concatMapRepl streamLen2 streamLen2 - - -- This is for comparison with concatMapFoldableWith - , benchIO "concatMapWithId outer=Max inner=1 (fromFoldable)" - $ concatMapWithId streamLen - - , benchIO "concatMapWith append outer=Max inner=1" - $ concatMapWith StreamK.append streamLen 1 - , benchIO "concatMapWith append outer=inner=(sqrt Max)" - $ concatMapWith StreamK.append streamLen2 streamLen2 - , benchIO "concatMapWith append outer=1 inner=Max" - $ concatMapWith StreamK.append 1 streamLen - - -- interleave with concatMapWith is O(1) - , benchIO "concatMapWith interleave outer=Max inner=1" - $ concatMapWith StreamK.interleave streamLen 1 - , benchIO "concatMapWith interleave outer=inner=(sqrt Max)" - $ concatMapWith StreamK.interleave streamLen2 streamLen2 - , benchIO "concatMapWith interleave outer=1 inner=Max" - $ concatMapWith StreamK.interleave 1 streamLen - ] - - where - - streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop - -o_n_space_concat :: Int -> [Benchmark] -o_n_space_concat streamLen = - -- concatMapWith using StreamD versions of interleave operations are - -- all quadratic, we just measure the sqrtVal benchmark for comparison. - [ benchIO "concatMapWithD D.interleave outer=inner=(sqrt Max)" - $ concatMapWithD Stream.interleave streamLen2 streamLen2 - , benchIO "concatMapWithD D.roundRobin outer=inner=(sqrt Max)" - $ concatMapWithD Stream.roundRobin streamLen2 streamLen2 - ] - - where - - streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop - -o_n_heap_concat :: Int -> [Benchmark] -o_n_heap_concat streamLen = - [ benchIO "mergeMapWith interleave outer=Max inner=1" - $ mergeMapWith StreamK.interleave streamLen 1 - , benchIO "mergeMapWith interleave outer=inner=(sqrt Max)" - $ mergeMapWith StreamK.interleave streamLen2 streamLen2 - , benchIO "mergeMapWith interleave outer=1 inner=Max" - $ mergeMapWith StreamK.interleave 1 streamLen - - , benchIO "mergeMapWithD D.interleave outer=inner=(sqrt Max)" - $ mergeMapWithD Stream.interleave streamLen2 streamLen2 - , benchIO "mergeMapWithD D.roundRobin outer=inner=(sqrt Max)" - $ mergeMapWithD Stream.roundRobin streamLen2 streamLen2 - - , benchIO "mergeMapWith (mergeBy compare) outer=Max inner=1" - $ mergeMapWith (StreamK.mergeBy compare) streamLen 1 - , benchIO "mergeMapWith (mergeBy compare) outer=inner=(sqrt Max)" - $ mergeMapWith (StreamK.mergeBy compare) streamLen2 streamLen2 - , benchIO "mergeMapWith (mergeBy compare) outer=1 inner=Max" - $ mergeMapWith (StreamK.mergeBy compare) 1 streamLen - - , benchIO "mergeMapWith (mergeBy (flip compare)) outer=Max inner=1" - $ mergeMapWith (StreamK.mergeBy (flip compare)) streamLen 1 - , benchIO "mergeMapWith (mergeBy (flip compare)) outer=inner=(sqrt Max)" - $ mergeMapWith (StreamK.mergeBy (flip compare)) streamLen2 streamLen2 - , benchIO "mergeMapWith (mergeBy (flip compare)) outer=1 inner=Max" - $ mergeMapWith (StreamK.mergeBy (flip compare)) 1 streamLen +benchmarks :: Int -> Int -> Int -> [(SpaceComplexity, Benchmark)] +benchmarks streamLen iterStreamLen maxIters = + let streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop + streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop + streamLen4 = round (P.fromIntegral streamLen**(1/4::P.Double)) -- 4 times nested loop + streamLen5 = round (P.fromIntegral streamLen**(1/5::P.Double)) -- 5 times nested loop + streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) + in + -- O(1) space + [ (SpaceO_1, benchIO "unfoldr" $ unfoldr streamLen) + , (SpaceO_1, benchIO "unfoldrM" $ unfoldrM streamLen) + , (SpaceO_1, benchIO "repeat" $ repeat streamLen) + , (SpaceO_1, benchIO "repeatM" $ repeatM streamLen) + , (SpaceO_1, benchIO "replicate" $ replicate streamLen) + , (SpaceO_1, benchIO "replicateM" $ replicateM streamLen) + , (SpaceO_1, benchIO "iterate" $ iterate streamLen) + , (SpaceO_1, benchIO "iterateM" $ iterateM streamLen) + + , (SpaceO_1, benchIO "fromFoldable" $ fromFoldable streamLen) + , (SpaceO_1, benchIO "fromFoldableM" $ fromFoldableM streamLen) + + -- appends + , (SpaceO_1, benchIO "concatMapFoldableWith" $ concatMapFoldableWith streamLen) + , (SpaceO_1, benchIO "concatMapFoldableWithM" $ concatMapFoldableWithM streamLen) + + , (SpaceO_1, benchIO "toNull" $ toNull streamLen) + , (SpaceO_1, benchIO "mapM_" $ mapM_ streamLen) + , (SpaceO_1, benchIO "uncons" $ uncons streamLen) + , (SpaceO_1, benchIO "init" $ init streamLen) + , (SpaceO_1, benchIO "foldl'" $ foldl' streamLen) + , (SpaceO_1, benchIO "foldlM'" $ foldlM' streamLen) + , (SpaceO_1, benchIO "last" $ last streamLen) + + , (SpaceO_1, benchIO "ap drain2" $ drainApplicative streamLen2) + , (SpaceO_1, benchIO "ap pureDrain2" $ drainApplicativeUnfoldr streamLen2) + + , (SpaceO_1, benchIO "monad drain2" $ drainMonad streamLen2) + , (SpaceO_1, benchIO "monad drain3" $ drainMonad3 streamLen3) + , (SpaceO_1, benchIO "monad filterAllIn2" $ filterAllInMonad streamLen2) + , (SpaceO_1, benchIO "monad filterAllOut2" $ filterAllOutMonad streamLen2) + , (SpaceO_1, benchIO "monad pureDrain2" $ drainMonadUnfoldr streamLen2) + , (SpaceO_1, benchIO "monad pureDrain3" $ drainMonad3Unfoldr streamLen3) + , (SpaceO_1, benchIO "monad pureFilterAllIn2" $ filterAllInMonadUnfoldr streamLen2) + , (SpaceO_1, benchIO "monad pureFilterAllOut2" $ filterAllOutMonadUnfoldr streamLen2) + + , (SpaceO_1, benchIO "concatFor drain1" $ drainConcatFor1 streamLen) + , (SpaceO_1, benchIO "concatFor drain2" $ drainConcatFor streamLen2) + , (SpaceO_1, benchIO "concatFor drainM2" $ drainConcatForM streamLen2) + , (SpaceO_1, benchIO "concatFor drain3" $ drainConcatFor3 streamLen3) + , (SpaceO_1, benchIO "concatFor drain4" $ drainConcatFor4 streamLen4) + , (SpaceO_1, benchIO "concatFor drain5" $ drainConcatFor5 streamLen5) + , (SpaceO_1, benchIO "concatFor drainM3" $ drainConcatFor3M streamLen3) + , (SpaceO_1, benchIO "concatFor filterAllIn2" $ filterAllInConcatFor streamLen2) + , (SpaceO_1, benchIO "concatFor filterAllOut2" $ filterAllOutConcatFor streamLen2) + + , (SpaceO_1, benchIO "foldrS" $ foldrS 1 streamLen) + , (SpaceO_1, benchIO "scanl'" $ scanl' 1 streamLen) + , (SpaceO_1, benchIO "map" $ map 1 streamLen) + , (SpaceO_1, benchIO "fmap" $ fmapK 1 streamLen) + , (SpaceO_1, benchIO "mapM" $ mapM 1 streamLen) + , (SpaceO_1, benchIO "mapMSerial" $ mapMSerial 1 streamLen) + + , (SpaceO_1, benchIO "scanl'X4" $ scanl' 4 streamLen) + , (SpaceO_1, benchIO "mapX4" $ map 4 streamLen) + , (SpaceO_1, benchIO "fmapX4" $ fmapK 4 streamLen) + , (SpaceO_1, benchIO "mapMX4" $ mapM 4 streamLen) + , (SpaceO_1, benchIO "mapMSerialX4" $ mapMSerial 4 streamLen) + -- XXX this is horribly slow + -- , (SpaceO_1, benchIO "concatMap" $ concatMap 4 streamLen16) + + , (SpaceO_1, benchIO "concatMapUnfoldr outer=Max inner=1" + $ concatMapUnfoldr streamLen 1) + , (SpaceO_1, benchIO "concatMapUnfoldr outer=inner=(sqrt Max)" + $ concatMapUnfoldr streamLen2 streamLen2) + , (SpaceO_1, benchIO "concatMapUnfoldr outer=1 inner=Max" + $ concatMapUnfoldr 1 streamLen) + + , (SpaceO_1, benchIO "concatMap outer=Max inner=1" + $ concatMap streamLen 1) + , (SpaceO_1, benchIO "concatMap outer=inner=(sqrt Max)" + $ concatMap streamLen2 streamLen2) + , (SpaceO_1, benchIO "concatMap outer=1 inner=Max" + $ concatMap 1 streamLen) + + , (SpaceO_1, benchIO "concatMapRepl outer=inner=(sqrt Max)" + $ concatMapRepl streamLen2 streamLen2) + + -- This is for comparison with concatMapFoldableWith + , (SpaceO_1, benchIO "concatMapWithId outer=Max inner=1 (fromFoldable)" + $ concatMapWithId streamLen) + + , (SpaceO_1, benchIO "concatMapWith append outer=Max inner=1" + $ concatMapWith StreamK.append streamLen 1) + , (SpaceO_1, benchIO "concatMapWith append outer=inner=(sqrt Max)" + $ concatMapWith StreamK.append streamLen2 streamLen2) + , (SpaceO_1, benchIO "concatMapWith append outer=1 inner=Max" + $ concatMapWith StreamK.append 1 streamLen) + + -- interleave with concatMapWith is O(1) + , (SpaceO_1, benchIO "concatMapWith interleave outer=Max inner=1" + $ concatMapWith StreamK.interleave streamLen 1) + , (SpaceO_1, benchIO "concatMapWith interleave outer=inner=(sqrt Max)" + $ concatMapWith StreamK.interleave streamLen2 streamLen2) + , (SpaceO_1, benchIO "concatMapWith interleave outer=1 inner=Max" + $ concatMapWith StreamK.interleave 1 streamLen) + + , (SpaceO_1, benchIO "filter-even" $ filterEven 1 streamLen) + , (SpaceO_1, benchIO "filter-all-out" $ filterAllOut 1 streamLen) + , (SpaceO_1, benchIO "filter-all-in" $ filterAllIn 1 streamLen) + , (SpaceO_1, benchIO "take-all" $ takeAll 1 streamLen) + , (SpaceO_1, benchIO "takeWhile-true" $ takeWhileTrue 1 streamLen) + , (SpaceO_1, benchIO "drop-one" $ dropOne 1 streamLen) + , (SpaceO_1, benchIO "drop-all" $ dropAll 1 streamLen) + , (SpaceO_1, benchIO "dropWhile-true" $ dropWhileTrue 1 streamLen) + , (SpaceO_1, benchIO "dropWhile-false" $ dropWhileFalse 1 streamLen) + + , (SpaceO_1, benchIO "filter-evenX4" $ filterEven 4 streamLen) + , (SpaceO_1, benchIO "filter-all-outX4" $ filterAllOut 4 streamLen) + , (SpaceO_1, benchIO "filter-all-inX4" $ filterAllIn 4 streamLen) + , (SpaceO_1, benchIO "take-allX4" $ takeAll 4 streamLen) + , (SpaceO_1, benchIO "takeWhile-trueX4" $ takeWhileTrue 4 streamLen) + , (SpaceO_1, benchIO "drop-oneX4" $ dropOne 4 streamLen) + , (SpaceO_1, benchIO "drop-allX4" $ dropAll 4 streamLen) + , (SpaceO_1, benchIO "dropWhile-trueX4" $ dropWhileTrue 4 streamLen) + , (SpaceO_1, benchIO "dropWhile-falseX4" $ dropWhileFalse 4 streamLen) + + , (SpaceO_1, benchIO "interleave" $ interleave2 streamLen) + + , (SpaceO_1, benchIO "mergeBy compare" + $ mergeBy compare (streamLen `div` 2)) + , (SpaceO_1, benchIO "mergeByM compare" + $ mergeByM compare (streamLen `div` 2)) + , (SpaceO_1, benchIO "mergeBy (flip compare)" + $ mergeBy (flip compare) (streamLen `div` 2)) + , (SpaceO_1, benchIO "mergeByM (flip compare)" + $ mergeByM (flip compare) (streamLen `div` 2)) + + , (SpaceO_1, benchIO "zipWith" $ zipWith streamLen) + , (SpaceO_1, benchIO "zipWithM" $ zipWithM streamLen) + + -- join 2 streams using concatMapWith + , (SpaceO_1, benchIO "concatMapWith interleave" + $ concatMapWith StreamK.interleave 2 (streamLen `div` 2)) + , (SpaceO_1, benchIO "concatMapWith D.interleave" + $ concatMapWithD Stream.interleave 2 (streamLen `div` 2)) + , (SpaceO_1, benchIO "concatMapWith D.roundRobin" + $ concatMapWithD Stream.roundRobin 2 (streamLen `div` 2)) + + -- join 2 streams using mergeMapWith + , (SpaceO_1, benchIO "mergeMapWith interleave" + $ mergeMapWith StreamK.interleave 2 (streamLen `div` 2)) + , (SpaceO_1, benchIO "mergeMapWith D.interleave" + $ mergeMapWithD Stream.interleave 2 (streamLen `div` 2)) + , (SpaceO_1, benchIO "mergeMapWith D.roundRobin" + $ mergeMapWithD Stream.roundRobin 2 (streamLen `div` 2)) + + , (SpaceO_1, benchIO "mergeMapWith (mergeBy compare)" + $ mergeMapWith (StreamK.mergeBy compare) 2 (streamLen `div` 2)) + , (SpaceO_1, benchIO "mergeMapWith (mergeBy (flip compare))" + $ mergeMapWith (StreamK.mergeBy (flip compare)) 2 (streamLen `div` 2)) + , (SpaceO_1, benchIO "mergeMapWithD (D.mergeBy compare)" + $ mergeMapWithD (Stream.mergeBy compare) 2 (streamLen `div` 2)) + , (SpaceO_1, benchIO "mergeMapWithD (D.mergeBy (flip compare))" + $ mergeMapWithD (Stream.mergeBy (flip compare)) 2 (streamLen `div` 2)) + + , (SpaceO_1, benchIO "mergeMapWith (zipWith (+))" + $ mergeMapWith (StreamK.zipWith (+)) 2 (streamLen `div` 2)) + + , (SpaceO_1, benchIO "scan-map" $ scanMap 1 streamLen) + , (SpaceO_1, benchIO "drop-map" $ dropMap 1 streamLen) + , (SpaceO_1, benchIO "drop-scan" $ dropScan 1 streamLen) + , (SpaceO_1, benchIO "take-drop" $ takeDrop 1 streamLen) + , (SpaceO_1, benchIO "take-scan" $ takeScan 1 streamLen) + , (SpaceO_1, benchIO "take-map" $ takeMap 1 streamLen) + , (SpaceO_1, benchIO "filter-drop" $ filterDrop 1 streamLen) + , (SpaceO_1, benchIO "filter-take" $ filterTake 1 streamLen) + , (SpaceO_1, benchIO "filter-scan" $ filterScan 1 streamLen) + , (SpaceO_1, benchIO "filter-map" $ filterMap 1 streamLen) + + , (SpaceO_1, benchIO "scan-mapX2" $ scanMap 2 streamLen) + , (SpaceO_1, benchIO "drop-mapX2" $ dropMap 2 streamLen) + , (SpaceO_1, benchIO "drop-scanX2" $ dropScan 2 streamLen) + , (SpaceO_1, benchIO "take-dropX2" $ takeDrop 2 streamLen) + , (SpaceO_1, benchIO "take-scanX2" $ takeScan 2 streamLen) + , (SpaceO_1, benchIO "take-mapX2" $ takeMap 2 streamLen) + , (SpaceO_1, benchIO "filter-dropX2" $ filterDrop 2 streamLen) + , (SpaceO_1, benchIO "filter-takeX2" $ filterTake 2 streamLen) + , (SpaceO_1, benchIO "filter-scanX2" $ filterScan 2 streamLen) + , (SpaceO_1, benchIO "filter-mapX2" $ filterMap 2 streamLen) + + , (SpaceO_1, benchIO "scan-mapX4" $ scanMap 4 streamLen) + , (SpaceO_1, benchIO "drop-mapX4" $ dropMap 4 streamLen) + , (SpaceO_1, benchIO "drop-scanX4" $ dropScan 4 streamLen) + , (SpaceO_1, benchIO "take-dropX4" $ takeDrop 4 streamLen) + , (SpaceO_1, benchIO "take-scanX4" $ takeScan 4 streamLen) + , (SpaceO_1, benchIO "take-mapX4" $ takeMap 4 streamLen) + , (SpaceO_1, benchIO "filter-dropX4" $ filterDrop 4 streamLen) + , (SpaceO_1, benchIO "filter-takeX4" $ filterTake 4 streamLen) + , (SpaceO_1, benchIO "filter-scanX4" $ filterScan 4 streamLen) + , (SpaceO_1, benchIO "filter-mapX4" $ filterMap 4 streamLen) + + , (SpaceO_1, benchIO "list last" $ lastList streamLen) + , (SpaceO_1, benchIO "list ap drain2" $ listApDrain2 streamLen2) + , (SpaceO_1, benchIO "list monad drain2" $ listMonadDrain2 streamLen2) + , (SpaceO_1, benchIO "list monad drain3" $ listMonadDrain3 streamLen3) + , (SpaceO_1, benchIO "list monad filterAllIn2" $ listMonadFilterAllIn2 streamLen2) + , (SpaceO_1, benchIO "list monad filterAllOut2" $ listMonadFilterAllOut2 streamLen2) + + -- O(n) heap + , (HeapO_n, benchIO "foldlS" $ foldlS 1 streamLen) + + , (HeapO_n, benchIO "mergeMapWith interleave outer=Max inner=1" + $ mergeMapWith StreamK.interleave streamLen 1) + , (HeapO_n, benchIO "mergeMapWith interleave outer=inner=(sqrt Max)" + $ mergeMapWith StreamK.interleave streamLen2 streamLen2) + , (HeapO_n, benchIO "mergeMapWith interleave outer=1 inner=Max" + $ mergeMapWith StreamK.interleave 1 streamLen) + + , (HeapO_n, benchIO "mergeMapWithD D.interleave outer=inner=(sqrt Max)" + $ mergeMapWithD Stream.interleave streamLen2 streamLen2) + , (HeapO_n, benchIO "mergeMapWithD D.roundRobin outer=inner=(sqrt Max)" + $ mergeMapWithD Stream.roundRobin streamLen2 streamLen2) + + , (HeapO_n, benchIO "mergeMapWith (mergeBy compare) outer=Max inner=1" + $ mergeMapWith (StreamK.mergeBy compare) streamLen 1) + , (HeapO_n, benchIO "mergeMapWith (mergeBy compare) outer=inner=(sqrt Max)" + $ mergeMapWith (StreamK.mergeBy compare) streamLen2 streamLen2) + , (HeapO_n, benchIO "mergeMapWith (mergeBy compare) outer=1 inner=Max" + $ mergeMapWith (StreamK.mergeBy compare) 1 streamLen) + + , (HeapO_n, benchIO "mergeMapWith (mergeBy (flip compare)) outer=Max inner=1" + $ mergeMapWith (StreamK.mergeBy (flip compare)) streamLen 1) + , (HeapO_n, benchIO "mergeMapWith (mergeBy (flip compare)) outer=inner=(sqrt Max)" + $ mergeMapWith (StreamK.mergeBy (flip compare)) streamLen2 streamLen2) + , (HeapO_n, benchIO "mergeMapWith (mergeBy (flip compare)) outer=1 inner=Max" + $ mergeMapWith (StreamK.mergeBy (flip compare)) 1 streamLen) {- -- This fails with stack overflow. - benchIO "concatMapWithZip (n of 1)" - (concatMapWithZip value 1) + (HeapO_n, benchIO "concatMapWithZip (n of 1)" + (concatMapWithZip value 1)) -- Not correct because of nil stream at end issue. - , benchIO "concatMapWithZip (sqrtVal of sqrtVal)" - (concatMapWithZip sqrtVal sqrtVal) + , (HeapO_n, benchIO "concatMapWithZip (sqrtVal of sqrtVal)" + (concatMapWithZip sqrtVal sqrtVal)) -} - , benchIO "mergeMapWith (zipWith (+)) outer=Max inner=1" - $ mergeMapWith (StreamK.zipWith (+)) streamLen 1 - , benchIO "mergeMapWith (zipWith (+)) outer=inner=(sqrt Max)" - $ mergeMapWith (StreamK.zipWith (+)) streamLen2 streamLen2 - ] - - where - - streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop - -{- HLINT ignore "Use sort" -} -o_n_heap_sorting :: Int -> [Benchmark] -o_n_heap_sorting streamLen = - [ benchIO "sortBy compare" $ sortBy compare streamLen - , benchIO "sortBy (flip compare)" $ sortBy (flip compare) streamLen - , benchIO "sortBy compare randomized" $ sortByCompareRandomized streamLen - , bench "List.sortBy compare" - $ nf (\x -> List.sortBy compare [1..x]) streamLen - , bench "List.sortBy (flip compare)" - $ nf (\x -> List.sortBy (flip compare) [1..x]) streamLen - , bench "sortByLists compare randomized" - $ nf (\x -> List.sortBy compare - (List.map (\n -> if even n then n + 2 else n) [1..x]) - ) - streamLen - ] - -o_1_space_filtering :: Int -> [Benchmark] -o_1_space_filtering streamLen = - [ benchIO "filter-even" $ filterEven 1 streamLen - , benchIO "filter-all-out" $ filterAllOut 1 streamLen - , benchIO "filter-all-in" $ filterAllIn 1 streamLen - , benchIO "take-all" $ takeAll 1 streamLen - , benchIO "takeWhile-true" $ takeWhileTrue 1 streamLen - , benchIO "drop-one" $ dropOne 1 streamLen - , benchIO "drop-all" $ dropAll 1 streamLen - , benchIO "dropWhile-true" $ dropWhileTrue 1 streamLen - , benchIO "dropWhile-false" $ dropWhileFalse 1 streamLen - ] - -o_1_space_filteringX4 :: Int -> [Benchmark] -o_1_space_filteringX4 streamLen = - [ benchIO "filter-evenX4" $ filterEven 4 streamLen - , benchIO "filter-all-outX4" $ filterAllOut 4 streamLen - , benchIO "filter-all-inX4" $ filterAllIn 4 streamLen - , benchIO "take-allX4" $ takeAll 4 streamLen - , benchIO "takeWhile-trueX4" $ takeWhileTrue 4 streamLen - , benchIO "drop-oneX4" $ dropOne 4 streamLen - , benchIO "drop-allX4" $ dropAll 4 streamLen - , benchIO "dropWhile-trueX4" $ dropWhileTrue 4 streamLen - , benchIO "dropWhile-falseX4" $ dropWhileFalse 4 streamLen - ] - -o_1_space_mixed :: Int -> [Benchmark] -o_1_space_mixed streamLen = - [ benchIO "scan-map" $ scanMap 1 streamLen - , benchIO "drop-map" $ dropMap 1 streamLen - , benchIO "drop-scan" $ dropScan 1 streamLen - , benchIO "take-drop" $ takeDrop 1 streamLen - , benchIO "take-scan" $ takeScan 1 streamLen - , benchIO "take-map" $ takeMap 1 streamLen - , benchIO "filter-drop" $ filterDrop 1 streamLen - , benchIO "filter-take" $ filterTake 1 streamLen - , benchIO "filter-scan" $ filterScan 1 streamLen - , benchIO "filter-map" $ filterMap 1 streamLen - ] - -o_1_space_mixedX2 :: Int -> [Benchmark] -o_1_space_mixedX2 streamLen = - [ benchIO "scan-mapX2" $ scanMap 2 streamLen - , benchIO "drop-mapX2" $ dropMap 2 streamLen - , benchIO "drop-scanX2" $ dropScan 2 streamLen - , benchIO "take-dropX2" $ takeDrop 2 streamLen - , benchIO "take-scanX2" $ takeScan 2 streamLen - , benchIO "take-mapX2" $ takeMap 2 streamLen - , benchIO "filter-dropX2" $ filterDrop 2 streamLen - , benchIO "filter-takeX2" $ filterTake 2 streamLen - , benchIO "filter-scanX2" $ filterScan 2 streamLen - , benchIO "filter-mapX2" $ filterMap 2 streamLen - ] - -o_1_space_mixedX4 :: Int -> [Benchmark] -o_1_space_mixedX4 streamLen = - [ benchIO "scan-mapX4" $ scanMap 4 streamLen - , benchIO "drop-mapX4" $ dropMap 4 streamLen - , benchIO "drop-scanX4" $ dropScan 4 streamLen - , benchIO "take-dropX4" $ takeDrop 4 streamLen - , benchIO "take-scanX4" $ takeScan 4 streamLen - , benchIO "take-mapX4" $ takeMap 4 streamLen - , benchIO "filter-dropX4" $ filterDrop 4 streamLen - , benchIO "filter-takeX4" $ filterTake 4 streamLen - , benchIO "filter-scanX4" $ filterScan 4 streamLen - , benchIO "filter-mapX4" $ filterMap 4 streamLen - ] - -o_1_space_list :: Int -> [Benchmark] -o_1_space_list streamLen = - [ benchIO "list last" $ lastList streamLen - , benchIO "list ap drain2" $ listApDrain2 streamLen2 - , benchIO "list monad drain2" $ listMonadDrain2 streamLen2 - , benchIO "list monad drain3" $ listMonadDrain3 streamLen3 - , benchIO "list monad filterAllIn2" $ listMonadFilterAllIn2 streamLen2 - , benchIO "list monad filterAllOut2" $ listMonadFilterAllOut2 streamLen2 - ] - where - - streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop - streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop - -o_n_heap_transformation :: Int -> [Benchmark] -o_n_heap_transformation streamLen = - [ benchIO "foldlS" $ foldlS 1 streamLen - ] - -o_n_stack_transformation :: Int -> [Benchmark] -o_n_stack_transformation streamLen = - -- XXX why do these need so much stack - [ benchIO "intersperse" $ intersperse streamLen 1 streamLen2 - , benchIO "interspersePure" $ interspersePure streamLen 1 streamLen2 - ] - where - streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) - -o_n_stack_transformationX4 :: Int -> [Benchmark] -o_n_stack_transformationX4 streamLen = - [ benchIO "intersperseX4" $ intersperse streamLen 4 streamLen16 - ] - where - streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) - -o_n_stack_iterated :: Int -> Int -> Int -> [Benchmark] -o_n_stack_iterated streamLen iterStreamLen maxIters = - [ benchIO "iterated mapM" $ iterateMapM iterStreamLen maxIters - , benchIO "iterated scan(1/10)" $ iterateScan iterStreamLen maxIters - , benchIO "iterated filterEven" $ iterateFilterEven iterStreamLen maxIters - , benchIO "iterated takeAll" $ iterateTakeAll streamLen iterStreamLen maxIters - , benchIO "iterated dropOne" $ iterateDropOne iterStreamLen maxIters - , benchIO "iterated dropWhileFalse(1/10)" $ iterateDropWhileFalse streamLen iterStreamLen maxIters - , benchIO "iterated dropWhileTrue" $ iterateDropWhileTrue streamLen iterStreamLen maxIters - ] - -benchmarks :: Int -> Int -> Int -> [(SpaceComplexity, Benchmark)] -benchmarks streamLen iterStreamLen maxIters = - -- O(1) space - fmap (SpaceO_1,) (concat - [ o_1_space_generation streamLen - , o_1_space_elimination streamLen - , o_1_space_ap streamLen - , o_1_space_monad streamLen - , o_1_space_bind streamLen - , o_1_space_transformation streamLen - , o_1_space_transformationX4 streamLen - , o_1_space_concat streamLen - , o_1_space_filtering streamLen - , o_1_space_filteringX4 streamLen - , o_1_space_joining streamLen - , o_1_space_mixed streamLen - , o_1_space_mixedX2 streamLen - , o_1_space_mixedX4 streamLen - , o_1_space_list streamLen - ]) - -- O(n) heap - ++ fmap (HeapO_n,) (concat - [ o_n_heap_transformation streamLen - , o_n_heap_concat streamLen - , o_n_heap_sorting streamLen - ]) - -- O(n) stack - ++ fmap (StackO_n,) - ( [ benchIO "tail" $ tail streamLen - , benchIO "nullTail" $ nullTail streamLen - , benchIO "headTail" $ headTail streamLen - ] - ++ o_n_stack_transformation streamLen - ++ o_n_stack_transformationX4 streamLen - ++ o_n_stack_iterated streamLen iterStreamLen maxIters - ) - -- O(n) space - ++ fmap (SpaceO_n,) - ( [ benchIO "toList" $ toList streamLen ] - ++ o_n_space_concat streamLen - ) + , (HeapO_n, benchIO "mergeMapWith (zipWith (+)) outer=Max inner=1" + $ mergeMapWith (StreamK.zipWith (+)) streamLen 1) + , (HeapO_n, benchIO "mergeMapWith (zipWith (+)) outer=inner=(sqrt Max)" + $ mergeMapWith (StreamK.zipWith (+)) streamLen2 streamLen2) + + {- HLINT ignore "Use sort" -} + , (HeapO_n, benchIO "sortBy compare" $ sortBy compare streamLen) + , (HeapO_n, benchIO "sortBy (flip compare)" $ sortBy (flip compare) streamLen) + , (HeapO_n, benchIO "sortBy compare randomized" $ sortByCompareRandomized streamLen) + , (HeapO_n, bench "List.sortBy compare" + $ nf (\x -> List.sortBy compare [1..x]) streamLen) + , (HeapO_n, bench "List.sortBy (flip compare)" + $ nf (\x -> List.sortBy (flip compare) [1..x]) streamLen) + , (HeapO_n, bench "sortByLists compare randomized" + $ nf (\x -> List.sortBy compare + (List.map (\n -> if even n then n + 2 else n) [1..x]) + ) + streamLen) + + -- O(n) stack + , (StackO_n, benchIO "tail" $ tail streamLen) + , (StackO_n, benchIO "nullTail" $ nullTail streamLen) + , (StackO_n, benchIO "headTail" $ headTail streamLen) + + -- XXX why do these need so much stack + , (StackO_n, benchIO "intersperse" $ intersperse streamLen 1 streamLen2) + , (StackO_n, benchIO "interspersePure" $ interspersePure streamLen 1 streamLen2) + + , (StackO_n, benchIO "intersperseX4" $ intersperse streamLen 4 streamLen16) + + , (StackO_n, benchIO "iterated mapM" $ iterateMapM iterStreamLen maxIters) + , (StackO_n, benchIO "iterated scan(1/10)" $ iterateScan iterStreamLen maxIters) + , (StackO_n, benchIO "iterated filterEven" $ iterateFilterEven iterStreamLen maxIters) + , (StackO_n, benchIO "iterated takeAll" $ iterateTakeAll streamLen iterStreamLen maxIters) + , (StackO_n, benchIO "iterated dropOne" $ iterateDropOne iterStreamLen maxIters) + , (StackO_n, benchIO "iterated dropWhileFalse(1/10)" $ iterateDropWhileFalse streamLen iterStreamLen maxIters) + , (StackO_n, benchIO "iterated dropWhileTrue" $ iterateDropWhileTrue streamLen iterStreamLen maxIters) + + -- O(n) space + , (SpaceO_n, benchIO "toList" $ toList streamLen) + + -- concatMapWith using StreamD versions of interleave operations are + -- all quadratic, we just measure the sqrtVal benchmark for comparison. + , (SpaceO_n, benchIO "concatMapWithD D.interleave outer=inner=(sqrt Max)" + $ concatMapWithD Stream.interleave streamLen2 streamLen2) + , (SpaceO_n, benchIO "concatMapWithD D.roundRobin outer=inner=(sqrt Max)" + $ concatMapWithD Stream.roundRobin streamLen2 streamLen2) + ] main :: IO () main = do From 8a84a3d3d39efdfa8df7ff72da840e56b059a9fc Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sun, 14 Jun 2026 06:35:42 +0530 Subject: [PATCH 08/20] Move Unfold exception benchmarks from Stream to Unfold --- .../Benchmark/Data/Stream/Exceptions.hs | 42 +------------------ .../Data/Stream/Prelude/Exceptions.hs | 18 -------- benchmark/Streamly/Benchmark/Data/Unfold.hs | 37 ++++++++++++++++ .../Benchmark/Data/Unfold/Prelude1.hs | 15 ++++++- 4 files changed, 52 insertions(+), 60 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs b/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs index 767ccff181..635e18cbe8 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs @@ -27,7 +27,6 @@ import Control.Exception (SomeException) import System.IO (Handle, hClose) import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.Internal.FileSystem.Handle as IFH -import qualified Streamly.Internal.Data.Unfold as IUF import qualified Streamly.Internal.Data.Stream as Stream import Test.Tasty.Bench hiding (env) @@ -93,22 +92,6 @@ readWriteAfter_Stream inh devNull = in Stream.fold (FH.write devNull) readEx ------------------------------------------------------------------------------- --- Exceptions readChunks -------------------------------------------------------------------------------- - --- | Send the file contents to /dev/null with exception handling -readChunksOnException :: Handle -> Handle -> IO () -readChunksOnException inh devNull = - let readEx = IUF.onException (\_ -> hClose inh) FH.chunkReader - in IUF.fold (IFH.writeChunks devNull) readEx inh - --- | Send the file contents to /dev/null with exception handling -readChunksBracket_ :: Handle -> Handle -> IO () -readChunksBracket_ inh devNull = - let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.chunkReader - in IUF.fold (IFH.writeChunks devNull) readEx inh - -------------------------------------------------------------------------------- -- Exceptions toChunks ------------------------------------------------------------------------------- @@ -157,25 +140,6 @@ inspect $ 'readWriteAfter_Stream `hasNoType` ''Stream.Step inspect $ 'readWriteAfter_Stream `hasNoType` ''FL.Step inspect $ 'readWriteAfter_Stream `hasNoType` ''SPEC --- readChunks (unfold-based; exception path keeps Step constructors) -#if __GLASGOW_HASKELL__ >= 906 -inspect $ hasNoTypeClassesExcept 'readChunksOnException [''MonadCatch] -#else -inspect $ hasNoTypeClasses 'readChunksOnException -#endif --- inspect $ 'readChunksOnException `hasNoType` ''Stream.Step -inspect $ 'readChunksOnException `hasNoType` ''FL.Step -inspect $ 'readChunksOnException `hasNoType` ''SPEC - -#if __GLASGOW_HASKELL__ >= 906 -inspect $ hasNoTypeClassesExcept 'readChunksBracket_ [''MonadCatch] -#else -inspect $ hasNoTypeClasses 'readChunksBracket_ -#endif --- inspect $ 'readChunksBracket_ `hasNoType` ''Stream.Step -inspect $ 'readChunksBracket_ `hasNoType` ''FL.Step -inspect $ 'readChunksBracket_ `hasNoType` ''SPEC - -- toChunks (bracketUnsafe wraps readChunks; Step constructors survive) inspect $ hasNoTypeClasses 'toChunksBracket_ -- inspect $ 'toChunksBracket_ `hasNoType` ''Stream.Step @@ -185,11 +149,7 @@ inspect $ 'toChunksBracket_ `hasNoType` ''SPEC benchmarks :: BenchEnv -> Int -> [(SpaceComplexity, Benchmark)] benchmarks _env _size = - [ (SpaceO_1, mkBench "UF.onException" _env $ \inH _ -> - readChunksOnException inH (nullH _env)) - , (SpaceO_1, mkBench "UF.bracket_" _env $ \inH _ -> - readChunksBracket_ inH (nullH _env)) - , (SpaceO_1, mkBench "Stream.bracket_ (toChunks)" _env $ \inH _ -> + [ (SpaceO_1, mkBench "Stream.bracket_ (toChunks)" _env $ \inH _ -> toChunksBracket_ inH (nullH _env)) , (SpaceO_1, mkBenchSmall "Stream.onException" _env $ \inh _ -> readWriteOnExceptionStream inh (nullH _env)) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Prelude/Exceptions.hs b/benchmark/Streamly/Benchmark/Data/Stream/Prelude/Exceptions.hs index 2601a7d1a8..2b199205cc 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Prelude/Exceptions.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Prelude/Exceptions.hs @@ -38,8 +38,6 @@ import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.Internal.FileSystem.Handle as IFH import qualified Streamly.Internal.Data.Stream as Stream import qualified Streamly.Internal.Data.Stream.Prelude as Stream -import qualified Streamly.Internal.Data.Unfold as IUF -import qualified Streamly.Internal.Data.Unfold.Prelude as IUF import Test.Tasty.Bench hiding (env) import Prelude hiding (last, length) @@ -174,21 +172,6 @@ o_1_space_copy_stream_exceptions env = fromToBytesBracketStream inh (nullH env) ] - ------------------------------------------------------------------------------- --- Exceptions readChunks -------------------------------------------------------------------------------- - -readChunksBracket :: Handle -> Handle -> IO () -readChunksBracket inh devNull = - let readEx = IUF.bracket return (\_ -> hClose inh) FH.chunkReader - in IUF.fold (IFH.writeChunks devNull) readEx inh - -o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark] -o_1_space_copy_exceptions_readChunks env = - [ mkBench "UF.bracket" env $ \inH _ -> - readChunksBracket inH (nullH env) - ] - ------------------------------------------------------------------------------- -- Exceptions toChunks ------------------------------------------------------------------------------- @@ -211,7 +194,6 @@ excBenchmarks :: BenchEnv -> Int -> [Benchmark] excBenchmarks env size = [ bgroup (o_1_space_prefix moduleName) $ concat [ o_1_space_serial_exceptions size - , o_1_space_copy_exceptions_readChunks env , o_1_space_copy_exceptions_toChunks env , o_1_space_copy_stream_exceptions env ] diff --git a/benchmark/Streamly/Benchmark/Data/Unfold.hs b/benchmark/Streamly/Benchmark/Data/Unfold.hs index 48a859ac9a..5ec12f3c64 100644 --- a/benchmark/Streamly/Benchmark/Data/Unfold.hs +++ b/benchmark/Streamly/Benchmark/Data/Unfold.hs @@ -34,6 +34,7 @@ import System.Random (randomRIO) import qualified Prelude import qualified Streamly.FileSystem.Handle as FH +import qualified Streamly.Internal.FileSystem.Handle as IFH import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Scanl as Scanl import qualified Streamly.Internal.Data.Unfold as UF @@ -615,6 +616,38 @@ moduleName = "Data.Unfold" ------------------------------------------------------------------------------- -- Unfold Exception Benchmarks ------------------------------------------------------------------------------- +-- | Send the file contents to /dev/null with exception handling +readChunksOnException :: Handle -> Handle -> IO () +readChunksOnException inh devNull = + let readEx = UF.onException (\_ -> hClose inh) FH.chunkReader + in UF.fold (IFH.writeChunks devNull) readEx inh + +-- | Send the file contents to /dev/null with exception handling +readChunksBracket_ :: Handle -> Handle -> IO () +readChunksBracket_ inh devNull = + let readEx = UF.bracket_ return (\_ -> hClose inh) FH.chunkReader + in UF.fold (IFH.writeChunks devNull) readEx inh + +#ifdef INSPECTION +#if __GLASGOW_HASKELL__ >= 906 +inspect $ hasNoTypeClassesExcept 'readChunksOnException [''MonadCatch] +#else +inspect $ hasNoTypeClasses 'readChunksOnException +#endif +-- inspect $ 'readChunksOnException `hasNoType` ''S.Step +inspect $ 'readChunksOnException `hasNoType` ''FL.Step +inspect $ 'readChunksOnException `hasNoType` ''SPEC + +#if __GLASGOW_HASKELL__ >= 906 +inspect $ hasNoTypeClassesExcept 'readChunksBracket_ [''MonadCatch] +#else +inspect $ hasNoTypeClasses 'readChunksBracket_ +#endif +-- inspect $ 'readChunksBracket_ `hasNoType` ''S.Step +inspect $ 'readChunksBracket_ `hasNoType` ''FL.Step +inspect $ 'readChunksBracket_ `hasNoType` ''SPEC +#endif + -- | Send the file contents to /dev/null with exception handling readWriteOnExceptionUnfold :: Handle -> Handle -> IO () readWriteOnExceptionUnfold inh devNull = @@ -729,6 +762,10 @@ benchmarks env size = -- Exceptions , (SpaceO_1, mkBenchSmall "UF.onException" env $ \inh _ -> readWriteOnExceptionUnfold inh (nullH env)) + , (SpaceO_1, mkBench "UF.onException (chunk)" env $ \inh _ -> + readChunksOnException inh (nullH env)) + , (SpaceO_1, mkBench "UF.bracket_ (chunk)" env $ \inh _ -> + readChunksBracket_ inh (nullH env)) , (SpaceO_1, mkBenchSmall "UF.handle" env $ \inh _ -> readWriteHandleExceptionUnfold inh (nullH env)) ] diff --git a/benchmark/Streamly/Benchmark/Data/Unfold/Prelude1.hs b/benchmark/Streamly/Benchmark/Data/Unfold/Prelude1.hs index 20981dd993..7353ff9d8c 100644 --- a/benchmark/Streamly/Benchmark/Data/Unfold/Prelude1.hs +++ b/benchmark/Streamly/Benchmark/Data/Unfold/Prelude1.hs @@ -13,6 +13,7 @@ import System.IO (Handle, hClose) import qualified Streamly.Internal.Data.Stream as S import qualified Streamly.Internal.Data.Unfold.Prelude as UF import qualified Streamly.FileSystem.Handle as FH +import qualified Streamly.Internal.FileSystem.Handle as IFH import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common @@ -28,6 +29,17 @@ readWriteBracketUnfold inh devNull = let readEx = UF.bracket return (\_ -> hClose inh) FH.reader in S.fold (FH.write devNull) $ S.unfold readEx inh +readChunksBracket :: Handle -> Handle -> IO () +readChunksBracket inh devNull = + let readEx = UF.bracket return (\_ -> hClose inh) FH.chunkReader + in S.fold (IFH.writeChunks devNull) $ S.unfold readEx inh + +o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark] +o_1_space_copy_exceptions_readChunks env = + [ mkBench "UF.bracket (chunk)" env $ \inH _ -> + readChunksBracket inH (nullH env) + ] + o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark] o_1_space_copy_read_exceptions env = [ mkBenchSmall "UF.finally" env $ \inh _ -> @@ -48,5 +60,6 @@ main = do allBenchmarks env _size = [ bgroup (o_1_space_prefix moduleName) - $ o_1_space_copy_read_exceptions env + $ o_1_space_copy_read_exceptions env + ++ o_1_space_copy_exceptions_readChunks env ] From 6c282f670c8d26e563507f9882b9002489fab79e Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sun, 14 Jun 2026 06:56:34 +0530 Subject: [PATCH 09/20] Move the pipe benchmarks to Data.Pipe bench-suite --- benchmark/Streamly/Benchmark/Data/Pipe.hs | 204 ++++++++++++++++++ .../Data/Stream/Transform/Composed.hs | 104 --------- benchmark/streamly-benchmarks.cabal | 6 + 3 files changed, 210 insertions(+), 104 deletions(-) create mode 100644 benchmark/Streamly/Benchmark/Data/Pipe.hs diff --git a/benchmark/Streamly/Benchmark/Data/Pipe.hs b/benchmark/Streamly/Benchmark/Data/Pipe.hs new file mode 100644 index 0000000000..c8dbd135e9 --- /dev/null +++ b/benchmark/Streamly/Benchmark/Data/Pipe.hs @@ -0,0 +1,204 @@ +-- | +-- Module : Streamly.Benchmark.Data.Pipe +-- Copyright : (c) 2018 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com + +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} + +#undef FUSION_CHECK +#ifdef FUSION_CHECK +{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-} +#endif + +#ifdef __HADDOCK_VERSION__ +#undef INSPECTION +#endif + +#ifdef INSPECTION +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} +#endif + +module Main (main) where + +import Control.DeepSeq (NFData) +import System.Random (randomRIO) +import Streamly.Internal.Data.Stream (Stream) + +import qualified Streamly.Internal.Data.Fold as FL +import qualified Streamly.Internal.Data.Pipe as Pipe +import qualified Streamly.Internal.Data.Stream as Stream + +import Test.Tasty.Bench +import Streamly.Benchmark.Common + +#ifdef INSPECTION +import GHC.Types (SPEC(..)) +import Test.Inspection +import qualified Streamly.Internal.Data.Stream as S +#endif + +------------------------------------------------------------------------------- +-- Helpers +------------------------------------------------------------------------------- + +{-# INLINE sourceUnfoldrM #-} +sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int +sourceUnfoldrM value n = Stream.unfoldrM step n + where + step cnt = + if cnt > n + value + then return Nothing + else return (Just (cnt, cnt + 1)) + +{-# INLINE withStream #-} +withStream :: Int -> (Stream IO Int -> IO b) -> IO b +withStream value f = randomRIO (1, 1 :: Int) >>= f . sourceUnfoldrM value + +{-# INLINE benchIO #-} +benchIO :: NFData b => String -> IO b -> Benchmark +benchIO name = bench name . nfIO + +{-# INLINE composeN #-} +composeN :: + Monad m + => Int + -> (Stream m Int -> Stream m Int) + -> Stream m Int + -> m () +composeN n f = + case n of + 1 -> Stream.fold FL.drain . f + 2 -> Stream.fold FL.drain . f . f + 3 -> Stream.fold FL.drain . f . f . f + 4 -> Stream.fold FL.drain . f . f . f . f + _ -> undefined + +------------------------------------------------------------------------------- +-- Pipe benchmarks +------------------------------------------------------------------------------- + +{-# INLINE transformMapM #-} +transformMapM :: Monad m => Int -> Stream m Int -> m () +transformMapM n = composeN n $ Stream.pipe (Pipe.mapM return) + +{-# INLINE transformComposeMapM #-} +transformComposeMapM :: Monad m => Int -> Stream m Int -> m () +transformComposeMapM n = + composeN n $ + Stream.pipe + (Pipe.mapM (\x -> return (x + 1)) `Pipe.compose` + Pipe.mapM (\x -> return (x + 2))) + +{-# INLINE transformTeeMapM #-} +transformTeeMapM :: Monad m => Int -> Stream m Int -> m () +transformTeeMapM n = + composeN n $ + Stream.pipe + (Pipe.mapM (\x -> return (x + 1)) `Pipe.teeMerge` + Pipe.mapM (\x -> return (x + 2))) + +pipeMapM :: Int -> IO () +pipeMapM value = withStream value (transformMapM 1) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'pipeMapM +inspect $ 'pipeMapM `hasNoType` ''S.Step +inspect $ 'pipeMapM `hasNoType` ''S.PipeState +inspect $ 'pipeMapM `hasNoType` ''FL.Step +inspect $ 'pipeMapM `hasNoType` ''SPEC +#endif + +pipeCompose :: Int -> IO () +pipeCompose value = withStream value (transformComposeMapM 1) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'pipeCompose +inspect $ 'pipeCompose `hasNoType` ''S.Step +inspect $ 'pipeCompose `hasNoType` ''S.PipeState +inspect $ 'pipeCompose `hasNoType` ''FL.Step +inspect $ 'pipeCompose `hasNoType` ''SPEC +#endif + +pipeTee :: Int -> IO () +pipeTee value = withStream value (transformTeeMapM 1) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'pipeTee +inspect $ 'pipeTee `hasNoType` ''S.Step +inspect $ 'pipeTee `hasNoType` ''S.PipeState +inspect $ 'pipeTee `hasNoType` ''FL.Step +inspect $ 'pipeTee `hasNoType` ''SPEC +#endif + +-- XXX this takes 1 GB memory to compile +-- pipeZip :: Int -> IO () + +pipeMapMX4 :: Int -> IO () +pipeMapMX4 value = withStream value (transformMapM 4) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'pipeMapMX4 +inspect $ 'pipeMapMX4 `hasNoType` ''S.Step +inspect $ 'pipeMapMX4 `hasNoType` ''S.PipeState +inspect $ 'pipeMapMX4 `hasNoType` ''FL.Step +inspect $ 'pipeMapMX4 `hasNoType` ''SPEC +#endif + +pipeComposeX4 :: Int -> IO () +pipeComposeX4 value = withStream value (transformComposeMapM 4) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'pipeComposeX4 +inspect $ 'pipeComposeX4 `hasNoType` ''S.Step +inspect $ 'pipeComposeX4 `hasNoType` ''S.PipeState +inspect $ 'pipeComposeX4 `hasNoType` ''FL.Step +inspect $ 'pipeComposeX4 `hasNoType` ''SPEC +#endif + +-- XXX requires @-fspec-constr-recursive=16@. +pipeTeeX4 :: Int -> IO () +pipeTeeX4 value = withStream value (transformTeeMapM 4) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'pipeTeeX4 +inspect $ 'pipeTeeX4 `hasNoType` ''S.Step +inspect $ 'pipeTeeX4 `hasNoType` ''S.PipeState +inspect $ 'pipeTeeX4 `hasNoType` ''FL.Step +inspect $ 'pipeTeeX4 `hasNoType` ''SPEC +#endif + +-- XXX this takes 1 GB memory to compile +-- pipeZipX4 :: Int -> IO () + +------------------------------------------------------------------------------- +-- Driver +------------------------------------------------------------------------------- + +moduleName :: String +moduleName = "Data.Pipe" + +o_1_space :: Int -> [(SpaceComplexity, Benchmark)] +o_1_space value = + [ (SpaceO_1, benchIO "mapM" $ pipeMapM value) + , (SpaceO_1, benchIO "compose" $ pipeCompose value) + , (SpaceO_1, benchIO "tee" $ pipeTee value) + , (SpaceO_1, benchIO "mapM x 4" $ pipeMapMX4 value) + , (SpaceO_1, benchIO "compose x 4" $ pipeComposeX4 value) + , (SpaceO_1, benchIO "tee x 4" $ pipeTeeX4 value) + ] + +main :: IO () +main = runWithCLIOpts defaultStreamSize allBenchmarks + + where + + allBenchmarks value = + let allBenches = o_1_space value + get x = map snd $ filter ((==) x . fst) allBenches + in + [ bgroup (o_1_space_prefix moduleName) (get SpaceO_1) + ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs index 5e1a6b61ae..d6c736ccae 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs @@ -34,7 +34,6 @@ import Streamly.Internal.Data.Stream (Stream) import qualified Stream.Common as Common import qualified Streamly.Internal.Data.Fold as FL -import qualified Streamly.Internal.Data.Pipe as Pipe import qualified Streamly.Internal.Data.Scanl as Scanl import qualified Streamly.Internal.Data.Scan as Scan import qualified Streamly.Internal.Data.Stream as S @@ -529,30 +528,6 @@ iterateDropWhileFalse value iterCount = withRandomIntIO $ Common.drain . iterateSource (S.dropWhile (> (value + 1))) (value `div` iterCount) iterCount -------------------------------------------------------------------------------- --- Pipes -------------------------------------------------------------------------------- - -{-# INLINE transformMapM #-} -transformMapM :: Monad m => Int -> Stream m Int -> m () -transformMapM n = composeN n $ Stream.pipe (Pipe.mapM return) - -{-# INLINE transformComposeMapM #-} -transformComposeMapM :: Monad m => Int -> Stream m Int -> m () -transformComposeMapM n = - composeN n $ - Stream.pipe - (Pipe.mapM (\x -> return (x + 1)) `Pipe.compose` - Pipe.mapM (\x -> return (x + 2))) - -{-# INLINE transformTeeMapM #-} -transformTeeMapM :: Monad m => Int -> Stream m Int -> m () -transformTeeMapM n = - composeN n $ - Stream.pipe - (Pipe.mapM (\x -> return (x + 1)) `Pipe.teeMerge` - Pipe.mapM (\x -> return (x + 2))) - {-# INLINE scanMapM #-} scanMapM :: Monad m => Int -> Stream m Int -> m () scanMapM n = composeN n $ Stream.scanr (Scan.functionM return) @@ -573,72 +548,6 @@ scanTeeMapM n = (Scan.teeWith (+) (Scan.functionM (\x -> return (x + 1))) (Scan.functionM (\x -> return (x + 2)))) -pipeMapM :: Int -> IO () -pipeMapM value = withStream value (transformMapM 1) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'pipeMapM -inspect $ 'pipeMapM `hasNoType` ''S.Step -inspect $ 'pipeMapM `hasNoType` ''S.PipeState -inspect $ 'pipeMapM `hasNoType` ''FL.Step -inspect $ 'pipeMapM `hasNoType` ''SPEC -#endif - -pipeCompose :: Int -> IO () -pipeCompose value = withStream value (transformComposeMapM 1) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'pipeCompose -inspect $ 'pipeCompose `hasNoType` ''S.Step -inspect $ 'pipeCompose `hasNoType` ''S.PipeState -inspect $ 'pipeCompose `hasNoType` ''FL.Step -inspect $ 'pipeCompose `hasNoType` ''SPEC -#endif - -pipeTee :: Int -> IO () -pipeTee value = withStream value (transformTeeMapM 1) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'pipeTee -inspect $ 'pipeTee `hasNoType` ''S.Step -inspect $ 'pipeTee `hasNoType` ''S.PipeState -inspect $ 'pipeTee `hasNoType` ''FL.Step -inspect $ 'pipeTee `hasNoType` ''SPEC -#endif - -pipeMapMX4 :: Int -> IO () -pipeMapMX4 value = withStream value (transformMapM 4) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'pipeMapMX4 -inspect $ 'pipeMapMX4 `hasNoType` ''S.Step -inspect $ 'pipeMapMX4 `hasNoType` ''S.PipeState -inspect $ 'pipeMapMX4 `hasNoType` ''FL.Step -inspect $ 'pipeMapMX4 `hasNoType` ''SPEC -#endif - -pipeComposeX4 :: Int -> IO () -pipeComposeX4 value = withStream value (transformComposeMapM 4) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'pipeComposeX4 -inspect $ 'pipeComposeX4 `hasNoType` ''S.Step -inspect $ 'pipeComposeX4 `hasNoType` ''S.PipeState -inspect $ 'pipeComposeX4 `hasNoType` ''FL.Step -inspect $ 'pipeComposeX4 `hasNoType` ''SPEC -#endif - -pipeTeeX4 :: Int -> IO () -pipeTeeX4 value = withStream value (transformTeeMapM 4) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'pipeTeeX4 -inspect $ 'pipeTeeX4 `hasNoType` ''S.Step -inspect $ 'pipeTeeX4 `hasNoType` ''S.PipeState -inspect $ 'pipeTeeX4 `hasNoType` ''FL.Step -inspect $ 'pipeTeeX4 `hasNoType` ''SPEC -#endif - ------------------------------------------------------------------------------- -- Scans ------------------------------------------------------------------------------- @@ -777,19 +686,6 @@ benchmarks size = , (SpaceO_1, benchIO "filter-scanl1 x 4" $ filterScanl14 size) , (SpaceO_1, benchIO "filter-map x 4" $ filterMap4 size) - -- pipes - -- XXX these should move to Data.Pipe benchmarks - , (SpaceO_1, benchIO "pipe/mapM" $ pipeMapM size) - , (SpaceO_1, benchIO "pipe/compose" $ pipeCompose size) - , (SpaceO_1, benchIO "pipe/tee" $ pipeTee size) - -- XXX this take 1 GB memory to compile - -- , (SpaceO_1, benchIO "zip" $ pipeZip size) - , (SpaceO_1, benchIO "pipe/mapM x 4" $ pipeMapMX4 size) - , (SpaceO_1, benchIO "pipe/compose x 4" $ pipeComposeX4 size) - -- XXX requires @-fspec-constr-recursive=16@. - , (SpaceO_1, benchIO "pipe/tee x 4" $ pipeTeeX4 size) - -- XXX this take 1 GB memory to compile - -- , (SpaceO_1, benchIO "zip x 4" $ pipeZipX4 size) -- XXX These should move to the Data.Scan module -- scans , (SpaceO_1, benchIO "scan/mapM" $ scansMapM size) diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index 7fe4946df0..6f6ba46fb0 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -377,6 +377,12 @@ benchmark Data.ParserK.Chunked.Generic buildable: True build-depends: exceptions >= 0.8 && < 0.11 +benchmark Data.Pipe + import: bench-options + type: exitcode-stdio-1.0 + hs-source-dirs: Streamly/Benchmark/Data + main-is: Pipe.hs + benchmark Data.RingArray import: bench-options type: exitcode-stdio-1.0 From 5c5cf7a6adf63b29d1b26e935fc4eddcac177583 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sun, 14 Jun 2026 07:00:59 +0530 Subject: [PATCH 10/20] Move the Scan benchmarks from Stream to Data.Scan bench --- benchmark/Streamly/Benchmark/Data/Scan.hs | 197 ++++++++++++++++++ .../Data/Stream/Transform/Composed.hs | 100 --------- benchmark/streamly-benchmarks.cabal | 6 + 3 files changed, 203 insertions(+), 100 deletions(-) create mode 100644 benchmark/Streamly/Benchmark/Data/Scan.hs diff --git a/benchmark/Streamly/Benchmark/Data/Scan.hs b/benchmark/Streamly/Benchmark/Data/Scan.hs new file mode 100644 index 0000000000..c37a407765 --- /dev/null +++ b/benchmark/Streamly/Benchmark/Data/Scan.hs @@ -0,0 +1,197 @@ +-- | +-- Module : Streamly.Benchmark.Data.Scan +-- Copyright : (c) 2018 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com + +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} + +#undef FUSION_CHECK +#ifdef FUSION_CHECK +{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-} +#endif + +#ifdef __HADDOCK_VERSION__ +#undef INSPECTION +#endif + +#ifdef INSPECTION +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} +#endif + +module Main (main) where + +import Control.DeepSeq (NFData) +import System.Random (randomRIO) +import Streamly.Internal.Data.Stream (Stream) + +import qualified Streamly.Internal.Data.Fold as FL +import qualified Streamly.Internal.Data.Scan as Scan +import qualified Streamly.Internal.Data.Stream as Stream + +import Test.Tasty.Bench +import Streamly.Benchmark.Common + +#ifdef INSPECTION +import GHC.Types (SPEC(..)) +import Test.Inspection +import qualified Streamly.Internal.Data.Stream as S +#endif + +------------------------------------------------------------------------------- +-- Helpers +------------------------------------------------------------------------------- + +{-# INLINE sourceUnfoldrM #-} +sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int +sourceUnfoldrM value n = Stream.unfoldrM step n + where + step cnt = + if cnt > n + value + then return Nothing + else return (Just (cnt, cnt + 1)) + +{-# INLINE withStream #-} +withStream :: Int -> (Stream IO Int -> IO b) -> IO b +withStream value f = randomRIO (1, 1 :: Int) >>= f . sourceUnfoldrM value + +{-# INLINE benchIO #-} +benchIO :: NFData b => String -> IO b -> Benchmark +benchIO name = bench name . nfIO + +{-# INLINE composeN #-} +composeN :: + Monad m + => Int + -> (Stream m Int -> Stream m Int) + -> Stream m Int + -> m () +composeN n f = + case n of + 1 -> Stream.fold FL.drain . f + 2 -> Stream.fold FL.drain . f . f + 3 -> Stream.fold FL.drain . f . f . f + 4 -> Stream.fold FL.drain . f . f . f . f + _ -> undefined + +------------------------------------------------------------------------------- +-- Scan benchmarks +------------------------------------------------------------------------------- + +{-# INLINE scanMapM #-} +scanMapM :: Monad m => Int -> Stream m Int -> m () +scanMapM n = composeN n $ Stream.scanr (Scan.functionM return) + +{-# INLINE scanComposeMapM #-} +scanComposeMapM :: Monad m => Int -> Stream m Int -> m () +scanComposeMapM n = + composeN n $ + Stream.scanr + (Scan.functionM (\x -> return (x + 1)) `Scan.compose` + Scan.functionM (\x -> return (x + 2))) + +{-# INLINE scanTeeMapM #-} +scanTeeMapM :: Monad m => Int -> Stream m Int -> m () +scanTeeMapM n = + composeN n $ + Stream.scanr + (Scan.teeWith (+) (Scan.functionM (\x -> return (x + 1))) + (Scan.functionM (\x -> return (x + 2)))) + +scansMapM :: Int -> IO () +scansMapM value = withStream value (scanMapM 1) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'scansMapM +inspect $ 'scansMapM `hasNoType` ''S.Step +inspect $ 'scansMapM `hasNoType` ''S.RunScanState +inspect $ 'scansMapM `hasNoType` ''FL.Step +inspect $ 'scansMapM `hasNoType` ''SPEC +#endif + +scansCompose :: Int -> IO () +scansCompose value = withStream value (scanComposeMapM 1) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'scansCompose +inspect $ 'scansCompose `hasNoType` ''S.Step +inspect $ 'scansCompose `hasNoType` ''S.RunScanState +inspect $ 'scansCompose `hasNoType` ''FL.Step +inspect $ 'scansCompose `hasNoType` ''SPEC +#endif + +scansTee :: Int -> IO () +scansTee value = withStream value (scanTeeMapM 1) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'scansTee +inspect $ 'scansTee `hasNoType` ''S.Step +inspect $ 'scansTee `hasNoType` ''S.RunScanState +inspect $ 'scansTee `hasNoType` ''FL.Step +inspect $ 'scansTee `hasNoType` ''SPEC +#endif + +scansMapMX4 :: Int -> IO () +scansMapMX4 value = withStream value (scanMapM 4) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'scansMapMX4 +inspect $ 'scansMapMX4 `hasNoType` ''S.Step +inspect $ 'scansMapMX4 `hasNoType` ''S.RunScanState +inspect $ 'scansMapMX4 `hasNoType` ''FL.Step +inspect $ 'scansMapMX4 `hasNoType` ''SPEC +#endif + +scansComposeX4 :: Int -> IO () +scansComposeX4 value = withStream value (scanComposeMapM 4) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'scansComposeX4 +inspect $ 'scansComposeX4 `hasNoType` ''S.Step +inspect $ 'scansComposeX4 `hasNoType` ''S.RunScanState +inspect $ 'scansComposeX4 `hasNoType` ''FL.Step +inspect $ 'scansComposeX4 `hasNoType` ''SPEC +#endif + +scansTeeX4 :: Int -> IO () +scansTeeX4 value = withStream value (scanTeeMapM 4) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'scansTeeX4 +inspect $ 'scansTeeX4 `hasNoType` ''S.Step +inspect $ 'scansTeeX4 `hasNoType` ''S.RunScanState +inspect $ 'scansTeeX4 `hasNoType` ''FL.Step +inspect $ 'scansTeeX4 `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Driver +------------------------------------------------------------------------------- + +moduleName :: String +moduleName = "Data.Scan" + +o_1_space :: Int -> [(SpaceComplexity, Benchmark)] +o_1_space value = + [ (SpaceO_1, benchIO "mapM" $ scansMapM value) + , (SpaceO_1, benchIO "compose" $ scansCompose value) + , (SpaceO_1, benchIO "tee" $ scansTee value) + , (SpaceO_1, benchIO "mapM x 4" $ scansMapMX4 value) + , (SpaceO_1, benchIO "compose x 4" $ scansComposeX4 value) + , (SpaceO_1, benchIO "tee x 4" $ scansTeeX4 value) + ] + +main :: IO () +main = runWithCLIOpts defaultStreamSize allBenchmarks + + where + + allBenchmarks value = + let allBenches = o_1_space value + get x = map snd $ filter ((==) x . fst) allBenches + in + [ bgroup (o_1_space_prefix moduleName) (get SpaceO_1) + ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs index d6c736ccae..6858323d21 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs @@ -35,7 +35,6 @@ import Streamly.Internal.Data.Stream (Stream) import qualified Stream.Common as Common import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Scanl as Scanl -import qualified Streamly.Internal.Data.Scan as Scan import qualified Streamly.Internal.Data.Stream as S import qualified Streamly.Internal.Data.Stream as Stream @@ -528,96 +527,6 @@ iterateDropWhileFalse value iterCount = withRandomIntIO $ Common.drain . iterateSource (S.dropWhile (> (value + 1))) (value `div` iterCount) iterCount -{-# INLINE scanMapM #-} -scanMapM :: Monad m => Int -> Stream m Int -> m () -scanMapM n = composeN n $ Stream.scanr (Scan.functionM return) - -{-# INLINE scanComposeMapM #-} -scanComposeMapM :: Monad m => Int -> Stream m Int -> m () -scanComposeMapM n = - composeN n $ - Stream.scanr - (Scan.functionM (\x -> return (x + 1)) `Scan.compose` - Scan.functionM (\x -> return (x + 2))) - -{-# INLINE scanTeeMapM #-} -scanTeeMapM :: Monad m => Int -> Stream m Int -> m () -scanTeeMapM n = - composeN n $ - Stream.scanr - (Scan.teeWith (+) (Scan.functionM (\x -> return (x + 1))) - (Scan.functionM (\x -> return (x + 2)))) - -------------------------------------------------------------------------------- --- Scans -------------------------------------------------------------------------------- - -scansMapM :: Int -> IO () -scansMapM value = withStream value (scanMapM 1) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'scansMapM -inspect $ 'scansMapM `hasNoType` ''S.Step -inspect $ 'scansMapM `hasNoType` ''S.RunScanState -inspect $ 'scansMapM `hasNoType` ''FL.Step -inspect $ 'scansMapM `hasNoType` ''SPEC -#endif - -scansCompose :: Int -> IO () -scansCompose value = withStream value (scanComposeMapM 1) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'scansCompose -inspect $ 'scansCompose `hasNoType` ''S.Step -inspect $ 'scansCompose `hasNoType` ''S.RunScanState -inspect $ 'scansCompose `hasNoType` ''FL.Step -inspect $ 'scansCompose `hasNoType` ''SPEC -#endif - -scansTee :: Int -> IO () -scansTee value = withStream value (scanTeeMapM 1) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'scansTee -inspect $ 'scansTee `hasNoType` ''S.Step -inspect $ 'scansTee `hasNoType` ''S.RunScanState -inspect $ 'scansTee `hasNoType` ''FL.Step -inspect $ 'scansTee `hasNoType` ''SPEC -#endif - -scansMapMX4 :: Int -> IO () -scansMapMX4 value = withStream value (scanMapM 4) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'scansMapMX4 -inspect $ 'scansMapMX4 `hasNoType` ''S.Step -inspect $ 'scansMapMX4 `hasNoType` ''S.RunScanState -inspect $ 'scansMapMX4 `hasNoType` ''FL.Step -inspect $ 'scansMapMX4 `hasNoType` ''SPEC -#endif - -scansComposeX4 :: Int -> IO () -scansComposeX4 value = withStream value (scanComposeMapM 4) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'scansComposeX4 -inspect $ 'scansComposeX4 `hasNoType` ''S.Step -inspect $ 'scansComposeX4 `hasNoType` ''S.RunScanState -inspect $ 'scansComposeX4 `hasNoType` ''FL.Step -inspect $ 'scansComposeX4 `hasNoType` ''SPEC -#endif - -scansTeeX4 :: Int -> IO () -scansTeeX4 value = withStream value (scanTeeMapM 4) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'scansTeeX4 -inspect $ 'scansTeeX4 `hasNoType` ''S.Step -inspect $ 'scansTeeX4 `hasNoType` ''S.RunScanState -inspect $ 'scansTeeX4 `hasNoType` ''FL.Step -inspect $ 'scansTeeX4 `hasNoType` ''SPEC -#endif - ------------------------------------------------------------------------------- -- Composed transformations (scan + mapMaybe) ------------------------------------------------------------------------------- @@ -686,15 +595,6 @@ benchmarks size = , (SpaceO_1, benchIO "filter-scanl1 x 4" $ filterScanl14 size) , (SpaceO_1, benchIO "filter-map x 4" $ filterMap4 size) - -- XXX These should move to the Data.Scan module - -- scans - , (SpaceO_1, benchIO "scan/mapM" $ scansMapM size) - , (SpaceO_1, benchIO "scan/compose" $ scansCompose size) - , (SpaceO_1, benchIO "scan/tee" $ scansTee size) - , (SpaceO_1, benchIO "scan/mapM x 4" $ scansMapMX4 size) - , (SpaceO_1, benchIO "scan/compose x 4" $ scansComposeX4 size) - , (SpaceO_1, benchIO "scan/tee x 4" $ scansTeeX4 size) - , (StackO_n, benchIO "iterated/mapM (n/10 x 10)" $ iterateMapM size 10) , (StackO_n, benchIO "iterated/scanl' (quadratic) (n/100 x 100)" $ iterateScan size 100) , (StackO_n, benchIO "iterated/scanl1' (n/10 x 10)" $ iterateScanl1 size 10) diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index 6f6ba46fb0..551c750bda 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -388,6 +388,12 @@ benchmark Data.RingArray type: exitcode-stdio-1.0 main-is: Streamly/Benchmark/Data/RingArray.hs +benchmark Data.Scan + import: bench-options + type: exitcode-stdio-1.0 + hs-source-dirs: Streamly/Benchmark/Data + main-is: Scan.hs + benchmark Data.Scanl import: bench-options type: exitcode-stdio-1.0 From 8623a33fe6c246bc04b41cfb9bc6e38ed1ad2245 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sun, 14 Jun 2026 07:08:44 +0530 Subject: [PATCH 11/20] Move the iterated benchmarks from Basic to Composed --- .../Benchmark/Data/Stream/Transform/Basic.hs | 58 ------------------- .../Data/Stream/Transform/Composed.hs | 58 +++++++++++++++++++ 2 files changed, 58 insertions(+), 58 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs index 65b0c4a190..5f26c1f620 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs @@ -286,55 +286,6 @@ inspect $ 'trace4 `hasNoType` ''FL.Step inspect $ 'trace4 `hasNoType` ''SPEC #endif -------------------------------------------------------------------------------- --- Iteration/looping utilities -------------------------------------------------------------------------------- - -{-# INLINE iterateN #-} -iterateN :: (Int -> a -> a) -> a -> Int -> a -iterateN g initial count = f count initial - - where - - f (0 :: Int) x = x - f i x = f (i - 1) (g i x) - --- Iterate a transformation over a singleton stream -{-# INLINE iterateSingleton #-} -iterateSingleton :: Applicative m => - (Int -> Stream m Int -> Stream m Int) - -> Int - -> Int - -> Stream m Int -iterateSingleton g count n = iterateN g (Stream.fromPure n) count - -{- --- XXX need to check why this is slower than the explicit recursion above, even --- if the above code is written in a foldr like head recursive way. We also --- need to try this with foldlM' once #150 is fixed. --- However, it is perhaps best to keep the iteration benchmarks independent of --- foldrM and any related fusion issues. -{-# INLINE _iterateSingleton #-} -_iterateSingleton :: - Monad m - => (Int -> Stream m Int -> Stream m Int) - -> Int - -> Int - -> Stream m Int -_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n --} - -iteratePlusBaseline :: Int -> IO Int -iteratePlusBaseline value = - withRandomIntIO $ \i0 -> - iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value - -iterateSubMap :: Int -> IO () -iterateSubMap value = withRandomIntIO $ drain . iterateSingleton (<$) value - -iterateFmap :: Int -> IO () -iterateFmap value = withRandomIntIO $ drain . iterateSingleton (fmap . (+)) value - ------------------------------------------------------------------------------- -- Size reducing transformations (filtering) ------------------------------------------------------------------------------- @@ -1048,15 +999,6 @@ benchmarks size = , (SpaceO_1, benchIO "indexedR" $ indexedR1 size) , (SpaceO_1, benchIO "indexed x 4" $ indexed4 size) , (SpaceO_1, benchIO "indexedR x 4" $ indexedR4 size) - , (SpaceO_n, benchIO "iterated/(+) (n times) (baseline)" $ iteratePlusBaseline size) - , (SpaceO_n, benchIO "iterated/(<$) (n times)" $ iterateSubMap size) - , (SpaceO_n, benchIO "iterated/fmap (n times)" $ iterateFmap size) - {- - , benchIOSrc fromSerial "_(<$) (n times)" $ - _iterateSingleton (<$) value - , benchIOSrc fromSerial "_fmap (n times)" $ - _iterateSingleton (fmap . (+)) value - -} -- Reversing a stream , (HeapO_n, benchIO "reverse" $ reverse size) , (HeapO_n, benchIO "reverse'" $ reverse' size) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs index 6858323d21..db15608fd5 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs @@ -527,6 +527,55 @@ iterateDropWhileFalse value iterCount = withRandomIntIO $ Common.drain . iterateSource (S.dropWhile (> (value + 1))) (value `div` iterCount) iterCount +------------------------------------------------------------------------------- +-- Iteration/looping utilities +------------------------------------------------------------------------------- + +{-# INLINE iterateN #-} +iterateN :: (Int -> a -> a) -> a -> Int -> a +iterateN g initial count = f count initial + + where + + f (0 :: Int) x = x + f i x = f (i - 1) (g i x) + +-- Iterate a transformation over a singleton stream +{-# INLINE iterateSingleton #-} +iterateSingleton :: Applicative m => + (Int -> Stream m Int -> Stream m Int) + -> Int + -> Int + -> Stream m Int +iterateSingleton g count n = iterateN g (Stream.fromPure n) count + +{- +-- XXX need to check why this is slower than the explicit recursion above, even +-- if the above code is written in a foldr like head recursive way. We also +-- need to try this with foldlM' once #150 is fixed. +-- However, it is perhaps best to keep the iteration benchmarks independent of +-- foldrM and any related fusion issues. +{-# INLINE _iterateSingleton #-} +_iterateSingleton :: + Monad m + => (Int -> Stream m Int -> Stream m Int) + -> Int + -> Int + -> Stream m Int +_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n +-} + +iteratePlusBaseline :: Int -> IO Int +iteratePlusBaseline value = + withRandomIntIO $ \i0 -> + iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value + +iterateSubMap :: Int -> IO () +iterateSubMap value = withRandomIntIO $ drain . iterateSingleton (<$) value + +iterateFmap :: Int -> IO () +iterateFmap value = withRandomIntIO $ drain . iterateSingleton (fmap . (+)) value + ------------------------------------------------------------------------------- -- Composed transformations (scan + mapMaybe) ------------------------------------------------------------------------------- @@ -604,5 +653,14 @@ benchmarks size = , (StackO_n, benchIO "iterated/dropWhileTrue (n/10 x 10)" $ iterateDropWhileTrue size 10) -- XXX tasty-bench hangs on this sometimes -- , (StackO_n, benchIO "iterated/dropWhileFalse (n/10 x 10)" $ iterateDropWhileFalse size 10) + , (SpaceO_n, benchIO "iterated/(+) (n times) (baseline)" $ iteratePlusBaseline size) + , (SpaceO_n, benchIO "iterated/(<$) (n times)" $ iterateSubMap size) + , (SpaceO_n, benchIO "iterated/fmap (n times)" $ iterateFmap size) + {- + , benchIOSrc fromSerial "_(<$) (n times)" $ + _iterateSingleton (<$) value + , benchIOSrc fromSerial "_fmap (n times)" $ + _iterateSingleton (fmap . (+)) value + -} , (SpaceO_n, benchIO "naive prime sieve" $ naivePrimeSieve size) ] From 3234c596de49ddd3fbac00ce024047c3f5d7822c Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sun, 14 Jun 2026 20:15:34 +0530 Subject: [PATCH 12/20] Break Stream/Type benchmark file into smaller files --- .../Streamly/Benchmark/Data/Stream/Type.hs | 1630 +---------------- .../Benchmark/Data/Stream/Type/Basic.hs | 927 ++++++++++ .../Benchmark/Data/Stream/Type/Logic.hs | 159 ++ .../Benchmark/Data/Stream/Type/MultiStream.hs | 422 +++++ .../Benchmark/Data/Stream/Type/Nested.hs | 267 +++ benchmark/streamly-benchmarks.cabal | 4 + 6 files changed, 1806 insertions(+), 1603 deletions(-) create mode 100644 benchmark/Streamly/Benchmark/Data/Stream/Type/Basic.hs create mode 100644 benchmark/Streamly/Benchmark/Data/Stream/Type/Logic.hs create mode 100644 benchmark/Streamly/Benchmark/Data/Stream/Type/MultiStream.hs create mode 100644 benchmark/Streamly/Benchmark/Data/Stream/Type/Nested.hs diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Type.hs b/benchmark/Streamly/Benchmark/Data/Stream/Type.hs index 98c6d0a778..a2880c1a0b 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Type.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Type.hs @@ -4,23 +4,6 @@ -- License : BSD-3-Clause -- Maintainer : streamly@composewell.com -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RankNTypes #-} - -{-# OPTIONS_GHC -Wno-orphans #-} - -#ifdef __HADDOCK_VERSION__ -#undef INSPECTION -#endif - -#ifdef INSPECTION -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} -#endif - module Stream.Type ( benchmarks , boundedInts @@ -38,1594 +21,35 @@ module Stream.Type , benchIO ) where -#ifdef INSPECTION -import GHC.Types (SPEC(..)) -import Test.Inspection -import qualified Streamly.Internal.Data.Producer as Producer -#endif - -import Control.Monad (when) -import Control.Monad.IO.Class (MonadIO(..)) -import Control.DeepSeq (NFData(..)) -import Data.Functor ((<&>)) -import Data.Functor.Identity (Identity(..), runIdentity) -import Data.Monoid (Sum(..)) -import Streamly.Internal.Data.Stream (Stream) -import Streamly.Data.Unfold (Unfold) -import System.Random (randomRIO) - -import qualified Data.Foldable as F -import qualified GHC.Exts as GHC - -import qualified Streamly.Internal.Data.Fold as FL -import qualified Streamly.Internal.Data.Fold as Fold -import qualified Streamly.Internal.Data.Refold.Type as Refold -import qualified Streamly.Internal.Data.Stream as S -import qualified Streamly.Internal.Data.Stream as Stream -import qualified Streamly.Internal.Data.Unfold as UF -import qualified Streamly.Internal.Data.Unfold as Unfold - -import Test.Tasty.Bench -import qualified Stream.Common as Common -import Stream.Common hiding (benchIO) -import Streamly.Benchmark.Common -import Prelude hiding (concatMap, mapM, zipWith) - -{-# INLINE benchIO #-} -benchIO :: NFData b => String -> IO b -> Benchmark -benchIO name = bench name . nfIO - -{-# INLINE withRandomIntIO #-} -withRandomIntIO :: (Int -> IO b) -> IO b -withRandomIntIO f = randomRIO (1, 1 :: Int) >>= f - -{-# INLINE withDrain #-} -withDrain :: (Int -> Stream IO a) -> IO () -withDrain f = withRandomIntIO $ \n -> drain (f n) - -{-# INLINE withDrainPure #-} -withDrainPure :: (Int -> Stream Identity a) -> IO () -withDrainPure f = withRandomIntIO $ \n -> return $! runIdentity $ drain (f n) - -{-# INLINE withRandomInt #-} -withRandomInt :: (Int -> b) -> IO b -withRandomInt f = randomRIO (1, 1 :: Int) <&> f - -{-# INLINE withStream #-} -withStream :: Int -> (Stream IO Int -> IO b) -> IO b -withStream value f = withRandomIntIO (f . sourceUnfoldrM value) - -{-# INLINE withPureStream #-} -withPureStream :: Int -> (Stream Identity Int -> b) -> IO b -withPureStream value f = randomRIO (1, 1) <&> (f . sourceUnfoldr value) - -mkCross :: Stream m a -> Stream.Nested m a -mkCross = Stream.Nested - -unCross :: Stream.Nested m a -> Stream m a -unCross = Stream.unNested - -------------------------------------------------------------------------------- --- fromList -------------------------------------------------------------------------------- - -sourceFromList :: Int -> IO () -sourceFromList value = withDrain $ \n -> Stream.fromList [n..n+value] - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'sourceFromList -inspect $ 'sourceFromList `hasNoType` ''Stream.Step -inspect $ 'sourceFromList `hasNoType` ''Fold.Step -inspect $ 'sourceFromList `hasNoType` ''SPEC -#endif - --- | 'fromTuple' yields two elements per tuple. To emit and drain ~value --- elements we generate value/2 tuples and reduce each tuple's 'fromTuple' --- stream with a light 'sum' fold (avoiding a heavy, non-fusible 'concatMap' --- that would mask the cost of 'fromTuple'). -sourceFromTuple :: Int -> IO () -sourceFromTuple value = withDrain $ \n -> - Stream.mapM (Stream.fold Fold.sum . Stream.fromTuple) - $ Stream.fromList (fmap (\i -> (i, i)) [n .. n + value `div` 2]) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'sourceFromTuple -inspect $ 'sourceFromTuple `hasNoType` ''Stream.Step -inspect $ 'sourceFromTuple `hasNoType` ''Producer.TupleState -inspect $ 'sourceFromTuple `hasNoType` ''Fold.Step -inspect $ 'sourceFromTuple `hasNoType` ''SPEC -#endif - -sourceIsList :: Int -> IO () -sourceIsList value = withDrainPure $ \n -> GHC.fromList [n..n+value] - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'sourceIsList -inspect $ 'sourceIsList `hasNoType` ''Stream.Step -inspect $ 'sourceIsList `hasNoType` ''Fold.Step -inspect $ 'sourceIsList `hasNoType` ''SPEC -#endif - -sourceIsString :: Int -> IO () -sourceIsString value = withDrainPure $ \n -> - GHC.fromString (Prelude.replicate (n + value) 'a') - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'sourceIsString -inspect $ 'sourceIsString `hasNoType` ''Stream.Step -inspect $ 'sourceIsString `hasNoType` ''Fold.Step -inspect $ 'sourceIsString `hasNoType` ''SPEC -#endif - -{-# INLINE readInstance #-} -readInstance :: String -> Stream Identity Int -readInstance str = - let r = reads str - in case r of - [(x,"")] -> x - _ -> error "readInstance: no parse" - --- For comparisons -{-# INLINE readInstanceList #-} -readInstanceList :: String -> [Int] -readInstanceList str = - let r = reads str - in case r of - [(x,"")] -> x - _ -> error "readInstance: no parse" - -instance NFData a => NFData (Stream Identity a) where - {-# INLINE rnf #-} - rnf xs = runIdentity $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) xs - -------------------------------------------------------------------------------- --- Foldable Instance -------------------------------------------------------------------------------- - -{-# INLINE foldableFoldl' #-} -foldableFoldl' :: Int -> Int -> Int -foldableFoldl' value n = - F.foldl' (+) 0 (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableFoldl' -inspect $ 'foldableFoldl' `hasNoType` ''Stream.Step -#endif - -{-# INLINE foldableFoldrElem #-} -foldableFoldrElem :: Int -> Int -> Bool -foldableFoldrElem value n = - F.foldr (\x xs -> x == value || xs) - False - (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableFoldrElem -inspect $ 'foldableFoldrElem `hasNoType` ''Stream.Step -inspect $ 'foldableFoldrElem `hasNoType` ''Fold.Step -inspect $ 'foldableFoldrElem `hasNoType` ''SPEC -#endif - -{-# INLINE foldableSum #-} -foldableSum :: Int -> Int -> Int -foldableSum value n = - Prelude.sum (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableSum -inspect $ 'foldableSum `hasNoType` ''Stream.Step -inspect $ 'foldableSum `hasNoType` ''Fold.Step -inspect $ 'foldableSum `hasNoType` ''SPEC -#endif - -{-# INLINE foldableProduct #-} -foldableProduct :: Int -> Int -> Int -foldableProduct value n = - Prelude.product (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableProduct -inspect $ 'foldableProduct `hasNoType` ''Stream.Step -inspect $ 'foldableProduct `hasNoType` ''Fold.Step -inspect $ 'foldableProduct `hasNoType` ''SPEC -#endif - -{-# INLINE _foldableNull #-} -_foldableNull :: Int -> Int -> Bool -_foldableNull value n = - Prelude.null (sourceUnfoldr value n :: Stream Identity Int) - -{-# INLINE foldableElem #-} -foldableElem :: Int -> Int -> Bool -foldableElem value n = - value `Prelude.elem` (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableElem -inspect $ 'foldableElem `hasNoType` ''Stream.Step -inspect $ 'foldableElem `hasNoType` ''Fold.Step -inspect $ 'foldableElem `hasNoType` ''SPEC -#endif - -{-# INLINE foldableNotElem #-} -foldableNotElem :: Int -> Int -> Bool -foldableNotElem value n = - value `Prelude.notElem` (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableNotElem -inspect $ 'foldableNotElem `hasNoType` ''Stream.Step -inspect $ 'foldableNotElem `hasNoType` ''Fold.Step -inspect $ 'foldableNotElem `hasNoType` ''SPEC -#endif - -{-# INLINE foldableFind #-} -foldableFind :: Int -> Int -> Maybe Int -foldableFind value n = - F.find (== (value + 1)) (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableFind -inspect $ 'foldableFind `hasNoType` ''Stream.Step -inspect $ 'foldableFind `hasNoType` ''Fold.Step -inspect $ 'foldableFind `hasNoType` ''SPEC -#endif - -{-# INLINE foldableAll #-} -foldableAll :: Int -> Int -> Bool -foldableAll value n = - Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableAll -inspect $ 'foldableAll `hasNoType` ''Stream.Step -inspect $ 'foldableAll `hasNoType` ''Fold.Step -inspect $ 'foldableAll `hasNoType` ''SPEC -#endif - -{- HLINT ignore "Use any"-} -{-# INLINE foldableAny #-} -foldableAny :: Int -> Int -> Bool -foldableAny value n = - Prelude.any (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableAny -inspect $ 'foldableAny `hasNoType` ''Stream.Step -inspect $ 'foldableAny `hasNoType` ''Fold.Step -inspect $ 'foldableAny `hasNoType` ''SPEC -#endif - -{- HLINT ignore "Use all"-} -{-# INLINE foldableAnd #-} -foldableAnd :: Int -> Int -> Bool -foldableAnd value n = - Prelude.and $ fmap - (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableAnd -inspect $ 'foldableAnd `hasNoType` ''Stream.Step -inspect $ 'foldableAnd `hasNoType` ''Fold.Step -inspect $ 'foldableAnd `hasNoType` ''SPEC -#endif - -{- HLINT ignore "Use any"-} -{-# INLINE foldableOr #-} -foldableOr :: Int -> Int -> Bool -foldableOr value n = - Prelude.or $ fmap - (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableOr -inspect $ 'foldableOr `hasNoType` ''Stream.Step -inspect $ 'foldableOr `hasNoType` ''Fold.Step -inspect $ 'foldableOr `hasNoType` ''SPEC -#endif - -{-# INLINE foldableLength #-} -foldableLength :: Int -> Int -> Int -foldableLength value n = - Prelude.length (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableLength -inspect $ 'foldableLength `hasNoType` ''Stream.Step -inspect $ 'foldableLength `hasNoType` ''Fold.Step -inspect $ 'foldableLength `hasNoType` ''SPEC -#endif - -{-# INLINE foldableMin #-} -foldableMin :: Int -> Int -> Int -foldableMin value n = - Prelude.minimum (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableMin -inspect $ 'foldableMin `hasNoType` ''Stream.Step -inspect $ 'foldableMin `hasNoType` ''Fold.Step -inspect $ 'foldableMin `hasNoType` ''SPEC -#endif - -{-# INLINE ordInstanceMin #-} -ordInstanceMin :: Int -> Int -> () -ordInstanceMin value n = - let src = sourceUnfoldr value n - in runIdentity $ drain $ min src src - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'ordInstanceMin -inspect $ 'ordInstanceMin `hasNoType` ''Stream.Step -inspect $ 'ordInstanceMin `hasNoType` ''Fold.Step -inspect $ 'ordInstanceMin `hasNoType` ''SPEC -#endif - -{-# INLINE foldableMax #-} -foldableMax :: Int -> Int -> Int -foldableMax value n = - Prelude.maximum (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableMax -inspect $ 'foldableMax `hasNoType` ''Stream.Step -inspect $ 'foldableMax `hasNoType` ''Fold.Step -inspect $ 'foldableMax `hasNoType` ''SPEC -#endif - -{-# INLINE foldableMinBy #-} -foldableMinBy :: Int -> Int -> Int -foldableMinBy value n = - F.minimumBy compare (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableMinBy -inspect $ 'foldableMinBy `hasNoType` ''Stream.Step -inspect $ 'foldableMinBy `hasNoType` ''Fold.Step -inspect $ 'foldableMinBy `hasNoType` ''SPEC -#endif - -{-# INLINE foldableListMinBy #-} -foldableListMinBy :: Int -> Int -> Int -foldableListMinBy value n = F.minimumBy compare [1..value+n] - -{-# INLINE foldableMaxBy #-} -foldableMaxBy :: Int -> Int -> Int -foldableMaxBy value n = - F.maximumBy compare (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableMaxBy -inspect $ 'foldableMaxBy `hasNoType` ''Stream.Step -inspect $ 'foldableMaxBy `hasNoType` ''Fold.Step -inspect $ 'foldableMaxBy `hasNoType` ''SPEC -#endif - -{-# INLINE foldableToList #-} -foldableToList :: Int -> Int -> [Int] -foldableToList value n = - F.toList (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableToList -inspect $ 'foldableToList `hasNoType` ''Stream.Step -inspect $ 'foldableToList `hasNoType` ''Fold.Step -inspect $ 'foldableToList `hasNoType` ''SPEC -#endif - -{-# INLINE foldableMapM_ #-} -foldableMapM_ :: Int -> Int -> IO () -foldableMapM_ value n = - F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: Stream Identity Int) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableMapM_ -inspect $ 'foldableMapM_ `hasNoType` ''Stream.Step -inspect $ 'foldableMapM_ `hasNoType` ''Fold.Step -inspect $ 'foldableMapM_ `hasNoType` ''SPEC -#endif - -{-# INLINE foldableSequence_ #-} -foldableSequence_ :: Int -> Int -> IO () -foldableSequence_ value n = - F.sequence_ (sourceUnfoldrAction value n :: Stream Identity (IO Int)) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldableSequence_ -inspect $ 'foldableSequence_ `hasNoType` ''Stream.Step -inspect $ 'foldableSequence_ `hasNoType` ''Fold.Step -inspect $ 'foldableSequence_ `hasNoType` ''SPEC -#endif - -{-# INLINE _foldableMsum #-} -_foldableMsum :: Int -> Int -> IO Int -_foldableMsum value n = - F.msum (sourceUnfoldrAction value n :: Stream Identity (IO Int)) - -------------------------------------------------------------------------------- --- Show instance -------------------------------------------------------------------------------- - -showInstance :: Int -> IO String -showInstance value = withPureStream value show - -{-# INLINE showInstanceList #-} -showInstanceList :: [Int] -> String -showInstanceList = show - -------------------------------------------------------------------------------- --- Eq and Ord instances -------------------------------------------------------------------------------- - -eqInstance :: Int -> IO Bool -eqInstance value = withPureStream value $ \src -> src == src - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'eqInstance -inspect $ 'eqInstance `hasNoType` ''Stream.Step -inspect $ 'eqInstance `hasNoType` ''Fold.Step -inspect $ 'eqInstance `hasNoType` ''SPEC -#endif - -eqInstanceNotEq :: Int -> IO Bool -eqInstanceNotEq value = withPureStream value $ \src -> src /= src - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'eqInstanceNotEq -inspect $ 'eqInstanceNotEq `hasNoType` ''Stream.Step -inspect $ 'eqInstanceNotEq `hasNoType` ''Fold.Step -inspect $ 'eqInstanceNotEq `hasNoType` ''SPEC -#endif - -ordInstance :: Int -> IO Bool -ordInstance value = withPureStream value $ \src -> src < src - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'ordInstance -inspect $ 'ordInstance `hasNoType` ''Stream.Step -inspect $ 'ordInstance `hasNoType` ''Fold.Step -inspect $ 'ordInstance `hasNoType` ''SPEC -#endif - -------------------------------------------------------------------------------- --- Reductions -------------------------------------------------------------------------------- - -uncons :: Int -> IO () -uncons value = withStream value go - - where - - go s = do - r <- S.uncons s - case r of - Nothing -> return () - Just (_, t) -> go t - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'uncons --- inspect $ 'uncons `hasNoType` ''S.Step -inspect $ 'uncons `hasNoType` ''Fold.Step -inspect $ 'uncons `hasNoType` ''SPEC -#endif - -foldBreak :: Int -> IO () -foldBreak value = withStream value go - - where - - go s = do - (r, s1) <- S.foldBreak (Fold.take 1 Fold.length) s - when (r /= 0) $ go s1 - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldBreak --- inspect $ 'foldBreak `hasNoType` ''S.Step -inspect $ 'foldBreak `hasNoType` ''Fold.Step -inspect $ 'foldBreak `hasNoType` ''SPEC -#endif - -foldrMElem :: Int -> IO Bool -foldrMElem value = - withStream value - (S.foldrM - (\x xs -> if x == value then return True else xs) - (return False)) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldrMElem -inspect $ 'foldrMElem `hasNoType` ''S.Step -inspect $ 'foldrMElem `hasNoType` ''Fold.Step -inspect $ 'foldrMElem `hasNoType` ''SPEC -#endif - -foldrMElemIdentity :: Int -> IO Bool -foldrMElemIdentity value = - withPureStream value $ - runIdentity . S.foldrM - (\x xs -> if x == value then return True else xs) - (return False) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldrMElemIdentity -inspect $ 'foldrMElemIdentity `hasNoType` ''S.Step -inspect $ 'foldrMElemIdentity `hasNoType` ''Fold.Step -inspect $ 'foldrMElemIdentity `hasNoType` ''SPEC -#endif - -foldrMToList :: Int -> IO [Int] -foldrMToList value = - withStream value $ S.foldrM (\x xs -> (x :) <$> xs) (return []) - -foldrMToListIdentity :: Int -> IO [Int] -foldrMToListIdentity value = - withPureStream value - (runIdentity . S.foldrM (\x xs -> (x :) <$> xs) (return [])) - -foldl'Reduce :: Int -> IO Int -foldl'Reduce value = withStream value (S.foldl' (+) 0) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldl'Reduce -inspect $ 'foldl'Reduce `hasNoType` ''S.Step -#endif - -foldl'ReduceIdentity :: Int -> IO Int -foldl'ReduceIdentity value = - withPureStream value $ runIdentity . S.foldl' (+) 0 - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldl'ReduceIdentity -inspect $ 'foldl'ReduceIdentity `hasNoType` ''S.Step -#endif - -foldlM'Reduce :: Int -> IO Int -foldlM'Reduce value = - withStream value (S.foldlM' (\xs a -> return $ a + xs) (return 0)) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldlM'Reduce -inspect $ 'foldlM'Reduce `hasNoType` ''S.Step -#endif - -foldlM'ReduceIdentity :: Int -> IO Int -foldlM'ReduceIdentity value = - withPureStream value $ - runIdentity . S.foldlM' (\xs a -> return $ a + xs) (return 0) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldlM'ReduceIdentity -inspect $ 'foldlM'ReduceIdentity `hasNoType` ''S.Step -#endif - -toNull :: Int -> IO () -toNull value = withStream value S.drain - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'toNull -inspect $ 'toNull `hasNoType` ''Stream.Step -inspect $ 'toNull `hasNoType` ''Fold.Step -inspect $ 'toNull `hasNoType` ''SPEC -#endif - -drainPure :: Int -> IO () -drainPure value = withPureStream value $ runIdentity . drain - -drainN :: Int -> IO () -drainN value = withStream value (S.fold (Fold.drainN value)) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'drainN -inspect $ 'drainN `hasNoType` ''S.Step -inspect $ 'drainN `hasNoType` ''Fold.Step -inspect $ 'drainN `hasNoType` ''SPEC -#endif - -foldl'Build :: Int -> IO [Int] -foldl'Build value = withStream value (S.foldl' (flip (:)) []) - -foldl'BuildIdentity :: Int -> IO [Int] -foldl'BuildIdentity value = - withPureStream value (runIdentity . S.foldl' (flip (:)) []) - -foldlM'Build :: Int -> IO [Int] -foldlM'Build value = - withStream value (S.foldlM' (\xs x -> return $ x : xs) (return [])) - -foldlM'BuildIdentity :: Int -> IO [Int] -foldlM'BuildIdentity value = - withPureStream value - (runIdentity . S.foldlM' (\xs x -> return $ x : xs) (return [])) - -foldrMToSum :: Int -> IO Int -foldrMToSum value = - withStream value (S.foldrM (\x xs -> (x +) <$> xs) (return 0)) - -foldrMToSumIdentity :: Int -> IO Int -foldrMToSumIdentity value = - withPureStream value - (runIdentity . S.foldrM (\x xs -> (x +) <$> xs) (return 0)) - -toList' :: Int -> IO [Int] -toList' value = withStream value S.toList - -eqByPure :: Int -> IO Bool -eqByPure value = - withPureStream value $ \src -> runIdentity $ S.eqBy (==) src src - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'eqByPure -inspect $ 'eqByPure `hasNoType` ''SPEC -inspect $ 'eqByPure `hasNoType` ''S.Step -inspect $ 'eqByPure `hasNoType` ''Fold.Step -#endif - -cmpByPure :: Int -> IO Ordering -cmpByPure value = - withPureStream value $ \src -> runIdentity $ S.cmpBy compare src src - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'cmpByPure -inspect $ 'cmpByPure `hasNoType` ''SPEC -inspect $ 'cmpByPure `hasNoType` ''S.Step -inspect $ 'cmpByPure `hasNoType` ''Fold.Step -#endif - -eqBy :: Int -> IO Bool -eqBy value = withStream value $ \src -> S.eqBy (==) src src - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'eqBy -inspect $ 'eqBy `hasNoType` ''SPEC -inspect $ 'eqBy `hasNoType` ''S.Step -inspect $ 'eqBy `hasNoType` ''Fold.Step -#endif - -cmpBy :: Int -> IO Ordering -cmpBy value = withStream value $ \src -> S.cmpBy compare src src - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'cmpBy -inspect $ 'cmpBy `hasNoType` ''SPEC -inspect $ 'cmpBy `hasNoType` ''S.Step -inspect $ 'cmpBy `hasNoType` ''Fold.Step -#endif - -------------------------------------------------------------------------------- --- Mapping -------------------------------------------------------------------------------- - -{-# INLINE mapN #-} -mapN :: Monad m => Int -> Stream m Int -> m () -mapN n = composeN n $ fmap (+ 1) - -{-# INLINE mapM #-} -mapM :: MonadAsync m => Int -> Stream m Int -> m () -mapM n = composeN n $ Stream.mapM return - -map1 :: Int -> IO () -map1 value = withStream value (mapN 1) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'map1 -inspect $ 'map1 `hasNoType` ''Stream.Step -inspect $ 'map1 `hasNoType` ''FL.Step -inspect $ 'map1 `hasNoType` ''SPEC -#endif - -mapM1 :: Int -> IO () -mapM1 value = withStream value (mapM 1) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'mapM1 -inspect $ 'mapM1 `hasNoType` ''Stream.Step -inspect $ 'mapM1 `hasNoType` ''FL.Step -inspect $ 'mapM1 `hasNoType` ''SPEC -#endif - -mapN4 :: Int -> IO () -mapN4 value = withStream value (mapN 4) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'mapN4 -inspect $ 'mapN4 `hasNoType` ''Stream.Step -inspect $ 'mapN4 `hasNoType` ''FL.Step -inspect $ 'mapN4 `hasNoType` ''SPEC -#endif - -mapM4 :: Int -> IO () -mapM4 value = withStream value (mapM 4) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'mapM4 -inspect $ 'mapM4 `hasNoType` ''Stream.Step -inspect $ 'mapM4 `hasNoType` ''FL.Step -inspect $ 'mapM4 `hasNoType` ''SPEC -#endif +import Test.Tasty.Bench (Benchmark) +import Streamly.Benchmark.Common (SpaceComplexity) -------------------------------------------------------------------------------- --- Filtering -------------------------------------------------------------------------------- - -{-# INLINE _takeOne #-} -_takeOne :: MonadIO m => Int -> Stream m Int -> m () -_takeOne n = composeN n $ Stream.take 1 - -{-# INLINE takeAll #-} -takeAll :: MonadIO m => Int -> Int -> Stream m Int -> m () -takeAll value n = composeN n $ Stream.take (value + 1) - -takeAll1 :: Int -> IO () -takeAll1 value = withStream value (takeAll value 1) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'takeAll1 -inspect $ 'takeAll1 `hasNoType` ''Stream.Step -inspect $ 'takeAll1 `hasNoType` ''FL.Step -inspect $ 'takeAll1 `hasNoType` ''SPEC -#endif - -takeAll4 :: Int -> IO () -takeAll4 value = withStream value (takeAll value 4) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'takeAll4 -inspect $ 'takeAll4 `hasNoType` ''Stream.Step -inspect $ 'takeAll4 `hasNoType` ''FL.Step -inspect $ 'takeAll4 `hasNoType` ''SPEC -#endif - -{-# INLINE takeWhileTrue #-} -takeWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m () -takeWhileTrue value n = composeN n $ Stream.takeWhile (<= (value + 1)) - -takeWhileTrue1 :: Int -> IO () -takeWhileTrue1 value = withStream value (takeWhileTrue value 1) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'takeWhileTrue1 -inspect $ 'takeWhileTrue1 `hasNoType` ''Stream.Step -inspect $ 'takeWhileTrue1 `hasNoType` ''FL.Step -inspect $ 'takeWhileTrue1 `hasNoType` ''SPEC -#endif - -takeWhileTrue4 :: Int -> IO () -takeWhileTrue4 value = withStream value (takeWhileTrue value 4) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'takeWhileTrue4 -inspect $ 'takeWhileTrue4 `hasNoType` ''Stream.Step -inspect $ 'takeWhileTrue4 `hasNoType` ''FL.Step -inspect $ 'takeWhileTrue4 `hasNoType` ''SPEC -#endif - -{-# INLINE takeWhileMTrue #-} -takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m () -takeWhileMTrue value n = composeN n $ Stream.takeWhileM (return . (<= (value + 1))) - -takeWhileMTrue4 :: Int -> IO () -takeWhileMTrue4 value = withStream value (takeWhileMTrue value 4) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'takeWhileMTrue4 -inspect $ 'takeWhileMTrue4 `hasNoType` ''Stream.Step -inspect $ 'takeWhileMTrue4 `hasNoType` ''FL.Step -inspect $ 'takeWhileMTrue4 `hasNoType` ''SPEC -#endif - -------------------------------------------------------------------------------- --- Multi-stream -------------------------------------------------------------------------------- - -------------------------------------------------------------------------------- --- Appending -------------------------------------------------------------------------------- - -serial2 :: Int -> IO () -serial2 count = withRandomIntIO $ \n -> - drain $ - Common.append - (sourceUnfoldrM count n) - (sourceUnfoldrM count (n + 1)) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'serial2 -inspect $ 'serial2 `hasNoType` ''SPEC -inspect $ 'serial2 `hasNoType` ''S.AppendState -inspect $ 'serial2 `hasNoType` ''S.Step -inspect $ 'serial2 `hasNoType` ''Fold.Step -#endif - -serial4 :: Int -> IO () -serial4 count = withRandomIntIO $ \n -> - drain $ - Common.append - (Common.append - (sourceUnfoldrM count n) - (sourceUnfoldrM count (n + 1))) - (Common.append - (sourceUnfoldrM count (n + 2)) - (sourceUnfoldrM count (n + 3))) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'serial4 -inspect $ 'serial4 `hasNoType` ''SPEC -inspect $ 'serial4 `hasNoType` ''S.AppendState -inspect $ 'serial4 `hasNoType` ''S.Step -inspect $ 'serial4 `hasNoType` ''Fold.Step -#endif - -------------------------------------------------------------------------------- --- Zipping -------------------------------------------------------------------------------- - -zipWith :: Int -> IO () -zipWith value = withRandomIntIO $ \n -> - let src = sourceUnfoldrM value n - in drain $ S.zipWith (,) src src - -#ifdef INSPECTION -inspect $ 'zipWith `hasNoType` ''SPEC --- inspect $ 'zipWith `hasNoType` ''S.Step -inspect $ 'zipWith `hasNoType` ''Fold.Step -#endif - -zipWithM :: Int -> IO () -zipWithM value = withRandomIntIO $ \n -> - let src = sourceUnfoldrM value n - in drain $ S.zipWithM (curry return) src src - -#ifdef INSPECTION -inspect $ 'zipWithM `hasNoType` ''SPEC --- inspect $ 'zipWithM `hasNoType` ''S.Step -inspect $ 'zipWithM `hasNoType` ''Fold.Step -#endif - -------------------------------------------------------------------------------- --- Concat -------------------------------------------------------------------------------- - -{-# INLINE sourceConcatMapSingletonStreams #-} -sourceConcatMapSingletonStreams :: Monad m => Int -> Int -> Stream m (Stream m Int) -sourceConcatMapSingletonStreams count start = - fmap Stream.fromPure $ sourceUnfoldr count start - -{-# INLINE sourceConcatMapStreams #-} -sourceConcatMapStreams :: Monad m => Int -> Int -> Int -> Stream m (Stream m Int) -sourceConcatMapStreams outer inner start = - fmap (sourceUnfoldr inner) $ sourceUnfoldr outer start - -concatMap :: Int -> Int -> IO () -concatMap outer inner = withRandomIntIO $ \n -> - drain $ S.concatMap - (sourceUnfoldrM inner) - (sourceUnfoldrM outer n) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'concatMap -inspect $ 'concatMap `hasNoType` ''SPEC --- inspect $ 'concatMap `hasNoType` ''S.Step -inspect $ 'concatMap `hasNoType` ''Fold.Step -#endif - -concatMapM2 :: Int -> IO () -concatMapM2 value = withStream value $ \s -> - drain $ do - Stream.concatMapM (\x -> - pure $ Stream.concatMapM (\y -> - pure $ Stream.fromPure $ x + y) s) s - -concatMapM3 :: Int -> IO () -concatMapM3 value = withStream value $ \s -> - drain $ do - Stream.concatMapM (\x -> - pure $ Stream.concatMapM (\y -> - pure $ Stream.concatMapM (\z -> - pure $ Stream.fromPure $ x + y + z) s) s) s - -concatMapViaUnfoldEach :: Int -> Int -> IO () -concatMapViaUnfoldEach outer inner = withRandomIntIO $ \n -> - drain $ cmap - (sourceUnfoldrM inner) - (sourceUnfoldrM outer n) - - where - - cmap f = Stream.unfoldEach (UF.lmap f UF.fromStream) - -concatMapM :: Int -> Int -> IO () -concatMapM outer inner = withRandomIntIO $ \n -> - drain $ S.concatMapM - (return . sourceUnfoldrM inner) - (sourceUnfoldrM outer n) - --- concatMap Streams - -concatMapSingletonStreams :: Int -> IO () -concatMapSingletonStreams value = - withRandomIntIO (drain . S.concatMap id . sourceConcatMapSingletonStreams value) - -concatMapStreams :: Int -> Int -> IO () -concatMapStreams outer inner = - withRandomIntIO (S.drain . S.concatMap id . sourceConcatMapStreams outer inner) - --- concatMap unfoldr/unfoldr - -concatMapPure :: Int -> Int -> IO () -concatMapPure outer inner = withRandomIntIO $ \n -> - drain $ S.concatMap - (sourceUnfoldr inner) - (sourceUnfoldr outer n) - -#ifdef INSPECTION -#if __GLASGOW_HASKELL__ >= 906 -inspect $ hasNoTypeClassesExcept 'concatMapPure [''Applicative] -#else -inspect $ hasNoTypeClasses 'concatMapPure -#endif -inspect $ 'concatMapPure `hasNoType` ''SPEC --- inspect $ 'concatMapPure `hasNoType` ''S.Step -inspect $ 'concatMapPure `hasNoType` ''Fold.Step -#endif - -{-# INLINE sourceUnfoldrMUnfold #-} -sourceUnfoldrMUnfold :: Monad m => Int -> Int -> Unfold m Int Int -sourceUnfoldrMUnfold size start = UF.unfoldrM step - - where - - step i = - return - $ if i < start + size - then Just (i, i + 1) - else Nothing - -unfoldEach :: Int -> Int -> IO () -unfoldEach outer inner = withRandomIntIO $ \start -> drain $ - S.unfoldEach (sourceUnfoldrMUnfold inner start) - $ sourceUnfoldrM outer start - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'unfoldEach -inspect $ 'unfoldEach `hasNoType` ''Producer.ConcatState -inspect $ 'unfoldEach `hasNoType` ''SPEC -inspect $ 'unfoldEach `hasNoType` ''S.Step -inspect $ 'unfoldEach `hasNoType` ''Fold.Step -#endif - -unfoldEach2 :: Int -> Int -> IO () -unfoldEach2 outer inner = withRandomIntIO $ \start -> drain $ - S.unfoldEach (UF.carryInput (sourceUnfoldrMUnfold inner start)) - $ sourceUnfoldrM outer start - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'unfoldEach2 -inspect $ 'unfoldEach2 `hasNoType` ''Producer.ConcatState -inspect $ 'unfoldEach2 `hasNoType` ''S.Step -inspect $ 'unfoldEach2 `hasNoType` ''Fold.Step -inspect $ 'unfoldEach2 `hasNoType` ''SPEC -#endif - -unfoldEach3 :: Int -> IO () -unfoldEach3 linearCount = withRandomIntIO $ \start -> drain $ do - S.unfoldEach (UF.carryInput (UF.lmap snd (sourceUnfoldrMUnfold nestedCount3 start))) - $ S.unfoldEach (UF.carryInput (sourceUnfoldrMUnfold nestedCount3 start)) - $ sourceUnfoldrM nestedCount3 start - where - - nestedCount3 = round (fromIntegral linearCount**(1/3::Double)) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'unfoldEach3 -inspect $ 'unfoldEach3 `hasNoType` ''Producer.ConcatState -inspect $ 'unfoldEach3 `hasNoType` ''S.Step -inspect $ 'unfoldEach3 `hasNoType` ''Fold.Step -inspect $ 'unfoldEach3 `hasNoType` ''SPEC -#endif - -unfoldCross :: Int -> Int -> IO () -unfoldCross outer inner = withRandomIntIO $ \start -> drain $ - Stream.unfoldCross - UF.identity - (sourceUnfoldrM outer start) - (sourceUnfoldrM inner start) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'unfoldCross -inspect $ 'unfoldCross `hasNoType` ''Producer.CrossState -inspect $ 'unfoldCross `hasNoType` ''Producer.ConcatState -inspect $ 'unfoldCross `hasNoType` ''S.Step -inspect $ 'unfoldCross `hasNoType` ''Fold.Step -inspect $ 'unfoldCross `hasNoType` ''SPEC -#endif - -------------------------------------------------------------------------------- --- Applicative -------------------------------------------------------------------------------- - -{-# INLINE toNullApPure #-} -toNullApPure :: MonadAsync m => Int -> Int -> m () -toNullApPure linearCount start = drain $ unCross $ - (+) <$> mkCross (sourceUnfoldr nestedCount2 start) - <*> mkCross (sourceUnfoldr nestedCount2 start) - - where - - nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) - -{-# INLINE toNullMPure #-} -toNullMPure :: MonadAsync m => Int -> Int -> m () -toNullMPure linearCount start = drain $ unCross $ do - x <- mkCross (sourceUnfoldr nestedCount2 start) - y <- mkCross (sourceUnfoldr nestedCount2 start) - return $ x + y - - where - - nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) - -{-# INLINE toNullM3Pure #-} -toNullM3Pure :: MonadAsync m => Int -> Int -> m () -toNullM3Pure linearCount start = drain $ unCross $ do - x <- mkCross (sourceUnfoldr nestedCount3 start) - y <- mkCross (sourceUnfoldr nestedCount3 start) - z <- mkCross (sourceUnfoldr nestedCount3 start) - return $ x + y + z - - where - - nestedCount3 = round (fromIntegral linearCount**(1/3::Double)) - -{-# INLINE filterAllOutMPure #-} -filterAllOutMPure :: MonadAsync m => Int -> Int -> m () -filterAllOutMPure linearCount start = drain $ unCross $ do - x <- mkCross (sourceUnfoldr nestedCount2 start) - y <- mkCross (sourceUnfoldr nestedCount2 start) - let s = x + y - if s < 0 - then return s - else mkCross Stream.nil - - where - - nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) - -{-# INLINE filterAllInMPure #-} -filterAllInMPure :: MonadAsync m => Int -> Int -> m () -filterAllInMPure linearCount start = drain $ unCross $ do - x <- mkCross (sourceUnfoldr nestedCount2 start) - y <- mkCross (sourceUnfoldr nestedCount2 start) - let s = x + y - if s > 0 - then return s - else mkCross Stream.nil - - where - - nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) - -cross2 :: Int -> IO () -cross2 linearCount = withRandomIntIO $ \start -> drain $ - Stream.crossWith (+) - (sourceUnfoldr nestedCount2 start) - (sourceUnfoldr nestedCount2 start) - - where - - nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) - -crossApply :: Int -> IO () -crossApply linearCount = withRandomIntIO $ \start -> drain $ - Stream.crossApply - ((+) <$> sourceUnfoldrM nestedCount2 start) - (sourceUnfoldrM nestedCount2 start) - - where - - nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) - -crossApplyFst :: Int -> IO () -crossApplyFst linearCount = withRandomIntIO $ \start -> drain $ - Stream.crossApplyFst - (sourceUnfoldrM nestedCount2 start) - (sourceUnfoldrM nestedCount2 start) - - where - - nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) - -crossApplySnd :: Int -> IO () -crossApplySnd linearCount = withRandomIntIO $ \start -> drain $ - Stream.crossApplySnd - (sourceUnfoldrM nestedCount2 start) - (sourceUnfoldrM nestedCount2 start) - - where - - nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) - -------------------------------------------------------------------------------- --- Monad -------------------------------------------------------------------------------- - -drainConcatFor1 :: Int -> IO () -drainConcatFor1 count = withStream count $ \s -> - drain $ Stream.concatFor s $ \x -> - Stream.fromPure $ x + 1 - -drainConcatFor :: Int -> IO () -drainConcatFor count = withStream count $ \s -> - drain $ do - Stream.concatFor s $ \x -> - Stream.concatFor s $ \y -> - Stream.fromPure $ x + y - -drainConcatForM :: Int -> IO () -drainConcatForM count = withStream count $ \s -> - drain $ do - Stream.concatForM s $ \x -> - pure $ Stream.concatForM s $ \y -> - pure $ Stream.fromPure $ x + y - -drainConcatFor3 :: Int -> IO () -drainConcatFor3 count = withStream count $ \s -> - drain $ do - Stream.concatFor s $ \x -> - Stream.concatFor s $ \y -> - Stream.concatFor s $ \z -> - Stream.fromPure $ x + y + z - -drainConcatFor4 :: Int -> IO () -drainConcatFor4 count = withStream count $ \s -> - drain $ do - Stream.concatFor s $ \x -> - Stream.concatFor s $ \y -> - Stream.concatFor s $ \z -> - Stream.concatFor s $ \w -> - Stream.fromPure $ x + y + z + w - -drainConcatFor5 :: Int -> IO () -drainConcatFor5 count = withStream count $ \s -> - drain $ do - Stream.concatFor s $ \x -> - Stream.concatFor s $ \y -> - Stream.concatFor s $ \z -> - Stream.concatFor s $ \w -> - Stream.concatFor s $ \u -> - Stream.fromPure $ x + y + z + w + u - -drainConcatFor3M :: Int -> IO () -drainConcatFor3M count = withStream count $ \s -> - drain $ do - Stream.concatForM s $ \x -> - pure $ Stream.concatForM s $ \y -> - pure $ Stream.concatForM s $ \z -> - pure $ Stream.fromPure $ x + y + z - -filterAllInConcatFor :: Int -> IO () -filterAllInConcatFor count = withStream count $ \s -> - drain $ do - Stream.concatFor s $ \x -> - Stream.concatFor s $ \y -> - let s1 = x + y - in if s1 > 0 - then Stream.fromPure s1 - else Stream.nil - -filterAllOutConcatFor :: Int -> IO () -filterAllOutConcatFor count = withStream count $ \s -> - drain $ do - Stream.concatFor s $ \x -> - Stream.concatFor s $ \y -> - let s1 = x + y - in if s1 < 0 - then Stream.fromPure s1 - else Stream.nil - --- search space |x| = 1000, |y| = 1000 -{-# INLINE boundedInts #-} -boundedInts :: Monad m => Int -> Int -> Stream m Int -boundedInts n _ = - Stream.interleave - (Stream.enumerateFromTo (0 :: Int) n) - (Stream.enumerateFromThenTo (-1) (-2) (-n)) - -{-# INLINE infiniteInts #-} -infiniteInts :: Monad m => Int -> Int -> Stream m Int -infiniteInts _ _ = - Stream.interleave - (Stream.enumerateFrom (0 :: Int)) - (Stream.enumerateFromThen (-1) (-2)) - -{-# INLINE boundedIntsUnfold #-} -boundedIntsUnfold :: Monad m => Int -> Int -> Unfold m ((), ()) Int -boundedIntsUnfold n _ = - Unfold.interleave - (Unfold.supply (0 :: Int, n) Unfold.enumerateFromTo) - (Unfold.supply (-1, -2, -n) Unfold.enumerateFromThenTo) - -{-# INLINE checkStream #-} -checkStream :: Applicative m => - Int -> Int -> Int -> Stream m (Maybe (Maybe (Int, Int))) -checkStream maxVal x y = - let eq1 = x + y == 0 - eq2 = x - y == 2 * maxVal - in if eq1 && eq2 - then Stream.fromPure (Just (Just (x,y))) - else if abs x > maxVal && abs y > maxVal - then Stream.fromPure (Just Nothing) - else Stream.fromPure Nothing - -{-# INLINE checkPair #-} -checkPair :: Monad m => Int -> (Int, Int) -> m (Maybe (Maybe (Int, Int))) -checkPair maxVal (x, y) = - let eq1 = x + y == 0 - eq2 = x - y == 2 * maxVal - in if eq1 && eq2 - then pure (Just (Just (x,y))) - else if abs x > maxVal && abs y > maxVal - then pure (Just Nothing) - else pure Nothing - --- Terminate the stream as soon as we get a Just value -{-# INLINE result #-} -result :: Monad m => Stream m (Maybe a) -> m () -result = Stream.fold (Fold.take 1 Fold.drain) . Stream.catMaybes - -{-# INLINE concatForEqn #-} -concatForEqn :: Monad m => Int -> Stream m Int -> m () -concatForEqn maxVal input = - result - $ Stream.concatFor input $ \x -> - Stream.concatForM input $ \y -> do - return $ checkStream maxVal x y - -{-# INLINE streamCrossEqn #-} -streamCrossEqn :: Monad m => Int -> Stream m Int -> m () -streamCrossEqn maxVal input = - result - $ Stream.mapM (checkPair maxVal) - $ Stream.cross input input - -{-# INLINE fairStreamCrossEqn #-} -fairStreamCrossEqn :: Monad m => Int -> Stream m Int -> m () -fairStreamCrossEqn maxVal input = - result - $ Stream.mapM (checkPair maxVal) - $ Stream.fairCross input input - -{-# INLINE unfoldEachEqn #-} -unfoldEachEqn :: Monad m => Int -> Unfold m ((), ()) Int -> Stream m Int -> m () -unfoldEachEqn maxVal input ints = - let intu = Unfold.carryInput $ Unfold.lmap (const (undefined, undefined)) input - in result - $ Stream.mapM (checkPair maxVal) - $ Stream.unfoldEach intu ints - -concatForBounded :: Int -> IO () -concatForBounded maxVal = withRandomIntIO $ \n -> - concatForEqn maxVal (boundedInts maxVal n) - -streamCrossBounded :: Int -> IO () -streamCrossBounded maxVal = withRandomIntIO $ \n -> - streamCrossEqn maxVal (boundedInts maxVal n) - -fairStreamCrossBounded :: Int -> IO () -fairStreamCrossBounded maxVal = withRandomIntIO $ \n -> - fairStreamCrossEqn maxVal (boundedInts maxVal n) - -fairStreamCrossInfinite :: Int -> IO () -fairStreamCrossInfinite maxVal = withRandomIntIO $ \n -> - fairStreamCrossEqn maxVal (infiniteInts maxVal n) - -unfoldEachBounded :: Int -> IO () -unfoldEachBounded maxVal = withRandomIntIO $ \n -> - unfoldEachEqn maxVal (boundedIntsUnfold maxVal 0) (boundedInts maxVal n) - -------------------------------------------------------------------------------- --- Fold Many -------------------------------------------------------------------------------- - -foldMany :: Int -> IO () -foldMany value = - withStream value $ - Common.drain - . fmap getSum - . S.foldMany (FL.take 2 FL.mconcat) - . fmap Sum - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldMany -inspect $ 'foldMany `hasNoType` ''S.Step -inspect $ 'foldMany `hasNoType` ''S.FoldMany -inspect $ 'foldMany `hasNoType` ''FL.Step -inspect $ 'foldMany `hasNoType` ''SPEC -#endif - -foldMany1 :: Int -> IO () -foldMany1 value = - withStream value $ - Common.drain - . fmap getSum - . S.foldManyPost (FL.take 2 FL.mconcat) - . fmap Sum - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldMany1 -inspect $ 'foldMany1 `hasNoType` ''S.Step -inspect $ 'foldMany1 `hasNoType` ''S.FoldManyPost -inspect $ 'foldMany1 `hasNoType` ''FL.Step -inspect $ 'foldMany1 `hasNoType` ''SPEC -#endif - -refoldMany :: Int -> IO () -refoldMany value = - withStream value $ - Common.drain - . fmap getSum - . S.refoldMany (Refold.take 2 Refold.sconcat) (return mempty) - . fmap Sum - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'refoldMany -inspect $ 'refoldMany `hasNoType` ''S.Step -inspect $ 'refoldMany `hasNoType` ''S.FoldMany -inspect $ 'refoldMany `hasNoType` ''FL.Step -inspect $ 'refoldMany `hasNoType` ''SPEC -#endif - --- {-# INLINE refoldIterateM #-} -refoldIterateM :: Int -> IO () -refoldIterateM value = - withStream value $ - Common.drain - . fmap getSum - . S.refoldIterateM - (Refold.take 2 Refold.sconcat) (return (Sum 0)) - . fmap Sum - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'refoldIterateM -inspect $ 'refoldIterateM `hasNoType` ''S.Step -inspect $ 'refoldIterateM `hasNoType` ''S.CIterState -inspect $ 'refoldIterateM `hasNoType` ''FL.Step -inspect $ 'refoldIterateM `hasNoType` ''Refold.Tuple'Fused -inspect $ 'refoldIterateM `hasNoType` ''SPEC -#endif +import Stream.Type.Basic + ( benchIO + , withRandomIntIO + , withDrain + , withDrainPure + , withRandomInt + , withStream + , withPureStream + ) +import Stream.Type.Logic + ( boundedInts + , infiniteInts + , boundedIntsUnfold + , checkStream + , checkPair + , result + ) -------------------------------------------------------------------------------- --- Main -------------------------------------------------------------------------------- +import qualified Stream.Type.Basic as Basic +import qualified Stream.Type.MultiStream as MultiStream +import qualified Stream.Type.Nested as Nested +import qualified Stream.Type.Logic as Logic --- In addition to gauge options, the number of elements in the stream can be --- passed using the --stream-size option. --- -{-# ANN benchmarks "HLint: ignore" #-} benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = - -- Construction - [ (SpaceO_1, benchIO "fromList" $ sourceFromList size) - , (SpaceO_1, benchIO "fromTuple" $ sourceFromTuple size) - , (SpaceO_1, benchIO "IsList.fromList" $ sourceIsList size) - , (SpaceO_1, benchIO "IsString.fromString" $ sourceIsString size) - -- Buffers the output of show/read. - -- XXX can the outputs be streaming? Can we have special read/show - -- style type classes, readM/showM supporting streaming effects? - , (HeapO_n, bench "readsPrec pure streams" $ - nf (readInstance . mkString) size) - , (HeapO_n, bench "readsPrec Haskell lists" $ - nf (readInstanceList . mkListString) size) - -- Elimination - -- Foldable instance - , (SpaceO_1, benchIO "Foldable/foldl'" $ withRandomInt (foldableFoldl' size)) - , (SpaceO_1, benchIO "Foldable/foldrElem" $ withRandomInt (foldableFoldrElem size)) - -- , (SpaceO_1, benchIO "Foldable/null" $ withRandomInt (_foldableNull size)) - , (SpaceO_1, benchIO "Foldable/elem" $ withRandomInt (foldableElem size)) - , (SpaceO_1, benchIO "Foldable/length" $ withRandomInt (foldableLength size)) - , (SpaceO_1, benchIO "Foldable/sum" $ withRandomInt (foldableSum size)) - , (SpaceO_1, benchIO "Foldable/product" $ withRandomInt (foldableProduct size)) - , (SpaceO_1, benchIO "Foldable/minimum" $ withRandomInt (foldableMin size)) - , (SpaceO_1, benchIO "Foldable/min (ord)" $ withRandomInt (ordInstanceMin size)) - , (SpaceO_1, benchIO "Foldable/maximum" $ withRandomInt (foldableMax size)) - , (SpaceO_1, benchIO "Foldable/minimumBy" $ withRandomInt (foldableMinBy size)) - , (SpaceO_1, benchIO "Foldable/maximumBy" $ withRandomInt (foldableMaxBy size)) - , (SpaceO_1, benchIO "Foldable/minimumByList" $ withRandomInt (foldableListMinBy size)) - , (SpaceO_1, benchIO "Foldable/length . toList" $ - withRandomInt (Prelude.length . foldableToList size)) - , (SpaceO_1, benchIO "Foldable/notElem" $ withRandomInt (foldableNotElem size)) - , (SpaceO_1, benchIO "Foldable/find" $ withRandomInt (foldableFind size)) - , (SpaceO_1, benchIO "Foldable/all" $ withRandomInt (foldableAll size)) - , (SpaceO_1, benchIO "Foldable/any" $ withRandomInt (foldableAny size)) - , (SpaceO_1, benchIO "Foldable/and" $ withRandomInt (foldableAnd size)) - , (SpaceO_1, benchIO "Foldable/or" $ withRandomInt (foldableOr size)) - - -- Applicative and Traversable operations - -- TBD: traverse_ - , (SpaceO_1, benchIO "Foldable/mapM_" $ withRandomIntIO (foldableMapM_ size)) - -- TBD: for_ - -- TBD: forM_ - , (SpaceO_1, benchIO "Foldable/sequence_" $ withRandomIntIO (foldableSequence_ size)) - -- TBD: sequenceA_ - -- TBD: asum - -- XXX needs to be fixed, results are in ns - -- , (SpaceO_1, benchIOSink1 "Foldable/msum" (foldableMsum size)) - , (SpaceO_1, benchIO "foldl'/IO" $ foldl'Reduce size) - , (SpaceO_1, benchIO "foldlM'/IO" $ foldlM'Reduce size) - - , (SpaceO_1, benchIO "foldl'/Identity" $ foldl'ReduceIdentity size) - , (SpaceO_1, benchIO "foldlM'/Identity" $ foldlM'ReduceIdentity size) - - , (SpaceO_1, benchIO "foldrMElem/IO" $ foldrMElem size) - - , (SpaceO_1, benchIO "foldrMElem/Identity" $ foldrMElemIdentity size) - , (SpaceO_1, benchIO "foldrMToList" $ foldrMToListIdentity size) - - -- this is too fast, causes all benchmarks reported in ns - -- , (SpaceO_1, benchIO "null" $ ...) - - -- deconstruction - , (SpaceO_1, benchIO "uncons" $ uncons size) - , (SpaceO_1, benchIO "foldBreak" $ foldBreak size) - - -- draining - , (SpaceO_1, benchIO "toNull" $ toNull size) - , (SpaceO_1, benchIO "drainN" $ drainN size) - , (SpaceO_1, benchIO "drain (pure)" $ drainPure size) - - -- length is used to check for foldr/build fusion - , (SpaceO_1, benchIO "length . IsList.toList" $ - withPureStream size (Prelude.length . GHC.toList)) - -- Left folds for building a structure are inherently non-streaming - -- as the structure cannot be lazily consumed until fully built. - , (HeapO_n, benchIO "foldl'/build/IO" $ foldl'Build size) - , (HeapO_n, benchIO "foldl'/build/Identity" $ foldl'BuildIdentity size) - , (HeapO_n, benchIO "foldlM'/build/IO" $ foldlM'Build size) - , (HeapO_n, benchIO "foldlM'/build/Identity" $ foldlM'BuildIdentity size) - -- Buffers the output of show/read. - -- XXX can the outputs be streaming? Can we have special read/show - -- style type classes, readM/showM supporting streaming effects? - , (HeapO_n, bench "showsPrec Haskell lists" $ nf showInstanceList (mkList size)) - -- XXX This is not o-1-space for GHC-8.10 - , (HeapO_n, benchIO "showsPrec pure streams" $ showInstance size) - -- Head recursive strict right folds. - -- accumulation due to strictness of IO monad - , (SpaceO_n, benchIO "foldrM/build/IO (toList)" $ foldrMToList size) - -- Right folds for reducing are inherently non-streaming as the - -- expression needs to be fully built before it can be reduced. - , (SpaceO_n, benchIO "foldrM/reduce/Identity (sum)" $ foldrMToSumIdentity size) - , (SpaceO_n, benchIO "foldrM/reduce/IO (sum)" $ foldrMToSum size) - -- Converting the stream to a list or pure stream in a strict monad - , (SpaceO_n, benchIO "toList" $ toList' size) - , (SpaceO_1, benchIO "==" $ eqInstance size) - , (SpaceO_1, benchIO "/=" $ eqInstanceNotEq size) - , (SpaceO_1, benchIO "<" $ ordInstance size) - , (SpaceO_1, benchIO "eqBy (pure)" $ eqByPure size) - , (SpaceO_1, benchIO "cmpBy (pure)" $ cmpByPure size) - , (SpaceO_1, benchIO "eqBy" $ eqBy size) - , (SpaceO_1, benchIO "cmpBy" $ cmpBy size) - -- Mapping - , (SpaceO_1, benchIO "fmap" $ map1 size) - , (SpaceO_1, benchIO "fmap x 4" $ mapN4 size) - , (SpaceO_1, benchIO "map" $ map1 size) - , (SpaceO_1, benchIO "mapM" $ mapM1 size) - , (SpaceO_1, benchIO "map x 4" $ mapN4 size) - , (SpaceO_1, benchIO "mapM x 4" $ mapM4 size) - -- Filtering - -- Trimming - , (SpaceO_1, benchIO "take-all" $ takeAll1 size) - , (SpaceO_1, benchIO "takeWhile-true" $ takeWhileTrue1 size) - -- , (SpaceO_1, benchIO "takeWhileM-true" ...) - -- trimming - , (SpaceO_1, benchIO "take-all x 4" $ takeAll4 size) - , (SpaceO_1, benchIO "takeWhile-true x 4" $ takeWhileTrue4 size) - , (SpaceO_1, benchIO "takeWhileM-true x 4" $ takeWhileMTrue4 size) - -- Multi-stream - , (SpaceO_1, benchIO "serial" $ serial2 (size `div` 2)) - , (SpaceO_1, benchIO "serial (2,2,x/4)" $ serial4 (size `div` 4)) - , (SpaceO_1, benchIO "zipWith" $ zipWith size) - , (SpaceO_1, benchIO "zipWithM" $ zipWithM size) - , (SpaceO_1, benchIO "concatMap" $ concatMap 2 (size `div` 2)) - , (SpaceO_1, benchIO "concatMap unfoldr outer=Max inner=1" $ - concatMapPure size 1) - , (SpaceO_1, benchIO "concatMap unfoldr outer=inner=(sqrt Max)" $ - concatMapPure sqrtVal sqrtVal) - , (SpaceO_1, benchIO "concatMap unfoldr outer=1 inner=Max" $ - concatMapPure 1 size) - , (SpaceO_1, benchIO "concatMap unfoldrM outer=max inner=1" $ - concatMap size 1) - , (SpaceO_1, benchIO "concatMap unfoldrM outer=inner=(sqrt Max)" $ - concatMap sqrtVal sqrtVal) - , (SpaceO_1, benchIO "concatMap unfoldrM outer=1 inner=Max" $ - concatMap 1 size) - -- Using boxed values/streams may have entirely different perf profile - , (SpaceO_1, benchIO "concatMap Streams fromPure outer=max inner=1" $ - concatMapSingletonStreams size) - , (SpaceO_1, benchIO "concatMap Streams unfoldr outer=max inner=1" $ - concatMapStreams size 1) - , (SpaceO_1, benchIO "concatMap Streams unfoldr outer=inner=(sqrt Max)" $ - concatMapStreams sqrtVal sqrtVal) - , (SpaceO_1, benchIO "concatMap Streams unfoldr outer=1 inner=Max" $ - concatMapStreams 1 size) - , (SpaceO_1, benchIO "concatMapM unfoldrM outer=max inner=1" $ - concatMapM size 1) - , (SpaceO_1, benchIO "concatMapM unfoldrM outer=inner=(sqrt Max)" $ - concatMapM sqrtVal sqrtVal) - , (SpaceO_1, benchIO "concatMapM unfoldrM outer=1 inner=Max" $ - concatMapM 1 size) - , (SpaceO_1, benchIO "concatMapM2 fromPure" $ concatMapM2 sqrtVal) - , (SpaceO_1, benchIO "concatMapM3 fromPure" $ concatMapM3 cubertVal) - , (SpaceO_1, benchIO "concatMapViaUnfoldEach outer=max inner=1" $ - concatMapViaUnfoldEach size 1) - , (SpaceO_1, benchIO "concatMapViaUnfoldEach outer=inner=(sqrt Max)" $ - concatMapViaUnfoldEach sqrtVal sqrtVal) - , (SpaceO_1, benchIO "concatMapViaUnfoldEach outer=1 inner=Max" $ - concatMapViaUnfoldEach 1 size) - , (SpaceO_1, benchIO "unfoldCross outer=max inner=1" $ unfoldCross size 1) - , (SpaceO_1, benchIO "unfoldCross outer=inner=(sqrt Max)" $ - unfoldCross sqrtVal sqrtVal) - , (SpaceO_1, benchIO "unfoldCross outer=1 inner=Max" $ unfoldCross 1 size) - -- concatMap vs unfoldEach - , (SpaceO_1, benchIO "unfoldEach outer=Max inner=1" $ unfoldEach size 1) - , (SpaceO_1, benchIO "unfoldEach outer=inner=(sqrt Max)" $ - unfoldEach sqrtVal sqrtVal) - , (SpaceO_1, benchIO "unfoldEach outer=1 inner=Max" $ unfoldEach 1 size) - , (SpaceO_1, benchIO "unfoldEach2 outer=Max inner=1" $ unfoldEach2 size 1) - , (SpaceO_1, benchIO "unfoldEach2 outer=inner=(sqrt Max)" $ - unfoldEach2 sqrtVal sqrtVal) - , (SpaceO_1, benchIO "unfoldEach2 outer=1 inner=Max" $ unfoldEach2 1 size) - , (SpaceO_1, benchIO "unfoldEach3 outer=inner=(cubert Max)" $ unfoldEach3 size) - , (SpaceO_1, benchIO "(*>)" $ withRandomIntIO (apDiscardFst size)) - , (SpaceO_1, benchIO "(<*)" $ withRandomIntIO (apDiscardSnd size)) - , (SpaceO_1, benchIO "(<*>)" $ withRandomIntIO (toNullAp size)) - , (SpaceO_1, benchIO "liftA2" $ withRandomIntIO (apLiftA2 size)) - , (SpaceO_1, benchIO "crossApply" $ crossApply size) - , (SpaceO_1, benchIO "crossApplyFst" $ crossApplyFst size) - , (SpaceO_1, benchIO "crossApplySnd" $ crossApplySnd size) - , (SpaceO_1, benchIO "pureDrain2" $ withRandomIntIO (toNullApPure size)) - , (SpaceO_1, benchIO "pureCross2" $ cross2 size) - , (SpaceO_1, benchIO "then2M" $ withRandomIntIO (monadThen size)) - , (SpaceO_1, benchIO "drain2M" $ withRandomIntIO (toNullM size)) - , (SpaceO_1, benchIO "drain3M" $ withRandomIntIO (toNullM3 size)) - , (SpaceO_1, benchIO "filterAllOut2M" $ withRandomIntIO (filterAllOutM size)) - , (SpaceO_1, benchIO "filterAllIn2M" $ withRandomIntIO (filterAllInM size)) - , (SpaceO_1, benchIO "filterSome2M" $ withRandomIntIO (filterSome size)) - , (SpaceO_1, benchIO "breakAfterSome2M" $ withRandomIntIO (breakAfterSome size)) - , (SpaceO_1, benchIO "pureDrain2M" $ withRandomIntIO (toNullMPure size)) - , (SpaceO_1, benchIO "pureDrain3M" $ withRandomIntIO (toNullM3Pure size)) - , (SpaceO_1, benchIO "pureFilterAllIn2M" $ withRandomIntIO (filterAllInMPure size)) - , (SpaceO_1, benchIO "pureFilterAllOut2M" $ withRandomIntIO (filterAllOutMPure size)) - , (SpaceO_n, benchIO "toList2M" $ withRandomIntIO (toListM size)) - , (SpaceO_n, benchIO "toListSome2M" $ withRandomIntIO (toListSome size)) - , (SpaceO_1, benchIO "concatFor/drain1" $ drainConcatFor1 size) - , (SpaceO_1, benchIO "concatFor/drain2" $ drainConcatFor sqrtVal) - , (SpaceO_1, benchIO "concatFor/drain3" $ drainConcatFor3 cubertVal) - , (SpaceO_1, benchIO "concatFor/drain4" $ drainConcatFor4 size4) - , (SpaceO_1, benchIO "concatFor/drain5" $ drainConcatFor5 size5) - , (SpaceO_1, benchIO "concatFor/drainM2" $ drainConcatForM sqrtVal) - , (SpaceO_1, benchIO "concatFor/drainM3" $ drainConcatFor3M cubertVal) - , (SpaceO_1, benchIO "concatFor/filterAllIn2" $ filterAllInConcatFor sqrtVal) - , (SpaceO_1, benchIO "concatFor/filterAllOut2" $ filterAllOutConcatFor sqrtVal) - -- Solve simultaneous equations by exploring all possibilities - , (SpaceO_1, benchIO "equations/concatFor (bounded)" $ - concatForBounded sqrtVal) - , (SpaceO_1, benchIO "equations/streamCross (bounded)" $ - streamCrossBounded sqrtVal) - , (SpaceO_1, benchIO "equations/fairStreamCross (bounded)" $ - fairStreamCrossBounded sqrtVal) - , (SpaceO_1, benchIO "equations/fairStreamCross (infinite)" $ - fairStreamCrossInfinite sqrtVal) - , (SpaceO_1, benchIO "equations/unfoldEach (bounded)" $ - unfoldEachBounded sqrtVal) - -- Fold Many - , (SpaceO_1, benchIO "foldMany" $ foldMany size) - , (SpaceO_1, benchIO "foldMany1" $ foldMany1 size) - , (SpaceO_1, benchIO "refoldMany" $ refoldMany size) - , (SpaceO_1, benchIO "refoldIterateM" $ refoldIterateM size) - ] - - where - - sqrtVal = round $ sqrt (fromIntegral size :: Double) -- double nested loop - cubertVal = round (fromIntegral size**(1/3::Double)) -- triple nested loop - size4 = round (fromIntegral size**(1/4::Double)) -- 4 times nested loop - size5 = round (fromIntegral size**(1/5::Double)) -- 5 times nested loop + Basic.benchmarks size + ++ MultiStream.benchmarks size + ++ Nested.benchmarks size + ++ Logic.benchmarks size diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Type/Basic.hs b/benchmark/Streamly/Benchmark/Data/Stream/Type/Basic.hs new file mode 100644 index 0000000000..67de33611e --- /dev/null +++ b/benchmark/Streamly/Benchmark/Data/Stream/Type/Basic.hs @@ -0,0 +1,927 @@ +-- | +-- Module : Stream.Type.Basic +-- Copyright : (c) 2018 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com + +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +#ifdef __HADDOCK_VERSION__ +#undef INSPECTION +#endif + +#ifdef INSPECTION +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} +#endif + +-- | Benchmarks for the basic stream operations: construction, the 'Foldable', +-- 'Show', 'Eq' and 'Ord' instances, reductions, mapping and filtering. This +-- module also hosts the low level benchmarking helpers shared by the other +-- @Stream.Type.*@ modules. +module Stream.Type.Basic + ( benchmarks + , benchIO + , withRandomIntIO + , withDrain + , withDrainPure + , withRandomInt + , withStream + , withPureStream + ) where + +#ifdef INSPECTION +import GHC.Types (SPEC(..)) +import Test.Inspection +import qualified Streamly.Internal.Data.Fold as FL +import qualified Streamly.Internal.Data.Producer as Producer +#endif + +import Control.Monad (when) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.DeepSeq (NFData(..)) +import Data.Functor ((<&>)) +import Data.Functor.Identity (Identity(..), runIdentity) +import Streamly.Internal.Data.Stream (Stream) +import System.Random (randomRIO) + +import qualified Data.Foldable as F +import qualified GHC.Exts as GHC + +import qualified Streamly.Internal.Data.Fold as Fold +import qualified Streamly.Internal.Data.Stream as S +import qualified Streamly.Internal.Data.Stream as Stream + +import Test.Tasty.Bench +import Stream.Common hiding (benchIO) +import Streamly.Benchmark.Common +import Prelude hiding (mapM) + +{-# INLINE benchIO #-} +benchIO :: NFData b => String -> IO b -> Benchmark +benchIO name = bench name . nfIO + +{-# INLINE withRandomIntIO #-} +withRandomIntIO :: (Int -> IO b) -> IO b +withRandomIntIO f = randomRIO (1, 1 :: Int) >>= f + +{-# INLINE withDrain #-} +withDrain :: (Int -> Stream IO a) -> IO () +withDrain f = withRandomIntIO $ \n -> drain (f n) + +{-# INLINE withDrainPure #-} +withDrainPure :: (Int -> Stream Identity a) -> IO () +withDrainPure f = withRandomIntIO $ \n -> return $! runIdentity $ drain (f n) + +{-# INLINE withRandomInt #-} +withRandomInt :: (Int -> b) -> IO b +withRandomInt f = randomRIO (1, 1 :: Int) <&> f + +{-# INLINE withStream #-} +withStream :: Int -> (Stream IO Int -> IO b) -> IO b +withStream value f = withRandomIntIO (f . sourceUnfoldrM value) + +{-# INLINE withPureStream #-} +withPureStream :: Int -> (Stream Identity Int -> b) -> IO b +withPureStream value f = randomRIO (1, 1) <&> (f . sourceUnfoldr value) +------------------------------------------------------------------------------- +-- fromList +------------------------------------------------------------------------------- + +sourceFromList :: Int -> IO () +sourceFromList value = withDrain $ \n -> Stream.fromList [n..n+value] + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'sourceFromList +inspect $ 'sourceFromList `hasNoType` ''Stream.Step +inspect $ 'sourceFromList `hasNoType` ''Fold.Step +inspect $ 'sourceFromList `hasNoType` ''SPEC +#endif + +-- | 'fromTuple' yields two elements per tuple. To emit and drain ~value +-- elements we generate value/2 tuples and reduce each tuple's 'fromTuple' +-- stream with a light 'sum' fold (avoiding a heavy, non-fusible 'concatMap' +-- that would mask the cost of 'fromTuple'). +sourceFromTuple :: Int -> IO () +sourceFromTuple value = withDrain $ \n -> + Stream.mapM (Stream.fold Fold.sum . Stream.fromTuple) + $ Stream.fromList (fmap (\i -> (i, i)) [n .. n + value `div` 2]) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'sourceFromTuple +inspect $ 'sourceFromTuple `hasNoType` ''Stream.Step +inspect $ 'sourceFromTuple `hasNoType` ''Producer.TupleState +inspect $ 'sourceFromTuple `hasNoType` ''Fold.Step +inspect $ 'sourceFromTuple `hasNoType` ''SPEC +#endif + +sourceIsList :: Int -> IO () +sourceIsList value = withDrainPure $ \n -> GHC.fromList [n..n+value] + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'sourceIsList +inspect $ 'sourceIsList `hasNoType` ''Stream.Step +inspect $ 'sourceIsList `hasNoType` ''Fold.Step +inspect $ 'sourceIsList `hasNoType` ''SPEC +#endif + +sourceIsString :: Int -> IO () +sourceIsString value = withDrainPure $ \n -> + GHC.fromString (Prelude.replicate (n + value) 'a') + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'sourceIsString +inspect $ 'sourceIsString `hasNoType` ''Stream.Step +inspect $ 'sourceIsString `hasNoType` ''Fold.Step +inspect $ 'sourceIsString `hasNoType` ''SPEC +#endif + +{-# INLINE readInstance #-} +readInstance :: String -> Stream Identity Int +readInstance str = + let r = reads str + in case r of + [(x,"")] -> x + _ -> error "readInstance: no parse" + +-- For comparisons +{-# INLINE readInstanceList #-} +readInstanceList :: String -> [Int] +readInstanceList str = + let r = reads str + in case r of + [(x,"")] -> x + _ -> error "readInstance: no parse" + +instance NFData a => NFData (Stream Identity a) where + {-# INLINE rnf #-} + rnf xs = runIdentity $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) xs + +------------------------------------------------------------------------------- +-- Foldable Instance +------------------------------------------------------------------------------- + +{-# INLINE foldableFoldl' #-} +foldableFoldl' :: Int -> Int -> Int +foldableFoldl' value n = + F.foldl' (+) 0 (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableFoldl' +inspect $ 'foldableFoldl' `hasNoType` ''Stream.Step +#endif + +{-# INLINE foldableFoldrElem #-} +foldableFoldrElem :: Int -> Int -> Bool +foldableFoldrElem value n = + F.foldr (\x xs -> x == value || xs) + False + (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableFoldrElem +inspect $ 'foldableFoldrElem `hasNoType` ''Stream.Step +inspect $ 'foldableFoldrElem `hasNoType` ''Fold.Step +inspect $ 'foldableFoldrElem `hasNoType` ''SPEC +#endif + +{-# INLINE foldableSum #-} +foldableSum :: Int -> Int -> Int +foldableSum value n = + Prelude.sum (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableSum +inspect $ 'foldableSum `hasNoType` ''Stream.Step +inspect $ 'foldableSum `hasNoType` ''Fold.Step +inspect $ 'foldableSum `hasNoType` ''SPEC +#endif + +{-# INLINE foldableProduct #-} +foldableProduct :: Int -> Int -> Int +foldableProduct value n = + Prelude.product (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableProduct +inspect $ 'foldableProduct `hasNoType` ''Stream.Step +inspect $ 'foldableProduct `hasNoType` ''Fold.Step +inspect $ 'foldableProduct `hasNoType` ''SPEC +#endif + +{-# INLINE _foldableNull #-} +_foldableNull :: Int -> Int -> Bool +_foldableNull value n = + Prelude.null (sourceUnfoldr value n :: Stream Identity Int) + +{-# INLINE foldableElem #-} +foldableElem :: Int -> Int -> Bool +foldableElem value n = + value `Prelude.elem` (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableElem +inspect $ 'foldableElem `hasNoType` ''Stream.Step +inspect $ 'foldableElem `hasNoType` ''Fold.Step +inspect $ 'foldableElem `hasNoType` ''SPEC +#endif + +{-# INLINE foldableNotElem #-} +foldableNotElem :: Int -> Int -> Bool +foldableNotElem value n = + value `Prelude.notElem` (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableNotElem +inspect $ 'foldableNotElem `hasNoType` ''Stream.Step +inspect $ 'foldableNotElem `hasNoType` ''Fold.Step +inspect $ 'foldableNotElem `hasNoType` ''SPEC +#endif + +{-# INLINE foldableFind #-} +foldableFind :: Int -> Int -> Maybe Int +foldableFind value n = + F.find (== (value + 1)) (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableFind +inspect $ 'foldableFind `hasNoType` ''Stream.Step +inspect $ 'foldableFind `hasNoType` ''Fold.Step +inspect $ 'foldableFind `hasNoType` ''SPEC +#endif + +{-# INLINE foldableAll #-} +foldableAll :: Int -> Int -> Bool +foldableAll value n = + Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableAll +inspect $ 'foldableAll `hasNoType` ''Stream.Step +inspect $ 'foldableAll `hasNoType` ''Fold.Step +inspect $ 'foldableAll `hasNoType` ''SPEC +#endif + +{- HLINT ignore "Use any"-} +{-# INLINE foldableAny #-} +foldableAny :: Int -> Int -> Bool +foldableAny value n = + Prelude.any (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableAny +inspect $ 'foldableAny `hasNoType` ''Stream.Step +inspect $ 'foldableAny `hasNoType` ''Fold.Step +inspect $ 'foldableAny `hasNoType` ''SPEC +#endif + +{- HLINT ignore "Use all"-} +{-# INLINE foldableAnd #-} +foldableAnd :: Int -> Int -> Bool +foldableAnd value n = + Prelude.and $ fmap + (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableAnd +inspect $ 'foldableAnd `hasNoType` ''Stream.Step +inspect $ 'foldableAnd `hasNoType` ''Fold.Step +inspect $ 'foldableAnd `hasNoType` ''SPEC +#endif + +{- HLINT ignore "Use any"-} +{-# INLINE foldableOr #-} +foldableOr :: Int -> Int -> Bool +foldableOr value n = + Prelude.or $ fmap + (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableOr +inspect $ 'foldableOr `hasNoType` ''Stream.Step +inspect $ 'foldableOr `hasNoType` ''Fold.Step +inspect $ 'foldableOr `hasNoType` ''SPEC +#endif + +{-# INLINE foldableLength #-} +foldableLength :: Int -> Int -> Int +foldableLength value n = + Prelude.length (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableLength +inspect $ 'foldableLength `hasNoType` ''Stream.Step +inspect $ 'foldableLength `hasNoType` ''Fold.Step +inspect $ 'foldableLength `hasNoType` ''SPEC +#endif + +{-# INLINE foldableMin #-} +foldableMin :: Int -> Int -> Int +foldableMin value n = + Prelude.minimum (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableMin +inspect $ 'foldableMin `hasNoType` ''Stream.Step +inspect $ 'foldableMin `hasNoType` ''Fold.Step +inspect $ 'foldableMin `hasNoType` ''SPEC +#endif + +{-# INLINE ordInstanceMin #-} +ordInstanceMin :: Int -> Int -> () +ordInstanceMin value n = + let src = sourceUnfoldr value n + in runIdentity $ drain $ min src src + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'ordInstanceMin +inspect $ 'ordInstanceMin `hasNoType` ''Stream.Step +inspect $ 'ordInstanceMin `hasNoType` ''Fold.Step +inspect $ 'ordInstanceMin `hasNoType` ''SPEC +#endif + +{-# INLINE foldableMax #-} +foldableMax :: Int -> Int -> Int +foldableMax value n = + Prelude.maximum (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableMax +inspect $ 'foldableMax `hasNoType` ''Stream.Step +inspect $ 'foldableMax `hasNoType` ''Fold.Step +inspect $ 'foldableMax `hasNoType` ''SPEC +#endif + +{-# INLINE foldableMinBy #-} +foldableMinBy :: Int -> Int -> Int +foldableMinBy value n = + F.minimumBy compare (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableMinBy +inspect $ 'foldableMinBy `hasNoType` ''Stream.Step +inspect $ 'foldableMinBy `hasNoType` ''Fold.Step +inspect $ 'foldableMinBy `hasNoType` ''SPEC +#endif + +{-# INLINE foldableListMinBy #-} +foldableListMinBy :: Int -> Int -> Int +foldableListMinBy value n = F.minimumBy compare [1..value+n] + +{-# INLINE foldableMaxBy #-} +foldableMaxBy :: Int -> Int -> Int +foldableMaxBy value n = + F.maximumBy compare (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableMaxBy +inspect $ 'foldableMaxBy `hasNoType` ''Stream.Step +inspect $ 'foldableMaxBy `hasNoType` ''Fold.Step +inspect $ 'foldableMaxBy `hasNoType` ''SPEC +#endif + +{-# INLINE foldableToList #-} +foldableToList :: Int -> Int -> [Int] +foldableToList value n = + F.toList (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableToList +inspect $ 'foldableToList `hasNoType` ''Stream.Step +inspect $ 'foldableToList `hasNoType` ''Fold.Step +inspect $ 'foldableToList `hasNoType` ''SPEC +#endif + +{-# INLINE foldableMapM_ #-} +foldableMapM_ :: Int -> Int -> IO () +foldableMapM_ value n = + F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: Stream Identity Int) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableMapM_ +inspect $ 'foldableMapM_ `hasNoType` ''Stream.Step +inspect $ 'foldableMapM_ `hasNoType` ''Fold.Step +inspect $ 'foldableMapM_ `hasNoType` ''SPEC +#endif + +{-# INLINE foldableSequence_ #-} +foldableSequence_ :: Int -> Int -> IO () +foldableSequence_ value n = + F.sequence_ (sourceUnfoldrAction value n :: Stream Identity (IO Int)) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldableSequence_ +inspect $ 'foldableSequence_ `hasNoType` ''Stream.Step +inspect $ 'foldableSequence_ `hasNoType` ''Fold.Step +inspect $ 'foldableSequence_ `hasNoType` ''SPEC +#endif + +{-# INLINE _foldableMsum #-} +_foldableMsum :: Int -> Int -> IO Int +_foldableMsum value n = + F.msum (sourceUnfoldrAction value n :: Stream Identity (IO Int)) + +------------------------------------------------------------------------------- +-- Show instance +------------------------------------------------------------------------------- + +showInstance :: Int -> IO String +showInstance value = withPureStream value show + +{-# INLINE showInstanceList #-} +showInstanceList :: [Int] -> String +showInstanceList = show + +------------------------------------------------------------------------------- +-- Eq and Ord instances +------------------------------------------------------------------------------- + +eqInstance :: Int -> IO Bool +eqInstance value = withPureStream value $ \src -> src == src + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'eqInstance +inspect $ 'eqInstance `hasNoType` ''Stream.Step +inspect $ 'eqInstance `hasNoType` ''Fold.Step +inspect $ 'eqInstance `hasNoType` ''SPEC +#endif + +eqInstanceNotEq :: Int -> IO Bool +eqInstanceNotEq value = withPureStream value $ \src -> src /= src + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'eqInstanceNotEq +inspect $ 'eqInstanceNotEq `hasNoType` ''Stream.Step +inspect $ 'eqInstanceNotEq `hasNoType` ''Fold.Step +inspect $ 'eqInstanceNotEq `hasNoType` ''SPEC +#endif + +ordInstance :: Int -> IO Bool +ordInstance value = withPureStream value $ \src -> src < src + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'ordInstance +inspect $ 'ordInstance `hasNoType` ''Stream.Step +inspect $ 'ordInstance `hasNoType` ''Fold.Step +inspect $ 'ordInstance `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Reductions +------------------------------------------------------------------------------- + +uncons :: Int -> IO () +uncons value = withStream value go + + where + + go s = do + r <- S.uncons s + case r of + Nothing -> return () + Just (_, t) -> go t + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'uncons +-- inspect $ 'uncons `hasNoType` ''S.Step +inspect $ 'uncons `hasNoType` ''Fold.Step +inspect $ 'uncons `hasNoType` ''SPEC +#endif + +foldBreak :: Int -> IO () +foldBreak value = withStream value go + + where + + go s = do + (r, s1) <- S.foldBreak (Fold.take 1 Fold.length) s + when (r /= 0) $ go s1 + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldBreak +-- inspect $ 'foldBreak `hasNoType` ''S.Step +inspect $ 'foldBreak `hasNoType` ''Fold.Step +inspect $ 'foldBreak `hasNoType` ''SPEC +#endif + +foldrMElem :: Int -> IO Bool +foldrMElem value = + withStream value + (S.foldrM + (\x xs -> if x == value then return True else xs) + (return False)) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldrMElem +inspect $ 'foldrMElem `hasNoType` ''S.Step +inspect $ 'foldrMElem `hasNoType` ''Fold.Step +inspect $ 'foldrMElem `hasNoType` ''SPEC +#endif + +foldrMElemIdentity :: Int -> IO Bool +foldrMElemIdentity value = + withPureStream value $ + runIdentity . S.foldrM + (\x xs -> if x == value then return True else xs) + (return False) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldrMElemIdentity +inspect $ 'foldrMElemIdentity `hasNoType` ''S.Step +inspect $ 'foldrMElemIdentity `hasNoType` ''Fold.Step +inspect $ 'foldrMElemIdentity `hasNoType` ''SPEC +#endif + +foldrMToList :: Int -> IO [Int] +foldrMToList value = + withStream value $ S.foldrM (\x xs -> (x :) <$> xs) (return []) + +foldrMToListIdentity :: Int -> IO [Int] +foldrMToListIdentity value = + withPureStream value + (runIdentity . S.foldrM (\x xs -> (x :) <$> xs) (return [])) + +foldl'Reduce :: Int -> IO Int +foldl'Reduce value = withStream value (S.foldl' (+) 0) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldl'Reduce +inspect $ 'foldl'Reduce `hasNoType` ''S.Step +#endif + +foldl'ReduceIdentity :: Int -> IO Int +foldl'ReduceIdentity value = + withPureStream value $ runIdentity . S.foldl' (+) 0 + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldl'ReduceIdentity +inspect $ 'foldl'ReduceIdentity `hasNoType` ''S.Step +#endif + +foldlM'Reduce :: Int -> IO Int +foldlM'Reduce value = + withStream value (S.foldlM' (\xs a -> return $ a + xs) (return 0)) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldlM'Reduce +inspect $ 'foldlM'Reduce `hasNoType` ''S.Step +#endif + +foldlM'ReduceIdentity :: Int -> IO Int +foldlM'ReduceIdentity value = + withPureStream value $ + runIdentity . S.foldlM' (\xs a -> return $ a + xs) (return 0) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldlM'ReduceIdentity +inspect $ 'foldlM'ReduceIdentity `hasNoType` ''S.Step +#endif + +toNull :: Int -> IO () +toNull value = withStream value S.drain + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'toNull +inspect $ 'toNull `hasNoType` ''Stream.Step +inspect $ 'toNull `hasNoType` ''Fold.Step +inspect $ 'toNull `hasNoType` ''SPEC +#endif + +drainPure :: Int -> IO () +drainPure value = withPureStream value $ runIdentity . drain + +drainN :: Int -> IO () +drainN value = withStream value (S.fold (Fold.drainN value)) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'drainN +inspect $ 'drainN `hasNoType` ''S.Step +inspect $ 'drainN `hasNoType` ''Fold.Step +inspect $ 'drainN `hasNoType` ''SPEC +#endif + +foldl'Build :: Int -> IO [Int] +foldl'Build value = withStream value (S.foldl' (flip (:)) []) + +foldl'BuildIdentity :: Int -> IO [Int] +foldl'BuildIdentity value = + withPureStream value (runIdentity . S.foldl' (flip (:)) []) + +foldlM'Build :: Int -> IO [Int] +foldlM'Build value = + withStream value (S.foldlM' (\xs x -> return $ x : xs) (return [])) + +foldlM'BuildIdentity :: Int -> IO [Int] +foldlM'BuildIdentity value = + withPureStream value + (runIdentity . S.foldlM' (\xs x -> return $ x : xs) (return [])) + +foldrMToSum :: Int -> IO Int +foldrMToSum value = + withStream value (S.foldrM (\x xs -> (x +) <$> xs) (return 0)) + +foldrMToSumIdentity :: Int -> IO Int +foldrMToSumIdentity value = + withPureStream value + (runIdentity . S.foldrM (\x xs -> (x +) <$> xs) (return 0)) + +toList' :: Int -> IO [Int] +toList' value = withStream value S.toList + +eqByPure :: Int -> IO Bool +eqByPure value = + withPureStream value $ \src -> runIdentity $ S.eqBy (==) src src + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'eqByPure +inspect $ 'eqByPure `hasNoType` ''SPEC +inspect $ 'eqByPure `hasNoType` ''S.Step +inspect $ 'eqByPure `hasNoType` ''Fold.Step +#endif + +cmpByPure :: Int -> IO Ordering +cmpByPure value = + withPureStream value $ \src -> runIdentity $ S.cmpBy compare src src + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'cmpByPure +inspect $ 'cmpByPure `hasNoType` ''SPEC +inspect $ 'cmpByPure `hasNoType` ''S.Step +inspect $ 'cmpByPure `hasNoType` ''Fold.Step +#endif + +eqBy :: Int -> IO Bool +eqBy value = withStream value $ \src -> S.eqBy (==) src src + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'eqBy +inspect $ 'eqBy `hasNoType` ''SPEC +inspect $ 'eqBy `hasNoType` ''S.Step +inspect $ 'eqBy `hasNoType` ''Fold.Step +#endif + +cmpBy :: Int -> IO Ordering +cmpBy value = withStream value $ \src -> S.cmpBy compare src src + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'cmpBy +inspect $ 'cmpBy `hasNoType` ''SPEC +inspect $ 'cmpBy `hasNoType` ''S.Step +inspect $ 'cmpBy `hasNoType` ''Fold.Step +#endif + +------------------------------------------------------------------------------- +-- Mapping +------------------------------------------------------------------------------- + +{-# INLINE mapN #-} +mapN :: Monad m => Int -> Stream m Int -> m () +mapN n = composeN n $ fmap (+ 1) + +{-# INLINE mapM #-} +mapM :: MonadAsync m => Int -> Stream m Int -> m () +mapM n = composeN n $ Stream.mapM return + +map1 :: Int -> IO () +map1 value = withStream value (mapN 1) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'map1 +inspect $ 'map1 `hasNoType` ''Stream.Step +inspect $ 'map1 `hasNoType` ''FL.Step +inspect $ 'map1 `hasNoType` ''SPEC +#endif + +mapM1 :: Int -> IO () +mapM1 value = withStream value (mapM 1) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'mapM1 +inspect $ 'mapM1 `hasNoType` ''Stream.Step +inspect $ 'mapM1 `hasNoType` ''FL.Step +inspect $ 'mapM1 `hasNoType` ''SPEC +#endif + +mapN4 :: Int -> IO () +mapN4 value = withStream value (mapN 4) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'mapN4 +inspect $ 'mapN4 `hasNoType` ''Stream.Step +inspect $ 'mapN4 `hasNoType` ''FL.Step +inspect $ 'mapN4 `hasNoType` ''SPEC +#endif + +mapM4 :: Int -> IO () +mapM4 value = withStream value (mapM 4) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'mapM4 +inspect $ 'mapM4 `hasNoType` ''Stream.Step +inspect $ 'mapM4 `hasNoType` ''FL.Step +inspect $ 'mapM4 `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Filtering +------------------------------------------------------------------------------- + +{-# INLINE _takeOne #-} +_takeOne :: MonadIO m => Int -> Stream m Int -> m () +_takeOne n = composeN n $ Stream.take 1 + +{-# INLINE takeAll #-} +takeAll :: MonadIO m => Int -> Int -> Stream m Int -> m () +takeAll value n = composeN n $ Stream.take (value + 1) + +takeAll1 :: Int -> IO () +takeAll1 value = withStream value (takeAll value 1) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'takeAll1 +inspect $ 'takeAll1 `hasNoType` ''Stream.Step +inspect $ 'takeAll1 `hasNoType` ''FL.Step +inspect $ 'takeAll1 `hasNoType` ''SPEC +#endif + +takeAll4 :: Int -> IO () +takeAll4 value = withStream value (takeAll value 4) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'takeAll4 +inspect $ 'takeAll4 `hasNoType` ''Stream.Step +inspect $ 'takeAll4 `hasNoType` ''FL.Step +inspect $ 'takeAll4 `hasNoType` ''SPEC +#endif + +{-# INLINE takeWhileTrue #-} +takeWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m () +takeWhileTrue value n = composeN n $ Stream.takeWhile (<= (value + 1)) + +takeWhileTrue1 :: Int -> IO () +takeWhileTrue1 value = withStream value (takeWhileTrue value 1) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'takeWhileTrue1 +inspect $ 'takeWhileTrue1 `hasNoType` ''Stream.Step +inspect $ 'takeWhileTrue1 `hasNoType` ''FL.Step +inspect $ 'takeWhileTrue1 `hasNoType` ''SPEC +#endif + +takeWhileTrue4 :: Int -> IO () +takeWhileTrue4 value = withStream value (takeWhileTrue value 4) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'takeWhileTrue4 +inspect $ 'takeWhileTrue4 `hasNoType` ''Stream.Step +inspect $ 'takeWhileTrue4 `hasNoType` ''FL.Step +inspect $ 'takeWhileTrue4 `hasNoType` ''SPEC +#endif + +{-# INLINE takeWhileMTrue #-} +takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m () +takeWhileMTrue value n = composeN n $ Stream.takeWhileM (return . (<= (value + 1))) + +takeWhileMTrue4 :: Int -> IO () +takeWhileMTrue4 value = withStream value (takeWhileMTrue value 4) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'takeWhileMTrue4 +inspect $ 'takeWhileMTrue4 `hasNoType` ''Stream.Step +inspect $ 'takeWhileMTrue4 `hasNoType` ''FL.Step +inspect $ 'takeWhileMTrue4 `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Benchmarks +------------------------------------------------------------------------------- + +{-# ANN benchmarks "HLint: ignore" #-} +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + -- Construction + [ (SpaceO_1, benchIO "fromList" $ sourceFromList size) + , (SpaceO_1, benchIO "fromTuple" $ sourceFromTuple size) + , (SpaceO_1, benchIO "IsList.fromList" $ sourceIsList size) + , (SpaceO_1, benchIO "IsString.fromString" $ sourceIsString size) + -- Buffers the output of show/read. + -- XXX can the outputs be streaming? Can we have special read/show + -- style type classes, readM/showM supporting streaming effects? + , (HeapO_n, bench "readsPrec pure streams" $ + nf (readInstance . mkString) size) + , (HeapO_n, bench "readsPrec Haskell lists" $ + nf (readInstanceList . mkListString) size) + + -- Elimination/Foldable instance + , (SpaceO_1, benchIO "Foldable/foldl'" $ withRandomInt (foldableFoldl' size)) + , (SpaceO_1, benchIO "Foldable/foldrElem" $ withRandomInt (foldableFoldrElem size)) + -- , (SpaceO_1, benchIO "Foldable/null" $ withRandomInt (_foldableNull size)) + , (SpaceO_1, benchIO "Foldable/elem" $ withRandomInt (foldableElem size)) + , (SpaceO_1, benchIO "Foldable/length" $ withRandomInt (foldableLength size)) + , (SpaceO_1, benchIO "Foldable/sum" $ withRandomInt (foldableSum size)) + , (SpaceO_1, benchIO "Foldable/product" $ withRandomInt (foldableProduct size)) + , (SpaceO_1, benchIO "Foldable/minimum" $ withRandomInt (foldableMin size)) + , (SpaceO_1, benchIO "Foldable/min (ord)" $ withRandomInt (ordInstanceMin size)) + , (SpaceO_1, benchIO "Foldable/maximum" $ withRandomInt (foldableMax size)) + , (SpaceO_1, benchIO "Foldable/minimumBy" $ withRandomInt (foldableMinBy size)) + , (SpaceO_1, benchIO "Foldable/maximumBy" $ withRandomInt (foldableMaxBy size)) + , (SpaceO_1, benchIO "Foldable/minimumByList" $ withRandomInt (foldableListMinBy size)) + , (SpaceO_1, benchIO "Foldable/length . toList" $ + withRandomInt (Prelude.length . foldableToList size)) + , (SpaceO_1, benchIO "Foldable/notElem" $ withRandomInt (foldableNotElem size)) + , (SpaceO_1, benchIO "Foldable/find" $ withRandomInt (foldableFind size)) + , (SpaceO_1, benchIO "Foldable/all" $ withRandomInt (foldableAll size)) + , (SpaceO_1, benchIO "Foldable/any" $ withRandomInt (foldableAny size)) + , (SpaceO_1, benchIO "Foldable/and" $ withRandomInt (foldableAnd size)) + , (SpaceO_1, benchIO "Foldable/or" $ withRandomInt (foldableOr size)) + + -- Applicative and Traversable operations + -- TBD: traverse_ + , (SpaceO_1, benchIO "Foldable/mapM_" $ withRandomIntIO (foldableMapM_ size)) + -- TBD: for_ + -- TBD: forM_ + , (SpaceO_1, benchIO "Foldable/sequence_" $ withRandomIntIO (foldableSequence_ size)) + -- TBD: sequenceA_ + -- TBD: asum + -- XXX needs to be fixed, results are in ns + -- , (SpaceO_1, benchIOSink1 "Foldable/msum" (foldableMsum size)) + + -- Elimination/folds + , (SpaceO_1, benchIO "foldl'/IO" $ foldl'Reduce size) + , (SpaceO_1, benchIO "foldlM'/IO" $ foldlM'Reduce size) + , (SpaceO_1, benchIO "foldl'/Identity" $ foldl'ReduceIdentity size) + , (SpaceO_1, benchIO "foldlM'/Identity" $ foldlM'ReduceIdentity size) + , (SpaceO_1, benchIO "foldrMElem/IO" $ foldrMElem size) + , (SpaceO_1, benchIO "foldrMElem/Identity" $ foldrMElemIdentity size) + , (SpaceO_1, benchIO "foldrMToList" $ foldrMToListIdentity size) + + -- Left folds for building a structure are inherently non-streaming + -- as the structure cannot be lazily consumed until fully built. + , (HeapO_n, benchIO "foldl'/build/IO" $ foldl'Build size) + , (HeapO_n, benchIO "foldl'/build/Identity" $ foldl'BuildIdentity size) + , (HeapO_n, benchIO "foldlM'/build/IO" $ foldlM'Build size) + , (HeapO_n, benchIO "foldlM'/build/Identity" $ foldlM'BuildIdentity size) + + -- Head recursive strict right folds. + -- accumulation due to strictness of IO monad + , (SpaceO_n, benchIO "foldrM/build/IO (toList)" $ foldrMToList size) + -- Right folds for reducing are inherently non-streaming as the + -- expression needs to be fully built before it can be reduced. + , (SpaceO_n, benchIO "foldrM/reduce/Identity (sum)" $ foldrMToSumIdentity size) + , (SpaceO_n, benchIO "foldrM/reduce/IO (sum)" $ foldrMToSum size) + -- Converting the stream to a list or pure stream in a strict monad + , (SpaceO_n, benchIO "toList" $ toList' size) + + -- this is too fast, causes all benchmarks reported in ns + -- , (SpaceO_1, benchIO "null" $ ...) + + -- deconstruction + , (SpaceO_1, benchIO "uncons" $ uncons size) + , (SpaceO_1, benchIO "foldBreak" $ foldBreak size) + + -- draining + , (SpaceO_1, benchIO "toNull" $ toNull size) + , (SpaceO_1, benchIO "drainN" $ drainN size) + , (SpaceO_1, benchIO "drain (pure)" $ drainPure size) + + -- length is used to check for foldr/build fusion + , (SpaceO_1, benchIO "length . IsList.toList" $ + withPureStream size (Prelude.length . GHC.toList)) + + -- Buffers the output of show/read. + -- XXX can the outputs be streaming? Can we have special read/show + -- style type classes, readM/showM supporting streaming effects? + , (HeapO_n, bench "showsPrec Haskell lists" $ nf showInstanceList (mkList size)) + -- XXX This is not o-1-space for GHC-8.10 + , (HeapO_n, benchIO "showsPrec pure streams" $ showInstance size) + + , (SpaceO_1, benchIO "==" $ eqInstance size) + , (SpaceO_1, benchIO "/=" $ eqInstanceNotEq size) + , (SpaceO_1, benchIO "<" $ ordInstance size) + , (SpaceO_1, benchIO "eqBy (pure)" $ eqByPure size) + , (SpaceO_1, benchIO "cmpBy (pure)" $ cmpByPure size) + , (SpaceO_1, benchIO "eqBy" $ eqBy size) + , (SpaceO_1, benchIO "cmpBy" $ cmpBy size) + + -- Mapping + , (SpaceO_1, benchIO "fmap" $ map1 size) + , (SpaceO_1, benchIO "fmap x 4" $ mapN4 size) + , (SpaceO_1, benchIO "map" $ map1 size) + , (SpaceO_1, benchIO "mapM" $ mapM1 size) + , (SpaceO_1, benchIO "map x 4" $ mapN4 size) + , (SpaceO_1, benchIO "mapM x 4" $ mapM4 size) + + -- Trimming + , (SpaceO_1, benchIO "take-all" $ takeAll1 size) + , (SpaceO_1, benchIO "takeWhile-true" $ takeWhileTrue1 size) + -- , (SpaceO_1, benchIO "takeWhileM-true" ...) + , (SpaceO_1, benchIO "take-all x 4" $ takeAll4 size) + , (SpaceO_1, benchIO "takeWhile-true x 4" $ takeWhileTrue4 size) + , (SpaceO_1, benchIO "takeWhileM-true x 4" $ takeWhileMTrue4 size) + ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Type/Logic.hs b/benchmark/Streamly/Benchmark/Data/Stream/Type/Logic.hs new file mode 100644 index 0000000000..5ab5dfaf55 --- /dev/null +++ b/benchmark/Streamly/Benchmark/Data/Stream/Type/Logic.hs @@ -0,0 +1,159 @@ +-- | +-- Module : Stream.Type.Logic +-- Copyright : (c) 2018 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com + +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} + +-- | Logic programming style benchmarks: solving simultaneous equations by +-- exploring all possibilities using the cross product combinators. +module Stream.Type.Logic + ( benchmarks + , boundedInts + , infiniteInts + , boundedIntsUnfold + , checkStream + , checkPair + , result + ) where + +import Streamly.Internal.Data.Stream (Stream) +import Streamly.Data.Unfold (Unfold) + +import qualified Streamly.Internal.Data.Fold as Fold +import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.Unfold as Unfold + +import Test.Tasty.Bench +import Stream.Type.Basic (benchIO, withRandomIntIO) +import Streamly.Benchmark.Common +import Prelude hiding (concatMap, mapM, zipWith) + +-- search space |x| = 1000, |y| = 1000 +{-# INLINE boundedInts #-} +boundedInts :: Monad m => Int -> Int -> Stream m Int +boundedInts n _ = + Stream.interleave + (Stream.enumerateFromTo (0 :: Int) n) + (Stream.enumerateFromThenTo (-1) (-2) (-n)) + +{-# INLINE infiniteInts #-} +infiniteInts :: Monad m => Int -> Int -> Stream m Int +infiniteInts _ _ = + Stream.interleave + (Stream.enumerateFrom (0 :: Int)) + (Stream.enumerateFromThen (-1) (-2)) + +{-# INLINE boundedIntsUnfold #-} +boundedIntsUnfold :: Monad m => Int -> Int -> Unfold m ((), ()) Int +boundedIntsUnfold n _ = + Unfold.interleave + (Unfold.supply (0 :: Int, n) Unfold.enumerateFromTo) + (Unfold.supply (-1, -2, -n) Unfold.enumerateFromThenTo) + +{-# INLINE checkStream #-} +checkStream :: Applicative m => + Int -> Int -> Int -> Stream m (Maybe (Maybe (Int, Int))) +checkStream maxVal x y = + let eq1 = x + y == 0 + eq2 = x - y == 2 * maxVal + in if eq1 && eq2 + then Stream.fromPure (Just (Just (x,y))) + else if abs x > maxVal && abs y > maxVal + then Stream.fromPure (Just Nothing) + else Stream.fromPure Nothing + +{-# INLINE checkPair #-} +checkPair :: Monad m => Int -> (Int, Int) -> m (Maybe (Maybe (Int, Int))) +checkPair maxVal (x, y) = + let eq1 = x + y == 0 + eq2 = x - y == 2 * maxVal + in if eq1 && eq2 + then pure (Just (Just (x,y))) + else if abs x > maxVal && abs y > maxVal + then pure (Just Nothing) + else pure Nothing + +-- Terminate the stream as soon as we get a Just value +{-# INLINE result #-} +result :: Monad m => Stream m (Maybe a) -> m () +result = Stream.fold (Fold.take 1 Fold.drain) . Stream.catMaybes + +{-# INLINE concatForEqn #-} +concatForEqn :: Monad m => Int -> Stream m Int -> m () +concatForEqn maxVal input = + result + $ Stream.concatFor input $ \x -> + Stream.concatForM input $ \y -> do + return $ checkStream maxVal x y + +{-# INLINE streamCrossEqn #-} +streamCrossEqn :: Monad m => Int -> Stream m Int -> m () +streamCrossEqn maxVal input = + result + $ Stream.mapM (checkPair maxVal) + $ Stream.cross input input + +{-# INLINE fairStreamCrossEqn #-} +fairStreamCrossEqn :: Monad m => Int -> Stream m Int -> m () +fairStreamCrossEqn maxVal input = + result + $ Stream.mapM (checkPair maxVal) + $ Stream.fairCross input input + +{-# INLINE unfoldEachEqn #-} +unfoldEachEqn :: Monad m => Int -> Unfold m ((), ()) Int -> Stream m Int -> m () +unfoldEachEqn maxVal input ints = + let intu = Unfold.carryInput $ Unfold.lmap (const (undefined, undefined)) input + in result + $ Stream.mapM (checkPair maxVal) + $ Stream.unfoldEach intu ints + +concatForBounded :: Int -> IO () +concatForBounded maxVal = withRandomIntIO $ \n -> + concatForEqn maxVal (boundedInts maxVal n) + +streamCrossBounded :: Int -> IO () +streamCrossBounded maxVal = withRandomIntIO $ \n -> + streamCrossEqn maxVal (boundedInts maxVal n) + +fairStreamCrossBounded :: Int -> IO () +fairStreamCrossBounded maxVal = withRandomIntIO $ \n -> + fairStreamCrossEqn maxVal (boundedInts maxVal n) + +fairStreamCrossInfinite :: Int -> IO () +fairStreamCrossInfinite maxVal = withRandomIntIO $ \n -> + fairStreamCrossEqn maxVal (infiniteInts maxVal n) + +unfoldEachBounded :: Int -> IO () +unfoldEachBounded maxVal = withRandomIntIO $ \n -> + unfoldEachEqn maxVal (boundedIntsUnfold maxVal 0) (boundedInts maxVal n) + +------------------------------------------------------------------------------- +-- Benchmarks +------------------------------------------------------------------------------- + +{-# ANN benchmarks "HLint: ignore" #-} +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + -- Logic Programming + -- Solve simultaneous equations by exploring all possibilities + [ (SpaceO_1, benchIO "equations/concatFor (bounded)" $ + concatForBounded sqrtVal) + , (SpaceO_1, benchIO "equations/streamCross (bounded)" $ + streamCrossBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairStreamCross (bounded)" $ + fairStreamCrossBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairStreamCross (infinite)" $ + fairStreamCrossInfinite sqrtVal) + , (SpaceO_1, benchIO "equations/unfoldEach (bounded)" $ + unfoldEachBounded sqrtVal) + ] + + where + + sqrtVal = round $ sqrt (fromIntegral size :: Double) -- double nested loop diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Type/MultiStream.hs b/benchmark/Streamly/Benchmark/Data/Stream/Type/MultiStream.hs new file mode 100644 index 0000000000..3cee23c294 --- /dev/null +++ b/benchmark/Streamly/Benchmark/Data/Stream/Type/MultiStream.hs @@ -0,0 +1,422 @@ +-- | +-- Module : Stream.Type.MultiStream +-- Copyright : (c) 2018 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com + +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} + +#ifdef __HADDOCK_VERSION__ +#undef INSPECTION +#endif + +#ifdef INSPECTION +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} +#endif + +-- | Benchmarks for operations combining multiple streams: appending, zipping, +-- @concatMap@\/@unfoldEach@ style flattening and the @foldMany@ family. +module Stream.Type.MultiStream + ( benchmarks + ) where + +#ifdef INSPECTION +import GHC.Types (SPEC(..)) +import Test.Inspection +import qualified Streamly.Internal.Data.Fold as Fold +import qualified Streamly.Internal.Data.Producer as Producer +#endif + +import Data.Monoid (Sum(..)) +import Streamly.Internal.Data.Stream (Stream) +import Streamly.Data.Unfold (Unfold) + +import qualified Streamly.Internal.Data.Fold as FL +import qualified Streamly.Internal.Data.Refold.Type as Refold +import qualified Streamly.Internal.Data.Stream as S +import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.Unfold as UF + +import Test.Tasty.Bench +import qualified Stream.Common as Common +import Stream.Common hiding (benchIO) +import Stream.Type.Basic (benchIO, withRandomIntIO, withStream) +import Streamly.Benchmark.Common +import Prelude hiding (concatMap, zipWith) + +------------------------------------------------------------------------------- +-- Multi-stream +------------------------------------------------------------------------------- + +------------------------------------------------------------------------------- +-- Appending +------------------------------------------------------------------------------- + +serial2 :: Int -> IO () +serial2 count = withRandomIntIO $ \n -> + drain $ + Common.append + (sourceUnfoldrM count n) + (sourceUnfoldrM count (n + 1)) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'serial2 +inspect $ 'serial2 `hasNoType` ''SPEC +inspect $ 'serial2 `hasNoType` ''S.AppendState +inspect $ 'serial2 `hasNoType` ''S.Step +inspect $ 'serial2 `hasNoType` ''Fold.Step +#endif + +serial4 :: Int -> IO () +serial4 count = withRandomIntIO $ \n -> + drain $ + Common.append + (Common.append + (sourceUnfoldrM count n) + (sourceUnfoldrM count (n + 1))) + (Common.append + (sourceUnfoldrM count (n + 2)) + (sourceUnfoldrM count (n + 3))) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'serial4 +inspect $ 'serial4 `hasNoType` ''SPEC +inspect $ 'serial4 `hasNoType` ''S.AppendState +inspect $ 'serial4 `hasNoType` ''S.Step +inspect $ 'serial4 `hasNoType` ''Fold.Step +#endif + +------------------------------------------------------------------------------- +-- Zipping +------------------------------------------------------------------------------- + +zipWith :: Int -> IO () +zipWith value = withRandomIntIO $ \n -> + let src = sourceUnfoldrM value n + in drain $ S.zipWith (,) src src + +#ifdef INSPECTION +inspect $ 'zipWith `hasNoType` ''SPEC +-- inspect $ 'zipWith `hasNoType` ''S.Step +inspect $ 'zipWith `hasNoType` ''Fold.Step +#endif + +zipWithM :: Int -> IO () +zipWithM value = withRandomIntIO $ \n -> + let src = sourceUnfoldrM value n + in drain $ S.zipWithM (curry return) src src + +#ifdef INSPECTION +inspect $ 'zipWithM `hasNoType` ''SPEC +-- inspect $ 'zipWithM `hasNoType` ''S.Step +inspect $ 'zipWithM `hasNoType` ''Fold.Step +#endif + +------------------------------------------------------------------------------- +-- Concat +------------------------------------------------------------------------------- + +{-# INLINE sourceConcatMapSingletonStreams #-} +sourceConcatMapSingletonStreams :: Monad m => Int -> Int -> Stream m (Stream m Int) +sourceConcatMapSingletonStreams count start = + fmap Stream.fromPure $ sourceUnfoldr count start + +{-# INLINE sourceConcatMapStreams #-} +sourceConcatMapStreams :: Monad m => Int -> Int -> Int -> Stream m (Stream m Int) +sourceConcatMapStreams outer inner start = + fmap (sourceUnfoldr inner) $ sourceUnfoldr outer start + +concatMap :: Int -> Int -> IO () +concatMap outer inner = withRandomIntIO $ \n -> + drain $ S.concatMap + (sourceUnfoldrM inner) + (sourceUnfoldrM outer n) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'concatMap +inspect $ 'concatMap `hasNoType` ''SPEC +-- inspect $ 'concatMap `hasNoType` ''S.Step +inspect $ 'concatMap `hasNoType` ''Fold.Step +#endif + +concatMapM2 :: Int -> IO () +concatMapM2 value = withStream value $ \s -> + drain $ do + Stream.concatMapM (\x -> + pure $ Stream.concatMapM (\y -> + pure $ Stream.fromPure $ x + y) s) s + +concatMapM3 :: Int -> IO () +concatMapM3 value = withStream value $ \s -> + drain $ do + Stream.concatMapM (\x -> + pure $ Stream.concatMapM (\y -> + pure $ Stream.concatMapM (\z -> + pure $ Stream.fromPure $ x + y + z) s) s) s + +concatMapViaUnfoldEach :: Int -> Int -> IO () +concatMapViaUnfoldEach outer inner = withRandomIntIO $ \n -> + drain $ cmap + (sourceUnfoldrM inner) + (sourceUnfoldrM outer n) + + where + + cmap f = Stream.unfoldEach (UF.lmap f UF.fromStream) + +concatMapM :: Int -> Int -> IO () +concatMapM outer inner = withRandomIntIO $ \n -> + drain $ S.concatMapM + (return . sourceUnfoldrM inner) + (sourceUnfoldrM outer n) + +-- concatMap Streams + +concatMapSingletonStreams :: Int -> IO () +concatMapSingletonStreams value = + withRandomIntIO (drain . S.concatMap id . sourceConcatMapSingletonStreams value) + +concatMapStreams :: Int -> Int -> IO () +concatMapStreams outer inner = + withRandomIntIO (S.drain . S.concatMap id . sourceConcatMapStreams outer inner) + +-- concatMap unfoldr/unfoldr + +concatMapPure :: Int -> Int -> IO () +concatMapPure outer inner = withRandomIntIO $ \n -> + drain $ S.concatMap + (sourceUnfoldr inner) + (sourceUnfoldr outer n) + +#ifdef INSPECTION +#if __GLASGOW_HASKELL__ >= 906 +inspect $ hasNoTypeClassesExcept 'concatMapPure [''Applicative] +#else +inspect $ hasNoTypeClasses 'concatMapPure +#endif +inspect $ 'concatMapPure `hasNoType` ''SPEC +-- inspect $ 'concatMapPure `hasNoType` ''S.Step +inspect $ 'concatMapPure `hasNoType` ''Fold.Step +#endif + +{-# INLINE sourceUnfoldrMUnfold #-} +sourceUnfoldrMUnfold :: Monad m => Int -> Int -> Unfold m Int Int +sourceUnfoldrMUnfold size start = UF.unfoldrM step + + where + + step i = + return + $ if i < start + size + then Just (i, i + 1) + else Nothing + +unfoldEach :: Int -> Int -> IO () +unfoldEach outer inner = withRandomIntIO $ \start -> drain $ + S.unfoldEach (sourceUnfoldrMUnfold inner start) + $ sourceUnfoldrM outer start + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'unfoldEach +inspect $ 'unfoldEach `hasNoType` ''Producer.ConcatState +inspect $ 'unfoldEach `hasNoType` ''SPEC +inspect $ 'unfoldEach `hasNoType` ''S.Step +inspect $ 'unfoldEach `hasNoType` ''Fold.Step +#endif + +unfoldEach2 :: Int -> Int -> IO () +unfoldEach2 outer inner = withRandomIntIO $ \start -> drain $ + S.unfoldEach (UF.carryInput (sourceUnfoldrMUnfold inner start)) + $ sourceUnfoldrM outer start + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'unfoldEach2 +inspect $ 'unfoldEach2 `hasNoType` ''Producer.ConcatState +inspect $ 'unfoldEach2 `hasNoType` ''S.Step +inspect $ 'unfoldEach2 `hasNoType` ''Fold.Step +inspect $ 'unfoldEach2 `hasNoType` ''SPEC +#endif + +unfoldEach3 :: Int -> IO () +unfoldEach3 linearCount = withRandomIntIO $ \start -> drain $ do + S.unfoldEach (UF.carryInput (UF.lmap snd (sourceUnfoldrMUnfold nestedCount3 start))) + $ S.unfoldEach (UF.carryInput (sourceUnfoldrMUnfold nestedCount3 start)) + $ sourceUnfoldrM nestedCount3 start + where + + nestedCount3 = round (fromIntegral linearCount**(1/3::Double)) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'unfoldEach3 +inspect $ 'unfoldEach3 `hasNoType` ''Producer.ConcatState +inspect $ 'unfoldEach3 `hasNoType` ''S.Step +inspect $ 'unfoldEach3 `hasNoType` ''Fold.Step +inspect $ 'unfoldEach3 `hasNoType` ''SPEC +#endif + +unfoldCross :: Int -> Int -> IO () +unfoldCross outer inner = withRandomIntIO $ \start -> drain $ + Stream.unfoldCross + UF.identity + (sourceUnfoldrM outer start) + (sourceUnfoldrM inner start) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'unfoldCross +inspect $ 'unfoldCross `hasNoType` ''Producer.CrossState +inspect $ 'unfoldCross `hasNoType` ''Producer.ConcatState +inspect $ 'unfoldCross `hasNoType` ''S.Step +inspect $ 'unfoldCross `hasNoType` ''Fold.Step +inspect $ 'unfoldCross `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Fold Many +------------------------------------------------------------------------------- + +foldMany :: Int -> IO () +foldMany value = + withStream value $ + Common.drain + . fmap getSum + . S.foldMany (FL.take 2 FL.mconcat) + . fmap Sum + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldMany +inspect $ 'foldMany `hasNoType` ''S.Step +inspect $ 'foldMany `hasNoType` ''S.FoldMany +inspect $ 'foldMany `hasNoType` ''FL.Step +inspect $ 'foldMany `hasNoType` ''SPEC +#endif + +foldMany1 :: Int -> IO () +foldMany1 value = + withStream value $ + Common.drain + . fmap getSum + . S.foldManyPost (FL.take 2 FL.mconcat) + . fmap Sum + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldMany1 +inspect $ 'foldMany1 `hasNoType` ''S.Step +inspect $ 'foldMany1 `hasNoType` ''S.FoldManyPost +inspect $ 'foldMany1 `hasNoType` ''FL.Step +inspect $ 'foldMany1 `hasNoType` ''SPEC +#endif + +refoldMany :: Int -> IO () +refoldMany value = + withStream value $ + Common.drain + . fmap getSum + . S.refoldMany (Refold.take 2 Refold.sconcat) (return mempty) + . fmap Sum + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'refoldMany +inspect $ 'refoldMany `hasNoType` ''S.Step +inspect $ 'refoldMany `hasNoType` ''S.FoldMany +inspect $ 'refoldMany `hasNoType` ''FL.Step +inspect $ 'refoldMany `hasNoType` ''SPEC +#endif + +-- {-# INLINE refoldIterateM #-} +refoldIterateM :: Int -> IO () +refoldIterateM value = + withStream value $ + Common.drain + . fmap getSum + . S.refoldIterateM + (Refold.take 2 Refold.sconcat) (return (Sum 0)) + . fmap Sum + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'refoldIterateM +inspect $ 'refoldIterateM `hasNoType` ''S.Step +inspect $ 'refoldIterateM `hasNoType` ''S.CIterState +inspect $ 'refoldIterateM `hasNoType` ''FL.Step +inspect $ 'refoldIterateM `hasNoType` ''Refold.Tuple'Fused +inspect $ 'refoldIterateM `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Benchmarks +------------------------------------------------------------------------------- + +{-# ANN benchmarks "HLint: ignore" #-} +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + -- Multi-stream (concatMap/foldMany) + [ (SpaceO_1, benchIO "serial" $ serial2 (size `div` 2)) + , (SpaceO_1, benchIO "serial (2,2,x/4)" $ serial4 (size `div` 4)) + , (SpaceO_1, benchIO "zipWith" $ zipWith size) + , (SpaceO_1, benchIO "zipWithM" $ zipWithM size) + , (SpaceO_1, benchIO "concatMap" $ concatMap 2 (size `div` 2)) + , (SpaceO_1, benchIO "concatMap unfoldr outer=Max inner=1" $ + concatMapPure size 1) + , (SpaceO_1, benchIO "concatMap unfoldr outer=inner=(sqrt Max)" $ + concatMapPure sqrtVal sqrtVal) + , (SpaceO_1, benchIO "concatMap unfoldr outer=1 inner=Max" $ + concatMapPure 1 size) + , (SpaceO_1, benchIO "concatMap unfoldrM outer=max inner=1" $ + concatMap size 1) + , (SpaceO_1, benchIO "concatMap unfoldrM outer=inner=(sqrt Max)" $ + concatMap sqrtVal sqrtVal) + , (SpaceO_1, benchIO "concatMap unfoldrM outer=1 inner=Max" $ + concatMap 1 size) + -- Using boxed values/streams may have entirely different perf profile + , (SpaceO_1, benchIO "concatMap Streams fromPure outer=max inner=1" $ + concatMapSingletonStreams size) + , (SpaceO_1, benchIO "concatMap Streams unfoldr outer=max inner=1" $ + concatMapStreams size 1) + , (SpaceO_1, benchIO "concatMap Streams unfoldr outer=inner=(sqrt Max)" $ + concatMapStreams sqrtVal sqrtVal) + , (SpaceO_1, benchIO "concatMap Streams unfoldr outer=1 inner=Max" $ + concatMapStreams 1 size) + , (SpaceO_1, benchIO "concatMapM unfoldrM outer=max inner=1" $ + concatMapM size 1) + , (SpaceO_1, benchIO "concatMapM unfoldrM outer=inner=(sqrt Max)" $ + concatMapM sqrtVal sqrtVal) + , (SpaceO_1, benchIO "concatMapM unfoldrM outer=1 inner=Max" $ + concatMapM 1 size) + , (SpaceO_1, benchIO "concatMapM2 fromPure" $ concatMapM2 sqrtVal) + , (SpaceO_1, benchIO "concatMapM3 fromPure" $ concatMapM3 cubertVal) + , (SpaceO_1, benchIO "concatMapViaUnfoldEach outer=max inner=1" $ + concatMapViaUnfoldEach size 1) + , (SpaceO_1, benchIO "concatMapViaUnfoldEach outer=inner=(sqrt Max)" $ + concatMapViaUnfoldEach sqrtVal sqrtVal) + , (SpaceO_1, benchIO "concatMapViaUnfoldEach outer=1 inner=Max" $ + concatMapViaUnfoldEach 1 size) + , (SpaceO_1, benchIO "unfoldCross outer=max inner=1" $ unfoldCross size 1) + , (SpaceO_1, benchIO "unfoldCross outer=inner=(sqrt Max)" $ + unfoldCross sqrtVal sqrtVal) + , (SpaceO_1, benchIO "unfoldCross outer=1 inner=Max" $ unfoldCross 1 size) + -- concatMap vs unfoldEach + , (SpaceO_1, benchIO "unfoldEach outer=Max inner=1" $ unfoldEach size 1) + , (SpaceO_1, benchIO "unfoldEach outer=inner=(sqrt Max)" $ + unfoldEach sqrtVal sqrtVal) + , (SpaceO_1, benchIO "unfoldEach outer=1 inner=Max" $ unfoldEach 1 size) + , (SpaceO_1, benchIO "unfoldEach2 outer=Max inner=1" $ unfoldEach2 size 1) + , (SpaceO_1, benchIO "unfoldEach2 outer=inner=(sqrt Max)" $ + unfoldEach2 sqrtVal sqrtVal) + , (SpaceO_1, benchIO "unfoldEach2 outer=1 inner=Max" $ unfoldEach2 1 size) + , (SpaceO_1, benchIO "unfoldEach3 outer=inner=(cubert Max)" $ unfoldEach3 size) + + -- Fold Many + , (SpaceO_1, benchIO "foldMany" $ foldMany size) + , (SpaceO_1, benchIO "foldMany1" $ foldMany1 size) + , (SpaceO_1, benchIO "refoldMany" $ refoldMany size) + , (SpaceO_1, benchIO "refoldIterateM" $ refoldIterateM size) + ] + + where + + sqrtVal = round $ sqrt (fromIntegral size :: Double) -- double nested loop + cubertVal = round (fromIntegral size**(1/3::Double)) -- triple nested loop diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Type/Nested.hs b/benchmark/Streamly/Benchmark/Data/Stream/Type/Nested.hs new file mode 100644 index 0000000000..3886d92977 --- /dev/null +++ b/benchmark/Streamly/Benchmark/Data/Stream/Type/Nested.hs @@ -0,0 +1,267 @@ +-- | +-- Module : Stream.Type.Nested +-- Copyright : (c) 2018 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com + +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} + +-- | Benchmarks for the 'Applicative' and 'Monad' instances of streams, i.e. +-- the nested looping (cross product) and @concatFor@ combinators. +module Stream.Type.Nested + ( benchmarks + ) where + +import Streamly.Internal.Data.Stream (Stream) + +import qualified Streamly.Internal.Data.Stream as Stream + +import Test.Tasty.Bench +import Stream.Common hiding (benchIO) +import Stream.Type.Basic (benchIO, withRandomIntIO, withStream) +import Streamly.Benchmark.Common +import Prelude hiding (concatMap, mapM, zipWith) + +mkCross :: Stream m a -> Stream.Nested m a +mkCross = Stream.Nested + +unCross :: Stream.Nested m a -> Stream m a +unCross = Stream.unNested + +------------------------------------------------------------------------------- +-- Applicative +------------------------------------------------------------------------------- + +{-# INLINE toNullApPure #-} +toNullApPure :: MonadAsync m => Int -> Int -> m () +toNullApPure linearCount start = drain $ unCross $ + (+) <$> mkCross (sourceUnfoldr nestedCount2 start) + <*> mkCross (sourceUnfoldr nestedCount2 start) + + where + + nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) + +{-# INLINE toNullMPure #-} +toNullMPure :: MonadAsync m => Int -> Int -> m () +toNullMPure linearCount start = drain $ unCross $ do + x <- mkCross (sourceUnfoldr nestedCount2 start) + y <- mkCross (sourceUnfoldr nestedCount2 start) + return $ x + y + + where + + nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) + +{-# INLINE toNullM3Pure #-} +toNullM3Pure :: MonadAsync m => Int -> Int -> m () +toNullM3Pure linearCount start = drain $ unCross $ do + x <- mkCross (sourceUnfoldr nestedCount3 start) + y <- mkCross (sourceUnfoldr nestedCount3 start) + z <- mkCross (sourceUnfoldr nestedCount3 start) + return $ x + y + z + + where + + nestedCount3 = round (fromIntegral linearCount**(1/3::Double)) + +{-# INLINE filterAllOutMPure #-} +filterAllOutMPure :: MonadAsync m => Int -> Int -> m () +filterAllOutMPure linearCount start = drain $ unCross $ do + x <- mkCross (sourceUnfoldr nestedCount2 start) + y <- mkCross (sourceUnfoldr nestedCount2 start) + let s = x + y + if s < 0 + then return s + else mkCross Stream.nil + + where + + nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) + +{-# INLINE filterAllInMPure #-} +filterAllInMPure :: MonadAsync m => Int -> Int -> m () +filterAllInMPure linearCount start = drain $ unCross $ do + x <- mkCross (sourceUnfoldr nestedCount2 start) + y <- mkCross (sourceUnfoldr nestedCount2 start) + let s = x + y + if s > 0 + then return s + else mkCross Stream.nil + + where + + nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) + +cross2 :: Int -> IO () +cross2 linearCount = withRandomIntIO $ \start -> drain $ + Stream.crossWith (+) + (sourceUnfoldr nestedCount2 start) + (sourceUnfoldr nestedCount2 start) + + where + + nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) + +crossApply :: Int -> IO () +crossApply linearCount = withRandomIntIO $ \start -> drain $ + Stream.crossApply + ((+) <$> sourceUnfoldrM nestedCount2 start) + (sourceUnfoldrM nestedCount2 start) + + where + + nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) + +crossApplyFst :: Int -> IO () +crossApplyFst linearCount = withRandomIntIO $ \start -> drain $ + Stream.crossApplyFst + (sourceUnfoldrM nestedCount2 start) + (sourceUnfoldrM nestedCount2 start) + + where + + nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) + +crossApplySnd :: Int -> IO () +crossApplySnd linearCount = withRandomIntIO $ \start -> drain $ + Stream.crossApplySnd + (sourceUnfoldrM nestedCount2 start) + (sourceUnfoldrM nestedCount2 start) + + where + + nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) + +------------------------------------------------------------------------------- +-- Monad +------------------------------------------------------------------------------- + +drainConcatFor1 :: Int -> IO () +drainConcatFor1 count = withStream count $ \s -> + drain $ Stream.concatFor s $ \x -> + Stream.fromPure $ x + 1 + +drainConcatFor :: Int -> IO () +drainConcatFor count = withStream count $ \s -> + drain $ do + Stream.concatFor s $ \x -> + Stream.concatFor s $ \y -> + Stream.fromPure $ x + y + +drainConcatForM :: Int -> IO () +drainConcatForM count = withStream count $ \s -> + drain $ do + Stream.concatForM s $ \x -> + pure $ Stream.concatForM s $ \y -> + pure $ Stream.fromPure $ x + y + +drainConcatFor3 :: Int -> IO () +drainConcatFor3 count = withStream count $ \s -> + drain $ do + Stream.concatFor s $ \x -> + Stream.concatFor s $ \y -> + Stream.concatFor s $ \z -> + Stream.fromPure $ x + y + z + +drainConcatFor4 :: Int -> IO () +drainConcatFor4 count = withStream count $ \s -> + drain $ do + Stream.concatFor s $ \x -> + Stream.concatFor s $ \y -> + Stream.concatFor s $ \z -> + Stream.concatFor s $ \w -> + Stream.fromPure $ x + y + z + w + +drainConcatFor5 :: Int -> IO () +drainConcatFor5 count = withStream count $ \s -> + drain $ do + Stream.concatFor s $ \x -> + Stream.concatFor s $ \y -> + Stream.concatFor s $ \z -> + Stream.concatFor s $ \w -> + Stream.concatFor s $ \u -> + Stream.fromPure $ x + y + z + w + u + +drainConcatFor3M :: Int -> IO () +drainConcatFor3M count = withStream count $ \s -> + drain $ do + Stream.concatForM s $ \x -> + pure $ Stream.concatForM s $ \y -> + pure $ Stream.concatForM s $ \z -> + pure $ Stream.fromPure $ x + y + z + +filterAllInConcatFor :: Int -> IO () +filterAllInConcatFor count = withStream count $ \s -> + drain $ do + Stream.concatFor s $ \x -> + Stream.concatFor s $ \y -> + let s1 = x + y + in if s1 > 0 + then Stream.fromPure s1 + else Stream.nil + +filterAllOutConcatFor :: Int -> IO () +filterAllOutConcatFor count = withStream count $ \s -> + drain $ do + Stream.concatFor s $ \x -> + Stream.concatFor s $ \y -> + let s1 = x + y + in if s1 < 0 + then Stream.fromPure s1 + else Stream.nil + +------------------------------------------------------------------------------- +-- Benchmarks +------------------------------------------------------------------------------- + +{-# ANN benchmarks "HLint: ignore" #-} +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + -- Applicative + [ (SpaceO_1, benchIO "(*>)" $ withRandomIntIO (apDiscardFst size)) + , (SpaceO_1, benchIO "(<*)" $ withRandomIntIO (apDiscardSnd size)) + , (SpaceO_1, benchIO "(<*>)" $ withRandomIntIO (toNullAp size)) + , (SpaceO_1, benchIO "liftA2" $ withRandomIntIO (apLiftA2 size)) + , (SpaceO_1, benchIO "crossApply" $ crossApply size) + , (SpaceO_1, benchIO "crossApplyFst" $ crossApplyFst size) + , (SpaceO_1, benchIO "crossApplySnd" $ crossApplySnd size) + , (SpaceO_1, benchIO "pureDrain2" $ withRandomIntIO (toNullApPure size)) + , (SpaceO_1, benchIO "pureCross2" $ cross2 size) + + -- Monad + , (SpaceO_1, benchIO "then2M" $ withRandomIntIO (monadThen size)) + , (SpaceO_1, benchIO "drain2M" $ withRandomIntIO (toNullM size)) + , (SpaceO_1, benchIO "drain3M" $ withRandomIntIO (toNullM3 size)) + , (SpaceO_1, benchIO "filterAllOut2M" $ withRandomIntIO (filterAllOutM size)) + , (SpaceO_1, benchIO "filterAllIn2M" $ withRandomIntIO (filterAllInM size)) + , (SpaceO_1, benchIO "filterSome2M" $ withRandomIntIO (filterSome size)) + , (SpaceO_1, benchIO "breakAfterSome2M" $ withRandomIntIO (breakAfterSome size)) + , (SpaceO_1, benchIO "pureDrain2M" $ withRandomIntIO (toNullMPure size)) + , (SpaceO_1, benchIO "pureDrain3M" $ withRandomIntIO (toNullM3Pure size)) + , (SpaceO_1, benchIO "pureFilterAllIn2M" $ withRandomIntIO (filterAllInMPure size)) + , (SpaceO_1, benchIO "pureFilterAllOut2M" $ withRandomIntIO (filterAllOutMPure size)) + , (SpaceO_n, benchIO "toList2M" $ withRandomIntIO (toListM size)) + , (SpaceO_n, benchIO "toListSome2M" $ withRandomIntIO (toListSome size)) + + -- concatFor (bind) + , (SpaceO_1, benchIO "concatFor/drain1" $ drainConcatFor1 size) + , (SpaceO_1, benchIO "concatFor/drain2" $ drainConcatFor sqrtVal) + , (SpaceO_1, benchIO "concatFor/drain3" $ drainConcatFor3 cubertVal) + , (SpaceO_1, benchIO "concatFor/drain4" $ drainConcatFor4 size4) + , (SpaceO_1, benchIO "concatFor/drain5" $ drainConcatFor5 size5) + , (SpaceO_1, benchIO "concatFor/drainM2" $ drainConcatForM sqrtVal) + , (SpaceO_1, benchIO "concatFor/drainM3" $ drainConcatFor3M cubertVal) + , (SpaceO_1, benchIO "concatFor/filterAllIn2" $ filterAllInConcatFor sqrtVal) + , (SpaceO_1, benchIO "concatFor/filterAllOut2" $ filterAllOutConcatFor sqrtVal) + ] + + where + + sqrtVal = round $ sqrt (fromIntegral size :: Double) -- double nested loop + cubertVal = round (fromIntegral size**(1/3::Double)) -- triple nested loop + size4 = round (fromIntegral size**(1/4::Double)) -- 4 times nested loop + size5 = round (fromIntegral size**(1/5::Double)) -- 5 times nested loop diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index 551c750bda..ca0cf783bb 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -462,6 +462,10 @@ benchmark Data.Stream Stream.Transform.Basic Stream.Transform.Composed Stream.Type + Stream.Type.Basic + Stream.Type.MultiStream + Stream.Type.Nested + Stream.Type.Logic if flag(limit-build-mem) if flag(dev) ghc-options: +RTS -M1000M -RTS From 1737060ee7d4c14ac81c1691b7fc382742dcd276 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sun, 14 Jun 2026 20:23:20 +0530 Subject: [PATCH 13/20] Fix iterated/dropWhileFalse warning --- .../Streamly/Benchmark/Data/Stream/Transform/Composed.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs index db15608fd5..45d156afbb 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs @@ -522,8 +522,8 @@ iterateDropWhileTrue value iterCount = withRandomIntIO $ Common.drain . iterateSource (S.dropWhile (<= (value + 1))) (value `div` iterCount) iterCount -iterateDropWhileFalse :: Int -> Int -> IO () -iterateDropWhileFalse value iterCount = +_iterateDropWhileFalse :: Int -> Int -> IO () +_iterateDropWhileFalse value iterCount = withRandomIntIO $ Common.drain . iterateSource (S.dropWhile (> (value + 1))) (value `div` iterCount) iterCount @@ -652,7 +652,7 @@ benchmarks size = , (StackO_n, benchIO "iterated/dropOne (n/10 x 10)" $ iterateDropOne size 10) , (StackO_n, benchIO "iterated/dropWhileTrue (n/10 x 10)" $ iterateDropWhileTrue size 10) -- XXX tasty-bench hangs on this sometimes - -- , (StackO_n, benchIO "iterated/dropWhileFalse (n/10 x 10)" $ iterateDropWhileFalse size 10) + -- , (StackO_n, benchIO "iterated/dropWhileFalse (n/10 x 10)" $ _iterateDropWhileFalse size 10) , (SpaceO_n, benchIO "iterated/(+) (n times) (baseline)" $ iteratePlusBaseline size) , (SpaceO_n, benchIO "iterated/(<$) (n times)" $ iterateSubMap size) , (SpaceO_n, benchIO "iterated/fmap (n times)" $ iterateFmap size) From f1b1920f243d8163e4ee55fa1cf516cb725ec296 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sun, 14 Jun 2026 20:24:50 +0530 Subject: [PATCH 14/20] Remove additional heap requirement for Data.Stream benchmarks --- benchmark/streamly-benchmarks.cabal | 5 ----- 1 file changed, 5 deletions(-) diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index ca0cf783bb..5e98dc4180 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -466,11 +466,6 @@ benchmark Data.Stream Stream.Type.MultiStream Stream.Type.Nested Stream.Type.Logic - if flag(limit-build-mem) - if flag(dev) - ghc-options: +RTS -M1000M -RTS - else - ghc-options: +RTS -M1200M -RTS benchmark Data.Stream.Adaptive import: bench-options-threaded From dd2b53556e9b4708d19ed571058a6e5d2a745d86 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Mon, 15 Jun 2026 01:02:34 +0530 Subject: [PATCH 15/20] Break Stream.Nesting bench module into smaller parts --- .../Streamly/Benchmark/Data/Stream/Nesting.hs | 430 +----------------- .../Benchmark/Data/Stream/Nesting/Basic.hs | 200 ++++++++ .../Data/Stream/Nesting/LogicConcat.hs | 118 +++++ .../Data/Stream/Nesting/LogicUnfold.hs | 124 +++++ .../Benchmark/Data/Stream/Parse/Group.hs | 1 + .../Benchmark/Data/Stream/Parse/Split.hs | 1 + .../Data/Stream/Parse/SplitChunks.hs | 1 + .../Benchmark/Data/Stream/Transform/Basic.hs | 1 + .../Data/Stream/Transform/Composed.hs | 2 + benchmark/streamly-benchmarks.cabal | 7 +- 10 files changed, 463 insertions(+), 422 deletions(-) create mode 100644 benchmark/Streamly/Benchmark/Data/Stream/Nesting/Basic.hs create mode 100644 benchmark/Streamly/Benchmark/Data/Stream/Nesting/LogicConcat.hs create mode 100644 benchmark/Streamly/Benchmark/Data/Stream/Nesting/LogicUnfold.hs diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs b/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs index 328d6382d3..71f206d301 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Nesting.hs @@ -1,432 +1,20 @@ -- | --- Module : Stream.Expand +-- Module : Stream.Nesting -- Copyright : (c) 2018 Composewell Technologies -- License : BSD-3-Clause -- Maintainer : streamly@composewell.com -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RankNTypes #-} - -#ifdef __HADDOCK_VERSION__ -#undef INSPECTION -#endif - -#ifdef INSPECTION -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} -#endif - module Stream.Nesting (benchmarks) where -#ifdef INSPECTION -import GHC.Types (SPEC(..)) -import qualified Streamly.Internal.Data.Fold as Fold -import qualified Streamly.Internal.Data.Producer as Producer -import Test.Inspection -#endif - -import Streamly.Data.Stream (Stream) -import Streamly.Data.Unfold (Unfold) - -import qualified Streamly.Internal.Data.Unfold as UF -import qualified Streamly.Internal.Data.Stream as S -import qualified Streamly.Internal.Data.Unfold as Unfold -import qualified Streamly.Internal.Data.Stream as Stream -import qualified Streamly.Internal.Data.StreamK as StreamK - -import Test.Tasty.Bench -import Stream.Common hiding (benchIO) -import Stream.Type (benchIO, withRandomIntIO) -import Streamly.Benchmark.Common -import qualified Stream.Type as Type -import Prelude hiding (concatMap, zipWith) - -------------------------------------------------------------------------------- --- Multi-Stream -------------------------------------------------------------------------------- - -------------------------------------------------------------------------------- --- Appending -------------------------------------------------------------------------------- - -interleave2 :: Int -> IO () -interleave2 count = withRandomIntIO $ \n -> - drain $ - S.interleave - (sourceUnfoldrM count n) - (sourceUnfoldrM count (n + 1)) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'interleave2 -inspect $ 'interleave2 `hasNoType` ''SPEC -inspect $ 'interleave2 `hasNoType` ''Producer.InterleaveState -inspect $ 'interleave2 `hasNoType` ''S.Step -inspect $ 'interleave2 `hasNoType` ''Fold.Step -#endif - -roundRobin2 :: Int -> IO () -roundRobin2 count = withRandomIntIO $ \n -> - S.drain $ - S.roundRobin - (sourceUnfoldrM count n) - (sourceUnfoldrM count (n + 1)) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'roundRobin2 -inspect $ 'roundRobin2 `hasNoType` ''SPEC -inspect $ 'roundRobin2 `hasNoType` ''S.InterleaveState -inspect $ 'roundRobin2 `hasNoType` ''S.Step -inspect $ 'roundRobin2 `hasNoType` ''Fold.Step -#endif - -------------------------------------------------------------------------------- --- Merging -------------------------------------------------------------------------------- - -mergeBy :: Int -> IO () -mergeBy count = withRandomIntIO $ \n -> - Stream.drain - $ Stream.mergeBy - compare - (sourceUnfoldrM count n) - (sourceUnfoldrM count (n + 1)) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'mergeBy -inspect $ 'mergeBy `hasNoType` ''SPEC --- inspect $ 'mergeBy `hasNoType` ''S.Step -inspect $ 'mergeBy `hasNoType` ''Fold.Step -#endif - -mergeByM :: Int -> IO () -mergeByM count = withRandomIntIO $ \n -> - Stream.drain - $ Stream.mergeByM - (\a b -> return $ compare a b) - (sourceUnfoldrM count n) - (sourceUnfoldrM count (n + 1)) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'mergeByM -inspect $ 'mergeByM `hasNoType` ''SPEC --- inspect $ 'mergeByM `hasNoType` ''S.Step -inspect $ 'mergeByM `hasNoType` ''Fold.Step -#endif - -------------------------------------------------------------------------------- --- Zipping -------------------------------------------------------------------------------- - -------------------------------------------------------------------------------- --- joining 2 streams using n-ary ops -------------------------------------------------------------------------------- - -{-# INLINE sourceUnfoldrMUF #-} --- unfold input is (count, value) -sourceUnfoldrMUF :: Monad m => Int -> UF.Unfold m (Int, Int) Int -sourceUnfoldrMUF count = UF.unfoldrM step - where - step (cnt, start) = - return $ - if cnt > start + count - then Nothing - else Just (cnt, (cnt + 1, start)) - -bfsUnfoldEach :: Int -> Int -> IO () -bfsUnfoldEach outer inner = withRandomIntIO $ \n -> - S.drain $ S.bfsUnfoldEach - -- (UF.lmap return (UF.replicateM inner)) - (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner)) - (sourceUnfoldrM outer n) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'bfsUnfoldEach --- inspect $ 'bfsUnfoldEach `hasNoType` ''S.Step -inspect $ 'bfsUnfoldEach `hasNoType` ''Fold.Step -inspect $ 'bfsUnfoldEach `hasNoType` ''SPEC -#endif - -altBfsUnfoldEach :: Int -> Int -> IO () -altBfsUnfoldEach outer inner = withRandomIntIO $ \n -> - S.drain $ S.altBfsUnfoldEach - -- (UF.lmap return (UF.replicateM inner)) - (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner)) - (sourceUnfoldrM outer n) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'altBfsUnfoldEach --- inspect $ 'altBfsUnfoldEach `hasNoType` ''S.Step -inspect $ 'altBfsUnfoldEach `hasNoType` ''Fold.Step --- inspect $ 'altBfsUnfoldEach `hasNoType` ''SPEC -#endif - -unfoldSched :: Int -> Int -> IO () -unfoldSched outer inner = withRandomIntIO $ \n -> - S.drain $ S.unfoldSched - -- (UF.lmap return (UF.replicateM inner)) - (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner)) - (sourceUnfoldrM outer n) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'unfoldSched --- inspect $ 'unfoldSched `hasNoType` ''S.Step -inspect $ 'unfoldSched `hasNoType` ''Fold.Step -inspect $ 'unfoldSched `hasNoType` ''SPEC -#endif - -------------------------------------------------------------------------------- --- Monad -------------------------------------------------------------------------------- - -{-# INLINE infiniteIntsUnfold #-} -infiniteIntsUnfold :: Monad m => Int -> Int -> Unfold m ((), ()) Int -infiniteIntsUnfold _ _ = - Unfold.interleave - (Unfold.supply (0 :: Int) Unfold.enumerateFrom) - (Unfold.supply (-1, -2) Unfold.enumerateFromThen) - --- In bounded case, the x stream is 0 to maxVal and y stream is -1 to -maxVal. --- The solution of the equation is x = maxVal y = -maxVal, so in the worst case --- we get to the solution only after exhausting both the streams. --- --- In the infinite stream case we terminate after we get to the solution or --- both streams go beyond maxVal, in this case if one stream is explored more --- then we might go through more than maxVal x maxVal cases. --- -{-# INLINE checkStreamK #-} -checkStreamK :: Int -> Int -> Int -> StreamK.StreamK m (Maybe (Maybe (Int, Int))) -checkStreamK maxVal x y = - let eq1 = x + y == 0 - eq2 = x - y == 2 * maxVal - in if eq1 && eq2 - then StreamK.fromPure (Just (Just (x,y))) - else if abs x > maxVal && abs y > maxVal - then StreamK.fromPure (Just Nothing) - else StreamK.fromPure Nothing - -{-# INLINE fairConcatForEqn #-} -fairConcatForEqn :: Monad m => Int -> Stream m Int -> m () -fairConcatForEqn maxVal input = - Type.result - $ Stream.fairConcatFor input $ \x -> - Stream.fairConcatForM input $ \y -> do - return $ Type.checkStream maxVal x y - -{-# INLINE fairConcatForEqnK #-} -fairConcatForEqnK :: Monad m => Int -> Stream m Int -> m () -fairConcatForEqnK maxVal input = - let inputK = StreamK.fromStream input - in Type.result - $ StreamK.toStream - $ StreamK.fairConcatFor inputK $ \x -> - StreamK.fairConcatForM inputK $ \y -> do - return $ checkStreamK maxVal x y +import Test.Tasty.Bench (Benchmark) +import Streamly.Benchmark.Common (SpaceComplexity) -{-# INLINE fairSchedForEqn #-} -fairSchedForEqn :: Monad m => Int -> Stream m Int -> m () -fairSchedForEqn maxVal input = - Type.result - $ Stream.fairSchedFor input $ \x -> - Stream.fairSchedForM input $ \y -> do - return $ Type.checkStream maxVal x y - -_schedForEqn :: Monad m => Int -> Stream m Int -> m () -_schedForEqn maxVal input = - Type.result - $ Stream.schedFor input $ \x -> - Stream.schedForM input $ \y -> do - return $ Type.checkStream maxVal x y - -{-# INLINE unfoldCrossEqn #-} -unfoldCrossEqn :: Monad m => Int -> Unfold m ((), ()) Int -> m () -unfoldCrossEqn maxVal input = - Type.result - $ Stream.mapM (Type.checkPair maxVal) - $ Stream.unfold (Unfold.cross input input) (undefined, undefined) - -{-# INLINE fairUnfoldCrossEqn #-} -fairUnfoldCrossEqn :: Monad m => Int -> Unfold m ((), ()) Int -> m () -fairUnfoldCrossEqn maxVal input = - Type.result - $ Stream.mapM (Type.checkPair maxVal) - $ Stream.unfold (Unfold.fairCross input input) (undefined, undefined) - -{-# INLINE fairUnfoldEachEqn #-} -fairUnfoldEachEqn :: Monad m => Int -> Unfold m ((), ()) Int -> Stream m Int -> m () -fairUnfoldEachEqn maxVal input ints = - let intu = Unfold.carryInput $ Unfold.lmap (const (undefined, undefined)) input - in Type.result - $ Stream.mapM (Type.checkPair maxVal) - $ Stream.fairUnfoldEach intu ints - -{-# INLINE unfoldSchedEqn #-} -unfoldSchedEqn :: Monad m => Int -> Unfold m ((), ()) Int -> Stream m Int -> m () -unfoldSchedEqn maxVal input ints = - let intu = Unfold.carryInput $ Unfold.lmap (const (undefined, undefined)) input - in Type.result - $ Stream.mapM (Type.checkPair maxVal) - $ Stream.unfoldSched intu ints - -{-# INLINE fairUnfoldSchedEqn #-} -fairUnfoldSchedEqn :: Monad m => Int -> Unfold m ((), ()) Int -> Stream m Int -> m () -fairUnfoldSchedEqn maxVal input ints = - let intu = Unfold.carryInput $ Unfold.lmap (const (undefined, undefined)) input - in Type.result - $ Stream.mapM (Type.checkPair maxVal) - $ Stream.fairUnfoldSched intu ints - -fairConcatForBounded :: Int -> IO () -fairConcatForBounded maxVal = withRandomIntIO $ \n -> - fairConcatForEqn maxVal (Type.boundedInts maxVal n) - -fairConcatForKBounded :: Int -> IO () -fairConcatForKBounded maxVal = withRandomIntIO $ \n -> - fairConcatForEqnK maxVal (Type.boundedInts maxVal n) - -fairConcatForInfinite :: Int -> IO () -fairConcatForInfinite maxVal = withRandomIntIO $ \n -> - fairConcatForEqn maxVal (Type.infiniteInts maxVal n) - -fairSchedForBounded :: Int -> IO () -fairSchedForBounded maxVal = withRandomIntIO $ \n -> - fairSchedForEqn maxVal (Type.boundedInts maxVal n) - -fairSchedForInfinite :: Int -> IO () -fairSchedForInfinite maxVal = withRandomIntIO $ \n -> - fairSchedForEqn maxVal (Type.infiniteInts maxVal n) - -unfoldCrossBounded :: Int -> IO () -unfoldCrossBounded maxVal = unfoldCrossEqn maxVal (Type.boundedIntsUnfold maxVal 0) - -fairUnfoldCrossBounded :: Int -> IO () -fairUnfoldCrossBounded maxVal = fairUnfoldCrossEqn maxVal (Type.boundedIntsUnfold maxVal 0) - -fairUnfoldCrossInfinite :: Int -> IO () -fairUnfoldCrossInfinite maxVal = fairUnfoldCrossEqn maxVal (infiniteIntsUnfold maxVal 0) - -fairUnfoldEachBounded :: Int -> IO () -fairUnfoldEachBounded maxVal = withRandomIntIO $ \n -> - fairUnfoldEachEqn maxVal (Type.boundedIntsUnfold maxVal 0) (Type.boundedInts maxVal n) - -fairUnfoldEachInfinite :: Int -> IO () -fairUnfoldEachInfinite maxVal = withRandomIntIO $ \n -> - fairUnfoldEachEqn maxVal (infiniteIntsUnfold maxVal 0) (Type.infiniteInts maxVal n) - -unfoldSchedBounded :: Int -> IO () -unfoldSchedBounded maxVal = withRandomIntIO $ \n -> - unfoldSchedEqn maxVal (Type.boundedIntsUnfold maxVal 0) (Type.boundedInts maxVal n) - -fairUnfoldSchedBounded :: Int -> IO () -fairUnfoldSchedBounded maxVal = withRandomIntIO $ \n -> - fairUnfoldSchedEqn maxVal (Type.boundedIntsUnfold maxVal 0) (Type.boundedInts maxVal n) - -fairUnfoldSchedInfinite :: Int -> IO () -fairUnfoldSchedInfinite maxVal = withRandomIntIO $ \n -> - fairUnfoldSchedEqn maxVal (infiniteIntsUnfold maxVal 0) (Type.infiniteInts maxVal n) - -------------------------------------------------------------------------------- --- Joining -------------------------------------------------------------------------------- - --- XXX this should be moved to the Top module -{- -toKv :: Int -> (Int, Int) -toKv p = (p, p) - -{-# INLINE joinWith #-} -joinWith :: Common.MonadAsync m => - ((Int -> Int -> Bool) -> Stream m Int -> Stream m Int -> Stream m b) - -> Int - -> Int - -> m () -joinWith j val i = - drain $ j (==) (sourceUnfoldrM val i) (sourceUnfoldrM val (val `div` 2)) - -{-# INLINE joinMapWith #-} -joinMapWith :: Common.MonadAsync m => - (Stream m (Int, Int) -> Stream m (Int, Int) -> Stream m b) - -> Int - -> Int - -> m () -joinMapWith j val i = - drain - $ j - (fmap toKv (sourceUnfoldrM val i)) - (fmap toKv (sourceUnfoldrM val (val `div` 2))) - -o_n_heap_buffering :: Int -> [Benchmark] -o_n_heap_buffering value = - [ bgroup "buffered" - [ - benchIOSrc1 "joinInnerGeneric (sqrtVal)" - $ joinWith S.joinInnerGeneric sqrtVal - , benchIOSrc1 "joinInner" - $ joinMapWith S.joinInner halfVal - , benchIOSrc1 "joinLeftGeneric (sqrtVal)" - $ joinWith S.joinLeftGeneric sqrtVal - , benchIOSrc1 "joinLeft " - $ joinMapWith S.joinLeft halfVal - , benchIOSrc1 "joinOuterGeneric (sqrtVal)" - $ joinWith S.joinOuterGeneric sqrtVal - , benchIOSrc1 "joinOuter" - $ joinMapWith S.joinOuter halfVal - , benchIOSrc1 "filterInStreamGenericBy (sqrtVal)" - $ joinWith S.filterInStreamGenericBy sqrtVal - , benchIOSrc1 "filterInStreamAscBy" - $ joinMapWith (S.filterInStreamAscBy compare) halfVal - -- Note: schedFor does a bfs scheduling, therefore, can take a lot of - -- memory. - , benchFold "schedFor (bounded)" schedForEqn (boundedInts 1000) - ] - ] - - where - - halfVal = value `div` 2 - sqrtVal = round $ sqrt (fromIntegral value :: Double) --} - -------------------------------------------------------------------------------- --- Main -------------------------------------------------------------------------------- +import qualified Stream.Nesting.Basic as Basic +import qualified Stream.Nesting.LogicConcat as LogicConcat +import qualified Stream.Nesting.LogicUnfold as LogicUnfold benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = - -- multi-stream - [ (SpaceO_1, benchIO "interleave" $ interleave2 (size `div` 2)) - , (SpaceO_1, benchIO "roundRobin" $ roundRobin2 (size `div` 2)) - , (SpaceO_1, benchIO "mergeBy compare" $ mergeBy (size `div` 2)) - , (SpaceO_1, benchIO "mergeByM compare" $ mergeByM (size `div` 2)) - - -- join 2 streams using n-ary ops - , (SpaceO_1, benchIO "bfsUnfoldEach" $ bfsUnfoldEach 2 (size `div` 2)) - , (SpaceO_1, benchIO "altBfsUnfoldEach" $ altBfsUnfoldEach 2 (size `div` 2)) - , (SpaceO_1, benchIO "unfoldSched" $ unfoldSched 2 (size `div` 2)) - - -- Solve simultaneous equations by exploring all possibilities - , (SpaceO_1, benchIO "equations/fairConcatFor (bounded)" $ fairConcatForBounded sqrtVal) - , (SpaceO_1, benchIO "equations/fairConcatForK (bounded)" $ fairConcatForKBounded sqrtVal) - , (SpaceO_1, benchIO "equations/fairConcatFor (infinite)" $ fairConcatForInfinite sqrtVal) - , (SpaceO_1, benchIO "equations/fairSchedFor (bounded)" $ fairSchedForBounded sqrtVal) - , (SpaceO_1, benchIO "equations/fairSchedFor (infinite)" $ fairSchedForInfinite sqrtVal) - , (SpaceO_1, benchIO "equations/unfoldCross (bounded)" $ unfoldCrossBounded sqrtVal) - , (SpaceO_1, benchIO "equations/fairUnfoldCross (bounded)" $ fairUnfoldCrossBounded sqrtVal) - , (SpaceO_1, benchIO "equations/fairUnfoldCross (infinite)" $ fairUnfoldCrossInfinite sqrtVal) - , (SpaceO_1, benchIO "equations/fairUnfoldEach (bounded)" $ fairUnfoldEachBounded sqrtVal) - , (SpaceO_1, benchIO "equations/fairUnfoldEach (infinite)" $ fairUnfoldEachInfinite sqrtVal) - , (SpaceO_1, benchIO "equations/unfoldSched (bounded)" $ unfoldSchedBounded sqrtVal) - , (SpaceO_1, benchIO "equations/fairUnfoldSched (bounded)" $ fairUnfoldSchedBounded sqrtVal) - , (SpaceO_1, benchIO "equations/fairUnfoldSched (infinite)" $ fairUnfoldSchedInfinite sqrtVal) - , (HeapO_n, benchIO "bfsUnfoldEach (n of 1)" $ bfsUnfoldEach size 1) - , (HeapO_n, benchIO "bfsUnfoldEach (sqrtVal of sqrtVal)" $ bfsUnfoldEach sqrtVal sqrtVal) - , (HeapO_n, benchIO "altBfsUnfoldEach (n of 1)" $ altBfsUnfoldEach size 1) - , (HeapO_n, benchIO "altBfsUnfoldEach (sqrtVal of sqrtVal)" $ altBfsUnfoldEach sqrtVal sqrtVal) - , (HeapO_n, benchIO "unfoldSched (n of 1)" $ unfoldSched size 1) - , (HeapO_n, benchIO "unfoldSched (sqrtVal of sqrtVal)" $ unfoldSched sqrtVal sqrtVal) - ] - - where - - sqrtVal = round $ sqrt (fromIntegral size :: Double) + Basic.benchmarks size + ++ LogicConcat.benchmarks size + ++ LogicUnfold.benchmarks size diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Nesting/Basic.hs b/benchmark/Streamly/Benchmark/Data/Stream/Nesting/Basic.hs new file mode 100644 index 0000000000..3d61ea454e --- /dev/null +++ b/benchmark/Streamly/Benchmark/Data/Stream/Nesting/Basic.hs @@ -0,0 +1,200 @@ +-- | +-- Module : Stream.Nesting.Basic +-- Copyright : (c) 2018 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com + +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} + +#ifdef __HADDOCK_VERSION__ +#undef INSPECTION +#endif + +#ifdef INSPECTION +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} +#endif + +module Stream.Nesting.Basic (benchmarks) where + +#ifdef INSPECTION +import GHC.Types (SPEC(..)) +import qualified Streamly.Internal.Data.Fold as Fold +import qualified Streamly.Internal.Data.Producer as Producer +import Test.Inspection +#endif + +import qualified Streamly.Internal.Data.Unfold as UF +import qualified Streamly.Internal.Data.Stream as S +import qualified Streamly.Internal.Data.Stream as Stream + +import Test.Tasty.Bench +import Stream.Common hiding (benchIO) +import Stream.Type (benchIO, withRandomIntIO) +import Streamly.Benchmark.Common +import Prelude hiding (concatMap, zipWith) + +------------------------------------------------------------------------------- +-- Multi-Stream +------------------------------------------------------------------------------- + +------------------------------------------------------------------------------- +-- Appending +------------------------------------------------------------------------------- + +interleave2 :: Int -> IO () +interleave2 count = withRandomIntIO $ \n -> + drain $ + S.interleave + (sourceUnfoldrM count n) + (sourceUnfoldrM count (n + 1)) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'interleave2 +inspect $ 'interleave2 `hasNoType` ''SPEC +inspect $ 'interleave2 `hasNoType` ''Producer.InterleaveState +inspect $ 'interleave2 `hasNoType` ''S.Step +inspect $ 'interleave2 `hasNoType` ''Fold.Step +#endif + +roundRobin2 :: Int -> IO () +roundRobin2 count = withRandomIntIO $ \n -> + S.drain $ + S.roundRobin + (sourceUnfoldrM count n) + (sourceUnfoldrM count (n + 1)) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'roundRobin2 +inspect $ 'roundRobin2 `hasNoType` ''SPEC +inspect $ 'roundRobin2 `hasNoType` ''S.InterleaveState +inspect $ 'roundRobin2 `hasNoType` ''S.Step +inspect $ 'roundRobin2 `hasNoType` ''Fold.Step +#endif + +------------------------------------------------------------------------------- +-- Merging +------------------------------------------------------------------------------- + +mergeBy :: Int -> IO () +mergeBy count = withRandomIntIO $ \n -> + Stream.drain + $ Stream.mergeBy + compare + (sourceUnfoldrM count n) + (sourceUnfoldrM count (n + 1)) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'mergeBy +inspect $ 'mergeBy `hasNoType` ''SPEC +-- inspect $ 'mergeBy `hasNoType` ''S.Step +inspect $ 'mergeBy `hasNoType` ''Fold.Step +#endif + +mergeByM :: Int -> IO () +mergeByM count = withRandomIntIO $ \n -> + Stream.drain + $ Stream.mergeByM + (\a b -> return $ compare a b) + (sourceUnfoldrM count n) + (sourceUnfoldrM count (n + 1)) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'mergeByM +inspect $ 'mergeByM `hasNoType` ''SPEC +-- inspect $ 'mergeByM `hasNoType` ''S.Step +inspect $ 'mergeByM `hasNoType` ''Fold.Step +#endif + +------------------------------------------------------------------------------- +-- Zipping +------------------------------------------------------------------------------- + +------------------------------------------------------------------------------- +-- joining 2 streams using n-ary ops +------------------------------------------------------------------------------- + +{-# INLINE sourceUnfoldrMUF #-} +-- unfold input is (count, value) +sourceUnfoldrMUF :: Monad m => Int -> UF.Unfold m (Int, Int) Int +sourceUnfoldrMUF count = UF.unfoldrM step + where + step (cnt, start) = + return $ + if cnt > start + count + then Nothing + else Just (cnt, (cnt + 1, start)) + +bfsUnfoldEach :: Int -> Int -> IO () +bfsUnfoldEach outer inner = withRandomIntIO $ \n -> + S.drain $ S.bfsUnfoldEach + -- (UF.lmap return (UF.replicateM inner)) + (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner)) + (sourceUnfoldrM outer n) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'bfsUnfoldEach +-- inspect $ 'bfsUnfoldEach `hasNoType` ''S.Step +inspect $ 'bfsUnfoldEach `hasNoType` ''Fold.Step +inspect $ 'bfsUnfoldEach `hasNoType` ''SPEC +#endif + +altBfsUnfoldEach :: Int -> Int -> IO () +altBfsUnfoldEach outer inner = withRandomIntIO $ \n -> + S.drain $ S.altBfsUnfoldEach + -- (UF.lmap return (UF.replicateM inner)) + (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner)) + (sourceUnfoldrM outer n) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'altBfsUnfoldEach +-- inspect $ 'altBfsUnfoldEach `hasNoType` ''S.Step +inspect $ 'altBfsUnfoldEach `hasNoType` ''Fold.Step +-- inspect $ 'altBfsUnfoldEach `hasNoType` ''SPEC +#endif + +unfoldSched :: Int -> Int -> IO () +unfoldSched outer inner = withRandomIntIO $ \n -> + S.drain $ S.unfoldSched + -- (UF.lmap return (UF.replicateM inner)) + (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner)) + (sourceUnfoldrM outer n) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'unfoldSched +-- inspect $ 'unfoldSched `hasNoType` ''S.Step +inspect $ 'unfoldSched `hasNoType` ''Fold.Step +inspect $ 'unfoldSched `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Main +------------------------------------------------------------------------------- + +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + -- multi-stream + [ (SpaceO_1, benchIO "interleave" $ interleave2 (size `div` 2)) + , (SpaceO_1, benchIO "roundRobin" $ roundRobin2 (size `div` 2)) + , (SpaceO_1, benchIO "mergeBy compare" $ mergeBy (size `div` 2)) + , (SpaceO_1, benchIO "mergeByM compare" $ mergeByM (size `div` 2)) + + -- join 2 streams using n-ary ops + , (SpaceO_1, benchIO "bfsUnfoldEach" $ bfsUnfoldEach 2 (size `div` 2)) + , (SpaceO_1, benchIO "altBfsUnfoldEach" $ altBfsUnfoldEach 2 (size `div` 2)) + , (SpaceO_1, benchIO "unfoldSched" $ unfoldSched 2 (size `div` 2)) + + , (HeapO_n, benchIO "bfsUnfoldEach (n of 1)" $ bfsUnfoldEach size 1) + , (HeapO_n, benchIO "bfsUnfoldEach (sqrtVal of sqrtVal)" $ bfsUnfoldEach sqrtVal sqrtVal) + , (HeapO_n, benchIO "altBfsUnfoldEach (n of 1)" $ altBfsUnfoldEach size 1) + , (HeapO_n, benchIO "altBfsUnfoldEach (sqrtVal of sqrtVal)" $ altBfsUnfoldEach sqrtVal sqrtVal) + , (HeapO_n, benchIO "unfoldSched (n of 1)" $ unfoldSched size 1) + , (HeapO_n, benchIO "unfoldSched (sqrtVal of sqrtVal)" $ unfoldSched sqrtVal sqrtVal) + ] + + where + + sqrtVal = round $ sqrt (fromIntegral size :: Double) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Nesting/LogicConcat.hs b/benchmark/Streamly/Benchmark/Data/Stream/Nesting/LogicConcat.hs new file mode 100644 index 0000000000..4fdc74aa39 --- /dev/null +++ b/benchmark/Streamly/Benchmark/Data/Stream/Nesting/LogicConcat.hs @@ -0,0 +1,118 @@ +-- | +-- Module : Stream.Nesting.LogicConcat +-- Copyright : (c) 2018 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com + +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} + +module Stream.Nesting.LogicConcat (benchmarks) where + +import Streamly.Data.Stream (Stream) + +import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.StreamK as StreamK + +import Test.Tasty.Bench +import Stream.Type (benchIO, withRandomIntIO) +import Streamly.Benchmark.Common +import qualified Stream.Type as Type +import Prelude hiding (concatMap, zipWith) + +------------------------------------------------------------------------------- +-- Monad +------------------------------------------------------------------------------- + +-- In bounded case, the x stream is 0 to maxVal and y stream is -1 to -maxVal. +-- The solution of the equation is x = maxVal y = -maxVal, so in the worst case +-- we get to the solution only after exhausting both the streams. +-- +-- In the infinite stream case we terminate after we get to the solution or +-- both streams go beyond maxVal, in this case if one stream is explored more +-- then we might go through more than maxVal x maxVal cases. +-- +{-# INLINE checkStreamK #-} +checkStreamK :: Int -> Int -> Int -> StreamK.StreamK m (Maybe (Maybe (Int, Int))) +checkStreamK maxVal x y = + let eq1 = x + y == 0 + eq2 = x - y == 2 * maxVal + in if eq1 && eq2 + then StreamK.fromPure (Just (Just (x,y))) + else if abs x > maxVal && abs y > maxVal + then StreamK.fromPure (Just Nothing) + else StreamK.fromPure Nothing + +{-# INLINE fairConcatForEqn #-} +fairConcatForEqn :: Monad m => Int -> Stream m Int -> m () +fairConcatForEqn maxVal input = + Type.result + $ Stream.fairConcatFor input $ \x -> + Stream.fairConcatForM input $ \y -> do + return $ Type.checkStream maxVal x y + +{-# INLINE fairConcatForEqnK #-} +fairConcatForEqnK :: Monad m => Int -> Stream m Int -> m () +fairConcatForEqnK maxVal input = + let inputK = StreamK.fromStream input + in Type.result + $ StreamK.toStream + $ StreamK.fairConcatFor inputK $ \x -> + StreamK.fairConcatForM inputK $ \y -> do + return $ checkStreamK maxVal x y + +{-# INLINE fairSchedForEqn #-} +fairSchedForEqn :: Monad m => Int -> Stream m Int -> m () +fairSchedForEqn maxVal input = + Type.result + $ Stream.fairSchedFor input $ \x -> + Stream.fairSchedForM input $ \y -> do + return $ Type.checkStream maxVal x y + +_schedForEqn :: Monad m => Int -> Stream m Int -> m () +_schedForEqn maxVal input = + Type.result + $ Stream.schedFor input $ \x -> + Stream.schedForM input $ \y -> do + return $ Type.checkStream maxVal x y + +fairConcatForBounded :: Int -> IO () +fairConcatForBounded maxVal = withRandomIntIO $ \n -> + fairConcatForEqn maxVal (Type.boundedInts maxVal n) + +fairConcatForKBounded :: Int -> IO () +fairConcatForKBounded maxVal = withRandomIntIO $ \n -> + fairConcatForEqnK maxVal (Type.boundedInts maxVal n) + +fairConcatForInfinite :: Int -> IO () +fairConcatForInfinite maxVal = withRandomIntIO $ \n -> + fairConcatForEqn maxVal (Type.infiniteInts maxVal n) + +fairSchedForBounded :: Int -> IO () +fairSchedForBounded maxVal = withRandomIntIO $ \n -> + fairSchedForEqn maxVal (Type.boundedInts maxVal n) + +fairSchedForInfinite :: Int -> IO () +fairSchedForInfinite maxVal = withRandomIntIO $ \n -> + fairSchedForEqn maxVal (Type.infiniteInts maxVal n) + +------------------------------------------------------------------------------- +-- Main +------------------------------------------------------------------------------- + +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + -- Solve simultaneous equations by exploring all possibilities + -- Concat + [ (SpaceO_1, benchIO "equations/fairConcatFor (bounded)" $ fairConcatForBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairConcatForK (bounded)" $ fairConcatForKBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairConcatFor (infinite)" $ fairConcatForInfinite sqrtVal) + , (SpaceO_1, benchIO "equations/fairSchedFor (bounded)" $ fairSchedForBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairSchedFor (infinite)" $ fairSchedForInfinite sqrtVal) + ] + + where + + sqrtVal = round $ sqrt (fromIntegral size :: Double) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Nesting/LogicUnfold.hs b/benchmark/Streamly/Benchmark/Data/Stream/Nesting/LogicUnfold.hs new file mode 100644 index 0000000000..704f0b9ce1 --- /dev/null +++ b/benchmark/Streamly/Benchmark/Data/Stream/Nesting/LogicUnfold.hs @@ -0,0 +1,124 @@ +-- | +-- Module : Stream.Nesting.LogicUnfold +-- Copyright : (c) 2018 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com + +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} + +module Stream.Nesting.LogicUnfold (benchmarks) where + +import Streamly.Data.Stream (Stream) +import Streamly.Data.Unfold (Unfold) + +import qualified Streamly.Internal.Data.Unfold as Unfold +import qualified Streamly.Internal.Data.Stream as Stream + +import Test.Tasty.Bench +import Stream.Type (benchIO, withRandomIntIO) +import Streamly.Benchmark.Common +import qualified Stream.Type as Type +import Prelude hiding (concatMap, zipWith) + +------------------------------------------------------------------------------- +-- Monad +------------------------------------------------------------------------------- + +{-# INLINE infiniteIntsUnfold #-} +infiniteIntsUnfold :: Monad m => Int -> Int -> Unfold m ((), ()) Int +infiniteIntsUnfold _ _ = + Unfold.interleave + (Unfold.supply (0 :: Int) Unfold.enumerateFrom) + (Unfold.supply (-1, -2) Unfold.enumerateFromThen) + +{-# INLINE unfoldCrossEqn #-} +unfoldCrossEqn :: Monad m => Int -> Unfold m ((), ()) Int -> m () +unfoldCrossEqn maxVal input = + Type.result + $ Stream.mapM (Type.checkPair maxVal) + $ Stream.unfold (Unfold.cross input input) (undefined, undefined) + +{-# INLINE fairUnfoldCrossEqn #-} +fairUnfoldCrossEqn :: Monad m => Int -> Unfold m ((), ()) Int -> m () +fairUnfoldCrossEqn maxVal input = + Type.result + $ Stream.mapM (Type.checkPair maxVal) + $ Stream.unfold (Unfold.fairCross input input) (undefined, undefined) + +{-# INLINE fairUnfoldEachEqn #-} +fairUnfoldEachEqn :: Monad m => Int -> Unfold m ((), ()) Int -> Stream m Int -> m () +fairUnfoldEachEqn maxVal input ints = + let intu = Unfold.carryInput $ Unfold.lmap (const (undefined, undefined)) input + in Type.result + $ Stream.mapM (Type.checkPair maxVal) + $ Stream.fairUnfoldEach intu ints + +{-# INLINE unfoldSchedEqn #-} +unfoldSchedEqn :: Monad m => Int -> Unfold m ((), ()) Int -> Stream m Int -> m () +unfoldSchedEqn maxVal input ints = + let intu = Unfold.carryInput $ Unfold.lmap (const (undefined, undefined)) input + in Type.result + $ Stream.mapM (Type.checkPair maxVal) + $ Stream.unfoldSched intu ints + +{-# INLINE fairUnfoldSchedEqn #-} +fairUnfoldSchedEqn :: Monad m => Int -> Unfold m ((), ()) Int -> Stream m Int -> m () +fairUnfoldSchedEqn maxVal input ints = + let intu = Unfold.carryInput $ Unfold.lmap (const (undefined, undefined)) input + in Type.result + $ Stream.mapM (Type.checkPair maxVal) + $ Stream.fairUnfoldSched intu ints + +unfoldCrossBounded :: Int -> IO () +unfoldCrossBounded maxVal = unfoldCrossEqn maxVal (Type.boundedIntsUnfold maxVal 0) + +fairUnfoldCrossBounded :: Int -> IO () +fairUnfoldCrossBounded maxVal = fairUnfoldCrossEqn maxVal (Type.boundedIntsUnfold maxVal 0) + +fairUnfoldCrossInfinite :: Int -> IO () +fairUnfoldCrossInfinite maxVal = fairUnfoldCrossEqn maxVal (infiniteIntsUnfold maxVal 0) + +fairUnfoldEachBounded :: Int -> IO () +fairUnfoldEachBounded maxVal = withRandomIntIO $ \n -> + fairUnfoldEachEqn maxVal (Type.boundedIntsUnfold maxVal 0) (Type.boundedInts maxVal n) + +fairUnfoldEachInfinite :: Int -> IO () +fairUnfoldEachInfinite maxVal = withRandomIntIO $ \n -> + fairUnfoldEachEqn maxVal (infiniteIntsUnfold maxVal 0) (Type.infiniteInts maxVal n) + +unfoldSchedBounded :: Int -> IO () +unfoldSchedBounded maxVal = withRandomIntIO $ \n -> + unfoldSchedEqn maxVal (Type.boundedIntsUnfold maxVal 0) (Type.boundedInts maxVal n) + +fairUnfoldSchedBounded :: Int -> IO () +fairUnfoldSchedBounded maxVal = withRandomIntIO $ \n -> + fairUnfoldSchedEqn maxVal (Type.boundedIntsUnfold maxVal 0) (Type.boundedInts maxVal n) + +fairUnfoldSchedInfinite :: Int -> IO () +fairUnfoldSchedInfinite maxVal = withRandomIntIO $ \n -> + fairUnfoldSchedEqn maxVal (infiniteIntsUnfold maxVal 0) (Type.infiniteInts maxVal n) + +------------------------------------------------------------------------------- +-- Main +------------------------------------------------------------------------------- + +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + -- Solve simultaneous equations by exploring all possibilities + -- Unfold + [ (SpaceO_1, benchIO "equations/unfoldCross (bounded)" $ unfoldCrossBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairUnfoldCross (bounded)" $ fairUnfoldCrossBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairUnfoldCross (infinite)" $ fairUnfoldCrossInfinite sqrtVal) + , (SpaceO_1, benchIO "equations/fairUnfoldEach (bounded)" $ fairUnfoldEachBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairUnfoldEach (infinite)" $ fairUnfoldEachInfinite sqrtVal) + , (SpaceO_1, benchIO "equations/unfoldSched (bounded)" $ unfoldSchedBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairUnfoldSched (bounded)" $ fairUnfoldSchedBounded sqrtVal) + , (SpaceO_1, benchIO "equations/fairUnfoldSched (infinite)" $ fairUnfoldSchedInfinite sqrtVal) + ] + + where + + sqrtVal = round $ sqrt (fromIntegral size :: Double) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs index caeb25ec94..149abcacc3 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Group.hs @@ -7,6 +7,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} +-- {-# OPTIONS_GHC -fforce-recomp #-} #ifdef __HADDOCK_VERSION__ #undef INSPECTION diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Split.hs b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Split.hs index 3f4230f702..71be2343ee 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Parse/Split.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Parse/Split.hs @@ -9,6 +9,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} +-- {-# OPTIONS_GHC -fforce-recomp #-} #ifdef __HADDOCK_VERSION__ #undef INSPECTION diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Parse/SplitChunks.hs b/benchmark/Streamly/Benchmark/Data/Stream/Parse/SplitChunks.hs index 1723471e6f..dee978cc82 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Parse/SplitChunks.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Parse/SplitChunks.hs @@ -9,6 +9,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} +-- {-# OPTIONS_GHC -fforce-recomp #-} #ifdef __HADDOCK_VERSION__ #undef INSPECTION diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs index 5f26c1f620..6885f13a84 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Basic.hs @@ -11,6 +11,7 @@ {-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -Wno-orphans #-} +-- {-# OPTIONS_GHC -fforce-recomp #-} #ifdef __HADDOCK_VERSION__ #undef INSPECTION diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs index 45d156afbb..2148bfba5e 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform/Composed.hs @@ -11,6 +11,8 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RankNTypes #-} +-- {-# OPTIONS_GHC -fforce-recomp #-} + #ifdef __HADDOCK_VERSION__ #undef INSPECTION #endif diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index 5e98dc4180..1bc52d1b40 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -451,12 +451,15 @@ benchmark Data.Stream Stream.Eliminate Stream.Exceptions Stream.Nesting + Stream.Nesting.Basic + Stream.Nesting.LogicConcat + Stream.Nesting.LogicUnfold Stream.Generate Stream.Lift Stream.Parse Stream.Parse.Group Stream.Parse.Split - -- XXX uses lot of memory + -- Note: uses around 400MB during build Stream.Parse.SplitChunks Stream.Transform Stream.Transform.Basic @@ -466,6 +469,8 @@ benchmark Data.Stream Stream.Type.MultiStream Stream.Type.Nested Stream.Type.Logic + if flag(limit-build-mem) + ghc-options: +RTS -M500M -RTS benchmark Data.Stream.Adaptive import: bench-options-threaded From 87436655bd98b706eaf10fc7e65c69729abdfcfd Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Mon, 15 Jun 2026 03:01:15 +0530 Subject: [PATCH 16/20] Fix the "streamly" sdist build --- .packcheck.ignore | 2 +- streamly.cabal | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/.packcheck.ignore b/.packcheck.ignore index f2b44a794b..6b60d85e73 100644 --- a/.packcheck.ignore +++ b/.packcheck.ignore @@ -1,5 +1,6 @@ .circleci/config.yml .ghci +.github/workflows/freebsd.yml .github/workflows/haskell.yml .github/workflows/regression-check.yml .github/workflows/packdiff.yml @@ -8,7 +9,6 @@ .hlint.ignore .hlint.yaml .packcheck.ignore -.cirrus.yml appveyor.yml benchmark/bench-runner/cabal.project benchmark/bench-runner/flake.lock diff --git a/streamly.cabal b/streamly.cabal index 9acdf663e4..0b91785071 100644 --- a/streamly.cabal +++ b/streamly.cabal @@ -82,7 +82,11 @@ extra-source-files: benchmark/Streamly/Benchmark/Data/Scanl/*.hs benchmark/Streamly/Benchmark/Data/Serialize/*.hs benchmark/Streamly/Benchmark/Data/Stream/*.hs + benchmark/Streamly/Benchmark/Data/Stream/Nesting/*.hs + benchmark/Streamly/Benchmark/Data/Stream/Parse/*.hs benchmark/Streamly/Benchmark/Data/Stream/Prelude/*.hs + benchmark/Streamly/Benchmark/Data/Stream/Transform/*.hs + benchmark/Streamly/Benchmark/Data/Stream/Type/*.hs benchmark/Streamly/Benchmark/Data/StreamK/*.hs benchmark/Streamly/Benchmark/Data/Unfold/*.hs benchmark/Streamly/Benchmark/FileSystem/*.hs @@ -131,6 +135,8 @@ extra-source-files: test/Streamly/Test/Data/Parser/*.hs test/Streamly/Test/Data/ParserK.hs test/Streamly/Test/Data/Stream/*.hs + test/Streamly/Test/Data/Stream/MkType/*.hs + test/Streamly/Test/Data/Stream/Prelude/*.hs test/Streamly/Test/Data/Stream/Serial/Common.hs test/Streamly/Test/FileSystem/Event.hs test/Streamly/Test/FileSystem/Event/Common.hs From ca4a4dc55fec1ed977ed942902b4894a5ae5fbdf Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Mon, 15 Jun 2026 03:46:36 +0530 Subject: [PATCH 17/20] Merge Scanl.Window benchmark with "Scanl" --- .github/workflows/regression-check.yml | 2 -- benchmark/Streamly/Benchmark/Data/Scanl.hs | 3 +++ .../Streamly/Benchmark/Data/Scanl/Window.hs | 22 +++---------------- benchmark/streamly-benchmarks.cabal | 8 ++----- hie.yaml | 6 ++--- targets/Targets.hs | 15 ++----------- 6 files changed, 13 insertions(+), 43 deletions(-) diff --git a/.github/workflows/regression-check.yml b/.github/workflows/regression-check.yml index 9387360106..bffa55032e 100644 --- a/.github/workflows/regression-check.yml +++ b/.github/workflows/regression-check.yml @@ -29,7 +29,6 @@ jobs: Data.Array.Generic Data.Array.Stream Data.Fold - Data.Fold.Window Data.MutArray Data.Parser Data.ParserK @@ -38,7 +37,6 @@ jobs: Data.RingArray Data.Scanl Data.Scanl.Concurrent - Data.Scanl.Window Data.Serialize Data.Stream Data.Stream.Concurrent diff --git a/benchmark/Streamly/Benchmark/Data/Scanl.hs b/benchmark/Streamly/Benchmark/Data/Scanl.hs index e837806db2..0bbef4190d 100644 --- a/benchmark/Streamly/Benchmark/Data/Scanl.hs +++ b/benchmark/Streamly/Benchmark/Data/Scanl.hs @@ -47,6 +47,8 @@ import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common import Prelude hiding (last, length, all, any, take, unzip, sequence_) +import qualified Scanl.Window as Window + #ifdef INSPECTION import GHC.Types (SPEC(..)) import Streamly.Internal.Data.Stream (Step(..)) @@ -184,6 +186,7 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks allBenchmarks value = let allBenches = o_1_space_serial value + ++ Window.benchmarks value get x = map snd $ filter ((==) x . fst) allBenches o_1_space = get SpaceO_1 in diff --git a/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs b/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs index 416fe6aa31..f527dfb87d 100644 --- a/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs +++ b/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs @@ -1,4 +1,4 @@ -module Main (main) where +module Scanl.Window (benchmarks) where import Streamly.Internal.Data.Scanl (Scanl) import Streamly.Internal.Data.Stream (Stream) @@ -46,8 +46,8 @@ benchScanWith src len name f = benchWithPostscan :: Int -> String -> Scanl IO Double a -> Benchmark benchWithPostscan = benchScanWith source -o_1_space_scans :: Int -> [(SpaceComplexity, Benchmark)] -o_1_space_scans numElements = +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks numElements = [ (SpaceO_1, benchWithPostscan numElements "minimum (window size 10)" (Scanl.windowMinimum 10)) -- Below window size 30 the linear search based impl performs better @@ -95,19 +95,3 @@ o_1_space_scans numElements = , (SpaceO_1, benchWithPostscan numElements "powerSum 2 (window size 1000)" (Scanl.incrScan 1000 (Scanl.incrPowerSum 2))) ] - -moduleName :: String -moduleName = "Data.Scanl.Window" - -main :: IO () -main = runWithCLIOpts defaultStreamSize allBenchmarks - - where - - allBenchmarks value = - let allBenches = o_1_space_scans value - get x = map snd $ filter ((==) x . fst) allBenches - o_1_space = get SpaceO_1 - in - [ bgroup (o_1_space_prefix moduleName) o_1_space - ] diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index 1bc52d1b40..0a79f34608 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -398,13 +398,9 @@ benchmark Data.Scanl import: bench-options type: exitcode-stdio-1.0 hs-source-dirs: Streamly/Benchmark/Data + , Streamly/Benchmark/Data/Scanl main-is: Scanl.hs - -benchmark Data.Scanl.Window - import: bench-options - type: exitcode-stdio-1.0 - hs-source-dirs: Streamly/Benchmark/Data/Scanl - main-is: Window.hs + other-modules: Scanl.Window benchmark Data.Scanl.Concurrent import: bench-options diff --git a/hie.yaml b/hie.yaml index 8f2d36e070..20482b0c28 100644 --- a/hie.yaml +++ b/hie.yaml @@ -35,7 +35,7 @@ cradle: - path: "./benchmark/Streamly/Benchmark/Data/Fold/Prelood.hs" component: "bench:Data.Fold.Prelude" - path: "./benchmark/Streamly/Benchmark/Data/Fold/Window.hs" - component: "bench:Data.Fold.Window" + component: "bench:Data.Fold" - path: "./benchmark/Streamly/Benchmark/Data/MutArray.hs" component: "bench:Data.MutArray" - path: "./benchmark/Streamly/Benchmark/Data/" @@ -50,10 +50,10 @@ cradle: component: "bench:Data.RingArray" - path: "./benchmark/Streamly/Benchmark/Data/Scanl.hs" component: "bench:Data.Scanl" + - path: "./benchmark/Streamly/Benchmark/Data/Scanl/Window.hs" + component: "bench:Data.Scanl" - path: "./benchmark/Streamly/Benchmark/Data/Scanl/Concurrent.hs" component: "bench:Data.Scanl.Concurrent" - - path: "./benchmark/Streamly/Benchmark/Data/Scanl/Window.hs" - component: "bench:Data.Scanl.Window" - path: "./benchmark/Streamly/Benchmark/Data/Serialize.hs" component: "bench:Data.Serialize" - path: "./benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs" diff --git a/targets/Targets.hs b/targets/Targets.hs index 3a776bf0d8..d4ce001430 100644 --- a/targets/Targets.hs +++ b/targets/Targets.hs @@ -43,12 +43,7 @@ targets = , "streamly_core_grp" ] ) - , ("Data.Fold.Window", - [ "infinite_grp" - , "fold_parser_grp" - , "streamly_core_grp" - ] - ) + , ("Data.List", [ "list_grp" , "noBench" @@ -113,13 +108,7 @@ targets = , "noTest" ] ) - , ("Data.Scanl.Window", - [ "infinite_grp" - , "fold_parser_grp" - , "streamly_core_grp" - , "noTest" - ] - ) + , ("Data.Serialize", [ "mut_bytearray_grp" , "streamly_core_grp" From f17bd02bf7ade8151bd3f4f480689e16dc34fb80 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Mon, 15 Jun 2026 01:44:38 +0530 Subject: [PATCH 18/20] Remove Fold.Window, move remaining benches to Scanl Flatten the Fold benchmarks into a single list --- benchmark/Streamly/Benchmark/Data/Fold.hs | 159 ++++++--------- .../Streamly/Benchmark/Data/Fold/Window.hs | 189 ------------------ .../Streamly/Benchmark/Data/Scanl/Window.hs | 15 ++ benchmark/streamly-benchmarks.cabal | 15 +- streamly.cabal | 1 - 5 files changed, 86 insertions(+), 293 deletions(-) delete mode 100644 benchmark/Streamly/Benchmark/Data/Fold/Window.hs diff --git a/benchmark/Streamly/Benchmark/Data/Fold.hs b/benchmark/Streamly/Benchmark/Data/Fold.hs index 732bddc89f..4a82a4a67c 100644 --- a/benchmark/Streamly/Benchmark/Data/Fold.hs +++ b/benchmark/Streamly/Benchmark/Data/Fold.hs @@ -633,61 +633,6 @@ splitWithSuffixSeq str inh = $ Stream.foldMany (Fold.takeEndBySeq (toarr str) Fold.drain) $ Handle.read inh -- >>= print -o_1_space_reduce_read_split :: BenchEnv -> [(SpaceComplexity, Benchmark)] -o_1_space_reduce_read_split env = - -- NOTE: keep the benchmark names consistent with Data.Stream.split* - fmap (SpaceO_1,) - -- Splitting on single element - [ mkBench "takeEndBy_ infix (splitOn)" env $ \inh _ -> - fileInfixTakeEndBy_ inh - , mkBench "takeEndBy_ suffix (splitOnSuffix)" env $ \inh _ -> - fileSuffixTakeEndBy_ inh - , mkBench "takeEndBy_ suffix parseMany (splitOnSuffix)" env - $ \inh _ -> parseFileSuffixTakeEndBy_ inh - , mkBench "takeEndBy suffix (splitWithSuffix)" env $ \inh _ -> - fileSuffixTakeEndBy inh - - -- Splitting on sequence - -- Infix takeEndBySeq_ - , mkBench "takeEndBySeq_ infix empty pattern" env $ \inh _ -> - splitOnSeq "" inh - , mkBench "takeEndBySeq_ infix lf" env $ \inh _ -> - splitOnSeq "\n" inh - , mkBench "takeEndBySeq_ infix a" env $ \inh _ -> - splitOnSeq "a" inh - , mkBench "takeEndBySeq_ infix crlf" env $ \inh _ -> - splitOnSeq "\r\n" inh - , mkBench "takeEndBySeq_ infix aa" env $ \inh _ -> - splitOnSeq "aa" inh - , mkBench "takeEndBySeq_ infix aaaa" env $ \inh _ -> - splitOnSeq "aaaa" inh - , mkBench "takeEndBySeq_ infix abcdefgh" env $ \inh _ -> - splitOnSeq "abcdefgh" inh - , mkBench "takeEndBySeq_ infix abcdefghi" env $ \inh _ -> - splitOnSeq "abcdefghi" inh - , mkBench "takeEndBySeq_ infix catcatcatcatcat" env $ \inh _ -> - splitOnSeq "catcatcatcatcat" inh - , mkBench "takeEndBySeq_ infix abcdefghijklmnopqrstuvwxyz" - env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh - , mkBench "takeEndBySeq_ infix 100k long pattern" - env $ \inh _ -> splitOnSeq100k inh - - -- Suffix takeEndBySeq_ - , mkBench "takeEndBySeq_ suffix empty pattern" env $ \inh _ -> - splitOnSuffixSeq "" inh - , mkBench "takeEndBySeq_ suffix lf" env $ \inh _ -> - splitOnSuffixSeq "\n" inh - , mkBench "takeEndBySeq_ suffix crlf" env $ \inh _ -> - splitOnSuffixSeq "\r\n" inh - , mkBenchSmall "takeEndBySeq_ suffix abcdefghijklmnopqrstuvwxyz" - env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh - - -- Suffix takeEndBySeq - , mkBench "takeEndBySeq suffix crlf" env $ \inh _ -> - splitWithSuffixSeq "\r\n" inh - , mkBenchSmall "takeEndBySeq suffix abcdefghijklmnopqrstuvwxyz" - env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh - ] -- | Infix split on a character sequence. splitOnSeqUtf8 :: String -> Handle -> IO Int @@ -699,14 +644,6 @@ splitOnSeqUtf8 str inh = $ Unicode.decodeUtf8Chunks $ Handle.readChunks inh -- >>= print -o_1_space_reduce_toChunks_split :: BenchEnv -> [(SpaceComplexity, Benchmark)] -o_1_space_reduce_toChunks_split env = - fmap (SpaceO_1,) - [ mkBenchSmall "takeEndBySeq_ infix abcdefgh (Utf8)" - env $ \inh _ -> splitOnSeqUtf8 "abcdefgh" inh - , mkBenchSmall "takeEndBySeq_ infix abcdefghijklmnopqrstuvwxyz (Utf8)" - env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh - ] ------------------------------------------------------------------------------- -- Distributing by parallel application @@ -1055,10 +992,67 @@ instance NFData a => NFData (Stream Identity a) where {-# INLINE rnf #-} rnf xs = runIdentity $ Stream.fold (FL.foldl' (\_ x -> rnf x) ()) xs -o_1_space_serial_elimination :: Int -> [(SpaceComplexity, Benchmark)] -o_1_space_serial_elimination value = +benchmarks :: BenchEnv -> Int -> [(SpaceComplexity, Benchmark)] +benchmarks env value = + -- NOTE: keep the benchmark names consistent with Data.Stream.split* + -- Splitting on single element fmap (SpaceO_1,) - [ benchIO "drain" $ drain value + [ mkBench "takeEndBy_ infix (splitOn)" env $ \inh _ -> + fileInfixTakeEndBy_ inh + , mkBench "takeEndBy_ suffix (splitOnSuffix)" env $ \inh _ -> + fileSuffixTakeEndBy_ inh + , mkBench "takeEndBy_ suffix parseMany (splitOnSuffix)" env + $ \inh _ -> parseFileSuffixTakeEndBy_ inh + , mkBench "takeEndBy suffix (splitWithSuffix)" env $ \inh _ -> + fileSuffixTakeEndBy inh + + -- Splitting on sequence + -- Infix takeEndBySeq_ + , mkBench "takeEndBySeq_ infix empty pattern" env $ \inh _ -> + splitOnSeq "" inh + , mkBench "takeEndBySeq_ infix lf" env $ \inh _ -> + splitOnSeq "\n" inh + , mkBench "takeEndBySeq_ infix a" env $ \inh _ -> + splitOnSeq "a" inh + , mkBench "takeEndBySeq_ infix crlf" env $ \inh _ -> + splitOnSeq "\r\n" inh + , mkBench "takeEndBySeq_ infix aa" env $ \inh _ -> + splitOnSeq "aa" inh + , mkBench "takeEndBySeq_ infix aaaa" env $ \inh _ -> + splitOnSeq "aaaa" inh + , mkBench "takeEndBySeq_ infix abcdefgh" env $ \inh _ -> + splitOnSeq "abcdefgh" inh + , mkBench "takeEndBySeq_ infix abcdefghi" env $ \inh _ -> + splitOnSeq "abcdefghi" inh + , mkBench "takeEndBySeq_ infix catcatcatcatcat" env $ \inh _ -> + splitOnSeq "catcatcatcatcat" inh + , mkBench "takeEndBySeq_ infix abcdefghijklmnopqrstuvwxyz" + env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh + , mkBench "takeEndBySeq_ infix 100k long pattern" + env $ \inh _ -> splitOnSeq100k inh + + -- Suffix takeEndBySeq_ + , mkBench "takeEndBySeq_ suffix empty pattern" env $ \inh _ -> + splitOnSuffixSeq "" inh + , mkBench "takeEndBySeq_ suffix lf" env $ \inh _ -> + splitOnSuffixSeq "\n" inh + , mkBench "takeEndBySeq_ suffix crlf" env $ \inh _ -> + splitOnSuffixSeq "\r\n" inh + , mkBenchSmall "takeEndBySeq_ suffix abcdefghijklmnopqrstuvwxyz" + env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh + + -- Suffix takeEndBySeq + , mkBench "takeEndBySeq suffix crlf" env $ \inh _ -> + splitWithSuffixSeq "\r\n" inh + , mkBenchSmall "takeEndBySeq suffix abcdefghijklmnopqrstuvwxyz" + env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh + + , mkBenchSmall "takeEndBySeq_ infix abcdefgh (Utf8)" + env $ \inh _ -> splitOnSeqUtf8 "abcdefgh" inh + , mkBenchSmall "takeEndBySeq_ infix abcdefghijklmnopqrstuvwxyz (Utf8)" + env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh + + , benchIO "drain" $ drain value , benchIO "drainBy" $ drainBy value , benchIO "drainN" $ drainN value , benchIO "last" $ last value @@ -1099,12 +1093,8 @@ o_1_space_serial_elimination value = , benchIO "takeEndBy_" $ takeEndBy_ value , benchIO "and" $ and value , benchIO "or" $ or value - ] -o_1_space_serial_transformation :: Int -> [(SpaceComplexity, Benchmark)] -o_1_space_serial_transformation value = - fmap (SpaceO_1,) - [ benchIO "map" $ map value + , benchIO "map" $ map value , benchIO "mapMaybe" $ mapMaybe value , benchIO "rsequence" $ rsequence value , benchIO "rmapM" $ rmapM value @@ -1115,12 +1105,8 @@ o_1_space_serial_transformation value = , benchIO "fold-scan" $ foldScanl value , benchIO "fold-scanMany" $ foldScanlMany value , benchIO "fold-postscan" $ foldPostscanl value - ] -o_1_space_serial_composition :: Int -> [(SpaceComplexity, Benchmark)] -o_1_space_serial_composition value = - fmap (SpaceO_1,) - [ benchIO "filter even" $ filter value + , benchIO "filter even" $ filter value , benchIO "scanMaybe even" $ scanMaybe value , benchIO "scanMaybe even, odd" $ scanMaybe2 value , benchIO "foldBreak (recursive)" $ foldBreak value @@ -1142,15 +1128,9 @@ o_1_space_serial_composition value = , benchIO "unzipWithFstM (sum, length)" $ unzipWithFstM value , benchIO "unzipWithMinM (sum, length)" $ unzipWithMinM value ] - -o_n_space_serial :: Int -> [(SpaceComplexity, Benchmark)] -o_n_space_serial value = - [ (SpaceO_n, benchIO "sequence_/100" $ sequenceFolds (value `div` 100)) - ] - -o_n_heap_serial :: Int -> [(SpaceComplexity, Benchmark)] -o_n_heap_serial value = - fmap (HeapO_n,) + ++ [ (SpaceO_n, benchIO "sequence_/100" $ sequenceFolds (value `div` 100)) + ] + ++ fmap (HeapO_n,) -- Left folds for building a structure are inherently non-streaming -- as the structure cannot be lazily consumed until fully built. [ benchIO "toList" $ toList value @@ -1184,14 +1164,7 @@ main = do where allBenchmarks env value = - let allBenches = - o_1_space_serial_elimination value - ++ o_1_space_serial_transformation value - ++ o_1_space_serial_composition value - ++ o_1_space_reduce_read_split env - ++ o_1_space_reduce_toChunks_split env - ++ o_n_space_serial value - ++ o_n_heap_serial value + let allBenches = benchmarks env value get x = [b | (c, b) <- allBenches, c == x] o_1_space = get SpaceO_1 o_n_heap = get HeapO_n diff --git a/benchmark/Streamly/Benchmark/Data/Fold/Window.hs b/benchmark/Streamly/Benchmark/Data/Fold/Window.hs deleted file mode 100644 index b9335a3e87..0000000000 --- a/benchmark/Streamly/Benchmark/Data/Fold/Window.hs +++ /dev/null @@ -1,189 +0,0 @@ -{-# OPTIONS_GHC -Wno-deprecations #-} - -module Main (main) where - -import Control.DeepSeq (NFData) -import Streamly.Data.Fold (Fold) -import Streamly.Internal.Data.Stream (Stream) -import System.Random (randomRIO) - -import qualified Streamly.Data.Fold as Fold -import qualified Streamly.Internal.Data.Fold as Window -import qualified Streamly.Internal.Data.RingArray as RingArray -import qualified Streamly.Internal.Data.Stream as Stream - -import Streamly.Benchmark.Common -import Test.Tasty.Bench - -{-# INLINE source #-} -source :: (Monad m, Num a, Stream.Enumerable a) => - Int -> a -> Stream m a -source len from = - Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len) - -{-# INLINE sourceDescending #-} -sourceDescending :: (Monad m, Num a, Stream.Enumerable a) => - Int -> a -> Stream m a -sourceDescending len from = - Stream.enumerateFromThenTo - (from + fromIntegral len) - (from + fromIntegral (len - 1)) - from - -{-# INLINE sourceDescendingInt #-} -sourceDescendingInt :: Monad m => Int -> Int -> Stream m Int -sourceDescendingInt = sourceDescending - -{-# INLINE benchWith #-} -benchWith :: (Num a, NFData b) => - (Int -> a -> Stream IO a) -> Int -> String -> Fold IO a b -> Benchmark -benchWith src len name f = - bench name - $ nfIO - $ randomRIO (1, 1 :: Int) >>= Stream.fold f . src len . fromIntegral - -{-# INLINE benchWithFold #-} -benchWithFold :: NFData a => Int -> String -> Fold IO Double a -> Benchmark -benchWithFold = benchWith source - -{-# INLINE benchWithFoldInt #-} -benchWithFoldInt :: Int -> String -> Fold IO Int Int -> Benchmark -benchWithFoldInt = benchWith source - -{-# INLINE benchScanWith #-} -benchScanWith :: Num a => - (Int -> a -> Stream IO a) -> Int -> String -> Fold IO a b -> Benchmark -benchScanWith src len name f = - bench name - $ nfIO - $ randomRIO (1, 1 :: Int) - >>= Stream.fold Fold.drain - . Stream.postscan f - . src len - . fromIntegral - -{-# INLINE benchWithPostscan #-} -benchWithPostscan :: Int -> String -> Fold IO Double a -> Benchmark -benchWithPostscan = benchScanWith source - -o_1_space_folds :: Int -> [(SpaceComplexity, Benchmark)] -o_1_space_folds numElements = - [ (SpaceO_1, benchWithFold numElements "fold minimum (window size 100)" - (Window.windowMinimum 100)) - , (SpaceO_1, benchWithFold numElements "fold minimum (window size 1000)" - (Window.windowMinimum 1000)) - , (SpaceO_1, benchWith sourceDescendingInt numElements - "fold minimum descending (window size 1000)" - (Window.windowMinimum 1000)) - - , (SpaceO_1, benchWithFold numElements "fold maximum (window size 100)" - (Window.windowMaximum 100)) - , (SpaceO_1, benchWithFold numElements "fold maximum (window size 1000)" - (Window.windowMaximum 1000)) - , (SpaceO_1, benchWith sourceDescendingInt numElements - "fold maximum descending (window size 1000)" - (Window.windowMaximum 1000)) - - , (SpaceO_1, benchWithFold numElements "fold range (window size 100)" - (Window.windowRange 100)) - , (SpaceO_1, benchWithFold numElements "fold range (window size 1000)" - (Window.windowRange 1000)) - , (SpaceO_1, benchWith sourceDescendingInt numElements - "fold range descending (window size 1000)" - (Window.windowRange 1000)) - - , (SpaceO_1, benchWithFoldInt numElements "fold sumInt (window size 100)" - (RingArray.slidingWindow 100 Window.windowSumInt)) - , (SpaceO_1, benchWithFoldInt numElements "fold sum for Int (window size 100)" - (RingArray.slidingWindow 100 Window.windowSum)) - , (SpaceO_1, benchWithFold numElements "fold sum (window size 100)" - (RingArray.slidingWindow 100 Window.windowSum)) - , (SpaceO_1, benchWithFold numElements "fold sum (window size 1000)" - (RingArray.slidingWindow 1000 Window.windowSum)) - , (SpaceO_1, benchWithFold numElements "fold sum (entire stream)" - (Window.cumulative Window.windowSum)) - , (SpaceO_1, benchWithFold numElements "fold sum (Data.Fold)" - Fold.sum) - - , (SpaceO_1, benchWithFold numElements "fold mean (window size 100)" - (RingArray.slidingWindow 100 Window.windowMean)) - , (SpaceO_1, benchWithFold numElements "fold mean (window size 1000)" - (RingArray.slidingWindow 1000 Window.windowMean)) - , (SpaceO_1, benchWithFold numElements "fold mean (entire stream)" - (Window.cumulative Window.windowMean)) - , (SpaceO_1, benchWithFold numElements "fold mean (Data.Fold)" - Fold.mean) - - , (SpaceO_1, benchWithFold numElements "fold powerSum 2 (window size 100)" - (RingArray.slidingWindow 100 (Window.windowPowerSum 2))) - , (SpaceO_1, benchWithFold numElements "fold powerSum 2 (entire stream)" - (Window.cumulative (Window.windowPowerSum 2))) - ] - -o_1_space_scans :: Int -> [(SpaceComplexity, Benchmark)] -o_1_space_scans numElements = - [ (SpaceO_1, benchWithPostscan numElements "scan minimum (window size 10)" - (Window.windowMinimum 10)) - -- Below window size 30 the linear search based impl performs better - -- than the dequeue based implementation. - , (SpaceO_1, benchWithPostscan numElements "scan minimum (window size 30)" - (Window.windowMinimum 30)) - , (SpaceO_1, benchWithPostscan numElements "scan minimum (window size 1000)" - (Window.windowMinimum 1000)) - , (SpaceO_1, benchScanWith sourceDescendingInt numElements - "scan minimum descending (window size 1000)" - (Window.windowMinimum 1000)) - - , (SpaceO_1, benchWithPostscan numElements "scan maximum (window size 10)" - (Window.windowMaximum 10)) - , (SpaceO_1, benchWithPostscan numElements "scan maximum (window size 30)" - (Window.windowMaximum 30)) - , (SpaceO_1, benchWithPostscan numElements "scan maximum (window size 1000)" - (Window.windowMaximum 1000)) - , (SpaceO_1, benchScanWith sourceDescendingInt numElements - "scan maximum descending (window size 1000)" - (Window.windowMaximum 1000)) - - , (SpaceO_1, benchWithPostscan numElements "scan range (window size 10)" - (Window.windowRange 10)) - , (SpaceO_1, benchWithPostscan numElements "scan range (window size 30)" - (Window.windowRange 30)) - , (SpaceO_1, benchWithPostscan numElements "scan range (window size 1000)" - (Window.windowRange 1000)) - , (SpaceO_1, benchScanWith sourceDescendingInt numElements - "scan range descending (window size 1000)" - (Window.windowRange 1000)) - - , (SpaceO_1, benchWithPostscan numElements "scan sum (window size 100)" - (RingArray.slidingWindow 100 Window.windowSum)) - , (SpaceO_1, benchWithPostscan numElements "scan sum (window size 1000)" - (RingArray.slidingWindow 1000 Window.windowSum)) - - , (SpaceO_1, benchWithPostscan numElements "scan mean (window size 100)" - (RingArray.slidingWindow 100 Window.windowMean)) - , (SpaceO_1, benchWithPostscan numElements "scan mean (window size 1000)" - (RingArray.slidingWindow 1000 Window.windowMean)) - - , (SpaceO_1, benchWithPostscan numElements "scan powerSum 2 (window size 100)" - (RingArray.slidingWindow 100 (Window.windowPowerSum 2))) - , (SpaceO_1, benchWithPostscan numElements "scan powerSum 2 (window size 1000)" - (RingArray.slidingWindow 1000 (Window.windowPowerSum 2))) - ] - -moduleName :: String -moduleName = "Data.Fold.Window" - -main :: IO () -main = runWithCLIOpts defaultStreamSize allBenchmarks - - where - - allBenchmarks value = - let allBenches = - o_1_space_folds value - ++ o_1_space_scans value - get x = map snd $ filter ((==) x . fst) allBenches - o_1_space = get SpaceO_1 - in - [ bgroup (o_1_space_prefix moduleName) o_1_space - ] diff --git a/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs b/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs index f527dfb87d..9a1a23dfcf 100644 --- a/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs +++ b/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs @@ -46,6 +46,10 @@ benchScanWith src len name f = benchWithPostscan :: Int -> String -> Scanl IO Double a -> Benchmark benchWithPostscan = benchScanWith source +{-# INLINE benchWithPostscanInt #-} +benchWithPostscanInt :: Int -> String -> Scanl IO Int a -> Benchmark +benchWithPostscanInt = benchScanWith source + benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks numElements = [ (SpaceO_1, benchWithPostscan numElements "minimum (window size 10)" @@ -84,14 +88,25 @@ benchmarks numElements = (Scanl.incrScan 100 Scanl.incrSum)) , (SpaceO_1, benchWithPostscan numElements "sum (window size 1000)" (Scanl.incrScan 1000 Scanl.incrSum)) + , (SpaceO_1, benchWithPostscan numElements "sum (entire stream)" + (Scanl.cumulativeScan Scanl.incrSum)) + + , (SpaceO_1, benchWithPostscanInt numElements "sumInt (window size 100)" + (Scanl.incrScan 100 Scanl.incrSumInt)) + , (SpaceO_1, benchWithPostscanInt numElements "sumInt (window size 1000)" + (Scanl.incrScan 1000 Scanl.incrSumInt)) , (SpaceO_1, benchWithPostscan numElements "mean (window size 100)" (Scanl.incrScan 100 Scanl.incrMean)) , (SpaceO_1, benchWithPostscan numElements "mean (window size 1000)" (Scanl.incrScan 1000 Scanl.incrMean)) + , (SpaceO_1, benchWithPostscan numElements "mean (entire stream)" + (Scanl.cumulativeScan Scanl.incrMean)) , (SpaceO_1, benchWithPostscan numElements "powerSum 2 (window size 100)" (Scanl.incrScan 100 (Scanl.incrPowerSum 2))) , (SpaceO_1, benchWithPostscan numElements "powerSum 2 (window size 1000)" (Scanl.incrScan 1000 (Scanl.incrPowerSum 2))) + , (SpaceO_1, benchWithPostscan numElements "powerSum 2 (entire stream)" + (Scanl.cumulativeScan (Scanl.incrPowerSum 2))) ] diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index 0a79f34608..deaa6ae41e 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -278,6 +278,7 @@ benchmark Data.Fold import: bench-options type: exitcode-stdio-1.0 hs-source-dirs: Streamly/Benchmark/Data + , Streamly/Benchmark/Data/Fold main-is: Fold.hs if impl(ghcjs) buildable: False @@ -285,6 +286,10 @@ benchmark Data.Fold buildable: True if flag(limit-build-mem) && !flag(fusion-plugin) ghc-options: +RTS -M600M -RTS + -- MonoLocalBinds increases the memory requirement from 400MB to 1000MB, + -- observed on macOS. + -- if flag(limit-build-mem) + -- ghc-options: +RTS -M1000M -RTS benchmark Data.Fold.Prelude import: bench-options @@ -297,16 +302,6 @@ benchmark Data.Fold.Prelude else buildable: True -benchmark Data.Fold.Window - import: bench-options - type: exitcode-stdio-1.0 - hs-source-dirs: Streamly/Benchmark/Data/Fold - main-is: Window.hs - -- MonoLocalBinds increases the memory requirement from 400MB to 1000MB, - -- observed on macOS. - -- if flag(limit-build-mem) - -- ghc-options: +RTS -M1000M -RTS - benchmark Data.MutArray import: bench-options type: exitcode-stdio-1.0 diff --git a/streamly.cabal b/streamly.cabal index 0b91785071..bcd8d0a4ee 100644 --- a/streamly.cabal +++ b/streamly.cabal @@ -75,7 +75,6 @@ extra-source-files: benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs benchmark/Streamly/Benchmark/Data/Array/Stream.hs benchmark/Streamly/Benchmark/Data/Fold/*.hs - benchmark/Streamly/Benchmark/Data/Fold/Window.hs benchmark/Streamly/Benchmark/Data/MutArray.hs benchmark/Streamly/Benchmark/Data/Parser/*.hs benchmark/Streamly/Benchmark/Data/RingArray.hs From 7b7288df90eacca85743d90d88882370b35757b3 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Mon, 15 Jun 2026 19:03:49 +0530 Subject: [PATCH 19/20] Change Scanl benchmark names after the ops --- .../Streamly/Benchmark/Data/Scanl/Window.hs | 46 +++++++++---------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs b/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs index 9a1a23dfcf..ea6c452fa2 100644 --- a/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs +++ b/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs @@ -52,61 +52,61 @@ benchWithPostscanInt = benchScanWith source benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks numElements = - [ (SpaceO_1, benchWithPostscan numElements "minimum (window size 10)" + [ (SpaceO_1, benchWithPostscan numElements "windowMinimum 10" (Scanl.windowMinimum 10)) -- Below window size 30 the linear search based impl performs better -- than the dequeue based implementation. - , (SpaceO_1, benchWithPostscan numElements "minimum (window size 30)" + , (SpaceO_1, benchWithPostscan numElements "windowMinimum 30" (Scanl.windowMinimum 30)) - , (SpaceO_1, benchWithPostscan numElements "minimum (window size 1000)" + , (SpaceO_1, benchWithPostscan numElements "windowMinimum 1000" (Scanl.windowMinimum 1000)) , (SpaceO_1, benchScanWith sourceDescendingInt numElements - "minimum descending (window size 1000)" + "windowMinimum 1000 descending" (Scanl.windowMinimum 1000)) - , (SpaceO_1, benchWithPostscan numElements "maximum (window size 10)" + , (SpaceO_1, benchWithPostscan numElements "windowMaximum 10" (Scanl.windowMaximum 10)) - , (SpaceO_1, benchWithPostscan numElements "maximum (window size 30)" + , (SpaceO_1, benchWithPostscan numElements "windowMaximum 30" (Scanl.windowMaximum 30)) - , (SpaceO_1, benchWithPostscan numElements "maximum (window size 1000)" + , (SpaceO_1, benchWithPostscan numElements "windowMaximum 1000" (Scanl.windowMaximum 1000)) , (SpaceO_1, benchScanWith sourceDescendingInt numElements - "maximum descending (window size 1000)" + "windowMaximum 1000 descending" (Scanl.windowMaximum 1000)) - , (SpaceO_1, benchWithPostscan numElements "range (window size 10)" + , (SpaceO_1, benchWithPostscan numElements "windowRange 10" (Scanl.windowRange 10)) - , (SpaceO_1, benchWithPostscan numElements "range (window size 30)" + , (SpaceO_1, benchWithPostscan numElements "windowRange 30" (Scanl.windowRange 30)) - , (SpaceO_1, benchWithPostscan numElements "range (window size 1000)" + , (SpaceO_1, benchWithPostscan numElements "windowRange 1000" (Scanl.windowRange 1000)) , (SpaceO_1, benchScanWith sourceDescendingInt numElements - "range descending (window size 1000)" + "windowRange 1000 descending" (Scanl.windowRange 1000)) - , (SpaceO_1, benchWithPostscan numElements "sum (window size 100)" + , (SpaceO_1, benchWithPostscan numElements "incrSum 100" (Scanl.incrScan 100 Scanl.incrSum)) - , (SpaceO_1, benchWithPostscan numElements "sum (window size 1000)" + , (SpaceO_1, benchWithPostscan numElements "incrSum 1000" (Scanl.incrScan 1000 Scanl.incrSum)) - , (SpaceO_1, benchWithPostscan numElements "sum (entire stream)" + , (SpaceO_1, benchWithPostscan numElements "incrSum cumulative" (Scanl.cumulativeScan Scanl.incrSum)) - , (SpaceO_1, benchWithPostscanInt numElements "sumInt (window size 100)" + , (SpaceO_1, benchWithPostscanInt numElements "incrSumInt 100" (Scanl.incrScan 100 Scanl.incrSumInt)) - , (SpaceO_1, benchWithPostscanInt numElements "sumInt (window size 1000)" + , (SpaceO_1, benchWithPostscanInt numElements "incrSumInt 1000" (Scanl.incrScan 1000 Scanl.incrSumInt)) - , (SpaceO_1, benchWithPostscan numElements "mean (window size 100)" + , (SpaceO_1, benchWithPostscan numElements "incrMean 100" (Scanl.incrScan 100 Scanl.incrMean)) - , (SpaceO_1, benchWithPostscan numElements "mean (window size 1000)" + , (SpaceO_1, benchWithPostscan numElements "incrMean 1000" (Scanl.incrScan 1000 Scanl.incrMean)) - , (SpaceO_1, benchWithPostscan numElements "mean (entire stream)" + , (SpaceO_1, benchWithPostscan numElements "incrMean cumulative" (Scanl.cumulativeScan Scanl.incrMean)) - , (SpaceO_1, benchWithPostscan numElements "powerSum 2 (window size 100)" + , (SpaceO_1, benchWithPostscan numElements "incrPowerSum 2 100" (Scanl.incrScan 100 (Scanl.incrPowerSum 2))) - , (SpaceO_1, benchWithPostscan numElements "powerSum 2 (window size 1000)" + , (SpaceO_1, benchWithPostscan numElements "incrPowerSum 2 1000" (Scanl.incrScan 1000 (Scanl.incrPowerSum 2))) - , (SpaceO_1, benchWithPostscan numElements "powerSum 2 (entire stream)" + , (SpaceO_1, benchWithPostscan numElements "incrPowerSum 2" (Scanl.cumulativeScan (Scanl.incrPowerSum 2))) ] From 105bf3085b55b2e5f30c94aed7281d44e588dffb Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Mon, 15 Jun 2026 19:50:40 +0530 Subject: [PATCH 20/20] Remove deprecation warning suppression --- benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs | 2 -- benchmark/Streamly/Benchmark/Unicode/Char.hs | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs b/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs index 01461471ff..e62fb622d1 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-deprecations #-} - {-# LANGUAGE CPP #-} #include "Streamly/Benchmark/Data/Array/CommonImports.hs" diff --git a/benchmark/Streamly/Benchmark/Unicode/Char.hs b/benchmark/Streamly/Benchmark/Unicode/Char.hs index 47bedbb310..adb3e2889b 100644 --- a/benchmark/Streamly/Benchmark/Unicode/Char.hs +++ b/benchmark/Streamly/Benchmark/Unicode/Char.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -Wno-deprecations -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- -- Module : Streamly.Unicode.Char