composewell/streamly
1
1
Fork 0
mirror of https://github.com/composewell/streamly.git synced 2024-08-16 15:00:25 +03:00
Code Issues Packages Projects Releases Wiki Activity

Move Prelude.Serial benchmarks to Data.Stream

Browse Source
This commit is contained in:
Ranjeet Kumar Ranjan 2022-08-01 18:41:59 +05:30 committed by Harendra Kumar
parent d2aaef0004
commit 8fbc085ef4
18 changed files with 728 additions and 313 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.github/workflows/regression-check.yml vendored
View File

@ -25,6 +25,7 @@ jobs:
Data.Parser.ParserD
Data.Parser.ParserK
Data.SmallArray
Data.Stream
Data.Stream.StreamD
Data.Stream.StreamDK
Data.Stream.StreamK:6
@ -33,7 +34,6 @@ jobs:
Prelude.Ahead
Prelude.Async:12
Prelude.Parallel
Prelude.Serial
Prelude.WAsync:6
Prelude.WSerial
Prelude.ZipAsync

13
.hlint.yaml
View File

@ -26,12 +26,13 @@
- ignore: {name: "Use fmap"}
# Warnings ignored in specific places
- ignore: {name: "Use ++", within: Serial.Transformation}
- ignore: {name: "Use mapM", within: Serial.Transformation}
- ignore: {name: "Use traverse", within: Serial.Transformation}
- ignore: {name: "Redundant <*", within: Serial.NestedStream}
- ignore: {name: "Use ++", within: Serial.NestedStream}
- ignore: {name: "Use ++", within: Stream.Transformation}
- ignore: {name: "Use mapM", within: Stream.Transformation}
- ignore: {name: "Use traverse", within: Stream.Transformation}
- ignore: {name: "Redundant <*", within: Stream.NestedStream}
- ignore: {name: "Use ++", within: Stream.NestedStream}
- ignore: {name: "Use ++", within: Stream.Split}
- ignore: {name: "Redundant bracket", within: Stream.Split}
- ignore: {name: "Use isDigit", within: Streamly.Internal.Unicode.Char.Parser}
# Specify additional command line arguments

36
benchmark/Streamly/Benchmark/Prelude/Serial.hs → benchmark/Streamly/Benchmark/Data/Stream.hs
View File

@ -1,5 +1,5 @@
-- |
-- Module : Serial
-- Module : Data.Stream
-- Copyright : (c) 2018 Composewell Technologies
-- License : BSD-3-Clause
-- Maintainer : streamly@composewell.com
@ -13,19 +13,22 @@ module Main (main) where
import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
import qualified Serial.Elimination as Elimination
import qualified Serial.Exceptions as Exceptions
import qualified Serial.Generation as Generation
import qualified Serial.NestedStream as NestedStream
import qualified Serial.Split as Split
import qualified Serial.Transformation as Transformation
import qualified Serial.NestedFold as NestedFold
import qualified Serial.Lift as Lift
import qualified Stream.Eliminate as Elimination
import qualified Stream.Exceptions as Exceptions
import qualified Stream.Generate as Generation
import qualified Stream.Lift as Lift
import qualified Stream.Reduce as Reduction
import qualified Stream.Transformation as Transformation
#ifdef USE_PRELUDE
import qualified Stream.NestedFold as NestedFold
import qualified Stream.NestedStream as NestedStream
import qualified Stream.Split as Split
#endif
import Streamly.Benchmark.Common
moduleName :: String
moduleName = "Prelude.Serial"
moduleName = "Data.Stream"
-------------------------------------------------------------------------------
-- Main
@ -42,12 +45,15 @@ main = do
where
allBenchmarks env size = Prelude.concat
[ Generation.benchmarks moduleName size
, Elimination.benchmarks moduleName size
[ Elimination.benchmarks moduleName size
, Exceptions.benchmarks moduleName env size
, Split.benchmarks moduleName env
, Transformation.benchmarks moduleName size
, NestedFold.benchmarks moduleName size
, Generation.benchmarks moduleName size
, Lift.benchmarks moduleName size
, Reduction.benchmarks moduleName size
, Transformation.benchmarks moduleName size
#ifdef USE_PRELUDE
, NestedFold.benchmarks moduleName size
, NestedStream.benchmarks moduleName size
, Split.benchmarks moduleName env
#endif
]

70
benchmark/Streamly/Benchmark/Data/Stream/Common.hs Normal file
View File

@ -0,0 +1,70 @@
-- |
-- Module : Stream.Common
-- Copyright : (c) 2018 Composewell Technologies
-- License : BSD-3-Clause
-- Maintainer : streamly@composewell.com
module Stream.Common
( sourceUnfoldr
, sourceUnfoldrM
, sourceUnfoldrAction
, benchIOSink
, benchIOSrc
)
where
import Streamly.Internal.Data.Stream (Stream, unfold)
import qualified Streamly.Internal.Data.Fold as Fold
import qualified Streamly.Internal.Data.Stream as Stream
import qualified Streamly.Internal.Data.Unfold as UF
import Control.DeepSeq (NFData)
import Gauge
import Prelude hiding (mapM)
import System.Random (randomRIO)
{-# INLINE toNull #-}
toNull :: Monad m => Stream m a -> m ()
toNull = Stream.fold Fold.drain
{-# INLINE sourceUnfoldrM #-}
sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
sourceUnfoldrM count start = unfold (UF.unfoldrM step) start
where
step cnt =
if cnt > start + count
then return Nothing
else return (Just (cnt, cnt + 1))
{-# INLINE sourceUnfoldr #-}
sourceUnfoldr :: Monad m => Int -> Int -> Stream m Int
sourceUnfoldr count start = unfold (UF.unfoldr step) start
where
step cnt =
if cnt > start + count
then Nothing
else Just (cnt, cnt + 1)
{-# INLINE sourceUnfoldrAction #-}
sourceUnfoldrAction :: (Monad m1, Monad m) => Int -> Int -> Stream m (m1 Int)
sourceUnfoldrAction value n = unfold (UF.unfoldr step) n
where
step cnt =
if cnt > n + value
then Nothing
else Just (return cnt, cnt + 1)
{-# INLINE benchIOSink #-}
benchIOSink
:: (NFData b)
=> Int -> String -> (Stream IO Int -> IO b) -> Benchmark
benchIOSink value name f =
bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
-- | Takes a source, and uses it with a default drain/fold method.
{-# INLINE benchIOSrc #-}
benchIOSrc
:: String
-> (Int -> Stream IO a)
-> Benchmark
benchIOSrc name f =
bench name $ nfIO $ randomRIO (1,1) >>= toNull . f

147
benchmark/Streamly/Benchmark/Prelude/Serial/Elimination.hs → benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs
View File

@ -1,5 +1,5 @@
-- |
-- Module : Serial.Elimination
-- Module : Stream.Eliminate
-- Copyright : (c) 2018 Composewell Technologies
-- License : BSD-3-Clause
-- Maintainer : streamly@composewell.com
@ -18,7 +18,7 @@
{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
#endif
module Serial.Elimination (benchmarks) where
module Stream.Eliminate (benchmarks) where
import Control.DeepSeq (NFData(..))
import Data.Functor.Identity (Identity, runIdentity)
@ -33,22 +33,39 @@ import Test.Inspection
import qualified Streamly.Internal.Data.Stream.StreamD as D
#endif
import qualified Streamly.Internal.Data.Fold as Fold
#ifdef USE_PRELUDE
import qualified Streamly.Prelude as S
import qualified Streamly.Internal.Data.Stream.IsStream as S
import qualified Streamly.Internal.Data.Stream.IsStream as Internal
#else
import qualified Streamly.Internal.Data.Stream as S
#endif
import Gauge
import Streamly.Prelude (SerialT, IsStream, fromSerial)
import Streamly.Benchmark.Common
import Streamly.Internal.Data.Stream.Serial (SerialT)
#ifdef USE_PRELUDE
import Streamly.Prelude (fromSerial)
import Streamly.Benchmark.Prelude
#else
import Stream.Common
( sourceUnfoldr
, sourceUnfoldrM
, sourceUnfoldrAction
, benchIOSink
)
#endif
import Streamly.Benchmark.Common
import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),
lookup, repeat, minimum, maximum, product, last, mapM_, init)
import qualified Prelude
#ifdef USE_PRELUDE
{-# INLINE repeat #-}
repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
repeat count = S.take count . S.repeat
#endif
-------------------------------------------------------------------------------
-- Elimination
-------------------------------------------------------------------------------
@ -60,76 +77,76 @@ repeat count = S.take count . S.repeat
{-# INLINE foldableFoldl' #-}
foldableFoldl' :: Int -> Int -> Int
foldableFoldl' value n =
F.foldl' (+) 0 (sourceUnfoldr value n :: S.SerialT Identity Int)
F.foldl' (+) 0 (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableFoldrElem #-}
foldableFoldrElem :: Int -> Int -> Bool
foldableFoldrElem value n =
F.foldr (\x xs -> x == value || xs)
False
(sourceUnfoldr value n :: S.SerialT Identity Int)
(sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableSum #-}
foldableSum :: Int -> Int -> Int
foldableSum value n =
Prelude.sum (sourceUnfoldr value n :: S.SerialT Identity Int)
Prelude.sum (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableProduct #-}
foldableProduct :: Int -> Int -> Int
foldableProduct value n =
Prelude.product (sourceUnfoldr value n :: S.SerialT Identity Int)
Prelude.product (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE _foldableNull #-}
_foldableNull :: Int -> Int -> Bool
_foldableNull value n =
Prelude.null (sourceUnfoldr value n :: S.SerialT Identity Int)
Prelude.null (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableElem #-}
foldableElem :: Int -> Int -> Bool
foldableElem value n =
value `Prelude.elem` (sourceUnfoldr value n :: S.SerialT Identity Int)
value `Prelude.elem` (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableNotElem #-}
foldableNotElem :: Int -> Int -> Bool
foldableNotElem value n =
value `Prelude.notElem` (sourceUnfoldr value n :: S.SerialT Identity Int)
value `Prelude.notElem` (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableFind #-}
foldableFind :: Int -> Int -> Maybe Int
foldableFind value n =
F.find (== (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
F.find (== (value + 1)) (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableAll #-}
foldableAll :: Int -> Int -> Bool
foldableAll value n =
Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableAny #-}
foldableAny :: Int -> Int -> Bool
foldableAny value n =
Prelude.any (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
Prelude.any (> (value + 1)) (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableAnd #-}
foldableAnd :: Int -> Int -> Bool
foldableAnd value n =
Prelude.and $ S.map
(<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
Prelude.and $ fmap
(<= (value + 1)) (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableOr #-}
foldableOr :: Int -> Int -> Bool
foldableOr value n =
Prelude.or $ S.map
(> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
Prelude.or $ fmap
(> (value + 1)) (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableLength #-}
foldableLength :: Int -> Int -> Int
foldableLength value n =
Prelude.length (sourceUnfoldr value n :: S.SerialT Identity Int)
Prelude.length (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableMin #-}
foldableMin :: Int -> Int -> Int
foldableMin value n =
Prelude.minimum (sourceUnfoldr value n :: S.SerialT Identity Int)
Prelude.minimum (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE ordInstanceMin #-}
ordInstanceMin :: SerialT Identity Int -> SerialT Identity Int
@ -138,12 +155,12 @@ ordInstanceMin src = min src src
{-# INLINE foldableMax #-}
foldableMax :: Int -> Int -> Int
foldableMax value n =
Prelude.maximum (sourceUnfoldr value n :: S.SerialT Identity Int)
Prelude.maximum (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableMinBy #-}
foldableMinBy :: Int -> Int -> Int
foldableMinBy value n =
F.minimumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
F.minimumBy compare (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableListMinBy #-}
foldableListMinBy :: Int -> Int -> Int
@ -152,27 +169,27 @@ foldableListMinBy value n = F.minimumBy compare [1..value+n]
{-# INLINE foldableMaxBy #-}
foldableMaxBy :: Int -> Int -> Int
foldableMaxBy value n =
F.maximumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
F.maximumBy compare (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableToList #-}
foldableToList :: Int -> Int -> [Int]
foldableToList value n =
F.toList (sourceUnfoldr value n :: S.SerialT Identity Int)
F.toList (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableMapM_ #-}
foldableMapM_ :: Monad m => Int -> Int -> m ()
foldableMapM_ value n =
F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: S.SerialT Identity Int)
F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: SerialT Identity Int)
{-# INLINE foldableSequence_ #-}
foldableSequence_ :: Int -> Int -> IO ()
foldableSequence_ value n =
F.sequence_ (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
F.sequence_ (sourceUnfoldrAction value n :: SerialT Identity (IO Int))
{-# INLINE _foldableMsum #-}
_foldableMsum :: Int -> Int -> IO Int
_foldableMsum value n =
F.msum (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
F.msum (sourceUnfoldrAction value n :: SerialT Identity (IO Int))
{-# INLINE showInstance #-}
showInstance :: SerialT Identity Int -> String
@ -240,8 +257,8 @@ benchPureSink value name = benchPure name (sourceUnfoldr value)
{-# INLINE benchHoistSink #-}
benchHoistSink
:: (IsStream t, NFData b)
=> Int -> String -> (t Identity Int -> IO b) -> Benchmark
:: (NFData b)
=> Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
benchHoistSink value name f =
bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
@ -249,8 +266,8 @@ benchHoistSink value name f =
-- we can't use it as it requires MonadAsync constraint.
{-# INLINE benchIdentitySink #-}
benchIdentitySink
:: (IsStream t, NFData b)
=> Int -> String -> (t Identity Int -> Identity b) -> Benchmark
:: (NFData b)
=> Int -> String -> (SerialT Identity Int -> Identity b) -> Benchmark
benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
-------------------------------------------------------------------------------
@ -264,7 +281,7 @@ uncons s = do
case r of
Nothing -> return ()
Just (_, t) -> uncons t
#ifdef USE_PRELUDE
{-# INLINE init #-}
init :: Monad m => SerialT m a -> m ()
init s = S.init s >>= Prelude.mapM_ S.drain
@ -272,6 +289,7 @@ init s = S.init s >>= Prelude.mapM_ S.drain
{-# INLINE mapM_ #-}
mapM_ :: Monad m => SerialT m Int -> m ()
mapM_ = S.mapM_ (\_ -> return ())
#endif
{-# INLINE foldrMElem #-}
foldrMElem :: Monad m => Int -> SerialT m Int -> m Bool
@ -290,7 +308,7 @@ foldrToStream = S.foldr S.cons S.nil
{-# INLINE foldrMBuild #-}
foldrMBuild :: Monad m => SerialT m Int -> m [Int]
foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])
#ifdef USE_PRELUDE
{-# INLINE foldl'Reduce #-}
foldl'Reduce :: Monad m => SerialT m Int -> m Int
foldl'Reduce = S.foldl' (+) 0
@ -398,40 +416,47 @@ drainWhile = S.drainWhile (const True)
{-# INLINE lookup #-}
lookup :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
lookup val = S.lookup val . S.map (\x -> (x, x))
#endif
o_1_space_elimination_folds :: Int -> [Benchmark]
o_1_space_elimination_folds value =
[ bgroup "elimination"
-- Basic folds
[ bgroup "reduce"
[
#ifdef USE_PRELUDE
bgroup "reduce"
[ bgroup
"IO"
[ benchIOSink value "foldl'" foldl'Reduce
, benchIOSink value "foldl1'" foldl1'Reduce
, benchIOSink value "foldlM'" foldlM'Reduce
]
, bgroup
"Identity"
[ benchIdentitySink value "foldl'" foldl'Reduce
, benchIdentitySink value "foldl1'" foldl1'Reduce
, benchIdentitySink value "foldlM'" foldlM'Reduce
]
]
, bgroup "build"
] ,
#endif
bgroup "build"
[ bgroup "IO"
[ benchIOSink value "foldrMElem" (foldrMElem value)
]
, bgroup "Identity"
[ benchIdentitySink value "foldrMElem" (foldrMElem value)
, benchIdentitySink value "foldrToStreamLength"
(S.length . runIdentity . foldrToStream)
, benchPureSink value "foldrMToListLength"
(Prelude.length . runIdentity . foldrMBuild)
, benchIdentitySink value "foldrToStreamLength"
(S.fold Fold.length . runIdentity . foldrToStream)
]
]
-- deconstruction
, benchIOSink value "uncons" uncons
, benchHoistSink value "length . generally"
(S.fold Fold.length . S.generally)
#ifdef USE_PRELUDE
, benchIOSink value "init" init
-- draining
@ -442,19 +467,18 @@ o_1_space_elimination_folds value =
, benchIOSink value "mapM_" mapM_
-- this is too fast, causes all benchmarks reported in ns
-- , benchIOSink value "head" head
--, benchIOSink value "head" head
, benchIOSink value "last" last
, benchIOSink value "length" length
, benchHoistSink value "length . generally"
(length . Internal.generally)
, benchIOSink value "sum" sum
, benchIOSink value "product" product
, benchIOSink value "maximumBy" maximumBy
, benchIOSink value "maximum" maximum
, benchIOSink value "minimumBy" minimumBy
, benchIOSink value "minimum" minimum
#ifdef USE_PRELUDE
, bench "the" $ nfIO $ randomRIO (1,1) >>= the . repeat value
#endif
, benchIOSink value "find" (find value)
, benchIOSink value "findM" (findM value)
-- , benchIOSink value "lookupFirst" (lookup 1)
@ -463,13 +487,14 @@ o_1_space_elimination_folds value =
, benchIOSink value "findIndex" (findIndex value)
, benchIOSink value "elemIndex" (elemIndex value)
-- this is too fast, causes all benchmarks reported in ns
-- , benchIOSink value "null" S.null
-- , benchIOSink value "null" S.null
, benchIOSink value "elem" (elem value)
, benchIOSink value "notElem" (notElem value)
, benchIOSink value "all" (all value)
, benchIOSink value "any" (any value)
, benchIOSink value "and" (and value)
, benchIOSink value "or" (or value)
#endif
-- length is used to check for foldr/build fusion
, benchPureSink value "length . IsList.toList" (Prelude.length . GHC.toList)
@ -479,7 +504,7 @@ o_1_space_elimination_folds value =
-------------------------------------------------------------------------------
-- Buffered Transformations by fold
-------------------------------------------------------------------------------
#ifdef USE_PRELUDE
{-# INLINE foldl'Build #-}
foldl'Build :: Monad m => SerialT m Int -> m [Int]
foldl'Build = S.foldl' (flip (:)) []
@ -499,6 +524,7 @@ o_n_heap_elimination_foldl value =
, benchIdentitySink value "foldlM'/build/Identity" foldlM'Build
]
]
#endif
-- For comparisons
{-# INLINE showInstanceList #-}
@ -533,7 +559,7 @@ o_n_space_elimination_foldr value =
, benchIOSink value "foldrM/reduce/IO (sum)" foldrMReduce
]
]
#ifdef USE_PRELUDE
o_n_heap_elimination_toList :: Int -> [Benchmark]
o_n_heap_elimination_toList value =
[ bgroup "toList"
@ -553,7 +579,7 @@ o_n_space_elimination_toList value =
(Internal.toStream :: (SerialT IO Int -> IO (SerialT Identity Int)))
]
]
#endif
-------------------------------------------------------------------------------
-- Multi-stream folds
-------------------------------------------------------------------------------
@ -673,14 +699,17 @@ benchmarks moduleName size =
, o_1_space_elimination_multi_stream_pure size
, o_1_space_elimination_multi_stream size
]
, bgroup (o_n_heap_prefix moduleName) $ concat
[ o_n_heap_elimination_foldl size
, o_n_heap_elimination_toList size
, o_n_heap_elimination_buffered size
]
, bgroup (o_n_space_prefix moduleName) $ concat
[ o_n_space_elimination_foldable size
, o_n_space_elimination_toList size
, o_n_space_elimination_foldr size
]
, bgroup (o_n_heap_prefix moduleName) $
o_n_heap_elimination_buffered size
#ifdef USE_PRELUDE
++ o_n_heap_elimination_foldl size
++ o_n_heap_elimination_toList size
#endif
, bgroup (o_n_space_prefix moduleName) $
o_n_space_elimination_foldable size
#ifdef USE_PRELUDE
++ o_n_space_elimination_toList size
#endif
++ o_n_space_elimination_foldr size
]

94
benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs → benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs
View File

@ -1,5 +1,5 @@
-- |
-- Module : Streamly.Benchmark.Prelude.Serial.Exceptions
-- Module : Stream.Exceptions
-- Copyright : (c) 2019 Composewell Technologies
-- License : BSD-3-Clause
-- Maintainer : streamly@composewell.com
@ -18,7 +18,7 @@
{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
#endif
module Serial.Exceptions (benchmarks) where
module Stream.Exceptions (benchmarks) where
import Control.Exception (SomeException, Exception, throwIO)
import System.IO (Handle, hClose, hPutChar)
@ -29,10 +29,18 @@ import qualified Data.Map.Strict as Map
import qualified Streamly.FileSystem.Handle as FH
import qualified Streamly.Internal.Data.Unfold as IUF
import qualified Streamly.Internal.FileSystem.Handle as IFH
import qualified Streamly.Internal.Data.Stream.IsStream as IP
#ifdef USE_PRELUDE
import qualified Streamly.Internal.Data.Stream.IsStream as Stream
import qualified Streamly.Prelude as S
#else
import qualified Streamly.Internal.Data.Stream as Stream
import qualified Streamly.Internal.Data.Stream as S
import qualified Streamly.Internal.Data.Fold as Fold
import qualified Streamly.Internal.Data.Unfold as Unfold
#endif
import Gauge hiding (env)
import Streamly.Internal.Data.Stream.Serial (SerialT)
import Prelude hiding (last, length)
import Streamly.Benchmark.Common
import Streamly.Benchmark.Common.Handle
@ -47,6 +55,28 @@ import qualified Streamly.Internal.Data.Stream.StreamD as D
-- stream exceptions
-------------------------------------------------------------------------------
drain :: SerialT IO a -> IO ()
#ifdef USE_PRELUDE
drain = Stream.drain
#else
drain = Stream.fold Fold.drain
#endif
enumerateFromTo :: Int -> Int -> SerialT IO Int
#ifdef USE_PRELUDE
enumerateFromTo length from = S.enumerateFromTo from (from + length)
#else
enumerateFromTo length from = Stream.unfold Unfold.enumerateFromTo (from, from + length)
#endif
sourceRef :: (Num b) => Int -> Int -> Ref.IORef b -> SerialT IO b
#ifdef USE_PRELUDE
sourceRef length from ref = S.replicateM (from + length)
#else
sourceRef length from ref = Stream.unfold (Unfold.replicateM (from + length))
#endif
$ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
data BenchException
= BenchException1
| BenchException2
@ -56,37 +86,40 @@ instance Exception BenchException
retryNoneSimple :: Int -> Int -> IO ()
retryNoneSimple length from =
IP.drain
$ IP.retry (Map.singleton BenchException1 length) (const S.nil) source
drain
$ Stream.retry
(Map.singleton BenchException1 length)
(const S.nil)
source
where
source = S.enumerateFromTo from (from + length)
source = enumerateFromTo length from
retryNone :: Int -> Int -> IO ()
retryNone length from = do
ref <- Ref.newIORef (0 :: Int)
IP.drain
$ IP.retry (Map.singleton BenchException1 length) (const S.nil)
drain
$ Stream.retry (Map.singleton BenchException1 length) (const S.nil)
$ source ref
where
source ref =
IP.replicateM (from + length)
$ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
source = sourceRef length from
retryAll :: Int -> Int -> IO ()
retryAll length from = do
ref <- Ref.newIORef 0
IP.drain
$ IP.retry (Map.singleton BenchException1 (length + from)) (const S.nil)
drain
$ Stream.retry
(Map.singleton BenchException1 (length + from)) (const S.nil)
$ source ref
where
source ref =
IP.fromEffect
Stream.fromEffect
$ do
Ref.modifyIORef' ref (+ 1)
val <- Ref.readIORef ref
@ -96,13 +129,13 @@ retryAll length from = do
retryUnknown :: Int -> Int -> IO ()
retryUnknown length from = do
IP.drain
$ IP.retry (Map.singleton BenchException1 length) (const source)
drain
$ Stream.retry (Map.singleton BenchException1 length) (const source)
$ throwIO BenchException2 `S.before` S.nil
where
source = S.enumerateFromTo from (from + length)
source = enumerateFromTo length from
o_1_space_serial_exceptions :: Int -> [Benchmark]
@ -124,7 +157,7 @@ o_1_space_serial_exceptions length =
readWriteOnExceptionStream :: Handle -> Handle -> IO ()
readWriteOnExceptionStream inh devNull =
let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
in S.fold (FH.write devNull) $ readEx
in S.fold (FH.write devNull) readEx
#ifdef INSPECTION
inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
@ -135,7 +168,7 @@ readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
readWriteHandleExceptionStream inh devNull =
let handler (_e :: SomeException) = S.fromEffect (hClose inh >> return 10)
readEx = S.handle handler (S.unfold FH.read inh)
in S.fold (FH.write devNull) $ readEx
in S.fold (FH.write devNull) readEx
#ifdef INSPECTION
inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
@ -144,7 +177,7 @@ inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
-- | Send the file contents to /dev/null with exception handling
readWriteFinally_Stream :: Handle -> Handle -> IO ()
readWriteFinally_Stream inh devNull =
let readEx = IP.finally_ (hClose inh) (S.unfold FH.read inh)
let readEx = Stream.finally_ (hClose inh) (S.unfold FH.read inh)
in S.fold (FH.write devNull) readEx
#ifdef INSPECTION
@ -159,9 +192,9 @@ readWriteFinallyStream inh devNull =
-- | Send the file contents to /dev/null with exception handling
fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
fromToBytesBracket_Stream inh devNull =
let readEx = IP.bracket_ (return ()) (\_ -> hClose inh)
let readEx = Stream.bracket_ (return ()) (\_ -> hClose inh)
(\_ -> IFH.getBytes inh)
in IFH.putBytes devNull $ readEx
in IFH.putBytes devNull readEx
#ifdef INSPECTION
inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
@ -171,13 +204,13 @@ fromToBytesBracketStream :: Handle -> Handle -> IO ()
fromToBytesBracketStream inh devNull =
let readEx = S.bracket (return ()) (\_ -> hClose inh)
(\_ -> IFH.getBytes inh)
in IFH.putBytes devNull $ readEx
in IFH.putBytes devNull readEx
readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
readWriteBeforeAfterStream inh devNull =
let readEx =
IP.after (hClose inh)
$ IP.before (hPutChar devNull 'A') (S.unfold FH.read inh)
Stream.after (hClose inh)
$ Stream.before (hPutChar devNull 'A') (S.unfold FH.read inh)
in S.fold (FH.write devNull) readEx
#ifdef INSPECTION
@ -186,7 +219,7 @@ inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
readWriteAfterStream :: Handle -> Handle -> IO ()
readWriteAfterStream inh devNull =
let readEx = IP.after (hClose inh) (S.unfold FH.read inh)
let readEx = Stream.after (hClose inh) (S.unfold FH.read inh)
in S.fold (FH.write devNull) readEx
#ifdef INSPECTION
@ -195,7 +228,7 @@ inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
readWriteAfter_Stream :: Handle -> Handle -> IO ()
readWriteAfter_Stream inh devNull =
let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)
let readEx = Stream.after_ (hClose inh) (S.unfold FH.read inh)
in S.fold (FH.write devNull) readEx
#ifdef INSPECTION
@ -277,11 +310,11 @@ o_1_space_copy_exceptions_readChunks env =
-- | Send the file contents to /dev/null with exception handling
toChunksBracket_ :: Handle -> Handle -> IO ()
toChunksBracket_ inh devNull =
let readEx = IP.bracket_
let readEx = Stream.bracket_
(return ())
(\_ -> hClose inh)
(\_ -> IFH.getChunks inh)
in S.fold (IFH.writeChunks devNull) $ readEx
in S.fold (IFH.writeChunks devNull) readEx
#ifdef INSPECTION
inspect $ hasNoTypeClasses 'toChunksBracket_
@ -293,7 +326,7 @@ toChunksBracket inh devNull =
(return ())
(\_ -> hClose inh)
(\_ -> IFH.getChunks inh)
in S.fold (IFH.writeChunks devNull) $ readEx
in S.fold (IFH.writeChunks devNull) readEx
o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
o_1_space_copy_exceptions_toChunks env =
@ -305,7 +338,6 @@ o_1_space_copy_exceptions_toChunks env =
]
]
benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
benchmarks moduleName env size =
[ bgroup (o_1_space_prefix moduleName) $ concat

71
benchmark/Streamly/Benchmark/Prelude/Serial/Generation.hs → benchmark/Streamly/Benchmark/Data/Stream/Generate.hs
View File

@ -1,5 +1,5 @@
-- |
-- Module : Serial.Generation
-- Module : Stream.Generate
-- Copyright : (c) 2018 Composewell Technologies
-- License : BSD-3-Clause
-- Maintainer : streamly@composewell.com
@ -9,19 +9,29 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
module Serial.Generation (benchmarks) where
module Stream.Generate (benchmarks) where
import Data.Functor.Identity (Identity)
import qualified Prelude
#ifdef USE_PRELUDE
import qualified GHC.Exts as GHC
import qualified Streamly.Prelude as S
import qualified Streamly.Prelude as S
import qualified Prelude
#endif
import qualified Streamly.Internal.Data.Stream as Stream
import qualified Streamly.Internal.Data.Unfold as Unfold
import Gauge
import Streamly.Prelude (SerialT, fromSerial, MonadAsync)
import Streamly.Benchmark.Common
import Streamly.Internal.Data.Stream.Serial (SerialT)
#ifdef USE_PRELUDE
import Streamly.Benchmark.Prelude
import Streamly.Prelude (fromSerial, MonadAsync)
#endif
import qualified Stream.Common as SC
import System.IO.Unsafe (unsafeInterleaveIO)
import Prelude hiding (repeat, replicate, iterate)
-------------------------------------------------------------------------------
@ -31,7 +41,7 @@ import Prelude hiding (repeat, replicate, iterate)
-------------------------------------------------------------------------------
-- fromList
-------------------------------------------------------------------------------
#ifdef USE_PRELUDE
{-# INLINE sourceIsList #-}
sourceIsList :: Int -> Int -> SerialT Identity Int
sourceIsList value n = GHC.fromList [n..n+value]
@ -39,6 +49,7 @@ sourceIsList value n = GHC.fromList [n..n+value]
{-# INLINE sourceIsString #-}
sourceIsString :: Int -> Int -> SerialT Identity Char
sourceIsString value n = GHC.fromString (Prelude.replicate (n + value) 'a')
#endif
{-# INLINE readInstance #-}
readInstance :: String -> SerialT Identity Int
@ -57,6 +68,7 @@ readInstanceList str =
[(x,"")] -> x
_ -> error "readInstance: no parse"
#ifdef USE_PRELUDE
{-# INLINE repeat #-}
repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
repeat count = S.take count . S.repeat
@ -115,8 +127,8 @@ fromIndices value n = S.take value $ S.fromIndices (+ n)
fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))
o_1_space_generation :: Int -> [Benchmark]
o_1_space_generation value =
o_1_space_generation_prel :: Int -> [Benchmark]
o_1_space_generation_prel value =
[ bgroup "generation"
[ benchIOSrc fromSerial "unfoldr" (sourceUnfoldr value)
, benchIOSrc fromSerial "unfoldrM" (sourceUnfoldrM value)
@ -147,10 +159,42 @@ o_1_space_generation value =
-- These essentially test cons and consM
, benchIOSrc fromSerial "fromFoldable" (sourceFromFoldable value)
, benchIOSrc fromSerial "fromFoldableM" (sourceFromFoldableM value)
, benchIOSrc fromSerial "absTimes" $ absTimes value
]
]
#endif
{-# INLINE mfixUnfold #-}
mfixUnfold :: Int -> Int -> SerialT IO (Int, Int)
mfixUnfold count start = Stream.mfix f
where
f action = do
let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act
x <- Stream.unfold Unfold.fromListM [incr 1 action, incr 2 action]
y <- SC.sourceUnfoldr count start
return (x, y)
{-# INLINE fromFoldable #-}
fromFoldable :: Int -> Int -> SerialT m Int
fromFoldable count start =
Stream.fromFoldable (Prelude.enumFromTo count start)
{-# INLINE fromFoldableM #-}
fromFoldableM :: Monad m => Int -> Int -> SerialT m Int
fromFoldableM count start =
Stream.fromFoldableM (fmap return (Prelude.enumFromTo count start))
o_1_space_generation :: Int -> [Benchmark]
o_1_space_generation value =
[ bgroup "generation"
[ SC.benchIOSrc "unfold" (SC.sourceUnfoldr value)
, SC.benchIOSrc "fromFoldable" (fromFoldable value)
, SC.benchIOSrc "fromFoldableM" (fromFoldableM value)
, SC.benchIOSrc "mfix_10" (mfixUnfold 10)
, SC.benchIOSrc "mfix_100" (mfixUnfold 100)
, SC.benchIOSrc "mfix_1000" (mfixUnfold 1000)
]
]
o_n_heap_generation :: Int -> [Benchmark]
o_n_heap_generation value =
@ -174,6 +218,11 @@ o_n_heap_generation value =
--
benchmarks :: String -> Int -> [Benchmark]
benchmarks moduleName size =
[ bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
[
#ifdef USE_PRELUDE
bgroup (o_1_space_prefix moduleName) (o_1_space_generation_prel size)
,
#endif
bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
, bgroup (o_n_heap_prefix moduleName) (o_n_heap_generation size)
]

76
benchmark/Streamly/Benchmark/Prelude/Serial/Lift.hs → benchmark/Streamly/Benchmark/Data/Stream/Lift.hs
View File

@ -1,5 +1,5 @@
-- |
-- Module : Serial.Lift
-- Module : Stream.Lift
-- Copyright : (c) 2018 Composewell Technologies
-- License : BSD-3-Clause
-- Maintainer : streamly@composewell.com
@ -9,29 +9,38 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
module Serial.Lift (benchmarks) where
module Stream.Lift (benchmarks) where
import Control.Monad.State.Strict (StateT, get, put, MonadState)
import qualified Control.Monad.State.Strict as State
#ifdef USE_PRELUDE
import Control.Monad.Trans.Class (lift)
import qualified Streamly.Prelude as S
import Control.Monad.State.Strict (StateT, get, put, MonadState)
import Streamly.Prelude (fromSerial)
import Streamly.Benchmark.Prelude
import qualified Control.Monad.State.Strict as State
import qualified Streamly.Prelude as Stream
import qualified Streamly.Internal.Data.Stream.IsStream as Internal
#else
import Control.DeepSeq (NFData(..))
import Data.Functor.Identity (Identity)
import Stream.Common (sourceUnfoldr, sourceUnfoldrM, benchIOSrc)
import System.Random (randomRIO)
import qualified Streamly.Internal.Data.Stream as Stream
#endif
import Gauge
import Streamly.Prelude (SerialT, fromSerial)
import Streamly.Internal.Data.Stream.Serial (SerialT)
import Streamly.Benchmark.Common
import Streamly.Benchmark.Prelude
import Prelude hiding (reverse, tail)
-------------------------------------------------------------------------------
-- Monad transformation (hoisting etc.)
-------------------------------------------------------------------------------
#ifdef USE_PRELUDE
{-# INLINE sourceUnfoldrState #-}
sourceUnfoldrState :: (S.IsStream t, S.MonadAsync m)
sourceUnfoldrState :: (Stream.IsStream t, Stream.MonadAsync m)
=> Int -> Int -> t (StateT Int m) Int
sourceUnfoldrState value n = S.unfoldrM step n
sourceUnfoldrState value n = Stream.unfoldrM step n
where
step cnt =
if cnt > n + value
@ -42,12 +51,12 @@ sourceUnfoldrState value n = S.unfoldrM step n
return (Just (s, cnt + 1))
{-# INLINE evalStateT #-}
evalStateT :: S.MonadAsync m => Int -> Int -> SerialT m Int
evalStateT :: Stream.MonadAsync m => Int -> Int -> SerialT m Int
evalStateT value n =
Internal.evalStateT (return 0) (sourceUnfoldrState value n)
{-# INLINE withState #-}
withState :: S.MonadAsync m => Int -> Int -> SerialT m Int
withState :: Stream.MonadAsync m => Int -> Int -> SerialT m Int
withState value n =
Internal.evalStateT
(return (0 :: Int)) (Internal.liftInner (sourceUnfoldrM value n))
@ -62,7 +71,7 @@ o_1_space_hoisting value =
{-# INLINE iterateStateIO #-}
iterateStateIO ::
(S.MonadAsync m)
(Stream.MonadAsync m)
=> Int
-> StateT Int m Int
iterateStateIO n = do
@ -86,7 +95,7 @@ iterateStateT n = do
{-# INLINE iterateState #-}
{-# SPECIALIZE iterateState :: Int -> SerialT (StateT Int IO) Int #-}
iterateState ::
(S.MonadAsync m, MonadState Int m)
(Stream.MonadAsync m, MonadState Int m)
=> Int
-> SerialT m Int
iterateState n = do
@ -103,12 +112,38 @@ o_n_heap_transformer value =
[ benchIO "StateT Int IO (n times) (baseline)" $ \n ->
State.evalStateT (iterateStateIO n) value
, benchIO "SerialT (StateT Int IO) (n times)" $ \n ->
State.evalStateT (S.drain (iterateStateT n)) value
State.evalStateT (Stream.drain (iterateStateT n)) value
, benchIO "MonadState Int m => SerialT m Int" $ \n ->
State.evalStateT (S.drain (iterateState n)) value
State.evalStateT (Stream.drain (iterateState n)) value
]
]
#else
{-# INLINE benchHoistSink #-}
benchHoistSink
:: (NFData b)
=> Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
benchHoistSink value name f =
bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
-- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but
-- we can't use it as it requires MonadAsync constraint.
{-# INLINE liftInner #-}
liftInner :: Monad m => Int -> Int -> SerialT m Int
liftInner value n =
Stream.evalStateT
(return (0 :: Int)) (Stream.liftInner (sourceUnfoldrM value n))
o_1_space_generation :: Int -> [Benchmark]
o_1_space_generation value =
[ bgroup "lift"
[ benchHoistSink value "length . generally"
((\(_ :: SerialT IO Int) -> return 8 :: IO Int) . Stream.generally)
, benchIOSrc "liftInner/evalStateT" (liftInner value)
]
]
#endif
-------------------------------------------------------------------------------
-- Main
-------------------------------------------------------------------------------
@ -118,6 +153,11 @@ o_n_heap_transformer value =
--
benchmarks :: String -> Int -> [Benchmark]
benchmarks moduleName size =
[ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)
[
#ifdef USE_PRELUDE
bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)
, bgroup (o_n_heap_prefix moduleName) (o_n_heap_transformer size)
#else
bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
#endif
]

4
benchmark/Streamly/Benchmark/Prelude/Serial/NestedFold.hs → benchmark/Streamly/Benchmark/Data/Stream/NestedFold.hs
View File

@ -1,5 +1,5 @@
-- |
-- Module : Serial.NestedFold
-- Module : Stream.NestedFold
-- Copyright : (c) 2018 Composewell Technologies
-- License : BSD-3-Clause
-- Maintainer : streamly@composewell.com
@ -11,7 +11,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RankNTypes #-}
module Serial.NestedFold (benchmarks) where
module Stream.NestedFold (benchmarks) where
import Control.DeepSeq (NFData(..))
import Control.Monad (when)

6
benchmark/Streamly/Benchmark/Prelude/Serial/NestedStream.hs → benchmark/Streamly/Benchmark/Data/Stream/NestedStream.hs
View File

@ -1,5 +1,5 @@
-- |
-- Module : Serial.NestedStream
-- Module : Stream.NestedStream
-- Copyright : (c) 2018 Composewell Technologies
-- License : BSD-3-Clause
-- Maintainer : streamly@composewell.com
@ -18,7 +18,7 @@
{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
#endif
module Serial.NestedStream (benchmarks) where
module Stream.NestedStream (benchmarks) where
import Control.Monad.Trans.Class (lift)
@ -356,7 +356,7 @@ o_n_space_applicative value =
[ benchIOSrc fromSerial "(*>) (n times)" $
iterateSingleton ((*>) . pure) value
, benchIOSrc fromSerial "(<*) (n times)" $
iterateSingleton (\x xs -> xs <* pure x) value
iterateSingleton (\x xs -> xs <* pure x) value
, benchIOSrc fromSerial "(<*>) (n times)" $
iterateSingleton (\x xs -> pure (+ x) <*> xs) value
, benchIOSrc fromSerial "liftA2 (n times)" $

124
benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs Normal file
View File

@ -0,0 +1,124 @@
-- |
-- Module : Stream.Reduce
-- Copyright : (c) 2018 Composewell Technologies
-- License : BSD-3-Clause
-- Maintainer : streamly@composewell.com
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
module Stream.Reduce (benchmarks) where
import Control.Monad.Catch (MonadCatch)
import Data.Monoid (Sum(Sum), getSum)
import Stream.Common (benchIOSink)
import Streamly.Benchmark.Common (o_1_space_prefix)
import Streamly.Internal.Data.Stream (Stream)
import qualified Streamly.Internal.Data.Stream as Stream
import qualified Streamly.Internal.Data.Parser as PR
import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),
lookup, repeat, minimum, maximum, product, last, mapM_, init)
import Gauge
import qualified Streamly.Data.Fold as FL
import qualified Streamly.Internal.Data.Refold.Type as Refold
import Control.Monad.IO.Class (MonadIO)
{-# INLINE foldMany #-}
foldMany :: Monad m => Stream m Int -> m ()
foldMany =
Stream.fold FL.drain
. fmap getSum
. Stream.foldMany (FL.take 2 FL.mconcat)
. fmap Sum
{-# INLINE foldManyPost #-}
foldManyPost :: Monad m => Stream m Int -> m ()
foldManyPost =
Stream.fold FL.drain
. fmap getSum
. Stream.foldManyPost (FL.take 2 FL.mconcat)
. fmap Sum
{-# INLINE refoldMany #-}
refoldMany :: Monad m => Stream m Int -> m ()
refoldMany =
Stream.fold FL.drain
. fmap getSum
. Stream.refoldMany (Refold.take 2 Refold.sconcat) (return mempty)
. fmap Sum
{-# INLINE foldIterateM #-}
foldIterateM :: Monad m => Stream m Int -> m ()
foldIterateM =
Stream.fold FL.drain
. fmap getSum
. Stream.foldIterateM
(return . FL.take 2 . FL.sconcat) (return (Sum 0))
. fmap Sum
{-# INLINE refoldIterateM #-}
refoldIterateM :: Monad m => Stream m Int -> m ()
refoldIterateM =
Stream.fold FL.drain
. fmap getSum
. Stream.refoldIterateM
(Refold.take 2 Refold.sconcat) (return (Sum 0))
. fmap Sum
{-# INLINE parseMany #-}
parseMany :: MonadCatch m => Int -> Stream m Int -> m ()
parseMany n =
Stream.fold FL.drain
. fmap getSum
. Stream.parseMany (PR.fromFold $ FL.take n FL.mconcat)
. fmap Sum
{-# INLINE parseManyD #-}
parseManyD :: MonadCatch m => Int -> Stream m Int -> m ()
parseManyD n =
Stream.fold FL.drain
. fmap getSum
. Stream.parseManyD (ParserD.fromFold $ FL.take n FL.mconcat)
. fmap Sum
{-# INLINE parseIterate #-}
parseIterate :: MonadCatch m => Int -> Stream m Int -> m ()
parseIterate n =
Stream.fold FL.drain
. fmap getSum
. Stream.parseIterate (\_ -> PR.fromFold $ FL.take n FL.mconcat) 0
. fmap Sum
{-# INLINE arraysOf #-}
arraysOf :: (MonadCatch m, MonadIO m) => Int -> Stream m Int -> m ()
arraysOf n =
Stream.fold FL.drain
. Stream.arraysOf n
o_1_space_grouping :: Int -> [Benchmark]
o_1_space_grouping value =
-- Buffering operations using heap proportional to group/window sizes.
[ bgroup "reduce"
[ benchIOSink value "foldMany" foldMany
, benchIOSink value "foldManyPost" foldManyPost
, benchIOSink value "refoldMany" refoldMany
, benchIOSink value "foldIterateM" foldIterateM
, benchIOSink value "refoldIterateM" refoldIterateM
, benchIOSink value "parseMany" $ parseMany value
, benchIOSink value "parseManyD" $ parseManyD value
, benchIOSink value "parseIterate" $ parseIterate value
, benchIOSink value "arraysOf" $ arraysOf value
]
]
benchmarks :: String -> Int -> [Benchmark]
benchmarks moduleName size =
[ bgroup (o_1_space_prefix moduleName) $ o_1_space_grouping size
]

4
benchmark/Streamly/Benchmark/Prelude/Serial/Split.hs → benchmark/Streamly/Benchmark/Data/Stream/Split.hs
View File

@ -1,5 +1,5 @@
-- |
-- Module : Streamly.Benchmark.Prelude.Serial.Split
-- Module : Stream.Split
-- Copyright : (c) 2019 Composewell Technologies
-- License : BSD-3-Clause
-- Maintainer : streamly@composewell.com
@ -18,7 +18,7 @@
{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
#endif
module Serial.Split (benchmarks) where
module Stream.Split (benchmarks) where
import Data.Char (ord)
import Data.Word (Word8)

288
benchmark/Streamly/Benchmark/Prelude/Serial/Transformation.hs → benchmark/Streamly/Benchmark/Data/Stream/Transformation.hs
View File

@ -1,5 +1,5 @@
-- |
-- Module : Serial.Transformation
-- Module : Stream.Transformation
-- Copyright : (c) 2018 Composewell Technologies
-- License : BSD-3-Clause
-- Maintainer : streamly@composewell.com
@ -18,29 +18,35 @@
{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
#endif
module Serial.Transformation (benchmarks) where
module Stream.Transformation (benchmarks) where
import Control.DeepSeq (NFData(..))
import Control.Monad.IO.Class (MonadIO(..))
import Data.Functor.Identity (Identity)
import System.Random (randomRIO)
#ifdef INSPECTION
import Test.Inspection
#endif
import qualified Streamly.Prelude as S
import qualified Streamly.Internal.Data.Stream as Stream
import qualified Streamly.Internal.Data.Stream.IsStream as Internal
import qualified Streamly.Internal.Data.Fold as FL
import qualified Streamly.Internal.Data.Unfold as Unfold
import qualified Prelude
import Gauge
import Streamly.Prelude (SerialT, fromSerial, MonadAsync)
import Streamly.Benchmark.Common
#ifdef USE_PRELUDE
import Streamly.Prelude (fromSerial, MonadAsync)
import Streamly.Benchmark.Prelude
import Streamly.Internal.Data.Time.Units
import qualified Streamly.Benchmark.Prelude as BP
import qualified Streamly.Prelude as S
import qualified Streamly.Internal.Data.Stream.IsStream as Internal
import qualified Streamly.Internal.Data.Unfold as Unfold
#else
import Control.DeepSeq (NFData(..))
import Data.Functor.Identity (Identity)
import Stream.Common
import qualified Streamly.Internal.Data.Stream as Stream
import qualified Streamly.Internal.Data.Stream as S
import qualified Streamly.Internal.Data.Stream as Internal
import qualified Prelude
#endif
import Gauge
import Streamly.Internal.Data.Stream.Serial (SerialT)
import Streamly.Benchmark.Common
import Prelude hiding (sequence, mapM, fmap)
-------------------------------------------------------------------------------
@ -54,7 +60,7 @@ import Prelude hiding (sequence, mapM, fmap)
-------------------------------------------------------------------------------
-- Traversable Instance
-------------------------------------------------------------------------------
#ifndef USE_PRELUDE
{-# INLINE traversableTraverse #-}
traversableTraverse :: SerialT Identity Int -> IO (SerialT Identity Int)
traversableTraverse = traverse return
@ -89,42 +95,69 @@ o_n_space_traversable value =
, benchPureSinkIO value "sequence" traversableSequence
]
]
#endif
#ifdef USE_PRELUDE
{-# INLINE composeNG #-}
composeNG ::
(S.IsStream t, Monad m)
=> Int
-> (t m Int -> S.SerialT m Int)
-> t m Int
-> m ()
composeNG = BP.composeN
#else
{-# INLINE composeNG #-}
composeNG ::
(Monad m)
=> Int
-> (SerialT m Int -> SerialT m Int)
-> SerialT m Int
-> m ()
composeNG _n = return $ Stream.fold FL.drain
#endif
-------------------------------------------------------------------------------
-- maps and scans
-------------------------------------------------------------------------------
{-# INLINE scanl' #-}
scanl' :: MonadIO m => Int -> SerialT m Int -> m ()
scanl' n = composeN n $ S.scanl' (+) 0
{-# INLINE scanlM' #-}
scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
scanlM' n = composeN n $ S.scanlM' (\b a -> return $ b + a) (return 0)
{-# INLINE scanl1' #-}
scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()
scanl1' n = composeN n $ S.scanl1' (+)
{-# INLINE scanl1M' #-}
scanl1M' :: MonadIO m => Int -> SerialT m Int -> m ()
scanl1M' n = composeN n $ S.scanl1M' (\b a -> return $ b + a)
{-# INLINE scan #-}
scan :: MonadIO m => Int -> SerialT m Int -> m ()
scan n = composeN n $ S.scan FL.sum
scan n = composeNG n $ S.scan FL.sum
{-# INLINE tap #-}
tap :: MonadIO m => Int -> SerialT m Int -> m ()
tap n = composeNG n $ S.tap FL.sum
#ifdef USE_PRELUDE
{-# INLINE scanl' #-}
scanl' :: MonadIO m => Int -> SerialT m Int -> m ()
scanl' n = composeNG n $ S.scanl' (+) 0
{-# INLINE scanlM' #-}
scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
scanlM' n = composeNG n $ S.scanlM' (\b a -> return $ b + a) (return 0)
{-# INLINE scanl1' #-}
scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()
scanl1' n = composeNG n $ S.scanl1' (+)
{-# INLINE scanl1M' #-}
scanl1M' :: MonadIO m => Int -> SerialT m Int -> m ()
scanl1M' n = composeNG n $ S.scanl1M' (\b a -> return $ b + a)
{-# INLINE postscanl' #-}
postscanl' :: MonadIO m => Int -> SerialT m Int -> m ()
postscanl' n = composeN n $ S.postscanl' (+) 0
postscanl' n = composeNG n $ S.postscanl' (+) 0
{-# INLINE postscanlM' #-}
postscanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
postscanlM' n = composeN n $ S.postscanlM' (\b a -> return $ b + a) (return 0)
postscanlM' n = composeNG n $ S.postscanlM' (\b a -> return $ b + a) (return 0)
{-# INLINE postscan #-}
postscan :: MonadIO m => Int -> SerialT m Int -> m ()
postscan n = composeN n $ S.postscan FL.sum
postscan n = composeNG n $ S.postscan FL.sum
{-# INLINE sequence #-}
sequence ::
@ -134,10 +167,6 @@ sequence ::
-> m ()
sequence t = S.drain . t . S.sequence
{-# INLINE tap #-}
tap :: MonadIO m => Int -> SerialT m Int -> m ()
tap n = composeN n $ S.tap FL.sum
{-# INLINE pollCounts #-}
pollCounts :: Int -> SerialT IO Int -> IO ()
pollCounts n =
@ -151,26 +180,26 @@ pollCounts n =
timestamped :: (S.MonadAsync m) => SerialT m Int -> m ()
timestamped = S.drain . Internal.timestamped
{-# INLINE trace #-}
trace :: MonadAsync m => Int -> SerialT m Int -> m ()
trace n = composeNG n $ Internal.trace return
#endif
{-# INLINE foldrS #-}
foldrS :: MonadIO m => Int -> SerialT m Int -> m ()
foldrS n = composeN n $ Internal.foldrS S.cons S.nil
foldrS n = composeNG n $ Internal.foldrS S.cons S.nil
{-# INLINE foldrSMap #-}
foldrSMap :: MonadIO m => Int -> SerialT m Int -> m ()
foldrSMap n = composeN n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
foldrSMap n = composeNG n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
{-# INLINE foldrT #-}
foldrT :: MonadIO m => Int -> SerialT m Int -> m ()
foldrT n = composeN n $ Internal.foldrT S.cons S.nil
foldrT n = composeNG n $ Internal.foldrT S.cons S.nil
{-# INLINE foldrTMap #-}
foldrTMap :: MonadIO m => Int -> SerialT m Int -> m ()
foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
{-# INLINE trace #-}
trace :: MonadAsync m => Int -> SerialT m Int -> m ()
trace n = composeN n $ Internal.trace return
foldrTMap n = composeNG n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
o_1_space_mapping :: Int -> [Benchmark]
o_1_space_mapping value =
@ -182,13 +211,13 @@ o_1_space_mapping value =
, benchIOSink value "foldrSMap" (foldrSMap 1)
, benchIOSink value "foldrT" (foldrT 1)
, benchIOSink value "foldrTMap" (foldrTMap 1)
#ifdef USE_PRELUDE
-- Mapping
, benchIOSink value "map" (mapN fromSerial 1)
, bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
sequence fromSerial (sourceUnfoldrAction value n)
, benchIOSink value "mapM" (mapM fromSerial 1)
, benchIOSink value "tap" (tap 1)
, benchIOSink value "pollCounts 1 second" (pollCounts 1)
, benchIOSink value "timestamped" timestamped
@ -199,12 +228,15 @@ o_1_space_mapping value =
, benchIOSink value "scanl1M'" (scanl1M' 1)
, benchIOSink value "postscanl'" (postscanl' 1)
, benchIOSink value "postscanlM'" (postscanlM' 1)
, benchIOSink value "scan" (scan 1)
, benchIOSink value "postscan" (postscan 1)
#endif
, benchIOSink value "scan" (scan 1)
, benchIOSink value "tap" (tap 1)
]
]
#ifdef USE_PRELUDE
o_1_space_mappingX4 :: Int -> [Benchmark]
o_1_space_mappingX4 value =
[ bgroup "mappingX4"
@ -218,10 +250,10 @@ o_1_space_mappingX4 value =
, benchIOSink value "scanl1M'" (scanl1M' 4)
, benchIOSink value "postscanl'" (postscanl' 4)
, benchIOSink value "postscanlM'" (postscanlM' 4)
]
]
{-# INLINE sieveScan #-}
sieveScan :: Monad m => SerialT m Int -> SerialT m Int
sieveScan =
@ -252,85 +284,89 @@ o_1_space_functor value =
, benchIOSink value "fmap x 4" (fmapN fromSerial 4)
]
]
#else
{-# INLINE foldFilterEven #-}
foldFilterEven :: MonadIO m => SerialT m Int -> m ()
foldFilterEven = Stream.fold FL.drain . Stream.foldFilter (FL.satisfy even)
#endif
-------------------------------------------------------------------------------
-- Size reducing transformations (filtering)
-------------------------------------------------------------------------------
{-# INLINE filterEven #-}
filterEven :: MonadIO m => Int -> SerialT m Int -> m ()
filterEven n = composeN n $ S.filter even
filterEven n = composeNG n $ S.filter even
{-# INLINE filterAllOut #-}
filterAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
filterAllOut value n = composeN n $ S.filter (> (value + 1))
filterAllOut value n = composeNG n $ S.filter (> (value + 1))
{-# INLINE filterAllIn #-}
filterAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
filterAllIn value n = composeN n $ S.filter (<= (value + 1))
filterAllIn value n = composeNG n $ S.filter (<= (value + 1))
{-# INLINE filterMEven #-}
filterMEven :: MonadIO m => Int -> SerialT m Int -> m ()
filterMEven n = composeN n $ S.filterM (return . even)
filterMEven n = composeNG n $ S.filterM (return . even)
{-# INLINE filterMAllOut #-}
filterMAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
filterMAllOut value n = composeN n $ S.filterM (\x -> return $ x > (value + 1))
filterMAllOut value n = composeNG n $ S.filterM (\x -> return $ x > (value + 1))
{-# INLINE filterMAllIn #-}
filterMAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
filterMAllIn value n = composeN n $ S.filterM (\x -> return $ x <= (value + 1))
{-# INLINE foldFilterEven #-}
foldFilterEven :: MonadIO m => Int -> SerialT m Int -> m ()
foldFilterEven n = composeN n $ Stream.foldFilter (FL.satisfy even)
filterMAllIn value n = composeNG n $ S.filterM (\x -> return $ x <= (value + 1))
{-# INLINE _takeOne #-}
_takeOne :: MonadIO m => Int -> SerialT m Int -> m ()
_takeOne n = composeN n $ S.take 1
_takeOne n = composeNG n $ S.take 1
{-# INLINE takeAll #-}
takeAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
takeAll value n = composeN n $ S.take (value + 1)
takeAll value n = composeNG n $ S.take (value + 1)
{-# INLINE takeWhileTrue #-}
takeWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
takeWhileTrue value n = composeN n $ S.takeWhile (<= (value + 1))
takeWhileTrue value n = composeNG n $ S.takeWhile (<= (value + 1))
{-# INLINE takeWhileMTrue #-}
takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))
takeWhileMTrue value n = composeNG n $ S.takeWhileM (return . (<= (value + 1)))
#ifdef USE_PRELUDE
{-# INLINE takeInterval #-}
takeInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
takeInterval i n = composeN n (Internal.takeInterval i)
#ifdef INSPECTION
-- inspect $ hasNoType 'takeInterval ''SPEC
inspect $ hasNoTypeClasses 'takeInterval
-- inspect $ 'takeInterval `hasNoType` ''D.Step
#endif
#endif
{-# INLINE dropOne #-}
dropOne :: MonadIO m => Int -> SerialT m Int -> m ()
dropOne n = composeN n $ S.drop 1
dropOne n = composeNG n $ S.drop 1
{-# INLINE dropAll #-}
dropAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
dropAll value n = composeN n $ S.drop (value + 1)
dropAll value n = composeNG n $ S.drop (value + 1)
{-# INLINE dropWhileTrue #-}
dropWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
dropWhileTrue value n = composeN n $ S.dropWhile (<= (value + 1))
dropWhileTrue value n = composeNG n $ S.dropWhile (<= (value + 1))
{-# INLINE dropWhileMTrue #-}
dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))
dropWhileMTrue value n = composeNG n $ S.dropWhileM (return . (<= (value + 1)))
{-# INLINE dropWhileFalse #-}
dropWhileFalse :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
dropWhileFalse value n = composeN n $ S.dropWhile (> (value + 1))
dropWhileFalse value n = composeNG n $ S.dropWhile (> (value + 1))
#ifdef USE_PRELUDE
-- XXX Decide on the time interval
{-# INLINE _intervalsOfSum #-}
_intervalsOfSum :: MonadAsync m => Double -> Int -> SerialT m Int -> m ()
@ -344,28 +380,30 @@ dropInterval i n = composeN n (Internal.dropInterval i)
inspect $ hasNoTypeClasses 'dropInterval
-- inspect $ 'dropInterval `hasNoType` ''D.Step
#endif
#endif
{-# INLINE findIndices #-}
findIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
findIndices value n = composeN n $ S.findIndices (== (value + 1))
findIndices value n = composeNG n $ S.findIndices (== (value + 1))
{-# INLINE elemIndices #-}
elemIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
elemIndices value n = composeN n $ S.elemIndices (value + 1)
elemIndices value n = composeNG n $ S.elemIndices (value + 1)
{-# INLINE deleteBy #-}
deleteBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
deleteBy value n = composeN n $ S.deleteBy (>=) (value + 1)
deleteBy value n = composeNG n $ S.deleteBy (>=) (value + 1)
-- uniq . uniq == uniq, composeN 2 ~ composeN 1
{-# INLINE uniq #-}
uniq :: MonadIO m => Int -> SerialT m Int -> m ()
uniq n = composeN n S.uniq
uniq n = composeNG n S.uniq
#ifdef USE_PRELUDE
{-# INLINE mapMaybe #-}
mapMaybe :: MonadIO m => Int -> SerialT m Int -> m ()
mapMaybe n =
composeN n $
composeNG n $
S.mapMaybe
(\x ->
if odd x
@ -375,12 +413,13 @@ mapMaybe n =
{-# INLINE mapMaybeM #-}
mapMaybeM :: S.MonadAsync m => Int -> SerialT m Int -> m ()
mapMaybeM n =
composeN n $
composeNG n $
S.mapMaybeM
(\x ->
if odd x
then return Nothing
else return $ Just x)
#endif
o_1_space_filtering :: Int -> [Benchmark]
o_1_space_filtering value =
@ -392,23 +431,26 @@ o_1_space_filtering value =
, benchIOSink value "filterM-even" (filterMEven 1)
, benchIOSink value "filterM-all-out" (filterMAllOut value 1)
, benchIOSink value "filterM-all-in" (filterMAllIn value 1)
, benchIOSink value "foldFilter-even" (foldFilterEven 1)
#ifndef USE_PRELUDE
, benchIOSink value "foldFilter-even" foldFilterEven
#endif
-- Trimming
, benchIOSink value "take-all" (takeAll value 1)
, benchIOSink
value
"takeInterval-all"
(takeInterval (NanoSecond64 maxBound) 1)
, benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
-- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)
, benchIOSink value "drop-one" (dropOne 1)
, benchIOSink value "drop-all" (dropAll value 1)
#ifdef USE_PRELUDE
, benchIOSink
value
"takeInterval-all"
(takeInterval (NanoSecond64 maxBound) 1)
, benchIOSink
value
"dropInterval-all"
(dropInterval (NanoSecond64 maxBound) 1)
#endif
, benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
-- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)
, benchIOSink
@ -418,17 +460,18 @@ o_1_space_filtering value =
, benchIOSink value "deleteBy" (deleteBy value 1)
, benchIOSink value "uniq" (uniq 1)
#ifdef USE_PRELUDE
-- Map and filter
, benchIOSink value "mapMaybe" (mapMaybe 1)
, benchIOSink value "mapMaybeM" (mapMaybeM 1)
#endif
-- Searching (stateful map and filter)
, benchIOSink value "findIndices" (findIndices value 1)
, benchIOSink value "elemIndices" (elemIndices value 1)
]
]
o_1_space_filteringX4 :: Int -> [Benchmark]
o_1_space_filteringX4 value =
[ bgroup "filteringX4"
@ -440,7 +483,7 @@ o_1_space_filteringX4 value =
, benchIOSink value "filterM-all-out" (filterMAllOut value 4)
, benchIOSink value "filterM-all-in" (filterMAllIn value 4)
, benchIOSink value "foldFilter-even" (foldFilterEven 4)
--, benchIOSink value "foldFilter-even" (foldFilterEven 4)
-- trimming
, benchIOSink value "take-all" (takeAll value 4)
@ -458,10 +501,11 @@ o_1_space_filteringX4 value =
, benchIOSink value "uniq" (uniq 4)
#ifdef USE_PRELUDE
-- map and filter
, benchIOSink value "mapMaybe" (mapMaybe 4)
, benchIOSink value "mapMaybeM" (mapMaybeM 4)
#endif
-- searching
, benchIOSink value "findIndices" (findIndices value 4)
, benchIOSink value "elemIndices" (elemIndices value 4)
@ -471,28 +515,29 @@ o_1_space_filteringX4 value =
-------------------------------------------------------------------------------
-- Size increasing transformations (insertions)
-------------------------------------------------------------------------------
#ifdef USE_PRELUDE
{-# INLINE intersperse #-}
intersperse :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
intersperse value n = composeN n $ S.intersperse (value + 1)
intersperse value n = composeNG n $ S.intersperse (value + 1)
{-# INLINE intersperseM #-}
intersperseM :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
intersperseM value n = composeN n $ S.intersperseM (return $ value + 1)
{-# INLINE insertBy #-}
insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
insertBy value n = composeN n $ S.insertBy compare (value + 1)
intersperseM value n = composeNG n $ S.intersperseM (return $ value + 1)
{-# INLINE interposeSuffix #-}
interposeSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
interposeSuffix value n =
composeN n $ Internal.interposeSuffix (value + 1) Unfold.identity
composeNG n $ Internal.interposeSuffix (value + 1) Unfold.identity
{-# INLINE intercalateSuffix #-}
intercalateSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
intercalateSuffix value n =
composeN n $ Internal.intercalateSuffix Unfold.identity (value + 1)
composeNG n $ Internal.intercalateSuffix Unfold.identity (value + 1)
{-# INLINE insertBy #-}
insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
insertBy value n = composeNG n $ S.insertBy compare (value + 1)
o_1_space_inserting :: Int -> [Benchmark]
o_1_space_inserting value =
@ -509,14 +554,14 @@ o_1_space_insertingX4 :: Int -> [Benchmark]
o_1_space_insertingX4 value =
[ bgroup "insertingX4"
[ benchIOSink value "intersperse" (intersperse value 4)
, benchIOSink value "insertBy" (insertBy value 4)
-- , benchIOSink value "insertBy" (insertBy value 4)
]
]
#endif
-------------------------------------------------------------------------------
-- Indexing
-------------------------------------------------------------------------------
#ifdef USE_PRELUDE
{-# INLINE indexed #-}
indexed :: MonadIO m => Int -> SerialT m Int -> m ()
indexed n = composeN n (S.map snd . S.indexed)
@ -541,6 +586,24 @@ o_1_space_indexingX4 value =
]
]
#else
{-# INLINE indexed #-}
indexed :: MonadIO m => SerialT m Int -> m ()
indexed = Stream.fold FL.drain . Prelude.fmap snd . Stream.indexed
{-# INLINE indexedR #-}
indexedR :: MonadIO m => Int -> SerialT m Int -> m ()
indexedR value = Stream.fold FL.drain . (Prelude.fmap snd . Stream.indexedR value)
o_1_space_indexing :: Int -> [Benchmark]
o_1_space_indexing value =
[ bgroup "indexing"
[ benchIOSink value "indexed" indexed
, benchIOSink value "indexedR" (indexedR value)
]
]
#endif
-------------------------------------------------------------------------------
-- Main
-------------------------------------------------------------------------------
@ -551,18 +614,23 @@ o_1_space_indexingX4 value =
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_mapping size
, o_1_space_indexing size
, o_1_space_filtering size
, o_1_space_filteringX4 size
#ifdef USE_PRELUDE
, o_1_space_functor size
, o_1_space_mappingX4 size
, o_1_space_inserting size
, o_1_space_insertingX4 size
, o_1_space_indexing size
, o_1_space_indexingX4 size
#endif
]
, bgroup (o_n_space_prefix moduleName) $ Prelude.concat
[ o_n_space_traversable size
, o_n_space_mapping size
]
, bgroup (o_n_space_prefix moduleName) $
#ifdef USE_PRELUDE
o_n_space_mapping size
#else
o_n_space_traversable size
#endif
]

18
benchmark/bench-runner/Main.hs
View File

@ -35,22 +35,22 @@ rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific]
`isPrefixOf` benchName = "-K2M -M256M"
| "Prelude.Rate/o-1-space." `isPrefixOf` benchName = "-K128K"
| "Prelude.Rate/o-1-space.asyncly." `isPrefixOf` benchName = "-K128K"
| "Prelude.Serial/o-1-space.mixed.sum-product-fold" == benchName =
| "Data.Stream/o-1-space.mixed.sum-product-fold" == benchName =
"-K64M"
| "Prelude.Serial/o-n-heap.grouping.classifySessionsOf"
| "Data.Stream/o-n-heap.grouping.classifySessionsOf"
`isPrefixOf` benchName = "-K1M -M32M"
| "Prelude.Serial/o-n-heap.Functor." `isPrefixOf` benchName =
| "Data.Stream/o-n-heap.Functor." `isPrefixOf` benchName =
"-K4M -M32M"
| "Prelude.Serial/o-n-heap.transformer." `isPrefixOf` benchName =
| "Data.Stream/o-n-heap.transformer." `isPrefixOf` benchName =
"-K8M -M64M"
| "Prelude.Serial/o-n-space.Functor." `isPrefixOf` benchName =
| "Data.Stream/o-n-space.Functor." `isPrefixOf` benchName =
"-K4M -M64M"
| "Prelude.Serial/o-n-space.Applicative." `isPrefixOf` benchName =
| "Data.Stream/o-n-space.Applicative." `isPrefixOf` benchName =
"-K8M -M128M"
| "Prelude.Serial/o-n-space.Monad." `isPrefixOf` benchName =
| "Data.Stream/o-n-space.Monad." `isPrefixOf` benchName =
"-K8M -M64M"
| "Prelude.Serial/o-n-space.grouping." `isPrefixOf` benchName = ""
| "Prelude.Serial/o-n-space." `isPrefixOf` benchName = "-K4M"
| "Data.Stream/o-n-space.grouping." `isPrefixOf` benchName = ""
| "Data.Stream/o-n-space." `isPrefixOf` benchName = "-K4M"
| "Prelude.WSerial/o-n-space." `isPrefixOf` benchName = "-K4M"
| "Prelude.Async/o-n-space.monad-outer-product." `isPrefixOf` benchName =
"-K4M"

63
benchmark/streamly-benchmarks.cabal
View File

@ -64,6 +64,10 @@ flag bench-core
manual: True
default: False
flag use-prelude
description: Use Streamly.Prelude instead of Streamly.Data.Stream for serial benchmarks
manual: True
default: False
-------------------------------------------------------------------------------
-- Common stanzas
-------------------------------------------------------------------------------
@ -71,6 +75,9 @@ flag bench-core
common compile-options
default-language: Haskell2010
if flag(use-prelude)
cpp-options: -DUSE_PRELUDE
if flag(dev)
cpp-options: -DDEVBUILD
@ -201,31 +208,6 @@ common bench-options-threaded
-- Serial Streams
-------------------------------------------------------------------------------
benchmark Prelude.Serial
import: bench-options
type: exitcode-stdio-1.0
hs-source-dirs: Streamly/Benchmark/Prelude
main-is: Serial.hs
other-modules:
Serial.Generation
, Serial.Elimination
, Serial.Transformation
, Serial.NestedStream
, Serial.NestedFold
, Serial.Split
, Serial.Exceptions
, Serial.Lift
if flag(bench-core) || impl(ghcjs)
buildable: False
else
buildable: True
if flag(limit-build-mem)
if flag(dev)
ghc-options: +RTS -M3500M -RTS
else
ghc-options: +RTS -M2500M -RTS
benchmark Prelude.WSerial
import: bench-options
type: exitcode-stdio-1.0
@ -405,6 +387,37 @@ benchmark Data.Parser
-------------------------------------------------------------------------------
-- Raw Streams
-------------------------------------------------------------------------------
benchmark Data.Stream
import: bench-options
type: exitcode-stdio-1.0
hs-source-dirs: Streamly/Benchmark/Data
main-is: Stream.hs
other-modules:
Stream.Eliminate
Stream.Exceptions
Stream.Generate
Stream.Lift
Stream.Transformation
if flag(use-prelude)
other-modules:
Stream.NestedFold
Stream.NestedStream
Stream.Split
else
other-modules:
Stream.Common
Stream.Reduce
if flag(bench-core) || impl(ghcjs)
buildable: False
else
buildable: True
build-depends: exceptions >= 0.8 && < 0.11
if flag(limit-build-mem)
if flag(dev)
ghc-options: +RTS -M3500M -RTS
else
ghc-options: +RTS -M2000M -RTS
benchmark Data.Stream.StreamD
import: bench-options

20
hie.yaml
View File

@ -30,6 +30,8 @@ cradle:
component: "bench:Data.Stream.StreamD"
- path: "./benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs"
component: "bench:Data.Stream.StreamK"
- path: "./benchmark/Streamly/Benchmark/Data/Stream/*.hs"
component: "bench:Data.Stream"
- path: "./benchmark/Streamly/Benchmark/Data/Unfold.hs"
component: "bench:Data.Unfold"
- path: "./benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs"
@ -44,24 +46,6 @@ cradle:
component: "bench:Prelude.Merge"
- path: "./benchmark/Streamly/Benchmark/Prelude/Parallel.hs"
component: "bench:Prelude.Parallel"
- path: "./benchmark/Streamly/Benchmark/Prelude/Serial.hs"
component: "bench:Prelude.Serial"
- path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Elimination.hs"
component: "bench:Prelude.Serial"
- path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs"
component: "bench:Prelude.Serial"
- path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Generation.hs"
component: "bench:Prelude.Serial"
- path: "./benchmark/Streamly/Benchmark/Prelude/Serial/NestedStream.hs"
component: "bench:Prelude.Serial"
- path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Split.hs"
component: "bench:Prelude.Serial"
- path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Transformation.hs"
component: "bench:Prelude.Serial"
- path: "./benchmark/Streamly/Benchmark/Prelude/Serial/NestedFold.hs"
component: "bench:Prelude.Serial"
- path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Lift.hs"
component: "bench:Prelude.Serial"
- path: "./benchmark/Streamly/Benchmark/Prelude/WSerial.hs"
component: "bench:Prelude.WSerial"
- path: "./benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs"

1
streamly.cabal
View File

@ -65,7 +65,6 @@ extra-source-files:
benchmark/Streamly/Benchmark/FileSystem/*.hs
benchmark/Streamly/Benchmark/FileSystem/Handle/*.hs
benchmark/Streamly/Benchmark/Prelude/*.hs
benchmark/Streamly/Benchmark/Prelude/Serial/*.hs
benchmark/Streamly/Benchmark/Unicode/*.hs
benchmark/lib/Streamly/Benchmark/*.hs
benchmark/lib/Streamly/Benchmark/Common/*.hs

4
targets/Targets.hs
View File

@ -25,9 +25,9 @@ targets =
)
-- Streams
, ("Prelude.Serial", ["serial_wserial_cmp"])
, ("Data.Stream", ["serial_wserial_cmp"])
, ("Prelude.WSerial", ["serial_wserial_cmp"])
, ("Prelude.Serial",
, ("Data.Stream",
[ "prelude_serial_grp"
, "infinite_grp"
, "serial_wserial_cmp"