streaming-benchmarks 0.3.0 → 0.4.1
raw patch · 36 files changed
+1508/−1579 lines, 36 filesdep +streaming-benchmarksdep +streamly-coredep +tastydep −Chartdep −Chart-diagramsdep −bench-showdep ~bytestringdep ~containersdep ~deepseq
Dependencies added: streaming-benchmarks, streamly-core, tasty, tasty-bench
Dependencies removed: Chart, Chart-diagrams, bench-show, csv, directory, getopt-generics, split, streamly, typed-process
Dependency ranges changed: bytestring, containers, deepseq, gauge, mtl, template-haskell, text, transformers, vector
Files
- Benchmarks.hs +0/−134
- Benchmarks/BenchTH.hs +0/−95
- Benchmarks/BenchmarkTH.hs +0/−57
- Benchmarks/ByteString.hs +15/−9
- Benchmarks/ByteStringLazy.hs +37/−25
- Benchmarks/Common.hs +0/−44
- Benchmarks/Conduit.hs +11/−4
- Benchmarks/DList.hs +15/−4
- Benchmarks/Drinkery.hs +8/−1
- Benchmarks/List.hs +15/−9
- Benchmarks/Machines.hs +12/−4
- Benchmarks/Pipes.hs +11/−4
- Benchmarks/Sequence.hs +12/−8
- Benchmarks/Streaming.hs +11/−4
- Benchmarks/Streamly.hs +105/−68
- Benchmarks/StreamlyArray.hs +44/−33
- Benchmarks/StreamlyPure.hs +72/−45
- Benchmarks/Text.hs +15/−9
- Benchmarks/Vector.hs +6/−212
- Benchmarks/VectorCommon.hs +230/−0
- Benchmarks/VectorStorable.hs +18/−0
- Benchmarks/VectorStreams.hs +16/−10
- Benchmarks/VectorUnboxed.hs +19/−0
- Changelog.md +10/−0
- Charts.hs +0/−283
- README.md +41/−44
- bench-report.nix +0/−50
- bench-runner/Main.hs +60/−0
- bench-runner/bench-runner.cabal +41/−0
- bench-runner/cabal.project.user +35/−0
- bench.sh +0/−325
- lib/Benchmarks/BenchTH.hs +111/−0
- lib/Benchmarks/BenchmarkTH.hs +94/−0
- lib/Benchmarks/Common.hs +56/−0
- lib/Benchmarks/DefaultMain.hs +146/−0
- streaming-benchmarks.cabal +242/−98
− Benchmarks.hs
@@ -1,134 +0,0 @@--- |--- Module : Main--- Copyright : (c) 2018 Harendra Kumar------ License : MIT--- Maintainer : harendra.kumar@gmail.com--{-# LANGUAGE TemplateHaskell #-}--module Main (main) where--import Data.List ((\\))-import Gauge--import Benchmarks.BenchmarkTH--import qualified Benchmarks.VectorStreams as VectorStreams-import qualified Benchmarks.Streamly as Streamly-import qualified Benchmarks.StreamlyPure as StreamlyPure-import qualified Benchmarks.Streaming as Streaming-import qualified Benchmarks.Machines as Machines-import qualified Benchmarks.Pipes as Pipes-import qualified Benchmarks.Conduit as Conduit-import qualified Benchmarks.Drinkery as Drinkery-import qualified Benchmarks.List as List-import qualified Benchmarks.ByteString as ByteString-import qualified Benchmarks.ByteStringLazy as ByteStringLazy-import qualified Benchmarks.Text as Text-import qualified Benchmarks.DList as DList-import qualified Benchmarks.Sequence as Sequence-import qualified Benchmarks.Vector as Vector-import qualified Benchmarks.StreamlyArray as StreamlyArray--- import qualified Benchmarks.LogicT as LogicT--- import qualified Benchmarks.ListT as ListT--- import qualified Benchmarks.ListTransformer as ListTransformer--main :: IO ()-main = do- defaultMain- [ bgroup "elimination"- [ $(createBgroupSink (benchMods ++ ["DList"]) "drain" "toNull")- , $(createBgroupSink ((benchMods \\ ["List"]) ++ ["DList"]) "toList" "toList")- , $(createBgroupSink (benchMods ++ ["DList"]) "foldl'" "foldl")- , $(createBgroupSink benchMods "last" "last")- , $(createBgroupSrc (["Streamly", "List", "VectorStreams"])- "enumInt" "sourceIntFromThenTo")- ]- , bgroup "transformation"- [ $(createBgroupSinkN (benchMods \\ ["Sequence"]) "scan" "scan" 1)- , $(createBgroupSinkN (benchMods ++ ["DList"]) "map" "map" 1)- , $(createBgroupSinkN benchMods "mapM" "mapM" 1)- ]- , bgroup "transformationX4"- [ $(createBgroupSinkN (benchMods \\ ["Sequence"]) "scan x 4" "scan" 4)- , $(createBgroupSinkN (benchMods ++ ["DList"]) "map x 4" "map" 4)- , $(createBgroupSinkN benchMods "mapM x 4" "mapM" 4)- ]- , bgroup "filtering"- [ $(createBgroupSinkN benchMods "filter-all-out" "filterAllOut" 1)- , $(createBgroupSinkN benchMods "filter-all-in" "filterAllIn" 1)- , $(createBgroupSinkN benchMods "drop-all" "dropAll" 1)- , $(createBgroupSinkN benchMods "takeWhile-true" "takeWhileTrue" 1)- , $(createBgroupSinkN benchMods "filter-even" "filterEven" 1)- , $(createBgroupSinkN benchMods "take-all" "takeAll" 1)- , $(createBgroupSinkN benchMods "drop-one" "dropOne" 1)- , $(createBgroupSinkN benchMods "dropWhile-true" "dropWhileTrue" 1)- , $(createBgroupSinkN benchMods "dropWhile-false" "dropWhileFalse" 1)- ]- -- drop-all/dropWhile-true/filter-all-out x 4 would be the same as- -- drop-all/dropWhile-true/filter-all-out x 1 as they would already- -- drop all elements and do nothing in the next iterations- , bgroup "filteringX4"- [ $(createBgroupSinkN benchMods "filter-even x 4" "filterEven" 4)- -- , $(createBgroupSinkN benchMods "filter-all-out x 4" "filterAllOut" 4)- , $(createBgroupSinkN benchMods "filter-all-in x 4" "filterAllIn" 4)- , $(createBgroupSinkN benchMods "take-all x 4" "takeAll" 4)- , $(createBgroupSinkN benchMods "takeWhile-true x 4" "takeWhileTrue" 4)- , $(createBgroupSinkN benchMods "drop-one x 4" "dropOne" 4)- -- , $(createBgroupSinkN benchMods "drop-all x 4" "dropAll" 4)- -- , $(createBgroupSinkN benchMods "dropWhile-true x 4" "dropWhileTrue" 4)- , $(createBgroupSinkN benchMods "dropWhile-false x 4" "dropWhileFalse" 4)- ]- , bgroup "mixedX4"- [ $(createBgroupSinkN (benchMods \\ ["Sequence"]) "scan-map x 4" "scanMap" 4)- , $(createBgroupSinkN (benchMods \\ ["Sequence"]) "drop-scan x 4" "dropScan" 4)- , $(createBgroupSinkN (benchMods \\ ["Sequence"]) "take-scan x 4" "takeScan" 4)- , $(createBgroupSinkN (benchMods \\ ["Sequence"]) "filter-scan x 4" "filterScan" 4)- , $(createBgroupSinkN benchMods "drop-map x 4" "dropMap" 4)- , $(createBgroupSinkN benchMods "take-drop x 4" "takeDrop" 4)- , $(createBgroupSinkN benchMods "take-map x 4" "takeMap" 4)- , $(createBgroupSinkN benchMods "filter-drop x 4" "filterDrop" 4)- , $(createBgroupSinkN benchMods "filter-take x 4" "filterTake" 4)- , $(createBgroupSinkN benchMods "filter-map x 4" "filterMap" 4)- ]- , $(createBgroupSink (benchMods \\ ["StreamlyArray", "StreamlyPure"]) "zip" "zip")- -- XXX use 4x250k concatMap for a comparative idea of cost wrt other ops- , $(createBgroupSink (- [ "List"- , "Streamly"- , "StreamlyPure"- , "Vector"- , "VectorStreams"- , "ByteString"- , "ByteStringLazy"- , "Text"- ]) "concatMap" "concatMap")- , $(createBgroupSink (benchMods \\- [ "List"- , "Streamly"- , "StreamlyPure"- , "Vector"- , "VectorStreams"- , "ByteString"- , "ByteStringLazy"- , "Sequence"- , "StreamlyArray"- , "Text"- ]) "concatMapFoldable" "concatMapFoldable")-- , $(createBgroupSrc ((benchMods ++ ["DList"]) \\- ["Drinkery", "StreamlyArray"]) "appendR[10000]" "appendSourceR")- , $(createBgroupSrc ["DList", "Conduit"] "appendL[10000]" "appendSourceL")-- -- Perform 100,000 mapM recursively over a stream of length 10- , bgroup "iterated"- [ $(createBgroupSrc (iterMods \\ pureMods) "mapM (iter)" "iterateMapM")- , $(createBgroupSrc (iterMods \\ ["Sequence"]) "scan[10000] (iter)" "iterateScan")- , $(createBgroupSrc iterMods "filterEven (iter)" "iterateFilterEven")- , $(createBgroupSrc iterMods "takeAll (iter)" "iterateTakeAll")- , $(createBgroupSrc iterMods "dropOne (iter)" "iterateDropOne")- , $(createBgroupSrc iterMods "dropWhileFalse[10000] (iter)" "iterateDropWhileFalse")- , $(createBgroupSrc iterMods "dropWhileTrue (iter)" "iterateDropWhileTrue")- ]- ]
− Benchmarks/BenchTH.hs
@@ -1,95 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module Benchmarks.BenchTH- ( mkBench- , mkBenchN- , purePackages- , monadicPackages- , monadicArrays- , allPackages- ) where--import Benchmarks.Common (benchIO, benchPure, benchIOArray)-import Language.Haskell.TH.Syntax (Q, Exp, mkName)-import Language.Haskell.TH.Lib (varE)---- First item in the tuple is the module name and the second one is the--- corresponding benchmark group name.----monadicPackages :: [(String, String)]-monadicPackages =- [ ("Streamly", "streamly")- , ("VectorStreams", "streams-vector")- , ("Streaming", "streaming")- , ("Machines", "machines")- , ("Pipes", "pipes")- , ("Conduit", "conduit")- , ("Drinkery", "drinkery")- ]--purePackages :: [(String, String)]-purePackages =- [ ("List", "list")- , ("DList", "dlist")- , ("ByteString", "bytestring")- , ("ByteStringLazy", "lazy-bytestring")- , ("Text", "text")- , ("Sequence", "sequence")- , ("StreamlyPure", "pure-streamly")- , ("Vector", "vector")- ]--monadicArrays :: [(String, String)]-monadicArrays = [("StreamlyArray", "array-streamly")]--allPackages :: [(String, String)]-allPackages =- purePackages- ++ monadicPackages- ++ monadicArrays---- mkBench <stream producer func> <stream consumer func> <module name>-mkBench :: String -> String -> String -> Q Exp-mkBench f x mdl =- case lookup mdl purePackages of- Nothing -> case lookup mdl monadicPackages of- Just pkg ->- [| benchIO pkg $(varE (mkName (mdl ++ "." ++ f)))- $(varE (mkName (mdl ++ "." ++ x)))- |]- Nothing ->- if mdl == "StreamlyArray"- then- [| benchIOArray "array-streamly"- $(varE (mkName (mdl ++ "." ++ f)))- $(varE (mkName (mdl ++ "." ++ x)))- |]- else error $- "module " ++ show mdl ++ " not found in module list"- Just pkg ->- [| benchPure pkg $(varE (mkName (mdl ++ "." ++ f)))- $(varE (mkName (mdl ++ "." ++ x)))- |]--mkBenchN :: String -> String -> Int -> String -> Q Exp-mkBenchN f x n mdl =- case lookup mdl purePackages of- Nothing -> case lookup mdl monadicPackages of- Just pkg ->- [| benchIO pkg $(varE (mkName (mdl ++ "." ++ f)))- ($(varE (mkName (mdl ++ "." ++ x))) n)- |]- Nothing ->- if mdl == "StreamlyArray"- then- [| benchIOArray "array-streamly"- $(varE (mkName (mdl ++ "." ++ f)))- ($(varE (mkName (mdl ++ "." ++ x))) n)- |]- else- error $- "module " ++ show mdl ++ " not found in module list"- Just pkg ->- [| benchPure pkg $(varE (mkName (mdl ++ "." ++ f)))- ($(varE (mkName (mdl ++ "." ++ x))) n)- |]
− Benchmarks/BenchmarkTH.hs
@@ -1,57 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module Benchmarks.BenchmarkTH- ( createBgroupSink- , createBgroupSinkN- , createBgroupSrc- , pureMods- , monadicMods- , allMods- , benchMods- , iterMods- ) where--import Data.List ((\\))-import Language.Haskell.TH.Syntax (Q, Exp)-import Language.Haskell.TH.Lib (listE)--import Benchmarks.BenchTH--benchMods, iterMods, pureMods, monadicMods, monadicArrayMods, allMods :: [String]-pureMods = map fst purePackages-monadicMods = map fst monadicPackages-monadicArrayMods = map fst monadicArrays-allMods = pureMods ++ monadicMods ++ monadicArrayMods-benchMods = allMods \\ ["DList"]-iterMods = allMods \\- [ "DList"- , "Streaming"- , "Machines"- , "Pipes"- , "Conduit"- , "Drinkery"- ]---- | createBgroupSink <module names> <benchmark name>--- <stream consumer function name>-createBgroupSink :: [String] -> String -> String -> Q Exp-createBgroupSink mods name fname =- [|- bgroup name $(listE (map (mkBench "source" fname) mods))- |]---- | createBgroupSink <module names> <benchmark name>--- <stream consumer function name> <number of iterations>-createBgroupSinkN :: [String] -> String -> String -> Int -> Q Exp-createBgroupSinkN mods name fname n =- [|- bgroup name $(listE (map (mkBenchN "source" fname n) mods))- |]---- | createBgroupSink <module names> <benchmark name>--- <stream producer function name>-createBgroupSrc :: [String] -> String -> String -> Q Exp-createBgroupSrc mods name fname =- [|- bgroup name $(listE (map (mkBench fname "toNull") mods))- |]
Benchmarks/ByteString.hs view
@@ -6,9 +6,11 @@ -- Maintainer : harendra.kumar@gmail.com {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} module Benchmarks.ByteString where +import Benchmarks.DefaultMain (defaultMain) -- import Benchmarks.Common (value, maxValue, appendValue) import Prelude (Int, (+), ($), (.), even, (>), (<=), subtract, undefined, maxBound, Maybe(..))@@ -50,12 +52,14 @@ ------------------------------------------------------------------------------- {-# INLINE appendSourceR #-}-appendSourceR :: Int -> Stream Element-appendSourceR n = P.foldr (S.append) S.empty (P.map (S.singleton . P.fromIntegral) [n..n+nAppends])+appendSourceR :: Int -> ()+appendSourceR n =+ toNull $ P.foldr (S.append) S.empty (P.map (S.singleton . P.fromIntegral) [n..n+nAppends]) {-# INLINE appendSourceL #-}-appendSourceL :: Int -> Stream Element-appendSourceL n = P.foldl (S.append) S.empty (P.map (S.singleton . P.fromIntegral) [n..n+nAppends])+appendSourceL :: Int -> ()+appendSourceL n =+ toNull $ P.foldl (S.append) S.empty (P.map (S.singleton . P.fromIntegral) [n..n+nAppends]) ------------------------------------------------------------------------------- -- Elimination@@ -171,15 +175,14 @@ iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue :: Int -> Stream Element --- this is quadratic -- XXX using scanl instead of scanl'-iterateScan n = iterateSource (S.scanl (+) 0) (maxIters `P.div` 100) n-iterateDropWhileFalse n =- iterateSource (S.dropWhile (> maxElem)) (maxIters `P.div` 100) n-+-- Scan increases the size of the stream by 1, drop 1 to not blow up the size+-- due to many iterations.+iterateScan n = iterateSource (S.drop 1 . S.scanl (+) 0) maxIters n iterateFilterEven n = iterateSource (S.filter even) maxIters n iterateTakeAll n = iterateSource (S.take nElements) maxIters n iterateDropOne n = iterateSource (S.drop 1) maxIters n+iterateDropWhileFalse n = iterateSource (S.dropWhile (> maxElem)) maxIters n iterateDropWhileTrue n = iterateSource (S.dropWhile (<= maxElem)) maxIters n -------------------------------------------------------------------------------@@ -224,3 +227,6 @@ {-# INLINE concatMap #-} concatMap :: Stream Element -> () concatMap src = transform $ (S.concatMap (S.replicate 3) src)++main :: P.IO ()+main = $(defaultMain "ByteString")
Benchmarks/ByteStringLazy.hs view
@@ -6,11 +6,13 @@ -- Maintainer : harendra.kumar@gmail.com {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} module Benchmarks.ByteStringLazy where +import Benchmarks.DefaultMain (defaultMain) -- import Benchmarks.Common (value, maxValue, appendValue)-import Prelude (Int, (+), id, ($), (.), even, (>), (<=), subtract, undefined,+import Prelude (Int, (+), ($), (.), even, (>), (<=), subtract, undefined, maxBound, Maybe(..)) import qualified Prelude as P import Data.Word (Word8)@@ -52,12 +54,14 @@ ------------------------------------------------------------------------------- {-# INLINE appendSourceR #-}-appendSourceR :: Int -> Stream Element-appendSourceR n = P.foldr (S.append) S.empty (P.map (S.singleton . P.fromIntegral) [n..n+nAppends])+appendSourceR :: Int -> ()+appendSourceR n =+ toNull $ P.foldr (S.append) S.empty (P.map (S.singleton . P.fromIntegral) [n..n+nAppends]) {-# INLINE appendSourceL #-}-appendSourceL :: Int -> Stream Element-appendSourceL n = P.foldl (S.append) S.empty (P.map (S.singleton . P.fromIntegral) [n..n+nAppends])+appendSourceL :: Int -> ()+appendSourceL n =+ toNull $ P.foldl (S.append) S.empty (P.map (S.singleton . P.fromIntegral) [n..n+nAppends]) ------------------------------------------------------------------------------- -- Elimination@@ -112,7 +116,6 @@ 4 -> transform . f . f . f . f _ -> undefined -{-# INLINE scan #-} {-# INLINE map #-} {-# INLINE mapM #-} {-# INLINE filterEven #-}@@ -125,7 +128,7 @@ {-# INLINE dropAll #-} {-# INLINE dropWhileTrue #-} {-# INLINE dropWhileFalse #-}-scan, map, mapM,+map, mapM, filterEven, filterAllOut, filterAllIn, takeOne, takeAll, takeWhileTrue, dropOne, dropAll, dropWhileTrue, dropWhileFalse@@ -133,8 +136,11 @@ -- XXX there is no scanl' -- XXX All scan ops hang for lazy bytestring, disabled for now--- scan n = composeN n $ S.scanl (+) 0-scan n = composeN n $ id+{-+{-# INLINE scan #-}+scan :: Int -> Stream Int -> ()+scan n = composeN n $ S.scanl (+) 0+-} map n = composeN n $ S.map (+1) mapM = map filterEven n = composeN n $ S.filter even@@ -166,56 +172,59 @@ f (0 :: Int) m = g m f x m = g (f (x P.- 1) m) -{-# INLINE iterateScan #-} {-# INLINE iterateFilterEven #-} {-# INLINE iterateTakeAll #-} {-# INLINE iterateDropOne #-} {-# INLINE iterateDropWhileFalse #-} {-# INLINE iterateDropWhileTrue #-}-iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,+iterateFilterEven, iterateTakeAll, iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue :: Int -> Stream Element -- this is quadratic -- XXX using scanl instead of scanl' -- XXX All scan ops hang for lazy bytestring, disabled for now-iterateScan n = iterateSource id (maxIters `P.div` 100) n-iterateDropWhileFalse n =- iterateSource (S.dropWhile (> maxElem)) (maxIters `P.div` 100) n-+{-+-- Scan increases the size of the stream by 1, drop 1 to not blow up the size+-- due to many iterations.+{-# INLINE iterateScan #-}+iterateScan :: Int -> Stream Element+iterateScan n = iterateSource (error "hangs") maxIters n+-} iterateFilterEven n = iterateSource (S.filter even) maxIters n iterateTakeAll n = iterateSource (S.take nElements) maxIters n iterateDropOne n = iterateSource (S.drop 1) maxIters n+iterateDropWhileFalse n = iterateSource (S.dropWhile (> maxElem)) maxIters n iterateDropWhileTrue n = iterateSource (S.dropWhile (<= maxElem)) maxIters n ------------------------------------------------------------------------------- -- Mixed Composition ------------------------------------------------------------------------------- -{-# INLINE scanMap #-} {-# INLINE dropMap #-}-{-# INLINE dropScan #-} {-# INLINE takeDrop #-}-{-# INLINE takeScan #-} {-# INLINE takeMap #-} {-# INLINE filterDrop #-} {-# INLINE filterTake #-}-{-# INLINE filterScan #-} {-# INLINE filterMap #-}-scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,- filterTake, filterScan, filterMap+dropMap, takeDrop, takeMap, filterDrop,+ filterTake, filterMap :: Int -> Stream Element -> () -- XXX using scanl instead of scanl' -- XXX All scan ops hang for lazy bytestring, disabled for now-scanMap n = composeN n $ id+-- {-# INLINE scanMap #-}+-- scanMap n = composeN n $ id dropMap n = composeN n $ S.map (subtract 1) . S.drop 1-dropScan n = composeN n $ id+-- {-# INLINE dropScan #-}+-- dropScan n = composeN n $ id takeDrop n = composeN n $ S.drop 1 . S.take nElements-takeScan n = composeN n $ id+-- {-# INLINE takeScan #-}+-- takeScan n = composeN n $ id takeMap n = composeN n $ S.map (subtract 1) . S.take nElements filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxElem) filterTake n = composeN n $ S.take nElements . S.filter (<= maxElem)-filterScan n = composeN n $ id+-- {-# INLINE filterScan #-}+-- filterScan n = composeN n $ id filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxElem) -------------------------------------------------------------------------------@@ -230,3 +239,6 @@ {-# INLINE concatMap #-} concatMap :: Stream Element -> () concatMap src = transform $ (S.concatMap (S.replicate 3) src)++main :: P.IO ()+main = $(defaultMain "ByteStringLazy")
− Benchmarks/Common.hs
@@ -1,44 +0,0 @@--- |--- Module : Benchmarks.Common--- Copyright : (c) 2018 Harendra Kumar------ License : MIT--- Maintainer : harendra.kumar@gmail.com--module Benchmarks.Common- ( value- , maxValue- , appendValue- , benchIO- , benchIOArray- , benchId- , benchPure- ) where--import Control.DeepSeq (NFData)-import Data.Functor.Identity (Identity, runIdentity)-import System.Random (randomRIO)--import Gauge--value, maxValue,appendValue :: Int-value = 1000000-maxValue = value + 1000-appendValue = 10000--{-# INLINE benchIO #-}-benchIO :: (NFData b) => String -> (Int -> a) -> (a -> IO b) -> Benchmark-benchIO name src f = bench name $ nfIO $ randomRIO (1,1) >>= f . src--{-# INLINE benchId #-}-benchId :: (NFData b) => String -> (Int -> a) -> (a -> Identity b) -> Benchmark-benchId name src f = bench name $ nf (runIdentity . f) (src 10)--{-# INLINE benchPure #-}-benchPure :: (NFData b) => String -> (Int -> a) -> (a -> b) -> Benchmark-benchPure name src f = bench name $ nfIO $ randomRIO (1,1) >>= return . f . src--{-# INLINE benchIOArray #-}-benchIOArray :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark-benchIOArray name src f = bench name $ nfIO $- randomRIO (1,1) >>= src >>= f
Benchmarks/Conduit.hs view
@@ -5,8 +5,11 @@ -- License : MIT -- Maintainer : harendra.kumar@gmail.com +{-# LANGUAGE TemplateHaskell #-}+ module Benchmarks.Conduit where +import Benchmarks.DefaultMain (defaultMain) import Benchmarks.Common (value, maxValue, appendValue) import Prelude (Monad, Int, (+), ($), return, even, (>), (<=),@@ -43,13 +46,14 @@ ------------------------------------------------------------------------------- {-# INLINE appendSourceR #-}-appendSourceR :: Monad m => Int -> Source m () Int-appendSourceR n = foldMap (S.yieldM . return) [n..n+appendValue]+appendSourceR :: Int -> P.IO ()+appendSourceR n =+ toNull $ foldMap (S.yieldM . return) [n..n+appendValue] {-# INLINE appendSourceL #-}-appendSourceL :: Monad m => Int -> Source m () Int+appendSourceL :: Int -> P.IO () appendSourceL n =- P.foldl (<>) P.mempty (P.map (S.yieldM . return) [n..n+appendValue])+ toNull $ P.foldl (<>) P.mempty (P.map (S.yieldM . return) [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination@@ -185,3 +189,6 @@ {-# INLINE concatMapFoldable #-} concatMapFoldable :: Monad m => Source m () Int -> m () concatMapFoldable = transform (S.map (replicate 3) S..| S.concat)++main :: P.IO ()+main = $(defaultMain "Conduit")
Benchmarks/DList.hs view
@@ -6,13 +6,19 @@ -- Maintainer : harendra.kumar@gmail.com {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-} module Benchmarks.DList where +import Benchmarks.DefaultMain (defaultMain) import Benchmarks.Common (value, appendValue) import Prelude (Int, (+), ($), (.), (>), undefined, Maybe(..)) import qualified Prelude as P++#if !MIN_VERSION_base(4,20,0) import qualified Data.Foldable as P+#endif import qualified Data.DList as S @@ -47,12 +53,14 @@ ------------------------------------------------------------------------------- {-# INLINE appendSourceR #-}-appendSourceR :: Int -> Stream Int-appendSourceR n = P.foldr S.append S.empty (P.map S.singleton [n..n+appendValue])+appendSourceR :: Int -> ()+appendSourceR n =+ toNull $ P.foldr S.append S.empty (P.map S.singleton [n..n+appendValue]) {-# INLINE appendSourceL #-}-appendSourceL :: Int -> Stream Int-appendSourceL n = P.foldl S.append S.empty (P.map S.singleton [n..n+appendValue])+appendSourceL :: Int -> ()+appendSourceL n =+ toNull $ P.foldl S.append S.empty (P.map S.singleton [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination@@ -210,3 +218,6 @@ {-# INLINE concat #-} concat :: Stream Int -> () concat _src = undefined++main :: P.IO ()+main = $(defaultMain "DList")
Benchmarks/Drinkery.hs view
@@ -1,11 +1,15 @@ {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+ module Benchmarks.Drinkery where +import Benchmarks.DefaultMain (defaultMain) import Benchmarks.Common (value, maxValue) import Control.Monad (void) import Prelude (Monad, Int, Maybe(..), (+), ($), return, even, (>), (<=),- subtract, undefined, replicate, (<$>), (<*>), fst, id, const, maxBound)+ subtract, undefined, replicate, (<$>), (<*>), fst, id, const,+ maxBound, IO) import qualified Data.Drinkery as S import qualified Data.Drinkery.Finite as S@@ -144,3 +148,6 @@ {-# INLINE concatMapFoldable #-} concatMapFoldable :: Monad m => Source m () Int -> m () concatMapFoldable = transform $ S.map (replicate 3) S.++$ S.concatMap id++main :: IO ()+main = $(defaultMain "Drinkery")
Benchmarks/List.hs view
@@ -6,9 +6,11 @@ -- Maintainer : harendra.kumar@gmail.com {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} module Benchmarks.List where +import Benchmarks.DefaultMain (defaultMain) import Benchmarks.Common (value, maxValue, appendValue) import Prelude (Int, (+), ($), (.), even, (>), (<=), subtract, undefined, maxBound, Maybe(..))@@ -51,12 +53,14 @@ ------------------------------------------------------------------------------- {-# INLINE appendSourceR #-}-appendSourceR :: Int -> Stream Int-appendSourceR n = P.foldr (S.++) [] (P.map (: []) [n..n+appendValue])+appendSourceR :: Int -> ()+appendSourceR n =+ toNull $ P.foldr (S.++) [] (P.map (: []) [n..n+appendValue]) {-# INLINE appendSourceL #-}-appendSourceL :: Int -> Stream Int-appendSourceL n = P.foldl (S.++) [] (P.map (: []) [n..n+appendValue])+appendSourceL :: Int -> ()+appendSourceL n =+ toNull $ P.foldl (S.++) [] (P.map (: []) [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination@@ -157,14 +161,13 @@ iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue :: Int -> Stream Int --- this is quadratic-iterateScan n = iterateSource (S.scanl' (+) 0) (maxIters `P.div` 100) n-iterateDropWhileFalse n =- iterateSource (S.dropWhile (> maxValue)) (maxIters `P.div` 100) n-+-- Scan increases the size of the stream by 1, drop 1 to not blow up the size+-- due to many iterations.+iterateScan n = iterateSource (S.drop 1 . S.scanl' (+) 0) maxIters n iterateFilterEven n = iterateSource (S.filter even) maxIters n iterateTakeAll n = iterateSource (S.take maxValue) maxIters n iterateDropOne n = iterateSource (S.drop 1) maxIters n+iterateDropWhileFalse n = iterateSource (S.dropWhile (> maxValue)) maxIters n iterateDropWhileTrue n = iterateSource (S.dropWhile (<= maxValue)) maxIters n -------------------------------------------------------------------------------@@ -208,3 +211,6 @@ {-# INLINE concatMap #-} concatMap :: Stream Int -> () concatMap src = transform $ (S.concatMap (S.replicate 3) src)++main :: P.IO ()+main = $(defaultMain "List")
Benchmarks/Machines.hs view
@@ -6,9 +6,12 @@ -- Maintainer : harendra.kumar@gmail.com {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-incomplete-patterns #-}+ module Benchmarks.Machines where +import Benchmarks.DefaultMain (defaultMain) import Benchmarks.Common (value, maxValue, appendValue) import Prelude (Monad, Int, (.), (+), ($), return, even, (>), (<=),@@ -39,13 +42,15 @@ ------------------------------------------------------------------------------- {-# INLINE appendSourceR #-}-appendSourceR :: Monad m => Int -> Source m Int-appendSourceR n = foldMap (S.construct . S.yield) [n..n+appendValue]+appendSourceR :: Int -> P.IO ()+appendSourceR n =+ toNull $ foldMap (S.construct . S.yield) [n..n+appendValue] -- XXX use S.prepended instead? {-# INLINE appendSourceL #-}-appendSourceL :: Monad m => Int -> Source m Int-appendSourceL n = P.foldl (<>) P.mempty (P.map (S.construct . S.yield) [n..n+appendValue])+appendSourceL :: Int -> P.IO ()+appendSourceL n =+ toNull $ P.foldl (<>) P.mempty (P.map (S.construct . S.yield) [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination@@ -159,3 +164,6 @@ {-# INLINE concatMapFoldable #-} concatMapFoldable :: Monad m => S.MachineT m k Int -> m () concatMapFoldable = transform (S.mapping (replicate 3) S.~> S.asParts)++main :: P.IO ()+main = $(defaultMain "Machines")
Benchmarks/Pipes.hs view
@@ -6,9 +6,11 @@ -- Maintainer : harendra.kumar@gmail.com {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-} module Benchmarks.Pipes where +import Benchmarks.DefaultMain (defaultMain) import Benchmarks.Common (value, maxValue, appendValue) import Data.Void (Void) import Prelude@@ -43,12 +45,14 @@ ------------------------------------------------------------------------------- {-# INLINE appendSourceR #-}-appendSourceR :: Monad m => Int -> Source m () Int-appendSourceR n = foldMap S.yield [n..n+appendValue]+appendSourceR :: Int -> P.IO ()+appendSourceR n =+ toNull $ foldMap S.yield [n..n+appendValue] {-# INLINE appendSourceL #-}-appendSourceL :: Monad m => Int -> Source m () Int-appendSourceL n = P.foldl (<>) P.mempty (P.map S.yield [n..n+appendValue])+appendSourceL :: Int -> P.IO ()+appendSourceL n =+ toNull $ P.foldl (<>) P.mempty (P.map S.yield [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination@@ -159,3 +163,6 @@ {-# INLINE concatMapFoldable #-} concatMapFoldable :: Monad m => Source m () Int -> m () concatMapFoldable = transform (S.map (replicate 3) S.>-> S.concat)++main :: P.IO ()+main = $(defaultMain "Pipes")
Benchmarks/Sequence.hs view
@@ -6,9 +6,12 @@ -- Maintainer : harendra.kumar@gmail.com {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-} module Benchmarks.Sequence where +import Benchmarks.DefaultMain (defaultMain) import Benchmarks.Common (value, maxValue, appendValue) import Prelude (Int, (+), ($), (.), even, (>), (<=), subtract, undefined, Maybe(..))@@ -48,13 +51,14 @@ ------------------------------------------------------------------------------- {-# INLINE appendSourceR #-}-appendSourceR :: Int -> Stream Int+appendSourceR :: Int -> () appendSourceR n =- P.foldr (S.><) S.empty (P.map S.singleton [n..n+appendValue])+ toNull $ P.foldr (S.><) S.empty (P.map S.singleton [n..n+appendValue]) {-# INLINE appendSourceL #-}-appendSourceL :: Int -> Stream Int-appendSourceL n = P.foldl (S.><) S.empty (P.map S.singleton [n..n+appendValue])+appendSourceL :: Int -> ()+appendSourceL n =+ toNull $ P.foldl (S.><) S.empty (P.map S.singleton [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination@@ -159,14 +163,11 @@ iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue :: Int -> Stream Int --- this is quadratic iterateScan = undefined-iterateDropWhileFalse n =- iterateSource (S.dropWhileL (> maxValue)) (maxIters `P.div` 100) n- iterateFilterEven n = iterateSource (S.filter even) maxIters n iterateTakeAll n = iterateSource (S.take maxValue) maxIters n iterateDropOne n = iterateSource (S.drop 1) maxIters n+iterateDropWhileFalse n = iterateSource (S.dropWhileL (> maxValue)) maxIters n iterateDropWhileTrue n = iterateSource (S.dropWhileL (<= maxValue)) maxIters n -------------------------------------------------------------------------------@@ -209,3 +210,6 @@ {-# INLINE concat #-} concat :: Stream Int -> Stream Int concat _src = undefined -- transform $ (S.concatMap (S.replicate 3) src)++main :: P.IO ()+main = $(defaultMain "Sequence")
Benchmarks/Streaming.hs view
@@ -5,10 +5,12 @@ -- License : MIT -- Maintainer : harendra.kumar@gmail.com +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Benchmarks.Streaming where +import Benchmarks.DefaultMain (defaultMain) import Benchmarks.Common (value, maxValue, appendValue) import Control.DeepSeq (NFData) import Prelude@@ -44,12 +46,14 @@ ------------------------------------------------------------------------------- {-# INLINE appendSourceR #-}-appendSourceR :: Monad m => Int -> Stream m Int-appendSourceR n = foldMap S.yield [n..n+appendValue]+appendSourceR :: Int -> P.IO ()+appendSourceR n =+ toNull $ foldMap S.yield [n..n+appendValue] {-# INLINE appendSourceL #-}-appendSourceL :: Monad m => Int -> Stream m Int-appendSourceL n = P.foldl (<>) P.mempty (P.map S.yield [n..n+appendValue])+appendSourceL :: Int -> P.IO ()+appendSourceL n =+ toNull $ P.foldl (<>) P.mempty (P.map S.yield [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination@@ -166,3 +170,6 @@ {-# INLINE concatMapFoldable #-} concatMapFoldable :: Monad m => Stream m Int -> m () concatMapFoldable src = runStream $ (S.concat $ S.map (P.replicate 3) src)++main :: P.IO ()+main = $(defaultMain "Streaming")
Benchmarks/Streamly.hs view
@@ -7,32 +7,52 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-identities #-} module Benchmarks.Streamly where +import Benchmarks.DefaultMain (defaultMain) import Benchmarks.Common (value, maxValue, appendValue) import Prelude- (Monad, Int, (+), ($), (.), return, even, (>), (<=), div,- subtract, undefined, Maybe(..), foldMap, maxBound)+ (Monad, Int, (+), ($), (.), return, even, (>), (<=),+ subtract, undefined, Maybe(..), maxBound, fmap) import qualified Prelude as P -import qualified Streamly.Prelude as S+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Scanl as Scanl+import qualified Streamly.Data.Stream as S+import qualified Streamly.Data.StreamK as K +-- import Data.Word (Word8)++-- To compare with ByteString we use an element of type Word8+-- It does not seem to make any perceptible difference though+type Element = Int+-- type Element = Word8++nElements :: Int+nElements = maxValue++maxElem :: Element+maxElem = maxBound+ ------------------------------------------------------------------------------- -- Stream generation ------------------------------------------------------------------------------- -type Stream m a = S.SerialT m a+type Stream m a = S.Stream m a+type StreamK m a = K.StreamK m a {-# INLINE source #-}-source :: S.MonadAsync m => Int -> Stream m Int+source :: Monad m => Int -> Stream m Element -- source n = S.fromFoldable [n..n+value] source n = S.unfoldrM step n where step cnt = if cnt > n + value then return Nothing- else return (Just (cnt, cnt + 1))+ else return (Just (P.fromIntegral cnt, cnt + 1)) {- source n = S.unfoldr step n where@@ -43,29 +63,32 @@ -} {-# INLINE sourceN #-}-sourceN :: S.MonadAsync m => Int -> Int -> Stream m Int-sourceN count begin = S.unfoldrM step begin+sourceN :: Monad m => Int -> Int -> StreamK m Element+sourceN count begin = K.fromStream $ S.unfoldrM step begin where step i = if i > begin + count then return Nothing- else return (Just (i, i + 1))+ else return (Just (P.fromIntegral i, i + 1)) {-# INLINE sourceIntFromThenTo #-}-sourceIntFromThenTo :: (Monad m, S.IsStream t) => Int -> t m Int-sourceIntFromThenTo n = S.enumerateFromThenTo n (n + 1) (n + value)+sourceIntFromThenTo :: Monad m => Int -> Stream m Element+sourceIntFromThenTo n =+ fmap P.fromIntegral $ S.enumerateFromThenTo n (n + 1) (n + value) ------------------------------------------------------------------------------- -- Append ------------------------------------------------------------------------------- {-# INLINE appendSourceR #-}-appendSourceR :: Int -> Stream m Int-appendSourceR n = foldMap S.fromPure [n..n+appendValue]+appendSourceR :: Int -> P.IO ()+appendSourceR n =+ K.drain $ P.foldr K.append K.nil (P.map K.fromPure [n..n+appendValue]) {-# INLINE appendSourceL #-}-appendSourceL :: Int -> Stream m Int-appendSourceL n = P.foldl (P.<>) S.nil (P.map S.fromPure [n..n+appendValue])+appendSourceL :: Int -> P.IO ()+appendSourceL n =+ K.drain $ P.foldl K.append K.nil (P.map K.fromPure [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination@@ -73,21 +96,21 @@ {-# INLINE runStream #-} runStream :: Monad m => Stream m a -> m ()-runStream = S.drain+runStream = S.fold Fold.drain {-# INLINE toNull #-} {-# INLINE toList #-} {-# INLINE foldl #-} {-# INLINE last #-}-toNull :: Monad m => Stream m Int -> m ()-toList :: Monad m => Stream m Int -> m [Int]-foldl :: Monad m => Stream m Int -> m Int-last :: Monad m => Stream m Int -> m (Maybe Int)+toNull :: Monad m => Stream m Element -> m ()+toList :: Monad m => Stream m Element -> m [Element]+foldl :: Monad m => Stream m Element -> m Element+last :: Monad m => Stream m Element -> m (Maybe Element) toNull = runStream toList = S.toList-foldl = S.foldl' (+) 0-last = S.last+foldl = S.fold (Fold.foldl' (+) 0)+last = S.fold Fold.latest ------------------------------------------------------------------------------- -- Transformation@@ -100,7 +123,7 @@ {-# INLINE composeN #-} composeN :: Monad m- => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()+ => Int -> (Stream m Element -> Stream m Element) -> Stream m Element -> m () composeN n f = case n of 1 -> transform . f@@ -126,23 +149,23 @@ filterEven, filterAllOut, filterAllIn, takeOne, takeAll, takeWhileTrue, dropOne, dropAll, dropWhileTrue, dropWhileFalse- :: Monad m => Int -> Stream m Int -> m ()+ :: Monad m => Int -> Stream m Element -> m () -mapM :: S.MonadAsync m => Int -> Stream m Int -> m ()+mapM :: Monad m => Int -> Stream m Element -> m () -scan n = composeN n $ S.scanl' (+) 0-map n = composeN n $ S.map (+1)+scan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0)+map n = composeN n $ fmap (+1) mapM n = composeN n $ S.mapM return filterEven n = composeN n $ S.filter even-filterAllOut n = composeN n $ S.filter (> maxValue)-filterAllIn n = composeN n $ S.filter (<= maxValue)+filterAllOut n = composeN n $ S.filter (> maxElem)+filterAllIn n = composeN n $ S.filter (<= maxElem) takeOne n = composeN n $ S.take 1-takeAll n = composeN n $ S.take maxValue-takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)+takeAll n = composeN n $ S.take nElements+takeWhileTrue n = composeN n $ S.takeWhile (<= maxElem) dropOne n = composeN n $ S.drop 1-dropAll n = composeN n $ S.drop maxValue-dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)-dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)+dropAll n = composeN n $ S.drop nElements+dropWhileFalse n = composeN n $ S.dropWhile (> maxElem)+dropWhileTrue n = composeN n $ S.dropWhile (<= maxElem) ------------------------------------------------------------------------------- -- Iteration@@ -154,34 +177,45 @@ {-# INLINE iterateSource #-} iterateSource- :: S.MonadAsync m- => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int+ :: Monad m+ => (StreamK m Element -> StreamK m Element)+ -> Int+ -> Int+ -> StreamK m Element iterateSource g i n = f i (sourceN iterStreamLen n)+ where- f (0 :: Int) m = g m- f x m = g (f (x P.- 1) m) -{-# INLINE iterateMapM #-}-{-# INLINE iterateScan #-}-{-# INLINE iterateFilterEven #-}-{-# INLINE iterateTakeAll #-}-{-# INLINE iterateDropOne #-}-{-# INLINE iterateDropWhileFalse #-}-{-# INLINE iterateDropWhileTrue #-}+ f (0 :: Int) m = g m+ f x m = g (f (x P.- 1) m)+ iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,- iterateDropWhileFalse, iterateDropWhileTrue :: S.MonadAsync m => Int -> Stream m Int+ iterateDropWhileFalse, iterateDropWhileTrue :: Monad m => Int -> Stream m Element --- this is quadratic-iterateScan n = iterateSource (S.scanl' (+) 0) (maxIters `div` 100) n-iterateDropWhileFalse n =- iterateSource (S.dropWhile (> maxValue)) (maxIters `div` 100) n+-- Scan increases the size of the stream by 1, drop 1 to not blow up the size+-- due to many iterations.+iterateScan n = K.toStream $ iterateSource (K.fromStream . S.drop 1 . S.scanl (Scanl.mkScanl (+) 0) . K.toStream) maxIters n+-- iterateScan n = K.toStream $ iterateSource (K.drop 1 . K.scanl' (+) 0) maxIters n -iterateMapM n = iterateSource (S.mapM return) maxIters n-iterateFilterEven n = iterateSource (S.filter even) maxIters n-iterateTakeAll n = iterateSource (S.take maxValue) maxIters n-iterateDropOne n = iterateSource (S.drop 1) maxIters n-iterateDropWhileTrue n = iterateSource (S.dropWhile (<= maxValue)) maxIters n+-- iterateMapM n = K.toStream $ iterateSource (K.fromStream . S.mapM return . K.toStream) maxIters n+iterateMapM n = K.toStream $ iterateSource (K.mapM return) maxIters n +-- The D version is very slow, investigate why.+-- iterateDropWhileFalse n = K.toStream $ iterateSource (K.fromStream . S.dropWhile (> maxElem) . K.toStream) maxIters n+iterateDropWhileFalse n = K.toStream $ iterateSource (K.dropWhile (> maxElem)) maxIters n++-- iterateTakeAll n = K.toStream $ iterateSource (K.fromStream . S.take nElements . K.toStream) maxIters n+iterateTakeAll n = K.toStream $ iterateSource (K.take nElements) maxIters n++iterateFilterEven n = K.toStream $ iterateSource (K.fromStream . S.filter even . K.toStream) maxIters n+-- iterateFilterEven n = K.toStream $ iterateSource (K.filter even) maxIters n++iterateDropOne n = K.toStream $ iterateSource (K.fromStream . S.drop 1 . K.toStream) maxIters n+-- iterateDropOne n = K.toStream $ iterateSource (K.drop 1) maxIters n++-- iterateDropWhileTrue n = K.toStream $ iterateSource (K.fromStream . S.dropWhile (<= maxElem) . K.toStream) maxIters n+iterateDropWhileTrue n = K.toStream $ iterateSource (K.dropWhile (<= maxElem)) maxIters n+ ------------------------------------------------------------------------------- -- Mixed Composition -------------------------------------------------------------------------------@@ -198,29 +232,32 @@ {-# INLINE filterMap #-} scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop, filterTake, filterScan, filterMap- :: Monad m => Int -> Stream m Int -> m ()+ :: Monad m => Int -> Stream m Element -> m () -scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0-dropMap n = composeN n $ S.map (subtract 1) . S.drop 1-dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1-takeDrop n = composeN n $ S.drop 1 . S.take maxValue-takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue-takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue-filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)-filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)-filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)-filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)+scanMap n = composeN n $ fmap (subtract 1) . S.scanl (Scanl.mkScanl (+) 0)+dropMap n = composeN n $ fmap (subtract 1) . S.drop 1+dropScan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0) . S.drop 1+takeDrop n = composeN n $ S.drop 1 . S.take nElements+takeScan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0) . S.take nElements+takeMap n = composeN n $ fmap (subtract 1) . S.take nElements+filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxElem)+filterTake n = composeN n $ S.take maxValue . S.filter (<= maxElem)+filterScan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0) . S.filter (<= maxElem)+filterMap n = composeN n $ fmap (subtract 1) . S.filter (<= maxElem) ------------------------------------------------------------------------------- -- Zipping and concat ------------------------------------------------------------------------------- {-# INLINE zip #-}-zip :: S.MonadAsync m => Stream m Int -> m ()+zip :: Monad m => Stream m Element -> m () zip src = transform $ (S.zipWith (,) src src) {-# INLINE concatMap #-}-concatMap :: Monad m => Stream m Int -> m ()+concatMap :: Monad m => Stream m Element -> m () concatMap src = transform $ (S.concatMap (S.replicate 3) src) -- XXX composed zip and concat++main :: P.IO ()+main = $(defaultMain "Streamly")
Benchmarks/StreamlyArray.hs view
@@ -7,20 +7,29 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-orphans #-} module Benchmarks.StreamlyArray where +import Control.DeepSeq (NFData(..)) import Control.Monad.IO.Class (MonadIO(..)) import Prelude (Int, (+), ($), (.), even, (>), (<=), subtract, undefined,- maxBound, Maybe(..))+ maxBound, Maybe(..), fmap, div) import qualified Prelude as P +import Benchmarks.DefaultMain (defaultMain) import Benchmarks.Common (value, maxValue) -- , appendValue) -import qualified Streamly.Prelude as S-import qualified Streamly.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Data.Stream as S+import qualified Streamly.Data.Array as A+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Scanl as Scanl +instance NFData (A.Array a) where+ {-# INLINE rnf #-}+ rnf _ = ()+ ------------------------------------------------------------------------------- -- Stream generation and elimination -------------------------------------------------------------------------------@@ -29,7 +38,7 @@ {-# INLINE source #-} source :: MonadIO m => Int -> m (Stream Int)-source n = S.fold (A.writeN value) (S.unfoldr step n)+source n = S.fold (A.createOf value) (S.unfoldr step n) where step cnt = if cnt > n + value@@ -38,7 +47,7 @@ {-# INLINE sourceN #-} sourceN :: MonadIO m => Int -> Int -> m (Stream Int)-sourceN count begin = S.fold (A.writeN value) (S.unfoldr step begin)+sourceN count begin = S.fold (A.createOf value) (S.unfoldr step begin) where step i = if i > begin + count@@ -74,11 +83,11 @@ {-# INLINE foldl #-} foldl :: MonadIO m => Stream Int -> m Int-foldl = S.fold Fold.sum . S.unfold A.read+foldl = S.fold Fold.sum . S.unfold A.reader {-# INLINE last #-} last :: P.Monad m => Stream Int -> m (Maybe Int)-last arr = P.return (A.getIndex arr (A.length arr P.- 1))+last arr = P.return (A.getIndex (A.length arr P.- 1) arr) ------------------------------------------------------------------------------- -- Transformation@@ -92,17 +101,17 @@ {-# INLINE composeN #-} composeN- :: S.MonadAsync m+ :: MonadIO m => Int- -> (S.SerialT m Int -> S.SerialT m Int)+ -> (S.Stream m Int -> S.Stream m Int) -> Stream Int -> m (Stream Int) composeN n f x = case n of- 1 -> S.fold A.write $ f $ S.unfold A.read x- 2 -> S.fold A.write $ f . f $ S.unfold A.read x- 3 -> S.fold A.write $ f . f . f $ S.unfold A.read x- 4 -> S.fold A.write $ f . f . f . f $ S.unfold A.read x+ 1 -> S.fold A.create $ f $ S.unfold A.reader x+ 2 -> S.fold A.create $ f . f $ S.unfold A.reader x+ 3 -> S.fold A.create $ f . f . f $ S.unfold A.reader x+ 4 -> S.fold A.create $ f . f . f . f $ S.unfold A.reader x _ -> undefined {-# INLINE scan #-}@@ -122,10 +131,10 @@ filterEven, filterAllOut, filterAllIn, takeOne, takeAll, takeWhileTrue, dropOne, dropAll, dropWhileTrue, dropWhileFalse- :: S.MonadAsync m => Int -> Stream Int -> m (Stream Int)+ :: MonadIO m => Int -> Stream Int -> m (Stream Int) -scan n = composeN n $ S.scanl' (+) 0-map n = composeN n $ S.map (+1)+scan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0)+map n = composeN n $ fmap (+1) mapM n = composeN n $ S.mapM (\x -> P.return $ x + 1) filterEven n = composeN n $ S.filter even filterAllOut n = composeN n $ S.filter (> maxValue)@@ -148,9 +157,9 @@ {-# INLINE iterateSource #-} iterateSource :: MonadIO m- => (S.SerialT m Int -> S.SerialT m Int) -> Int -> Int -> m (Stream Int)+ => (S.Stream m Int -> S.Stream m Int) -> Int -> Int -> m (Stream Int) iterateSource g i n =- sourceN iterStreamLen n P.>>= \a -> S.fold A.write (f i $ S.unfold A.read a)+ sourceN iterStreamLen n P.>>= \a -> S.fold A.create (f i $ S.unfold A.reader a) where f (0 :: Int) m = g m f x m = g (f (x P.- 1) m)@@ -164,17 +173,16 @@ {-# INLINE iterateDropWhileTrue #-} iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue ::- S.MonadAsync m => Int -> m (Stream Int)---- this is quadratic-iterateScan n = iterateSource (S.scanl' (+) 0) (maxIters `P.div` 100) n-iterateDropWhileFalse n =- iterateSource (S.dropWhile (> maxValue)) (maxIters `P.div` 100) n+ MonadIO m => Int -> m (Stream Int) +-- Scan increases the size of the stream by 1, drop 1 to not blow up the size+-- due to many iterations.+iterateScan n = iterateSource (S.drop 1 . S.scanl (Scanl.mkScanl (+) 0)) (maxIters `div` 100) n iterateMapM n = iterateSource (S.mapM P.return) maxIters n iterateFilterEven n = iterateSource (S.filter even) maxIters n iterateTakeAll n = iterateSource (S.take maxValue) maxIters n iterateDropOne n = iterateSource (S.drop 1) maxIters n+iterateDropWhileFalse n = iterateSource (S.dropWhile (> maxValue)) (maxIters `div` 100) n iterateDropWhileTrue n = iterateSource (S.dropWhile (<= maxValue)) maxIters n -------------------------------------------------------------------------------@@ -193,18 +201,18 @@ {-# INLINE filterMap #-} scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop, filterTake, filterScan, filterMap- :: S.MonadAsync m => Int -> Stream Int -> m (Stream Int)+ :: MonadIO m => Int -> Stream Int -> m (Stream Int) -scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0-dropMap n = composeN n $ S.map (subtract 1) . S.drop 1-dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1+scanMap n = composeN n $ fmap (subtract 1) . S.scanl (Scanl.mkScanl (+) 0)+dropMap n = composeN n $ fmap (subtract 1) . S.drop 1+dropScan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0) . S.drop 1 takeDrop n = composeN n $ S.drop 1 . S.take maxValue-takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue-takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue+takeScan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0) . S.take maxValue+takeMap n = composeN n $ fmap (subtract 1) . S.take maxValue filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue) filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)-filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)-filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)+filterScan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0) . S.filter (<= maxBound)+filterMap n = composeN n $ fmap (subtract 1) . S.filter (<= maxValue) ------------------------------------------------------------------------------- -- Zipping and concat@@ -220,3 +228,6 @@ concat :: Stream Int -> () concat src = transform $ (S.concatMap (S.replicate 3) src) -}++main :: P.IO ()+main = $(defaultMain "StreamlyArray")
Benchmarks/StreamlyPure.hs view
@@ -8,27 +8,35 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} module Benchmarks.StreamlyPure where +import Benchmarks.DefaultMain (defaultMain) import Benchmarks.Common (value, maxValue, appendValue) import Data.Functor.Identity (Identity, runIdentity) import Prelude (Int, (+), ($), (.), even, (>), (<=),- subtract, undefined, Maybe(..), foldMap, maxBound)+ subtract, undefined, Maybe(..), maxBound, fmap) import qualified Prelude as P -import qualified Streamly.Prelude as S+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Scanl as Scanl+import qualified Streamly.Data.Stream as S+import qualified Streamly.Data.StreamK as K ------------------------------------------------------------------------------- -- Stream generation ------------------------------------------------------------------------------- -type Stream = S.SerialT Identity+type Stream = S.Stream Identity+type StreamK = K.StreamK Identity +maxElem :: Int+maxElem = maxBound+ {-# INLINE source #-} source :: Int -> Stream Int- source n = S.unfoldr step n where step cnt =@@ -37,8 +45,8 @@ else (Just (cnt, cnt + 1)) {-# INLINE sourceN #-}-sourceN :: Int -> Int -> Stream Int-sourceN count begin = S.unfoldr step begin+sourceN :: Int -> Int -> StreamK Int+sourceN count begin = K.fromStream $ S.unfoldr step begin where step i = if i > begin + count@@ -50,12 +58,14 @@ ------------------------------------------------------------------------------- {-# INLINE appendSourceR #-}-appendSourceR :: Int -> Stream Int-appendSourceR n = foldMap S.fromPure [n..n+appendValue]+appendSourceR :: Int -> Identity ()+appendSourceR n =+ K.drain $ P.foldr K.append K.nil (P.map K.fromPure [n..n+appendValue]) {-# INLINE appendSourceL #-}-appendSourceL :: Int -> Stream Int-appendSourceL n = P.foldl (P.<>) S.nil (P.map S.fromPure [n..n+appendValue])+appendSourceL :: Int -> Identity ()+appendSourceL n =+ K.drain $ P.foldl K.append K.nil (P.map K.fromPure [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination@@ -82,12 +92,12 @@ toList = evalF . runIdentity . S.toList {-# INLINE foldl #-}-foldl :: Stream Int -> Int-foldl = runIdentity . S.foldl' (+) 0+foldl :: Stream Int -> Int+foldl = runIdentity . S.fold (Fold.foldl' (+) 0) {-# INLINE last #-}-last :: Stream Int -> Maybe Int-last = runIdentity . S.last+last :: Stream Int -> Maybe Int+last = runIdentity . S.fold Fold.latest ------------------------------------------------------------------------------- -- Transformation@@ -127,8 +137,8 @@ dropOne, dropAll, dropWhileTrue, dropWhileFalse :: Int -> Stream Int -> () -scan n = composeN n $ S.scanl' (+) 0-map n = composeN n $ S.map (+1)+scan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0)+map n = composeN n $ fmap (+1) mapM = map filterEven n = composeN n $ S.filter even filterAllOut n = composeN n $ S.filter (> maxValue)@@ -150,31 +160,45 @@ maxIters = 100000 {-# INLINE iterateSource #-}-iterateSource :: (Stream Int -> Stream Int) -> Int -> Int -> Stream Int+iterateSource+ :: (StreamK Int -> StreamK Int)+ -> Int+ -> Int+ -> StreamK Int iterateSource g i n = f i (sourceN iterStreamLen n)+ where- f (0 :: Int) m = g m- f x m = g (f (x P.- 1) m) -{-# INLINE iterateScan #-}-{-# INLINE iterateFilterEven #-}-{-# INLINE iterateTakeAll #-}-{-# INLINE iterateDropOne #-}-{-# INLINE iterateDropWhileFalse #-}-{-# INLINE iterateDropWhileTrue #-}-iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,+ f (0 :: Int) m = g m+ f x m = g (f (x P.- 1) m)++iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue :: Int -> Stream Int --- this is quadratic-iterateScan n = iterateSource (S.scanl' (+) 0) (maxIters `P.div` 100) n-iterateDropWhileFalse n =- iterateSource (S.dropWhile (> maxValue)) (maxIters `P.div` 100) n+-- Scan increases the size of the stream by 1, drop 1 to not blow up the size+-- due to many iterations.+iterateScan n = K.toStream $ iterateSource (K.fromStream . S.drop 1 . S.scanl (Scanl.mkScanl (+) 0) . K.toStream) (maxIters `P.div` 100) n+-- iterateScan n = K.toStream $ iterateSource (K.scanl' (+) 0) (maxIters `div` 100) n -iterateFilterEven n = iterateSource (S.filter even) maxIters n-iterateTakeAll n = iterateSource (S.take maxValue) maxIters n-iterateDropOne n = iterateSource (S.drop 1) maxIters n-iterateDropWhileTrue n = iterateSource (S.dropWhile (<= maxValue)) maxIters n+-- iterateMapM n = K.toStream $ iterateSource (K.fromStream . S.mapM return . K.toStream) maxIters n+iterateMapM n = K.toStream $ iterateSource (K.mapM P.return) maxIters n +-- The D version is very slow, investigate why.+-- iterateDropWhileFalse n = K.toStream $ iterateSource (K.fromStream . S.dropWhile (> maxElem) . K.toStream) maxIters n+iterateDropWhileFalse n = K.toStream $ iterateSource (K.dropWhile (> maxElem)) maxIters n++-- iterateTakeAll n = K.toStream $ iterateSource (K.fromStream . S.take maxValue . K.toStream) maxIters n+iterateTakeAll n = K.toStream $ iterateSource (K.take maxValue) maxIters n++iterateFilterEven n = K.toStream $ iterateSource (K.fromStream . S.filter even . K.toStream) maxIters n+-- iterateFilterEven n = K.toStream $ iterateSource (K.filter even) maxIters n++iterateDropOne n = K.toStream $ iterateSource (K.fromStream . S.drop 1 . K.toStream) maxIters n+-- iterateDropOne n = K.toStream $ iterateSource (K.drop 1) maxIters n++-- iterateDropWhileTrue n = K.toStream $ iterateSource (K.fromStream . S.dropWhile (<= maxElem) . K.toStream) maxIters n+iterateDropWhileTrue n = K.toStream $ iterateSource (K.dropWhile (<= maxElem)) maxIters n+ ------------------------------------------------------------------------------- -- Mixed Composition -------------------------------------------------------------------------------@@ -193,26 +217,29 @@ filterTake, filterScan, filterMap :: Int -> Stream Int -> () -scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0-dropMap n = composeN n $ S.map (subtract 1) . S.drop 1-dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1+scanMap n = composeN n $ fmap (subtract 1) . S.scanl (Scanl.mkScanl (+) 0)+dropMap n = composeN n $ fmap (subtract 1) . S.drop 1+dropScan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0) . S.drop 1 takeDrop n = composeN n $ S.drop 1 . S.take maxValue-takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue-takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue+takeScan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0) . S.take maxValue+takeMap n = composeN n $ fmap (subtract 1) . S.take maxValue filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue) filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)-filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)-filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)+filterScan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0) . S.filter (<= maxBound)+filterMap n = composeN n $ fmap (subtract 1) . S.filter (<= maxValue) ------------------------------------------------------------------------------- -- Zipping and concat ------------------------------------------------------------------------------- --- {-# INLINE zip #-}--- zip :: Stream Int -> ()--- zip src = runIdentity $ S.foldr (\(x,y) xs -> P.seq x (P.seq y xs)) ()--- $ S.zipWith (,) src src+{-# INLINE zip #-}+zip :: Stream Int -> ()+zip src = runIdentity $ S.foldr (\(x,y) xs -> P.seq x (P.seq y xs)) ()+ $ S.zipWith (,) src src {-# INLINE concatMap #-} concatMap :: Stream Int -> () concatMap src = transform $ (S.concatMap (S.replicate 3) src)++main :: P.IO ()+main = $(defaultMain "StreamlyPure")
Benchmarks/Text.hs view
@@ -6,9 +6,11 @@ -- Maintainer : harendra.kumar@gmail.com {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} module Benchmarks.Text where +import Benchmarks.DefaultMain (defaultMain) -- import Benchmarks.Common (value, maxValue, appendValue) import Prelude (Int, (+), ($), (.), even, (>), (<=), undefined, Maybe(..), Char)@@ -50,12 +52,14 @@ ------------------------------------------------------------------------------- {-# INLINE appendSourceR #-}-appendSourceR :: Int -> Stream Element-appendSourceR n = P.foldr (S.append) S.empty (P.map (S.singleton . chr) [n..n+nAppends])+appendSourceR :: Int -> ()+appendSourceR n =+ toNull $ P.foldr (S.append) S.empty (P.map (S.singleton . chr) [n..n+nAppends]) {-# INLINE appendSourceL #-}-appendSourceL :: Int -> Stream Element-appendSourceL n = P.foldl (S.append) S.empty (P.map (S.singleton . chr) [n..n+nAppends])+appendSourceL :: Int -> ()+appendSourceL n =+ toNull $ P.foldl (S.append) S.empty (P.map (S.singleton . chr) [n..n+nAppends]) ------------------------------------------------------------------------------- -- Elimination@@ -174,15 +178,14 @@ iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue :: Int -> Stream Element --- this is quadratic -- XXX using scanl instead of scanl'-iterateScan n = iterateSource (S.scanl plus (chr 0)) (maxIters `P.div` 100) n-iterateDropWhileFalse n =- iterateSource (S.dropWhile (> maxElem)) (maxIters `P.div` 100) n-+-- Scan increases the size of the stream by 1, drop 1 to not blow up the size+-- due to many iterations.+iterateScan n = iterateSource (S.drop 1 . S.scanl plus (chr 0)) maxIters n iterateFilterEven n = iterateSource (S.filter (even . ord)) maxIters n iterateTakeAll n = iterateSource (S.take nElements) maxIters n iterateDropOne n = iterateSource (S.drop 1) maxIters n+iterateDropWhileFalse n = iterateSource (S.dropWhile (> maxElem)) maxIters n iterateDropWhileTrue n = iterateSource (S.dropWhile (<= maxElem)) maxIters n -------------------------------------------------------------------------------@@ -226,3 +229,6 @@ {-# INLINE concatMap #-} concatMap :: Stream Element -> () concatMap src = transform $ (S.concatMap (S.pack . P.replicate 3) src)++main :: P.IO ()+main = $(defaultMain "Text")
Benchmarks/Vector.hs view
@@ -7,219 +7,13 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} module Benchmarks.Vector where -import Foreign.Storable (Storable)-import Benchmarks.Common (value, maxValue, appendValue)-import Prelude (Int, (+), ($), (.), even, (>), (<=), subtract, undefined,- maxBound, Maybe(..))-import qualified Prelude as P---- import qualified Data.Vector as S-import qualified Data.Vector.Storable as S--- import qualified Data.Vector.Unboxed as S------------------------------------------------------------------------------------ Stream generation and elimination----------------------------------------------------------------------------------type Stream = S.Vector--{-# INLINE source #-}-source :: Int -> Stream Int--- source v = S.fromList [v..v+value]--source n = S.unfoldr step n- where- step cnt =- if cnt > n + value- then Nothing- else (Just (cnt, cnt + 1))--{-# INLINE sourceN #-}-sourceN :: Int -> Int -> Stream Int-sourceN count begin = S.unfoldr step begin- where- step i =- if i > begin + count- then Nothing- else (Just (i, i + 1))------------------------------------------------------------------------------------ Append----------------------------------------------------------------------------------{-# INLINE appendSourceR #-}-appendSourceR :: Int -> Stream Int-appendSourceR n =- P.foldr (S.++) S.empty (P.map S.singleton [n..n+appendValue])--{-# INLINE appendSourceL #-}-appendSourceL :: Int -> Stream Int-appendSourceL n = P.foldl (S.++) S.empty (P.map S.singleton [n..n+appendValue])------------------------------------------------------------------------------------ Elimination------------------------------------------------------------------------------------ Using NFData for evaluation may be fraught with problems because of a--- non-optimal implementation of NFData instance. So we just evaluate each--- element of the stream using a fold.-{-# INLINE eval #-}-eval :: Storable a => Stream a -> ()-eval = S.foldr P.seq ()---- eval foldable-{-# INLINE evalF #-}-evalF :: P.Foldable t => t a -> ()-evalF = P.foldr P.seq ()--{-# INLINE toNull #-}-toNull :: Stream Int -> ()-toNull = eval--{-# INLINE toList #-}-toList :: Stream Int -> ()-toList = evalF . S.toList--{-# INLINE foldl #-}-foldl :: Stream Int -> Int-foldl = S.foldl' (+) 0--{-# INLINE last #-}-last :: Stream Int -> Int-last = S.last------------------------------------------------------------------------------------ Transformation----------------------------------------------------------------------------------{-# INLINE transform #-}-transform :: Storable a => Stream a -> ()-transform = eval--{-# INLINE composeN #-}-composeN :: Int -> (Stream Int -> Stream Int) -> Stream Int -> ()-composeN n f =- case n of- 1 -> transform . f- 2 -> transform . f . f- 3 -> transform . f . f . f- 4 -> transform . f . f . f . f- _ -> undefined--{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE mapM #-}-{-# INLINE filterEven #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropOne #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE dropWhileFalse #-}-scan, map, mapM,- filterEven, filterAllOut, filterAllIn,- takeOne, takeAll, takeWhileTrue,- dropOne, dropAll, dropWhileTrue, dropWhileFalse- :: Int -> Stream Int -> ()--scan n = composeN n $ S.scanl' (+) 0-map n = composeN n $ S.map (+1)-mapM = map-filterEven n = composeN n $ S.filter even-filterAllOut n = composeN n $ S.filter (> maxValue)-filterAllIn n = composeN n $ S.filter (<= maxValue)-takeOne n = composeN n $ S.take 1-takeAll n = composeN n $ S.take maxValue-takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)-dropOne n = composeN n $ S.drop 1-dropAll n = composeN n $ S.drop maxValue-dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)-dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)------------------------------------------------------------------------------------ Iteration----------------------------------------------------------------------------------iterStreamLen, maxIters :: Int-iterStreamLen = 10-maxIters = 100000--{-# INLINE iterateSource #-}-iterateSource :: (Stream Int -> Stream Int) -> Int -> Int -> Stream Int-iterateSource g i n = f i (sourceN iterStreamLen n)- where- f (0 :: Int) m = g m- f x m = g (f (x P.- 1) m)--{-# INLINE iterateScan #-}-{-# INLINE iterateFilterEven #-}-{-# INLINE iterateTakeAll #-}-{-# INLINE iterateDropOne #-}-{-# INLINE iterateDropWhileFalse #-}-{-# INLINE iterateDropWhileTrue #-}-iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,- iterateDropWhileFalse, iterateDropWhileTrue :: Int -> Stream Int---- this is quadratic-iterateScan n = iterateSource (S.scanl' (+) 0) (maxIters `P.div` 100) n-iterateDropWhileFalse n =- iterateSource (S.dropWhile (> maxValue)) (maxIters `P.div` 100) n--iterateFilterEven n = iterateSource (S.filter even) maxIters n-iterateTakeAll n = iterateSource (S.take maxValue) maxIters n-iterateDropOne n = iterateSource (S.drop 1) maxIters n-iterateDropWhileTrue n = iterateSource (S.dropWhile (<= maxValue)) maxIters n------------------------------------------------------------------------------------ Mixed Composition----------------------------------------------------------------------------------{-# INLINE scanMap #-}-{-# INLINE dropMap #-}-{-# INLINE dropScan #-}-{-# INLINE takeDrop #-}-{-# INLINE takeScan #-}-{-# INLINE takeMap #-}-{-# INLINE filterDrop #-}-{-# INLINE filterTake #-}-{-# INLINE filterScan #-}-{-# INLINE filterMap #-}-scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,- filterTake, filterScan, filterMap- :: Int -> Stream Int -> ()--scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0-dropMap n = composeN n $ S.map (subtract 1) . S.drop 1-dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1-takeDrop n = composeN n $ S.drop 1 . S.take maxValue-takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue-takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue-filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)-filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)-filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)-filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)------------------------------------------------------------------------------------ Zipping and concat----------------------------------------------------------------------------------#define STORABLE_VECTOR-{-# INLINE zip #-}-#ifndef STORABLE_VECTOR-zip :: Stream Int -> ()-zip src = P.foldr (\(x,y) xs -> P.seq x (P.seq y xs)) ()- $ S.zipWith (,) src src-#else-zip :: Stream Int -> Stream Int-zip src = S.zipWith (+) src src-#endif+import Benchmarks.DefaultMain (defaultMain)+#define VECTOR_BOXED+#include "VectorCommon.hs" -{-# INLINE concatMap #-}-concatMap :: Stream Int -> ()-concatMap src = transform $ (S.concatMap (S.replicate 3) src)+main :: P.IO ()+main = $(defaultMain "Vector")
+ Benchmarks/VectorCommon.hs view
@@ -0,0 +1,230 @@+-- |+-- Module : Benchmarks.Vector+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : MIT+-- Maintainer : harendra.kumar@gmail.com++-- {-# LANGUAGE CPP #-}+-- {-# LANGUAGE ScopedTypeVariables #-}++import Benchmarks.Common (value, maxValue, appendValue)+import Prelude (Int, (+), ($), (.), even, (>), (<=), subtract, undefined,+ maxBound, Maybe(..))+import qualified Prelude as P++#ifdef VECTOR_BOXED+import qualified Data.Vector as S+#define CONSTRAINT(a)+#elif defined (VECTOR_UNBOXED)+#define CONSTRAINT(a) S.Unbox a =>+import qualified Data.Vector.Unboxed as S+#else+#define CONSTRAINT(a) Storable a =>+import Foreign.Storable (Storable)+import qualified Data.Vector.Storable as S+#endif++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++type Stream = S.Vector++{-# INLINE source #-}+source :: Int -> Stream Int+-- source v = S.fromList [v..v+value]++source n = let v = S.unfoldr step n in v S.++ S.singleton (S.unsafeLast v)+ where+ step cnt =+ if cnt > n + value+ then Nothing+ else (Just (cnt, cnt + 1))++{-# INLINE sourceN #-}+sourceN :: Int -> Int -> Stream Int+sourceN count begin = let v = S.unfoldr step begin in v S.++ S.singleton (S.unsafeLast v)+ where+ step i =+ if i > begin + count+ then Nothing+ else (Just (i, i + 1))++-------------------------------------------------------------------------------+-- Append+-------------------------------------------------------------------------------++{-# INLINE appendSourceR #-}+appendSourceR :: Int -> ()+appendSourceR n =+ toNull $ P.foldr (S.++) S.empty (P.map S.singleton [n..n+appendValue])++{-# INLINE appendSourceL #-}+appendSourceL :: Int -> ()+appendSourceL n =+ toNull $ P.foldl (S.++) S.empty (P.map S.singleton [n..n+appendValue])++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++-- Using NFData for evaluation may be fraught with problems because of a+-- non-optimal implementation of NFData instance. So we just evaluate each+-- element of the stream using a fold.+{-# INLINE eval #-}+eval :: CONSTRAINT(a) Stream a -> ()+eval = S.foldr P.seq ()++-- eval foldable+{-# INLINE evalF #-}+evalF :: P.Foldable t => t a -> ()+evalF = P.foldr P.seq ()++{-# INLINE toNull #-}+toNull :: Stream Int -> ()+toNull = eval++{-# INLINE toList #-}+toList :: Stream Int -> ()+toList = evalF . S.toList++{-# INLINE foldl #-}+foldl :: Stream Int -> Int+foldl = S.foldl' (+) 0++{-# INLINE last #-}+last :: Stream Int -> Int+last = S.last++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE transform #-}+transform :: CONSTRAINT(a) Stream a -> ()+transform = eval++{-# INLINE composeN #-}+composeN :: Int -> (Stream Int -> Stream Int) -> Stream Int -> ()+composeN n f x =+ case n of+ 1 -> (transform . f) x+ 2 -> (transform . f . f) x+ 3 -> (transform . f . f . f) x+ 4 -> let v = (f . f . f . f) x in transform (v S.++ S.singleton (S.unsafeLast v))+ _ -> undefined++{-# INLINE scan #-}+{-# INLINE map #-}+{-# INLINE mapM #-}+{-# INLINE filterEven #-}+{-# INLINE filterAllOut #-}+{-# INLINE filterAllIn #-}+{-# INLINE takeOne #-}+{-# INLINE takeAll #-}+{-# INLINE takeWhileTrue #-}+{-# INLINE dropOne #-}+{-# INLINE dropAll #-}+{-# INLINE dropWhileTrue #-}+{-# INLINE dropWhileFalse #-}+scan, map, mapM,+ filterEven, filterAllOut, filterAllIn,+ takeOne, takeAll, takeWhileTrue,+ dropOne, dropAll, dropWhileTrue, dropWhileFalse+ :: Int -> Stream Int -> ()++scan n = composeN n $ S.scanl' (+) 0+map n = composeN n $ S.map (+1)+mapM = map+filterEven n = composeN n $ S.filter even+filterAllOut n = composeN n $ S.filter (> maxValue)+filterAllIn n = composeN n $ S.filter (<= maxValue)+takeOne n = composeN n $ S.take 1+takeAll n = composeN n $ S.take maxValue+takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)+dropOne n = composeN n $ S.drop 1+dropAll n = composeN n $ S.drop maxValue+dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)+dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)++-------------------------------------------------------------------------------+-- Iteration+-------------------------------------------------------------------------------++iterStreamLen, maxIters :: Int+iterStreamLen = 10+maxIters = 100000++{-# INLINE iterateSource #-}+iterateSource :: (Stream Int -> Stream Int) -> Int -> Int -> Stream Int+iterateSource g i n = f i (sourceN iterStreamLen n)+ where+ f (0 :: Int) m = g m+ f x m = g (f (x P.- 1) m)++{-# INLINE iterateScan #-}+{-# INLINE iterateFilterEven #-}+{-# INLINE iterateTakeAll #-}+{-# INLINE iterateDropOne #-}+{-# INLINE iterateDropWhileFalse #-}+{-# INLINE iterateDropWhileTrue #-}+iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,+ iterateDropWhileFalse, iterateDropWhileTrue :: Int -> Stream Int++-- Scan increases the size of the stream by 1, drop 1 to not blow up the size+-- due to many iterations.+iterateScan n = iterateSource (S.drop 1 . S.scanl' (+) 0) maxIters n+iterateFilterEven n = iterateSource (S.filter even) maxIters n+iterateTakeAll n = iterateSource (S.take maxValue) maxIters n+iterateDropOne n = iterateSource (S.drop 1) maxIters n+iterateDropWhileFalse n = iterateSource (S.dropWhile (> maxValue)) maxIters n+iterateDropWhileTrue n = iterateSource (S.dropWhile (<= maxValue)) maxIters n++-------------------------------------------------------------------------------+-- Mixed Composition+-------------------------------------------------------------------------------++{-# INLINE scanMap #-}+{-# INLINE dropMap #-}+{-# INLINE dropScan #-}+{-# INLINE takeDrop #-}+{-# INLINE takeScan #-}+{-# INLINE takeMap #-}+{-# INLINE filterDrop #-}+{-# INLINE filterTake #-}+{-# INLINE filterScan #-}+{-# INLINE filterMap #-}+scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,+ filterTake, filterScan, filterMap+ :: Int -> Stream Int -> ()++scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1+takeDrop n = composeN n $ S.drop 1 . S.take maxValue+takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue+takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue+filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)+filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)+filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)++-------------------------------------------------------------------------------+-- Zipping and concat+-------------------------------------------------------------------------------++#define STORABLE_VECTOR+{-# INLINE zip #-}+#ifndef STORABLE_VECTOR+zip :: Stream Int -> ()+zip src = P.foldr (\(x,y) xs -> P.seq x (P.seq y xs)) ()+ $ S.zipWith (,) src src+#else+zip :: Stream Int -> Stream Int+zip src = S.zipWith (+) src src+#endif++{-# INLINE concatMap #-}+concatMap :: Stream Int -> ()+concatMap src = transform $ (S.concatMap (S.replicate 3) src)
+ Benchmarks/VectorStorable.hs view
@@ -0,0 +1,18 @@+-- |+-- Module : Benchmarks.Vector+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : MIT+-- Maintainer : harendra.kumar@gmail.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}++module Benchmarks.VectorStorable where++import Benchmarks.DefaultMain (defaultMain)+#include "VectorCommon.hs"++main :: P.IO ()+main = $(defaultMain "VectorStorable")
Benchmarks/VectorStreams.hs view
@@ -7,12 +7,14 @@ -- Maintainer : harendra.kumar@gmail.com {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} module Benchmarks.VectorStreams where +import Benchmarks.DefaultMain (defaultMain) import Benchmarks.Common (value, maxValue, appendValue) import Prelude- (Monad, Int, (+), ($), (.), return, even, (>), (<=), div,+ (Monad, Int, (+), ($), (.), return, even, (>), (<=), subtract, undefined, Maybe(..)) import qualified Prelude as P @@ -60,12 +62,14 @@ ------------------------------------------------------------------------------- {-# INLINE appendSourceR #-}-appendSourceR :: Monad m => Int -> Stream m Int-appendSourceR n = P.foldr (S.++) S.empty (P.map S.singleton [n..n+appendValue])+appendSourceR :: Int -> P.IO ()+appendSourceR n =+ toNull $ P.foldr (S.++) S.empty (P.map S.singleton [n..n+appendValue]) {-# INLINE appendSourceL #-}-appendSourceL :: Monad m => Int -> Stream m Int-appendSourceL n = P.foldl (S.++) S.empty (P.map S.singleton [n..n+appendValue])+appendSourceL :: Int -> P.IO ()+appendSourceL n =+ toNull $ P.foldl (S.++) S.empty (P.map S.singleton [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination@@ -169,15 +173,14 @@ iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue :: Monad m => Int -> Stream m Int --- this is quadratic-iterateScan n = iterateSource (S.scanl' (+) 0) (maxIters `div` 100) n-iterateDropWhileFalse n =- iterateSource (S.dropWhile (> maxValue)) (maxIters `div` 100) n-+-- Scan increases the size of the stream by 1, drop 1 to not blow up the size+-- due to many iterations.+iterateScan n = iterateSource (S.drop 1 . S.scanl' (+) 0) maxIters n iterateMapM n = iterateSource (S.mapM return) maxIters n iterateFilterEven n = iterateSource (S.filter even) maxIters n iterateTakeAll n = iterateSource (S.take maxValue) maxIters n iterateDropOne n = iterateSource (S.drop 1) maxIters n+iterateDropWhileFalse n = iterateSource (S.dropWhile (> maxValue)) maxIters n iterateDropWhileTrue n = iterateSource (S.dropWhile (<= maxValue)) maxIters n -------------------------------------------------------------------------------@@ -220,3 +223,6 @@ {-# INLINE concatMap #-} concatMap :: Monad m => Stream m Int -> m () concatMap src = transform $ (S.concatMap (S.replicate 3) src)++main :: P.IO ()+main = $(defaultMain "VectorStreams")
+ Benchmarks/VectorUnboxed.hs view
@@ -0,0 +1,19 @@+-- |+-- Module : Benchmarks.Vector+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : MIT+-- Maintainer : harendra.kumar@gmail.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}++module Benchmarks.VectorUnboxed where++import Benchmarks.DefaultMain (defaultMain)+#define VECTOR_UNBOXED+#include "VectorCommon.hs"++main :: P.IO ()+main = $(defaultMain "VectorUnboxed")
Changelog.md view
@@ -1,3 +1,13 @@+## 0.4.1++* Support streamly-core-0.3.0 and streamly-0.11.0++## 0.4.0++* Add different streaming libraries under individual flags+* Use the external bench-report package and remove the shell scripts+* User streamly-core package (streamly-0.9.0 changes)+ ## 0.3.0 * Simplify the README, use text tables instead of graphs.
− Charts.hs
@@ -1,283 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Main where--import Control.Exception (catch, ErrorCall(..))-import Data.Char (isSpace)-import Data.List (reverse, sortOn, isPrefixOf)--- import Data.List (stripPrefix)-import Data.List.Split (splitOn)-import Data.Maybe (catMaybes)--- import Data.Maybe (fromJust)-import System.Exit (ExitCode(..))-import System.Process.Typed (readProcess)-import BenchShow-import WithCli (withCli)--import Data.List--import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.Encoding as T---- pairs of benchmark group titles and corresponding list of benchmark--- prefixes i.e. without the package name at the end.-charts :: [(String, [String])]-charts =- [- ( "Elimination Operations"- , [- "elimination/drain"- , "elimination/last"- , "elimination/foldl'"- ]- )- , ( "Transformation Operations"- , [ "transformation/map"- , "transformation/mapM"- , "transformation/scan"- ]- )- , ( "Transformation Operations x 4"- , [ "transformationX4/map x 4"- , "transformationX4/mapM x 4"- , "transformationX4/scan x 4"- ]- )- , ( "Filtering Operations"- , [- "filtering/filter-all-out"- , "filtering/filter-all-in"- , "filtering/drop-all"- , "filtering/takeWhile-true"- , "filtering/take-all"- , "filtering/dropWhile-true"- , "filtering/filter-even"- , "filtering/drop-one"- , "filtering/dropWhile-false"- ]- )- , ( "Filtering Operations x 4"- , [- "filteringX4/filter-all-out x 4"- , "filteringX4/takeWhile-true x 4"- , "filteringX4/filter-all-in x 4"- , "filteringX4/take-all x 4"- , "filteringX4/filter-even x 4"- , "filteringX4/drop-all x 4"- , "filteringX4/dropWhile-true x 4"- , "filteringX4/dropWhile-false x 4"- , "filteringX4/drop-one x 4"- ]- )- , ( "Mixed Operations x 4"- , [ "mixedX4/filter-map x 4"- , "mixedX4/take-map x 4"- , "mixedX4/drop-map x 4"- , "mixedX4/filter-drop x 4"- , "mixedX4/filter-take x 4"- , "mixedX4/take-drop x 4"- , "mixedX4/scan-map x 4"- , "mixedX4/filter-scan x 4"- , "mixedX4/take-scan x 4"- , "mixedX4/drop-scan x 4"- ]- )- , ( "Iterated Operations"- , [ "iterated/mapM"- , "iterated/scan[x0.01]"- , "iterated/filterEven"- , "iterated/takeAll"- , "iterated/dropOne"- , "iterated/dropWhileFalse[x0.01]"- , "iterated/dropWhileTrue"- ]- )- , ( "Append Operations"- , [ "appendR"- -- , "appendL"- ]- )- , ( "Zip Operation"- , [ "zip"- ]- )- , ( "Concat Operation"- , [ "concatMap"- , "concatMapFoldable"- ]- )- , ( "Conversion Operations"- , [ "elimination/toList"- ]- )- ]------------------------------------------------------------------------------------- returns [(packagename, version)]-getPkgVersions :: [String] -> IO [(String, String)]-getPkgVersions packages = do- (ecode, out, _) <- readProcess "stack list-dependencies --bench"-- case ecode of- ExitSuccess -> do- -- Get our streaming packages and their versions- let match [] = Nothing- match (_ : []) = Nothing- match (x : y : _) =- case elem x packages of- False -> Nothing- True -> Just (x, y)-- in return- $ catMaybes- $ map match- $ map words (lines (T.unpack $ T.decodeUtf8 out))- ExitFailure _ -> do- putStrLn $ "Warning! Cannot determine package versions, "- ++ "the 'stack list-dependencies' command failed."- return []---- suffix versions to packages-suffixVersion :: [(String, String)] -> String -> String-suffixVersion pkginfo p =- case lookup p pkginfo of- Nothing -> p- Just v -> p ++ "-" ++ v--ignoringErr :: IO () -> IO ()-ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->- putStrLn $ "Failed with error:\n" ++ err ++ "\nSkipping.")--createCharts :: String -> String -> Bool -> String -> Bool -> IO ()-createCharts input pkgList graphs delta versions = do- let packages = splitOn "," pkgList-- pkgInfo <-- if versions- then getPkgVersions packages- else return []-- let cmpStyle = case delta of- "absolute" -> Absolute- "multiples" -> Multiples- "percent" -> PercentDiff- x -> error $ "Unknown compare option: " ++ show x-- let bsort pxs bs =- let i = intersect (map (last . splitOn "/") pxs) bs- in i ++ (bs \\ i)- let cfg (t, prefixes) = defaultConfig- { mkTitle = Just t- , outputDir = Just "charts"- , presentation = Groups cmpStyle- , diffStrategy = SingleEstimator- , omitBaseline = True- , classifyBenchmark = \bm ->- case any (`isPrefixOf` bm) prefixes of- True ->- let xs = reverse (splitOn "/" bm)- grp = xs !! 0- bench = xs !! 1- in case grp `elem` packages of- True -> Just (suffixVersion pkgInfo grp, bench)- False -> Nothing- False -> Nothing- , selectGroups = \gs ->- let gs' = map fst gs- i = intersect (map (suffixVersion pkgInfo) packages) gs'- new = i ++ (gs' \\ i)- in nub $ concat $ map (\x -> filter (\(y,_) -> y == x) gs) new- , selectBenchmarks = \g -> bsort prefixes $- either error (map fst) $ g (ColumnIndex 0) Nothing- }-- -- links in README.rst eat up the space so we match the same- let toOutfile t = filter (not . isSpace) (takeWhile (/= '(') t)- packages' = packages- {-- let packages' = map (\x ->- if "pure-" `isPrefixOf` x- then fromJust (stripPrefix "pure-" x)- else x) packages-- let selectByRegression f =- reverse- $ fmap fst- $ either- (const $ either error id $ f (ColumnIndex 0) Nothing)- (sortOn snd)- $ f (ColumnIndex 1) Nothing-- let makeOneGraph infile (t, prefixes) = do- let title' fname =- if delta /= "absolute"- then t ++ " (" ++ fname ++ ") relative to " ++ packages' !! 0- else t ++ " (" ++ fname ++ ") (Lower is Better)"- cfg' = cfg (title', prefixes)- cfg'' =- if delta /= "absolute"- then cfg' { selectBenchmarks = selectByRegression }- else cfg'- if graphs- then ignoringErr $ graph infile (toOutfile t) cfg''- else ignoringErr $ report infile Nothing cfg''-- mapM_ (makeOneGraph input) charts- -}-- let cutOffByRegression p f =- let cmp = if delta == "absolute"- then Multiples- else cmpStyle- in reverse- $ fmap fst- $ filter (\(_,y) -> p y) . (sortOn snd)- $ either- (const $ either error id $ f (ColumnIndex 0) (Just cmp))- id- $ f (ColumnIndex 1) (Just cmp)-- -- Make a graph of all operations sorted based on performance regression in- -- descending order and operations below a 10% threshold filtered out.- let makeDiffGraph infile prefixes t p = do- let cfg' = (cfg (t, prefixes))- { presentation = Groups cmpStyle- , selectBenchmarks = cutOffByRegression p- }- if graphs- then ignoringErr $ graph infile (toOutfile (t "")) cfg'- else ignoringErr $ report infile Nothing cfg'-- -- compare two packages for best and worst operations- let makeTitle fname =- if delta /= "absolute"- then- let prefix = if delta == "percent"- then "Extra % "- else ""- connector = if delta == "multiples"- then "as multiples of"- else "wrt"- field = case fname of- "time" -> "time taken"- "maxrss" -> "memory used"- x -> x- pkg = if length packages' == 2- then "by '" ++ packages' !! 1 ++ "'"- else ""- in prefix ++ field ++ " " ++ pkg ++ " " ++ connector- ++ " '" ++ packages' !! 0 ++ "'"- else fname ++ " (Lower is Better)"- let p x =- case delta of- "absolute" -> True- "multiples" -> x < (-1.1) || x > 1.1- "percent" -> x < (-10) || x > 10- y -> error $ "Unknown compare option: " ++ show y- makeDiffGraph input (concatMap snd charts) makeTitle p---- Pass <input file> <comma separated list of packages> <True/False>-main :: IO ()-main = withCli createCharts
README.md view
@@ -8,7 +8,7 @@ This package provides micro-benchmarks to measure and compare the performance of various streaming implementations in Haskell. -We have taken due to care to make sure that we are+We have taken due care to make sure that we are benchmarking correctly and fairly. See [the notes on correct benchmarking](docs/benchmarking-notes.md). @@ -56,25 +56,37 @@ each library's code to the best of our knowledge, please point out if you find any measurement issues. -### Reproducing benchmark results+## Running Benchmarks -Commands to reproduce the benchmark results are provided in each section-below. But before you run those commands you need to build the reporting-tool once using the following command. Note that this command works with-only ghc-8.8.4 or lower. However, after building this tool you can run-the benchmarks with any GHC version.+You can run individual benchmarks using `cabal bench <target>`. You may+need to specify a build flag to include a particular streaming library+e.g. `--flag pipes` to benchmark the `pipes` library. Please consult the cabal+file to find the exact flag names. +### Generating Comparison Reports++You can generate the comparison reports presented in this page yourself.+To do so you need to run the benchmarks using the reporting tool, first build+the reporting tool using the following command:+ ```-$ cabal install --flag dev --installdir charts --with-compiler ghc-8.8.4 bench-report+$ cd bench-runner+$ cabal install --project-file cabal.project.user --installdir ../bin ``` -Nix users can use bench-report.nix. It uses an older version of nixpkgs that-contains the required dependencies:+If you want to create a report for benchmarks showing a 10% or greater+improvement with Streamly over Lists, use: ```-$ nix-shell bench-report.nix --run "cabal install --flag dev --installdir charts bench-report"+$ bin/bench-runner --package-name streaming-benchmarks --package-version 0.4.0 --compare --diff-cutoff-percent 10 --diff-style absolute --targets "StreamlyPure List" ``` +After running once, you can add `--no-measure` option to use the same benchmark+measurements for different reports. For example, use:++* `--diff-cutoff-percent -10` to know where lists are better than streamly+* `--diff-style multiples` to generate ratios instead of absolute values+ ### Streamly vs Haskell Lists Streamly, when used with `Identity` monad, is almost the same as Haskell lists@@ -86,7 +98,8 @@ [streamly](https://github.com/composewell/streamly) with lists using a one million element stream. For brevity only those operations where the performance of the two packages differ by-more than 10% are shown in the table below.+more than 10% are shown in the table below. The last column shows how+many times slower list is compared to streamly. | Benchmark | streamly(μs) | list(μs) | list/streamly | | ------------------- | ------------ | ---------- | ------------- |@@ -112,12 +125,9 @@ * streamly-0.8.0, base-4.14.1.0, ghc-8.10.4, Linux -To reproduce these results use the following commands:+To generate these reports run `bench-runner` with: -```-$ ./bench.sh --benchmarks "pure-streamly,list" --measure-$ ./bench.sh --benchmarks "pure-streamly,list" --diff multiples-```+* `--targets "StreamlyPure List"` ### Streamly vs Streaming @@ -168,12 +178,9 @@ * streamly-0.8.0, streaming-0.2.3.0, ghc-8.10.4, Linux -To reproduce these results use the following commands:+To generate these reports run `bench-runner` with: -```-$ ./bench.sh --benchmarks "streamly,streaming" --measure-$ ./bench.sh --benchmarks "streamly,streaming" --diff multiples-```+* `--targets "Streamly Streaming" --cabal-build-options "--flag streaming"` ### Streamly vs Pipes @@ -224,12 +231,9 @@ * streamly-0.8.0, pipes-4.3.16, ghc-8.10.4, Linux -To reproduce these results use the following commands:+To generate these reports run `bench-runner` with: -```-$ ./bench.sh --benchmarks "streamly,pipes" --measure-$ ./bench.sh --benchmarks "streamly,pipes" --diff multiples-```+* `--targets "Streamly Pipes" --cabal-build-options "--flag pipes"` ### Streamly vs Conduit @@ -280,31 +284,24 @@ * streamly-0.8.0, conduit-1.3.4.1, ghc-8.10.4, Linux -To reproduce these results use the following commands:--```-$ ./bench.sh --benchmarks "streamly,conduit" --measure-$ ./bench.sh --benchmarks "streamly,conduit" --diff multiples-```+To generate these reports run `bench-runner` with: -## Comparing other libraries+* `--targets "Streamly Conduit" --cabal-build-options "--flag conduit"` -This package supports many streaming libraries. Use the following command to-see all available benchmarks:+## Stack and heap utilization -```-$ ./bench.sh --help-```+`bench-runner` also generates a `maxrss` comparison report, displaying the+maximum resident memory for each benchmark. -You can then select the libraries you want to compare:+## Comparing other libraries -```-$ ./bench.sh --benchmarks "streaming,pipes" --measure-```+This package supports many streaming libraries, bytestring, text, vector etc.+You can run the benchmarks directly or use `bench-runner` to create comparison+reports. Check out the targets in the cabal file. ## Adding New Libraries -It is trivial to add a new package. This is how +It is trivial to add a new package. This is how [a benchmark file](https://github.com/composewell/streaming-benchmarks/blob/master/Benchmarks/Streamly.hs) for a streaming package looks like. Pull requests are welcome, we will be happy to help, [just join the gitter chat](https://gitter.im/composewell/streamly)
− bench-report.nix
@@ -1,50 +0,0 @@-{- nixpkgs ?- # nixpkgs 21.05 needs a revised version of bench-show and we do not- # know how to use a revised version in nix.- #import (builtins.fetchTarball https://github.com/NixOS/nixpkgs/archive/refs/tags/21.05.tar.gz)- import (builtins.fetchTarball https://github.com/composewell/nixpkgs/archive/01dd2b4e738.tar.gz)- {}-#, compiler ? "ghc884" # For nix 21.05-, compiler ? "default"-}:-let haskellPackages =- if compiler == "default"- then nixpkgs.haskellPackages- else nixpkgs.haskell.packages.${compiler};-- mkPackage = super: pkg: path: opts: inShell:- let orig = super.callCabal2nixWithOptions pkg path opts {};- in if inShell- # Avoid copying the source directory to nix store by using- # src = null.- then orig.overrideAttrs (oldAttrs: { src = null; })- else orig;-- mkHaskellPackages = inShell:- haskellPackages.override {- overrides = self: super:- with nixpkgs.haskell.lib;- {- streaming-benchmarks = mkPackage super "streaming-benchmarks" ./. "--flag dev" inShell;- };- };-- drv = mkHaskellPackages true;-- shell = drv.shellFor {- packages = p:- [ p.streaming-benchmarks- ];- # Use a better prompt- shellHook = ''- export CABAL_DIR="$(pwd)/.cabal.nix"- if test -n "$PS_SHELL"- then- export PS1="$PS_SHELL\[$bldred\](nix)\[$txtrst\] "- fi- '';- };-in if nixpkgs.lib.inNixShell- then shell- else (mkHaskellPackages false).streaming-benchmarks
+ bench-runner/Main.hs view
@@ -0,0 +1,60 @@+module Main (main) where++import BenchRunner (mainWith)+import BuildLib (Quickness(..))+import Control.Applicative ((<|>))+import Data.List (isInfixOf, isPrefixOf, isSuffixOf)++-- tags with _grp and _cmp suffixes are special+ -- [(<benchmark name>", [<tags>])]+targets :: [(String, [String])]+targets =+ [ ("StreamlyPure", ["pure_stream_cmp"])+ , ("List", ["pure_stream_cmp"])+ , ("Streamly", ["io_stream_cmp"])+ , ("ByteStringLazy", ["io_stream_cmp"])+ , ("VectorStreams", [])+ -- , ("Streaming", [])+ -- , ("Machines", [])+ -- , ("Pipes", [])+ -- , ("Conduit", [])+ -- , ("Drinkery", [])+ ]++rtsOpts :: String -> String -> String+rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific]++ where++ -- Drop All.+ benchName = drop 4 benchName0+ general+ -- | "o-1-sp" `isInfixOf` benchName = "-K36K -M16M"+ | otherwise = ""+ exeSpecific+ -- | "Prelude.Concurrent" `isSuffixOf` exeName = "-K512K -M384M"+ | otherwise = ""+ benchSpecific+ -- | "Data.Stream.StreamD/o-n-space.elimination.toList" == benchName = "-K2M"+ | otherwise = ""++speedOpts :: String -> String -> Maybe Quickness+speedOpts exeName benchName0 = exeSpecific <|> benchSpecific++ where++ -- slowestOf Quicker _ = Quicker+ -- slowestOf _ Quicker = Quicker+ -- slowestOf _ _ = SuperQuick++ -- Drop All.+ benchName = drop 4 benchName0+ exeSpecific+ -- | "Prelude.Concurrent" == exeName = Just SuperQuick+ | otherwise = Nothing+ benchSpecific+ -- | "Prelude.Parallel/o-n-heap.mapping.mapM" == benchName = Just SuperQuick+ | otherwise = Nothing++main :: IO ()+main = mainWith targets speedOpts rtsOpts
+ bench-runner/bench-runner.cabal view
@@ -0,0 +1,41 @@+cabal-version: 2.4+name: bench-runner+version: 0.1.0.0++-- A short (one-line) description of the package.+-- synopsis:++-- A longer description of the package.+-- description:++-- A URL where users can report bugs.+-- bug-reports:++-- The license under which the package is released.+-- license:++-- The package author(s).+-- author:++-- An email address to which users can send suggestions, bug reports, and patches.+-- maintainer:++-- A copyright notice.+-- copyright:+-- category:+-- extra-source-files: CHANGELOG.md++executable bench-runner+ ghc-options: -Wall+ main-is: Main.hs++ -- Modules included in this executable, other than Main.+ -- other-modules:++ -- LANGUAGE extensions used by modules in this package.+ -- other-extensions:+ build-depends: base+ , bench-report+ , containers+ hs-source-dirs: .+ default-language: Haskell2010
+ bench-runner/cabal.project.user view
@@ -0,0 +1,35 @@+packages: .++package bench-report+ flags: +no-charts++source-repository-package+ type: git+ location: https://github.com/composewell/streamly-coreutils.git+ tag: fa180060c7510c89d2767980ca6f7ec7011d04b9++source-repository-package+ type: git+ location: https://github.com/composewell/bench-report.git+ tag: 4dad3ea916a950524bcfd5097fc6f0f63e645987++-- source-repository-package+-- type: git+-- location: https://github.com/composewell/streamly.git+-- tag: 9a039b89c6b81300b2bd9c8765bf4bfa18e7c83c+-- +-- source-repository-package+-- type: git+-- location: https://github.com/composewell/streamly.git+-- tag: 9a039b89c6b81300b2bd9c8765bf4bfa18e7c83c+-- subdir: core+-- +-- source-repository-package+-- type: git+-- location: https://github.com/composewell/streamly-process.git+-- tag: c1ce40ebe84973d0c54dd27fb17e337bf9ca4a46+-- +-- source-repository-package+-- type: git+-- location: https://github.com/composewell/streamly-shell.git+-- tag: 070ff21fda7aab8ca45b08b330746299a91eb981
− bench.sh
@@ -1,325 +0,0 @@-#!/bin/bash--print_help () {- echo "Usage: $0 "- echo " [--benchmarks <streamly,vector,...>]"- echo " [--diff <percent|multiples>]"- echo " [--graphs]"- echo " [--measure]"- echo " [--append] "- echo " [--slow]"- echo " [--fast]"- echo " [--versions] "- echo " [--stack] "- echo " -- <gauge options>"- echo- echo "--benchmarks: specify comma separated list of packages to be compared"- echo- echo "Available benchmarks are: "- echo "Pure streams: list, pure-streamly, vector, sequence, dlist, bytestring, text"- echo "Monadic streams: streamly, streams-vector, streaming, pipes, conduit, machines, drinkery"- echo- echo "--graphs: generate SVG graphs instead of text reports"- echo "--diff: show diff of subsequent packages from the first package"- echo "--slow: slower but a bit more precise benchmarking"- echo "--fast: faster but a bit less precise benchmarking"- echo "--measure: rerun benchmark measurements"- echo "--append: append the new measurement results to previous ones for comparison"- echo "--versions: add package versions in the report/graphs"- echo "--stack: use stack for build and benchmark"- echo- echo "Any arguments after a '--' are passed directly to guage"- exit-}--# $1: message-die () {- >&2 echo -e "Error: $1"- exit 1-}--set_benchmarks() {- if test -z "$BENCHMARKS"- then- BENCHMARKS=$DEFAULT_BENCHMARKS- elif test "$BENCHMARKS" = "all"- then- BENCHMARKS=$ALL_BENCHMARKS- fi- echo "Using benchmark suites [$BENCHMARKS]"-}--# $1: benchmark name (linear, nested, base)-find_report_prog() {- local prog_name="bench-report"- hash -r- local prog_path=$($WHICH_COMMAND $prog_name)- if test -x "$prog_path"- then- echo $prog_path- else- if test -x "charts/$prog_name"- then echo "charts/$prog_name"- else- return 1- fi- fi-}--# $1: benchmark name (linear, nested, base)-build_report_prog() {- local prog_name="bench-report"- local prog_path=$($WHICH_COMMAND $prog_name)-- hash -r- if test -x "charts/$prog_name"- then return 0- fi- if test ! -x "$prog_path" -a "$BUILD_ONCE" = "0"- then- echo "Building bench-show executable"- BUILD_ONCE=1- $BUILD_CHART_EXE || die "build failed"- if test "$USE_STACK" -ne 1- then- cabal install --flag dev --installdir=charts bench-report- fi- elif test ! -x "$prog_path"- then- return 1- fi- return 0-}--build_report_progs() {- if test "$RAW" = "0"- then- build_report_prog || exit 1- local prog- prog=$(find_report_prog) || \- die "Cannot find bench-show executable"- echo "Using bench-show executable [$prog]"- fi-}--# We run the benchmarks in isolation in a separate process so that different-# benchmarks do not interfere with other. To enable that we need to pass the-# benchmark exe path to guage as an argument. Unfortunately it cannot find its-# own path currently.--# The path is dependent on the architecture and cabal version.-# Use this command to find the exe if this script fails with an error:-# find .stack-work/ -type f -name "benchmarks"--stack_bench_prog () {- local bench_name=$1- local bench_prog=`stack path --dist-dir`/build/$bench_name/$bench_name- if test -x "$bench_prog"- then- echo $bench_prog- else- return 1- fi-}--cabal_bench_prog () {- local bench_name=$1- local bench_prog=`$WHICH_COMMAND $1`- if test -x "$bench_prog"- then- echo $bench_prog- else- return 1- fi-}--bench_output_file() {- echo "charts/results.csv"-}--# --min-duration 0 means exactly one iteration per sample. We use a million-# iterations in the benchmarking code explicitly and do not use the iterations-# done by the benchmarking tool.-#-# Benchmarking tool by default discards the first iteration to remove-# aberrations due to initial evaluations etc. We do not discard it because we-# are anyway doing iterations in the benchmarking code and many of them so that-# any constant factor gets amortized and anyway it is a cost that we pay in-# real life.-#-# We can pass --min-samples value from the command line as second argument-# after the benchmark name in case we want to use more than one sample.--run_bench () {- local bench_name=$1- local output_file=$(bench_output_file $bench_name)- local bench_prog- bench_prog=$($GET_BENCH_PROG $bench_name) || \- die "Cannot find benchmark executable for benchmark $bench_name"-- mkdir -p `dirname $output_file`-- echo "Running benchmark $bench_name ..."-- local MATCH_ARGS=""- for i in $(echo $BENCHMARKS | tr "," "\n")- do- MATCH_ARGS="$MATCH_ARGS -m pattern /$i"- done-- $bench_prog $SPEED_OPTIONS \- --csvraw=$output_file \- -v 2 \- --measure-with $bench_prog $MATCH_ARGS $GAUGE_ARGS \- || die "Benchmarking failed"-}--run_benches() {- for i in $1- do- run_bench $i- done-}--backup_output_file() {- local bench_name=$1- local output_file=$(bench_output_file $bench_name)-- if test -e $output_file -a "$APPEND" != 1- then- mv -f -v $output_file ${output_file}.prev- fi-}--run_measurements() {- local bench_list=$1- local to_run-- for i in $bench_list- do- local output_file=$(bench_output_file $i)- if test "$MEASURE" = 1 -o ! -e $output_file- then- backup_output_file $i- to_run="$to_run $i"- fi- done-- run_benches "$to_run"-}--run_reports() {- local prog- prog=$(find_report_prog) || \- die "Cannot find bench-graph executable"- echo-- local output_file=$(bench_output_file)- echo "Generating reports for ${output_file}..."- $prog $output_file $1 $GRAPH $DELTA $VERSIONS-}--#------------------------------------------------------------------------------# Execution starts here-#-------------------------------------------------------------------------------DEFAULT_BENCHMARKS="streamly,streaming,conduit,pipes,machines"-ALL_BENCHMARKS="streamly,vector,streaming,conduit,pipes,machines,drinkery"-DELTA="absolute"--APPEND=0-RAW=0-GRAPH=False-VERSIONS=False-MEASURE=0-SPEED_OPTIONS="--quick --min-samples 10 --time-limit 1 --min-duration 0"--GAUGE_ARGS=-BUILD_ONCE=0-USE_STACK=0--GHC_VERSION=$(ghc --numeric-version)-STREAMING_BENCHMARKS_VERSION=0.3.0--cabal_which() {- find dist-newstyle -type f -path \- "*${GHC_VERSION}/streaming-benchmarks-$STREAMING_BENCHMARKS_VERSION/*/$1"-}--#------------------------------------------------------------------------------# Read command line-#-------------------------------------------------------------------------------while test -n "$1"-do- case $1 in- -h|--help|help) print_help ;;- # options with arguments- --slow) SPEED_OPTIONS="--min-duration 0"; shift ;;- --fast) SPEED_OPTIONS="--quick --min-samples 1 --min-duration 0 --include-first-iter"- shift ;;- --append) APPEND=1; shift ;;- --benchmarks) shift; BENCHMARKS=$1; shift ;;- --diff) shift; DELTA=$1; shift ;;- --raw) RAW=1; shift ;;- --graphs) GRAPH=True; shift ;;- --versions) VERSIONS=True; shift ;;- --stack) USE_STACK=1; shift ;;- --measure) MEASURE=1; shift ;;- --) shift; break ;;- -*|--*) print_help ;;- *) break ;;- esac-done-GAUGE_ARGS=$*--if test "$USE_STACK" = "1"-then- WHICH_COMMAND="stack exec which"- GET_BENCH_PROG=stack_bench_prog- BUILD_CHART_EXE="stack build"- BUILD_BENCH="stack build $STACK_BUILD_FLAGS --bench --no-run-benchmarks"-else- # XXX cabal issue "cabal v2-exec which" cannot find benchmark/test executables- #WHICH_COMMAND="cabal v2-exec which"- WHICH_COMMAND=cabal_which- GET_BENCH_PROG=cabal_bench_prog- BUILD_CHART_EXE="cabal v2-build --flag dev bench-report"- BUILD_BENCH="cabal v2-build $CABAL_BUILD_FLAGS --enable-benchmarks all"-fi--# echo "Using stack command [$STACK]"-set_benchmarks--#------------------------------------------------------------------------------# Build stuff-#-------------------------------------------------------------------------------# We need to build the report progs first at the current (latest) commit before-# checking out any other commit for benchmarking.-#build_report_progs "$BENCHMARKS"--if test ! -e charts/bench-report-then- echo "Please build the bench-report executable first."- echo "It requires ghc-8.8.4 or earlier"- echo- echo "cabal install --flag dev --installdir charts --with-compiler ghc-8.8.4 bench-report"- exit-fi--#------------------------------------------------------------------------------# Run benchmarks-#-------------------------------------------------------------------------------$BUILD_BENCH || die "build failed"-run_measurements bmarks--#------------------------------------------------------------------------------# Run reports-#-------------------------------------------------------------------------------if test "$RAW" = "0"-then- run_reports "$BENCHMARKS"-fi
+ lib/Benchmarks/BenchTH.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE TemplateHaskell #-}++module Benchmarks.BenchTH+ ( mkBench+ , mkBenchIO+ , mkBenchN+ , purePackages+ , monadicPackages+ , monadicArrays+ , allPackages+ ) where++import Benchmarks.Common+ (benchIO, benchIOAction, benchPure, benchPureFunc, benchIOArray)+import Language.Haskell.TH.Syntax (Q, Exp, mkName)+import Language.Haskell.TH.Lib (varE)++-- First item in the tuple is the module name and the second one is the+-- corresponding benchmark group name.+--+monadicPackages :: [(String, String)]+monadicPackages =+ [ ("Streamly", "streamly")+ , ("VectorStreams", "streams-vector")+ , ("Streaming", "streaming")+ , ("Machines", "machines")+ , ("Pipes", "pipes")+ , ("Conduit", "conduit")+ , ("Drinkery", "drinkery")+ ]++purePackages :: [(String, String)]+purePackages =+ [ -- stream like packages+ ("List", "list")+ , ("StreamlyPure", "pure-streamly")+ , ("DList", "dlist")+ , ("Sequence", "sequence")+ , ("ByteStringLazy", "lazy-bytestring")++ -- array like packages+ , ("ByteString", "bytestring")+ , ("Text", "text")+ , ("Vector", "vector")+ , ("VectorUnboxed", "unboxed-vector")+ , ("VectorStorable", "storable-vector")+ ]++monadicArrays :: [(String, String)]+monadicArrays = [("StreamlyArray", "array-streamly")]++allPackages :: [(String, String)]+allPackages =+ purePackages+ ++ monadicPackages+ ++ monadicArrays++-- mkBench <stream producer func> <stream consumer func> <module name>+-- <bench name>+mkBench :: String -> String -> String -> String -> Q Exp+mkBench f x mdl bname =+ case lookup mdl purePackages of+ Nothing -> case lookup mdl monadicPackages of+ Just _ ->+ [| benchIO bname $(varE (mkName f)) $(varE (mkName x)) |]+ Nothing ->+ if mdl == "StreamlyArray"+ then+ [| benchIOArray bname+ $(varE (mkName f))+ $(varE (mkName x))+ |]+ else error $+ "module " ++ show mdl ++ " not found in module list"+ Just _ ->+ [| benchPure bname $(varE (mkName f)) $(varE (mkName x)) |]++mkBenchN :: String -> String -> Int -> String -> String -> Q Exp+mkBenchN f x n mdl bname =+ case lookup mdl purePackages of+ Nothing -> case lookup mdl monadicPackages of+ Just _ ->+ [| benchIO bname $(varE (mkName f)) ($(varE (mkName x)) n) |]+ Nothing ->+ if mdl == "StreamlyArray"+ then+ [| benchIOArray bname+ $(varE (mkName f))+ ($(varE (mkName x)) n)+ |]+ else+ error $+ "module " ++ show mdl ++ " not found in module list"+ Just _ ->+ [| benchPure bname $(varE (mkName f)) ($(varE (mkName x)) n)+ |]++mkBenchIO :: String -> String -> String -> Q Exp+mkBenchIO action mdl bname =+ case lookup mdl purePackages of+ Nothing -> case lookup mdl monadicPackages of+ Just _ ->+ [| benchIOAction bname $(varE (mkName action)) |]+ Nothing ->+ if mdl == "StreamlyArray"+ then+ [| benchIOArray "array-streamly" $(varE (mkName action)) |]+ else error $+ "module " ++ show mdl ++ " not found in module list"+ Just _ ->+ [| benchPureFunc bname $(varE (mkName action)) |]
+ lib/Benchmarks/BenchmarkTH.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveLift #-}++module Benchmarks.BenchmarkTH+ ( createBgroupSink+ , createBgroupSinkN+ , createBgroupSrc+ , createBgroupIO+ , pureMods+ , monadicMods+ , allMods+ , benchMods+ , iterMods+ , Select (..)+ ) where++import Data.List ((\\))+import Language.Haskell.TH.Syntax (Q, Exp, Lift)++import Benchmarks.BenchTH++benchMods, iterMods, pureMods, monadicMods, monadicArrayMods, allMods :: [String]+pureMods = map fst purePackages+monadicMods = map fst monadicPackages+monadicArrayMods = map fst monadicArrays+allMods = pureMods ++ monadicMods ++ monadicArrayMods+benchMods = allMods \\ ["DList"]+iterMods = allMods \\+ [ "DList"+ , "Streaming"+ , "Machines"+ , "Pipes"+ , "Conduit"+ , "Drinkery"+ , "VectorStreams"+ ]++data Select = Exclude [String] | Include [String] deriving Lift++-- | createBgroupSink <selection func> <module name> <benchmark name>+-- <stream consumer function name>+createBgroupSink :: Select -> String -> String -> String -> Q Exp+createBgroupSink select modName bname fname =+ case select of+ Exclude mods -> f elem mods+ Include mods -> f notElem mods++ where++ f p mods =+ if p modName mods+ then [| Nothing |]+ else [| Just $(mkBench "source" fname modName bname) |]++-- | createBgroupSink <selection func> <module names> <benchmark name>+-- <stream consumer function name> <number of iterations>+createBgroupSinkN :: Select -> String -> String -> String -> Int -> Q Exp+createBgroupSinkN select modName bname fname n =+ case select of+ Exclude mods -> f elem mods+ Include mods -> f notElem mods++ where++ f p mods =+ if p modName mods+ then [| Nothing |]+ else [| Just $(mkBenchN "source" fname n modName bname) |]++createBgroupSrc :: Select -> String -> String -> String -> Q Exp+createBgroupSrc select modName bname fname =+ case select of+ Exclude mods -> f elem mods+ Include mods -> f notElem mods++ where++ f p mods =+ if p modName mods+ then [| Nothing |]+ else [| Just $(mkBench fname "toNull" modName bname) |]++createBgroupIO :: Select -> String -> String -> String -> Q Exp+createBgroupIO select modName bname fname =+ case select of+ Exclude mods -> f elem mods+ Include mods -> f notElem mods++ where++ f p mods =+ if p modName mods+ then [| Nothing |]+ else [| Just $(mkBenchIO fname modName bname) |]
+ lib/Benchmarks/Common.hs view
@@ -0,0 +1,56 @@+-- |+-- Module : Benchmarks.Common+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : MIT+-- Maintainer : harendra.kumar@gmail.com++module Benchmarks.Common+ ( value+ , maxValue+ , appendValue+ , benchIO+ , benchIOAction+ , benchIOArray+ , benchId+ , benchPure+ , benchPureFunc+ ) where++import Control.DeepSeq (NFData)+import Data.Functor.Identity (Identity, runIdentity)+import System.Random (randomRIO)++import Gauge++value, maxValue,appendValue :: Int+value = 1000000+maxValue = value + 1000+appendValue = 10000++{-# INLINE benchIOAction #-}+benchIOAction :: NFData b => String -> (Int -> IO b) -> Benchmark+benchIOAction name action = bench name $ nfIO $ randomRIO (1,1) >>= action++{-# INLINE benchIO #-}+benchIO :: (NFData b) => String -> (Int -> a) -> (a -> IO b) -> Benchmark+benchIO name src f = bench name $ nfIO $ randomRIO (1,1) >>= f . src++{-# INLINE benchId #-}+benchId :: (NFData b) => String -> (Int -> a) -> (a -> Identity b) -> Benchmark+benchId name src f = bench name $ nf (runIdentity . f) (src 10)++{-# INLINE benchPureFunc #-}+benchPureFunc :: NFData b => String -> (Int -> b) -> Benchmark+benchPureFunc name action =+ bench name $ nfIO $ randomRIO (1,1) >>= return . action++{-# INLINE benchPure #-}+benchPure :: (NFData b) => String -> (Int -> a) -> (a -> b) -> Benchmark+benchPure name src f =+ bench name $ nfIO $ randomRIO (1,1) >>= return . f . src++{-# INLINE benchIOArray #-}+benchIOArray :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark+benchIOArray name src f =+ bench name $ nfIO $ randomRIO (1,1) >>= src >>= f
+ lib/Benchmarks/DefaultMain.hs view
@@ -0,0 +1,146 @@+-- |+-- Module : Main+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : MIT+-- Maintainer : harendra.kumar@gmail.com++{-# LANGUAGE TemplateHaskell #-}++module Benchmarks.DefaultMain (defaultMain) where++import Data.List ((\\))+import Data.Maybe (catMaybes)+import Gauge (bgroup)+import Language.Haskell.TH.Syntax (Q, Exp)++import qualified Gauge as Gauge (defaultMain)++import Benchmarks.BenchmarkTH+import Prelude hiding (all)++all, most, almost :: Select+all = Exclude []+most = Exclude ["DList"]+almost = Exclude ["DList", "Sequence", "ByteStringLazy"]++defaultMain :: String -> Q Exp+defaultMain name = [| do+ Gauge.defaultMain [ bgroup (name ++ "/benchmarks") $ catMaybes+ [ Just $ bgroup "elimination" $ catMaybes+ [ $(createBgroupSink all name "drain" "toNull")+ , $(createBgroupSink (Exclude ["List"]) name "toList" "toList")+ , $(createBgroupSink all name "foldl'" "foldl")+ , $(createBgroupSink most name "last" "last")+ , $(createBgroupSrc (Include ["Streamly", "List", "VectorStreams"])+ name "enumInt" "sourceIntFromThenTo")+ ]+ , Just $ bgroup "transformation" $ catMaybes+ [ $(createBgroupSinkN almost name "scan" "scan" 1)+ , $(createBgroupSinkN all name "map" "map" 1)+ , $(createBgroupSinkN most name "mapM" "mapM" 1)+ ]+ , Just $ bgroup "transformationX4" $ catMaybes+ [ $(createBgroupSinkN almost name "scan x 4" "scan" 4)+ , $(createBgroupSinkN all name "map x 4" "map" 4)+ , $(createBgroupSinkN most name "mapM x 4" "mapM" 4)+ ]+ , Just $ bgroup "filtering" $ catMaybes+ [ $(createBgroupSinkN most name "filter-all-out" "filterAllOut" 1)+ , $(createBgroupSinkN most name "filter-all-in" "filterAllIn" 1)+ , $(createBgroupSinkN most name "drop-all" "dropAll" 1)+ , $(createBgroupSinkN most name "takeWhile-true" "takeWhileTrue" 1)+ , $(createBgroupSinkN most name "filter-even" "filterEven" 1)+ , $(createBgroupSinkN most name "take-all" "takeAll" 1)+ , $(createBgroupSinkN most name "drop-one" "dropOne" 1)+ , $(createBgroupSinkN most name "dropWhile-true" "dropWhileTrue" 1)+ , $(createBgroupSinkN most name "dropWhile-false" "dropWhileFalse" 1)+ ]+ -- drop-all/dropWhile-true/filter-all-out x 4 would be the same as+ -- drop-all/dropWhile-true/filter-all-out x 1 as they would already+ -- drop all elements and do nothing in the next iterations+ , Just $ bgroup "filteringX4" $ catMaybes+ [ $(createBgroupSinkN most name "filter-even x 4" "filterEven" 4)+ -- , $(createBgroupSinkN most name "filter-all-out x 4" "filterAllOut" 4)+ , $(createBgroupSinkN most name "filter-all-in x 4" "filterAllIn" 4)+ , $(createBgroupSinkN most name "take-all x 4" "takeAll" 4)+ , $(createBgroupSinkN most name "takeWhile-true x 4" "takeWhileTrue" 4)+ , $(createBgroupSinkN most name "drop-one x 4" "dropOne" 4)+ -- , $(createBgroupSinkN most name "drop-all x 4" "dropAll" 4)+ -- , $(createBgroupSinkN most name "dropWhile-true x 4" "dropWhileTrue" 4)+ , $(createBgroupSinkN most name "dropWhile-false x 4" "dropWhileFalse" 4)+ ]+ , Just $ bgroup "mixedX4" $ catMaybes+ [ $(createBgroupSinkN almost name "scan-map x 4" "scanMap" 4)+ , $(createBgroupSinkN almost name "drop-scan x 4" "dropScan" 4)+ , $(createBgroupSinkN almost name "take-scan x 4" "takeScan" 4)+ , $(createBgroupSinkN almost name "filter-scan x 4" "filterScan" 4)+ , $(createBgroupSinkN most name "drop-map x 4" "dropMap" 4)+ , $(createBgroupSinkN most name "take-drop x 4" "takeDrop" 4)+ , $(createBgroupSinkN most name "take-map x 4" "takeMap" 4)+ , $(createBgroupSinkN most name "filter-drop x 4" "filterDrop" 4)+ , $(createBgroupSinkN most name "filter-take x 4" "filterTake" 4)+ , $(createBgroupSinkN most name "filter-map x 4" "filterMap" 4)+ ]+ , $(createBgroupSink (Exclude ["DList", "StreamlyArray"]) name "zip" "zip")+ -- XXX use 4x250k concatMap for a comparative idea of cost wrt other ops+ , $(createBgroupSink (Include+ [ "List"+ , "Streamly"+ , "StreamlyPure"+ , "VectorStreams"+ , "Vector"+ , "VectorStorable"+ , "VectorUnboxed"+ , "ByteString"+ , "ByteStringLazy"+ , "Text"+ ]) name "concatMap" "concatMap")+ , $(createBgroupSink (Exclude+ [ "List"+ , "DList"+ , "Streamly"+ , "StreamlyPure"+ , "VectorStreams"+ , "Vector"+ , "VectorStorable"+ , "VectorUnboxed"+ , "ByteString"+ , "ByteStringLazy"+ , "Sequence"+ , "StreamlyArray"+ , "Text"+ ]) name "concatMapFoldable" "concatMapFoldable")++ -- XXX The rest are StreamK operations, use a separate bench group/suite+ -- for these?+ , $(createBgroupIO (Exclude+ [ "Drinkery"+ , "StreamlyArray"+ ]) name "appendR (1/100)" "appendSourceR")+ , $(createBgroupIO (Include+ [ "DList"+ , "Conduit"+ -- , "Streamly"+ -- , "StreamlyPure"+ ]) name "appendL (1/100)" "appendSourceL")+ -- Perform 100,000 mapM recursively over a stream of length 10+ , Just $ bgroup "iterated" $ catMaybes+ [ $(createBgroupSrc (Include (iterMods \\ pureMods)) name+ "mapM" "iterateMapM")+ , $(createBgroupSrc (Include (iterMods \\ ["Sequence", "ByteStringLazy"])) name+ "scan" "iterateScan")+ , $(createBgroupSrc (Include iterMods) name+ "filterEven" "iterateFilterEven")+ , $(createBgroupSrc (Include iterMods) name+ "takeAll" "iterateTakeAll")+ , $(createBgroupSrc (Include iterMods) name+ "dropOne" "iterateDropOne")+ , $(createBgroupSrc (Include iterMods) name+ "dropWhileFalse" "iterateDropWhileFalse")+ , $(createBgroupSrc (Include iterMods) name+ "dropWhileTrue" "iterateDropWhileTrue")+ ]+ ]+ ]+ |]
streaming-benchmarks.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: streaming-benchmarks-version: 0.3.0+version: 0.4.1 license: MIT license-file: LICENSE author: Composewell Technologies@@ -25,127 +25,271 @@ * conduit * drinkery -tested-with: GHC==8.8.4, GHC==8.10.4+tested-with:+ GHC==8.10.7+ , GHC==9.2.8+ , GHC==9.4.4+ , GHC==9.6.3+ , GHC==9.8.4+ , GHC==9.10.3+ , GHC==9.12.4+ , GHC==9.14.1+ build-type: Simple extra-source-files:- Changelog.md- README.md- bench.sh- bench-report.nix+ Benchmarks/VectorCommon.hs+ bench-runner/Main.hs+ bench-runner/bench-runner.cabal+ bench-runner/cabal.project.user extra-doc-files:+ Changelog.md+ README.md docs/benchmarking-notes.md source-repository head type: git- location: git://github.com/composewell/streaming-benchmarks.git+ location: https://github.com/composewell/streaming-benchmarks -flag dev- description: Development build+flag no-fusion-plugin+ description: Disable fusion plugin for streamly benchmarks manual: True default: False -flag fusion-plugin- description: Use fusion plugin for benchmarks+flag use-gauge+ description: Use gauge instead of tasty-bench for benchmarking manual: True default: False -benchmark bmarks- default-language: Haskell2010- type: exitcode-stdio-1.0- hs-source-dirs: .- main-is: Benchmarks.hs- other-modules: Benchmarks.Common- , Benchmarks.BenchTH- , Benchmarks.BenchmarkTH+flag drinkery+ description: Use drinkery+ manual: True+ default: False - -- Pure streams- , Benchmarks.List- , Benchmarks.DList- , Benchmarks.Sequence- , Benchmarks.Vector- , Benchmarks.StreamlyPure- , Benchmarks.StreamlyArray- , Benchmarks.ByteString- , Benchmarks.ByteStringLazy- , Benchmarks.Text+flag conduit+ description: Use conduit+ manual: True+ default: False - -- Monadic streams- , Benchmarks.Streamly- , Benchmarks.VectorStreams- , Benchmarks.Streaming- , Benchmarks.Conduit- , Benchmarks.Pipes- , Benchmarks.Machines- , Benchmarks.Drinkery+flag pipes+ description: Use pipes+ manual: True+ default: False - -- List transformers- -- , Benchmarks.LogicT- -- , Benchmarks.ListT- -- , Benchmarks.ListTransformer+flag machines+ description: Use machines+ manual: True+ default: False - ghc-options: -O2 -Wall -with-rtsopts "-T"- -fspec-constr-recursive=16- -fmax-worker-args=16- ghc-options: -Wcompat- -Wunrecognised-warning-flags- -Widentities- -Wincomplete-record-updates- -Wincomplete-uni-patterns- -Wredundant-constraints- -Wnoncanonical-monad-instances- if flag(fusion-plugin)- ghc-options: -fplugin Fusion.Plugin+flag streaming+ description: Use streaming+ manual: True+ default: False +common lib-options+ default-language: Haskell2010+ ghc-options:+ -Wall+ -Wcompat+ -Wunrecognised-warning-flags+ -Widentities+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wredundant-constraints+ -Wnoncanonical-monad-instances+ -Rghc-timing+ +RTS -M512M -RTS+ -O2 build-depends: base == 4.*,- deepseq >= 1.4.0 && < 1.5,- gauge >= 0.2.3 && < 0.3,- mtl >= 2 && < 2.3,+ deepseq >= 1.4.4 && < 1.6,+ mtl >= 2.2.2 && < 2.4, random >= 1.0 && < 2.0,- transformers >= 0.4 && < 0.6,- template-haskell >= 2.10 && < 2.18,+ transformers >= 0.5.5 && < 0.7,+ template-haskell >= 2.14 && < 2.25+ if flag(use-gauge)+ build-depends: gauge >= 0.2.4 && < 0.3+ else+ build-depends: tasty-bench >= 0.3 && < 0.6+ , tasty >= 1.4.1 && < 1.6+ mixins: tasty-bench+ (Test.Tasty.Bench as Gauge+ , Test.Tasty.Bench as Gauge.Main+ ) - bytestring >= 0.9 && < 0.12,- text >= 1.0 && < 1.3,- vector >= 0.12 && < 0.13,- streamly >= 0.8.0 && < 0.9,- streaming >= 0.1.4 && < 0.3,- machines >= 0.6.0 && < 0.8,- pipes >= 4 && < 4.4,- conduit >= 1.3 && < 1.4,- drinkery >= 0.3 && < 0.5,- dlist >= 0.7 && < 1.1,- containers >= 0.5 && < 0.7- -- does not build with lts-11.0- -- simple-conduit >= 0.4.0 && < 0.7,- -- list-transformer >= 1.0.2 && < 1.1,- -- list-t >= 0.4.6 && < 1.1,- -- logict >= 0.5.0 && < 0.7,- if flag(fusion-plugin)- build-depends:- fusion-plugin >= 0.2 && < 0.3+common bench-options+ import: lib-options+ ghc-options:+ -rtsopts+ -with-rtsopts "-T"+ build-depends: streaming-benchmarks -executable bench-report- default-language: Haskell2010- default-extensions: OverloadedStrings- hs-source-dirs: .- main-is: Charts.hs- ghc-options: -Wall- if flag(dev)- buildable: True- build-depends:- base == 4.*- , bench-show >= 0.3.0 && < 0.4- , bytestring >= 0.9 && < 0.12- , Chart >= 1.6 && < 2- , Chart-diagrams >= 1.6 && < 2- , csv >= 0.1 && < 0.2- , directory >= 1.2 && < 1.4- , split >= 0.2 && < 0.3- , text >= 1.1.1 && < 1.3- , transformers >= 0.4 && < 0.6- , typed-process >= 0.1.0.0 && < 0.3- , getopt-generics >= 0.11 && < 0.14+common streamly-options+ import: bench-options+ ghc-options:+ -fdicts-strict+ -fspec-constr-recursive=16+ -fmax-worker-args=16+ if !flag(no-fusion-plugin)+ ghc-options: -fplugin Fusion.Plugin+ build-depends:+ streamly-core >= 0.1.0 && < 0.3.1+ if !flag(no-fusion-plugin)+ build-depends: fusion-plugin >= 0.2 && < 0.3++library+ import: lib-options+ hs-source-dirs: lib+ exposed-modules:+ Benchmarks.Common+ , Benchmarks.BenchTH+ , Benchmarks.BenchmarkTH+ , Benchmarks.DefaultMain++-- Streams+benchmark Streamly+ import: streamly-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/Streamly.hs+ ghc-options: -main-is Benchmarks.Streamly++benchmark StreamlyPure+ import: streamly-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/StreamlyPure.hs+ ghc-options: -main-is Benchmarks.StreamlyPure++benchmark List+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/List.hs+ ghc-options: -main-is Benchmarks.List++benchmark DList+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/DList.hs+ ghc-options: -main-is Benchmarks.DList+ build-depends: dlist >= 0.7 && < 1.1++benchmark Streaming+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/Streaming.hs+ ghc-options: -main-is Benchmarks.Streaming+ if flag(streaming)+ build-depends: streaming >= 0.1.4 && < 0.3 else buildable: False++benchmark Machines+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/Machines.hs+ ghc-options: -main-is Benchmarks.Machines+ if flag(machines)+ build-depends: machines >= 0.6.0 && < 0.8+ else+ buildable: False++benchmark Pipes+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/Pipes.hs+ ghc-options: -main-is Benchmarks.Pipes+ if flag(pipes)+ build-depends: pipes >= 4 && < 4.4+ else+ buildable: False++benchmark Conduit+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/Conduit.hs+ ghc-options: -main-is Benchmarks.Conduit+ if flag(conduit)+ build-depends: conduit >= 1.3 && < 1.4+ else+ buildable: False++benchmark Drinkery+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/Drinkery.hs+ ghc-options: -main-is Benchmarks.Drinkery+ if flag(drinkery)+ build-depends: drinkery >= 0.3 && < 0.5+ else+ buildable: False++-- benchmark SimpleConduit+-- import: bench-options+-- type: exitcode-stdio-1.0+-- main-is: Benchmarks/SimpleConduit.hs+-- ghc-options: -main-is Benchmarks.SimpleConduit+-- build-depends: simple-conduit >= 0.6 && < 0.7++-- Arrays+benchmark StreamlyArray+ import: streamly-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/StreamlyArray.hs+ ghc-options:+ -main-is Benchmarks.StreamlyArray+ +RTS -M1500M -RTS++benchmark Sequence+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/Sequence.hs+ ghc-options: -main-is Benchmarks.Sequence+ build-depends: containers >= 0.5 && < 0.9++benchmark ByteString+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/ByteString.hs+ ghc-options: -main-is Benchmarks.ByteString+ build-depends: bytestring >= 0.9 && < 0.13++benchmark ByteStringLazy+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/ByteStringLazy.hs+ ghc-options: -main-is Benchmarks.ByteStringLazy+ build-depends: bytestring >= 0.9 && < 0.13++benchmark Text+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/Text.hs+ ghc-options: -main-is Benchmarks.Text+ build-depends: text >= 1.0 && < 3.0++benchmark VectorStreams+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/VectorStreams.hs+ ghc-options: -main-is Benchmarks.VectorStreams+ build-depends: vector >= 0.12 && < 0.14++benchmark Vector+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/Vector.hs+ ghc-options: -main-is Benchmarks.Vector+ build-depends: vector >= 0.12 && < 0.14++benchmark VectorUnboxed+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/VectorUnboxed.hs+ ghc-options: -main-is Benchmarks.VectorUnboxed+ build-depends: vector >= 0.12 && < 0.14++benchmark VectorStorable+ import: bench-options+ type: exitcode-stdio-1.0+ main-is: Benchmarks/VectorStorable.hs+ ghc-options: -main-is Benchmarks.VectorStorable+ build-depends: vector >= 0.12 && < 0.14