@@ -11,6 +11,7 @@
1111-- Maintainer : streamly@composewell.com
1212
1313import Control.DeepSeq (NFData(..), deepseq)
14+import Control.Monad (when)
1415import Data.Functor.Identity (Identity, runIdentity)
1516import Data.Monoid (Last(..))
1617import System.Random (randomRIO)
@@ -129,7 +130,13 @@ main :: IO ()
129130main = do
130131 -- XXX Fix indentation
131132 (value, cfg, benches) <- parseCLIOpts defaultStreamSize
132− value `seq` runMode (mode cfg) cfg benches
133+ let bufValue = min value defaultStreamSize
134+ when (bufValue /= value) $
135+ putStrLn $ "Limiting stream size to "
136+ ++ show defaultStreamSize
137+ ++ " for buffered operations"
138+
139+ bufValue `seq` value `seq` runMode (mode cfg) cfg benches
133140 [ bgroup "serially"
134141 [ bgroup "pure"
135142 [ benchPureSink value "id" id
@@ -458,53 +465,53 @@ main = do
458465
459466 -- Right folds for reducing are inherently non-streaming as the
460467 -- expression needs to be fully built before it can be reduced.
461− benchIOSink value "foldrM/reduce/IO" Ops.foldrMReduce
462− , benchIdentitySink value "foldrM/reduce/Identity" Ops.foldrMReduce
468+ benchIOSink bufValue "foldrM/reduce/IO" Ops.foldrMReduce
469+ , benchIdentitySink bufValue "foldrM/reduce/Identity" Ops.foldrMReduce
463470
464471 -- Left folds for building a structure are inherently non-streaming as
465472 -- the structure cannot be lazily consumed until fully built.
466− , benchIOSink value "foldl'/build/IO" Ops.foldl'Build
467− , benchIdentitySink value "foldl'/build/Identity" Ops.foldl'Build
468− , benchIOSink value "foldlM'/build/IO" Ops.foldlM'Build
469− , benchIdentitySink value "foldlM'/build/Identity" Ops.foldlM'Build
473+ , benchIOSink bufValue "foldl'/build/IO" Ops.foldl'Build
474+ , benchIdentitySink bufValue "foldl'/build/Identity" Ops.foldl'Build
475+ , benchIOSink bufValue "foldlM'/build/IO" Ops.foldlM'Build
476+ , benchIdentitySink bufValue "foldlM'/build/Identity" Ops.foldlM'Build
470477
471478 -- accumulation due to strictness of IO monad
472− , benchIOSink value "foldrM/build/IO" Ops.foldrMBuild
473− , benchPureSinkIO value "traversable/mapM" Ops.traversableMapM
479+ , benchIOSink bufValue "foldrM/build/IO" Ops.foldrMBuild
480+ , benchPureSinkIO bufValue "traversable/mapM" Ops.traversableMapM
474481
475482 -- Converting the stream to a list or pure stream
476− , benchIOSink value "toList" Ops.toList
477− , benchIOSink value "toListRev" Ops.toListRev
478− , benchIOSink value "toStream" (S.fold IP.toStream)
479− , benchIOSink value "toStreamRev" (S.fold IP.toStreamRev)
483+ , benchIOSink bufValue "toList" Ops.toList
484+ , benchIOSink bufValue "toListRev" Ops.toListRev
485+ , benchIOSink bufValue "toStream" (S.fold IP.toStream)
486+ , benchIOSink bufValue "toStreamRev" (S.fold IP.toStreamRev)
480487
481− , benchIOSink value "folds/toList" (S.fold FL.toList)
482− , benchIOSink value "folds/toListRevF" (S.fold IFL.toListRevF)
488+ , benchIOSink bufValue "folds/toList" (S.fold FL.toList)
489+ , benchIOSink bufValue "folds/toListRevF" (S.fold IFL.toListRevF)
483490
484491 -- Converting the stream to an array
485− , benchIOSink value "folds/lastN.Max" (S.fold (IA.lastN (value + 1)))
486− , benchIOSink value "folds/writeN" (S.fold (A.writeN value))
492+ , benchIOSink bufValue "folds/lastN.Max" (S.fold (IA.lastN (bufValue + 1)))
493+ , benchIOSink bufValue "folds/writeN" (S.fold (A.writeN bufValue))
487494
488495 -- Reversing/sorting a stream
489− , benchIOSink value "reverse" (Ops.reverse 1)
490− , benchIOSink value "reverse'" (Ops.reverse' 1)
496+ , benchIOSink bufValue "reverse" (Ops.reverse 1)
497+ , benchIOSink bufValue "reverse'" (Ops.reverse' 1)
491498
492499 -- XXX can these be streaming? Can we have special read/show style type
493500 -- classes supporting streaming?
494− , mkString value `deepseq` (bench "readsPrec pure streams" $
495− nf Ops.readInstance (mkString value))
496− , mkString value `deepseq` (bench "readsPrec Haskell lists" $
497− nf Ops.readInstanceList (mkListString value))
498− , mkList value `deepseq` (bench "showPrec Haskell lists" $
499− nf Ops.showInstanceList (mkList value))
501+ , mkString bufValue `deepseq` (bench "readsPrec pure streams" $
502+ nf Ops.readInstance (mkString bufValue))
503+ , mkString bufValue `deepseq` (bench "readsPrec Haskell lists" $
504+ nf Ops.readInstanceList (mkListString bufValue))
505+ , mkList bufValue `deepseq` (bench "showPrec Haskell lists" $
506+ nf Ops.showInstanceList (mkList bufValue))
500507
501508 -- XXX streaming operations that can potentially be fixed
502− , benchPureSink value "foldable/sum" Ops.foldableSum
503− , benchIOSink value "tail" Ops.tail
504− , benchIOSink value "nullHeadTail" Ops.nullHeadTail
509+ , benchPureSink bufValue "foldable/sum" Ops.foldableSum
510+ , benchIOSink bufValue "tail" Ops.tail
511+ , benchIOSink bufValue "nullHeadTail" Ops.nullHeadTail
505512 , benchIOSrc1 "concatUnfoldInterleaveRepl (x/4,4)"
506− (Ops.concatUnfoldInterleaveRepl4xN value)
513+ (Ops.concatUnfoldInterleaveRepl4xN bufValue)
507514 , benchIOSrc1 "concatUnfoldRoundrobinRepl (x/4,4)"
508− (Ops.concatUnfoldRoundrobinRepl4xN value)
515+ (Ops.concatUnfoldRoundrobinRepl4xN bufValue)
509516 ]
510517 ]