streaming-benchmarks 0.2.0 → 0.3.0
raw patch · 36 files changed
+4104/−1646 lines, 36 filesdep +bench-showdep +containersdep +dlistdep −bench-graphdep ~bytestringdep ~drinkerydep ~machinesnew-component:exe:bench-report
Dependencies added: bench-show, containers, dlist, fusion-plugin
Dependencies removed: bench-graph
Dependency ranges changed: bytestring, drinkery, machines, streamly, template-haskell, text
Files
- Benchmarks.hs +98/−57
- Benchmarks/BenchTH.hs +95/−0
- Benchmarks/BenchmarkTH.hs +49/−36
- Benchmarks/ByteString.hs +226/−0
- Benchmarks/ByteStringLazy.hs +232/−0
- Benchmarks/Common.hs +12/−7
- Benchmarks/Conduit.hs +121/−85
- Benchmarks/DList.hs +212/−0
- Benchmarks/Drinkery.hs +94/−73
- Benchmarks/List.hs +163/−67
- Benchmarks/Machines.hs +102/−70
- Benchmarks/Pipes.hs +94/−73
- Benchmarks/Sequence.hs +211/−0
- Benchmarks/Streaming.hs +99/−78
- Benchmarks/Streamly.hs +146/−87
- Benchmarks/StreamlyArray.hs +222/−0
- Benchmarks/StreamlyPure.hs +218/−0
- Benchmarks/Text.hs +228/−0
- Benchmarks/Vector.hs +166/−106
- Benchmarks/VectorPure.hs +0/−116
- Benchmarks/VectorStreams.hs +222/−0
- Changelog.md +15/−0
- Charts.hs +193/−58
- LICENSE +35/−0
- README.md +311/−0
- README.rst +0/−442
- bench-report.nix +50/−0
- bench.sh +325/−0
- docs/benchmarking-notes.md +68/−0
- licenses/LICENSE.machines +0/−30
- licenses/Readme.txt +0/−3
- run.sh +0/−136
- stack-8.2.yaml +0/−21
- stack-pedantic.yaml +0/−16
- stack.yaml +0/−14
- streaming-benchmarks.cabal +97/−71
Benchmarks.hs view
@@ -9,85 +9,126 @@ module Main (main) where -import Benchmarks.BenchmarkTH (createBgroup)-import Benchmarks.Common (benchIO)---import Benchmarks.BenchmarkTH (createScaling)+import Data.List ((\\))+import Gauge -import qualified Benchmarks.Vector as Vector+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.VectorPure as VectorPure+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 -import Gauge- main :: IO () main = do defaultMain [ bgroup "elimination"- [ $(createBgroup "drain" "toNull")- , $(createBgroup "toList" "toList")- , $(createBgroup "fold" "foldl")- , $(createBgroup "last" "last")+ [ $(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"- [ $(createBgroup "scan" "scan")- , $(createBgroup "map" "map")- , $(createBgroup "mapM" "mapM")- , $(createBgroup "concat" "concat")+ [ $(createBgroupSinkN (benchMods \\ ["Sequence"]) "scan" "scan" 1)+ , $(createBgroupSinkN (benchMods ++ ["DList"]) "map" "map" 1)+ , $(createBgroupSinkN benchMods "mapM" "mapM" 1) ]- , bgroup "filtering"- [ $(createBgroup "filter-even" "filterEven")- , $(createBgroup "filter-all-out" "filterAllOut")- , $(createBgroup "filter-all-in" "filterAllIn")- , $(createBgroup "take-all" "takeAll")- , $(createBgroup "takeWhile-true" "takeWhileTrue")- , $(createBgroup "drop-all" "dropAll")- , $(createBgroup "dropWhile-true" "dropWhileTrue")+ , 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) ]- , $(createBgroup "zip" "zip")- , bgroup "append"- [ benchIO "streamly" Streamly.appendSource Streamly.toNull- , benchIO "conduit" Conduit.appendSource Conduit.toNull--- , benchIO "pipes" Pipes.appendSource Pipes.toNull- , bench "pipes" $ nfIO (return 1 :: IO Int)--- , benchIO "vector" Vector.appendSource Vector.toNull- , bench "vector" $ nfIO (return 1 :: IO Int)--- , benchIO "streaming" Streaming.appendSource Streaming.toNull- , bench "streaming" $ nfIO (return 1 :: IO Int)+ , 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) ]- {-- -- Perform 100,000 mapM recursively over a stream of length 10- -- implemented only for vector and streamly.- bgroup "mapM-nested"- , [ benchIO "streamly" Streamly.mapMSource Streamly.toNull- , benchIO "vector" Vector.mapMSource Vector.toNull+ -- 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 "compose"- [ $(createBgroup "mapM" "composeMapM")- , $(createBgroup "map-with-all-in-filter" "composeMapAllInFilter")- , $(createBgroup "all-in-filters" "composeAllInFilters")- , $(createBgroup "all-out-filters" "composeAllOutFilters")+ , 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) ]- -- XXX Disabling this for now to reduce the running time- -- We need a way to include/exclude this dynamically- {-- , bgroup "compose-scaling"- -- Scaling with same operation in sequence- [ $(createScaling "vector-filters" "Vector")- , $(createScaling "streamly-filters" "Streamly")- , $(createScaling "streaming-filters" "Streaming")- , $(createScaling "machines-filters" "Machines")- , $(createScaling "pipes-filters" "Pipes")- , $(createScaling "conduit-filters" "Conduit")+ , $(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 view
@@ -0,0 +1,95 @@+{-# 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 view
@@ -1,44 +1,57 @@ {-# LANGUAGE TemplateHaskell #-} -module Benchmarks.BenchmarkTH (createBgroup, createScaling) where+module Benchmarks.BenchmarkTH+ ( createBgroupSink+ , createBgroupSinkN+ , createBgroupSrc+ , pureMods+ , monadicMods+ , allMods+ , benchMods+ , iterMods+ ) where -import Benchmarks.Common (benchIO, benchPure)---import Benchmarks.Common (benchId)-import Language.Haskell.TH.Syntax (Q, Exp, mkName)-import Language.Haskell.TH.Lib (varE)+import Data.List ((\\))+import Language.Haskell.TH.Syntax (Q, Exp)+import Language.Haskell.TH.Lib (listE) -createBgroup :: String -> String -> Q Exp-createBgroup name fname =+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- [ benchIO "vector" $(varE (mkName ("Vector.source")))- $(varE (mkName ("Vector." ++ fname)))- , benchIO "streamly" $(varE (mkName ("Streamly.source")))- $(varE (mkName ("Streamly." ++ fname)))- , benchIO "streaming" $(varE (mkName ("Streaming.source")))- $(varE (mkName ("Streaming." ++ fname)))- , benchIO "machines" $(varE (mkName ("Machines.source")))- $(varE (mkName ("Machines." ++ fname)))- , benchIO "pipes" $(varE (mkName ("Pipes.source")))- $(varE (mkName ("Pipes." ++ fname)))- , benchIO "conduit" $(varE (mkName ("Conduit.source")))- $(varE (mkName ("Conduit." ++ fname)))- , benchIO "drinkery" $(varE (mkName ("Drinkery.source")))- $(varE (mkName ("Drinkery." ++ fname)))- , benchPure "list" $(varE (mkName ("List.source")))- $(varE (mkName ("List." ++ fname)))- , benchPure "pure-vector" $(varE (mkName ("VectorPure.source")))- $(varE (mkName ("VectorPure." ++ fname)))- ]+ bgroup name $(listE (map (mkBench "source" fname) mods)) |] -createScaling :: String -> String -> Q Exp-createScaling name mname =- [| let src = $(varE (mkName (mname ++ ".source")))- in bgroup name- [ benchIO "1" src ($(varE (mkName (mname ++ ".composeScaling"))) 1)- , benchIO "2" src ($(varE (mkName (mname ++ ".composeScaling"))) 2)- , benchIO "3" src ($(varE (mkName (mname ++ ".composeScaling"))) 3)- , benchIO "4" src ($(varE (mkName (mname ++ ".composeScaling"))) 4)- ]+-- | 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
@@ -0,0 +1,226 @@+-- |+-- Module : Benchmarks.ByteString+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : MIT+-- Maintainer : harendra.kumar@gmail.com++{-# LANGUAGE ScopedTypeVariables #-}++module Benchmarks.ByteString where++-- import Benchmarks.Common (value, maxValue, appendValue)+import Prelude (Int, (+), ($), (.), even, (>), (<=), subtract, undefined,+ maxBound, Maybe(..))+import qualified Prelude as P+import Data.Word (Word8)++import qualified Data.ByteString as S++nElements, nAppends :: Int+nElements = 1000000+nAppends = 10000++minElem, maxElem :: Word8+minElem = 1+maxElem = maxBound++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++type Element = Word8+type Stream a = S.ByteString++{-# INLINE sourceN #-}+sourceN :: Int -> Int -> Stream Element+sourceN count begin = S.unfoldr step begin+ where+ step i =+ if i > begin + count+ then Nothing+ else (Just (P.fromIntegral i, i + 1))++{-# INLINE source #-}+source :: Int -> Stream Element+source = sourceN nElements++-------------------------------------------------------------------------------+-- Append+-------------------------------------------------------------------------------++{-# INLINE appendSourceR #-}+appendSourceR :: Int -> Stream Element+appendSourceR n = 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])++-------------------------------------------------------------------------------+-- 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 :: 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 Element -> ()+toNull = eval++{-# INLINE toList #-}+toList :: Stream Element -> ()+toList = evalF . S.unpack++{-# INLINE foldl #-}+foldl :: Stream Element -> Element+foldl = S.foldl' (+) 0++{-# INLINE last #-}+last :: Stream Element -> Element+last = S.last++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE transform #-}+transform :: Stream a -> ()+transform = eval++{-# INLINE composeN #-}+composeN :: Int+ -> (Stream Element -> Stream Element)+ -> Stream Element+ -> ()+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 -> ()++-- XXX there is no scanl'+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 (> maxElem)+filterAllIn n = composeN n $ S.filter (<= maxElem)+takeOne n = composeN n $ S.take 1+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 nElements+dropWhileFalse n = composeN n $ S.dropWhile (> maxElem)+dropWhileTrue n = composeN n $ S.dropWhile (<= maxElem)++-------------------------------------------------------------------------------+-- Iteration+-------------------------------------------------------------------------------++iterStreamLen, maxIters :: Int+iterStreamLen = 10+maxIters = 100000++{-# INLINE iterateSource #-}+iterateSource :: (Stream Element -> Stream Element)+ -> Int+ -> Int+ -> Stream 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 iterateScan #-}+{-# INLINE iterateFilterEven #-}+{-# INLINE iterateTakeAll #-}+{-# INLINE iterateDropOne #-}+{-# INLINE iterateDropWhileFalse #-}+{-# INLINE iterateDropWhileTrue #-}+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++iterateFilterEven n = iterateSource (S.filter even) maxIters n+iterateTakeAll n = iterateSource (S.take nElements) maxIters n+iterateDropOne n = iterateSource (S.drop 1) 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+ :: Int -> Stream Element -> ()++-- XXX using scanl instead of scanl'+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 nElements+takeScan n = composeN n $ S.scanl (+) 0 . S.take nElements+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 $ S.scanl (+) 0 . S.filter (<= maxElem)+filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxElem)++-------------------------------------------------------------------------------+-- Zipping and concat+-------------------------------------------------------------------------------++{-# INLINE zip #-}+zip :: Stream Element -> ()+zip src = P.foldr (\(x,y) xs -> P.seq x (P.seq y xs)) ()+ $ S.zipWith (,) src src++{-# INLINE concatMap #-}+concatMap :: Stream Element -> ()+concatMap src = transform $ (S.concatMap (S.replicate 3) src)
+ Benchmarks/ByteStringLazy.hs view
@@ -0,0 +1,232 @@+-- |+-- Module : Benchmarks.ByteStringLazy+-- Copyright : (c) 2019 Harendra Kumar+--+-- License : MIT+-- Maintainer : harendra.kumar@gmail.com++{-# LANGUAGE ScopedTypeVariables #-}++module Benchmarks.ByteStringLazy where++-- import Benchmarks.Common (value, maxValue, appendValue)+import Prelude (Int, (+), id, ($), (.), even, (>), (<=), subtract, undefined,+ maxBound, Maybe(..))+import qualified Prelude as P+import Data.Word (Word8)+import Data.Int (Int64) -- for lazy bytestring++import qualified Data.ByteString.Lazy as S++nAppends :: Int+nElements :: Int64+nElements = 1000000+nAppends = 10000++minElem, maxElem :: Word8+minElem = 1+maxElem = maxBound++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++type Element = Word8+type Stream a = S.ByteString++{-# INLINE sourceN #-}+sourceN :: Int -> Int -> Stream Element+sourceN count begin = S.unfoldr step begin+ where+ step i =+ if i > begin + count+ then Nothing+ else (Just (P.fromIntegral i, i + 1))++{-# INLINE source #-}+source :: Int -> Stream Element+source = sourceN (P.fromIntegral nElements)++-------------------------------------------------------------------------------+-- Append+-------------------------------------------------------------------------------++{-# INLINE appendSourceR #-}+appendSourceR :: Int -> Stream Element+appendSourceR n = 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])++-------------------------------------------------------------------------------+-- 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 :: 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 Element -> ()+toNull = eval++{-# INLINE toList #-}+toList :: Stream Element -> ()+toList = evalF . S.unpack++{-# INLINE foldl #-}+foldl :: Stream Element -> Element+foldl = S.foldl' (+) 0++{-# INLINE last #-}+last :: Stream Element -> Element+last = S.last++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE transform #-}+transform :: Stream a -> ()+transform = eval++{-# INLINE composeN #-}+composeN :: Int+ -> (Stream Element -> Stream Element)+ -> Stream Element+ -> ()+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 -> ()++-- 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+map n = composeN n $ S.map (+1)+mapM = map+filterEven n = composeN n $ S.filter even+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 nElements+takeWhileTrue n = composeN n $ S.takeWhile (<= maxElem)+dropOne n = composeN n $ S.drop 1+dropAll n = composeN n $ S.drop nElements+dropWhileFalse n = composeN n $ S.dropWhile (> maxElem)+dropWhileTrue n = composeN n $ S.dropWhile (<= maxElem)++-------------------------------------------------------------------------------+-- Iteration+-------------------------------------------------------------------------------++iterStreamLen, maxIters :: Int+iterStreamLen = 10+maxIters = 100000++{-# INLINE iterateSource #-}+iterateSource :: (Stream Element -> Stream Element)+ -> Int+ -> Int+ -> Stream 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 iterateScan #-}+{-# INLINE iterateFilterEven #-}+{-# INLINE iterateTakeAll #-}+{-# INLINE iterateDropOne #-}+{-# INLINE iterateDropWhileFalse #-}+{-# INLINE iterateDropWhileTrue #-}+iterateScan, 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++iterateFilterEven n = iterateSource (S.filter even) maxIters n+iterateTakeAll n = iterateSource (S.take nElements) maxIters n+iterateDropOne n = iterateSource (S.drop 1) 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+ :: 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+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1+dropScan n = composeN n $ id+takeDrop n = composeN n $ S.drop 1 . S.take nElements+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+filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxElem)++-------------------------------------------------------------------------------+-- Zipping and concat+-------------------------------------------------------------------------------++{-# INLINE zip #-}+zip :: Stream Element -> ()+zip src = P.foldr (\(x,y) xs -> P.seq x (P.seq y xs)) ()+ $ S.zipWith (,) src src++{-# INLINE concatMap #-}+concatMap :: Stream Element -> ()+concatMap src = transform $ (S.concatMap (S.replicate 3) src)
Benchmarks/Common.hs view
@@ -8,7 +8,9 @@ module Benchmarks.Common ( value , maxValue+ , appendValue , benchIO+ , benchIOArray , benchId , benchPure ) where@@ -19,21 +21,24 @@ import Gauge -value, maxValue :: Int+value, maxValue,appendValue :: Int value = 1000000 maxValue = value + 1000+appendValue = 10000 --- We need a monadic bind here to make sure that the function f does not get--- completely optimized out by the compiler in some cases. This happens--- specially in case of conduit, perhaps because of fusion? {-# INLINE benchIO #-} benchIO :: (NFData b) => String -> (Int -> a) -> (a -> IO b) -> Benchmark-benchIO name src f = bench name $ nfIO $ randomRIO (1,1000) >>= f . src+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 $ nf f (src 10)+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
@@ -7,10 +7,13 @@ module Benchmarks.Conduit where -import Benchmarks.Common (value, maxValue)+import Benchmarks.Common (value, maxValue, appendValue) import Prelude (Monad, Int, (+), ($), return, even, (>), (<=),- subtract, undefined, replicate, (<$>), (<*>), Maybe(..), foldMap, (.))+ subtract, undefined, replicate, (<$>), (<*>), Maybe(..), foldMap, (.),+ maxBound)+import qualified Prelude as P+import Data.Semigroup ((<>)) import qualified Data.Conduit as S import qualified Data.Conduit.Combinators as S@@ -18,42 +21,6 @@ -- import Data.Conduit.List (sourceList) ---------------------------------------------------------------------------------- Benchmark ops----------------------------------------------------------------------------------{-# INLINE toNull #-}-{-# INLINE toList #-}-{-# INLINE foldl #-}-{-# INLINE last #-}-{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE filterEven #-}-{-# INLINE mapM #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE zip #-}-{-# INLINE concat #-}-{-# INLINE composeMapM #-}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-toNull, scan, map, filterEven, mapM, filterAllOut,- filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,- concat, composeMapM, composeAllInFilters, composeAllOutFilters,- composeMapAllInFilter- :: Monad m- => Source m () Int -> m ()--toList :: Monad m => Source m () Int -> m [Int]-foldl :: Monad m => Source m () Int -> m Int-last :: Monad m => Source m () Int -> m (Maybe Int)--------------------------------------------------------------------------------- -- Stream generation and elimination ------------------------------------------------------------------------------- @@ -75,26 +42,45 @@ -- Append ------------------------------------------------------------------------------- -{-# INLINE appendSource #-}-appendSource :: Monad m => Int -> Source m () Int-appendSource n = foldMap (S.yieldM . return) [n..n+value]+{-# INLINE appendSourceR #-}+appendSourceR :: Monad m => Int -> Source m () Int+appendSourceR n = foldMap (S.yieldM . return) [n..n+appendValue] -{-# INLINE runStream #-}-runStream :: Monad m => Sink m Int a -> Source m () Int -> m a-runStream t src = S.runConduit $ src S..| t+{-# INLINE appendSourceL #-}+appendSourceL :: Monad m => Int -> Source m () Int+appendSourceL n =+ P.foldl (<>) P.mempty (P.map (S.yieldM . return) [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination ------------------------------------------------------------------------------- -eliminate :: Monad m => Sink m Int a -> Source m () Int -> m a-eliminate = runStream+-- eval :: Monad m => Sink m a ()+-- eval = S.foldl (\_ x -> P.seq x ()) () -toNull = eliminate $ S.sinkNull-toList = eliminate $ S.sinkList-foldl = eliminate $ S.foldl (+) 0-last = eliminate $ S.last+{-# INLINE runStream #-}+-- runStream :: Monad m => Sink m Int () -> Source m () Int -> m ()+-- runStream t src = S.runConduit $ src S..| t S..| S.foldl (\_ x -> P.seq x ()) ()+runStream :: Monad m => Sink m Int a -> Source m () Int -> m a+runStream t src = S.runConduit $ src S..| t +{-# INLINE toNull #-}+toNull :: Monad m => Source m () Int -> m ()+toNull = runStream $ S.sinkNull+-- toNull src = S.runConduit $ src S..| eval++{-# INLINE toList #-}+toList :: Monad m => Source m () Int -> m [Int]+toList = runStream $ S.sinkList++{-# INLINE foldl #-}+foldl :: Monad m => Source m () Int -> m Int+foldl = runStream $ S.foldl (+) 0++{-# INLINE last #-}+last :: Monad m => Source m () Int -> m (Maybe Int)+last = runStream $ S.last+ ------------------------------------------------------------------------------- -- Transformation -------------------------------------------------------------------------------@@ -102,50 +88,100 @@ {-# INLINE transform #-} transform :: Monad m => Pipe m Int Int -> Source m () Int -> m () -- mapM_ is much more costly compared to sinkNull---transform t = runStream (t S..| S.mapM_ (\_ -> return ()))+-- transform t = runStream (t S..| S.mapM_ (\_ -> return ()))+-- transform t s = runStream (t S..| eval) s P.>>= \x -> P.seq x (return ()) transform t = runStream (t S..| S.sinkNull) -scan = transform $ S.scanl (+) 0-map = transform $ S.map (+1)-mapM = transform $ S.mapM return-filterEven = transform $ S.filter even-filterAllOut = transform $ S.filter (> maxValue)-filterAllIn = transform $ S.filter (<= maxValue)-takeOne = transform $ S.take 1-takeAll = transform $ S.take maxValue-takeWhileTrue = transform $ S.takeWhile (<= maxValue)-dropAll = transform $ S.drop maxValue-dropWhileTrue = transform $ S.dropWhile (<= maxValue)+{-# INLINE composeN #-}+composeN :: Monad m => Int -> Pipe m Int Int -> Source m () Int -> m ()+composeN n f =+ case n of+ 1 -> transform $ f+ 2 -> transform $ f S..| f+ 3 -> transform $ f S..| f S..| f+ 4 -> transform $ f S..| f S..| f S..| 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+ :: Monad m => Int -> Source m () Int -> m ()++scan n = composeN n $ S.scanl (+) 0+map n = composeN n $ S.map (+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)+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 P.>> S.awaitForever S.yield)+dropAll n = composeN n $ (S.drop maxValue P.>> S.awaitForever S.yield)+dropWhileFalse n = composeN n $ (S.dropWhile (> maxValue) P.>>+ S.awaitForever S.yield)+dropWhileTrue n = composeN n $ (S.dropWhile (<= maxValue) P.>>+ S.awaitForever S.yield)+ ---------------------------------------------------------------------------------- Zipping and concat+-- Mixed Composition ------------------------------------------------------------------------------- -zip src = S.runConduit $- ( S.getZipSource $ (,)- <$> S.ZipSource src- <*> S.ZipSource src) S..| S.sinkNull-concat = transform (S.map (replicate 3) S..| S.concat)+{-# 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+ :: Monad m => Int -> Source m () Int -> m () +scanMap n = composeN n $ S.map (subtract 1) S..| S.scanl (+) 0+dropMap n = composeN n $ S.map (subtract 1) S..|+ (S.drop 1 P.>> S.awaitForever S.yield)+dropScan n = composeN n $ S.scanl (+) 0 S..|+ (S.drop 1 P.>> S.awaitForever S.yield)+takeDrop n = composeN n $ (S.drop 1 P.>> S.awaitForever S.yield) S..|+ S.take maxValue+takeScan n = composeN n $ S.scanl (+) 0 S..| S.take maxValue+takeMap n = composeN n $ S.map (subtract 1) S..| S.take maxValue+filterDrop n = composeN n $ (S.drop 1 P.>> S.awaitForever S.yield) S..|+ S.filter (<= maxValue)+filterTake n = composeN n $ S.take maxValue S..| S.filter (<= maxValue)+filterScan n = composeN n $ S.scanl (+) 0 S..| S.filter (<= maxBound)+filterMap n = composeN n $ S.map (subtract 1) S..| S.filter (<= maxValue)+ ---------------------------------------------------------------------------------- Composition+-- Zipping and concat ------------------------------------------------------------------------------- -{-# INLINE compose #-}-compose :: Monad m => Pipe m Int Int -> Source m () Int -> m ()-compose f = transform $ (f S..| f S..| f S..| f)+{-# INLINE zip #-}+zip :: Monad m => Source m () Int -> m () -composeMapM = compose (S.mapM return)-composeAllInFilters = compose (S.filter (<= maxValue))-composeAllOutFilters = compose (S.filter (> maxValue))-composeMapAllInFilter = compose (S.map (subtract 1) S..| S.filter (<= maxValue))+zip src = S.runConduit $+ ( S.getZipSource $ (,)+ <$> S.ZipSource src+ <*> S.ZipSource src) S..| S.sinkNull -- eval -composeScaling :: Monad m => Int -> Source m () Int -> m ()-composeScaling m =- case m of- 1 -> transform f- 2 -> transform (f S..| f)- 3 -> transform (f S..| f S..| f)- 4 -> transform (f S..| f S..| f S..| f)- _ -> undefined- where f = S.filter (<= maxValue)+{-# INLINE concatMapFoldable #-}+concatMapFoldable :: Monad m => Source m () Int -> m ()+concatMapFoldable = transform (S.map (replicate 3) S..| S.concat)
+ Benchmarks/DList.hs view
@@ -0,0 +1,212 @@+-- |+-- Module : Benchmarks.DList+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : MIT+-- Maintainer : harendra.kumar@gmail.com++{-# LANGUAGE ScopedTypeVariables #-}++module Benchmarks.DList where++import Benchmarks.Common (value, appendValue)+import Prelude (Int, (+), ($), (.), (>), undefined, Maybe(..))+import qualified Prelude as P+import qualified Data.Foldable as P++import qualified Data.DList as S++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++type Stream = S.DList++{-# INLINE source #-}+source :: Int -> Stream Int+-- source v = [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.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])++-------------------------------------------------------------------------------+-- 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 :: 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 = P.foldl' (+) 0++{-# INLINE last #-}+last :: Stream Int -> Int+last = undefined++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE transform #-}+transform :: 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 = undefined+map n = composeN n $ S.map (+1)+mapM = map+filterEven = undefined+filterAllOut = undefined+filterAllIn = undefined+takeOne = undefined+takeAll = undefined+takeWhileTrue = undefined+dropOne = undefined+dropAll = undefined+dropWhileFalse = undefined+dropWhileTrue = undefined++-------------------------------------------------------------------------------+-- 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 = undefined+iterateDropWhileFalse = undefined++iterateFilterEven = undefined+iterateTakeAll = undefined+iterateDropOne = undefined+iterateDropWhileTrue = undefined++-------------------------------------------------------------------------------+-- 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 = undefined+dropMap = undefined+dropScan = undefined+takeDrop = undefined+takeScan = undefined+takeMap = undefined+filterDrop = undefined+filterTake = undefined+filterScan = undefined+filterMap = undefined++-------------------------------------------------------------------------------+-- Zipping and concat+-------------------------------------------------------------------------------++{-# INLINE zip #-}+zip :: Stream Int -> ()+zip _src = undefined++{-# INLINE concat #-}+concat :: Stream Int -> ()+concat _src = undefined
Benchmarks/Drinkery.hs view
@@ -4,45 +4,13 @@ import Benchmarks.Common (value, maxValue) import Control.Monad (void) import Prelude- (Monad, Int, (+), ($), return, even, (>), (<=),- subtract, undefined, replicate, (<$>), (<*>), fst, id)+ (Monad, Int, Maybe(..), (+), ($), return, even, (>), (<=),+ subtract, undefined, replicate, (<$>), (<*>), fst, id, const, maxBound) import qualified Data.Drinkery as S import qualified Data.Drinkery.Finite as S ---------------------------------------------------------------------------------- Benchmark ops----------------------------------------------------------------------------------{-# INLINE toNull #-}-{-# INLINE toList #-}-{-# INLINE foldl #-}-{-# INLINE last #-}-{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE filterEven #-}-{-# INLINE mapM #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE zip #-}-{-# INLINE concat #-}-{-# INLINE composeMapM #-}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-toNull, toList, foldl, last, scan, map, filterEven, mapM, filterAllOut,- filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,- concat, composeMapM, composeAllInFilters, composeAllOutFilters,- composeMapAllInFilter- :: Monad m- => Source m () Int -> m ()--------------------------------------------------------------------------------- -- Stream generation and elimination ------------------------------------------------------------------------------- @@ -52,20 +20,26 @@ {-# INLINE source #-} source :: Monad m => Int -> Source m () Int-source n = S.tapListT $ S.sample [n .. n + value]--{-# INLINE runStream #-}-runStream :: Monad m => Pipe m Int o -> Source m () Int -> m ()-runStream t src = void $ src S.++& t S.$& S.drainFrom S.consume+source n = S.unfoldrTapM+ (const $ \x -> return (if x > n + value then Nothing else Just x, x + 1)) n ------------------------------------------------------------------------------- -- Elimination ------------------------------------------------------------------------------- +{-# INLINE runStream #-}+runStream :: Monad m => Pipe m Int o -> Source m () Int -> m ()+runStream t src = void $ src S.++& t S.$& S.drainFrom S.consume+ {-# INLINE eliminate #-} eliminate :: Monad m => Sink m Int a -> Source m () Int -> m () eliminate s src = void $ src S.++& s +{-# INLINE toNull #-}+{-# INLINE toList #-}+{-# INLINE foldl #-}+{-# INLINE last #-}+toNull, toList, foldl, last :: Monad m => Source m () Int -> m () toNull = eliminate $ S.drainFrom S.consume toList = eliminate S.drinkUp foldl = eliminate $ S.foldlFrom' S.consume (+) 0@@ -79,47 +53,94 @@ transform :: Monad m => Pipe m Int o -> Source m () Int -> m () transform = runStream -scan = transform $ S.scan (+) 0-map = transform $ S.map (+1)-mapM = transform $ S.traverse return-filterEven = transform $ S.filter even-filterAllOut = transform $ S.filter (> maxValue)-filterAllIn = transform $ S.filter (<= maxValue)-takeOne = transform $ S.take 1-takeAll = transform $ S.take maxValue-takeWhileTrue = transform $ S.takeWhile (<= maxValue)-dropAll = transform $ S.drop maxValue-dropWhileTrue = transform $ S.dropWhile (<= maxValue)+{-# INLINE composeN #-}+composeN+ :: Monad m+ => Int+ -> (forall n. Monad n => Pipe n Int Int)+ -> Source m () Int+ -> m ()+composeN n f =+ case n of+ 1 -> transform $ f+ 2 -> transform $ f S.++$ f+ 3 -> transform $ f S.++$ f S.++$ f+ 4 -> transform $ f S.++$ f S.++$ f S.++$ 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+ :: Monad m => Int -> Source m () Int -> m ()++scan n = composeN n $ S.scan (+) 0+map n = composeN n $ S.map (+1)+mapM n = composeN n $ S.traverse return+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)+ ---------------------------------------------------------------------------------- Zipping and concat+-- Mixed Composition ------------------------------------------------------------------------------- -zip src = void- $ S.unJoint ((,) <$> S.Joint src <*> S.Joint src)- S.++& S.drainFrom (fst <$> S.consume)-concat = transform $ S.map (replicate 3) S.++$ S.concatMap id+{-# 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+ :: Monad m => Int -> Source m () Int -> m () +scanMap n = composeN n $ S.map (subtract 1) S.++$ S.scan (+) 0+dropMap n = composeN n $ S.map (subtract 1) S.++$ S.drop 1+dropScan n = composeN n $ S.scan (+) 0 S.++$ S.drop 1+takeDrop n = composeN n $ S.drop 1 S.++$ S.take maxValue+takeScan n = composeN n $ S.scan (+) 0 S.++$ S.take maxValue+takeMap n = composeN n $ S.map (subtract 1) S.++$ S.take maxValue+filterDrop n = composeN n $ S.drop 1 S.++$ S.filter (<= maxValue)+filterTake n = composeN n $ S.take maxValue S.++$ S.filter (<= maxValue)+filterScan n = composeN n $ S.scan (+) 0 S.++$ S.filter (<= maxBound)+filterMap n = composeN n $ S.map (subtract 1) S.++$ S.filter (<= maxValue)+ ---------------------------------------------------------------------------------- Composition+-- Zipping and concat ------------------------------------------------------------------------------- -{-# INLINE compose #-}-compose :: Monad m => (forall n. Monad n => Pipe n Int Int) -> Source m () Int -> m ()-compose f = transform (f S.++$ f S.++$ f S.++$ f)+{-# INLINE zip #-}+zip :: Monad m => Source m () Int -> m () -composeMapM = compose (S.traverse return)-composeAllInFilters = compose (S.filter (<= maxValue))-composeAllOutFilters = compose (S.filter (> maxValue))-composeMapAllInFilter = compose (S.map (subtract 1) S.++$ S.filter (<= maxValue))+zip src = void+ $ S.unJoint ((,) <$> S.Joint src <*> S.Joint src)+ S.++& S.drainFrom (fst <$> S.consume) -composeScaling :: Monad m => Int -> Source m () Int -> m ()-composeScaling m =- case m of- 1 -> transform f- 2 -> transform (f S.++$ f)- 3 -> transform (f S.++$ f S.++$ f)- 4 -> transform (f S.++$ f S.++$ f S.++$ f)- _ -> undefined- where f :: Monad m => Pipe m Int Int- f = S.filter (<= maxValue)+{-# INLINE concatMapFoldable #-}+concatMapFoldable :: Monad m => Source m () Int -> m ()+concatMapFoldable = transform $ S.map (replicate 3) S.++$ S.concatMap id
Benchmarks/List.hs view
@@ -5,110 +5,206 @@ -- License : MIT -- Maintainer : harendra.kumar@gmail.com +{-# LANGUAGE ScopedTypeVariables #-}+ module Benchmarks.List where -import Benchmarks.Common (value, maxValue)-import Prelude (Int, (+), id, ($), (.), even, (>), (<=), subtract, undefined)+import Benchmarks.Common (value, maxValue, appendValue)+import Prelude (Int, (+), ($), (.), even, (>), (<=), subtract, undefined,+ maxBound, Maybe(..))+import qualified Prelude as P import qualified Data.List as S ---------------------------------------------------------------------------------- Benchmark ops+-- Stream generation and elimination ------------------------------------------------------------------------------- +type Stream = []++{-# INLINE source #-}+source :: Int -> [Int]+-- source v = [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))++{-# INLINE sourceIntFromThenTo #-}+sourceIntFromThenTo :: Int -> Stream Int+sourceIntFromThenTo n = P.enumFromThenTo n (n + 1) (n + value)++-------------------------------------------------------------------------------+-- Append+-------------------------------------------------------------------------------++{-# INLINE appendSourceR #-}+appendSourceR :: Int -> Stream Int+appendSourceR n = P.foldr (S.++) [] (P.map (: []) [n..n+appendValue])++{-# INLINE appendSourceL #-}+appendSourceL :: Int -> Stream Int+appendSourceL n = P.foldl (S.++) [] (P.map (: []) [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 :: Stream a -> ()+eval = S.foldr P.seq ()+ {-# INLINE toNull #-} {-# INLINE toList #-}+toNull, toList :: Stream Int -> ()++toNull = eval+toList = eval+ {-# INLINE foldl #-} {-# INLINE last #-}+foldl, last :: Stream Int -> Int+foldl = S.foldl' (+) 0+last = S.last++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE transform #-}+transform :: 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 filterEven #-} {-# INLINE mapM #-}+{-# INLINE filterEven #-} {-# INLINE filterAllOut #-} {-# INLINE filterAllIn #-} {-# INLINE takeOne #-} {-# INLINE takeAll #-} {-# INLINE takeWhileTrue #-}+{-# INLINE dropOne #-} {-# INLINE dropAll #-} {-# INLINE dropWhileTrue #-}-{-# INLINE zip #-}-{-# INLINE concat #-}-{-# INLINE composeMapM #-}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-toNull, toList, scan, map, filterEven, mapM, filterAllOut,- filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue,- concat, composeMapM, composeAllInFilters, composeAllOutFilters,- composeMapAllInFilter- :: [Int] -> [Int]+{-# INLINE dropWhileFalse #-}+scan, map, mapM,+ filterEven, filterAllOut, filterAllIn,+ takeOne, takeAll, takeWhileTrue,+ dropOne, dropAll, dropWhileTrue, dropWhileFalse+ :: Int -> Stream Int -> () -foldl :: [Int] -> Int-last :: [Int] -> Int-zip :: [Int] -> [(Int, 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) ---------------------------------------------------------------------------------- Stream generation and elimination+-- Iteration ------------------------------------------------------------------------------- -source :: Int -> [Int]-source v = [v..v+value]------------------------------------------------------------------------------------ Elimination--------------------------------------------------------------------------------+iterStreamLen, maxIters :: Int+iterStreamLen = 10+maxIters = 100000 -toNull = id-toList = id-foldl = S.foldl' (+) 0-last = S.last+{-# 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) ----------------------------------------------------------------------------------- Transformation--------------------------------------------------------------------------------+{-# INLINE iterateScan #-}+{-# INLINE iterateFilterEven #-}+{-# INLINE iterateTakeAll #-}+{-# INLINE iterateDropOne #-}+{-# INLINE iterateDropWhileFalse #-}+{-# INLINE iterateDropWhileTrue #-}+iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,+ iterateDropWhileFalse, iterateDropWhileTrue :: Int -> Stream Int -{-# INLINE transform #-}-transform :: [a] -> [a]-transform = id+-- 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 = transform . S.scanl' (+) 0-map = transform . S.map (+1)-mapM = map-filterEven = transform . S.filter even-filterAllOut = transform . S.filter (> maxValue)-filterAllIn = transform . S.filter (<= maxValue)-takeOne = transform . S.take 1-takeAll = transform . S.take maxValue-takeWhileTrue = transform . S.takeWhile (<= maxValue)-dropAll = transform . S.drop maxValue-dropWhileTrue = transform . S.dropWhile (<= maxValue)+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 ---------------------------------------------------------------------------------- Zipping and concat+-- Mixed Composition ------------------------------------------------------------------------------- -zip src = transform $ (S.zipWith (,) src src)-concat src = transform $ (S.concatMap (S.replicate 3) src)+{-# 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)+ ---------------------------------------------------------------------------------- Composition+-- Zipping and concat ------------------------------------------------------------------------------- -{-# INLINE compose #-}-compose :: ([Int] -> [Int]) -> [Int] -> [Int]-compose f = transform . f . f . f . f--composeMapM = compose (S.map (+1))-composeAllInFilters = compose (S.filter (<= maxValue))-composeAllOutFilters = compose (S.filter (> maxValue))-composeMapAllInFilter = compose (S.filter (<= maxValue) . S.map (subtract 1))+{-# INLINE zip #-}+zip :: Stream Int -> ()+zip src = P.foldr (\(x,y) xs -> P.seq x (P.seq y xs)) ()+ $ S.zipWith (,) src src -composeScaling :: Int -> [Int] -> [Int]-composeScaling m =- case m of- 1 -> transform . f- 2 -> transform . f . f- 3 -> transform . f . f . f- 4 -> transform . f . f . f . f- _ -> undefined- where f = S.filter (<= maxValue)+{-# INLINE concatMap #-}+concatMap :: Stream Int -> ()+concatMap src = transform $ (S.concatMap (S.replicate 3) src)
Benchmarks/Machines.hs view
@@ -9,48 +9,16 @@ {-# OPTIONS_GHC -Wno-incomplete-patterns #-} module Benchmarks.Machines where -import Benchmarks.Common (value, maxValue)+import Benchmarks.Common (value, maxValue, appendValue) import Prelude- (Monad, Int, (+), ($), return, even, (>), (<=),- subtract, replicate, Maybe(..))+ (Monad, Int, (.), (+), ($), return, even, (>), (<=),+ subtract, replicate, Maybe(..), maxBound, foldMap)+import qualified Prelude as P+import Data.Semigroup ((<>)) import qualified Data.Machine as S ---------------------------------------------------------------------------------- Benchmark ops----------------------------------------------------------------------------------{-# INLINE toNull #-}-{-# INLINE toList #-}-{-# INLINE foldl #-}-{-# INLINE last #-}-{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE filterEven #-}-{-# INLINE mapM #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE zip #-}-{-# INLINE concat #-}-{-# INLINE composeMapM #-}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-toNull, foldl, last, scan, map, filterEven, mapM, filterAllOut,- filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,- concat, composeMapM, composeAllInFilters, composeAllOutFilters,- composeMapAllInFilter- :: Monad m- => S.MachineT m k Int -> m ()--toList :: Monad m => S.MachineT m k Int -> m [Int]--------------------------------------------------------------------------------- -- Stream generation and elimination ------------------------------------------------------------------------------- @@ -66,14 +34,34 @@ then return Nothing else return (Just (cnt, cnt + 1)) -{-# INLINE runStream #-}-runStream :: Monad m => Pipe m Int o -> S.MachineT m k Int -> m ()-runStream t src = S.runT_ $ src S.~> t+-------------------------------------------------------------------------------+-- Append+------------------------------------------------------------------------------- +{-# INLINE appendSourceR #-}+appendSourceR :: Monad m => Int -> Source m Int+appendSourceR n = 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])+ ------------------------------------------------------------------------------- -- Elimination ------------------------------------------------------------------------------- +{-# INLINE runStream #-}+runStream :: Monad m => Pipe m Int o -> S.MachineT m k Int -> m ()+runStream t src = S.runT_ $ src S.~> t++{-# INLINE toNull #-}+{-# INLINE toList #-}+{-# INLINE foldl #-}+{-# INLINE last #-}+toNull, foldl, last :: Monad m => S.MachineT m k Int -> m ()+toList :: Monad m => S.MachineT m k Int -> m [Int]+ toNull = S.runT_ toList = S.runT foldl = runStream $ S.fold (+) 0@@ -87,43 +75,87 @@ transform :: Monad m => Pipe m Int o -> S.MachineT m k Int -> m () transform = runStream -scan = transform $ S.scan (+) 0-map = transform $ S.mapping (+1)-mapM = transform $ S.autoM return-filterEven = transform $ S.filtered even-filterAllOut = transform $ S.filtered (> maxValue)-filterAllIn = transform $ S.filtered (<= maxValue)-takeOne = transform $ S.taking 1-takeAll = transform $ S.taking maxValue-takeWhileTrue = transform $ S.takingWhile (<= maxValue)-dropAll = transform $ S.dropping maxValue-dropWhileTrue = transform $ S.droppingWhile (<= maxValue)+{-# INLINE composeN #-}+composeN :: Monad m => Int -> Pipe m Int Int -> S.MachineT m k Int -> m ()+composeN n f =+ case n of+ 1 -> transform $ f+ 2 -> transform $ f S.~> f+ 3 -> transform $ f S.~> f S.~> f+ 4 -> transform $ f S.~> f S.~> f S.~> 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+ :: Monad m => Int -> S.MachineT m k Int -> m ()++scan n = composeN n $ S.scan (+) 0+map n = composeN n $ S.mapping (+1)+mapM n = composeN n $ S.autoM return+filterEven n = composeN n $ S.filtered even+filterAllOut n = composeN n $ S.filtered (> maxValue)+filterAllIn n = composeN n $ S.filtered (<= maxValue)+takeOne n = composeN n $ S.taking 1+takeAll n = composeN n $ S.taking maxValue+takeWhileTrue n = composeN n $ S.takingWhile (<= maxValue)+dropOne n = composeN n $ S.dropping 1+dropAll n = composeN n $ S.dropping maxValue+dropWhileFalse n = composeN n $ S.droppingWhile (> maxValue)+dropWhileTrue n = composeN n $ S.droppingWhile (<= maxValue)+ ---------------------------------------------------------------------------------- Zipping and concat+-- Mixed Composition ------------------------------------------------------------------------------- -zip _src = S.runT_ (S.capT (source 10) (source 20) S.zipping)-concat = transform (S.mapping (replicate 3) S.~> S.asParts)+{-# 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+ :: Monad m => Int -> S.MachineT m k Int -> m () +scanMap n = composeN n $ S.mapping (subtract 1) S.~> S.scan (+) 0+dropMap n = composeN n $ S.mapping (subtract 1) S.~> S.dropping 1+dropScan n = composeN n $ S.scan (+) 0 S.~> S.dropping 1+takeDrop n = composeN n $ S.dropping 1 S.~> S.taking maxValue+takeScan n = composeN n $ S.scan (+) 0 S.~> S.taking maxValue+takeMap n = composeN n $ S.mapping (subtract 1) S.~> S.taking maxValue+filterDrop n = composeN n $ S.dropping 1 S.~> S.filtered (<= maxValue)+filterTake n = composeN n $ S.taking maxValue S.~> S.filtered (<= maxValue)+filterScan n = composeN n $ S.scan (+) 0 S.~> S.filtered (<= maxBound)+filterMap n = composeN n $ S.mapping (subtract 1) S.~> S.filtered (<= maxValue)+ ---------------------------------------------------------------------------------- Composition+-- Zipping and concat ------------------------------------------------------------------------------- -compose :: Monad m => Pipe m Int Int -> S.MachineT m k Int -> m ()-compose f = transform $ (f S.~> f S.~> f S.~> f)+{-# INLINE zip #-}+zip :: Monad m => S.MachineT m k Int -> m () -composeMapM = compose (S.autoM return)-composeAllInFilters = compose (S.filtered (<= maxValue))-composeAllOutFilters = compose (S.filtered (> maxValue))-composeMapAllInFilter = compose (S.mapping (subtract 1) S.~> S.filtered (<= maxValue))+zip _src = S.runT_ (S.capT (source 10) (source 20) S.zipping) -composeScaling :: Monad m => Int -> Source m Int -> m ()-composeScaling m =- case m of- 1 -> transform f- 2 -> transform (f S.~> f)- 3 -> transform (f S.~> f S.~> f)- 4 -> transform (f S.~> f S.~> f S.~> f)- -- _ -> undefined- where f = S.filtered (<= maxValue)+{-# INLINE concatMapFoldable #-}+concatMapFoldable :: Monad m => S.MachineT m k Int -> m ()+concatMapFoldable = transform (S.mapping (replicate 3) S.~> S.asParts)
Benchmarks/Pipes.hs view
@@ -9,52 +9,18 @@ module Benchmarks.Pipes where -import Benchmarks.Common (value, maxValue)+import Benchmarks.Common (value, maxValue, appendValue) import Data.Void (Void) import Prelude (Monad, Int, (+), ($), id, return, even, (>), (<=),- subtract, undefined, replicate, Maybe, Either(..), foldMap)+ subtract, undefined, replicate, Maybe, Either(..), foldMap, maxBound)+import qualified Prelude as P+import Data.Semigroup ((<>)) import qualified Pipes as S import qualified Pipes.Prelude as S ---------------------------------------------------------------------------------- Benchmark ops----------------------------------------------------------------------------------{-# INLINE toNull #-}-{-# INLINE toList #-}-{-# INLINE foldl #-}-{-# INLINE last #-}-{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE filterEven #-}-{-# INLINE mapM #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE zip #-}-{-# INLINE concat #-}-{-# INLINE composeMapM #-}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-toNull, scan, map, filterEven, mapM, filterAllOut,- filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,- concat, composeMapM, composeAllInFilters, composeAllOutFilters,- composeMapAllInFilter- :: Monad m- => Source m () Int -> m ()--toList :: Monad m => Source m () Int -> m [Int]-foldl :: Monad m => Source m () Int -> m Int-last :: Monad m => Source m () Int -> m (Maybe Int)--------------------------------------------------------------------------------- -- Stream generation and elimination ------------------------------------------------------------------------------- @@ -76,14 +42,27 @@ -- Append ------------------------------------------------------------------------------- -{-# INLINE appendSource #-}-appendSource :: Monad m => Int -> Source m () Int-appendSource n = foldMap S.yield [n..n+value]+{-# INLINE appendSourceR #-}+appendSourceR :: Monad m => Int -> Source m () Int+appendSourceR n = 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])+ ------------------------------------------------------------------------------- -- Elimination ------------------------------------------------------------------------------- +{-# INLINE toNull #-}+{-# INLINE toList #-}+{-# INLINE foldl #-}+{-# INLINE last #-}+toNull :: Monad m => Source m () Int -> m ()+toList :: Monad m => Source m () Int -> m [Int]+foldl :: Monad m => Source m () Int -> m Int+last :: Monad m => Source m () Int -> m (Maybe Int)+ toNull src = S.runEffect $ S.for src S.discard toList = S.toListM foldl = S.fold (+) 0 id@@ -97,44 +76,86 @@ transform :: Monad m => Pipe m Int Int -> Source m () Int -> m () transform t src = S.runEffect $ S.for (src S.>-> t) S.discard -scan = transform $ S.scan (+) 0 id-map = transform $ S.map (+1)-mapM = transform $ S.mapM return-filterEven = transform $ S.filter even-filterAllOut = transform $ S.filter (> maxValue)-filterAllIn = transform $ S.filter (<= maxValue)-takeOne = transform $ S.take 1-takeAll = transform $ S.take maxValue-takeWhileTrue = transform $ S.takeWhile (<= maxValue)-dropAll = transform $ S.drop maxValue-dropWhileTrue = transform $ S.dropWhile (<= maxValue)+{-# INLINE composeN #-}+composeN :: Monad m => Int -> Pipe m Int Int -> Source m () Int -> m ()+composeN n f =+ case n of+ 1 -> transform $ f+ 2 -> transform $ f S.>-> f+ 3 -> transform $ f S.>-> f S.>-> f+ 4 -> transform $ f S.>-> f S.>-> f S.>-> 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+ :: Monad m => Int -> Source m () Int -> m ()++scan n = composeN n $ S.scan (+) 0 id+map n = composeN n $ S.map (+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)+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)+ ---------------------------------------------------------------------------------- Zipping and concat+-- Mixed Composition ------------------------------------------------------------------------------- -zip src = S.runEffect $ S.for (S.zip src src) S.discard-concat = transform (S.map (replicate 3) S.>-> S.concat)+{-# 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+ :: Monad m => Int -> Source m () Int -> m () +scanMap n = composeN n $ S.map (subtract 1) S.>-> S.scan (+) 0 id+dropMap n = composeN n $ S.map (subtract 1) S.>-> S.drop 1+dropScan n = composeN n $ S.scan (+) 0 id S.>-> S.drop 1+takeDrop n = composeN n $ S.drop 1 S.>-> S.take maxValue+takeScan n = composeN n $ S.scan (+) 0 id S.>-> S.take maxValue+takeMap n = composeN n $ S.map (subtract 1) S.>-> S.take maxValue+filterDrop n = composeN n $ S.drop 1 S.>-> S.filter (<= maxValue)+filterTake n = composeN n $ S.take maxValue S.>-> S.filter (<= maxValue)+filterScan n = composeN n $ S.scan (+) 0 id S.>-> S.filter (<= maxBound)+filterMap n = composeN n $ S.map (subtract 1) S.>-> S.filter (<= maxValue)+ ---------------------------------------------------------------------------------- Composition+-- Zipping and concat ------------------------------------------------------------------------------- -{-# INLINE compose #-}-compose :: Monad m => Pipe m Int Int -> Source m () Int -> m ()-compose f = transform $ (f S.>-> f S.>-> f S.>-> f)--composeMapM = compose (S.mapM return)-composeAllInFilters = compose (S.filter (<= maxValue))-composeAllOutFilters = compose (S.filter (> maxValue))-composeMapAllInFilter = compose (S.map (subtract 1) S.>-> S.filter (<= maxValue))+{-# INLINE zip #-}+zip :: Monad m => Source m () Int -> m ()+zip src = S.runEffect $ S.for (S.zip src src) S.discard -composeScaling :: Monad m => Int -> Source m () Int -> m ()-composeScaling m =- case m of- 1 -> transform f- 2 -> transform (f S.>-> f)- 3 -> transform (f S.>-> f S.>-> f)- 4 -> transform (f S.>-> f S.>-> f S.>-> f)- _ -> undefined- where f = S.filter (<= maxValue)+{-# INLINE concatMapFoldable #-}+concatMapFoldable :: Monad m => Source m () Int -> m ()+concatMapFoldable = transform (S.map (replicate 3) S.>-> S.concat)
+ Benchmarks/Sequence.hs view
@@ -0,0 +1,211 @@+-- |+-- Module : Benchmarks.Sequence+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : MIT+-- Maintainer : harendra.kumar@gmail.com++{-# LANGUAGE ScopedTypeVariables #-}++module Benchmarks.Sequence where++import Benchmarks.Common (value, maxValue, appendValue)+import Prelude (Int, (+), ($), (.), even, (>), (<=), subtract, undefined,+ Maybe(..))+import qualified Prelude as P+import qualified Data.Foldable as P++import qualified Data.Sequence as S++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++type Stream = S.Seq++{-# 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 :: Stream a -> ()+eval = P.foldr P.seq ()++{-# INLINE toNull #-}+{-# INLINE toList #-}+{-# INLINE foldl #-}+{-# INLINE last #-}+toNull :: Stream Int -> ()+toList :: Stream Int -> ()+foldl :: Stream Int -> Int+last :: Stream Int -> Int++toNull = eval+toList = P.foldr P.seq () . P.toList+foldl = P.foldl' (+) 0+last xs =+ case S.viewr xs of+ _ S.:> x -> x+ _ -> undefined++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE transform #-}+transform :: 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 = undefined+map n = composeN n $ P.fmap (+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.takeWhileL (<= maxValue)+dropOne n = composeN n $ S.drop 1+dropAll n = composeN n $ S.drop maxValue+dropWhileFalse n = composeN n $ S.dropWhileL (> maxValue)+dropWhileTrue n = composeN n $ S.dropWhileL (<= 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 = 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+iterateDropWhileTrue n = iterateSource (S.dropWhileL (<= 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 = undefined -- composeN n $ S.map (subtract 1) . S.scanl' (+) 0+dropMap n = composeN n $ P.fmap (subtract 1) . S.drop 1+dropScan = undefined -- composeN n $ S.scanl' (+) 0 . S.drop 1+takeDrop n = composeN n $ S.drop 1 . S.take maxValue+takeScan = undefined -- composeN n $ S.scanl' (+) 0 . S.take maxValue+takeMap n = composeN n $ P.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 = undefined -- composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)+filterMap n = composeN n $ P.fmap (subtract 1) . S.filter (<= maxValue)++-------------------------------------------------------------------------------+-- Zipping and concat+-------------------------------------------------------------------------------++{-# INLINE zip #-}+zip :: Stream Int -> ()+zip src = transform $ (S.zipWith (,) src src)++{-# INLINE concat #-}+concat :: Stream Int -> Stream Int+concat _src = undefined -- transform $ (S.concatMap (S.replicate 3) src)
Benchmarks/Streaming.hs view
@@ -9,52 +9,18 @@ module Benchmarks.Streaming where -import Benchmarks.Common (value, maxValue)+import Benchmarks.Common (value, maxValue, appendValue) import Control.DeepSeq (NFData) import Prelude (Monad, Int, (+), id, ($), (.), return, even, (>), (<=),- subtract, undefined, Maybe, Either(..), foldMap)+ subtract, undefined, Maybe, Either(..), foldMap, maxBound)+import qualified Prelude as P+import Data.Semigroup ((<>)) --import Prelude (replicate) import qualified Streaming.Prelude as S ---------------------------------------------------------------------------------- Benchmark ops----------------------------------------------------------------------------------{-# INLINE toNull #-}-{-# INLINE toList #-}-{-# INLINE foldl #-}-{-# INLINE last #-}-{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE filterEven #-}-{-# INLINE mapM #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE zip #-}-{-# INLINE concat #-}-{-# INLINE composeMapM #-}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-toNull, scan, map, filterEven, mapM, filterAllOut,- filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,- concat, composeMapM, composeAllInFilters, composeAllOutFilters,- composeMapAllInFilter- :: Monad m- => Stream m Int -> m ()--toList :: Monad m => Stream m Int -> m (S.Of [Int] ())-foldl :: Monad m => Stream m Int -> m (S.Of Int ())-last :: Monad m => Stream m Int -> m (S.Of (Maybe Int) ())--------------------------------------------------------------------------------- -- Stream generation and elimination ------------------------------------------------------------------------------- @@ -77,18 +43,31 @@ -- Append ------------------------------------------------------------------------------- -{-# INLINE appendSource #-}-appendSource :: Monad m => Int -> Stream m Int-appendSource n = foldMap S.yield [n..n+value]+{-# INLINE appendSourceR #-}+appendSourceR :: Monad m => Int -> Stream m Int+appendSourceR n = foldMap S.yield [n..n+appendValue] -{-# INLINE runStream #-}-runStream :: Monad m => Stream m a -> m ()-runStream = S.mapM_ (\_ -> return ())+{-# INLINE appendSourceL #-}+appendSourceL :: Monad m => Int -> Stream m Int+appendSourceL n = P.foldl (<>) P.mempty (P.map S.yield [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination ------------------------------------------------------------------------------- +{-# INLINE runStream #-}+runStream :: Monad m => Stream m a -> m ()+runStream = S.mapM_ (\_ -> return ())++{-# INLINE toNull #-}+{-# INLINE toList #-}+{-# INLINE foldl #-}+{-# INLINE last #-}+toNull :: Monad m => Stream m Int -> m ()+toList :: Monad m => Stream m Int -> m (S.Of [Int] ())+foldl :: Monad m => Stream m Int -> m (S.Of Int ())+last :: Monad m => Stream m Int -> m (S.Of (Maybe Int) ())+ toNull = runStream toList = S.toList foldl = S.fold (+) 0 id@@ -102,46 +81,88 @@ transform :: Monad m => Stream m a -> m () transform = runStream -scan = transform . S.scan (+) 0 id-map = transform . S.map (+1)-mapM = transform . S.mapM return-filterEven = transform . S.filter even-filterAllOut = transform . S.filter (> maxValue)-filterAllIn = transform . S.filter (<= maxValue)-takeOne = transform . S.take 1-takeAll = transform . S.take maxValue-takeWhileTrue = transform . S.takeWhile (<= maxValue)-dropAll = transform . S.drop maxValue-dropWhileTrue = transform . S.dropWhile (<= maxValue)+{-# INLINE composeN #-}+composeN+ :: Monad m+ => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()+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+ :: Monad m => Int -> Stream m Int -> m ()++scan n = composeN n $ S.scan (+) 0 id+map n = composeN n $ S.map (+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)+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)+ ---------------------------------------------------------------------------------- Zipping and concat+-- Mixed Composition ------------------------------------------------------------------------------- -zip src = runStream $ (S.zip src src)-concat _src = return ()- -- it just hangs with 100% CPU usage- -- runStream $ (S.concat $ S.map (replicate 3) (source n))+{-# 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+ :: Monad m => Int -> Stream m Int -> m () +scanMap n = composeN n $ S.map (subtract 1) . S.scan (+) 0 id+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1+dropScan n = composeN n $ S.scan (+) 0 id . S.drop 1+takeDrop n = composeN n $ S.drop 1 . S.take maxValue+takeScan n = composeN n $ S.scan (+) 0 id . 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.scan (+) 0 id . S.filter (<= maxBound)+filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)+ ---------------------------------------------------------------------------------- Composition+-- Zipping and concat ------------------------------------------------------------------------------- -{-# INLINE compose #-}-compose :: Monad m => (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-compose f = transform . f . f . f . f--composeMapM = compose (S.mapM return)-composeAllInFilters = compose (S.filter (<= maxValue))-composeAllOutFilters = compose (S.filter (> maxValue))-composeMapAllInFilter = compose (S.filter (<= maxValue) . S.map (subtract 1))+{-# INLINE zip #-}+zip :: Monad m => Stream m Int -> m ()+zip src = runStream $ (S.zip src src) -composeScaling :: Monad m => Int -> Stream m Int -> m ()-composeScaling m =- case m of- 1 -> transform . f- 2 -> transform . f . f- 3 -> transform . f . f . f- 4 -> transform . f . f . f . f- _ -> undefined- where f = S.filter (<= maxValue)+{-# INLINE concatMapFoldable #-}+concatMapFoldable :: Monad m => Stream m Int -> m ()+concatMapFoldable src = runStream $ (S.concat $ S.map (P.replicate 3) src)
Benchmarks/Streamly.hs view
@@ -6,56 +6,20 @@ -- Maintainer : harendra.kumar@gmail.com {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Benchmarks.Streamly where -import Benchmarks.Common (value, maxValue)+import Benchmarks.Common (value, maxValue, appendValue) import Prelude- (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=),- subtract, undefined, Maybe(..), foldMap)+ (Monad, Int, (+), ($), (.), return, even, (>), (<=), div,+ subtract, undefined, Maybe(..), foldMap, maxBound) import qualified Prelude as P -import qualified Streamly as S import qualified Streamly.Prelude as S ---------------------------------------------------------------------------------- Benchmark ops----------------------------------------------------------------------------------{-# INLINE toNull #-}-{-# INLINE toList #-}-{-# INLINE foldl #-}-{-# INLINE last #-}-{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE filterEven #-}-{-# INLINE mapM #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE zip #-}-{-# INLINE concat #-}-{-# INLINE composeMapM #-}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-toNull, scan, map, filterEven, filterAllOut,- filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,- concat, composeAllInFilters, composeAllOutFilters,- composeMapAllInFilter- :: Monad m- => Stream m Int -> m ()--mapM, composeMapM :: S.MonadAsync 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)------------------------------------------------------------------------------------ Stream generation and elimination+-- Stream generation ------------------------------------------------------------------------------- type Stream m a = S.SerialT m a@@ -87,30 +51,39 @@ then return Nothing else return (Just (i, i + 1)) +{-# INLINE sourceIntFromThenTo #-}+sourceIntFromThenTo :: (Monad m, S.IsStream t) => Int -> t m Int+sourceIntFromThenTo n = S.enumerateFromThenTo n (n + 1) (n + value)+ ------------------------------------------------------------------------------- -- Append ------------------------------------------------------------------------------- -{-# INLINE appendSource #-}-appendSource :: Monad m => Int -> Stream m Int-appendSource n = foldMap (S.yieldM . return) [n..n+value]--{-# INLINE mapMSource #-}-mapMSource :: S.MonadAsync m => Int -> Stream m Int-mapMSource n = f 100000 (sourceN 10 n)- where- f :: S.MonadAsync m => Int -> Stream m Int -> Stream m Int- f 0 m = S.mapM return m- f x m = S.mapM return (f (x P.- 1) m)+{-# INLINE appendSourceR #-}+appendSourceR :: Int -> Stream m Int+appendSourceR n = foldMap S.fromPure [n..n+appendValue] -{-# INLINE runStream #-}-runStream :: Monad m => Stream m a -> m ()-runStream = S.runStream+{-# INLINE appendSourceL #-}+appendSourceL :: Int -> Stream m Int+appendSourceL n = P.foldl (P.<>) S.nil (P.map S.fromPure [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination ------------------------------------------------------------------------------- +{-# INLINE runStream #-}+runStream :: Monad m => Stream m a -> m ()+runStream = S.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 = runStream toList = S.toList foldl = S.foldl' (+) 0@@ -124,44 +97,130 @@ transform :: Monad m => Stream m a -> m () transform = runStream -scan = transform . S.scanl' (+) 0-map = transform . fmap (+1)-mapM = transform . S.mapM return-filterEven = transform . S.filter even-filterAllOut = transform . S.filter (> maxValue)-filterAllIn = transform . S.filter (<= maxValue)-takeOne = transform . S.take 1-takeAll = transform . S.take maxValue-takeWhileTrue = transform . S.takeWhile (<= maxValue)-dropAll = transform . S.drop maxValue-dropWhileTrue = transform . S.dropWhile (<= maxValue)+{-# INLINE composeN #-}+composeN+ :: Monad m+ => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()+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,+ filterEven, filterAllOut, filterAllIn,+ takeOne, takeAll, takeWhileTrue,+ dropOne, dropAll, dropWhileTrue, dropWhileFalse+ :: Monad m => Int -> Stream m Int -> m ()++mapM :: S.MonadAsync m => Int -> Stream m Int -> m ()++scan n = composeN n $ S.scanl' (+) 0+map n = composeN n $ S.map (+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)+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)+ ---------------------------------------------------------------------------------- Zipping and concat+-- Iteration ------------------------------------------------------------------------------- -zip src = transform $ (S.zipWith (,) src src)-concat _n = return ()+iterStreamLen, maxIters :: Int+iterStreamLen = 10+maxIters = 100000 +{-# INLINE iterateSource #-}+iterateSource+ :: S.MonadAsync m+ => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m 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 iterateMapM #-}+{-# INLINE iterateScan #-}+{-# INLINE iterateFilterEven #-}+{-# INLINE iterateTakeAll #-}+{-# INLINE iterateDropOne #-}+{-# INLINE iterateDropWhileFalse #-}+{-# INLINE iterateDropWhileTrue #-}+iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,+ iterateDropWhileFalse, iterateDropWhileTrue :: S.MonadAsync 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++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+ ---------------------------------------------------------------------------------- Composition+-- Mixed Composition ------------------------------------------------------------------------------- -{-# INLINE compose #-}-compose :: Monad m => (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-compose f = transform . f . f . f . f+{-# 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+ :: Monad m => Int -> Stream m Int -> m () -composeMapM = compose (S.mapM return)-composeAllInFilters = compose (S.filter (<= maxValue))-composeAllOutFilters = compose (S.filter (> maxValue))-composeMapAllInFilter = compose (S.filter (<= maxValue) . fmap (subtract 1))+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) -composeScaling :: Monad m => Int -> Stream m Int -> m ()-composeScaling m =- case m of- 1 -> transform . f- 2 -> transform . f . f- 3 -> transform . f . f . f- 4 -> transform . f . f . f . f- _ -> undefined- where f = S.filter (<= maxValue)+-------------------------------------------------------------------------------+-- Zipping and concat+-------------------------------------------------------------------------------++{-# INLINE zip #-}+zip :: S.MonadAsync m => Stream m Int -> m ()+zip src = transform $ (S.zipWith (,) src src)++{-# INLINE concatMap #-}+concatMap :: Monad m => Stream m Int -> m ()+concatMap src = transform $ (S.concatMap (S.replicate 3) src)++-- XXX composed zip and concat
+ Benchmarks/StreamlyArray.hs view
@@ -0,0 +1,222 @@+-- |+-- Module : Benchmarks.StreamlyArray+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : MIT+-- Maintainer : harendra.kumar@gmail.com++{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}++module Benchmarks.StreamlyArray where++import Control.Monad.IO.Class (MonadIO(..))+import Prelude (Int, (+), ($), (.), even, (>), (<=), subtract, undefined,+ maxBound, Maybe(..))+import qualified Prelude as P++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++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++type Stream = A.Array++{-# INLINE source #-}+source :: MonadIO m => Int -> m (Stream Int)+source n = S.fold (A.writeN value) (S.unfoldr step n)+ where+ step cnt =+ if cnt > n + value+ then Nothing+ else (Just (cnt, cnt + 1))++{-# INLINE sourceN #-}+sourceN :: MonadIO m => Int -> Int -> m (Stream Int)+sourceN count begin = S.fold (A.writeN value) (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+-------------------------------------------------------------------------------++{-# INLINE toNull #-}+toNull :: P.Monad m => Stream Int -> m (Stream Int)+toNull = P.return++{-# INLINE toList #-}+toList :: P.Monad m => Stream Int -> m ([Int])+toList = P.return . A.toList++{-# INLINE foldl #-}+foldl :: MonadIO m => Stream Int -> m Int+foldl = S.fold Fold.sum . S.unfold A.read++{-# INLINE last #-}+last :: P.Monad m => Stream Int -> m (Maybe Int)+last arr = P.return (A.getIndex arr (A.length arr P.- 1))++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-+{-# INLINE transform #-}+transform :: Stream a -> ()+transform = eval+-}++{-# INLINE composeN #-}+composeN+ :: S.MonadAsync m+ => Int+ -> (S.SerialT m Int -> S.SerialT 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+ _ -> 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+ :: S.MonadAsync m => Int -> Stream Int -> m (Stream Int)++scan n = composeN n $ S.scanl' (+) 0+map n = composeN n $ S.map (+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)+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 :: MonadIO m+ => (S.SerialT m Int -> S.SerialT 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)+ 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 #-}+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++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+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+ :: S.MonadAsync 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+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+-------------------------------------------------------------------------------++{-+{-# INLINE zip #-}+zip :: Stream Int -> ()+zip src = P.foldr (\(x,y) xs -> P.seq x (P.seq y xs)) ()+ $ S.zipWith (,) src src++{-# INLINE concat #-}+concat :: Stream Int -> ()+concat src = transform $ (S.concatMap (S.replicate 3) src)+-}
+ Benchmarks/StreamlyPure.hs view
@@ -0,0 +1,218 @@+-- |+-- Module : Benchmarks.StreamlyPure+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : MIT+-- Maintainer : harendra.kumar@gmail.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Benchmarks.StreamlyPure where++import Benchmarks.Common (value, maxValue, appendValue)+import Data.Functor.Identity (Identity, runIdentity)+import Prelude+ (Int, (+), ($), (.), even, (>), (<=),+ subtract, undefined, Maybe(..), foldMap, maxBound)+import qualified Prelude as P++import qualified Streamly.Prelude as S++-------------------------------------------------------------------------------+-- Stream generation+-------------------------------------------------------------------------------++type Stream = S.SerialT Identity++{-# INLINE source #-}+source :: Int -> Stream Int++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 = foldMap S.fromPure [n..n+appendValue]++{-# INLINE appendSourceL #-}+appendSourceL :: Int -> Stream Int+appendSourceL n = P.foldl (P.<>) S.nil (P.map S.fromPure [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 :: Stream a -> ()+eval = runIdentity . S.foldrM P.seq (P.return ())++-- 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 . runIdentity . S.toList++{-# INLINE foldl #-}+foldl :: Stream Int -> Int+foldl = runIdentity . S.foldl' (+) 0++{-# INLINE last #-}+last :: Stream Int -> Maybe Int+last = runIdentity . S.last++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE transform #-}+transform :: 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+-------------------------------------------------------------------------------++-- {-# 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)
+ Benchmarks/Text.hs view
@@ -0,0 +1,228 @@+-- |+-- Module : Benchmarks.Text+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : MIT+-- Maintainer : harendra.kumar@gmail.com++{-# LANGUAGE ScopedTypeVariables #-}++module Benchmarks.Text where++-- import Benchmarks.Common (value, maxValue, appendValue)+import Prelude (Int, (+), ($), (.), even, (>), (<=), undefined,+ Maybe(..), Char)+import qualified Prelude as P+import Data.Char (chr, ord)++import qualified Data.Text as S++nElements, nAppends :: Int+nElements = 1000000+nAppends = 10000++minElem, maxElem :: Char+minElem = chr 0+maxElem = P.maxBound++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++type Element = Char+type Stream a = S.Text++{-# INLINE sourceN #-}+sourceN :: Int -> Int -> Stream Element+sourceN count begin = S.unfoldr step begin+ where+ step i =+ if i > begin + count+ then Nothing+ else (Just (chr (i `P.mod` 10000), i + 1))++{-# INLINE source #-}+source :: Int -> Stream Element+source = sourceN nElements++-------------------------------------------------------------------------------+-- Append+-------------------------------------------------------------------------------++{-# INLINE appendSourceR #-}+appendSourceR :: Int -> Stream Element+appendSourceR n = 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])++-------------------------------------------------------------------------------+-- 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 :: Stream a -> ()+eval = S.foldr P.seq ()++-- eval foldable+{-# INLINE evalF #-}+evalF :: P.Foldable t => t a -> ()+evalF = P.foldr P.seq ()++plus :: Char -> Char -> Char+plus x y = chr $ (ord x + ord y) `P.mod` 10000++{-# INLINE toNull #-}+toNull :: Stream Element -> ()+toNull = eval++{-# INLINE toList #-}+toList :: Stream Element -> ()+toList = evalF . S.unpack++{-# INLINE foldl #-}+foldl :: Stream Element -> Element+foldl = S.foldl' plus (chr 0)++{-# INLINE last #-}+last :: Stream Element -> Element+last = S.last++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE transform #-}+transform :: Stream a -> ()+transform = eval++{-# INLINE composeN #-}+composeN :: Int+ -> (Stream Element -> Stream Element)+ -> Stream Element+ -> ()+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 -> ()++-- XXX there is no scanl'+scan n = composeN n $ S.scanl plus (chr 0)+map n = composeN n $ S.map (plus (chr 1))+mapM = map+filterEven n = composeN n $ S.filter (even . ord)+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 nElements+takeWhileTrue n = composeN n $ S.takeWhile (<= maxElem)+dropOne n = composeN n $ S.drop 1+dropAll n = composeN n $ S.drop nElements+dropWhileFalse n = composeN n $ S.dropWhile (> maxElem)+dropWhileTrue n = composeN n $ S.dropWhile (<= maxElem)++-------------------------------------------------------------------------------+-- Iteration+-------------------------------------------------------------------------------++iterStreamLen, maxIters :: Int+iterStreamLen = 10+maxIters = 100000++{-# INLINE iterateSource #-}+iterateSource :: (Stream Element -> Stream Element)+ -> Int+ -> Int+ -> Stream 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 iterateScan #-}+{-# INLINE iterateFilterEven #-}+{-# INLINE iterateTakeAll #-}+{-# INLINE iterateDropOne #-}+{-# INLINE iterateDropWhileFalse #-}+{-# INLINE iterateDropWhileTrue #-}+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++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+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+ :: Int -> Stream Element -> ()++-- XXX using scanl instead of scanl'+scanMap n = composeN n $ S.map (plus (chr 1)) . S.scanl plus (chr 0)+dropMap n = composeN n $ S.map (plus (chr 1)) . S.drop 1+dropScan n = composeN n $ S.scanl plus (chr 0) . S.drop 1+takeDrop n = composeN n $ S.drop 1 . S.take nElements+takeScan n = composeN n $ S.scanl plus (chr 0) . S.take nElements+takeMap n = composeN n $ S.map (plus (chr 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 $ S.scanl plus (chr 0) . S.filter (<= maxElem)+filterMap n = composeN n $ S.map (plus (chr 1)) . S.filter (<= maxElem)++-------------------------------------------------------------------------------+-- Zipping and concat+-------------------------------------------------------------------------------++{-# INLINE zip #-}+zip :: Stream Element -> ()+zip src = eval $ S.zipWith plus src src++{-# INLINE concatMap #-}+concatMap :: Stream Element -> ()+concatMap src = transform $ (S.concatMap (S.pack . P.replicate 3) src)
Benchmarks/Vector.hs view
@@ -1,117 +1,94 @@ -- | -- Module : Benchmarks.Vector -- Copyright : (c) 2018 Harendra Kumar--- (c) 2018 Philipp Schuster -- -- License : MIT -- Maintainer : harendra.kumar@gmail.com +{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Benchmarks.Vector where -import Benchmarks.Common (value, maxValue)-import Prelude- (Monad, Int, (+), ($), (.), return, even, (>), (<=),- subtract, undefined, replicate, Maybe(..))+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.Fusion.Stream.Monadic as S------------------------------------------------------------------------------------ Benchmark ops----------------------------------------------------------------------------------{-# INLINE toNull #-}-{-# INLINE toList #-}-{-# INLINE foldl #-}-{-# INLINE last #-}-{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE filterEven #-}-{-# INLINE mapM #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE zip #-}-{-# INLINE concat #-}-{-# INLINE composeMapM #-}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-toNull, scan, map, filterEven, mapM, filterAllOut,- filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,- concat, composeMapM, composeAllInFilters, composeAllOutFilters,- composeMapAllInFilter- :: 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 Int+-- 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 m a = S.Stream m a+type Stream = S.Vector {-# INLINE source #-}-source :: Monad m => Int -> Stream m Int---source n = S.fromList [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))- {-+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 :: Monad m => Int -> Int -> Stream m Int-sourceN count begin = S.unfoldrM step begin+sourceN :: Int -> Int -> Stream Int+sourceN count begin = S.unfoldr step begin where step i = if i > begin + count- then return Nothing- else return (Just (i, i + 1))+ then Nothing+ else (Just (i, i + 1)) ------------------------------------------------------------------------------- -- Append ------------------------------------------------------------------------------- -{-# INLINE appendSource #-}-appendSource :: Monad m => Int -> Stream m Int-appendSource n = P.foldr (S.++) S.empty (P.map S.singleton [n..n+value])--{-# INLINE mapMSource #-}-mapMSource :: Monad m => Int -> Stream m Int-mapMSource n = f 100000 (sourceN 10 n)- where- f :: Monad m => Int -> Stream m Int -> Stream m Int- f 0 m = S.mapM return m- f x m = S.mapM return (f (x P.- 1) m)+{-# INLINE appendSourceR #-}+appendSourceR :: Int -> Stream Int+appendSourceR n =+ P.foldr (S.++) S.empty (P.map S.singleton [n..n+appendValue]) -{-# INLINE runStream #-}-runStream :: Monad m => Stream m a -> m ()-runStream = S.mapM_ (\_ -> return ())+{-# INLINE appendSourceL #-}+appendSourceL :: Int -> Stream Int+appendSourceL n = P.foldl (S.++) S.empty (P.map S.singleton [n..n+appendValue]) ------------------------------------------------------------------------------- -- Elimination ------------------------------------------------------------------------------- -toNull = runStream-toList = S.toList+-- 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 -------------------------------------------------------------------------------@@ -119,47 +96,130 @@ ------------------------------------------------------------------------------- {-# INLINE transform #-}-transform :: Monad m => Stream m a -> m ()-transform = runStream+transform :: Storable a => Stream a -> ()+transform = eval -scan = transform . S.prescanl' (+) 0-map = transform . S.map (+1)-mapM = transform . S.mapM return-filterEven = transform . S.filter even-filterAllOut = transform . S.filter (> maxValue)-filterAllIn = transform . S.filter (<= maxValue)-takeOne = transform . S.take 1-takeAll = transform . S.take maxValue-takeWhileTrue = transform . S.takeWhile (<= maxValue)-dropAll = transform . S.drop maxValue-dropWhileTrue = transform . S.dropWhile (<= maxValue)+{-# 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)+ ---------------------------------------------------------------------------------- Zipping and concat+-- Iteration ------------------------------------------------------------------------------- -zip src = transform $ (S.zipWith (,) src src)-concat src = transform $ (S.concatMap (S.fromList . replicate 3) src)+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+ ---------------------------------------------------------------------------------- Composition+-- Mixed Composition ------------------------------------------------------------------------------- -{-# INLINE compose #-}-compose :: Monad m => (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-compose f = transform . f . f . f . f+{-# 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 -> () -composeMapM = compose (S.mapM return)-composeAllInFilters = compose (S.filter (<= maxValue))-composeAllOutFilters = compose (S.filter (> maxValue))-composeMapAllInFilter = compose (S.filter (<= maxValue) . S.map (subtract 1))+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) -composeScaling :: Monad m => Int -> Stream m Int -> m ()-composeScaling n =- case n of- 1 -> transform . f- 2 -> transform . f . f- 3 -> transform . f . f . f- 4 -> transform . f . f . f . f- _ -> undefined- where f = 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/VectorPure.hs
@@ -1,116 +0,0 @@--- |--- Module : Benchmarks.VectorPure--- Copyright : (c) 2018 Harendra Kumar------ License : MIT--- Maintainer : harendra.kumar@gmail.com--module Benchmarks.VectorPure where--import Benchmarks.Common (value, maxValue)-import Prelude (Int, (+), id, ($), (.), even, (>), (<=), subtract, undefined)--import qualified Data.Vector as S------------------------------------------------------------------------------------ Benchmark ops----------------------------------------------------------------------------------{-# INLINE toNull #-}-{-# INLINE toList #-}-{-# INLINE foldl #-}-{-# INLINE last #-}-{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE filterEven #-}-{-# INLINE mapM #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE zip #-}-{-# INLINE concat #-}-{-# INLINE composeMapM #-}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-scan, map, filterEven, mapM, filterAllOut,- filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue,- concat, composeMapM, composeAllInFilters, composeAllOutFilters,- composeMapAllInFilter- :: S.Vector Int -> S.Vector Int--toNull :: S.Vector Int -> [Int]-toList :: S.Vector Int -> [Int]-foldl :: S.Vector Int -> Int-last :: S.Vector Int -> Int-zip :: S.Vector Int -> S.Vector (Int, Int)------------------------------------------------------------------------------------ Stream generation and elimination----------------------------------------------------------------------------------source :: Int -> S.Vector Int-source v = S.fromList [v..v+value]------------------------------------------------------------------------------------ Elimination----------------------------------------------------------------------------------toNull = S.toList-toList = S.toList-foldl = S.foldl' (+) 0-last = S.last------------------------------------------------------------------------------------ Transformation----------------------------------------------------------------------------------{-# INLINE transform #-}-transform :: S.Vector a -> S.Vector a-transform = id--scan = transform . S.scanl' (+) 0-map = transform . S.map (+1)-mapM = map-filterEven = transform . S.filter even-filterAllOut = transform . S.filter (> maxValue)-filterAllIn = transform . S.filter (<= maxValue)-takeOne = transform . S.take 1-takeAll = transform . S.take maxValue-takeWhileTrue = transform . S.takeWhile (<= maxValue)-dropAll = transform . S.drop maxValue-dropWhileTrue = transform . S.dropWhile (<= maxValue)------------------------------------------------------------------------------------ Zipping and concat----------------------------------------------------------------------------------zip src = transform $ (S.zipWith (,) src src)-concat src = transform $ (S.concatMap (S.replicate 3) src)------------------------------------------------------------------------------------ Composition----------------------------------------------------------------------------------{-# INLINE compose #-}-compose :: (S.Vector Int -> S.Vector Int) -> S.Vector Int -> S.Vector Int-compose f = transform . f . f . f . f--composeMapM = compose (S.map (+1))-composeAllInFilters = compose (S.filter (<= maxValue))-composeAllOutFilters = compose (S.filter (> maxValue))-composeMapAllInFilter = compose (S.filter (<= maxValue) . S.map (subtract 1))--composeScaling :: Int -> S.Vector Int -> S.Vector Int-composeScaling m =- case m of- 1 -> transform . f- 2 -> transform . f . f- 3 -> transform . f . f . f- 4 -> transform . f . f . f . f- _ -> undefined- where f = S.filter (<= maxValue)
+ Benchmarks/VectorStreams.hs view
@@ -0,0 +1,222 @@+-- |+-- Module : Benchmarks.VectorStreams+-- Copyright : (c) 2018 Harendra Kumar+-- (c) 2018 Philipp Schuster+--+-- License : MIT+-- Maintainer : harendra.kumar@gmail.com++{-# LANGUAGE ScopedTypeVariables #-}++module Benchmarks.VectorStreams where++import Benchmarks.Common (value, maxValue, appendValue)+import Prelude+ (Monad, Int, (+), ($), (.), return, even, (>), (<=), div,+ subtract, undefined, Maybe(..))+import qualified Prelude as P++import qualified Data.Vector.Fusion.Stream.Monadic as S++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++type Stream m a = S.Stream m a++{-# INLINE source #-}+source :: Monad m => Int -> Stream m Int+--source n = S.fromList [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))+ {-+source n = S.unfoldr step n+ where+ step cnt =+ if cnt > n + value+ then Nothing+ else (Just (cnt, cnt + 1))+ -}++{-# INLINE sourceN #-}+sourceN :: Monad m => Int -> Int -> Stream m Int+sourceN count begin = S.unfoldrM step begin+ where+ step i =+ if i > begin + count+ then return Nothing+ else return (Just (i, i + 1))++{-# INLINE sourceIntFromThenTo #-}+sourceIntFromThenTo :: Monad m => Int -> Stream m Int+sourceIntFromThenTo n = S.enumFromStepN n 1 value++-------------------------------------------------------------------------------+-- Append+-------------------------------------------------------------------------------++{-# INLINE appendSourceR #-}+appendSourceR :: Monad m => Int -> Stream m Int+appendSourceR n = 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])++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++{-# INLINE runStream #-}+runStream :: Monad m => Stream m a -> m ()+runStream = S.mapM_ (\_ -> return ())++{-# 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 Int++toNull = runStream+toList = S.toList+foldl = S.foldl' (+) 0+last = S.last++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE transform #-}+transform :: Monad m => Stream m a -> m ()+transform = runStream++{-# INLINE composeN #-}+composeN+ :: Monad m+ => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()+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+ :: Monad m => Int -> Stream m Int -> m ()++scan n = composeN n $ S.scanl' (+) 0+map n = composeN n $ S.map (+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)+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+ :: Monad m+ => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m 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 iterateMapM #-}+{-# INLINE iterateScan #-}+{-# INLINE iterateFilterEven #-}+{-# INLINE iterateTakeAll #-}+{-# INLINE iterateDropOne #-}+{-# INLINE iterateDropWhileFalse #-}+{-# INLINE iterateDropWhileTrue #-}+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++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++-------------------------------------------------------------------------------+-- 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+ :: Monad m => Int -> Stream m Int -> 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 (<= P.maxBound)+filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)++-------------------------------------------------------------------------------+-- Zipping and concat+-------------------------------------------------------------------------------++{-# INLINE zip #-}+zip :: Monad m => Stream m Int -> m ()+zip src = transform $ (S.zipWith (,) src src)++{-# INLINE concatMap #-}+concatMap :: Monad m => Stream m Int -> m ()+concatMap src = transform $ (S.concatMap (S.replicate 3) src)
Changelog.md view
@@ -1,3 +1,18 @@+## 0.3.0++* Simplify the README, use text tables instead of graphs.+* Upgrade to latest release of all streaming packages+* Build bench-report utility independently to avoid dependency issues+* Add benchmarks for streamly pure lists, streamly arrays, bytestring,+ text, dlist, sequence+* Add benchmarks to measure composition of the filtering and+ transformation operations multiple times+* Add benchmarks to measure composition of various combinations of different+ operations multiple times.+* Add benchmarks that iterate the same operation multiple times+* Use the `bench-show` package for better reporting of diffs. Supports+ comparison in multiples or percentages of other packages.+ ## 0.2.0 * Added benchmarks for pure lists
Charts.hs view
@@ -1,13 +1,18 @@ {-# 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 BenchGraph (bgraph, defaultConfig, Config(..), ComparisonStyle(..))+import BenchShow import WithCli (withCli) import Data.List@@ -20,50 +25,92 @@ charts :: [(String, [String])] charts = [- -- Operations are listed in increasing cost order- {-- ( "Key Operations"+ ( "Elimination Operations" , [- "elimination/fold"+ "elimination/drain"+ , "elimination/last"+ , "elimination/foldl'"+ ]+ )+ , ( "Transformation Operations"+ , [ "transformation/map" , "transformation/mapM"- , "filtering/filter-even"- , "zip"+ , "transformation/scan" ] )- , -} ( "Append Operation"- , [ "append"+ , ( "Transformation Operations x 4"+ , [ "transformationX4/map x 4"+ , "transformationX4/mapM x 4"+ , "transformationX4/scan x 4" ] )- , ( "Key Operations"+ , ( "Filtering Operations" , [- "elimination/drain"+ "filtering/filter-all-out"+ , "filtering/filter-all-in" , "filtering/drop-all"- -- , "filtering/dropWhile-true"- -- , "filtering/filter-all-out"- , "elimination/last"- , "elimination/fold"- -- "filtering/take-one"- , "transformation/map"+ , "filtering/takeWhile-true" , "filtering/take-all"- --, "filtering/takeWhile-true"- -- , "filtering/filter-all-in"+ , "filtering/dropWhile-true" , "filtering/filter-even"- , "transformation/scan"- , "transformation/mapM"- , "zip"- -- , "transformation/concat"+ , "filtering/drop-one"+ , "filtering/dropWhile-false" ] )- , ( "toList Operation"- , [ "elimination/toList"+ , ( "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" ] )- , ( "Composed Operations: 4 times"- , [ "compose/mapM"- , "compose/all-in-filters"- , "compose/map-with-all-in-filter"+ , ( "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"+ ]+ ) ] -------------------------------------------------------------------------------@@ -71,7 +118,7 @@ -- returns [(packagename, version)] getPkgVersions :: [String] -> IO [(String, String)] getPkgVersions packages = do- (ecode, out, _) <- readProcess "stack --system-ghc list-dependencies --bench"+ (ecode, out, _) <- readProcess "stack list-dependencies --bench" case ecode of ExitSuccess -> do@@ -99,15 +146,34 @@ Nothing -> p Just v -> p ++ "-" ++ v -createCharts :: String -> String -> Bool -> IO ()-createCharts input pkgList delta = do+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- let pkgInfo = []- -- pkgInfo <- getPkgVersions- let cfg (title, prefixes) = defaultConfig- { chartTitle = Just title- , outputDir = "charts"- , comparisonStyle = if delta then CompareDelta else CompareFull++ 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 ->@@ -118,30 +184,99 @@ True -> Just (suffixVersion pkgInfo grp, bench) False -> Nothing False -> Nothing- , sortBenchmarks = \bs ->- let i = intersect (map (last . splitOn "/") prefixes) bs- in i ++ (bs \\ i)- , sortBenchGroups = \gs ->- let i = intersect (map (suffixVersion pkgInfo) packages) gs- in i ++ (gs \\ i)+ , 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 title field =- (filter (not . isSpace) (takeWhile (/= '(') title))- ++ "-"- ++ field+ -- 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 - makeOneGraph infile field (title, prefixes) = do- let title' =- title- ++ " (" ++ field ++ ")"- ++ " (Lower is Better)"- bgraph infile (toOutfile title field) field (cfg (title', prefixes))+ let selectByRegression f =+ reverse+ $ fmap fst+ $ either+ (const $ either error id $ f (ColumnIndex 0) Nothing)+ (sortOn snd)+ $ f (ColumnIndex 1) Nothing - mapM_ (makeOneGraph input "time") charts- mapM_ (makeOneGraph input "allocated") charts- mapM_ (makeOneGraph input "maxrss") charts+ 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 ()
LICENSE view
@@ -19,3 +19,38 @@ Please also see the licenses for other contributions in the "licenses" directory.++-------------------------------------------------------------------------------+-- The initial code was adapated from the "machines" package+-------------------------------------------------------------------------------++Copyright 2012-2015 Edward Kmett, Runar Bjarnason, Paul Chiusano++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,311 @@+# Streaming Benchmarks++[](https://hackage.haskell.org/package/streaming-benchmarks)+[](https://gitter.im/composewell/streamly)+[](https://travis-ci.org/composewell/streaming-benchmarks)+[](https://ci.appveyor.com/project/harendra-kumar/streaming-benchmarks)++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+benchmarking correctly and fairly. See [the notes on correct+benchmarking](docs/benchmarking-notes.md).++DISCLAIMER: This package is a result of benchmarking effort done during the+development of [streamly](https://github.com/composewell/streamly) by the+authors of [streamly](https://github.com/composewell/streamly).++## Benchmarks++The benchmark names are obvious, some of them are described below. Single+operation benchmarks:++| Name | Description |+| -------------- | ----------------------------------------------------------- |+| `drain` | Just discards all the elements in the stream |+| `drop-all` | drops all element using the ``drop`` operation |+| `last` | extract the last element of the stream |+| `fold` | sum all the numbers in the stream |+| `map` | increments each number in the stream by 1 |+| `take-all` | Use ``take`` to retain all the elements in the stream |+| `filter-even` | Keep even numbers, discard odd |+| `scan` | scan the stream using ``+`` operation |+| `mapM` | transform the stream using a monadic action |+| `zip` | combines corresponding elements of the two streams together |++Composite operation benchmarks:++| Name | Description |+| -------------- | ----------------------------------------------------------- |+| `map x 4` | perform `map` operation 4 times |+| `take-map` | `take` followed by a `map` |++For more details on how each benchmark is implemented see+[this benchmark file](https://github.com/composewell/streaming-benchmarks/blob/master/Benchmarks/Streamly.hs).++Each benchmark is run in a separate process to avoid any effects of GC+interference and sharing across benchmarks.++## Benchmark Results++Below we present some results comparing+[streamly](https://github.com/composewell/streamly) with other streaming+implementations.+Due care has been taken to keep the comparisons fair. We have optimized+each library's code to the best of our knowledge, please point out if+you find any measurement issues.++### Reproducing benchmark results++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.++```+$ cabal install --flag dev --installdir charts --with-compiler ghc-8.8.4 bench-report+```++Nix users can use bench-report.nix. It uses an older version of nixpkgs that+contains the required dependencies:++```+$ nix-shell bench-report.nix --run "cabal install --flag dev --installdir charts bench-report"+```++### Streamly vs Haskell Lists++Streamly, when used with `Identity` monad, is almost the same as Haskell lists+(in the `base` package).+[See this](https://github.com/composewell/streamly/blob/master/docs/streamly-vs-lists.md)+for more details.++The following table compares the timing of several operations for+[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.++| Benchmark | streamly(μs) | list(μs) | list/streamly |+| ------------------- | ------------ | ---------- | ------------- |+| drop-map x 4 | 375.09 | 76925.32 | 205.08 |+| filter-drop x 4 | 382.03 | 54848.54 | 143.57 |+| drop-scan x 4 | 795.81 | 76716.79 | 96.40 |+| filter-scan x 4 | 795.60 | 44559.15 | 56.01 |+| scan-map x 4 | 1192.19 | 48838.22 | 40.97 |+| take-map x 4 | 1500.99 | 60126.58 | 40.06 |+| filter-take x 4 | 1502.01 | 48766.87 | 32.47 |+| take-drop x 4 | 1499.62 | 41720.03 | 27.82 |+| take-scan x 4 | 1874.94 | 51283.30 | 27.35 |+| drop-one x 4 | 375.33 | 8993.87 | 23.96 |+| dropWhile-false x 4 | 374.61 | 8957.79 | 23.91 |+| dropWhile-false | 374.83 | 8670.05 | 23.13 |+| drop-one | 390.77 | 8681.85 | 22.22 |+| dropWhile-true | 571.60 | 12237.48 | 21.41 |+| drop-all | 562.94 | 8262.38 | 14.68 |+| take-all | 624.83 | 564.34 | 1/1.11 |+| scan x 4 | 795.83 | 385.85 | 1/2.06 |+| appendR[10000] | 360.75 | 126.95 | 1/2.84 |+| concatMap | 34957.71 | 1124.85 | 1/31.08 |++* streamly-0.8.0, base-4.14.1.0, ghc-8.10.4, Linux++To reproduce these results use the following commands:++```+$ ./bench.sh --benchmarks "pure-streamly,list" --measure+$ ./bench.sh --benchmarks "pure-streamly,list" --diff multiples+```++### Streamly vs Streaming++The following table compares the timing of several operations+for [streamly](https://github.com/composewell/streamly) with+[streaming](https://hackage.haskell.org/package/streaming) using a+million element stream.++| Benchmark | streamly(μs) | streaming(μs) | streaming/streamly |+| ------------------- | ------------ | ------------- | ------------------ |+| appendR[10000] | 326.56 | 1301176.69 | 3984.54 |+| mapM x 4 | 374.42 | 223591.08 | 597.17 |+| filter-map x 4 | 381.07 | 194903.88 | 511.47 |+| filter-scan x 4 | 795.66 | 233527.90 | 293.50 |+| filter-all-in x 4 | 375.40 | 102629.64 | 273.38 |+| filter-drop x 4 | 387.15 | 99096.98 | 255.96 |+| map x 4 | 386.49 | 94944.87 | 245.66 |+| drop-map x 4 | 375.62 | 89669.37 | 238.73 |+| scan x 4 | 797.00 | 166332.40 | 208.70 |+| scan-map x 4 | 1194.30 | 238804.48 | 199.95 |+| filter-even x 4 | 396.37 | 77865.47 | 196.45 |+| drop-scan x 4 | 796.98 | 156063.52 | 195.82 |+| takeWhile-true x 4 | 562.49 | 90183.53 | 160.33 |+| scan | 375.24 | 47520.57 | 126.64 |+| filter-take x 4 | 1498.55 | 189635.34 | 126.55 |+| mapM | 388.10 | 46689.61 | 120.30 |+| take-map x 4 | 1500.71 | 178954.50 | 119.25 |+| zip | 656.65 | 66689.73 | 101.56 |+| take-scan x 4 | 2380.35 | 241675.75 | 101.53 |+| filter-all-in | 375.97 | 33590.14 | 89.34 |+| map | 375.02 | 33081.13 | 88.21 |+| filter-even | 393.26 | 30458.46 | 77.45 |+| filter-all-out | 382.87 | 26826.21 | 70.07 |+| take-all x 4 | 1499.71 | 101332.53 | 67.57 |+| take-drop x 4 | 1498.53 | 98281.99 | 65.59 |+| takeWhile-true | 562.62 | 31863.25 | 56.63 |+| foldl' | 388.22 | 18503.15 | 47.66 |+| drop-all | 562.08 | 25200.32 | 44.83 |+| take-all | 768.65 | 33247.97 | 43.26 |+| dropWhile-true | 564.87 | 24431.50 | 43.25 |+| last | 385.53 | 15240.85 | 39.53 |+| dropWhile-false | 374.83 | 14566.70 | 38.86 |+| drop-one | 374.80 | 14565.01 | 38.86 |+| drop-one x 4 | 375.88 | 14448.67 | 38.44 |+| dropWhile-false x 4 | 390.12 | 14619.42 | 37.47 |+| drain | 375.06 | 13702.29 | 36.53 |+| toList | 117708.83 | 201444.81 | 1.71 |++* streamly-0.8.0, streaming-0.2.3.0, ghc-8.10.4, Linux++To reproduce these results use the following commands:++```+$ ./bench.sh --benchmarks "streamly,streaming" --measure+$ ./bench.sh --benchmarks "streamly,streaming" --diff multiples+```++### Streamly vs Pipes++The following table compares the timing of several operations+for [streamly](https://github.com/composewell/streamly) with+[pipes](https://hackage.haskell.org/package/pipes) using a+million element stream.++| Benchmark | streamly(μs) | pipes(μs) | pipes/streamly |+| ------------------- | ------------ | --------- | -------------- |+| appendR[10000] | 327.90 | 901135.92 | 2748.21 |+| mapM x 4 | 375.20 | 407184.39 | 1085.23 |+| filter-map x 4 | 381.52 | 366759.70 | 961.31 |+| drop-map x 4 | 375.48 | 281296.82 | 749.16 |+| filter-all-in x 4 | 375.60 | 222331.68 | 591.93 |+| filter-drop x 4 | 387.44 | 222830.71 | 575.14 |+| drop-scan x 4 | 797.23 | 336737.89 | 422.39 |+| filter-even x 4 | 389.87 | 152688.91 | 391.64 |+| filter-scan x 4 | 797.38 | 309733.91 | 388.44 |+| drop-one x 4 | 375.48 | 139851.13 | 372.46 |+| map x 4 | 386.56 | 136289.32 | 352.57 |+| dropWhile-false x 4 | 390.72 | 137395.44 | 351.65 |+| scan-map x 4 | 1194.38 | 381286.88 | 319.23 |+| takeWhile-true x 4 | 562.86 | 165143.23 | 293.40 |+| scan x 4 | 796.68 | 222986.17 | 279.90 |+| mapM | 388.19 | 95576.97 | 246.21 |+| filter-all-in | 375.21 | 71297.42 | 190.02 |+| take-map x 4 | 1502.76 | 275887.24 | 183.59 |+| scan | 374.81 | 65549.13 | 174.89 |+| take-drop x 4 | 1503.43 | 256448.45 | 170.58 |+| filter-even | 390.29 | 66183.72 | 169.57 |+| filter-all-out | 376.99 | 59074.54 | 156.70 |+| drop-one | 375.19 | 58395.24 | 155.64 |+| dropWhile-false | 375.35 | 58223.03 | 155.12 |+| map | 375.05 | 57736.43 | 153.94 |+| filter-take x 4 | 1503.00 | 227925.71 | 151.65 |+| take-scan x 4 | 2455.91 | 354284.33 | 144.26 |+| zip | 657.07 | 86011.93 | 130.90 |+| takeWhile-true | 564.14 | 61390.21 | 108.82 |+| take-all x 4 | 1502.32 | 139730.70 | 93.01 |+| dropWhile-true | 564.03 | 49227.19 | 87.28 |+| drop-all | 562.05 | 46505.37 | 82.74 |+| take-all | 824.09 | 60511.34 | 73.43 |+| drain | 375.29 | 26390.59 | 70.32 |+| foldl' | 397.34 | 19064.05 | 47.98 |+| last | 387.11 | 17364.44 | 44.86 |+| toList | 117257.09 | 207405.94 | 1.77 |++* streamly-0.8.0, pipes-4.3.16, ghc-8.10.4, Linux++To reproduce these results use the following commands:++```+$ ./bench.sh --benchmarks "streamly,pipes" --measure+$ ./bench.sh --benchmarks "streamly,pipes" --diff multiples+```++### Streamly vs Conduit++The following table compares the timing of several operations+for [streamly](https://github.com/composewell/streamly) with+[conduit](https://hackage.haskell.org/package/conduit) using a+million element stream.++| Benchmark | streamly(μs) | conduit(μs) | conduit/streamly |+| ------------------- | ------------ | ----------- | ---------------- |+| mapM x 4 | 375.46 | 297002.31 | 791.04 |+| filter-map x 4 | 380.79 | 267543.81 | 702.60 |+| drop-map x 4 | 375.66 | 232307.84 | 618.39 |+| filter-drop x 4 | 386.05 | 235029.15 | 608.81 |+| filter-scan x 4 | 796.56 | 306556.67 | 384.85 |+| drop-scan x 4 | 797.19 | 300789.06 | 377.31 |+| zip | 657.29 | 210069.05 | 319.60 |+| filter-all-in x 4 | 375.24 | 118506.68 | 315.82 |+| scan-map x 4 | 1194.67 | 360671.18 | 301.90 |+| map x 4 | 387.00 | 113497.14 | 293.27 |+| drop-one x 4 | 375.49 | 101842.95 | 271.23 |+| dropWhile-false x 4 | 389.44 | 102051.22 | 262.04 |+| scan x 4 | 796.72 | 190479.35 | 239.08 |+| takeWhile-true x 4 | 564.58 | 114459.57 | 202.73 |+| filter-even x 4 | 391.76 | 72369.30 | 184.73 |+| filter-take x 4 | 1502.04 | 267921.27 | 178.37 |+| take-map x 4 | 1502.88 | 238875.95 | 158.95 |+| take-drop x 4 | 1500.34 | 232606.19 | 155.04 |+| take-scan x 4 | 2443.83 | 309738.86 | 126.74 |+| mapM | 389.15 | 41897.48 | 107.66 |+| scan | 375.40 | 38137.85 | 101.59 |+| take-all x 4 | 1502.32 | 110682.74 | 73.67 |+| filter-all-in | 375.31 | 26024.21 | 69.34 |+| dropWhile-false | 375.10 | 25307.13 | 67.47 |+| map | 375.18 | 23088.09 | 61.54 |+| drop-one | 375.43 | 22020.65 | 58.65 |+| filter-even | 392.28 | 21504.28 | 54.82 |+| takeWhile-true | 562.79 | 29012.68 | 51.55 |+| filter-all-out | 378.76 | 15736.05 | 41.55 |+| drop-all | 562.89 | 19916.48 | 35.38 |+| foldl' | 388.88 | 12499.03 | 32.14 |+| dropWhile-true | 564.43 | 17983.35 | 31.86 |+| take-all | 784.67 | 24425.36 | 31.13 |+| last | 385.75 | 10974.84 | 28.45 |+| drain | 375.18 | 4272.15 | 11.39 |+| appendR[10000] | 326.93 | 1207.88 | 3.69 |+| toList | 116441.26 | 199138.09 | 1.71 |++* 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+```++## Comparing other libraries++This package supports many streaming libraries. Use the following command to+see all available benchmarks:++```+$ ./bench.sh --help+```++You can then select the libraries you want to compare:++```+$ ./bench.sh --benchmarks "streaming,pipes" --measure+```++## Adding New Libraries++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)+and ask!
− README.rst
@@ -1,442 +0,0 @@-Streaming Benchmarks-====================--.. image:: https://badges.gitter.im/composewell/gitter.svg?- :target: https://gitter.im/composewell/streamly- :alt: Gitter chat--.. image:: https://img.shields.io/hackage/v/streaming-benchmarks.svg?style=flat- :target: https://hackage.haskell.org/package/streaming-benchmarks- :alt: Hackage--.. image:: https://travis-ci.org/composewell/streaming-benchmarks.svg?branch=master- :target: https://travis-ci.org/composewell/streaming-benchmarks- :alt: Unix Build Status--.. image:: https://ci.appveyor.com/api/projects/status/8d1kgrrw9mmxv5xt?svg=true- :target: https://ci.appveyor.com/project/harendra-kumar/streaming-benchmarks- :alt: Windows Build status--.. contents:: Table of Contents- :depth: 1--This package compares `streamly <https://github.com/composewell/streamly>`_, a-blazing fast streaming library providing native high level, declarative and-composable concurrency support, with popular streaming libraries e.g. vector,-streaming, pipes and conduit. This package has been motivated by `streamly-<https://github.com/composewell/streamly>`_, however, it is general purpose and-compares more libraries and benchmarks than shown here. Please send an email or-a pull request if the benchmarking code has a problem or is unfair to some-library in any way.--Benchmarks & Results-----------------------A stream of one million consecutive numbers is generated using monadic unfold-API ``unfoldrM``, these elements are then processed using a streaming-combinator under test (e.g. ``map``). The total time to process all one million-operations, and the maximum resident set size (rss) is measured and plotted for-each library. The underlying monad for each stream is the IO Monad. All the-libraries are compiled with GHC-8.4.3. All the benchmarks were run on an Apple-MacBook Pro computer with a single 2.2 GHz Intel Core i7 processor with 4 cores-and 16GB RAM.--Highlights-~~~~~~~~~~--* ``streamly`` shows the best overall performance in terms of time as well as- space. ``streamly`` and ``vector`` show similar performance except- for the ``append`` operation where ``streamly`` is much better, and the- ``filter`` operation where vector is faster.-* The ``append`` operation scales well only for ``streamly`` and ``conduit``.- All other libraries show quadratic complexity on this operation.-* ``streaming`` performs slightly better than ``conduit`` when multiple- operations are composed together even though in terms of individual- operations it is slightly worse than ``conduit``.-* ``conduit`` and ``pipes`` show unusually large space utilization for- ``take`` and ``drop`` operations (more than 100-150 MiB vs 3 MiB).-* ``drinkery`` shows very good performance too though not plotted here because- of a small issue in measurement and lack of space.-* ``machines`` is roughly 2x slower than the slowest library here, and its- maximum resident set size is close to 100 MiB for all operations (touching- 300 MiB for ``take``) compared to the 3MiB for all other libraries. I am not- sure if there is something wrong with the measurements or the benchmarking- code, majority of the code is common to all libraries, any improvements in- the machines benchmarking code are welcome.--Key Operations-~~~~~~~~~~~~~~--The following diagram plots the time taken by key streaming operations to-process a million stream elements.-*Note: the time for streamly and vector is very low (600-700 microseconds) and-therefore can barely be seen in this graph.*--.. |keyoperations-time| image:: charts-0/KeyOperations-time.svg- :width: 75%- :target: charts-0/KeyOperations-time.svg- :alt: Time Cost of Key Streaming Operations--|keyoperations-time|--For those interested in the heap allocations, the following diagram-plots the overall heap allocations during each measurement period i.e. the-total allocations for processing one million stream elements.--.. |keyoperations-allocated| image:: charts-0/KeyOperations-allocated.svg- :width: 75%- :target: charts-0/KeyOperations-allocated.svg- :alt: Heap allocations for Key Streaming Operations--|keyoperations-allocated|--The following diagram plots the maximum resident set size (rss) during the-measurement of each operation. In plain terms, it is the maximum amount of-physical memory that is utilized at any point during the measurement.--.. |keyoperations-maxrss| image:: charts-0/KeyOperations-maxrss.svg- :width: 75 %- :target: charts-0/KeyOperations-maxrss.svg- :alt: Maximum rss for Key Streaming Operations--|keyoperations-maxrss|--+------------------------+----------------------------------------------------+-| Benchmark | Description |-+========================+====================================================+-| drain | Just discards all the elements in the stream |-+------------------------+----------------------------------------------------+-| drop-all | drops all element using the ``drop`` operation |-+------------------------+----------------------------------------------------+-| last | extract the last element of the stream |-+------------------------+----------------------------------------------------+-| fold | sum all the numbers in the stream |-+------------------------+----------------------------------------------------+-| map | increments each number in the stream by 1 |-+------------------------+----------------------------------------------------+-| take-all | Use ``take`` to retain all the elements in the |-| | stream |-+------------------------+----------------------------------------------------+-| filter-even | Use ``filter`` to keep even numbers and discard |-| | odd numbers in the stream. |-+------------------------+----------------------------------------------------+-| scan | scans the stream using ``+`` operation |-+------------------------+----------------------------------------------------+-| mapM | transform the stream using a monadic action |-+------------------------+----------------------------------------------------+-| zip | combines corresponding elements of the two streams |-| | together |-+------------------------+----------------------------------------------------+--Append Operation-~~~~~~~~~~~~~~~~--A million streams of single elements are created and appended together to-create a stream of million elements. The total time taken in this operation is-measured. *Note that vector, streaming and pipes show a quadratic-complexity (O(n^2)) on this benchmark and do not finish in a reasonable time*.-The time shown in the graph for these libraries is just-indicative, the actual time taken is much higher.--.. |append| image:: charts-0/AppendOperation-time.svg- :width: 60 %- :target: charts-0/AppendOperation-time.svg- :alt: Cost of appending a million streams of single elements--|append|--toList Operation-~~~~~~~~~~~~~~~~--A stream of a million elements is generated using ``unfoldrM`` and then-converted to a list.--.. |toList| image:: charts-0/toListOperation-time.svg- :width: 60 %- :target: charts-0/toListOperation-time.svg- :alt: Cost of converting a stream of million elements to a list--|toList|--Composing Multiple Operations-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--A stream operation or a combination of stream operations are performed four-times in a row to measure how the composition scales for each library. A-million elements are passed through this composition.--*Note: the time for streamly and vector is very low (600-700 microseconds) and-therefore can barely be seen in this graph.*--.. |composed| image:: charts-0/ComposedOperations%3A4times-time.svg- :width: 60 %- :target: charts-0/ComposedOperations%3A4times-time.svg- :alt: Cost when operations are composed--|composed|--+------------------------+----------------------------------------------------+-| Benchmark | Description |-+========================+====================================================+-| mapM | ``mapM`` four times in a row |-+------------------------+----------------------------------------------------+-| all-in-filters | four filters in a row, |-| | each allowing all elements in |-+------------------------+----------------------------------------------------+-| map-with-all-in-filter | ``map`` followed by ``filter`` composed four times |-| | serially |-+------------------------+----------------------------------------------------+--How to Run-------------To quickly compare packages:--::-- # Chart all the default packages- ./run.sh --quick-- # Compare a given list of packages- # Available package names are: streamly, vector, streaming, pipes,- # conduit, machines, drinkery, list, pure-vector- ./run.sh --quick --select "streamly,vector"-- # Show full results for the first packages and delta from that for- # the rest of the packages.- ./run.sh --quick --select "streamly,vector" --delta--After running you can find the charts generated in the ``charts`` directory.-If you have the patience to wait longer for the results remove the ``--quick``-option, the results are likely to be a tiny bit more accurate.--The ``list`` package above is the standard haskell lists in the base package,-and ``pure-vector`` is the vector package using pure API instead of the monadic-API.--Pedantic Mode-~~~~~~~~~~~~~--Note that if different optimization flags are used on different packages,-performance can sometimes badly suffer because of GHC inlining and-specialization not working optimally. If you want to be absolutely sure that-all packages and dependencies are compiled with the same optimization flags-(``-O2``) use ``run.sh --pedantic``, it will install the stack snapshot in a-private directory under the current directory and build them fresh with the ghc-flags specified in ``stack-pedantic.yaml``. Be aware that this will require 1-2-GB extra disk space.--Adding New Libraries-~~~~~~~~~~~~~~~~~~~~--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, I will be happy-to help, `just join the gitter chat-<https://github.com/composewell/streaming-benchmarks/blob/master/Benchmarks/Streamly.hs>`_-and ask!--Benchmarking Notes---------------------Benchmarking is a tricky business. Though the benchmarks have been carefully-designed there may still be issues with the way benchmarking is being done or-the way they have been coded. If you find that something is being measured-unfairly or incorrectly please bring it to our notice by raising an issue or-sending an email or via gitter chat.--Measurement-~~~~~~~~~~~--``Benchmarking Tool:`` We use the `gauge-<https://github.com/vincenthz/hs-gauge>`_ package for measurements instead of-criterion. There were several issues with criterion that we fixed in gauge to-get correct results. Each benchmark is run in a separate process to avoid any-interaction between benchmarks.--Benchmarking Code-~~~~~~~~~~~~~~~~~--* ``IO Monad:`` We run the benchmarks in the IO monad so that they are close to- real life usage. Note that most existing streaming benchmarks use pure code- or Identity monad which may produce entirely different results.--* ``unfoldrM`` is used to generate the stream for two reasons, (1) it is- monadic, (2) it reduces the generation overhead so that the actual streaming- operation cost is amplified. If we use generation from a list there is a- significant overhead in the generation itself because of the intermediate- list structure.--* Unless we perform some real IO operation, the operation being benchmarked can- get completely optimized out in some cases. We use a random number generation- in the IO monad and feed it to the operation being benchmarked to avoid that- issue.--GHC Inlining---------------* ``Inlining:`` GHC simplifier is very fragile and inlining may affect the- results in unpredictable ways unless you have spent enough time scrutinizing- and optimizing everything carefully. Inlining is the biggest source of- fragility in performance benchmarking. It can easily result in an order of- magnitude drop in performance just because some operation is not correctly- inlined. Note that this applies very well to the benchmarking code as well.--* ``GHC Optimization Flags:`` To make sure we are comparing fairly we make sure- that we compile the benchmarking code, the library code as well as all- dependencies using exactly the same GHC flags. GHC inlining and- specialization optimizations can make the code unpredictable if mixed flags- are used. See the ``--pedantic`` option of the ``run.sh`` script.--* ``Single file vs multiple files`` The best way to avoid issues is to have all- the benchmarking code in a single file. However, in real life that is not the- case and we also needed some modularity to scale the benchmarks to arbitrary- number of libraries so we split it into per package file. As soon as the code- was split into multiple files, performance of some libraries dropped, in some- cases by 3-4x. Careful sprinkling of INLINE pragmas was required to bring it- back to original. Even functions that seemed just 2 lines of code were not- automatically inlined.--* When all the code was in a single file, not a single INLINE pragma was- needed. But when split in multiple files even functions that were not- exported from that file needed an INLINE pragma for equivalent performance.- This is something that GHC may have to look at.--* The effect of inlining varied depending on the library. To make sure that we- are using the fully optimized combination of inline or non-inline for each- library we carefully studied the impact of inlining individual operations for- each package. The current code is the best we could get for each package.--* There is something magical about streamly, not sure what it is. Even though- all other libraries were impacted significantly for many ops, streamly seemed- almost unaffected by splitting the benchmarking ops into a separate file! If- we can find out why is it so, we could perhaps understand and use GHC- inlining in a more predictable manner. Edit - CPS seems to be more immune to- inlining, as soon as streamly started using direct style, it too became- sensitive to inlining.--* This kind of unpredictable non-uniform impact of moving functions in- different files shows that we are at the mercy of the GHC simplifier and- always need to tune performance carefully after refactoring, to be sure that- everything is fine. In other words, benchmarking and optimizing is crucial- not just for the libraries `but for the users of the libraries as well`.--Streaming Libraries----------------------There are two dual paradigms for stream processing in Haskell. In the first-paradigm we represent a stream as a data type and use functions to work on it.-In the second paradigm we represent *stream processors* as data types and-provide them individual data elements to process, there is no explicit-representation of the stream as a data type. In the first paradigm we work with-data representation and in the second paradigm we work with function-representations. Both of these paradigms have equal expressive power. The-latter uses the monadic composition for data flow whereas the former does not-need monadic composition for straight line stream processing and therefore can-use it for higher level composition e.g. to compose streams in a product-style.--To see an example of the first paradigm, let us use the ``vector`` package to-represent a monadic stream of integers as ``Stream IO Int``. This data-representation of stream is passed explicitly to the stream processing-functions like ``filter`` and ``drop`` to manipulate it::-- import qualified Data.Vector.Fusion.Stream.Monadic as S-- stream :: S.Stream IO Int- stream = S.fromList [1..100]-- main = do- let str = (S.filter even . S.drop 10) stream- toList str >>= putStrLn . show--Pure lists and vectors are the most basic examples of streams in this paradigm.-The streaming IO libraries just extend the same paradigm to monadic streaming.-The API of these libraries is very much similar to lists with a monad parameter-added.--The second paradigm is direct opposite of the first one, there is no stream-representation in this paradigm, instead we represent *stream processors* as-data types. A stream processor represents a particular process rather than-data, and we compose them together to create composite processors. We can call-them stream transducers or simply pipes. Using the ``machines`` package::-- import qualified Data.Machine as S-- producer :: S.SourceT IO Int- producer = S.enumerateFromTo 1 100-- main = do- let processor = producer S.~> S.dropping 10 S.~> S.filtered even- S.runT processor >>= putStrLn . show--Both of these paradigms look almost the same, right? To see the difference-let's take a look at some types. In the first paradigm we have an explicit-stream type and the processing functions take the stream as input and produce-the transformed stream::-- stream :: S.Stream IO Int- filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a--In the second paradigm, there is no stream data type, there are stream-processors, let's call them boxes that represent a process. We have a-*SourceT* box that represents a singled ended producer and a *Process* box or a-pipe that has two ends, an input end and an output end, a ``MachineT``-represents any kind of box. We put these boxes together using the ``~>``-operator and then run the resulting machine using ``runT``::-- producer :: S.SourceT IO Int- filtered :: (a -> Bool) -> Process a a- dropping :: Int -> Process a a- (~>) :: Monad m => MachineT m k b -> ProcessT m b c -> MachineT m k c--Custom pipes can be created using a Monadic composition and primitives to-receive and send data usually called ``await`` and ``yield``.--.. |str| replace:: `streamly <https://github.com/composewell/streamly>`__--+-----------------------------------------------------------------------------+-| Streaming libraries using the direct paradigm. |-+------------------------+----------------------------------------------------+-| Library | Remarks |-+========================+====================================================+-| vector | The simplest in this category, provides |-| | transformation and combining of monadic |-| | streams but no monadic composition of streams. |-| | Provides a very simple list like API. |-+------------------------+----------------------------------------------------+-| streaming | * Encodes a return value to be supplied when the |-| | stream ends. The monad instance passes on the |-| | streams and combines the return values. |-| | * Functor general |-| | * The API is more complicated than vector because |-| | of the return value and the functor layer. |-+------------------------+----------------------------------------------------+-| list-t | Provides straight line composition of streams |-| | as well as a list like monadic composition. |-| | The API is simple, just like ``vector``. |-+------------------------+----------------------------------------------------+-| | Like list-t, in addition to straight line |-| | composition it provides a list like monadic |-| | composition of streams, supports combining streams |-| | concurrently supports concurrent applicative and |-| | monadic composition. |-| |str| | The basic API is very much like lists and |-| | almost identical to ``vector`` streams. |-+------------------------+----------------------------------------------------+--+-----------------------------------------------------------------------------+-| Streaming libraries using the pipes paradigm. |-+------------------------+----------------------------------------------------+-| Library | Remarks |-+========================+====================================================+-| conduit | ``await`` and ``yield`` data to upstream or |-| | downstream pipes; supports pushing leftovers back. |-+------------------------+----------------------------------------------------+-| pipes | ``await`` and ``yield`` data to upstream or |-| | downstream pipes |-+------------------------+----------------------------------------------------+-| machines | Can await from two sources, left and right. |-+------------------------+----------------------------------------------------+-
+ bench-report.nix view
@@ -0,0 +1,50 @@+{+ 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.sh view
@@ -0,0 +1,325 @@+#!/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
+ docs/benchmarking-notes.md view
@@ -0,0 +1,68 @@+# Benchmarking Correctly++## Reduce noise overhead++A common mistake in writing benchmarks is to mask signal with noise.+For example, if we write the benchmarks such as to convert the stream+to a list then the time consumed by list creation itself will mask the+stream processing time. The total time would be:++```+ total = n * list cons overhead + n * stream processing overhead+```++If the list cons overhead is too high it will just mask the stream+processing time which is what we are really interested in. We need to+ensure that any such noise factor is either small enough to neglect or+we measure and deduct it from the results.++## Describe signal and noise++Ideally in case of micro benchmarks, with each benchmark we need to+explain what exactly is being measured or what is the benchmarking code+doing. For example, in the previous example we can mention that the+benchmark measures the list creation time plus the stream operation time;+the list creation time dominates.++Each benchmark should have a description of what it is measuring.++## Caveats for fair comparison++To avoid the domination of list creation time we should choose a+stream exit operation that takes the minimum amount of time. For+example, we could use a sum fold on the output of the stream instead of+converting it into a list. We assume that the fold time would be much+lower. However, this means that we are measuring the fold time + the+stream operation time. If the fold time for a particular library is+high then we are really measuring the fold performance for that rather+than measuring the performance of that particular operation.++The ideal would be to break down the components involved in a+benchmark and show each component separately. However, in the+real world it is a combination of operations that we are going+to use. That's why micro benchmarks are only useful to optimize+individual operations the overall performance may be dominated by the+most frequent operations and the weakest link in the whole chain.++## Measuring maxrss++Memory once requested from the OS is never released back to the OS by+`GHC` (this has changed since GHC 9.2). This may lead to false `maxrss`+reporting when there are multiple benchmarks in the same benchmark+recipe file. We run each benchmark in an isolated process to avoid+that. The `bench.sh` script takes care of this, running the benchmark+executable directly may not give correct results if all benchmarks are+run together.++## Avoiding interference across benchmarks++Running benchmarks in isolation also ensures avoiding any other kind of+interference (e.g. unwanted sharing) among benchmarks. Though this may+not be able to avoid any compile time interference, e.g. sharing of data+across benchmarks may lead GHC to generate suboptimal code.++## Fragile inlining++We have tried to optimize (`INLINE` etc.) each library's code as much as we+could, library authors are encouraged to take a look at if their library is+being used in a fully optimized manner and report if there are any issues.
− licenses/LICENSE.machines
@@ -1,30 +0,0 @@-Copyright 2012-2015 Edward Kmett, Runar Bjarnason, Paul Chiusano--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:--1. Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.--2. Redistributions in binary form must reproduce the above copyright- notice, this list of conditions and the following disclaimer in the- documentation and/or other materials provided with the distribution.--3. Neither the name of the author nor the names of his contributors- may be used to endorse or promote products derived from this software- without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,-STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN-ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE-POSSIBILITY OF SUCH DAMAGE.
− licenses/Readme.txt
@@ -1,3 +0,0 @@-The benchmarking code in this package was originally adapted from the-benchmarks in the machines package. The original license for that code is-included in this directory as LICENSE.machines.
− run.sh
@@ -1,136 +0,0 @@-#!/bin/bash--print_help () {- echo "Usage: $0 [--quick] [--select] [--delta] [--append] [--pedantic] [--no-graphs] [--no-measure] -- <gauge options>"- echo- echo "--select "streamly,vector" - would generate results only for those two libraries."- echo "--delta - chart diff of subsequent packages from the first package"- echo "Any arguments after a '--' are passed directly to guage"- echo "You can omit '--' if the gauge args used do not start with a '-'."- exit-}--# $1: message-die () {- >&2 echo -e "Error: $1"- exit 1-}--DELTA=False--while test -n "$1"-do- case $1 in- -h|--help|help) print_help ;;- --quick) QUICK=1; shift ;;- --select) shift; SELECTED=$1; shift ;;- --delta) DELTA=True; shift ;;- --append) APPEND=1; shift ;;- --pedantic) PEDANTIC=1; shift ;;- --no-graphs) GRAPH=0; shift ;;- --no-measure) MEASURE=0; shift ;;- --) shift; break ;;- -*|--*) print_help ;;- *) break ;;- esac-done--DEFAULT_PACKAGES="streamly,vector,streaming,conduit,pipes,machines,drinkery"--if test -z "$SELECTED"-then- SELECTED=$DEFAULT_PACKAGES-fi--STACK=stack-if test "$PEDANTIC" = "1"-then- GHC_PATH=`$STACK path --compiler-bin`- export PATH=$GHC_PATH:$PATH- mkdir -p .stack-root- export STACK_ROOT=`pwd`/.stack-root- STACK="$STACK --system-ghc --stack-yaml stack-pedantic.yaml"-fi--echo "Using stack command [$STACK]"-$STACK build --bench --no-run-benchmarks || die "build failed"--# 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"--enable_isolated () {- local PROG=`$STACK path --dist-dir`/build/benchmarks/benchmarks- if test -x "$PROG"- then- BENCH_PROG="--measure-with $PROG"- else- echo- echo "WARNING! benchmark binary [$PROG] not found or not executable"- echo "WARNING! not using isolated measurement."- echo- fi-}--enable_isolated--# --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.--if test "$QUICK" = "1"-then- ENABLE_QUICK="--quick"-fi--if test "$MEASURE" != "0"- then- if test -e results.csv -a "$APPEND" != 1- then- mv -f -v results.csv results.csv.prev- fi-- MATCH_ARGS=""- for i in $(echo $SELECTED | tr "," "\n")- do- MATCH_ARGS="$MATCH_ARGS -m pattern /$i"- done-- # We set min-samples to 3 if we use less than three samples, statistical- # analysis crashes. Note that the benchmark runs for a minimum of 5 seconds.- # We use min-duration=0 to run just one iteration for each sample, we anyway- # run a million ops in each iteration so we do not need more iterations.- # However with fusion, million ops finish in microseconds. The- # default is to run iterations worth minimum 30 ms and most of our benchmarks- # are close to that or more.- # --min-duration 0 \- $STACK bench --benchmark-arguments "$ENABLE_QUICK \- --include-first-iter \- --min-samples 3 \- --match exact \- --csvraw=results.csv \- -v 2 \- $MATCH_ARGS \- $BENCH_PROG $*" || die "Benchmarking failed"-fi--if test "$GRAPH" != "0"-then- echo- echo "Generating charts from results.csv..."- $STACK exec makecharts results.csv $SELECTED $DELTA-fi
− stack-8.2.yaml
@@ -1,21 +0,0 @@-resolver: lts-11.0-packages:-- '.'-extra-deps:- - gauge-0.2.3- - streamly-0.4.1- - bench-graph-0.1.3-- # for lts-11.0- - Chart-diagrams-1.8.3- - SVGFonts-1.6.0.3- - diagrams-core-1.4.0.1- - diagrams-lib-1.4.2- - diagrams-postscript-1.4- - diagrams-svg-1.4.1.1- - diagrams-solve-0.1.1- - dual-tree-0.2.1- - lens-4.15.4- - free-4.12.4- - drinkery-0.3-rebuild-ghc-options: true
− stack-pedantic.yaml
@@ -1,16 +0,0 @@-resolver: lts-12.0-packages:-- '.'-extra-deps:- - streamly-0.4.1- - drinkery-0.3-- # for lts-12.0- - bench-graph-0.1.3- - Chart-1.9- - Chart-diagrams-1.9- - SVGFonts-1.6.0.3--rebuild-ghc-options: true-ghc-options:- "$everything": -O2
− stack.yaml
@@ -1,14 +0,0 @@-resolver: lts-12.0-packages:-- '.'-extra-deps:- - streamly-0.4.1- - drinkery-0.3-- # for lts-12.0- - bench-graph-0.1.3- - Chart-1.9- - Chart-diagrams-1.9- - SVGFonts-1.6.0.3--rebuild-ghc-options: true
streaming-benchmarks.cabal view
@@ -1,85 +1,101 @@+cabal-version: 2.2 name: streaming-benchmarks-category: Benchmark-version: 0.2.0+version: 0.3.0 license: MIT license-file: LICENSE-author: Harendra Kumar-maintainer: Harendra Kumar+author: Composewell Technologies+maintainer: streamly@composewell.com stability: provisional-homepage: http://github.com/composewell/streaming-benchmarks+homepage: https://streamly.composewell.com bug-reports: http://github.com/composewell/streaming-benchmarks/issues copyright: Copyright (c) 2017 Harendra Kumar-synopsis: Benchmarks to compare streaming packages+category: Streamly, Streaming, Benchmark+synopsis: Measures and compares the performance of streaming libraries description:- Benchmarks along with with pretty comparative graph generation for streaming- operations and their comparisons across notable Haskell streaming libraries- including `streamly`, `vector`, `streaming`, `machines`, `pipes`, and- `conduit`.- <http://hackage.haskell.org/package/streamly streamly> is a streaming library- with native - high level, declarative and composable concurrency, it- is the primary motivation for these benchmarks.- .- If you are using @stack@ then you can just use @./run.sh@ to run the- benchmarks; use @--quick@ option to get the result quickly; charts will be- generated in the `charts` directory. Use @./run.sh --help@ for all script- options.+ This package provides micro-benchmarks to measure and compare the+ performance of various streaming implementations in Haskell. .- With any build tool, run the benchmarks with @--csv=results.csv@ as arguments- (you can pass any @gauge@ arguments including @--quick@) and then use- @makecharts results.csv "streamly,vector,..." False@ to create the charts.- The second argument to @makecharts@ is the list of package names, the third- argument is whether to plot full or diff from the first package.+ The following packages are supported: .- See the README file shipped with the package or- <https://github.com/composewell/streaming-benchmarks in the github repo>- for more details. The github repo also shows the latest comparative graphs.+ * base (Haskell lists)+ * streamly+ * streaming+ * pipes+ * machines+ * conduit+ * drinkery -cabal-version: >= 1.10-tested-with: GHC==8.2.2, GHC==8.4.3-build-type: Simple+tested-with: GHC==8.8.4, GHC==8.10.4+build-type: Simple extra-source-files: Changelog.md- run.sh- README.rst- licenses/Readme.txt- licenses/LICENSE.machines- stack-8.2.yaml- stack.yaml- stack-pedantic.yaml+ README.md+ bench.sh+ bench-report.nix +extra-doc-files:+ docs/benchmarking-notes.md+ source-repository head type: git location: git://github.com/composewell/streaming-benchmarks.git -benchmark benchmarks+flag dev+ description: Development build+ manual: True+ default: False++flag fusion-plugin+ description: Use fusion plugin for benchmarks+ 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- , Benchmarks.Streamly++ -- Pure streams+ , Benchmarks.List+ , Benchmarks.DList+ , Benchmarks.Sequence , Benchmarks.Vector+ , Benchmarks.StreamlyPure+ , Benchmarks.StreamlyArray+ , Benchmarks.ByteString+ , Benchmarks.ByteStringLazy+ , Benchmarks.Text++ -- Monadic streams+ , Benchmarks.Streamly+ , Benchmarks.VectorStreams , Benchmarks.Streaming- -- , Benchmarks.LogicT- -- , Benchmarks.ListT- -- , Benchmarks.ListTransformer , Benchmarks.Conduit , Benchmarks.Pipes , Benchmarks.Machines , Benchmarks.Drinkery- , Benchmarks.List- , Benchmarks.VectorPure++ -- List transformers+ -- , Benchmarks.LogicT+ -- , Benchmarks.ListT+ -- , Benchmarks.ListTransformer+ ghc-options: -O2 -Wall -with-rtsopts "-T"- if impl(ghc >= 8.0)- ghc-options: -Wcompat- -Wunrecognised-warning-flags- -Widentities- -Wincomplete-record-updates- -Wincomplete-uni-patterns- -Wredundant-constraints- -Wnoncanonical-monad-instances- -Wnoncanonical-monadfail-instances+ -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 build-depends: base == 4.*,@@ -88,38 +104,48 @@ mtl >= 2 && < 2.3, random >= 1.0 && < 2.0, transformers >= 0.4 && < 0.6,- template-haskell >= 2.10 && < 2.14,+ template-haskell >= 2.10 && < 2.18, + bytestring >= 0.9 && < 0.12,+ text >= 1.0 && < 1.3, vector >= 0.12 && < 0.13,- streamly >= 0.2.1 && < 0.5,+ streamly >= 0.8.0 && < 0.9, streaming >= 0.1.4 && < 0.3,- machines >= 0.6.0 && < 0.7,+ machines >= 0.6.0 && < 0.8, pipes >= 4 && < 4.4, conduit >= 1.3 && < 1.4,- drinkery >= 0.3 && < 0.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 -executable makecharts+executable bench-report default-language: Haskell2010 default-extensions: OverloadedStrings hs-source-dirs: . main-is: Charts.hs ghc-options: -Wall-- build-depends:- base == 4.*- , bench-graph >= 0.1 && < 0.2- , bytestring >= 0.9 && < 0.11- , 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+ 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+ else+ buildable: False