From fbe84ec9a5659d01082aa55ec2a709faa0feb81f Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Thu, 11 Jun 2026 02:36:01 +0530 Subject: [PATCH 1/8] Add space complexity tags to all benchmarks --- benchmark/Streamly/Benchmark/Data/Array.hs | 22 ++- .../Streamly/Benchmark/Data/Array/Common.hs | 10 +- .../Streamly/Benchmark/Data/Array/Generic.hs | 22 ++- .../Benchmark/Data/Array/SmallArray.hs | 16 ++- .../Streamly/Benchmark/Data/Array/Stream.hs | 11 +- benchmark/Streamly/Benchmark/Data/Fold.hs | 47 ++++--- .../Streamly/Benchmark/Data/Fold/Prelood.hs | 12 +- .../Streamly/Benchmark/Data/Fold/Window.hs | 23 ++-- benchmark/Streamly/Benchmark/Data/MutArray.hs | 36 +++-- benchmark/Streamly/Benchmark/Data/ParserK.hs | 58 ++++---- .../Streamly/Benchmark/Data/RingArray.hs | 25 +++- benchmark/Streamly/Benchmark/Data/Scanl.hs | 14 +- .../Benchmark/Data/Scanl/Concurrent.hs | 14 +- .../Streamly/Benchmark/Data/Scanl/Window.hs | 14 +- benchmark/Streamly/Benchmark/Data/Stream.hs | 29 ++-- .../Benchmark/Data/Stream/Eliminate.hs | 32 ++--- .../Benchmark/Data/Stream/Exceptions.hs | 13 +- .../Streamly/Benchmark/Data/Stream/Expand.hs | 47 ++++--- .../Benchmark/Data/Stream/Generate.hs | 9 +- .../Streamly/Benchmark/Data/Stream/Lift.hs | 7 +- .../Streamly/Benchmark/Data/Stream/Reduce.hs | 37 +++-- .../Streamly/Benchmark/Data/Stream/Split.hs | 8 +- .../Benchmark/Data/Stream/SplitChunks.hs | 8 +- .../Benchmark/Data/Stream/Transform.hs | 37 +++-- benchmark/Streamly/Benchmark/Data/StreamK.hs | 130 ++++++++++-------- benchmark/Streamly/Benchmark/Data/Unfold.hs | 72 +++++----- benchmark/streamly-benchmarks.cabal | 3 + 27 files changed, 439 insertions(+), 317 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Array.hs b/benchmark/Streamly/Benchmark/Data/Array.hs index 4a3c875af6..70b40ee68e 100644 --- a/benchmark/Streamly/Benchmark/Data/Array.hs +++ b/benchmark/Streamly/Benchmark/Data/Array.hs @@ -132,14 +132,26 @@ moduleName = "Data.Array" defStreamSize :: Int 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) + ++ commonBenchmarks size + main :: IO () main = runWithCLIOpts defStreamSize allBenchmarks where allBenchmarks size = - [ bgroup (o_1_space_prefix moduleName) $ - o_1_space_generation size ++ o_1_space_elimination size - , bgroup (o_n_space_prefix moduleName) $ - o_n_heap_serial size - ] ++ commonBenchmarks size + let allBenches = benchmarks size + get x = fmap snd $ filter ((==) x . fst) allBenches + o_1_space = get SpaceO_1 + o_n_heap = get HeapO_n + o_n_space = get SpaceO_n + in + [ bgroup (o_1_space_prefix moduleName) o_1_space + , bgroup (o_n_heap_prefix moduleName) o_n_heap + , bgroup (o_n_space_prefix moduleName) o_n_space + ] diff --git a/benchmark/Streamly/Benchmark/Data/Array/Common.hs b/benchmark/Streamly/Benchmark/Data/Array/Common.hs index 6d7e6b87e0..6d265297b5 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Common.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Common.hs @@ -172,14 +172,12 @@ common_o_1_space_transformationX4 value = ] ] -commonBenchmarks :: Int -> [Benchmark] +commonBenchmarks :: Int -> [(SpaceComplexity, Benchmark)] commonBenchmarks size = - [ bgroup (o_1_space_prefix moduleName) $ concat + 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 - ] - , bgroup (o_n_space_prefix moduleName) $ - common_o_n_heap_serial size - ] + ]) + ++ fmap (HeapO_n,) (common_o_n_heap_serial size) diff --git a/benchmark/Streamly/Benchmark/Data/Array/Generic.hs b/benchmark/Streamly/Benchmark/Data/Array/Generic.hs index dbe1a31633..9a0bd7d227 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Generic.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Generic.hs @@ -105,14 +105,26 @@ moduleName = "Data.Array.Generic" defStreamSize :: Int 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) + ++ commonBenchmarks size + main :: IO () main = runWithCLIOpts defStreamSize allBenchmarks where allBenchmarks size = - [ bgroup (o_1_space_prefix moduleName) $ - o_1_space_generation size ++ o_1_space_elimination size - , bgroup (o_n_space_prefix moduleName) $ - o_n_heap_serial size - ] ++ commonBenchmarks size + let allBenches = benchmarks size + get x = fmap snd $ filter ((==) x . fst) allBenches + o_1_space = get SpaceO_1 + o_n_heap = get HeapO_n + o_n_space = get SpaceO_n + in + [ bgroup (o_1_space_prefix moduleName) o_1_space + , bgroup (o_n_heap_prefix moduleName) o_n_heap + , bgroup (o_n_space_prefix moduleName) o_n_space + ] diff --git a/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs b/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs index 4d68a43a09..4790d14a23 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs @@ -85,11 +85,23 @@ moduleName = "Data.SmallArray" defStreamSize :: Int defStreamSize = 128 +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + fmap (SpaceO_1,) (o_1_space_generation size) ++ commonBenchmarks size + main :: IO () main = runWithCLIOpts defStreamSize allBenchmarks where allBenchmarks size = - bgroup (o_1_space_prefix moduleName) (o_1_space_generation size) - : commonBenchmarks size + let allBenches = benchmarks size + get x = fmap snd $ filter ((==) x . fst) allBenches + o_1_space = get SpaceO_1 + o_n_heap = get HeapO_n + o_n_space = get SpaceO_n + in + [ bgroup (o_1_space_prefix moduleName) o_1_space + , bgroup (o_n_heap_prefix moduleName) o_n_heap + , bgroup (o_n_space_prefix moduleName) o_n_space + ] diff --git a/benchmark/Streamly/Benchmark/Data/Array/Stream.hs b/benchmark/Streamly/Benchmark/Data/Array/Stream.hs index 2390eeb25a..40699895f4 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Stream.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Stream.hs @@ -300,11 +300,18 @@ main = do big <- Stream.toList $ Array.chunksOf value $ sourceUnfoldrM value 0 return (small, big) - allBenchmarks env arrays value = + benchmarks env arrays value = let (arraysSmall, arraysBig) = arrays - in [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat + 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 ] + + allBenchmarks env arrays value = + let allBenches = benchmarks env arrays 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/Fold.hs b/benchmark/Streamly/Benchmark/Data/Fold.hs index db65641959..b12cf4d7df 100644 --- a/benchmark/Streamly/Benchmark/Data/Fold.hs +++ b/benchmark/Streamly/Benchmark/Data/Fold.hs @@ -633,9 +633,10 @@ splitWithSuffixSeq str inh = $ Stream.foldMany (Fold.takeEndBySeq (toarr str) Fold.drain) $ Handle.read inh -- >>= print -o_1_space_reduce_read_split :: BenchEnv -> [Benchmark] +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 [ @@ -704,8 +705,9 @@ splitOnSeqUtf8 str inh = $ Unicode.decodeUtf8Chunks $ Handle.readChunks inh -- >>= print -o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark] +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 @@ -1061,8 +1063,9 @@ 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 -> [Benchmark] +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 @@ -1108,8 +1111,9 @@ o_1_space_serial_elimination value = ] ] -o_1_space_serial_transformation :: Int -> [Benchmark] +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 @@ -1125,8 +1129,9 @@ o_1_space_serial_transformation value = ] ] -o_1_space_serial_composition :: Int -> [Benchmark] +o_1_space_serial_composition :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_serial_composition value = + fmap (SpaceO_1,) [ bgroup "composition" [ benchIO "filter even" $ filter value @@ -1153,13 +1158,14 @@ o_1_space_serial_composition value = ] ] -o_n_space_serial :: Int -> [Benchmark] +o_n_space_serial :: Int -> [(SpaceComplexity, Benchmark)] o_n_space_serial value = - [ benchIO "sequence_/100" $ sequenceFolds (value `div` 100) + [ (SpaceO_n, benchIO "sequence_/100" $ sequenceFolds (value `div` 100)) ] -o_n_heap_serial :: Int -> [Benchmark] +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. @@ -1199,15 +1205,22 @@ main = do where allBenchmarks env value = - [ bgroup (o_1_space_prefix moduleName) $ concat - [ 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 - ] - , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value) - , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial 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 + get x = [b | (c, b) <- allBenches, c == x] + o_1_space = get SpaceO_1 + o_n_heap = get HeapO_n + o_n_space = get SpaceO_n + in + [ bgroup (o_1_space_prefix moduleName) o_1_space + , bgroup (o_n_space_prefix moduleName) o_n_space + , bgroup (o_n_heap_prefix moduleName) o_n_heap ] #else -- Enable FUSION_CHECK macro at the beginning of the file diff --git a/benchmark/Streamly/Benchmark/Data/Fold/Prelood.hs b/benchmark/Streamly/Benchmark/Data/Fold/Prelood.hs index 234ce526bb..a6357635de 100644 --- a/benchmark/Streamly/Benchmark/Data/Fold/Prelood.hs +++ b/benchmark/Streamly/Benchmark/Data/Fold/Prelood.hs @@ -109,9 +109,9 @@ instance NFData a => NFData (Stream Identity a) where {-# INLINE rnf #-} rnf xs = runIdentity $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) xs -o_n_heap_serial :: Int -> [Benchmark] +o_n_heap_serial :: Int -> [(SpaceComplexity, Benchmark)] o_n_heap_serial value = - [ bgroup "key-value" + [ (HeapO_n, bgroup "key-value" [ benchIOSink value "demuxToHashMap (64 buckets) [sum, length]" $ demuxToHashMap (getKey 64) (getFold . getKey 64) @@ -125,7 +125,7 @@ o_n_heap_serial value = $ toHashMapIO (getKey 64) , benchIOSink value "toHashMapIO (max buckets) sum" $ toHashMapIO (getKey value) - ] + ]) ] where @@ -151,7 +151,11 @@ main = do where allBenchmarks _env value = - [ bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value) + let allBenches = o_n_heap_serial value + get x = map snd $ filter ((==) x . fst) allBenches + o_n_heap = get HeapO_n + in + [ bgroup (o_n_heap_prefix moduleName) o_n_heap ] #else -- Enable FUSION_CHECK macro at the beginning of the file diff --git a/benchmark/Streamly/Benchmark/Data/Fold/Window.hs b/benchmark/Streamly/Benchmark/Data/Fold/Window.hs index 45ebc1ab78..e7e83820f3 100644 --- a/benchmark/Streamly/Benchmark/Data/Fold/Window.hs +++ b/benchmark/Streamly/Benchmark/Data/Fold/Window.hs @@ -66,9 +66,9 @@ benchScanWith src len name f = benchWithPostscan :: Int -> String -> Fold IO Double a -> Benchmark benchWithPostscan = benchScanWith source -o_1_space_folds :: Int -> [Benchmark] +o_1_space_folds :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_folds numElements = - [ bgroup "fold" + [ (SpaceO_1, bgroup "fold" [ benchWithFold numElements "minimum (window size 100)" (Window.windowMinimum 100) , benchWithFold numElements "minimum (window size 1000)" @@ -120,12 +120,12 @@ o_1_space_folds numElements = , benchWithFold numElements "powerSum 2 (entire stream)" (Window.cumulative (Window.windowPowerSum 2)) - ] + ]) ] -o_1_space_scans :: Int -> [Benchmark] +o_1_space_scans :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_scans numElements = - [ bgroup "scan" + [ (SpaceO_1, bgroup "scan" [ benchWithPostscan numElements "minimum (window size 10)" (Window.windowMinimum 10) -- Below window size 30 the linear search based impl performs better @@ -172,7 +172,7 @@ o_1_space_scans numElements = (RingArray.slidingWindow 100 (Window.windowPowerSum 2)) , benchWithPostscan numElements "powerSum 2 (window size 1000)" (RingArray.slidingWindow 1000 (Window.windowPowerSum 2)) - ] + ]) ] moduleName :: String @@ -184,8 +184,11 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks where allBenchmarks value = - [ bgroup (o_1_space_prefix moduleName) $ concat - [ o_1_space_folds value - , o_1_space_scans 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/MutArray.hs b/benchmark/Streamly/Benchmark/Data/MutArray.hs index eeac64807f..f5c5fb6547 100644 --- a/benchmark/Streamly/Benchmark/Data/MutArray.hs +++ b/benchmark/Streamly/Benchmark/Data/MutArray.hs @@ -30,6 +30,7 @@ import Prelude ( IO , Int , Integral(..) + , Eq(..) , Maybe(..) , Monad(..) , Num(..) @@ -38,10 +39,14 @@ import Prelude , ($) , (.) , (||) + , (++) , concat , const + , filter , fmap + , fst , id + , snd , undefined ) import Streamly.Internal.Data.MutArray (MutArray) @@ -282,6 +287,19 @@ o_1_space_serial_marray value ~(array, indices) = moduleName :: String 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) + main :: IO () main = do runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks @@ -294,13 +312,13 @@ main = do return (marr, indices) allBenchmarks array value = - [ bgroup (o_1_space_prefix moduleName) - $ 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 - ] - , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value) + let allBenches = benchmarks array value + get x = fmap snd $ filter ((==) x . fst) allBenches + o_1_space = get SpaceO_1 + o_n_heap = get HeapO_n + o_n_space = get SpaceO_n + in + [ bgroup (o_1_space_prefix moduleName) o_1_space + , bgroup (o_n_heap_prefix moduleName) o_n_heap + , bgroup (o_n_space_prefix moduleName) o_n_space ] diff --git a/benchmark/Streamly/Benchmark/Data/ParserK.hs b/benchmark/Streamly/Benchmark/Data/ParserK.hs index a9f45542db..4ee991aa98 100644 --- a/benchmark/Streamly/Benchmark/Data/ParserK.hs +++ b/benchmark/Streamly/Benchmark/Data/ParserK.hs @@ -376,15 +376,15 @@ instance NFData ParseError where {-# INLINE rnf #-} rnf (ParseError x) = rnf x -o_1_space_serial :: Int -> [Benchmark] +o_1_space_serial :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_serial value = - [ benchIOSink value "drain" (Stream.fold Fold.drain . StreamK.toStream) - , benchIOSink value "takeWhile" $ takeWhileK value - , benchIOSink value "splitAp2" $ splitAp2 value - , benchIOSink value "splitAp8" $ splitAp8 value - , benchIOSink value "alt2" $ alt2 value - , benchIOSink value "monad2" $ monad2 value - , benchIOSink value "monad4" $ monad4 value + [ (SpaceO_1, benchIOSink value "drain" (Stream.fold Fold.drain . StreamK.toStream)) + , (SpaceO_1, benchIOSink value "takeWhile" $ takeWhileK value) + , (SpaceO_1, benchIOSink value "splitAp2" $ splitAp2 value) + , (SpaceO_1, benchIOSink value "splitAp8" $ splitAp8 value) + , (SpaceO_1, benchIOSink value "alt2" $ alt2 value) + , (SpaceO_1, benchIOSink value "monad2" $ monad2 value) + , (SpaceO_1, benchIOSink value "monad4" $ monad4 value) ] {-# INLINE sepBy1 #-} @@ -400,31 +400,31 @@ sepBy1 xs = do fmap (x :) $ AP.many (sep >> p) -- O(n) heap beacuse of accumulation of the list in strict IO monad? -o_n_heap_serial :: Int -> [Benchmark] +o_n_heap_serial :: Int -> [(SpaceComplexity, Benchmark)] o_n_heap_serial value = [ -- accumulates the results in a list -- XXX why should this take O(n) heap, it discards the results? - benchIOSink value "sequence_" $ sequence_ value - , benchIOSink value "sequenceA_" $ sequenceA_ value - , benchIOSink value "sequence" $ sequence value - , benchIOSink value "sequenceA" $ sequenceA value - , benchIOSink value "manyAlt" manyAlt - , benchIOSink value "sepBy1" sepBy1 - , benchIOSink value "someAlt" someAlt - , benchIOSink value "choice" $ choice value + (HeapO_n, benchIOSink value "sequence_" $ sequence_ value) + , (HeapO_n, benchIOSink value "sequenceA_" $ sequenceA_ value) + , (HeapO_n, benchIOSink value "sequence" $ sequence value) + , (HeapO_n, benchIOSink value "sequenceA" $ sequenceA value) + , (HeapO_n, benchIOSink value "manyAlt" manyAlt) + , (HeapO_n, benchIOSink value "sepBy1" sepBy1) + , (HeapO_n, benchIOSink value "someAlt" someAlt) + , (HeapO_n, benchIOSink value "choice" $ choice value) -- XXX these take too much memory with --long, need to investigate - , benchIOSink value "alt8" $ alt8 value - , benchIOSink value "alt16" $ alt16 value - , benchIOSink value "monad8" $ monad8 value - , benchIOSink value "monad16" $ monad16 value + , (HeapO_n, benchIOSink value "alt8" $ alt8 value) + , (HeapO_n, benchIOSink value "alt16" $ alt16 value) + , (HeapO_n, benchIOSink value "monad8" $ monad8 value) + , (HeapO_n, benchIOSink value "monad16" $ monad16 value) ] -- O(n) heap beacuse of accumulation of the list in strict IO monad? -o_1_space_recursive :: Int -> [Benchmark] +o_1_space_recursive :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_recursive value = - [ benchIOSink value "one (recursive)" $ one value + [ (SpaceO_1, benchIOSink value "one (recursive)" $ one value) ] ------------------------------------------------------------------------------- @@ -437,7 +437,13 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks where allBenchmarks value = - [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value) - , bgroup (o_1_space_prefix moduleName) (o_1_space_recursive value) - , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value) + let allBenches = o_1_space_serial value + ++ o_n_heap_serial value + ++ o_1_space_recursive value + get x = map snd $ filter ((==) x . fst) allBenches + o_1_space = get SpaceO_1 + o_n_heap = get HeapO_n + in + [ bgroup (o_1_space_prefix moduleName) o_1_space + , bgroup (o_n_heap_prefix moduleName) o_n_heap ] diff --git a/benchmark/Streamly/Benchmark/Data/RingArray.hs b/benchmark/Streamly/Benchmark/Data/RingArray.hs index 4f6b45268e..0161cf89d6 100644 --- a/benchmark/Streamly/Benchmark/Data/RingArray.hs +++ b/benchmark/Streamly/Benchmark/Data/RingArray.hs @@ -33,10 +33,14 @@ eqArray (arr, ring) = RingArray.eqArray ring arr -- Benchmark groups ------------------------------------------------------------------------------- -o_1_space_serial :: Int -> Array.Array Int -> RingArray.RingArray Int -> [Benchmark] +o_1_space_serial :: + Int + -> Array.Array Int + -> RingArray.RingArray Int + -> [(SpaceComplexity, Benchmark)] o_1_space_serial value arr ring = - [ bench "eqArrayN" $ nfIO $ eqArrayN (value, arr, ring) - , bench "eqArray" $ nfIO $ eqArray (arr, ring) + [ (SpaceO_1, bench "eqArrayN" $ nfIO $ eqArrayN (value, arr, ring)) + , (SpaceO_1, bench "eqArray" $ nfIO $ eqArray (arr, ring)) ] ------------------------------------------------------------------------------- @@ -46,6 +50,13 @@ o_1_space_serial value arr ring = moduleName :: String moduleName = "Data.RingArray" +benchmarks :: + Int + -> Array.Array Int + -> RingArray.RingArray Int + -> [(SpaceComplexity, Benchmark)] +benchmarks = o_1_space_serial + main :: IO () main = do runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks @@ -61,7 +72,9 @@ main = do return (arr, ring) allBenchmarks (arr, ring) value = - [ bgroup - (o_1_space_prefix moduleName) - (o_1_space_serial value arr ring) + let allBenches = benchmarks value arr ring + 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.hs b/benchmark/Streamly/Benchmark/Data/Scanl.hs index 80b874a6d6..c54538b860 100644 --- a/benchmark/Streamly/Benchmark/Data/Scanl.hs +++ b/benchmark/Streamly/Benchmark/Data/Scanl.hs @@ -45,7 +45,7 @@ import qualified Streamly.Internal.Data.Stream as Stream import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common -import Prelude hiding (last, length, all, any, take, unzip, sequence_, filter) +import Prelude hiding (last, length, all, any, take, unzip, sequence_) #ifdef INSPECTION import GHC.Types (SPEC(..)) @@ -165,14 +165,14 @@ inspect $ 'classifySum `hasNoType` ''FL.Step inspect $ 'classifySum `hasNoType` ''SPEC #endif -o_1_space_serial :: Int -> [Benchmark] +o_1_space_serial :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_serial value = - [ bgroup "key-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 - ] + ]) ] ------------------------------------------------------------------------------- @@ -185,5 +185,9 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks where allBenchmarks value = - [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value) + let allBenches = o_1_space_serial 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/Concurrent.hs b/benchmark/Streamly/Benchmark/Data/Scanl/Concurrent.hs index 4645af4a52..523f23d778 100644 --- a/benchmark/Streamly/Benchmark/Data/Scanl/Concurrent.hs +++ b/benchmark/Streamly/Benchmark/Data/Scanl/Concurrent.hs @@ -50,11 +50,11 @@ parDistributeScanM len seed = do -- Groups -------------------------------------------------------------------------------- -o_1_space_scans :: Int -> [Benchmark] +o_1_space_scans :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_scans numElements = - [ bgroup "scan" + [ (SpaceO_1, bgroup "scan" [ mkBench "parDistributeScanM" (parDistributeScanM numElements) - ] + ]) ] -------------------------------------------------------------------------------- @@ -70,7 +70,9 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks where allBenchmarks value = - [ bgroup (o_1_space_prefix moduleName) - ( o_1_space_scans 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/Benchmark/Data/Scanl/Window.hs b/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs index dc2937bc3d..e774cbf944 100644 --- a/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs +++ b/benchmark/Streamly/Benchmark/Data/Scanl/Window.hs @@ -46,9 +46,9 @@ benchScanWith src len name f = benchWithPostscan :: Int -> String -> Scanl IO Double a -> Benchmark benchWithPostscan = benchScanWith source -o_1_space_scans :: Int -> [Benchmark] +o_1_space_scans :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_scans numElements = - [ bgroup "scan" + [ (SpaceO_1, bgroup "scan" [ benchWithPostscan numElements "minimum (window size 10)" (Scanl.windowMinimum 10) -- Below window size 30 the linear search based impl performs better @@ -95,7 +95,7 @@ o_1_space_scans numElements = (Scanl.incrScan 100 (Scanl.incrPowerSum 2)) , benchWithPostscan numElements "powerSum 2 (window size 1000)" (Scanl.incrScan 1000 (Scanl.incrPowerSum 2)) - ] + ]) ] moduleName :: String @@ -107,7 +107,9 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks where allBenchmarks value = - [ bgroup (o_1_space_prefix moduleName) - ( o_1_space_scans 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/Benchmark/Data/Stream.hs b/benchmark/Streamly/Benchmark/Data/Stream.hs index f59a2515f2..b66ada22a2 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream.hs @@ -16,6 +16,7 @@ module Main (main) where +import Test.Tasty.Bench (bgroup) import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv) import qualified Stream.Eliminate as Elimination @@ -57,16 +58,24 @@ main = do where - allBenchmarks env size = Prelude.concat - [ Generation.benchmarks moduleName size - , Elimination.benchmarks moduleName size - , Exceptions.benchmarks moduleName env size - , Split.benchmarks moduleName env - , SplitChunks.benchmarks moduleName env - , Transformation.benchmarks moduleName size - , NestedFold.benchmarks moduleName size - , Lift.benchmarks moduleName size - , NestedStream.benchmarks moduleName size + allBenchmarks env size = + let allBenches = concat + [ Generation.benchmarks size + , Elimination.benchmarks size + , Exceptions.benchmarks env size + , Split.benchmarks env + , SplitChunks.benchmarks env + , Transformation.benchmarks size + , NestedFold.benchmarks size + , Lift.benchmarks size + , NestedStream.benchmarks size + ] + 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) + , bgroup (o_n_stack_prefix moduleName) (get StackO_n) + , bgroup (o_n_space_prefix moduleName) (get SpaceO_n) ] #else -- Enable FUSION_CHECK macro at the beginning of the file diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs b/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs index 4b34f3630a..86d3ef4bab 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs @@ -1181,20 +1181,18 @@ o_1_space_elimination_multi_stream value = -- In addition to gauge options, the number of elements in the stream can be -- passed using the --stream-size option. -- -benchmarks :: String -> Int -> [Benchmark] -benchmarks moduleName size = - [ bgroup (o_1_space_prefix moduleName) $ concat - [ o_1_space_elimination_foldable size - , o_1_space_elimination_folds size - , o_1_space_elimination_multi_stream_pure size - , o_1_space_elimination_multi_stream size - ] - - , bgroup (o_n_heap_prefix moduleName) $ - o_n_heap_elimination_buffered size - ++ o_n_heap_elimination_foldl size - ++ o_n_heap_elimination_toList size - , bgroup (o_n_space_prefix moduleName) $ - o_n_space_elimination_foldr size - ++ o_n_space_elimination_toList size - ] +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + map (SpaceO_1,) (concat + [ o_1_space_elimination_foldable size + , o_1_space_elimination_folds size + , o_1_space_elimination_multi_stream_pure size + , o_1_space_elimination_multi_stream size + ]) + ++ map (HeapO_n,) ( + o_n_heap_elimination_buffered size + ++ o_n_heap_elimination_foldl size + ++ o_n_heap_elimination_toList size) + ++ map (SpaceO_n,) ( + o_n_space_elimination_foldr size + ++ o_n_space_elimination_toList size) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs b/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs index 990b18b8aa..aa228b7f0e 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs @@ -219,11 +219,10 @@ o_1_space_copy_exceptions_toChunks env = ] ] -benchmarks :: String -> BenchEnv -> Int -> [Benchmark] -benchmarks moduleName _env _size = - [ bgroup (o_1_space_prefix moduleName) $ concat - [ o_1_space_copy_exceptions_readChunks _env - , o_1_space_copy_exceptions_toChunks _env - , o_1_space_copy_stream_exceptions _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 ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Expand.hs b/benchmark/Streamly/Benchmark/Data/Stream/Expand.hs index 442be81195..f718d24d98 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Expand.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Expand.hs @@ -1132,27 +1132,26 @@ o_n_heap_buffering value = -- passed using the --stream-size option. -- {-# ANN benchmarks "HLint: ignore" #-} -benchmarks :: String -> Int -> [Benchmark] -benchmarks moduleName size = - [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat - [ - -- multi-stream - o_1_space_joining size - , o_1_space_concat size - , o_1_space_applicative size - , o_1_space_monad size - , o_1_space_bind size - , o_1_space_equations size - ] - , bgroup (o_n_space_prefix moduleName) $ Prelude.concat - [ - -- multi-stream - o_n_space_monad size - ] - , bgroup (o_n_heap_prefix moduleName) $ - {- - -- multi-stream - o_n_heap_buffering size - -} - (o_n_heap_concat size) - ] +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + map (SpaceO_1,) (Prelude.concat + [ + -- multi-stream + o_1_space_joining size + , o_1_space_concat size + , o_1_space_applicative size + , o_1_space_monad size + , o_1_space_bind size + , o_1_space_equations size + ]) + ++ map (SpaceO_n,) (Prelude.concat + [ + -- multi-stream + o_n_space_monad size + ]) + ++ map (HeapO_n,) + {- + -- multi-stream + (o_n_heap_buffering size) + -} + (o_n_heap_concat size) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs b/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs index f6ee867ab8..75c257203f 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs @@ -425,8 +425,7 @@ o_n_heap_generation value = -- In addition to gauge options, the number of elements in the stream can be -- passed using the --stream-size option. -- -benchmarks :: String -> Int -> [Benchmark] -benchmarks moduleName size = - [ bgroup (o_1_space_prefix moduleName) (o_1_space_generation size) - , bgroup (o_n_heap_prefix moduleName) (o_n_heap_generation size) - ] +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + map (SpaceO_1,) (o_1_space_generation size) + ++ map (HeapO_n,) (o_n_heap_generation size) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs b/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs index ff1d0ad7ac..245257c30a 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs @@ -123,7 +123,6 @@ o_1_space_hoisting value = -- In addition to gauge options, the number of elements in the stream can be -- passed using the --stream-size option. -- -benchmarks :: String -> Int -> [Benchmark] -benchmarks moduleName size = - [ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size) - ] +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + map (SpaceO_1,) (o_1_space_hoisting size) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs b/benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs index 342e5c5848..1ccffd5afb 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs @@ -1138,22 +1138,21 @@ o_1_space_scansX4 value = -- In addition to gauge options, the number of elements in the stream can be -- passed using the --stream-size option. -- -benchmarks :: String -> Int -> [Benchmark] -benchmarks moduleName size = - [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat - [ o_1_space_grouping size - , 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 - ] - , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size) - , bgroup (o_n_heap_prefix moduleName) (o_n_heap_buffering size) - ] +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + map (SpaceO_1,) (Prelude.concat + [ o_1_space_grouping size + , 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 (HeapO_n,) (o_n_heap_buffering size) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Split.hs b/benchmark/Streamly/Benchmark/Data/Stream/Split.hs index baf668666d..c6a4f23442 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Split.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Split.hs @@ -352,8 +352,6 @@ o_1_space_reduce_read_split env = ] ] -benchmarks :: String -> BenchEnv -> [Benchmark] -benchmarks moduleName env = - [ bgroup (o_1_space_prefix moduleName) $ - o_1_space_reduce_read_split env - ] +benchmarks :: BenchEnv -> [(SpaceComplexity, Benchmark)] +benchmarks env = + map (SpaceO_1,) (o_1_space_reduce_read_split env) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/SplitChunks.hs b/benchmark/Streamly/Benchmark/Data/Stream/SplitChunks.hs index 3a4804d647..e1d31e34e8 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/SplitChunks.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/SplitChunks.hs @@ -81,8 +81,6 @@ o_1_space_reduce_toChunks_split env = ] ] -benchmarks :: String -> BenchEnv -> [Benchmark] -benchmarks moduleName env = - [ bgroup (o_1_space_prefix moduleName) $ - o_1_space_reduce_toChunks_split env - ] +benchmarks :: BenchEnv -> [(SpaceComplexity, Benchmark)] +benchmarks env = + map (SpaceO_1,) (o_1_space_reduce_toChunks_split env) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform.hs index 39be36fa6a..943cd6b852 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform.hs @@ -1324,22 +1324,21 @@ o_1_space_indexingX4 value = -- In addition to gauge options, the number of elements in the stream can be -- passed using the --stream-size option. -- -benchmarks :: String -> Int -> [Benchmark] -benchmarks moduleName size = - [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat - [ o_1_space_functor size - , 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 - ] - , bgroup (o_n_space_prefix moduleName) $ Prelude.concat - [ - o_n_space_mapping size - , o_n_space_iterated size - ] - ] +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks size = + map (SpaceO_1,) (Prelude.concat + [ o_1_space_functor size + , 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,) (Prelude.concat + [ + o_n_space_mapping size + , o_n_space_iterated size + ]) diff --git a/benchmark/Streamly/Benchmark/Data/StreamK.hs b/benchmark/Streamly/Benchmark/Data/StreamK.hs index 8ed72cb441..c9230442e7 100644 --- a/benchmark/Streamly/Benchmark/Data/StreamK.hs +++ b/benchmark/Streamly/Benchmark/Data/StreamK.hs @@ -1158,59 +1158,39 @@ o_1_space_list streamLen = 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 :: Int -> Benchmark -o_1_space streamLen = - bgroup (o_1_space_prefix moduleName) - [ 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 :: Int -> Benchmark -o_n_heap streamLen = - bgroup (o_n_heap_prefix moduleName) - [ bgroup "transformation" +o_n_heap_transformation :: Int -> Benchmark +o_n_heap_transformation streamLen = + bgroup "transformation" [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen) ] - , o_n_heap_concat streamLen - , o_n_heap_sorting streamLen - ] - -{-# INLINE benchK #-} -benchK :: P.String -> (Int -> StreamK P.IO Int) -> Benchmark -benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f -o_n_stack :: Int -> Int -> Int -> Benchmark -o_n_stack streamLen iterStreamLen maxIters = - bgroup (o_n_stack_prefix moduleName) - [ bgroup "elimination" - [ benchFold "tail" tail (unfoldrM streamLen) - , benchFold "nullTail" nullTail (unfoldrM streamLen) - , benchFold "headTail" headTail (unfoldrM streamLen) - ] - , bgroup "transformation" +o_n_stack_transformation :: Int -> Benchmark +o_n_stack_transformation streamLen = + bgroup "transformation" [ -- XXX why do these need so much stack benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2) , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2) ] - , bgroup "transformationX4" + where + streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) + +o_n_stack_transformationX4 :: Int -> Benchmark +o_n_stack_transformationX4 streamLen = + bgroup "transformationX4" [ benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16) ] - , bgroup "iterated" + where + streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) + +{-# INLINE benchK #-} +benchK :: P.String -> (Int -> StreamK P.IO Int) -> Benchmark +benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f + +o_n_stack_iterated :: Int -> Int -> Int -> Benchmark +o_n_stack_iterated streamLen iterStreamLen maxIters = + bgroup "iterated" [ benchK "mapM" (iterateMapM iterStreamLen maxIters) , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters) , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters) @@ -1219,19 +1199,44 @@ o_n_stack streamLen iterStreamLen maxIters = , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters) , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters) ] - ] - where - streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop - streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop -o_n_space :: Int -> Benchmark -o_n_space streamLen = - bgroup (o_n_space_prefix moduleName) - [ bgroup "elimination" - [ benchFold "toList" toList (unfoldrM streamLen) - ] - , o_n_space_concat streamLen - ] +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) + -- O(n) heap + , (HeapO_n, o_n_heap_transformation streamLen) + , (HeapO_n, o_n_heap_concat streamLen) + , (HeapO_n, o_n_heap_sorting streamLen) + -- O(n) stack + , (StackO_n, bgroup "elimination" + [ benchFold "tail" tail (unfoldrM streamLen) + , benchFold "nullTail" nullTail (unfoldrM streamLen) + , benchFold "headTail" headTail (unfoldrM streamLen) + ]) + , (StackO_n, o_n_stack_transformation streamLen) + , (StackO_n, o_n_stack_transformationX4 streamLen) + , (StackO_n, o_n_stack_iterated streamLen iterStreamLen maxIters) + -- O(n) space + , (SpaceO_n, bgroup "elimination" + [ benchFold "toList" toList (unfoldrM streamLen) + ]) + , (SpaceO_n, o_n_space_concat streamLen) + ] main :: IO () main = do @@ -1242,8 +1247,15 @@ main = do allBenchmarks streamLen = let !iterStreamLen = 10 !maxIters = streamLen `div` iterStreamLen - in [ o_1_space streamLen - , o_n_stack streamLen iterStreamLen maxIters - , o_n_heap streamLen - , o_n_space streamLen - ] + allBenches = benchmarks streamLen iterStreamLen maxIters + get x = P.map snd $ filter ((==) x . fst) allBenches + o1 = get SpaceO_1 + o_n_heap = get HeapO_n + o_n_stack = get StackO_n + o_n_space = get SpaceO_n + in + [ bgroup (o_1_space_prefix moduleName) o1 + , bgroup (o_n_stack_prefix moduleName) o_n_stack + , bgroup (o_n_heap_prefix moduleName) o_n_heap + , bgroup (o_n_space_prefix moduleName) o_n_space + ] diff --git a/benchmark/Streamly/Benchmark/Data/Unfold.hs b/benchmark/Streamly/Benchmark/Data/Unfold.hs index edfd10d502..df3a920f28 100644 --- a/benchmark/Streamly/Benchmark/Data/Unfold.hs +++ b/benchmark/Streamly/Benchmark/Data/Unfold.hs @@ -1511,9 +1511,9 @@ inspect $ 'foldManySepBy `hasNoType` ''SPEC moduleName :: String moduleName = "Data.Unfold" -o_1_space_transformation_input :: Int -> [Benchmark] +o_1_space_transformation_input :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_transformation_input size = - [ bgroup + [ (SpaceO_1, bgroup "transformation/input" [ benchIO "lmap" $ lmap size , benchIO "lmapM" $ lmapM size @@ -1525,12 +1525,12 @@ o_1_space_transformation_input size = , benchIO "consInput" $ consInput size , benchIO "consInputWith" $ consInputWith size , benchIO "swap" $ swap size - ] + ]) ] -o_1_space_generation :: Int -> [Benchmark] +o_1_space_generation :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_generation size = - [ bgroup + [ (SpaceO_1, bgroup "generation" [ benchIO "fromStream" $ fromStream size , benchIO "fromStreamK" $ fromStreamK size @@ -1560,12 +1560,12 @@ o_1_space_generation size = , benchIO "enumerateFromStepNum" $ enumerateFromStepNum size , benchIO "enumerateFromNum" $ enumerateFromNum size , benchIO "enumerateFromToFractional" $ enumerateFromToFractional size - ] + ]) ] -o_1_space_transformation :: Int -> [Benchmark] +o_1_space_transformation :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_transformation size = - [ bgroup + [ (SpaceO_1, bgroup "transformation" [ benchIO "map" $ map size , benchIO "mapM" $ mapM size @@ -1573,12 +1573,12 @@ o_1_space_transformation size = , benchIO "postscan" $ postscan size , benchIO "scanl" $ scanl size , benchIO "scanlMany" $ scanlMany size - ] + ]) ] -o_1_space_filtering :: Int -> [Benchmark] +o_1_space_filtering :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_filtering size = - [ bgroup + [ (SpaceO_1, bgroup "filtering" [ benchIO "takeWhileM" $ takeWhileM size , benchIO "takeWhile" $ takeWhile size @@ -1595,12 +1595,12 @@ o_1_space_filtering size = , benchIO "mapMaybe" $ mapMaybe size , benchIO "mapMaybeM" $ mapMaybeM size , benchIO "catMaybes" $ catMaybes size - ] + ]) ] -o_1_space_zip :: Int -> [Benchmark] +o_1_space_zip :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_zip size = - [ bgroup + [ (SpaceO_1, bgroup "zip" [ benchIO "zipWithM" $ zipWithM size , benchIO "zipWith" $ zipWith size @@ -1610,12 +1610,12 @@ o_1_space_zip size = , benchIO "zipArrowWithM" $ zipArrowWithM size , benchIO "zipArrowWith" $ zipArrowWith size , benchIO "zipRepeat" $ zipRepeat size - ] + ]) ] -o_1_space_nested :: BenchEnv -> Int -> [Benchmark] +o_1_space_nested :: BenchEnv -> Int -> [(SpaceComplexity, Benchmark)] o_1_space_nested env size = - [ bgroup + [ (SpaceO_1, bgroup "nested" [ benchIO "crossApply outer=inner=(sqrt Max)" $ toNullAp size , benchIO "crossApplyFst outer=inner=(sqrt Max)" $ crossApplyFst size @@ -1640,16 +1640,16 @@ o_1_space_nested env size = $ unfoldEachInterleave size 1 , mkBench "foldMany (Fold.takeEndBy_ (== lf) Fold.drain)" env $ \inh _ -> foldManySepBy inh - ] + ]) ] where sqrtVal = round $ sqrt (fromIntegral size :: Double) -o_1_space_concat :: Int -> [Benchmark] +o_1_space_concat :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_concat size = - [ bgroup + [ (SpaceO_1, bgroup "concat" [ benchIO "concatMapM outer=inner=(sqrt Max)" $ concatMapM sqrtVal sqrtVal , benchIO "concatMapPure outer=inner=(sqrt Max)" $ concatMapPure sqrtVal sqrtVal @@ -1661,32 +1661,32 @@ o_1_space_concat size = , benchIO "filterAllOut2" $ filterAllOut size , benchIO "filterAllIn2" $ filterAllIn size , benchIO "filterSome2" $ filterSome size - ] + ]) ] where sqrtVal = round $ sqrt (fromIntegral size :: Double) -o_n_space_concat :: Int -> [Benchmark] +o_n_space_concat :: Int -> [(SpaceComplexity, Benchmark)] o_n_space_concat size = - [ bgroup + [ (SpaceO_n, bgroup "concat" [ benchIO "toList2" $ toList size , benchIO "toListSome2" $ toListSome size - ] + ]) ] -o_1_space_resource_management :: Int -> [Benchmark] +o_1_space_resource_management :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_resource_management size = - [ bgroup + [ (SpaceO_1, bgroup "resource-management" [ benchIO "before" $ before size , benchIO "after_" $ after_ size , benchIO "afterIO" $ afterIO size , benchIO "finallyIO" $ finallyIO size , benchIO "bracketIO" $ bracketIO size - ] + ]) ] ------------------------------------------------------------------------------- @@ -1746,9 +1746,9 @@ inspect $ hasNoTypeClasses 'readWriteBracket_Unfold -- inspect $ 'readWriteBracket_Unfold `hasNoType` ''S.Step #endif -o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark] +o_1_space_copy_read_exceptions :: BenchEnv -> [(SpaceComplexity, Benchmark)] o_1_space_copy_read_exceptions env = - [ bgroup "exceptions" + [ (SpaceO_1, bgroup "exceptions" [ mkBenchSmall "UF.onException" env $ \inh _ -> readWriteOnExceptionUnfold inh (nullH env) , mkBenchSmall "UF.handle" env $ \inh _ -> @@ -1757,7 +1757,7 @@ o_1_space_copy_read_exceptions env = readWriteFinally_Unfold inh (nullH env) , mkBenchSmall "UF.bracket_" env $ \inh _ -> readWriteBracket_Unfold inh (nullH env) - ] + ]) ] @@ -1774,8 +1774,7 @@ main = do where allBenchmarks env size = - [ bgroup (o_1_space_prefix moduleName) - $ Prelude.concat + let allBenches = Prelude.concat [ o_1_space_transformation_input size , o_1_space_generation size , o_1_space_transformation size @@ -1785,9 +1784,14 @@ main = do , o_1_space_concat size , o_1_space_resource_management size , o_1_space_copy_read_exceptions env + , o_n_space_concat size ] - , bgroup (o_n_space_prefix moduleName) - $ Prelude.concat [o_n_space_concat size] + get x = Prelude.map snd $ Prelude.filter ((==) x . fst) allBenches + o_1_space = get SpaceO_1 + o_n_space = get SpaceO_n + in + [ bgroup (o_1_space_prefix moduleName) o_1_space + , bgroup (o_n_space_prefix moduleName) o_n_space ] #else -- Enable FUSION_CHECK macro at the beginning of the file diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index 628438cdd0..02abace0d6 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -420,7 +420,10 @@ benchmark Data.Serialize benchmark Data.SmallArray import: bench-options type: exitcode-stdio-1.0 + hs-source-dirs: ., Streamly/Benchmark/Data main-is: Streamly/Benchmark/Data/Array/SmallArray.hs + other-modules: + Stream.Common if flag(dev) && !flag(use-streamly-core) buildable: True else From 565a975f13992d4dc9fe0b5a52e442344dcbef4f Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Thu, 11 Jun 2026 05:02:10 +0530 Subject: [PATCH 2/8] Create a Data.Stream.Type benchmark module Move benchmarks to mirror the source module of the same name. --- benchmark/Streamly/Benchmark/Data/Stream.hs | 2 + .../Benchmark/Data/Stream/Eliminate.hs | 271 +--- .../Streamly/Benchmark/Data/Stream/Expand.hs | 738 +-------- .../Benchmark/Data/Stream/Generate.hs | 36 - .../Streamly/Benchmark/Data/Stream/Reduce.hs | 74 - .../Benchmark/Data/Stream/SplitChunks.hs | 5 - .../Benchmark/Data/Stream/Transform.hs | 154 +- .../Streamly/Benchmark/Data/Stream/Type.hs | 1388 +++++++++++++++++ benchmark/streamly-benchmarks.cabal | 1 + .../src/Streamly/Internal/Data/Refold/Type.hs | 1 + 10 files changed, 1435 insertions(+), 1235 deletions(-) create mode 100644 benchmark/Streamly/Benchmark/Data/Stream/Type.hs diff --git a/benchmark/Streamly/Benchmark/Data/Stream.hs b/benchmark/Streamly/Benchmark/Data/Stream.hs index b66ada22a2..f2140b7b18 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream.hs @@ -28,6 +28,7 @@ import qualified Stream.Reduce as NestedFold import qualified Stream.Split as Split import qualified Stream.SplitChunks as SplitChunks import qualified Stream.Transform as Transformation +import qualified Stream.Type as Type import Streamly.Benchmark.Common @@ -69,6 +70,7 @@ main = do , NestedFold.benchmarks size , Lift.benchmarks size , NestedStream.benchmarks size + , Type.benchmarks size ] get x = map snd $ filter ((==) x . fst) allBenches in diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs b/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs index 86d3ef4bab..acf4eb83f5 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs @@ -23,7 +23,7 @@ module Stream.Eliminate (benchmarks) where -import Control.Monad (when, (>=>)) +import Control.Monad ((>=>)) import Data.Functor ((<&>)) import Control.DeepSeq (NFData(..)) import Data.Functor.Identity (Identity(..), runIdentity) @@ -400,25 +400,6 @@ o_1_space_elimination_foldable value = -- Reductions ------------------------------------------------------------------------------- -{-# INLINE uncons #-} -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 - {-# INLINE toNull #-} toNull :: Int -> IO () toNull value = withStream value S.drain @@ -452,87 +433,6 @@ inspect $ 'mapM_ `hasNoType` ''Fold.Step inspect $ 'mapM_ `hasNoType` ''SPEC #endif -{-# INLINE foldBreak #-} -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 - -{-# INLINE foldrMElem #-} -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 - -{-# INLINE foldrMElemIdentity #-} -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 - --- {-# INLINE foldrToStream #-} --- foldrToStream :: Monad m => Stream m Int -> m (Stream Identity Int) --- foldrToStream = S.foldr S.cons S.nil - -{-# 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) - -#ifdef INSPECTION -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 - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldl'ReduceIdentity -inspect $ 'foldl'ReduceIdentity `hasNoType` ''S.Step -#endif - {-# INLINE streamLast #-} streamLast :: Int -> IO (Maybe Int) streamLast value = withStream value S.last @@ -563,27 +463,6 @@ inspect $ hasNoTypeClasses 'foldl1'ReduceIdentity inspect $ 'foldl1'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)) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'foldlM'Reduce -inspect $ 'foldlM'Reduce `hasNoType` ''S.Step -#endif - -{-# INLINE foldlM'ReduceIdentity #-} -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 - {-# INLINE _head #-} _head :: Monad m => Stream m Int -> m (Maybe Int) _head = S.head @@ -845,35 +724,20 @@ o_1_space_elimination_folds value = bgroup "reduce" [ bgroup "IO" - [ benchIO "foldl'" $ foldl'Reduce value - , benchIO "foldl1'" $ foldl1'Reduce value - , benchIO "foldlM'" $ foldlM'Reduce value + [ benchIO "foldl1'" $ foldl1'Reduce value ] , bgroup "Identity" - [ benchIO "foldl'" $ foldl'ReduceIdentity value - , benchIO "foldl1'" $ foldl1'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 + [ benchIO "foldl1'" $ foldl1'ReduceIdentity value ] ] -- deconstruction - , benchIO "uncons" $ uncons value , benchIO "mapM_" $ mapM_ value , benchIO "last" $ streamLast value , benchIO "length . generalizeInner" $ generalizeInner value , benchIO "toNull" $ toNull value - , benchIO "foldBreak" $ foldBreak value , benchIO "init" $ streamInit value -- draining @@ -913,42 +777,6 @@ o_1_space_elimination_folds value = ] ] -------------------------------------------------------------------------------- --- Buffered Transformations by fold -------------------------------------------------------------------------------- - -{-# 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 [])) - -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 - ] - ] - -- For comparisons {-# INLINE showInstanceList #-} showInstanceList :: [Int] -> String @@ -966,34 +794,6 @@ o_n_heap_elimination_buffered value = ] ] -{-# 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)) - -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 - - -- This is horribly slow, never finishes - -- let foldlS = composeN n $ S.foldlS (flip S.cons) S.nil - -- in benchFold "foldlS" (foldlS 1) sourceUnfoldrM - ] - ] - {-# INLINE toListRev #-} toListRev :: Int -> IO [Int] toListRev value = withStream value S.toListRev @@ -1012,10 +812,6 @@ o_n_heap_elimination_toList value = ] ] -{-# INLINE toList' #-} -toList' :: Int -> IO [Int] -toList' value = withStream value S.toList - -- NOTE: this is a Fold benchmark, used here only for comparison with ToList {-# INLINE toStream #-} toStream :: Int -> IO (Stream Identity Int) @@ -1025,8 +821,7 @@ 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 - , benchIO "toStream" $ toStream value + [ benchIO "toStream" $ toStream value ] ] @@ -1038,18 +833,6 @@ o_n_space_elimination_toList value = -- Multi-stream pure ------------------------------------------------------------------------------- -{-# INLINE eqByPure #-} -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 - {-# INLINE eqInstance #-} eqInstance :: Int -> IO Bool eqInstance value = withPureStream value $ \src -> src == src @@ -1072,18 +855,6 @@ inspect $ 'eqInstanceNotEq `hasNoType` ''Fold.Step inspect $ 'eqInstanceNotEq `hasNoType` ''SPEC #endif -{-# INLINE cmpByPure #-} -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 - {-# INLINE ordInstance #-} ordInstance :: Int -> IO Bool ordInstance value = withPureStream value $ \src -> src < src @@ -1098,10 +869,8 @@ inspect $ 'ordInstance `hasNoType` ''SPEC o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark] o_1_space_elimination_multi_stream_pure value = [ bgroup "multi-stream-pure" - [ benchIO "eqBy" $ eqByPure value - , benchIO "==" $ eqInstance value + [ benchIO "==" $ eqInstance value , benchIO "/=" $ eqInstanceNotEq value - , benchIO "cmpBy" $ cmpByPure value , benchIO "<" $ ordInstance value ] ] @@ -1141,34 +910,10 @@ inspect $ 'stripPrefix `hasNoType` ''Fold.Step inspect $ 'stripPrefix `hasNoType` ''SPEC #endif -{-# INLINE eqBy #-} -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 - -{-# INLINE cmpBy #-} -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 - 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 "isPrefixOf" $ isPrefixOf value + [ benchIO "isPrefixOf" $ isPrefixOf value , benchIO "isSubsequenceOf" $ isSubsequenceOf value , benchIO "stripPrefix" $ stripPrefix value ] @@ -1191,8 +936,6 @@ benchmarks size = ]) ++ map (HeapO_n,) ( o_n_heap_elimination_buffered size - ++ o_n_heap_elimination_foldl size ++ o_n_heap_elimination_toList size) ++ map (SpaceO_n,) ( - o_n_space_elimination_foldr size - ++ o_n_space_elimination_toList size) + o_n_space_elimination_toList size) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Expand.hs b/benchmark/Streamly/Benchmark/Data/Stream/Expand.hs index f718d24d98..4a0e81ee56 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Expand.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Expand.hs @@ -22,6 +22,7 @@ module Stream.Expand (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 @@ -29,11 +30,9 @@ import Test.Inspection import Streamly.Data.Stream (Stream) import Streamly.Data.Unfold (Unfold) -import qualified Stream.Common as Common 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.Fold as Fold import qualified Streamly.Internal.Data.Stream as Stream import qualified Streamly.Internal.Data.StreamK as StreamK @@ -43,6 +42,7 @@ import System.Random (randomRIO) import Test.Tasty.Bench import Stream.Common hiding (benchIO) import Streamly.Benchmark.Common +import qualified Stream.Type as Type import Prelude hiding (concatMap, zipWith) {-# INLINE benchIO #-} @@ -53,87 +53,6 @@ benchIO name = bench name . nfIO withRandomIntIO :: (Int -> IO b) -> IO b withRandomIntIO f = randomRIO (1, 1 :: Int) >>= f -{-# INLINE withStream #-} -withStream :: Int -> (Stream IO Int -> IO b) -> IO b -withStream value f = withRandomIntIO (f . sourceUnfoldrM value) - -mkCross :: Stream m a -> Stream.Nested m a -mkCross = Stream.Nested - -unCross :: Stream.Nested m a -> Stream m a -unCross = Stream.unNested - -{-# 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 - -{-# 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)) - ------------------------------------------------------------------------------- -- Multi-Stream ------------------------------------------------------------------------------- @@ -142,42 +61,6 @@ filterAllInMPure linearCount start = drain $ unCross $ do -- Appending ------------------------------------------------------------------------------- -{-# INLINE serial2 #-} -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 - -{-# INLINE serial4 #-} -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 - {-# INLINE interleave2 #-} interleave2 :: Int -> IO () interleave2 count = withRandomIntIO $ \n -> @@ -250,30 +133,6 @@ inspect $ 'mergeByM `hasNoType` ''Fold.Step -- Zipping ------------------------------------------------------------------------------- -{-# INLINE zipWith #-} -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 - -{-# INLINE zipWithM #-} -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 - ------------------------------------------------------------------------------- -- joining 2 streams using n-ary ops ------------------------------------------------------------------------------- @@ -337,244 +196,20 @@ inspect $ 'unfoldSched `hasNoType` ''SPEC 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 "interleave" $ interleave2 (value `div` 2) + [ 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) - , benchIO "zipWith" $ zipWith value - , benchIO "zipWithM" $ zipWithM value -- 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) - , benchIO "concatMap" $ concatMap 2 (value `div` 2) - ] - ] - -------------------------------------------------------------------------------- --- Concat -------------------------------------------------------------------------------- - --- concatMap unfoldrM/unfoldrM - -{-# INLINE concatMap #-} -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 - -{-# INLINE concatMapM2 #-} -concatMapM2 :: Int -> IO () -concatMapM2 value = withStream value $ \s -> - drain $ do - Stream.concatMapM (\x -> - pure $ Stream.concatMapM (\y -> - pure $ Stream.fromPure $ x + y) s) s - -{-# INLINE concatMapM3 #-} -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 - -{-# INLINE concatMapViaUnfoldEach #-} -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) - -{-# INLINE concatMapM #-} -concatMapM :: Int -> Int -> IO () -concatMapM outer inner = withRandomIntIO $ \n -> - drain $ S.concatMapM - (return . sourceUnfoldrM inner) - (sourceUnfoldrM outer 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 - (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 - -{-# INLINE unfoldEach #-} -unfoldEach :: Int -> Int -> IO () -unfoldEach outer inner = withRandomIntIO $ \start -> drain $ - -- XXX the replicateM takes much more time compared to unfoldrM, is there - -- a perf issue or this is just because of accessing outer loop variables? - -- S.unfoldEach (UF.lmap ((inner,) . return) UF.replicateM) - 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 - -{-# INLINE unfoldEach2 #-} -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 - -{-# INLINE unfoldEach3 #-} -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 - -{-# INLINE unfoldCross #-} -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 - -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 ] ] - where - - sqrtVal = round $ sqrt (fromIntegral value :: Double) - cubertVal = round (fromIntegral value**(1/3::Double)) -- triple nested loop - o_n_heap_concat :: Int -> [Benchmark] o_n_heap_concat value = sqrtVal `seq` [ bgroup "concat" @@ -591,225 +226,10 @@ o_n_heap_concat value = sqrtVal `seq` sqrtVal = round $ sqrt (fromIntegral value :: Double) -------------------------------------------------------------------------------- --- Applicative -------------------------------------------------------------------------------- - -{-# INLINE cross2 #-} -cross2 :: Int -> IO () -cross2 linearCount = withRandomIntIO $ \start -> drain $ - Stream.crossWith (+) - (sourceUnfoldr nestedCount2 start) - (sourceUnfoldr nestedCount2 start) - - where - - nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) - -{-# INLINE crossApply #-} -crossApply :: Int -> IO () -crossApply linearCount = withRandomIntIO $ \start -> drain $ - Stream.crossApply - ((+) <$> sourceUnfoldrM nestedCount2 start) - (sourceUnfoldrM nestedCount2 start) - - where - - nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) - -{-# INLINE crossApplyFst #-} -crossApplyFst :: Int -> IO () -crossApplyFst linearCount = withRandomIntIO $ \start -> drain $ - Stream.crossApplyFst - (sourceUnfoldrM nestedCount2 start) - (sourceUnfoldrM nestedCount2 start) - - where - - nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) - -{-# INLINE crossApplySnd #-} -crossApplySnd :: Int -> IO () -crossApplySnd linearCount = withRandomIntIO $ \start -> drain $ - Stream.crossApplySnd - (sourceUnfoldrM nestedCount2 start) - (sourceUnfoldrM nestedCount2 start) - - where - - nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) - -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 - ] - ] - ------------------------------------------------------------------------------- -- Monad ------------------------------------------------------------------------------- -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) - ] - ] - -o_n_space_monad :: Int -> [Benchmark] -o_n_space_monad value = - [ bgroup "Monad" - [ benchIO "toList2" $ withRandomIntIO (toListM value) - , benchIO "toListSome2" $ withRandomIntIO (toListSome value) - ] - ] - -{-# 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 - Stream.concatFor s $ \x -> - Stream.concatFor s $ \y -> - Stream.fromPure $ x + y - -{-# INLINE drainConcatForM #-} -drainConcatForM :: Int -> IO () -drainConcatForM count = withStream count $ \s -> - drain $ do - Stream.concatForM s $ \x -> - pure $ Stream.concatForM s $ \y -> - pure $ Stream.fromPure $ x + y - -{-# INLINE drainConcatFor3 #-} -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 - -{-# INLINE drainConcatFor4 #-} -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 - -{-# INLINE drainConcatFor5 #-} -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 - -{-# INLINE drainConcatFor3M #-} -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 - -{-# INLINE filterAllInConcatFor #-} -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 - -{-# INLINE filterAllOutConcatFor #-} -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 - -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 - ] - ] - - 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 -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 infiniteIntsUnfold #-} infiniteIntsUnfold :: Monad m => Int -> Int -> Unfold m ((), ()) Int infiniteIntsUnfold _ _ = @@ -825,18 +245,6 @@ infiniteIntsUnfold _ _ = -- 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 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 checkStreamK #-} checkStreamK :: Int -> Int -> Int -> StreamK.StreamK m (Maybe (Maybe (Int, Int))) checkStreamK maxVal x y = @@ -848,209 +256,138 @@ checkStreamK maxVal x y = then StreamK.fromPure (Just Nothing) else StreamK.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 fairConcatForEqn #-} fairConcatForEqn :: Monad m => Int -> Stream m Int -> m () fairConcatForEqn maxVal input = - result + Type.result $ Stream.fairConcatFor input $ \x -> Stream.fairConcatForM input $ \y -> do - return $ checkStream maxVal x y + 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 result + in Type.result $ StreamK.toStream $ StreamK.fairConcatFor inputK $ \x -> StreamK.fairConcatForM inputK $ \y -> do return $ checkStreamK maxVal x y -{-# 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 fairSchedForEqn #-} fairSchedForEqn :: Monad m => Int -> Stream m Int -> m () fairSchedForEqn maxVal input = - result + Type.result $ Stream.fairSchedFor input $ \x -> Stream.fairSchedForM input $ \y -> do - return $ checkStream maxVal x y + return $ Type.checkStream maxVal x y _schedForEqn :: Monad m => Int -> Stream m Int -> m () _schedForEqn maxVal input = - result + Type.result $ Stream.schedFor input $ \x -> Stream.schedForM 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 + return $ Type.checkStream maxVal x y {-# INLINE unfoldCrossEqn #-} unfoldCrossEqn :: Monad m => Int -> Unfold m ((), ()) Int -> m () unfoldCrossEqn maxVal input = - result - $ Stream.mapM (checkPair maxVal) + 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 = - result - $ Stream.mapM (checkPair maxVal) + Type.result + $ Stream.mapM (Type.checkPair maxVal) $ Stream.unfold (Unfold.fairCross input input) (undefined, undefined) -{-# 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 - {-# 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 result - $ Stream.mapM (checkPair maxVal) + 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 result - $ Stream.mapM (checkPair maxVal) + 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 result - $ Stream.mapM (checkPair maxVal) + in Type.result + $ Stream.mapM (Type.checkPair maxVal) $ Stream.fairUnfoldSched intu ints -concatForBounded :: Int -> IO () -concatForBounded maxVal = withRandomIntIO $ \n -> - concatForEqn maxVal (boundedInts maxVal n) - fairConcatForBounded :: Int -> IO () fairConcatForBounded maxVal = withRandomIntIO $ \n -> - fairConcatForEqn maxVal (boundedInts maxVal n) + fairConcatForEqn maxVal (Type.boundedInts maxVal n) fairConcatForKBounded :: Int -> IO () fairConcatForKBounded maxVal = withRandomIntIO $ \n -> - fairConcatForEqnK maxVal (boundedInts maxVal n) + fairConcatForEqnK maxVal (Type.boundedInts maxVal n) fairConcatForInfinite :: Int -> IO () fairConcatForInfinite maxVal = withRandomIntIO $ \n -> - fairConcatForEqn maxVal (infiniteInts maxVal n) + fairConcatForEqn maxVal (Type.infiniteInts maxVal n) fairSchedForBounded :: Int -> IO () fairSchedForBounded maxVal = withRandomIntIO $ \n -> - fairSchedForEqn maxVal (boundedInts maxVal n) + fairSchedForEqn maxVal (Type.boundedInts maxVal n) fairSchedForInfinite :: Int -> IO () fairSchedForInfinite maxVal = withRandomIntIO $ \n -> - fairSchedForEqn maxVal (infiniteInts 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) + fairSchedForEqn maxVal (Type.infiniteInts maxVal n) unfoldCrossBounded :: Int -> IO () -unfoldCrossBounded maxVal = unfoldCrossEqn maxVal (boundedIntsUnfold maxVal 0) +unfoldCrossBounded maxVal = unfoldCrossEqn maxVal (Type.boundedIntsUnfold maxVal 0) fairUnfoldCrossBounded :: Int -> IO () -fairUnfoldCrossBounded maxVal = fairUnfoldCrossEqn maxVal (boundedIntsUnfold maxVal 0) +fairUnfoldCrossBounded maxVal = fairUnfoldCrossEqn maxVal (Type.boundedIntsUnfold maxVal 0) fairUnfoldCrossInfinite :: Int -> IO () fairUnfoldCrossInfinite maxVal = fairUnfoldCrossEqn maxVal (infiniteIntsUnfold maxVal 0) -unfoldEachBounded :: Int -> IO () -unfoldEachBounded maxVal = withRandomIntIO $ \n -> - unfoldEachEqn maxVal (boundedIntsUnfold maxVal 0) (boundedInts maxVal n) - fairUnfoldEachBounded :: Int -> IO () fairUnfoldEachBounded maxVal = withRandomIntIO $ \n -> - fairUnfoldEachEqn maxVal (boundedIntsUnfold maxVal 0) (boundedInts maxVal n) + fairUnfoldEachEqn maxVal (Type.boundedIntsUnfold maxVal 0) (Type.boundedInts maxVal n) fairUnfoldEachInfinite :: Int -> IO () fairUnfoldEachInfinite maxVal = withRandomIntIO $ \n -> - fairUnfoldEachEqn maxVal (infiniteIntsUnfold maxVal 0) (infiniteInts maxVal n) + fairUnfoldEachEqn maxVal (infiniteIntsUnfold maxVal 0) (Type.infiniteInts maxVal n) unfoldSchedBounded :: Int -> IO () unfoldSchedBounded maxVal = withRandomIntIO $ \n -> - unfoldSchedEqn maxVal (boundedIntsUnfold maxVal 0) (boundedInts maxVal n) + unfoldSchedEqn maxVal (Type.boundedIntsUnfold maxVal 0) (Type.boundedInts maxVal n) fairUnfoldSchedBounded :: Int -> IO () fairUnfoldSchedBounded maxVal = withRandomIntIO $ \n -> - fairUnfoldSchedEqn maxVal (boundedIntsUnfold maxVal 0) (boundedInts maxVal n) + fairUnfoldSchedEqn maxVal (Type.boundedIntsUnfold maxVal 0) (Type.boundedInts maxVal n) fairUnfoldSchedInfinite :: Int -> IO () fairUnfoldSchedInfinite maxVal = withRandomIntIO $ \n -> - fairUnfoldSchedEqn maxVal (infiniteIntsUnfold maxVal 0) (infiniteInts maxVal 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 = [ bgroup "equations" - [ benchIO "concatFor (bounded)" $ concatForBounded sqrtVal - , benchIO "fairConcatFor (bounded)" $ fairConcatForBounded sqrtVal + [ 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 "streamCross (bounded)" $ streamCrossBounded sqrtVal - , benchIO "fairStreamCross (bounded)" $ fairStreamCrossBounded sqrtVal - , benchIO "fairStreamCross (infinite)" $ fairStreamCrossInfinite sqrtVal , benchIO "unfoldCross (bounded)" $ unfoldCrossBounded sqrtVal , benchIO "fairUnfoldCross (bounded)" $ fairUnfoldCrossBounded sqrtVal , benchIO "fairUnfoldCross (infinite)" $ fairUnfoldCrossInfinite sqrtVal - , benchIO "unfoldEach (bounded)" $ unfoldEachBounded sqrtVal , benchIO "fairUnfoldEach (bounded)" $ fairUnfoldEachBounded sqrtVal , benchIO "fairUnfoldEach (infinite)" $ fairUnfoldEachInfinite sqrtVal , benchIO "unfoldSched (bounded)" $ unfoldSchedBounded sqrtVal @@ -1138,17 +475,8 @@ benchmarks size = [ -- multi-stream o_1_space_joining size - , o_1_space_concat size - , o_1_space_applicative size - , o_1_space_monad size - , o_1_space_bind size , o_1_space_equations size ]) - ++ map (SpaceO_n,) (Prelude.concat - [ - -- multi-stream - o_n_space_monad size - ]) ++ map (HeapO_n,) {- -- multi-stream diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs b/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs index 75c257203f..87de9ed405 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs @@ -26,7 +26,6 @@ module Stream.Generate (benchmarks) where #ifdef INSPECTION import GHC.Types (SPEC(..)) import Test.Inspection -import qualified Streamly.Internal.Data.Producer as Producer #endif import Control.DeepSeq (NFData(..)) @@ -64,39 +63,6 @@ withDrain f = withRandomIntIO $ \n -> drain (f n) withDrainPure :: (Int -> Stream Identity a) -> IO () withDrainPure f = withRandomIntIO $ \n -> return $! runIdentity $ drain (f n) -------------------------------------------------------------------------------- --- fromList -------------------------------------------------------------------------------- - -{-# INLINE sourceFromList #-} -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'). -{-# INLINE sourceFromTuple #-} -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 - {-# INLINE fromListM #-} fromListM :: Monad m => [m a] -> Stream m a fromListM = Stream.sequence . Stream.fromList @@ -376,8 +342,6 @@ o_1_space_generation value = , benchIO "integerFromStep" $ sourceIntegerFromStep value , benchIO "fracFromThenTo" $ sourceFracFromThenTo value , benchIO "fracFromTo" $ sourceFracFromTo value - , benchIO "fromList" $ sourceFromList value - , benchIO "fromTuple" $ sourceFromTuple value , benchIO "fromListM" $ sourceFromListM value , benchIO "IsList.fromList" $ sourceIsList value , benchIO "IsString.fromString" $ sourceIsString value diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs b/benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs index 1ccffd5afb..76e15f43e2 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs @@ -39,7 +39,6 @@ import System.Random (randomRIO) 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.Refold.Type as Refold import qualified Streamly.Internal.Data.Scan as Scan import qualified Streamly.Internal.Data.Stream as S import qualified Streamly.Internal.Data.Stream as Stream @@ -138,57 +137,6 @@ inspect $ 'groupsByRollingEq `hasNoType` ''FL.Step inspect $ 'groupsByRollingEq `hasNoType` ''SPEC #endif -{-# INLINE foldMany #-} -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 - -{-# INLINE foldMany1 #-} -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 - -{-# INLINE refoldMany #-} -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 foldIterateM #-} foldIterateM :: Int -> IO () foldIterateM value = @@ -207,24 +155,6 @@ inspect $ 'foldIterateM `hasNoType` ''FL.Step inspect $ 'foldIterateM `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` ''SPEC -#endif - o_1_space_grouping :: Int -> [Benchmark] o_1_space_grouping value = -- Buffering operations using heap proportional to group/window sizes. @@ -239,11 +169,7 @@ o_1_space_grouping 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 "foldMany" $ foldMany value - , benchIO "foldMany1" $ foldMany1 value - , benchIO "refoldMany" $ refoldMany value , benchIO "foldIterateM" $ foldIterateM value - , benchIO "refoldIterateM" $ refoldIterateM value ] ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/SplitChunks.hs b/benchmark/Streamly/Benchmark/Data/Stream/SplitChunks.hs index e1d31e34e8..940562255c 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/SplitChunks.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/SplitChunks.hs @@ -35,11 +35,6 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Common.Handle #ifdef INSPECTION -import Streamly.Internal.Data.Stream (Step(..)) - -import qualified Streamly.Internal.Data.MutArray as MutArray -import qualified Streamly.Internal.Data.Unfold as Unfold - import GHC.Types (SPEC(..)) import Test.Inspection #endif diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform.hs index 943cd6b852..3f4dc99de8 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform.hs @@ -73,58 +73,6 @@ withStream value f = withRandomIntIO (f . sourceUnfoldrM value) -- maps and scans ------------------------------------------------------------------------------- -{-# 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 - -{-# INLINE map1 #-} -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 - -{-# INLINE mapM1 #-} -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 - -{-# INLINE mapN4 #-} -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 - -{-# INLINE mapM4 #-} -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 - {-# INLINE scanl' #-} scanl' :: MonadIO m => Int -> Stream m Int -> m () scanl' n = composeN n $ Stream.scanl' (+) 0 @@ -383,9 +331,7 @@ o_1_space_mapping value = -- , benchIOSink value "foldrTMap" (foldrTMap 1) -- Mapping - benchIO "map" $ map1 value - , benchIO "sequence" $ sequence1 value - , benchIO "mapM" $ mapM1 value + benchIO "sequence" $ sequence1 value , benchIO "tap" $ tap1 value -- XXX tasty-bench hangs benchmarking this -- , benchIOSink value "timestamped" _timestamped @@ -404,9 +350,7 @@ o_1_space_mapping value = o_1_space_mappingX4 :: Int -> [Benchmark] o_1_space_mappingX4 value = [ bgroup "mappingX4" - [ benchIO "map" $ mapN4 value - , benchIO "mapM" $ mapM4 value - , benchIO "trace" $ trace4 value + [ benchIO "trace" $ trace4 value , benchIO "scanl'" $ scanl'4 value , benchIO "scanl1'" $ scanl1'4 value @@ -443,18 +387,6 @@ o_n_space_mapping value = ] ] -------------------------------------------------------------------------------- --- Functor -------------------------------------------------------------------------------- - -o_1_space_functor :: Int -> [Benchmark] -o_1_space_functor value = - [ bgroup "Functor" - [ benchIO "fmap" $ map1 value - , benchIO "fmap x 4" $ mapN4 value - ] - ] - ------------------------------------------------------------------------------- -- Iteration/looping utilities ------------------------------------------------------------------------------- @@ -682,77 +614,6 @@ inspect $ 'filterMAllIn4 `hasNoType` ''FL.Step inspect $ 'filterMAllIn4 `hasNoType` ''SPEC #endif -{-# 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) - -{-# INLINE takeAll1 #-} -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 - -{-# INLINE takeAll4 #-} -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)) - -{-# INLINE takeWhileTrue1 #-} -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 - -{-# INLINE takeWhileTrue4 #-} -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))) - -{-# INLINE takeWhileMTrue4 #-} -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 - {-# INLINE dropOne #-} dropOne :: MonadIO m => Int -> Stream m Int -> m () dropOne n = composeN n $ Stream.drop 1 @@ -1057,10 +918,6 @@ o_1_space_filtering value = , benchIO "filterM-all-out" $ filterMAllOut1 value , benchIO "filterM-all-in" $ filterMAllIn1 value - -- Trimming - , benchIO "take-all" $ takeAll1 value - , benchIO "takeWhile-true" $ takeWhileTrue1 value - -- , benchIO "takeWhileM-true" ... , benchIO "drop-one" $ dropOne1 value , benchIO "drop-all" $ dropAll1 value , benchIO "dropWhile-true" $ dropWhileTrue1 value @@ -1091,10 +948,6 @@ o_1_space_filteringX4 value = , benchIO "filterM-all-out" $ filterMAllOut4 value , benchIO "filterM-all-in" $ filterMAllIn4 value - -- trimming - , benchIO "take-all" $ takeAll4 value - , benchIO "takeWhile-true" $ takeWhileTrue4 value - , benchIO "takeWhileM-true" $ takeWhileMTrue4 value , benchIO "drop-one" $ dropOne4 value , benchIO "drop-all" $ dropAll4 value , benchIO "dropWhile-true" $ dropWhileTrue4 value @@ -1327,8 +1180,7 @@ o_1_space_indexingX4 value = benchmarks :: Int -> [(SpaceComplexity, Benchmark)] benchmarks size = map (SpaceO_1,) (Prelude.concat - [ o_1_space_functor size - , o_1_space_mapping size + [ o_1_space_mapping size , o_1_space_mappingX4 size , o_1_space_filtering size , o_1_space_filteringX4 size diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Type.hs b/benchmark/Streamly/Benchmark/Data/Stream/Type.hs new file mode 100644 index 0000000000..91f9024f6a --- /dev/null +++ b/benchmark/Streamly/Benchmark/Data/Stream/Type.hs @@ -0,0 +1,1388 @@ +-- | +-- Module : Stream.Type +-- 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 + +module Stream.Type + ( benchmarks + , boundedInts + , infiniteInts + , boundedIntsUnfold + , checkStream + , checkPair + , result + ) 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 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 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 +------------------------------------------------------------------------------- + +{-# INLINE sourceFromList #-} +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'). +{-# INLINE sourceFromTuple #-} +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 + +o_1_space_generation :: Int -> [Benchmark] +o_1_space_generation value = + [ bgroup "generation" + [ benchIO "fromList" $ sourceFromList value + , benchIO "fromTuple" $ sourceFromTuple value + ] + ] + +------------------------------------------------------------------------------- +-- Reductions +------------------------------------------------------------------------------- + +{-# INLINE uncons #-} +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 + +{-# INLINE foldBreak #-} +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 + +{-# INLINE foldrMElem #-} +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 + +{-# INLINE foldrMElemIdentity #-} +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 + +{-# 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) + +#ifdef INSPECTION +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 + +#ifdef INSPECTION +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)) + +#ifdef INSPECTION +inspect $ hasNoTypeClasses 'foldlM'Reduce +inspect $ 'foldlM'Reduce `hasNoType` ''S.Step +#endif + +{-# INLINE foldlM'ReduceIdentity #-} +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 + +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 + ] + ] + + -- deconstruction + , benchIO "uncons" $ uncons value + , benchIO "foldBreak" $ foldBreak value + ] + ] + +{-# 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 [])) + +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 + ] + ] + +{-# 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)) + +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 + ] + ] + +{-# 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 = + [ bgroup "toList" + -- 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 = + 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 + +{-# INLINE cmpByPure #-} +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 + +o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark] +o_1_space_elimination_multi_stream_pure value = + [ bgroup "multi-stream-pure" + [ benchIO "eqBy" $ eqByPure value + , benchIO "cmpBy" $ cmpByPure value + ] + ] + +{-# INLINE eqBy #-} +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 + +{-# INLINE cmpBy #-} +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 + +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 + ] + ] + +------------------------------------------------------------------------------- +-- 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 + +{-# INLINE map1 #-} +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 + +{-# INLINE mapM1 #-} +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 + +{-# INLINE mapN4 #-} +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 + +{-# INLINE mapM4 #-} +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 + +o_1_space_functor :: Int -> [Benchmark] +o_1_space_functor value = + [ bgroup "Functor" + [ 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 + ] + ] + +o_1_space_mappingX4 :: Int -> [Benchmark] +o_1_space_mappingX4 value = + [ bgroup "mappingX4" + [ benchIO "map" $ mapN4 value + , benchIO "mapM" $ mapM4 value + ] + ] + +------------------------------------------------------------------------------- +-- 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) + +{-# INLINE takeAll1 #-} +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 + +{-# INLINE takeAll4 #-} +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)) + +{-# INLINE takeWhileTrue1 #-} +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 + +{-# INLINE takeWhileTrue4 #-} +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))) + +{-# INLINE takeWhileMTrue4 #-} +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 + +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" ... + ] + ] + +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 + ] + ] + +------------------------------------------------------------------------------- +-- Multi-stream +------------------------------------------------------------------------------- + +------------------------------------------------------------------------------- +-- Appending +------------------------------------------------------------------------------- + +{-# INLINE serial2 #-} +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 + +{-# INLINE serial4 #-} +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 +------------------------------------------------------------------------------- + +{-# INLINE zipWith #-} +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 + +{-# INLINE zipWithM #-} +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 + +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) + ] + ] + +------------------------------------------------------------------------------- +-- 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 + +{-# INLINE concatMap #-} +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 + +{-# INLINE concatMapM2 #-} +concatMapM2 :: Int -> IO () +concatMapM2 value = withStream value $ \s -> + drain $ do + Stream.concatMapM (\x -> + pure $ Stream.concatMapM (\y -> + pure $ Stream.fromPure $ x + y) s) s + +{-# INLINE concatMapM3 #-} +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 + +{-# INLINE concatMapViaUnfoldEach #-} +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) + +{-# INLINE concatMapM #-} +concatMapM :: Int -> Int -> IO () +concatMapM outer inner = withRandomIntIO $ \n -> + drain $ S.concatMapM + (return . sourceUnfoldrM inner) + (sourceUnfoldrM outer 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 + (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 + +{-# INLINE unfoldEach #-} +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 + +{-# INLINE unfoldEach2 #-} +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 + +{-# INLINE unfoldEach3 #-} +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 + +{-# INLINE unfoldCross #-} +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 + +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 + ] + ] + + where + + sqrtVal = round $ sqrt (fromIntegral value :: Double) + cubertVal = round (fromIntegral value**(1/3::Double)) -- triple nested loop + +------------------------------------------------------------------------------- +-- 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)) + +{-# INLINE cross2 #-} +cross2 :: Int -> IO () +cross2 linearCount = withRandomIntIO $ \start -> drain $ + Stream.crossWith (+) + (sourceUnfoldr nestedCount2 start) + (sourceUnfoldr nestedCount2 start) + + where + + nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) + +{-# INLINE crossApply #-} +crossApply :: Int -> IO () +crossApply linearCount = withRandomIntIO $ \start -> drain $ + Stream.crossApply + ((+) <$> sourceUnfoldrM nestedCount2 start) + (sourceUnfoldrM nestedCount2 start) + + where + + nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) + +{-# INLINE crossApplyFst #-} +crossApplyFst :: Int -> IO () +crossApplyFst linearCount = withRandomIntIO $ \start -> drain $ + Stream.crossApplyFst + (sourceUnfoldrM nestedCount2 start) + (sourceUnfoldrM nestedCount2 start) + + where + + nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) + +{-# INLINE crossApplySnd #-} +crossApplySnd :: Int -> IO () +crossApplySnd linearCount = withRandomIntIO $ \start -> drain $ + Stream.crossApplySnd + (sourceUnfoldrM nestedCount2 start) + (sourceUnfoldrM nestedCount2 start) + + where + + nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) + +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 + ] + ] + +------------------------------------------------------------------------------- +-- Monad +------------------------------------------------------------------------------- + +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) + ] + ] + +o_n_space_monad :: Int -> [Benchmark] +o_n_space_monad value = + [ bgroup "Monad" + [ benchIO "toList2" $ withRandomIntIO (toListM value) + , benchIO "toListSome2" $ withRandomIntIO (toListSome value) + ] + ] + +{-# 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 + Stream.concatFor s $ \x -> + Stream.concatFor s $ \y -> + Stream.fromPure $ x + y + +{-# INLINE drainConcatForM #-} +drainConcatForM :: Int -> IO () +drainConcatForM count = withStream count $ \s -> + drain $ do + Stream.concatForM s $ \x -> + pure $ Stream.concatForM s $ \y -> + pure $ Stream.fromPure $ x + y + +{-# INLINE drainConcatFor3 #-} +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 + +{-# INLINE drainConcatFor4 #-} +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 + +{-# INLINE drainConcatFor5 #-} +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 + +{-# INLINE drainConcatFor3M #-} +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 + +{-# INLINE filterAllInConcatFor #-} +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 + +{-# INLINE filterAllOutConcatFor #-} +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 + +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 + ] + ] + + 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 +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) + +-- 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 + ] + ] + + where + + sqrtVal = round $ sqrt (fromIntegral value :: Double) + +------------------------------------------------------------------------------- +-- Fold Many +------------------------------------------------------------------------------- + +{-# INLINE foldMany #-} +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 + +{-# INLINE foldMany1 #-} +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 + +{-# INLINE refoldMany #-} +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 + +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 + ] + ] + +------------------------------------------------------------------------------- +-- 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 = + -- Construction + map (SpaceO_1,) (o_1_space_generation size) + -- Elimination + ++ map (SpaceO_1,) (o_1_space_elimination_folds size) + ++ map (HeapO_n,) (o_n_heap_elimination_foldl 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) + -- 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) + -- Filtering + ++ map (SpaceO_1,) (o_1_space_filtering size) + ++ map (SpaceO_1,) (o_1_space_filteringX4 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) + -- Fold Many + ++ map (SpaceO_1,) (o_1_space_grouping size) diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index 02abace0d6..c786dbed9d 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -446,6 +446,7 @@ benchmark Data.Stream -- XXX uses lot of memory Stream.SplitChunks Stream.Transform + Stream.Type if flag(limit-build-mem) if flag(dev) ghc-options: +RTS -M1000M -RTS diff --git a/core/src/Streamly/Internal/Data/Refold/Type.hs b/core/src/Streamly/Internal/Data/Refold/Type.hs index 1ffe45d9ae..ea713f3adc 100644 --- a/core/src/Streamly/Internal/Data/Refold/Type.hs +++ b/core/src/Streamly/Internal/Data/Refold/Type.hs @@ -25,6 +25,7 @@ module Streamly.Internal.Data.Refold.Type ( -- * Types Refold (..) + , Tuple'Fused (..) -- * Constructors , foldl' From 1698db7b48f45c8f7f6ec785426fc3686cbee744 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Thu, 11 Jun 2026 17:44:35 +0530 Subject: [PATCH 3/8] Remove unused import in Parser/Monad benchmark --- benchmark/Streamly/Benchmark/Data/Parser/Monad.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/benchmark/Streamly/Benchmark/Data/Parser/Monad.hs b/benchmark/Streamly/Benchmark/Data/Parser/Monad.hs index abab761b8b..1259927d77 100644 --- a/benchmark/Streamly/Benchmark/Data/Parser/Monad.hs +++ b/benchmark/Streamly/Benchmark/Data/Parser/Monad.hs @@ -35,7 +35,6 @@ import Streamly.Internal.Data.Stream (Stream) import System.Random (randomRIO) import Test.Tasty.Bench (Benchmark, bench, nfIO) -import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Parser as PR import qualified Streamly.Internal.Data.Stream as Stream From aa1fd527acacbe0d89a69cae75574a95ed5cda0a Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Thu, 11 Jun 2026 18:21:21 +0530 Subject: [PATCH 4/8] Use per benchmark IO action in Data.ParserK benchmarks --- benchmark/Streamly/Benchmark/Data/ParserK.hs | 163 +++++++++---------- 1 file changed, 77 insertions(+), 86 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/ParserK.hs b/benchmark/Streamly/Benchmark/Data/ParserK.hs index 4ee991aa98..2d0f4b1d4b 100644 --- a/benchmark/Streamly/Benchmark/Data/ParserK.hs +++ b/benchmark/Streamly/Benchmark/Data/ParserK.hs @@ -110,31 +110,34 @@ sourceUnfoldrM value n = Stream.unfoldrM step n then return Nothing else return (Just (cnt, cnt + 1)) --- | Takes a fold method, and uses it with a default source. -{-# INLINE benchIOSink #-} -benchIOSink - :: NFData b - => Int -> String -> (StreamK IO PARSE_ELEM -> IO b) -> Benchmark -benchIOSink value name f = - bench name $ nfIO $ randomRIO (1,1) - >>= f - . StreamK.fromStream +{-# INLINE benchIO #-} +benchIO :: NFData b => String -> IO b -> Benchmark +benchIO name = bench name . nfIO + +{-# INLINE withStreamK #-} +withStreamK :: Int -> (StreamK IO PARSE_ELEM -> IO b) -> IO b +withStreamK value f = + randomRIO (1,1) >>= + f . StreamK.fromStream #ifdef BENCH_CHUNKED - . Array.chunksOf 4000 + . Array.chunksOf 4000 #endif #ifdef BENCH_CHUNKED_GENERIC - . GenArr.chunksOf 4000 + . GenArr.chunksOf 4000 #endif - . sourceUnfoldrM value + . sourceUnfoldrM value ------------------------------------------------------------------------------- -- Parsers ------------------------------------------------------------------------------- +{-# INLINE drain #-} +drain :: Int -> IO () +drain value = withStreamK value $ Stream.fold Fold.drain . StreamK.toStream + {-# INLINE one #-} -one :: MonadIO m => - Int -> StreamK m PARSE_ELEM -> m (Either ParseError (Maybe Int)) -one value = PARSE_OP p +one :: Int -> IO (Either ParseError (Maybe Int)) +one value = withStreamK value $ PARSE_OP p where @@ -153,25 +156,22 @@ takeWhile :: CONSTRAINT_IO => (a -> Bool) -> PR.ParserK INPUT m () takeWhile p = FROM_PARSER $ PRD.takeWhile p FL.drain {-# INLINE takeWhileK #-} -takeWhileK :: MonadIO m => - Int -> StreamK m PARSE_ELEM -> m (Either ParseError ()) -takeWhileK value = PARSE_OP (takeWhile (<= value)) +takeWhileK :: Int -> IO (Either ParseError ()) +takeWhileK value = withStreamK value $ PARSE_OP (takeWhile (<= value)) {-# INLINE splitAp2 #-} -splitAp2 :: MonadIO m - => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ((), ())) +splitAp2 :: Int -> IO (Either ParseError ((), ())) splitAp2 value = - PARSE_OP + withStreamK value $ PARSE_OP ((,) <$> takeWhile (<= (value `div` 2)) <*> takeWhile (<= value) ) {-# INLINE splitAp8 #-} -splitAp8 :: MonadIO m - => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ()) +splitAp8 :: Int -> IO (Either ParseError ()) splitAp8 value = - PARSE_OP + withStreamK value $ PARSE_OP ( (\() () () () () () () () -> ()) <$> takeWhile (<= ( value `div` 8)) <*> takeWhile (<= ((value * 2) `div` 8)) @@ -184,36 +184,35 @@ splitAp8 value = ) {-# INLINE sequenceA #-} -sequenceA :: MonadIO m => Int -> StreamK m PARSE_ELEM -> m Int -sequenceA value xs = do +sequenceA :: Int -> IO Int +sequenceA value = withStreamK value $ \xs -> do let parser = satisfy (> 0) list = Prelude.replicate value parser x <- PARSE_OP (TR.sequenceA list) xs return $ Prelude.length x {-# INLINE sequenceA_ #-} -sequenceA_ :: MonadIO m => - Int -> StreamK m PARSE_ELEM -> m (Either ParseError ()) -sequenceA_ value xs = do +sequenceA_ :: Int -> IO (Either ParseError ()) +sequenceA_ value = withStreamK value $ \xs -> do let parser = satisfy (> 0) list = Prelude.replicate value parser PARSE_OP (F.sequenceA_ list) xs {-# INLINE sequence #-} -sequence :: MonadIO m => Int -> StreamK m PARSE_ELEM -> m Int -sequence value xs = do +sequence :: Int -> IO Int +sequence value = withStreamK value $ \xs -> do let parser = satisfy (> 0) list = Prelude.replicate value parser x <- PARSE_OP (TR.sequence list) xs return $ Prelude.length x {-# INLINE sequence_ #-} -sequence_ :: MonadIO m => - Int -> StreamK m PARSE_ELEM -> m (Either ParseError ()) +sequence_ :: Int -> IO (Either ParseError ()) sequence_ value = - let parser = satisfy (> 0) - list = Prelude.replicate value parser - in PARSE_OP (F.sequence_ list) + withStreamK value $ + let parser = satisfy (> 0) + list = Prelude.replicate value parser + in PARSE_OP (F.sequence_ list) {-# INLINE takeWhileFailD #-} takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b @@ -246,19 +245,17 @@ takeWhileFail :: CONSTRAINT => takeWhileFail p f = FROM_PARSER (takeWhileFailD p f) {-# INLINE alt2 #-} -alt2 :: MonadIO m - => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ()) +alt2 :: Int -> IO (Either ParseError ()) alt2 value = - PARSE_OP + withStreamK value $ PARSE_OP ( takeWhileFail (<= (value `div` 2)) Fold.drain <|> takeWhile (<= value) ) {-# INLINE alt8 #-} -alt8 :: MonadIO m - => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ()) +alt8 :: Int -> IO (Either ParseError ()) alt8 value = - PARSE_OP + withStreamK value $ PARSE_OP ( takeWhileFail (<= ( value `div` 8)) Fold.drain <|> takeWhileFail (<= ((value * 2) `div` 8)) Fold.drain <|> takeWhileFail (<= ((value * 3) `div` 8)) Fold.drain @@ -270,10 +267,9 @@ alt8 value = ) {-# INLINE alt16 #-} -alt16 :: MonadIO m - => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ()) +alt16 :: Int -> IO (Either ParseError ()) alt16 value = - PARSE_OP + withStreamK value $ PARSE_OP ( takeWhileFail (<= ( value `div` 16)) Fold.drain <|> takeWhileFail (<= ((value * 2) `div` 16)) Fold.drain <|> takeWhileFail (<= ((value * 3) `div` 16)) Fold.drain @@ -293,47 +289,43 @@ alt16 value = ) {-# INLINE manyAlt #-} -manyAlt :: MonadIO m => StreamK m PARSE_ELEM -> m Int -manyAlt xs = do +manyAlt :: Int -> IO Int +manyAlt value = withStreamK value $ \xs -> do x <- PARSE_OP (AP.many (satisfy (> 0))) xs return $ Prelude.length x {-# INLINE someAlt #-} -someAlt :: MonadIO m => StreamK m PARSE_ELEM -> m Int -someAlt xs = do +someAlt :: Int -> IO Int +someAlt value = withStreamK value $ \xs -> do x <- PARSE_OP (AP.some (satisfy (> 0))) xs return $ Prelude.length x {-# INLINE choice #-} -choice :: MonadIO m => - Int -> StreamK m PARSE_ELEM -> m (Either ParseError Int) +choice :: Int -> IO (Either ParseError Int) choice value = - PARSE_OP (asum (replicate value (satisfy (< 0))) + withStreamK value $ PARSE_OP (asum (replicate value (satisfy (< 0))) AP.<|> satisfy (> 0)) {-# INLINE monad2 #-} -monad2 :: MonadIO m - => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ()) +monad2 :: Int -> IO (Either ParseError ()) monad2 value = - PARSE_OP $ do + withStreamK value $ PARSE_OP $ do takeWhile (<= (value `div` 2)) takeWhile (<= value) {-# INLINE monad4 #-} -monad4 :: MonadIO m - => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ()) +monad4 :: Int -> IO (Either ParseError ()) monad4 value = - PARSE_OP $ do + withStreamK value $ PARSE_OP $ do takeWhile (<= ( value `div` 4)) takeWhile (<= ((value * 2) `div` 4)) takeWhile (<= ((value * 3) `div` 4)) takeWhile (<= value) {-# INLINE monad8 #-} -monad8 :: MonadIO m - => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ()) +monad8 :: Int -> IO (Either ParseError ()) monad8 value = - PARSE_OP $ do + withStreamK value $ PARSE_OP $ do takeWhile (<= ( value `div` 8)) takeWhile (<= ((value * 2) `div` 8)) takeWhile (<= ((value * 3) `div` 8)) @@ -344,10 +336,9 @@ monad8 value = takeWhile (<= value) {-# INLINE monad16 #-} -monad16 :: MonadIO m - => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ()) +monad16 :: Int -> IO (Either ParseError ()) monad16 value = - PARSE_OP $ do + withStreamK value $ PARSE_OP $ do takeWhile (<= ( value `div` 16)) takeWhile (<= ((value * 2) `div` 16)) takeWhile (<= ((value * 3) `div` 16)) @@ -378,18 +369,18 @@ instance NFData ParseError where o_1_space_serial :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_serial value = - [ (SpaceO_1, benchIOSink value "drain" (Stream.fold Fold.drain . StreamK.toStream)) - , (SpaceO_1, benchIOSink value "takeWhile" $ takeWhileK value) - , (SpaceO_1, benchIOSink value "splitAp2" $ splitAp2 value) - , (SpaceO_1, benchIOSink value "splitAp8" $ splitAp8 value) - , (SpaceO_1, benchIOSink value "alt2" $ alt2 value) - , (SpaceO_1, benchIOSink value "monad2" $ monad2 value) - , (SpaceO_1, benchIOSink value "monad4" $ monad4 value) + [ (SpaceO_1, benchIO "drain" $ drain value) + , (SpaceO_1, benchIO "takeWhile" $ takeWhileK value) + , (SpaceO_1, benchIO "splitAp2" $ splitAp2 value) + , (SpaceO_1, benchIO "splitAp8" $ splitAp8 value) + , (SpaceO_1, benchIO "alt2" $ alt2 value) + , (SpaceO_1, benchIO "monad2" $ monad2 value) + , (SpaceO_1, benchIO "monad4" $ monad4 value) ] {-# INLINE sepBy1 #-} -sepBy1 :: MonadIO m => StreamK m PARSE_ELEM -> m Int -sepBy1 xs = do +sepBy1 :: Int -> IO Int +sepBy1 value = withStreamK value $ \xs -> do x <- PARSE_OP (parser (satisfy odd) (satisfy even)) xs return $ Prelude.length x @@ -405,26 +396,26 @@ o_n_heap_serial value = [ -- accumulates the results in a list -- XXX why should this take O(n) heap, it discards the results? - (HeapO_n, benchIOSink value "sequence_" $ sequence_ value) - , (HeapO_n, benchIOSink value "sequenceA_" $ sequenceA_ value) - , (HeapO_n, benchIOSink value "sequence" $ sequence value) - , (HeapO_n, benchIOSink value "sequenceA" $ sequenceA value) - , (HeapO_n, benchIOSink value "manyAlt" manyAlt) - , (HeapO_n, benchIOSink value "sepBy1" sepBy1) - , (HeapO_n, benchIOSink value "someAlt" someAlt) - , (HeapO_n, benchIOSink value "choice" $ choice value) + (HeapO_n, benchIO "sequence_" $ sequence_ value) + , (HeapO_n, benchIO "sequenceA_" $ sequenceA_ value) + , (HeapO_n, benchIO "sequence" $ sequence value) + , (HeapO_n, benchIO "sequenceA" $ sequenceA value) + , (HeapO_n, benchIO "manyAlt" $ manyAlt value) + , (HeapO_n, benchIO "sepBy1" $ sepBy1 value) + , (HeapO_n, benchIO "someAlt" $ someAlt value) + , (HeapO_n, benchIO "choice" $ choice value) -- XXX these take too much memory with --long, need to investigate - , (HeapO_n, benchIOSink value "alt8" $ alt8 value) - , (HeapO_n, benchIOSink value "alt16" $ alt16 value) - , (HeapO_n, benchIOSink value "monad8" $ monad8 value) - , (HeapO_n, benchIOSink value "monad16" $ monad16 value) + , (HeapO_n, benchIO "alt8" $ alt8 value) + , (HeapO_n, benchIO "alt16" $ alt16 value) + , (HeapO_n, benchIO "monad8" $ monad8 value) + , (HeapO_n, benchIO "monad16" $ monad16 value) ] -- O(n) heap beacuse of accumulation of the list in strict IO monad? o_1_space_recursive :: Int -> [(SpaceComplexity, Benchmark)] o_1_space_recursive value = - [ (SpaceO_1, benchIOSink value "one (recursive)" $ one value) + [ (SpaceO_1, benchIO "one (recursive)" $ one value) ] ------------------------------------------------------------------------------- From 25442ee4c03ba274ba0ec34ed3265c93c17071b2 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Fri, 12 Jun 2026 00:14:11 +0530 Subject: [PATCH 5/8] Use per benchmark IO action in Data.StreamK benchmarks --- benchmark/Streamly/Benchmark/Data/StreamK.hs | 1188 +++++++++--------- 1 file changed, 627 insertions(+), 561 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/StreamK.hs b/benchmark/Streamly/Benchmark/Data/StreamK.hs index c9230442e7..e89c369bb9 100644 --- a/benchmark/Streamly/Benchmark/Data/StreamK.hs +++ b/benchmark/Streamly/Benchmark/Data/StreamK.hs @@ -24,6 +24,7 @@ module Main (main) where #if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2) #endif +import Control.DeepSeq (NFData) import Control.Monad (when) import Data.Maybe (isJust) import Streamly.Internal.Data.Stream (Stream) @@ -50,133 +51,167 @@ import Test.Inspection -- Stream generation and elimination ------------------------------------------------------------------------------- -{-# INLINE unfoldr #-} -unfoldr :: Int -> Int -> StreamK m Int -unfoldr streamLen n = StreamK.unfoldr step n +{-# INLINE withRandomIntIO #-} +withRandomIntIO :: (Int -> IO b) -> IO b +withRandomIntIO f = randomRIO (1, 1 :: Int) >>= f + +{-# INLINE withDrain #-} +withDrain :: (Int -> StreamK IO a) -> IO () +withDrain f = withRandomIntIO $ \n -> StreamK.drain (f n) + +{-# INLINE sourceUnfoldr #-} +sourceUnfoldr :: Int -> Int -> StreamK m Int +sourceUnfoldr streamLen n = StreamK.unfoldr step n where step cnt = if cnt > n + streamLen then Nothing else Just (cnt, cnt + 1) -{-# INLINE unfoldrM #-} -unfoldrM :: Monad m => Int -> Int -> StreamK m Int -unfoldrM streamLen n = StreamK.unfoldrMWith StreamK.consM step n +{-# INLINE unfoldr #-} +unfoldr :: Int -> IO () +unfoldr streamLen = withDrain (sourceUnfoldr streamLen) + +{-# INLINE sourceUnfoldrM #-} +sourceUnfoldrM :: Monad m => Int -> Int -> StreamK m Int +sourceUnfoldrM streamLen n = StreamK.unfoldrMWith StreamK.consM step n where step cnt = if cnt > n + streamLen then return Nothing else return (Just (cnt, cnt + 1)) +{-# INLINE unfoldrM #-} +unfoldrM :: Int -> IO () +unfoldrM streamLen = withDrain (sourceUnfoldrM streamLen) + +{-# INLINE withStream #-} +withStream :: Int -> (StreamK IO Int -> IO b) -> IO b +withStream value f = randomRIO (1,1) >>= f . sourceUnfoldrM value + {-# INLINE repeat #-} -repeat :: Int -> Int -> StreamK m Int -repeat streamLen = StreamK.take streamLen . StreamK.repeat +repeat :: Int -> IO () +repeat streamLen = withDrain $ StreamK.take streamLen . StreamK.repeat {-# INLINE repeatM #-} -repeatM :: Monad m => Int -> Int -> StreamK m Int -repeatM streamLen = StreamK.take streamLen . StreamK.repeatM . return +repeatM :: Int -> IO () +repeatM streamLen = withDrain $ StreamK.take streamLen . StreamK.repeatM . return {-# INLINE replicate #-} -replicate :: Int -> Int -> StreamK m Int -replicate = StreamK.replicate +replicate :: Int -> IO () +replicate streamLen = withDrain (StreamK.replicate streamLen) {-# INLINE replicateM #-} -replicateM :: Monad m => Int -> Int -> StreamK m Int -replicateM streamLen = StreamK.replicateMWith StreamK.consM streamLen . return +replicateM :: Int -> IO () +replicateM streamLen = + withDrain $ StreamK.replicateMWith StreamK.consM streamLen . return {-# INLINE iterate #-} -iterate :: Int -> Int -> StreamK m Int -iterate streamLen = StreamK.take streamLen . StreamK.iterate (+1) +iterate :: Int -> IO () +iterate streamLen = withDrain $ StreamK.take streamLen . StreamK.iterate (+1) {-# INLINE iterateM #-} -iterateM :: Monad m => Int -> Int -> StreamK m Int -iterateM streamLen = StreamK.take streamLen . StreamK.iterateM (return . (+1)) . return +iterateM :: Int -> IO () +iterateM streamLen = + withDrain $ StreamK.take streamLen . StreamK.iterateM (return . (+1)) . return {-# INLINE fromFoldable #-} -fromFoldable :: Int -> Int -> StreamK m Int -fromFoldable streamLen n = StreamK.fromFoldable [n..n+streamLen] +fromFoldable :: Int -> IO () +fromFoldable streamLen = + withDrain $ \n -> StreamK.fromFoldable [n..n+streamLen] {- HLINT ignore "Fuse foldr/fmap" -} {-# INLINE fromFoldableM #-} -fromFoldableM :: Monad m => Int -> Int -> StreamK m Int -fromFoldableM streamLen n = +fromFoldableM :: Int -> IO () +fromFoldableM streamLen = + withDrain $ \n -> List.foldr StreamK.consM StreamK.nil (Prelude.fmap return [n..n+streamLen]) -{-# INLINABLE concatMapFoldableWith #-} -concatMapFoldableWith :: P.Foldable f - => (StreamK m b -> StreamK m b -> StreamK m b) - -> (a -> StreamK m b) - -> f a - -> StreamK m b -concatMapFoldableWith f g = P.foldr (f . g) StreamK.nil - {-# INLINE concatMapFoldableSerial #-} concatMapFoldableSerial :: Int -> Int -> StreamK m Int concatMapFoldableSerial streamLen n = - concatMapFoldableWith StreamK.append StreamK.fromPure [n..n+streamLen] + P.foldr (StreamK.append . StreamK.fromPure) StreamK.nil [n..n+streamLen] {-# INLINE concatMapFoldableSerialM #-} concatMapFoldableSerialM :: Monad m => Int -> Int -> StreamK m Int concatMapFoldableSerialM streamLen n = - concatMapFoldableWith StreamK.append (StreamK.fromEffect . return) [n..n+streamLen] + P.foldr (StreamK.append . StreamK.fromEffect . return) StreamK.nil [n..n+streamLen] + +{-# INLINE concatMapFoldableWith #-} +concatMapFoldableWith :: Int -> IO () +concatMapFoldableWith streamLen = withDrain (concatMapFoldableSerial streamLen) + +{-# INLINE concatMapFoldableWithM #-} +concatMapFoldableWithM :: Int -> IO () +concatMapFoldableWithM streamLen = withDrain (concatMapFoldableSerialM streamLen) ------------------------------------------------------------------------------- -- Elimination ------------------------------------------------------------------------------- -{-# INLINE drain #-} -drain :: Monad m => StreamK m a -> m () -drain = StreamK.drain +{-# INLINE toNull #-} +toNull :: Int -> IO () +toNull streamLen = withDrain (sourceUnfoldrM streamLen) {-# INLINE mapM_ #-} -mapM_ :: Monad m => StreamK m a -> m () -mapM_ = StreamK.mapM_ (\_ -> return ()) +mapM_ :: Int -> IO () +mapM_ streamLen = withStream streamLen (StreamK.mapM_ (\_ -> return ())) {-# INLINE uncons #-} -uncons :: Monad m => StreamK m Int -> m () -uncons s = do - r <- StreamK.uncons s - case r of - Nothing -> return () - Just (_, t) -> uncons t +uncons :: Int -> IO () +uncons streamLen = withStream streamLen go + where + go s = do + r <- StreamK.uncons s + case r of + Nothing -> return () + Just (_, t) -> go t {-# INLINE init #-} -init :: Monad m => StreamK m a -> m () -init s = do - t <- StreamK.init s - P.mapM_ StreamK.drain t +init :: Int -> IO () +init streamLen = withStream streamLen go + where + go s = do + t <- StreamK.init s + P.mapM_ StreamK.drain t {-# INLINE tail #-} -tail :: Monad m => StreamK m a -> m () -tail s = StreamK.tail s >>= P.mapM_ tail +tail :: Int -> IO () +tail streamLen = withStream streamLen go + where go s = StreamK.tail s >>= P.mapM_ go {-# INLINE nullTail #-} -nullTail :: Monad m => StreamK m Int -> m () -nullTail s = do - r <- StreamK.null s - when (not r) $ StreamK.tail s >>= P.mapM_ nullTail +nullTail :: Int -> IO () +nullTail streamLen = withStream streamLen go + where + go s = do + r <- StreamK.null s + when (not r) $ StreamK.tail s >>= P.mapM_ go {-# INLINE headTail #-} -headTail :: Monad m => StreamK m Int -> m () -headTail s = do - h <- StreamK.head s - when (isJust h) $ StreamK.tail s >>= P.mapM_ headTail +headTail :: Int -> IO () +headTail streamLen = withStream streamLen go + where + go s = do + h <- StreamK.head s + when (isJust h) $ StreamK.tail s >>= P.mapM_ go {-# INLINE toList #-} -toList :: Monad m => StreamK m Int -> m [Int] -toList = StreamK.toList +toList :: Int -> IO [Int] +toList streamLen = withStream streamLen StreamK.toList {-# INLINE foldl' #-} -foldl' :: Monad m => StreamK m Int -> m Int -foldl' = StreamK.foldl' (+) 0 +foldl' :: Int -> IO Int +foldl' streamLen = withStream streamLen (StreamK.foldl' (+) 0) {-# INLINE foldlM' #-} -foldlM' :: Monad m => StreamK m Int -> m Int -foldlM' = StreamK.foldlM' (\b a -> return (b + a)) (return 0) +foldlM' :: Int -> IO Int +foldlM' streamLen = + withStream streamLen (StreamK.foldlM' (\b a -> return (b + a)) (return 0)) {-# INLINE last #-} -last :: Monad m => StreamK m Int -> m (Maybe Int) -last = StreamK.last +last :: Int -> IO (Maybe Int) +last streamLen = withStream streamLen StreamK.last ------------------------------------------------------------------------------- -- Transformation @@ -188,83 +223,87 @@ composeN => Int -> (StreamK m Int -> StreamK m Int) -> StreamK m Int -> m () composeN n f = case n of - 1 -> drain . f - 2 -> drain . f . f - 3 -> drain . f . f . f - 4 -> drain . f . f . f . f + 1 -> StreamK.drain . f + 2 -> StreamK.drain . f . f + 3 -> StreamK.drain . f . f . f + 4 -> StreamK.drain . f . f . f . f _ -> undefined {-# INLINE scanl' #-} -scanl' :: Monad m => Int -> StreamK m Int -> m () -scanl' n = composeN n $ StreamK.scanl' (+) 0 +scanl' :: Int -> Int -> IO () +scanl' n streamLen = withStream streamLen (composeN n (StreamK.scanl' (+) 0)) {-# INLINE map #-} -map :: Monad m => Int -> StreamK m Int -> m () -map n = composeN n $ StreamK.map (+ 1) +map :: Int -> Int -> IO () +map n streamLen = withStream streamLen (composeN n (StreamK.map (+ 1))) {-# INLINE fmapK #-} -fmapK :: Monad m => Int -> StreamK m Int -> m () -fmapK n = composeN n $ P.fmap (+ 1) +fmapK :: Int -> Int -> IO () +fmapK n streamLen = withStream streamLen (composeN n (P.fmap (+ 1))) {-# INLINE mapM #-} -mapM :: Monad m => Int -> StreamK m Int -> m () -mapM n = composeN n $ StreamK.mapMWith StreamK.consM return +mapM :: Int -> Int -> IO () +mapM n streamLen = withStream streamLen (composeN n (StreamK.mapMWith StreamK.consM return)) {-# INLINE mapMSerial #-} -mapMSerial :: Monad m => Int -> StreamK m Int -> m () -mapMSerial n = composeN n $ StreamK.mapMSerial return +mapMSerial :: Int -> Int -> IO () +mapMSerial n streamLen = withStream streamLen (composeN n (StreamK.mapMSerial return)) {-# INLINE filterEven #-} -filterEven :: Monad m => Int -> StreamK m Int -> m () -filterEven n = composeN n $ StreamK.filter even +filterEven :: Int -> Int -> IO () +filterEven n streamLen = withStream streamLen (composeN n (StreamK.filter even)) {-# INLINE filterAllOut #-} -filterAllOut :: Monad m => Int -> Int -> StreamK m Int -> m () -filterAllOut streamLen n = composeN n $ StreamK.filter (> streamLen) +filterAllOut :: Int -> Int -> IO () +filterAllOut n streamLen = withStream streamLen (composeN n (StreamK.filter (> streamLen))) {-# INLINE filterAllIn #-} -filterAllIn :: Monad m => Int -> Int -> StreamK m Int -> m () -filterAllIn streamLen n = composeN n $ StreamK.filter (<= streamLen) +filterAllIn :: Int -> Int -> IO () +filterAllIn n streamLen = withStream streamLen (composeN n (StreamK.filter (<= streamLen))) {-# INLINE _takeOne #-} _takeOne :: Monad m => Int -> StreamK m Int -> m () _takeOne n = composeN n $ StreamK.take 1 {-# INLINE takeAll #-} -takeAll :: Monad m => Int -> Int -> StreamK m Int -> m () -takeAll streamLen n = composeN n $ StreamK.take streamLen +takeAll :: Int -> Int -> IO () +takeAll n streamLen = withStream streamLen (composeN n (StreamK.take streamLen)) {-# INLINE takeWhileTrue #-} -takeWhileTrue :: Monad m => Int -> Int -> StreamK m Int -> m () -takeWhileTrue streamLen n = composeN n $ StreamK.takeWhile (<= streamLen) +takeWhileTrue :: Int -> Int -> IO () +takeWhileTrue n streamLen = withStream streamLen (composeN n (StreamK.takeWhile (<= streamLen))) {-# INLINE dropOne #-} -dropOne :: Monad m => Int -> StreamK m Int -> m () -dropOne n = composeN n $ StreamK.drop 1 +dropOne :: Int -> Int -> IO () +dropOne n streamLen = withStream streamLen (composeN n (StreamK.drop 1)) {-# INLINE dropAll #-} -dropAll :: Monad m => Int -> Int -> StreamK m Int -> m () -dropAll streamLen n = composeN n $ StreamK.drop streamLen +dropAll :: Int -> Int -> IO () +dropAll n streamLen = withStream streamLen (composeN n (StreamK.drop streamLen)) {-# INLINE dropWhileTrue #-} -dropWhileTrue :: Monad m => Int -> Int -> StreamK m Int -> m () -dropWhileTrue streamLen n = composeN n $ StreamK.dropWhile (<= streamLen) +dropWhileTrue :: Int -> Int -> IO () +dropWhileTrue n streamLen = withStream streamLen (composeN n (StreamK.dropWhile (<= streamLen))) {-# INLINE dropWhileFalse #-} -dropWhileFalse :: Monad m => Int -> StreamK m Int -> m () -dropWhileFalse n = composeN n $ StreamK.dropWhile (<= 1) +dropWhileFalse :: Int -> Int -> IO () +dropWhileFalse n streamLen = withStream streamLen (composeN n (StreamK.dropWhile (<= 1))) {-# INLINE foldrS #-} -foldrS :: Monad m => Int -> StreamK m Int -> m () -foldrS n = composeN n $ StreamK.foldrS StreamK.cons StreamK.nil +foldrS :: Int -> Int -> IO () +foldrS n streamLen = withStream streamLen (composeN n (StreamK.foldrS StreamK.cons StreamK.nil)) {-# INLINE foldlS #-} -foldlS :: Monad m => Int -> StreamK m Int -> m () -foldlS n = composeN n $ StreamK.foldlS (flip StreamK.cons) StreamK.nil +foldlS :: Int -> Int -> IO () +foldlS n streamLen = withStream streamLen (composeN n (StreamK.foldlS (flip StreamK.cons) StreamK.nil)) {-# INLINE intersperse #-} -intersperse :: Monad m => Int -> Int -> StreamK m Int -> m () -intersperse streamLen n = composeN n $ StreamK.intersperse streamLen +intersperse :: Int -> Int -> Int -> IO () +intersperse bound n streamLen = withStream streamLen (composeN n (StreamK.intersperse bound)) + +{-# INLINE interspersePure #-} +interspersePure :: Int -> Int -> Int -> IO () +interspersePure bound n streamLen = withRandomIntIO $ composeN n (StreamK.intersperse bound) . sourceUnfoldr streamLen ------------------------------------------------------------------------------- -- Iteration @@ -273,58 +312,63 @@ intersperse streamLen n = composeN n $ StreamK.intersperse streamLen {-# INLINE iterateSource #-} iterateSource :: Monad m => Int -> (StreamK m Int -> StreamK m Int) -> Int -> Int -> StreamK m Int -iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n) +iterateSource iterStreamLen g i n = f i (sourceUnfoldrM iterStreamLen n) where f (0 :: Int) m = g m f x m = g (f (x P.- 1) m) -- this is quadratic {-# INLINE iterateScan #-} -iterateScan :: Monad m => Int -> Int -> Int -> StreamK m Int +iterateScan :: Int -> Int -> IO () iterateScan iterStreamLen maxIters = - iterateSource iterStreamLen (StreamK.scanl' (+) 0) (maxIters `div` 10) + withDrain $ iterateSource iterStreamLen (StreamK.scanl' (+) 0) (maxIters `div` 10) -- this is quadratic {-# INLINE iterateDropWhileFalse #-} -iterateDropWhileFalse :: Monad m => Int -> Int -> Int -> Int -> StreamK m Int +iterateDropWhileFalse :: Int -> Int -> Int -> IO () iterateDropWhileFalse streamLen iterStreamLen maxIters = - iterateSource iterStreamLen (StreamK.dropWhile (> streamLen)) (maxIters `div` 10) + withDrain $ iterateSource iterStreamLen (StreamK.dropWhile (> streamLen)) (maxIters `div` 10) {-# INLINE iterateMapM #-} -iterateMapM :: Monad m => Int -> Int -> Int -> StreamK m Int -iterateMapM iterStreamLen = - iterateSource iterStreamLen (StreamK.mapMWith StreamK.consM return) +iterateMapM :: Int -> Int -> IO () +iterateMapM iterStreamLen maxIters = + withDrain $ iterateSource iterStreamLen (StreamK.mapMWith StreamK.consM return) maxIters {-# INLINE iterateFilterEven #-} -iterateFilterEven :: Monad m => Int -> Int -> Int -> StreamK m Int -iterateFilterEven iterStreamLen = iterateSource iterStreamLen (StreamK.filter even) +iterateFilterEven :: Int -> Int -> IO () +iterateFilterEven iterStreamLen maxIters = + withDrain $ iterateSource iterStreamLen (StreamK.filter even) maxIters {-# INLINE iterateTakeAll #-} -iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> StreamK m Int -iterateTakeAll streamLen iterStreamLen = - iterateSource iterStreamLen (StreamK.take streamLen) +iterateTakeAll :: Int -> Int -> Int -> IO () +iterateTakeAll streamLen iterStreamLen maxIters = + withDrain $ iterateSource iterStreamLen (StreamK.take streamLen) maxIters {-# INLINE iterateDropOne #-} -iterateDropOne :: Monad m => Int -> Int -> Int -> StreamK m Int -iterateDropOne iterStreamLen = iterateSource iterStreamLen (StreamK.drop 1) +iterateDropOne :: Int -> Int -> IO () +iterateDropOne iterStreamLen maxIters = + withDrain $ iterateSource iterStreamLen (StreamK.drop 1) maxIters {-# INLINE iterateDropWhileTrue #-} -iterateDropWhileTrue :: - Monad m => Int -> Int -> Int -> Int -> StreamK m Int -iterateDropWhileTrue streamLen iterStreamLen = - iterateSource iterStreamLen (StreamK.dropWhile (<= streamLen)) +iterateDropWhileTrue :: Int -> Int -> Int -> IO () +iterateDropWhileTrue streamLen iterStreamLen maxIters = + withDrain $ iterateSource iterStreamLen (StreamK.dropWhile (<= streamLen)) maxIters ------------------------------------------------------------------------------- -- Zipping ------------------------------------------------------------------------------- {-# INLINE zipWith #-} -zipWith :: Monad m => StreamK m Int -> m () -zipWith src = drain $ StreamK.zipWith (,) src src +zipWith :: Int -> IO () +zipWith streamLen = withDrain $ \n -> + let src = sourceUnfoldrM streamLen n + in StreamK.zipWith (,) src src {-# INLINE zipWithM #-} -zipWithM :: Monad m => StreamK m Int -> m () -zipWithM src = drain $ StreamK.zipWithM (curry return) src src +zipWithM :: Int -> IO () +zipWithM streamLen = withDrain $ \n -> + let src = sourceUnfoldrM streamLen n + in StreamK.zipWithM (curry return) src src ------------------------------------------------------------------------------- -- Sorting @@ -335,43 +379,49 @@ sortByK :: (Int -> Int -> Ordering) -> StreamK m Int -> StreamK m Int sortByK f = StreamK.mergeMapWith (StreamK.mergeBy f) StreamK.fromPure {-# INLINE sortBy #-} -sortBy :: Monad m => (Int -> Int -> Ordering) -> StreamK m Int -> m () -sortBy f = drain . sortByK f +sortBy :: (Int -> Int -> Ordering) -> Int -> IO () +sortBy cmp streamLen = withDrain $ sortByK cmp . sourceUnfoldrM streamLen + +{-# INLINE sortByCompareRandomized #-} +sortByCompareRandomized :: Int -> IO () +sortByCompareRandomized streamLen = + withDrain $ sortByK compare . StreamK.map (\x -> if even x then x + 2 else x) . sourceUnfoldrM streamLen ------------------------------------------------------------------------------- -- Joining ------------------------------------------------------------------------------- {-# INLINE interleave2 #-} -interleave2 :: Int -> Int -> IO () -interleave2 value n = - StreamK.drain $ StreamK.interleave - (unfoldrM (value `div` 2) n) - (unfoldrM (value `div` 2) (n + 1)) +interleave2 :: Int -> IO () +interleave2 value = + withDrain $ \n -> + StreamK.interleave + (sourceUnfoldrM (value `div` 2) n) + (sourceUnfoldrM (value `div` 2) (n + 1)) {-# INLINE concatMapWith #-} concatMapWith :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int) -> Int -> Int - -> Int -> IO () -concatMapWith op outer inner n = - StreamK.drain $ StreamK.concatMapWith op - (unfoldrM inner) - (unfoldrM outer n) +concatMapWith op outer inner = + withDrain $ \n -> + StreamK.concatMapWith op + (sourceUnfoldrM inner) + (sourceUnfoldrM outer n) {-# INLINE concatMapWithD #-} concatMapWithD :: (Stream IO Int -> Stream IO Int -> Stream IO Int) -> Int -> Int - -> Int -> IO () -concatMapWithD op outer inner n = - StreamK.drain $ StreamK.concatMapWith op1 - (unfoldrM inner) - (unfoldrM outer n) +concatMapWithD op outer inner = + withDrain $ \n -> + StreamK.concatMapWith op1 + (sourceUnfoldrM inner) + (sourceUnfoldrM outer n) where @@ -382,24 +432,24 @@ mergeMapWith :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int) -> Int -> Int - -> Int -> IO () -mergeMapWith op outer inner n = - StreamK.drain $ StreamK.mergeMapWith op - (unfoldrM inner) - (unfoldrM outer n) +mergeMapWith op outer inner = + withDrain $ \n -> + StreamK.mergeMapWith op + (sourceUnfoldrM inner) + (sourceUnfoldrM outer n) {-# INLINE mergeMapWithD #-} mergeMapWithD :: (Stream IO Int -> Stream IO Int -> Stream IO Int) -> Int -> Int - -> Int -> IO () -mergeMapWithD op outer inner n = - StreamK.drain $ StreamK.mergeMapWith op1 - (unfoldrM inner) - (unfoldrM outer n) +mergeMapWithD op outer inner = + withDrain $ \n -> + StreamK.mergeMapWith op1 + (sourceUnfoldrM inner) + (sourceUnfoldrM outer n) where @@ -417,13 +467,12 @@ mergeWith :: -> StreamK IO Int ) -> (Int -> Int -> Ordering) - -> Int -> Int -> IO () -mergeWith g cmp count n = - StreamK.drain - $ g - cmp - (unfoldrM count n) - (unfoldrM count (n + 1)) + -> Int -> IO () +mergeWith g cmp count = + withDrain $ \n -> + g cmp + (sourceUnfoldrM count n) + (sourceUnfoldrM count (n + 1)) {-# INLINE mergeWithM #-} mergeWithM :: @@ -433,20 +482,19 @@ mergeWithM :: -> StreamK IO Int ) -> (Int -> Int -> Ordering) - -> Int -> Int -> IO () -mergeWithM g cmp count n = - StreamK.drain - $ g - (\a b -> return $ cmp a b) - (unfoldrM count n) - (unfoldrM count (n + 1)) + -> Int -> IO () +mergeWithM g cmp count = + withDrain $ \n -> + g (\a b -> return $ cmp a b) + (sourceUnfoldrM count n) + (sourceUnfoldrM count (n + 1)) {-# INLINE mergeBy #-} -mergeBy :: (Int -> Int -> Ordering) -> Int -> Int -> IO () +mergeBy :: (Int -> Int -> Ordering) -> Int -> IO () mergeBy = mergeWith StreamK.mergeBy {-# INLINE mergeByM #-} -mergeByM :: (Int -> Int -> Ordering) -> Int -> Int -> IO () +mergeByM :: (Int -> Int -> Ordering) -> Int -> IO () mergeByM = mergeWithM StreamK.mergeByM #ifdef INSPECTION @@ -462,44 +510,44 @@ inspect $ 'mergeByM `hasNoType` ''SPEC ------------------------------------------------------------------------------- {-# INLINE scanMap #-} -scanMap :: Monad m => Int -> StreamK m Int -> m () -scanMap n = composeN n $ StreamK.map (subtract 1) . StreamK.scanl' (+) 0 +scanMap :: Int -> Int -> IO () +scanMap n streamLen = withStream streamLen (composeN n (StreamK.map (subtract 1) . StreamK.scanl' (+) 0)) {-# INLINE dropMap #-} -dropMap :: Monad m => Int -> StreamK m Int -> m () -dropMap n = composeN n $ StreamK.map (subtract 1) . StreamK.drop 1 +dropMap :: Int -> Int -> IO () +dropMap n streamLen = withStream streamLen (composeN n (StreamK.map (subtract 1) . StreamK.drop 1)) {-# INLINE dropScan #-} -dropScan :: Monad m => Int -> StreamK m Int -> m () -dropScan n = composeN n $ StreamK.scanl' (+) 0 . StreamK.drop 1 +dropScan :: Int -> Int -> IO () +dropScan n streamLen = withStream streamLen (composeN n (StreamK.scanl' (+) 0 . StreamK.drop 1)) {-# INLINE takeDrop #-} -takeDrop :: Monad m => Int -> Int -> StreamK m Int -> m () -takeDrop streamLen n = composeN n $ StreamK.drop 1 . StreamK.take streamLen +takeDrop :: Int -> Int -> IO () +takeDrop n streamLen = withStream streamLen (composeN n (StreamK.drop 1 . StreamK.take streamLen)) {-# INLINE takeScan #-} -takeScan :: Monad m => Int -> Int -> StreamK m Int -> m () -takeScan streamLen n = composeN n $ StreamK.scanl' (+) 0 . StreamK.take streamLen +takeScan :: Int -> Int -> IO () +takeScan n streamLen = withStream streamLen (composeN n (StreamK.scanl' (+) 0 . StreamK.take streamLen)) {-# INLINE takeMap #-} -takeMap :: Monad m => Int -> Int -> StreamK m Int -> m () -takeMap streamLen n = composeN n $ StreamK.map (subtract 1) . StreamK.take streamLen +takeMap :: Int -> Int -> IO () +takeMap n streamLen = withStream streamLen (composeN n (StreamK.map (subtract 1) . StreamK.take streamLen)) {-# INLINE filterDrop #-} -filterDrop :: Monad m => Int -> Int -> StreamK m Int -> m () -filterDrop streamLen n = composeN n $ StreamK.drop 1 . StreamK.filter (<= streamLen) +filterDrop :: Int -> Int -> IO () +filterDrop n streamLen = withStream streamLen (composeN n (StreamK.drop 1 . StreamK.filter (<= streamLen))) {-# INLINE filterTake #-} -filterTake :: Monad m => Int -> Int -> StreamK m Int -> m () -filterTake streamLen n = composeN n $ StreamK.take streamLen . StreamK.filter (<= streamLen) +filterTake :: Int -> Int -> IO () +filterTake n streamLen = withStream streamLen (composeN n (StreamK.take streamLen . StreamK.filter (<= streamLen))) {-# INLINE filterScan #-} -filterScan :: Monad m => Int -> StreamK m Int -> m () -filterScan n = composeN n $ StreamK.scanl' (+) 0 . StreamK.filter (<= maxBound) +filterScan :: Int -> Int -> IO () +filterScan n streamLen = withStream streamLen (composeN n (StreamK.scanl' (+) 0 . StreamK.filter (<= maxBound))) {-# INLINE filterMap #-} -filterMap :: Monad m => Int -> Int -> StreamK m Int -> m () -filterMap streamLen n = composeN n $ StreamK.map (subtract 1) . StreamK.filter (<= streamLen) +filterMap :: Int -> Int -> IO () +filterMap n streamLen = withStream streamLen (composeN n (StreamK.map (subtract 1) . StreamK.filter (<= streamLen))) ------------------------------------------------------------------------------- -- ConcatMap @@ -508,11 +556,12 @@ filterMap streamLen n = composeN n $ StreamK.map (subtract 1) . StreamK.filter ( -- concatMap unfoldrM/unfoldrM {-# INLINE concatMap #-} -concatMap :: Int -> Int -> Int -> IO () -concatMap outer inner n = - StreamK.drain $ StreamK.concatMap - (\_ -> unfoldrM inner n) - (unfoldrM outer n) +concatMap :: Int -> Int -> IO () +concatMap outer inner = + withDrain $ \n -> + StreamK.concatMap + (\_ -> sourceUnfoldrM inner n) + (sourceUnfoldrM outer n) #ifdef INSPECTION inspect $ hasNoTypeClasses 'concatMap @@ -520,23 +569,25 @@ inspect $ hasNoTypeClasses 'concatMap -- concatMap unfoldr/unfoldr -{-# INLINE concatMapPure #-} -concatMapPure :: Int -> Int -> Int -> IO () -concatMapPure outer inner n = - StreamK.drain $ StreamK.concatMap - (\_ -> unfoldr inner n) - (unfoldr outer n) +{-# INLINE concatMapUnfoldr #-} +concatMapUnfoldr :: Int -> Int -> IO () +concatMapUnfoldr outer inner = + withDrain $ \n -> + StreamK.concatMap + (\_ -> sourceUnfoldr inner n) + (sourceUnfoldr outer n) #ifdef INSPECTION -inspect $ hasNoTypeClasses 'concatMapPure +inspect $ hasNoTypeClasses 'concatMapUnfoldr #endif -- concatMap replicate/unfoldrM {-# INLINE concatMapRepl #-} -concatMapRepl :: Int -> Int -> Int -> IO () -concatMapRepl outer inner n = - StreamK.drain $ StreamK.concatMap (StreamK.replicate inner) (unfoldrM outer n) +concatMapRepl :: Int -> Int -> IO () +concatMapRepl outer inner = + withDrain $ \n -> + StreamK.concatMap (StreamK.replicate inner) (sourceUnfoldrM outer n) #ifdef INSPECTION inspect $ hasNoTypeClasses 'concatMapRepl @@ -550,6 +601,11 @@ sourceConcatMapId :: Monad m sourceConcatMapId val n = StreamK.fromFoldable $ fmap (StreamK.fromEffect . return) [n..n+val] +{-# INLINE concatMapWithId #-} +concatMapWithId :: Int -> IO () +concatMapWithId streamLen = + withDrain $ StreamK.concatMapWith StreamK.append id . sourceConcatMapId streamLen + ------------------------------------------------------------------------------- -- Nested Composition ------------------------------------------------------------------------------- @@ -581,74 +637,96 @@ instance Monad m => Monad (StreamK.StreamK m) where (>>=) = flip StreamK.concatMap {-# INLINE drainApplicative #-} -drainApplicative :: Monad m => StreamK m Int -> m () -drainApplicative s = drain $ do - (+) <$> s <*> s +drainApplicative :: Int -> IO () +drainApplicative streamLen = withDrain $ \n -> + let s = sourceUnfoldrM streamLen n + in (+) <$> s <*> s + +{-# INLINE drainApplicativeUnfoldr #-} +drainApplicativeUnfoldr :: Int -> IO () +drainApplicativeUnfoldr streamLen = withDrain $ \n -> + let s = sourceUnfoldr streamLen n + in (+) <$> s <*> s {-# INLINE drainMonad #-} -drainMonad :: Monad m => StreamK m Int -> m () -drainMonad s = drain $ do - x <- s - y <- s - return $ x + y +drainMonad :: Int -> IO () +drainMonad streamLen = withDrain $ \n -> + let s = sourceUnfoldrM streamLen n + in do { x <- s; y <- s; return $ x + y } + +{-# INLINE drainMonadUnfoldr #-} +drainMonadUnfoldr :: Int -> IO () +drainMonadUnfoldr streamLen = withDrain $ \n -> + let s = sourceUnfoldr streamLen n + in do { x <- s; y <- s; return $ x + y } {-# INLINE drainConcatFor1 #-} -drainConcatFor1 :: Monad m => StreamK m Int -> m () -drainConcatFor1 s = drain $ do - StreamK.concatFor s $ \x -> - StreamK.fromPure $ x + 1 +drainConcatFor1 :: Int -> IO () +drainConcatFor1 streamLen = withDrain $ \n -> + let s = sourceUnfoldrM streamLen n + in StreamK.concatFor s $ \x -> StreamK.fromPure $ x + 1 {-# INLINE drainConcatFor #-} -drainConcatFor :: Monad m => StreamK m Int -> m () -drainConcatFor s = drain $ do - StreamK.concatFor s $ \x -> +drainConcatFor :: Int -> IO () +drainConcatFor streamLen = withDrain $ \n -> + let s = sourceUnfoldrM streamLen n + in StreamK.concatFor s $ \x -> StreamK.concatFor s $ \y -> StreamK.fromPure $ x + y {-# INLINE drainConcatForM #-} -drainConcatForM :: Monad m => StreamK m Int -> m () -drainConcatForM s = drain $ do - StreamK.concatForM s $ \x -> +drainConcatForM :: Int -> IO () +drainConcatForM streamLen = withDrain $ \n -> + let s = sourceUnfoldrM streamLen n + in StreamK.concatForM s $ \x -> pure $ StreamK.concatForM s $ \y -> pure $ StreamK.fromPure $ x + y {-# INLINE drainMonad3 #-} -drainMonad3 :: Monad m => StreamK m Int -> m () -drainMonad3 s = drain $ do - x <- s - y <- s - z <- s - return $ x + y + z +drainMonad3 :: Int -> IO () +drainMonad3 streamLen = withDrain $ \n -> + let s = sourceUnfoldrM streamLen n + in do { x <- s; y <- s; z <- s; return $ x + y + z } + +{-# INLINE drainMonad3Unfoldr #-} +drainMonad3Unfoldr :: Int -> IO () +drainMonad3Unfoldr streamLen = withDrain $ \n -> + let s = sourceUnfoldr streamLen n + in do { x <- s; y <- s; z <- s; return $ x + y + z } {-# INLINE drainConcatFor3 #-} -drainConcatFor3 :: Monad m => StreamK m Int -> m () -drainConcatFor3 s = drain $ do - StreamK.concatFor s $ \x -> +drainConcatFor3 :: Int -> IO () +drainConcatFor3 streamLen = withDrain $ \n -> + let s = sourceUnfoldrM streamLen n + in StreamK.concatFor s $ \x -> StreamK.concatFor s $ \y -> StreamK.concatFor s $ \z -> StreamK.fromPure $ x + y + z {-# INLINE drainConcatFor3M #-} -drainConcatFor3M :: Monad m => StreamK m Int -> m () -drainConcatFor3M s = drain $ do - StreamK.concatForM s $ \x -> +drainConcatFor3M :: Int -> IO () +drainConcatFor3M streamLen = withDrain $ \n -> + let s = sourceUnfoldrM streamLen n + in StreamK.concatForM s $ \x -> pure $ StreamK.concatForM s $ \y -> pure $ StreamK.concatForM s $ \z -> pure $ StreamK.fromPure $ x + y + z {-# INLINE drainConcatFor4 #-} -drainConcatFor4 :: Monad m => StreamK m Int -> m () -drainConcatFor4 s = drain $ do - StreamK.concatFor s $ \x -> +drainConcatFor4 :: Int -> IO () +drainConcatFor4 streamLen = withDrain $ \n -> + let s = sourceUnfoldrM streamLen n + in StreamK.concatFor s $ \x -> StreamK.concatFor s $ \y -> StreamK.concatFor s $ \z -> StreamK.concatFor s $ \w -> StreamK.fromPure $ x + y + z + w {-# INLINE drainConcatFor5 #-} -drainConcatFor5 :: Monad m => StreamK m Int -> m () -drainConcatFor5 s = drain $ do - StreamK.concatFor s $ \x -> +drainConcatFor5 :: Int -> IO () +drainConcatFor5 streamLen = withDrain $ \n -> + let s = sourceUnfoldrM streamLen n + in StreamK.concatFor s $ \x -> StreamK.concatFor s $ \y -> StreamK.concatFor s $ \z -> StreamK.concatFor s $ \w -> @@ -656,52 +734,62 @@ drainConcatFor5 s = drain $ do StreamK.fromPure $ x + y + z + w + u {-# INLINE filterAllOutMonad #-} -filterAllOutMonad - :: Monad m - => StreamK m Int -> m () -filterAllOutMonad str = drain $ do - x <- str - y <- str - let s = x + y - if s < 0 - then return s - else StreamK.nil +filterAllOutMonad :: Int -> IO () +filterAllOutMonad streamLen = withDrain $ \n -> + let str = sourceUnfoldrM streamLen n + in do + x <- str + y <- str + let s = x + y + if s < 0 then return s else StreamK.nil + +{-# INLINE filterAllOutMonadUnfoldr #-} +filterAllOutMonadUnfoldr :: Int -> IO () +filterAllOutMonadUnfoldr streamLen = withDrain $ \n -> + let str = sourceUnfoldr streamLen n + in do + x <- str + y <- str + let s = x + y + if s < 0 then return s else StreamK.nil {-# INLINE filterAllOutConcatFor #-} -filterAllOutConcatFor - :: Monad m - => StreamK m Int -> m () -filterAllOutConcatFor s = drain $ do - StreamK.concatFor s $ \x -> +filterAllOutConcatFor :: Int -> IO () +filterAllOutConcatFor streamLen = withDrain $ \n -> + let s = sourceUnfoldrM streamLen n + in StreamK.concatFor s $ \x -> StreamK.concatFor s $ \y -> let s1 = x + y - in if s1 < 0 - then StreamK.fromPure s1 - else StreamK.nil + in if s1 < 0 then StreamK.fromPure s1 else StreamK.nil {-# INLINE filterAllInMonad #-} -filterAllInMonad - :: Monad m - => StreamK m Int -> m () -filterAllInMonad str = drain $ do - x <- str - y <- str - let s = x + y - if s > 0 - then return s - else StreamK.nil +filterAllInMonad :: Int -> IO () +filterAllInMonad streamLen = withDrain $ \n -> + let str = sourceUnfoldrM streamLen n + in do + x <- str + y <- str + let s = x + y + if s > 0 then return s else StreamK.nil + +{-# INLINE filterAllInMonadUnfoldr #-} +filterAllInMonadUnfoldr :: Int -> IO () +filterAllInMonadUnfoldr streamLen = withDrain $ \n -> + let str = sourceUnfoldr streamLen n + in do + x <- str + y <- str + let s = x + y + if s > 0 then return s else StreamK.nil {-# INLINE filterAllInConcatFor #-} -filterAllInConcatFor - :: Monad m - => StreamK m Int -> m () -filterAllInConcatFor s = drain $ do - StreamK.concatFor s $ \x -> +filterAllInConcatFor :: Int -> IO () +filterAllInConcatFor streamLen = withDrain $ \n -> + let s = sourceUnfoldrM streamLen n + in StreamK.concatFor s $ \x -> StreamK.concatFor s $ \y -> let s1 = x + y - in if s1 > 0 - then StreamK.fromPure s1 - else StreamK.nil + in if s1 > 0 then StreamK.fromPure s1 else StreamK.nil ------------------------------------------------------------------------------- -- Nested Composition Pure lists @@ -721,44 +809,49 @@ unfoldrList maxval n = List.unfoldr step n then Nothing else Just (cnt, cnt + 1) -{-# INLINE toNullApNestedList #-} -toNullApNestedList :: [Int] -> [Int] -toNullApNestedList s = (+) <$> s <*> s -{-# INLINE toNullNestedList #-} -toNullNestedList :: [Int] -> [Int] -toNullNestedList s = do +{-# INLINE withList #-} +withList :: Int -> ([Int] -> IO b) -> IO b +withList value f = randomRIO (1,1) >>= f . unfoldrList value + +{-# INLINE lastList #-} +lastList :: Int -> IO [Int] +lastList streamLen = withList streamLen (return . (\xs -> [List.last xs])) + +{-# INLINE listApDrain2 #-} +listApDrain2 :: Int -> IO [Int] +listApDrain2 streamLen = withList streamLen $ \s -> return $ (+) <$> s <*> s + +{-# INLINE listMonadDrain2 #-} +listMonadDrain2 :: Int -> IO [Int] +listMonadDrain2 streamLen = withList streamLen $ \s -> return $ do x <- s y <- s return $ x + y -{-# INLINE toNullNestedList3 #-} -toNullNestedList3 :: [Int] -> [Int] -toNullNestedList3 s = do +{-# INLINE listMonadDrain3 #-} +listMonadDrain3 :: Int -> IO [Int] +listMonadDrain3 streamLen = withList streamLen $ \s -> return $ do x <- s y <- s z <- s return $ x + y + z -{-# INLINE filterAllOutNestedList #-} -filterAllOutNestedList :: [Int] -> [Int] -filterAllOutNestedList str = do - x <- str - y <- str - let s = x + y - if s < 0 - then return s - else [] - -{-# INLINE filterAllInNestedList #-} -filterAllInNestedList :: [Int] -> [Int] -filterAllInNestedList str = do - x <- str - y <- str - let s = x + y - if s > 0 - then return s - else [] +{-# INLINE listMonadFilterAllIn2 #-} +listMonadFilterAllIn2 :: Int -> IO [Int] +listMonadFilterAllIn2 streamLen = withList streamLen $ \s -> return $ do + x <- s + y <- s + let t = x + y + if t > 0 then return t else [] + +{-# INLINE listMonadFilterAllOut2 #-} +listMonadFilterAllOut2 :: Int -> IO [Int] +listMonadFilterAllOut2 streamLen = withList streamLen $ \s -> return $ do + x <- s + y <- s + let t = x + y + if t < 0 then return t else [] ------------------------------------------------------------------------------- -- Benchmarks @@ -767,43 +860,47 @@ filterAllInNestedList str = do moduleName :: String moduleName = "Data.StreamK" +{-# INLINE benchIO #-} +benchIO :: NFData b => String -> IO b -> Benchmark +benchIO name = bench name . nfIO + o_1_space_generation :: Int -> Benchmark o_1_space_generation streamLen = bgroup "generation" - [ benchFold "unfoldr" drain (unfoldr streamLen) - , benchFold "unfoldrM" drain (unfoldrM streamLen) - , benchFold "repeat" drain (repeat streamLen) - , benchFold "repeatM" drain (repeatM streamLen) - , benchFold "replicate" drain (replicate streamLen) - , benchFold "replicateM" drain (replicateM streamLen) - , benchFold "iterate" drain (iterate streamLen) - , benchFold "iterateM" drain (iterateM streamLen) - - , benchFold "fromFoldable" drain (fromFoldable streamLen) - , benchFold "fromFoldableM" drain (fromFoldableM 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 - , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen) - , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen) + , benchIO "concatMapFoldableWith" $ concatMapFoldableWith streamLen + , benchIO "concatMapFoldableWithM" $ concatMapFoldableWithM streamLen ] o_1_space_elimination :: Int -> Benchmark o_1_space_elimination streamLen = bgroup "elimination" - [ benchFold "toNull" drain (unfoldrM streamLen) - , benchFold "mapM_" mapM_ (unfoldrM streamLen) - , benchFold "uncons" uncons (unfoldrM streamLen) - , benchFold "init" init (unfoldrM streamLen) - , benchFold "foldl'" foldl' (unfoldrM streamLen) - , benchFold "foldlM'" foldlM' (unfoldrM streamLen) - , benchFold "last" last (unfoldrM 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 = bgroup "Applicative" - [ benchFold "drain2" drainApplicative (unfoldrM streamLen2) - , benchFold "pureDrain2" drainApplicative (unfoldr streamLen2) + [ benchIO "drain2" $ drainApplicative streamLen2 + , benchIO "pureDrain2" $ drainApplicativeUnfoldr streamLen2 ] where streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop @@ -811,14 +908,14 @@ o_1_space_ap streamLen = o_1_space_monad :: Int -> Benchmark o_1_space_monad streamLen = bgroup "Monad" - [ benchFold "drain2" drainMonad (unfoldrM streamLen2) - , benchFold "drain3" drainMonad3 (unfoldrM streamLen3) - , benchFold "filterAllIn2" filterAllInMonad (unfoldrM streamLen2) - , benchFold "filterAllOut2" filterAllOutMonad (unfoldrM streamLen2) - , benchFold "pureDrain2" drainMonad (unfoldr streamLen2) - , benchFold "pureDrain3" drainMonad3 (unfoldr streamLen3) - , benchFold "pureFilterAllIn2" filterAllInMonad (unfoldr streamLen2) - , benchFold "pureFilterAllOut2" filterAllOutMonad (unfoldr streamLen2) + [ 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 ] where streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop @@ -827,15 +924,15 @@ o_1_space_monad streamLen = o_1_space_bind :: Int -> Benchmark o_1_space_bind streamLen = bgroup "concatFor" - [ benchFold "drain1" drainConcatFor1 (unfoldrM streamLen) - , benchFold "drain2" drainConcatFor (unfoldrM streamLen2) - , benchFold "drainM2" drainConcatForM (unfoldrM streamLen2) - , benchFold "drain3" drainConcatFor3 (unfoldrM streamLen3) - , benchFold "drain4" drainConcatFor4 (unfoldrM streamLen4) - , benchFold "drain5" drainConcatFor5 (unfoldrM streamLen5) - , benchFold "drainM3" drainConcatFor3M (unfoldrM streamLen3) - , benchFold "filterAllIn2" filterAllInConcatFor (unfoldrM streamLen2) - , benchFold "filterAllOut2" filterAllOutConcatFor (unfoldrM streamLen2) + [ 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 ] where streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop @@ -846,126 +943,110 @@ o_1_space_bind streamLen = o_1_space_transformation :: Int -> Benchmark o_1_space_transformation streamLen = bgroup "transformation" - [ benchFold "foldrS" (foldrS 1) (unfoldrM streamLen) - , benchFold "scanl'" (scanl' 1) (unfoldrM streamLen) - , benchFold "map" (map 1) (unfoldrM streamLen) - , benchFold "fmap" (fmapK 1) (unfoldrM streamLen) - , benchFold "mapM" (mapM 1) (unfoldrM streamLen) - , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM 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 = bgroup "transformationX4" - [ benchFold "scanl'" (scanl' 4) (unfoldrM streamLen) - , benchFold "map" (map 4) (unfoldrM streamLen) - , benchFold "fmap" (fmapK 4) (unfoldrM streamLen) - , benchFold "mapM" (mapM 4) (unfoldrM streamLen) - , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen) + [ 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 - -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16) + -- , benchIO "concatMap" $ concatMap 4 streamLen16 ] o_1_space_joining :: Int -> Benchmark o_1_space_joining streamLen = bgroup "joining (2 of n/2)" - [ benchIOSrc1 "interleave" (interleave2 streamLen) - - , benchIOSrc1 - "mergeBy compare" - (mergeBy compare (streamLen `div` 2)) - , benchIOSrc1 - "mergeByM compare" - (mergeByM compare (streamLen `div` 2)) - , benchIOSrc1 - "mergeBy (flip compare)" - (mergeBy (flip compare) (streamLen `div` 2)) - , benchIOSrc1 - "mergeByM (flip compare)" - (mergeByM (flip compare) (streamLen `div` 2)) - - , benchFold "zipWith" zipWith (unfoldrM streamLen) - , benchFold "zipWithM" zipWithM (unfoldrM 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 - , benchIOSrc1 - "concatMapWith interleave" - (concatMapWith StreamK.interleave 2 (streamLen `div` 2)) - , benchIOSrc1 - "concatMapWith D.interleave" - (concatMapWithD Stream.interleave 2 (streamLen `div` 2)) - , benchIOSrc1 - "concatMapWith D.roundRobin" - (concatMapWithD Stream.roundRobin 2 (streamLen `div` 2)) + , 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 - , benchIOSrc1 - "mergeMapWith interleave" - (mergeMapWith StreamK.interleave 2 (streamLen `div` 2)) - , benchIOSrc1 - "mergeMapWith D.interleave" - (mergeMapWithD Stream.interleave 2 (streamLen `div` 2)) - , benchIOSrc1 - "mergeMapWith D.roundRobin" - (mergeMapWithD Stream.roundRobin 2 (streamLen `div` 2)) - - , benchIOSrc1 - "mergeMapWith (mergeBy compare)" - (mergeMapWith (StreamK.mergeBy compare) 2 (streamLen `div` 2)) - , benchIOSrc1 - "mergeMapWith (mergeBy (flip compare))" - (mergeMapWith (StreamK.mergeBy (flip compare)) 2 (streamLen `div` 2)) - , benchIOSrc1 - "mergeMapWithD (D.mergeBy compare)" - (mergeMapWithD (Stream.mergeBy compare) 2 (streamLen `div` 2)) - , benchIOSrc1 - "mergeMapWithD (D.mergeBy (flip compare))" - (mergeMapWithD (Stream.mergeBy (flip compare)) 2 (streamLen `div` 2)) - - , benchIOSrc1 "mergeMapWith (zipWith (+))" - (mergeMapWith (StreamK.zipWith (+)) 2 (streamLen `div` 2)) + , 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 = bgroup "concat" - [ benchIOSrc1 "concatMapPure outer=Max inner=1" - (concatMapPure streamLen 1) - , benchIOSrc1 "concatMapPure outer=inner=(sqrt Max)" - (concatMapPure streamLen2 streamLen2) - , benchIOSrc1 "concatMapPure outer=1 inner=Max" - (concatMapPure 1 streamLen) - - , benchIOSrc1 "concatMap outer=Max inner=1" - (concatMap streamLen 1) - , benchIOSrc1 "concatMap outer=inner=(sqrt Max)" - (concatMap streamLen2 streamLen2) - , benchIOSrc1 "concatMap outer=1 inner=Max" - (concatMap 1 streamLen) - - , benchIOSrc1 "concatMapRepl outer=inner=(sqrt Max)" - (concatMapRepl streamLen2 streamLen2) + [ 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 - , benchIOSrc1 "concatMapWithId outer=Max inner=1 (fromFoldable)" - (StreamK.drain - . StreamK.concatMapWith StreamK.append id - . sourceConcatMapId streamLen) - - , benchIOSrc1 "concatMapWith append outer=Max inner=1" - (concatMapWith StreamK.append streamLen 1) - , benchIOSrc1 "concatMapWith append outer=inner=(sqrt Max)" - (concatMapWith StreamK.append streamLen2 streamLen2) - , benchIOSrc1 "concatMapWith append outer=1 inner=Max" - (concatMapWith StreamK.append 1 streamLen) + , 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) - , benchIOSrc1 "concatMapWith interleave outer=Max inner=1" - (concatMapWith StreamK.interleave streamLen 1) - , benchIOSrc1 "concatMapWith interleave outer=inner=(sqrt Max)" - (concatMapWith StreamK.interleave streamLen2 streamLen2) - , benchIOSrc1 "concatMapWith interleave outer=1 inner=Max" - (concatMapWith StreamK.interleave 1 streamLen) + , 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 @@ -978,10 +1059,10 @@ o_n_space_concat streamLen = [ -- concatMapWith using StreamD versions of interleave operations are -- all quadratic, we just measure the sqrtVal benchmark for comparison. - benchIOSrc1 "concatMapWithD D.interleave outer=inner=(sqrt Max)" - (concatMapWithD Stream.interleave streamLen2 streamLen2) - , benchIOSrc1 "concatMapWithD D.roundRobin outer=inner=(sqrt Max)" - (concatMapWithD Stream.roundRobin streamLen2 streamLen2) + 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 @@ -992,43 +1073,43 @@ o_n_heap_concat :: Int -> Benchmark o_n_heap_concat streamLen = bgroup "concat" [ - benchIOSrc1 "mergeMapWith interleave outer=Max inner=1" - (mergeMapWith StreamK.interleave streamLen 1) - , benchIOSrc1 "mergeMapWith interleave outer=inner=(sqrt Max)" - (mergeMapWith StreamK.interleave streamLen2 streamLen2) - , benchIOSrc1 "mergeMapWith interleave outer=1 inner=Max" - (mergeMapWith StreamK.interleave 1 streamLen) - - , benchIOSrc1 "mergeMapWithD D.interleave outer=inner=(sqrt Max)" - (mergeMapWithD Stream.interleave streamLen2 streamLen2) - , benchIOSrc1 "mergeMapWithD D.roundRobin outer=inner=(sqrt Max)" - (mergeMapWithD Stream.roundRobin streamLen2 streamLen2) - - , benchIOSrc1 "mergeMapWith (mergeBy compare) outer=Max inner=1" - (mergeMapWith (StreamK.mergeBy compare) streamLen 1) - , benchIOSrc1 "mergeMapWith (mergeBy compare) outer=inner=(sqrt Max)" - (mergeMapWith (StreamK.mergeBy compare) streamLen2 streamLen2) - , benchIOSrc1 "mergeMapWith (mergeBy compare) outer=1 inner=Max" - (mergeMapWith (StreamK.mergeBy compare) 1 streamLen) - - , benchIOSrc1 "mergeMapWith (mergeBy (flip compare)) outer=Max inner=1" - (mergeMapWith (StreamK.mergeBy (flip compare)) streamLen 1) - , benchIOSrc1 "mergeMapWith (mergeBy (flip compare)) outer=inner=(sqrt Max)" - (mergeMapWith (StreamK.mergeBy (flip compare)) streamLen2 streamLen2) - , benchIOSrc1 "mergeMapWith (mergeBy (flip compare)) outer=1 inner=Max" - (mergeMapWith (StreamK.mergeBy (flip compare)) 1 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 {- -- This fails with stack overflow. - benchIOSrc1 "concatMapWithZip (n of 1)" + benchIO "concatMapWithZip (n of 1)" (concatMapWithZip value 1) -- Not correct because of nil stream at end issue. - , benchIOSrc1 "concatMapWithZip (sqrtVal of sqrtVal)" + , benchIO "concatMapWithZip (sqrtVal of sqrtVal)" (concatMapWithZip sqrtVal sqrtVal) -} - , benchIOSrc1 "mergeMapWith (zipWith (+)) outer=Max inner=1" - (mergeMapWith (StreamK.zipWith (+)) streamLen 1) - , benchIOSrc1 "mergeMapWith (zipWith (+)) outer=inner=(sqrt Max)" - (mergeMapWith (StreamK.zipWith (+)) streamLen2 streamLen2) + , 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 @@ -1039,15 +1120,9 @@ o_n_heap_concat streamLen = o_n_heap_sorting :: Int -> Benchmark o_n_heap_sorting streamLen = bgroup "sorting" - [ benchFold "sortBy compare" - (sortBy compare) - (unfoldrM streamLen) - , benchFold "sortBy (flip compare)" - (sortBy (flip compare)) - (unfoldrM streamLen) - , benchFold "sortBy compare randomized" - (sortBy compare . fmap (\x -> if even x then x + 2 else x)) - (unfoldrM 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)" @@ -1062,95 +1137,90 @@ o_n_heap_sorting streamLen = o_1_space_filtering :: Int -> Benchmark o_1_space_filtering streamLen = bgroup "filtering" - [ benchFold "filter-even" (filterEven 1) (unfoldrM streamLen) - , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen) - , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen) - , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen) - , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen) - , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen) - , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen) - , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen) - , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM 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 = bgroup "filteringX4" - [ benchFold "filter-even" (filterEven 4) (unfoldrM streamLen) - , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen) - , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen) - , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen) - , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen) - , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen) - , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen) - , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen) - , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen) + [ 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 ] o_1_space_mixed :: Int -> Benchmark o_1_space_mixed streamLen = bgroup "mixed" - [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen) - , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen) - , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen) - , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen) - , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen) - , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen) - , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen) - , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen) - , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen) - , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM 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 = bgroup "mixedX2" - [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen) - , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen) - , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen) - , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen) - , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen) - , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen) - , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen) - , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen) - , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen) - , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen) + [ 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 ] o_1_space_mixedX4 :: Int -> Benchmark o_1_space_mixedX4 streamLen = bgroup "mixedX4" - [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen) - , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen) - , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen) - , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen) - , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen) - , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen) - , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen) - , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen) - , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen) - , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen) + [ 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 ] -{- HLINT ignore "Use <&>" -} -{-# INLINE benchList #-} -benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark -benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f - o_1_space_list :: Int -> Benchmark o_1_space_list streamLen = bgroup "list" [ bgroup "elimination" - [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen) + [ benchIO "last" $ lastList streamLen ] , bgroup "Applicative" - [ benchList "drain2" toNullApNestedList (unfoldrList streamLen2) + [ benchIO "drain2" $ listApDrain2 streamLen2 ] , bgroup "Monad" - [ benchList "drain2" toNullNestedList (unfoldrList streamLen2) - , benchList "drain3" toNullNestedList3 (unfoldrList streamLen3) - , benchList "filterAllIn2" filterAllInNestedList (unfoldrList streamLen2) - , benchList "filterAllOut2" filterAllOutNestedList (unfoldrList streamLen2) + [ benchIO "drain2" $ listMonadDrain2 streamLen2 + , benchIO "drain3" $ listMonadDrain3 streamLen3 + , benchIO "filterAllIn2" $ listMonadFilterAllIn2 streamLen2 + , benchIO "filterAllOut2" $ listMonadFilterAllOut2 streamLen2 ] ] where @@ -1161,7 +1231,7 @@ o_1_space_list streamLen = o_n_heap_transformation :: Int -> Benchmark o_n_heap_transformation streamLen = bgroup "transformation" - [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen) + [ benchIO "foldlS" $ foldlS 1 streamLen ] o_n_stack_transformation :: Int -> Benchmark @@ -1169,8 +1239,8 @@ o_n_stack_transformation streamLen = bgroup "transformation" [ -- XXX why do these need so much stack - benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2) - , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2) + benchIO "intersperse" $ intersperse streamLen 1 streamLen2 + , benchIO "interspersePure" $ interspersePure streamLen 1 streamLen2 ] where streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) @@ -1179,25 +1249,21 @@ o_n_stack_transformationX4 :: Int -> Benchmark o_n_stack_transformationX4 streamLen = bgroup "transformationX4" [ - benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16) + benchIO "intersperse" $ intersperse streamLen 4 streamLen16 ] where streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -{-# INLINE benchK #-} -benchK :: P.String -> (Int -> StreamK P.IO Int) -> Benchmark -benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f - o_n_stack_iterated :: Int -> Int -> Int -> Benchmark o_n_stack_iterated streamLen iterStreamLen maxIters = bgroup "iterated" - [ benchK "mapM" (iterateMapM iterStreamLen maxIters) - , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters) - , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters) - , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters) - , benchK "dropOne" (iterateDropOne iterStreamLen maxIters) - , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters) - , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters) + [ 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 ] benchmarks :: Int -> Int -> Int -> [(SpaceComplexity, Benchmark)] @@ -1224,16 +1290,16 @@ benchmarks streamLen iterStreamLen maxIters = , (HeapO_n, o_n_heap_sorting streamLen) -- O(n) stack , (StackO_n, bgroup "elimination" - [ benchFold "tail" tail (unfoldrM streamLen) - , benchFold "nullTail" nullTail (unfoldrM streamLen) - , benchFold "headTail" headTail (unfoldrM streamLen) + [ 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) -- O(n) space , (SpaceO_n, bgroup "elimination" - [ benchFold "toList" toList (unfoldrM streamLen) + [ benchIO "toList" $ toList streamLen ]) , (SpaceO_n, o_n_space_concat streamLen) ] From 7427390da37b6d1e9ddd4c39d4b84f26493918ff Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Fri, 12 Jun 2026 00:28:06 +0530 Subject: [PATCH 6/8] Use per benchmark IO action in Data.Array benchmarks --- benchmark/Streamly/Benchmark/Data/Array.hs | 114 +++++------ .../Streamly/Benchmark/Data/Array/Common.hs | 183 ++++++++++-------- .../Benchmark/Data/Array/CommonImports.hs | 1 - .../Streamly/Benchmark/Data/Array/Generic.hs | 76 ++++---- .../Benchmark/Data/Array/SmallArray.hs | 43 ++-- 5 files changed, 204 insertions(+), 213 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Array.hs b/benchmark/Streamly/Benchmark/Data/Array.hs index 70b40ee68e..0dd8c7139d 100644 --- a/benchmark/Streamly/Benchmark/Data/Array.hs +++ b/benchmark/Streamly/Benchmark/Data/Array.hs @@ -4,7 +4,7 @@ #include "Streamly/Benchmark/Data/Array/CommonImports.hs" -import Control.DeepSeq (deepseq) + #if __GLASGOW_HASKELL__ >= 810 import Data.Kind (Type) #endif @@ -16,9 +16,9 @@ import qualified GHC.Exts as GHC import qualified Streamly.Internal.Data.Array as A #if __GLASGOW_HASKELL__ >= 810 -type Stream :: Type -> Type +type Arr :: Type -> Type #endif -type Stream = A.Array +type Arr = A.Array #include "Streamly/Benchmark/Data/Array/Common.hs" @@ -26,59 +26,58 @@ instance NFData (A.Array a) where {-# INLINE rnf #-} rnf _ = () -------------------------------------------------------------------------------- --- Benchmark helpers -------------------------------------------------------------------------------- - --- Drain a source that generates a pure array -{-# INLINE benchPureSrc #-} -benchPureSrc :: String -> (Int -> Stream a) -> Benchmark -benchPureSrc name src = benchPure name src id - --- Drain a source that generates an array in the IO monad -{-# INLINE benchIOSrc #-} -benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark -benchIOSrc name src = benchIO name src id - ------------------------------------------------------------------------------- -- Bench Ops ------------------------------------------------------------------------------- {-# INLINE sourceIntFromToFromList #-} -sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int) -sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value] +sourceIntFromToFromList :: Int -> IO (Arr Int) +sourceIntFromToFromList value = withRandomIntIO $ \n -> + P.return $ A.fromListN value [n..n + value] -{-# INLINE readInstance #-} -readInstance :: P.String -> Stream Int -readInstance str = +{-# INLINE parseInstance #-} +parseInstance :: P.String -> Arr Int +parseInstance str = let r = P.reads str in case r of [(x,"")] -> x - _ -> P.error "readInstance: no parse" - -#ifdef DEVBUILD -{- -{-# INLINE foldableFoldl' #-} -foldableFoldl' :: Stream Int -> Int -foldableFoldl' = F.foldl' (+) 0 - -{-# INLINE foldableSum #-} -foldableSum :: Stream Int -> Int -foldableSum = P.sum --} -#endif + _ -> P.error "parseInstance: no parse" + +{-# INLINE readInstance #-} +readInstance :: Int -> IO (Arr Int) +readInstance value = withRandomIntIO $ \n -> + let testStr = "fromList " ++ show [n..n+value] + in return $! parseInstance testStr {-# INLINE sourceIsList #-} -sourceIsList :: Int -> Int -> Stream Int -sourceIsList value n = GHC.fromList [n..n+value] +sourceIsList :: Int -> IO (Arr Int) +sourceIsList value = withRandomIntIO $ \n -> return $! GHC.fromList [n..n+value] {-# INLINE sourceIsString #-} -sourceIsString :: Int -> Int -> Stream P.Char -sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a') +sourceIsString :: Int -> IO (Arr P.Char) +sourceIsString value = withRandomIntIO $ \n -> + return $! GHC.fromString (P.replicate (n + value) 'a') {-# INLINE sourceIntFromToFromStream #-} -sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int) -sourceIntFromToFromStream value n = S.fold A.create $ S.enumerateFromTo n (n + value) +sourceIntFromToFromStream :: Int -> IO (Arr Int) +sourceIntFromToFromStream value = withRandomIntIO $ \n -> + S.fold A.create $ S.enumerateFromTo n (n + value) + +{-# INLINE toListLength #-} +toListLength :: Int -> IO Int +toListLength value = withArray value $ \arr -> return $! length (GHC.toList arr) + +{-# INLINE createOfLast1 #-} +createOfLast1 :: Int -> IO (Arr Int) +createOfLast1 value = withStream value (S.fold (IA.createOfLast 1)) + +{-# INLINE createOfLast10 #-} +createOfLast10 :: Int -> IO (Arr Int) +createOfLast10 value = withStream value (S.fold (IA.createOfLast 10)) + +{-# INLINE createOfLastMax #-} +createOfLastMax :: Int -> IO (Arr Int) +createOfLastMax value = withStream value (S.fold (IA.createOfLast (value + 1))) ------------------------------------------------------------------------------- -- Bench groups @@ -88,42 +87,27 @@ o_1_space_generation :: Int -> [Benchmark] o_1_space_generation value = [ bgroup "generation" - [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value) - , let testStr = "fromList " ++ mkListString value - in testStr `deepseq` bench "read" (nf readInstance testStr) - , benchPureSrc "writeN . IsList.fromList" (sourceIsList value) - , benchPureSrc - "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" - [ benchPureSink value "length . IsList.toList" (length . GHC.toList) - , benchFold "createOfLast.1" - (S.fold (IA.createOfLast 1)) (P.sourceUnfoldrM value) - , benchFold "createOfLast.10" - (S.fold (IA.createOfLast 10)) (P.sourceUnfoldrM value) -#ifdef DEVBUILD -{- - benchPureSink value "foldable/foldl'" foldableFoldl' - , benchPureSink value "foldable/sum" foldableSum --} -#endif + [ 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" - [ - -- Converting the stream to an array - benchFold "createOfLast.Max" (S.fold (IA.createOfLast (value + 1))) - (P.sourceUnfoldrM 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 6d265297b5..5c2cc66629 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Common.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Common.hs @@ -2,44 +2,49 @@ -- Benchmark helpers ------------------------------------------------------------------------------- -{-# INLINE benchIO #-} -benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark -benchIO name src f = bench name $ nfIO $ - (randomRIO (1,1) >>= src) <&> f +{-# INLINE withRandomIntIO #-} +withRandomIntIO :: (Int -> IO b) -> IO b +withRandomIntIO f = randomRIO (1, 1 :: Int) >>= f -{-# INLINE benchPureSink #-} -benchPureSink :: NFData b => Int -> String -> (Stream Int -> b) -> Benchmark -benchPureSink value name = benchIO name (sourceIntFromTo value) +{-# INLINE benchIO #-} +benchIO :: NFData b => String -> IO b -> Benchmark +benchIO name = bench name . nfIO -{-# INLINE benchIO' #-} -benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark -benchIO' name src f = bench name $ nfIO $ - randomRIO (1,1) >>= src >>= f +{-# INLINE withArray #-} +withArray :: Int -> (Arr Int -> IO b) -> IO b +withArray value f = sourceIntFromTo value >>= f -{-# INLINE benchIOSink #-} -benchIOSink :: NFData b => Int -> String -> (Stream Int -> IO b) -> Benchmark -benchIOSink value name = benchIO' name (sourceIntFromTo value) +{-# INLINE withStream #-} +withStream :: Int -> (S.Stream IO Int -> IO b) -> IO b +withStream value f = withRandomIntIO $ \n -> f $ P.sourceUnfoldrM value n ------------------------------------------------------------------------------- -- Bench Ops ------------------------------------------------------------------------------- -{-# INLINE sourceUnfoldr #-} -sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int) -sourceUnfoldr value n = S.fold (A.createOf value) $ S.unfoldr step n - where - step cnt = - if cnt > n + value - then Nothing - else Just (cnt, cnt + 1) - {-# INLINE sourceIntFromTo #-} -sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int) -sourceIntFromTo value n = S.fold (A.createOf value) $ S.enumerateFromTo n (n + value) +sourceIntFromTo :: Int -> IO (Arr Int) +sourceIntFromTo value = withRandomIntIO $ \n -> + S.fold (A.createOf value) $ S.enumerateFromTo n (n + value) + +{-# INLINE sourceUnfoldr #-} +sourceUnfoldr :: Int -> IO (Arr Int) +sourceUnfoldr value = withRandomIntIO $ \n -> + let step cnt = + if cnt > n + value + then Nothing + else Just (cnt, cnt + 1) + in S.fold (A.createOf value) $ S.unfoldr step n {-# INLINE sourceFromList #-} -sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int) -sourceFromList value n = S.fold (A.createOf value) $ S.fromList [n..n+value] +sourceFromList :: Int -> IO (Arr Int) +sourceFromList value = withRandomIntIO $ \n -> + S.fold (A.createOf value) $ S.fromList [n..n+value] + + +{-# INLINE showStream #-} +showStream :: Int -> IO P.String +showStream value = withArray value (return . showInstance) ------------------------------------------------------------------------------- -- Transformation @@ -47,7 +52,7 @@ sourceFromList value n = S.fold (A.createOf value) $ S.fromList [n..n+value] {-# INLINE composeN #-} composeN :: P.Monad m - => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int) + => Int -> (Arr Int -> m (Arr Int)) -> Arr Int -> m (Arr Int) composeN n f x = case n of 1 -> f x @@ -56,61 +61,80 @@ composeN n f x = 4 -> f x P.>>= f P.>>= f P.>>= f _ -> undefined +{-# INLINE onArray #-} +onArray + :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int) + -> Arr Int + -> m (Arr Int) +onArray value f arr = S.fold (A.createOf value) $ f $ S.unfold A.reader arr + {-# INLINE scanl' #-} +scanl' :: Int -> IO (Arr Int) +scanl' value = withArray value $ composeN 1 $ onArray value $ S.scanl (Scanl.scanl' (+) 0) + +{-# INLINE scanl'X4 #-} +scanl'X4 :: Int -> IO (Arr Int) +scanl'X4 value = withArray value $ composeN 4 $ onArray value $ S.scanl (Scanl.scanl' (+) 0) + {-# INLINE scanl1' #-} -{-# INLINE map #-} +scanl1' :: Int -> IO (Arr Int) +scanl1' value = withArray value $ composeN 1 $ onArray value $ Stream.scanl1' (+) -scanl' , scanl1', map - :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int) +{-# INLINE scanl1'X4 #-} +scanl1'X4 :: Int -> IO (Arr Int) +scanl1'X4 value = withArray value $ composeN 4 $ onArray value $ Stream.scanl1' (+) +{-# INLINE map #-} +map :: Int -> IO (Arr Int) +map value = withArray value $ composeN 1 $ onArray value $ fmap (+1) -{-# INLINE onArray #-} -onArray - :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int) - -> Stream Int - -> m (Stream Int) -onArray value f arr = S.fold (A.createOf value) $ f $ S.unfold A.reader arr +{-# INLINE mapX4 #-} +mapX4 :: Int -> IO (Arr Int) +mapX4 value = withArray value $ composeN 4 $ onArray value $ fmap (+1) -scanl' value n = composeN n $ onArray value $ S.scanl (Scanl.scanl' (+) 0) -scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+) -map value n = composeN n $ onArray value $ fmap (+1) --- map n = composeN n $ A.map (+1) +{-# INLINE idArr #-} +idArr :: Int -> IO (Arr Int) +idArr value = withArray value return {-# INLINE eqInstance #-} -eqInstance :: Stream Int -> Bool -eqInstance src = src == src +eqInstance :: Int -> IO Bool +eqInstance value = withArray value $ \src -> return (src == src) {-# INLINE eqInstanceNotEq #-} -eqInstanceNotEq :: Stream Int -> Bool -eqInstanceNotEq src = src P./= src +eqInstanceNotEq :: Int -> IO Bool +eqInstanceNotEq value = withArray value $ \src -> return (src P./= src) {-# INLINE ordInstance #-} -ordInstance :: Stream Int -> Bool -ordInstance src = src P.< src +ordInstance :: Int -> IO Bool +ordInstance value = withArray value $ \src -> return (src P.< src) {-# INLINE ordInstanceMin #-} -ordInstanceMin :: Stream Int -> Stream Int -ordInstanceMin src = P.min src src +ordInstanceMin :: Int -> IO (Arr Int) +ordInstanceMin value = withArray value $ \src -> return (P.min src src) {-# INLINE showInstance #-} -showInstance :: Stream Int -> P.String +showInstance :: Arr Int -> P.String showInstance = P.show {-# INLINE pureFoldl' #-} -pureFoldl' :: MonadIO m => Stream Int -> m Int -pureFoldl' = S.fold (Fold.foldl' (+) 0) . S.unfold A.reader +pureFoldl' :: Int -> IO Int +pureFoldl' value = withArray value $ S.fold (Fold.foldl' (+) 0) . S.unfold A.reader ------------------------------------------------------------------------------- -- Elimination ------------------------------------------------------------------------------- {-# INLINE unfoldReadDrain #-} -unfoldReadDrain :: MonadIO m => Stream Int -> m () -unfoldReadDrain = S.fold Fold.drain . S.unfold A.reader +unfoldReadDrain :: Int -> IO () +unfoldReadDrain value = withArray value $ S.fold Fold.drain . S.unfold A.reader {-# INLINE toStreamRevDrain #-} -toStreamRevDrain :: MonadIO m => Stream Int -> m () -toStreamRevDrain = S.fold Fold.drain . A.readRev +toStreamRevDrain :: Int -> IO () +toStreamRevDrain value = withArray value $ S.fold Fold.drain . A.readRev + +{-# INLINE writeN #-} +writeN :: Int -> IO (Arr Int) +writeN value = withStream value (S.fold (A.createOf value)) ------------------------------------------------------------------------------- -- Bench groups @@ -120,55 +144,50 @@ common_o_1_space_generation :: Int -> [Benchmark] common_o_1_space_generation value = [ bgroup "generation" - [ benchIOSrc "writeN . intFromTo" (sourceIntFromTo value) - , benchIOSrc - "fromList . intFromTo" - (sourceIntFromToFromList value) - , benchIOSrc "writeN . unfoldr" (sourceUnfoldr value) - , benchIOSrc "writeN . fromList" (sourceFromList value) - , benchPureSink value "show" showInstance + [ 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" - [ benchPureSink value "id" id - , benchPureSink value "==" eqInstance - , benchPureSink value "/=" eqInstanceNotEq - , benchPureSink value "<" ordInstance - , benchPureSink value "min" ordInstanceMin - , benchIOSink value "foldl'" pureFoldl' - , benchIOSink value "read" unfoldReadDrain - , benchIOSink value "toStreamRev" toStreamRevDrain + [ 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 ] ] common_o_n_heap_serial :: Int -> [Benchmark] common_o_n_heap_serial value = [ bgroup "elimination" - [ - -- Converting the stream to an array - benchFold "writeN" (S.fold (A.createOf value)) - (P.sourceUnfoldrM value) - ] + [ benchIO "writeN" $ writeN value + ] ] common_o_1_space_transformation :: Int -> [Benchmark] common_o_1_space_transformation value = [ bgroup "transformation" - [ benchIOSink value "scanl'" (scanl' value 1) - , benchIOSink value "scanl1'" (scanl1' value 1) - , benchIOSink value "map" (map value 1) + [ 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" - [ benchIOSink value "scanl'" (scanl' value 4) - , benchIOSink value "scanl1'" (scanl1' value 4) - , benchIOSink value "map" (map value 4) + [ benchIO "scanl'" $ scanl'X4 value + , benchIO "scanl1'" $ scanl1'X4 value + , benchIO "map" $ mapX4 value ] ] diff --git a/benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs b/benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs index 3300d95fbc..4ce1a6eef0 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs @@ -2,7 +2,6 @@ import Control.DeepSeq (NFData(..)) import Control.Monad.IO.Class (MonadIO) -import Data.Functor ((<&>)) import System.Random (randomRIO) import qualified Streamly.Data.Fold as Fold diff --git a/benchmark/Streamly/Benchmark/Data/Array/Generic.hs b/benchmark/Streamly/Benchmark/Data/Array/Generic.hs index 9a0bd7d227..58f6d5f780 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Generic.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Generic.hs @@ -4,12 +4,10 @@ #include "Streamly/Benchmark/Data/Array/CommonImports.hs" -import Control.DeepSeq (deepseq) - import qualified Streamly.Internal.Data.Array.Generic as IA import qualified Streamly.Internal.Data.Array.Generic as A -type Stream = A.Array +type Arr = A.Array #include "Streamly/Benchmark/Data/Array/Common.hs" @@ -17,48 +15,58 @@ instance NFData a => NFData (A.Array a) where {-# INLINE rnf #-} rnf = A.foldl' (\_ x -> rnf x) () -------------------------------------------------------------------------------- --- Benchmark helpers -------------------------------------------------------------------------------- - --- Drain a source that generates an array in the IO monad -{-# INLINE benchIOSrc #-} -benchIOSrc :: NFData a => String -> (Int -> IO (Stream a)) -> Benchmark -benchIOSrc name src = benchIO name src id - ------------------------------------------------------------------------------- -- Bench Ops ------------------------------------------------------------------------------- {-# INLINE sourceIntFromToFromList #-} -sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int) -sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value] +sourceIntFromToFromList :: Int -> IO (Arr Int) +sourceIntFromToFromList value = withRandomIntIO $ \n -> + P.return $ A.fromListN value [n..n + value] -{-# INLINE readInstance #-} -readInstance :: P.String -> Stream Int -readInstance str = +{-# INLINE parseInstance #-} +parseInstance :: P.String -> Arr Int +parseInstance str = let r = P.reads str in case r of [(x,"")] -> x - _ -> P.error "readInstance: no parse" + _ -> P.error "parseInstance: no parse" + +{-# INLINE readInstance #-} +readInstance :: Int -> IO (Arr Int) +readInstance value = withRandomIntIO $ \n -> + let testStr = "fromList " ++ show [n..n+value] + in return $! parseInstance testStr #ifdef DEVBUILD {- {-# INLINE foldableFoldl' #-} -foldableFoldl' :: Stream Int -> Int +foldableFoldl' :: Arr Int -> Int foldableFoldl' = F.foldl' (+) 0 {-# INLINE foldableSum #-} -foldableSum :: Stream Int -> Int +foldableSum :: Arr Int -> Int foldableSum = P.sum -} #endif {-# INLINE sourceIntFromToFromStream #-} -sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int) -sourceIntFromToFromStream value n = +sourceIntFromToFromStream :: Int -> IO (Arr Int) +sourceIntFromToFromStream value = withRandomIntIO $ \n -> S.fold A.create $ S.enumerateFromTo n (n + value) +{-# INLINE createOfLast1 #-} +createOfLast1 :: Int -> IO (Arr Int) +createOfLast1 value = withStream value (S.fold (IA.createOfLast 1)) + +{-# INLINE createOfLast10 #-} +createOfLast10 :: Int -> IO (Arr Int) +createOfLast10 value = withStream value (S.fold (IA.createOfLast 10)) + +{-# INLINE createOfLastMax #-} +createOfLastMax :: Int -> IO (Arr Int) +createOfLastMax value = withStream value (S.fold (IA.createOfLast (value + 1))) + ------------------------------------------------------------------------------- -- Bench groups ------------------------------------------------------------------------------- @@ -67,36 +75,24 @@ o_1_space_generation :: Int -> [Benchmark] o_1_space_generation value = [ bgroup "generation" - [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value) - , let testStr = "fromList " ++ mkListString value - in testStr `deepseq` bench "read" (nf readInstance testStr) + [ benchIO "write . intFromTo" $ sourceIntFromToFromStream value + , benchIO "read" $ readInstance value ] ] o_1_space_elimination :: Int -> [Benchmark] o_1_space_elimination value = [ bgroup "elimination" - [ benchFold "createOfLast.1" - (S.fold (IA.createOfLast 1)) (P.sourceUnfoldrM value) - , benchFold "createOfLast.10" - (S.fold (IA.createOfLast 10)) (P.sourceUnfoldrM value) -#ifdef DEVBUILD -{- - benchPureSink value "foldable/foldl'" foldableFoldl' - , benchPureSink value "foldable/sum" foldableSum --} -#endif + [ benchIO "createOfLast.1" $ createOfLast1 value + , benchIO "createOfLast.10" $ createOfLast10 value ] ] o_n_heap_serial :: Int -> [Benchmark] o_n_heap_serial value = [ bgroup "elimination" - [ - -- Converting the stream to an array - benchFold "createOfLast.Max" (S.fold (IA.createOfLast (value + 1))) - (P.sourceUnfoldrM 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 4790d14a23..cb4dae3fa4 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs @@ -4,46 +4,43 @@ #include "Streamly/Benchmark/Data/Array/CommonImports.hs" -import Control.DeepSeq (deepseq) - import qualified Streamly.Internal.Data.SmallArray as A -type Stream = A.SmallArray +type Arr = A.SmallArray #include "Streamly/Benchmark/Data/Array/Common.hs" -------------------------------------------------------------------------------- --- Benchmark helpers -------------------------------------------------------------------------------- - --- Drain a source that generates an array in the IO monad -{-# INLINE benchIOSrc #-} -benchIOSrc :: NFData a => String -> (Int -> IO (Stream a)) -> Benchmark -benchIOSrc name src = benchIO name src id - ------------------------------------------------------------------------------- -- Bench Ops ------------------------------------------------------------------------------- {-# INLINE sourceIntFromToFromList #-} -sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int) -sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value] +sourceIntFromToFromList :: Int -> IO (Arr Int) +sourceIntFromToFromList value = withRandomIntIO $ \n -> + P.return $ A.fromListN value [n..n + value] -{-# INLINE readInstance #-} -readInstance :: P.String -> Stream Int -readInstance str = +{-# INLINE parseInstance #-} +parseInstance :: P.String -> Arr Int +parseInstance str = let r = P.reads str in case r of [(x,"")] -> x - _ -> P.error "readInstance: no parse" + _ -> P.error "parseInstance: no parse" + +{-# INLINE readInstance #-} +readInstance :: Int -> IO (Arr Int) +readInstance value = + let testStr = "fromListN " ++ show (value + 1) + ++ "[1" ++ concat (replicate value ",1") ++ "]" + in return $! parseInstance testStr #ifdef DEVBUILD {- {-# INLINE foldableFoldl' #-} -foldableFoldl' :: Stream Int -> Int +foldableFoldl' :: Arr Int -> Int foldableFoldl' = F.foldl' (+) 0 {-# INLINE foldableSum #-} -foldableSum :: Stream Int -> Int +foldableSum :: Arr Int -> Int foldableSum = P.sum -} #endif @@ -56,11 +53,7 @@ o_1_space_generation :: Int -> [Benchmark] o_1_space_generation value = [ bgroup "generation" - [ let testStr = - "fromListN " ++ - show (value + 1) ++ - "[1" ++ concat (replicate value ",1") ++ "]" - in testStr `deepseq` bench "read" (nf readInstance testStr) + [ benchIO "read" $ readInstance value ] ] From 43edcfe9793bbd5b5411189a530517261f4b47da Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Fri, 12 Jun 2026 01:01:23 +0530 Subject: [PATCH 7/8] Use per benchmark IO action in Data.MutArray benchmarks --- benchmark/Streamly/Benchmark/Data/MutArray.hs | 202 +++++++++--------- 1 file changed, 101 insertions(+), 101 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/MutArray.hs b/benchmark/Streamly/Benchmark/Data/MutArray.hs index f5c5fb6547..d1e7fd737a 100644 --- a/benchmark/Streamly/Benchmark/Data/MutArray.hs +++ b/benchmark/Streamly/Benchmark/Data/MutArray.hs @@ -21,7 +21,6 @@ import Control.DeepSeq (NFData(..)) import Control.Monad.IO.Class (MonadIO) -import Data.Functor ((<&>)) #if __GLASGOW_HASKELL__ >= 810 import Data.Kind (Type) #endif @@ -41,11 +40,9 @@ import Prelude , (||) , (++) , concat - , const , filter , fmap , fst - , id , snd , undefined ) @@ -73,28 +70,21 @@ instance NFData (MutArray a) where -- Benchmark helpers ------------------------------------------------------------------------------- -{-# INLINE benchIO #-} -benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark -benchIO name src f = bench name $ nfIO $ - (randomRIO (1,1) >>= src) <&> f - -{-# INLINE benchPureSink #-} -benchPureSink :: NFData b => Int -> String -> (Stream Int -> b) -> Benchmark -benchPureSink value name = benchIO name (sourceIntFromTo value) +{-# INLINE withRandomIntIO #-} +withRandomIntIO :: (Int -> IO b) -> IO b +withRandomIntIO f = randomRIO (1, 1 :: Int) >>= f -{-# INLINE benchIO' #-} -benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark -benchIO' name src f = bench name $ nfIO $ - randomRIO (1,1) >>= src >>= f +{-# INLINE benchIO #-} +benchIO :: NFData b => String -> IO b -> Benchmark +benchIO name = bench name . nfIO -{-# INLINE benchIOSink #-} -benchIOSink :: NFData b => Int -> String -> (Stream Int -> IO b) -> Benchmark -benchIOSink value name = benchIO' name (sourceIntFromTo value) +{-# INLINE withArray #-} +withArray :: Int -> (Stream Int -> IO b) -> IO b +withArray value f = sourceIntFromTo value >>= f --- Drain a source that generates an array in the IO monad -{-# INLINE benchIOSrc #-} -benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark -benchIOSrc name src = benchIO name src id +{-# INLINE withStream #-} +withStream :: Int -> (Stream.Stream IO Int -> IO b) -> IO b +withStream value f = withRandomIntIO $ \n -> f $ sourceUnfoldrM value n drain :: Monad m => Stream.Stream m a -> m () drain = Stream.fold Fold.drain @@ -104,34 +94,32 @@ drain = Stream.fold Fold.drain ------------------------------------------------------------------------------- {-# INLINE sourceUnfoldr #-} -sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int) -sourceUnfoldr value n = - Stream.fold (MArray.createOf value) $ Stream.unfoldr step n - - where - - step cnt = - if cnt > n + value - then Nothing - else Just (cnt, cnt + 1) +sourceUnfoldr :: Int -> IO (Stream Int) +sourceUnfoldr value = withRandomIntIO $ \n -> + let step cnt = + if cnt > n + value + then Nothing + else Just (cnt, cnt + 1) + in Stream.fold (MArray.createOf value) $ Stream.unfoldr step n {-# INLINE sourceIntFromTo #-} -sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int) -sourceIntFromTo value n = +sourceIntFromTo :: Int -> IO (Stream Int) +sourceIntFromTo value = withRandomIntIO $ \n -> Stream.fold (MArray.createOf value) $ Stream.enumerateFromTo n (n + value) {-# INLINE sourceFromList #-} -sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int) -sourceFromList value n = +sourceFromList :: Int -> IO (Stream Int) +sourceFromList value = withRandomIntIO $ \n -> Stream.fold (MArray.createOf value) $ Stream.fromList [n .. n + value] {-# INLINE sourceIntFromToFromList #-} -sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int) -sourceIntFromToFromList value n = MArray.fromListN value [n..n + value] +sourceIntFromToFromList :: Int -> IO (Stream Int) +sourceIntFromToFromList value = withRandomIntIO $ \n -> + MArray.fromListN value [n..n + value] {-# INLINE sourceIntFromToFromStream #-} -sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int) -sourceIntFromToFromStream value n = +sourceIntFromToFromStream :: Int -> IO (Stream Int) +sourceIntFromToFromStream value = withRandomIntIO $ \n -> Stream.fold MArray.create $ Stream.enumerateFromTo n (n + value) {-# INLINE sourceUnfoldrM #-} @@ -158,18 +146,6 @@ composeN n f x = 4 -> f x >>= f >>= f >>= f _ -> undefined -{-# INLINE scanl' #-} -scanl' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int) -scanl' value n = composeN n $ onArray value $ Stream.scanl (Scanl.scanl' (+) 0) - -{-# INLINE scanl1' #-} -scanl1' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int) -scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+) - -{-# INLINE map #-} -map :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int) -map value n = composeN n $ onArray value $ fmap (+ 1) - {-# INLINE onArray #-} onArray :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int) @@ -178,29 +154,61 @@ onArray onArray value f arr = Stream.fold (MArray.createOf value) $ f $ Stream.unfold MArray.reader arr +{-# INLINE scanl' #-} +scanl' :: Int -> IO (Stream Int) +scanl' value = withArray value $ composeN 1 $ onArray value $ Stream.scanl (Scanl.scanl' (+) 0) + +{-# INLINE scanl'X4 #-} +scanl'X4 :: Int -> IO (Stream Int) +scanl'X4 value = withArray value $ composeN 4 $ onArray value $ Stream.scanl (Scanl.scanl' (+) 0) + +{-# INLINE scanl1' #-} +scanl1' :: Int -> IO (Stream Int) +scanl1' value = withArray value $ composeN 1 $ onArray value $ Stream.scanl1' (+) + +{-# INLINE scanl1'X4 #-} +scanl1'X4 :: Int -> IO (Stream Int) +scanl1'X4 value = withArray value $ composeN 4 $ onArray value $ Stream.scanl1' (+) + +{-# INLINE map #-} +map :: Int -> IO (Stream Int) +map value = withArray value $ composeN 1 $ onArray value $ fmap (+ 1) + +{-# INLINE mapX4 #-} +mapX4 :: Int -> IO (Stream Int) +mapX4 value = withArray value $ composeN 4 $ onArray value $ fmap (+ 1) + +{-# INLINE idArr #-} +idArr :: Int -> IO (Stream Int) +idArr value = withArray value return + ------------------------------------------------------------------------------- -- Elimination ------------------------------------------------------------------------------- {-# INLINE unfoldReadDrain #-} -unfoldReadDrain :: MonadIO m => Stream Int -> m () -unfoldReadDrain = drain . Stream.unfold MArray.reader +unfoldReadDrain :: Int -> IO () +unfoldReadDrain value = withArray value $ drain . Stream.unfold MArray.reader {-# INLINE unfoldReadRevDrain #-} -unfoldReadRevDrain :: MonadIO m => Stream Int -> m () -unfoldReadRevDrain = drain . Stream.unfold MArray.readerRev +unfoldReadRevDrain :: Int -> IO () +unfoldReadRevDrain value = withArray value $ drain . Stream.unfold MArray.readerRev {-# INLINE toStreamDRevDrain #-} -toStreamDRevDrain :: MonadIO m => Stream Int -> m () -toStreamDRevDrain = drain . MArray.readRev +toStreamDRevDrain :: Int -> IO () +toStreamDRevDrain value = withArray value $ drain . MArray.readRev {-# INLINE toStreamDDrain #-} -toStreamDDrain :: MonadIO m => Stream Int -> m () -toStreamDDrain = drain . MArray.read +toStreamDDrain :: Int -> IO () +toStreamDDrain value = withArray value $ drain . MArray.read {-# INLINE unfoldFold #-} -unfoldFold :: MonadIO m => Stream Int -> m Int -unfoldFold = Stream.fold (Fold.foldl' (+) 0) . Stream.unfold MArray.reader +unfoldFold :: Int -> IO Int +unfoldFold value = withArray value $ Stream.fold (Fold.foldl' (+) 0) . Stream.unfold MArray.reader + +{-# INLINE writeN #-} +writeN :: Int -> IO (Stream Int) +writeN value = withStream value (Stream.fold (MArray.createOf value)) ------------------------------------------------------------------------------- -- Bench groups @@ -210,74 +218,66 @@ o_1_space_generation :: Int -> [Benchmark] o_1_space_generation value = [ bgroup "generation" - [ benchIOSrc "createOf . intFromTo" (sourceIntFromTo value) - , benchIOSrc - "fromList . intFromTo" - (sourceIntFromToFromList value) - , benchIOSrc "createOf . unfoldr" (sourceUnfoldr value) - , benchIOSrc "createOf . fromList" (sourceFromList value) - , benchIOSrc "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" - [ benchPureSink value "id" id - , benchIOSink value "foldl'" unfoldFold - , benchIOSink value "read" unfoldReadDrain - , benchIOSink value "readRev" unfoldReadRevDrain - , benchIOSink value "toStream" toStreamDDrain - , benchIOSink value "toStreamRev" toStreamDRevDrain + [ 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" - [ - -- Converting the stream to an array - benchFold "createOf" (Stream.fold (MArray.createOf value)) - (sourceUnfoldrM value) - ] + [ benchIO "createOf" $ writeN value + ] ] o_1_space_transformation :: Int -> [Benchmark] o_1_space_transformation value = [ bgroup "transformation" - [ benchIOSink value "scanl'" (scanl' value 1) - , benchIOSink value "scanl1'" (scanl1' value 1) - , benchIOSink value "map" (map value 1) + [ 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" - [ benchIOSink value "scanl'" (scanl' value 4) - , benchIOSink value "scanl1'" (scanl1' value 4) - , benchIOSink value "map" (map value 4) + [ benchIO "scanl'" $ scanl'X4 value + , benchIO "scanl1'" $ scanl1'X4 value + , benchIO "map" $ 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)" (const (return array)) - $ MArray.partitionBy (< 0) - , benchIO' "partitionBy (> 0)" (const (return array)) - $ MArray.partitionBy (> 0) - , benchIO' "partitionBy (< value/2)" (const (return array)) - $ MArray.partitionBy (< (value `div` 2)) - , benchIO' "partitionBy (> value/2)" (const (return array)) - $ MArray.partitionBy (> (value `div` 2)) - , benchIO' "strip (< value/2 || > value/2)" (const (return array)) - $ MArray.dropAround (\x -> x < value `div` 2 || x > value `div` 2) - , benchIO' "strip (> 0)" (const (return array)) - $ MArray.dropAround (> 0) - , benchIO' "modifyIndices (+ 1)" (const (return indices)) - $ Stream.fold (MArray.modifyIndices array (\_idx val -> val + 1)) - . Stream.unfold Array.reader + [ 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 ] ------------------------------------------------------------------------------- From bf84dbe2a98aa00dd33afd1f6bb5d5f1190920f4 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Fri, 12 Jun 2026 01:05:31 +0530 Subject: [PATCH 8/8] Use benchIO in RingArray similar to other Array benchmarks --- benchmark/Streamly/Benchmark/Data/RingArray.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/RingArray.hs b/benchmark/Streamly/Benchmark/Data/RingArray.hs index 0161cf89d6..8af97cbcd2 100644 --- a/benchmark/Streamly/Benchmark/Data/RingArray.hs +++ b/benchmark/Streamly/Benchmark/Data/RingArray.hs @@ -14,11 +14,16 @@ import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Data.MutArray as MutArray import qualified Streamly.Internal.Data.RingArray as RingArray +import Control.DeepSeq (NFData) import Test.Tasty.Bench import Streamly.Benchmark.Common import Prelude as P +{-# INLINE benchIO #-} +benchIO :: NFData b => String -> IO b -> Benchmark +benchIO name = bench name . nfIO + ------------------------------------------------------------------------------- -- Benchmark ops ------------------------------------------------------------------------------- @@ -39,8 +44,8 @@ o_1_space_serial :: -> RingArray.RingArray Int -> [(SpaceComplexity, Benchmark)] o_1_space_serial value arr ring = - [ (SpaceO_1, bench "eqArrayN" $ nfIO $ eqArrayN (value, arr, ring)) - , (SpaceO_1, bench "eqArray" $ nfIO $ eqArray (arr, ring)) + [ (SpaceO_1, benchIO "eqArrayN" $ eqArrayN (value, arr, ring)) + , (SpaceO_1, benchIO "eqArray" $ eqArray (arr, ring)) ] -------------------------------------------------------------------------------