diff --git a/Benchmarks.hs b/Benchmarks.hs --- a/Benchmarks.hs +++ b/Benchmarks.hs @@ -1,449 +1,93 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Main (main) where - -import Control.DeepSeq (NFData) -import Control.Monad.IO.Class (MonadIO(liftIO)) -import Control.Monad.Trans.Class (lift) -import Gauge -import Data.Foldable (msum) -import Data.Function ((&)) ---import System.Random (randomIO) -import System.Random (randomRIO) - -import qualified Streamly as A -import qualified Streamly.Prelude as A -import qualified Data.Conduit as C -import qualified Data.Conduit.Combinators as CC -import qualified Data.Conduit.List as C -import qualified List.Transformer as L -import qualified ListT as LT -import qualified Control.Monad.Logic as LG -import qualified Data.Machine as M -import qualified Pipes as P -import qualified Pipes.Prelude as P -import qualified Streaming.Prelude as S -import qualified Data.Vector.Fusion.Stream.Monadic as V --- import qualified Conduit.Simple as SC +-- | +-- Module : Main +-- Copyright : (c) 2018 Harendra Kumar -- - --- Orphan instance to use nfIO on streaming -instance (NFData a, NFData b) => NFData (S.Of a b) - -getRandom :: MonadIO m => m Int -getRandom = liftIO $ randomRIO (1,1000) - -value, maxValue :: Int -value = 1000000 -maxValue = value + 1000 - -------------------------------------------------------------------------------- --- Streamly -------------------------------------------------------------------------------- - -sourceA :: MonadIO m => A.StreamT m Int -sourceA = getRandom >>= \v -> A.each [v..v+value] - --- Note, streamly provides two different ways to compose, i.e. category style --- composition and monadic compostion. - --- Category composition -runIOA :: A.StreamT IO Int -> (A.StreamT IO Int -> A.StreamT IO Int) -> IO () -runIOA s t = A.runStreamT $ s & t - -{- --- Monadic composition -runIOA_M :: A.StreamT IO Int -> (Int -> A.StreamT IO Int) -> IO () -runIOA_M s t = A.runStreamT $ s >>= t --} - -------------------------------------------------------------------------------- --- streaming -------------------------------------------------------------------------------- - -sourceS :: MonadIO m => S.Stream (S.Of Int) m () -sourceS = getRandom >>= \v -> S.each [v..v+value] - -runIOS :: S.Stream (S.Of Int) IO () - -> (S.Stream (S.Of Int) IO () -> S.Stream (S.Of Int) IO ()) -> IO () -runIOS s t = s & t & S.mapM_ (\_ -> return ()) - -------------------------------------------------------------------------------- --- simple-conduit -------------------------------------------------------------------------------- - -{- -sourceSC :: MonadIO m => SC.Source m Int -sourceSC = getRandom >>= \v -> SC.enumFromToC v (v + value) - -runIOSC :: SC.Source IO Int -> SC.Conduit Int IO a -> IO () -runIOSC s t = s SC.$= t SC.$$ SC.mapM_C (\_ -> return ()) --} - -------------------------------------------------------------------------------- --- conduit -------------------------------------------------------------------------------- - -sourceC :: MonadIO m => C.ConduitT () Int m () -sourceC = getRandom >>= \v -> C.enumFromTo v (v + value) - -runIOC :: C.ConduitT () Int IO () -> C.ConduitT Int a IO () -> IO () -runIOC s t = C.runConduit $ s C..| t C..| C.mapM_ (\_ -> return ()) - -------------------------------------------------------------------------------- --- pipes -------------------------------------------------------------------------------- - -sourceP :: MonadIO m => P.Producer' Int m () -sourceP = getRandom >>= \v -> P.each [v..v+value] - -runIOP :: P.Producer' Int IO () -> P.Proxy () Int () a IO () -> IO () -runIOP s t = P.runEffect $ s P.>-> t P.>-> P.mapM_ (\_ -> return ()) - -------------------------------------------------------------------------------- --- machines -------------------------------------------------------------------------------- - -sourceM :: Monad m => Int -> M.SourceT m Int -sourceM v = M.enumerateFromTo v (v + value) - -runIOM :: M.SourceT IO Int -> M.ProcessT IO Int o -> IO () -runIOM s t = M.runT_ (s M.~> t) - -------------------------------------------------------------------------------- --- list-transformer -------------------------------------------------------------------------------- - -sourceL :: MonadIO m => L.ListT m Int -sourceL = getRandom >>= \v -> L.select [v..v+value] - -runIOL :: L.ListT IO Int -> (Int -> L.ListT IO Int) -> IO () -runIOL s t = L.runListT (s >>= t) - -------------------------------------------------------------------------------- --- list-t -------------------------------------------------------------------------------- - -sourceLT :: MonadIO m => LT.ListT m Int -sourceLT = getRandom >>= \v -> LT.fromFoldable [v..v+value] - -runIOLT :: LT.ListT IO Int -> (Int -> LT.ListT IO Int) -> IO () -runIOLT s t = LT.traverse_ (\_ -> return ()) (s >>= t) - -------------------------------------------------------------------------------- --- logict -------------------------------------------------------------------------------- - -sourceLG :: Int -> LG.LogicT m Int -sourceLG v = msum $ map return [v..v+value] +-- License : MIT +-- Maintainer : harendra.kumar@gmail.com -runIOLG :: LG.LogicT IO Int -> (Int -> LG.LogicT IO Int) -> IO () -runIOLG s t = LG.observeAllT (s >>= t) >> return () +{-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- --- vector -------------------------------------------------------------------------------- +module Main (main) where -sourceV :: Monad m => Int -> V.Stream m Int -sourceV v = V.fromList [v..v+value] +import Benchmarks.BenchmarkTH (createBgroup) +import Benchmarks.Common (benchIO) +--import Benchmarks.BenchmarkTH (createScaling) -runIOV :: V.Stream IO Int -> (V.Stream IO Int -> V.Stream IO Int) -> IO () -runIOV s t = s & t & V.mapM_ (\_ -> return ()) +import qualified Benchmarks.Vector as Vector +import qualified Benchmarks.Streamly as Streamly +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.LogicT as LogicT +-- import qualified Benchmarks.ListT as ListT +-- import qualified Benchmarks.ListTransformer as ListTransformer -------------------------------------------------------------------------------- --- Benchmarks -------------------------------------------------------------------------------- +import Gauge main :: IO () -main = +main = do defaultMain - [ bgroup "elimination" - [ - bgroup "toNull" - [ - bench "conduit" $ nfIO $ C.runConduit $ sourceC C..| C.mapM_ (\_ -> return ()) - , bench "pipes" $ nfIO $ P.runEffect $ sourceP P.>-> P.mapM_ (\_ -> return ()) - , bench "machines" $ nfIO $ getRandom >>= \v -> M.runT_ (sourceM v) - , bench "streaming" $ nfIO $ runIOS sourceS id - , bench "streamly" $ nfIO $ runIOA sourceA id - -- , bench "simple-conduit" $ nfIO $ sourceSC SC.$$ SC.mapM_C (\_ -> return ()) - , bench "logict" $ nfIO $ getRandom >>= \v -> LG.observeAllT (sourceLG v) >> return () - , bench "list-t" $ nfIO $ LT.traverse_ (\_ -> return ()) sourceLT - , bench "list-transformer" $ nfIO $ L.runListT sourceL - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) id - ] - , bgroup "toList" - [ - bench "conduit" $ nfIO $ C.runConduit $ sourceC C..| CC.sinkList - , bench "pipes" $ nfIO $ P.toListM sourceP - , bench "machines" $ nfIO $ getRandom >>= \v -> M.runT (sourceM v) - , bench "streaming" $ nfIO $ S.toList sourceS - , bench "streamly" $ nfIO $ A.toList sourceA - -- , bench "simple-conduit" $ nfIO $ sourceSC SC.$$ SC.sinkList - , bench "logict" $ nfIO $ getRandom >>= \v -> LG.observeAllT (sourceLG v) >> return () - , bench "list-t" $ nfIO $ LT.toList sourceLT - -- , bench "list-transformer" $ nfIO $ toList sourceL - , bench "vector" $ nfIO $ getRandom >>= \v -> V.toList (sourceV v) - ] - , bgroup "fold" - [ bench "streamly" $ nfIO $ A.foldl (+) 0 id sourceA - , bench "streaming" $ nfIO $ S.fold (+) 0 id sourceS - , bench "conduit" $ nfIO $ C.runConduit $ sourceC C..| (C.fold (+) 0) - , bench "pipes" $ nfIO $ P.fold (+) 0 id sourceP - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.fold (+) 0) - , bench "list-transformer" $ nfIO $ L.fold (+) 0 id sourceL - , bench "vector" $ nfIO $ getRandom >>= \v -> V.foldl' (+) 0 (sourceV v) - ] - , bgroup "scan" - [ bench "conduit" $ nfIO $ runIOC sourceC (CC.scanl (+) 0) - , bench "pipes" $ nfIO $ runIOP sourceP (P.scan (+) 0 id) - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.scan (+) 0) - , bench "streaming" $ nfIO $ runIOS sourceS (S.scan (+) 0 id) - , bench "streamly" $ nfIO $ runIOA sourceA (A.scan (+) 0 id) - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) (V.prescanl' (+) 0) - ] - , bgroup "last" - [ bench "pipes" $ nfIO $ P.last sourceP - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.final) - , bench "streaming" $ nfIO $ S.last sourceS - , bench "streamly" $ nfIO $ A.last sourceA - , bench "conduit" $ nfIO $ C.runConduit $ sourceC C..| CC.last - , bench "vector" $ nfIO $ getRandom >>= \v -> V.last (sourceV v) - ] - , bgroup "concat" - [ bench "conduit" $ nfIO $ runIOC sourceC (C.map (replicate 3) C..| C.concat) - , bench "pipes" $ nfIO $ runIOP sourceP (P.map (replicate 3) P.>-> P.concat) - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.mapping (replicate 3) M.~> M.asParts) - -- XXX This hangs indefinitely - -- , bench "streaming" $ nfIO $ runIOS sourceS (S.concat . S.map (replicate 3)) - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) (V.concatMap (V.fromList . replicate 3)) - ] - ] + [ bgroup "elimination" + [ $(createBgroup "drain" "toNull") + , $(createBgroup "toList" "toList") + , $(createBgroup "fold" "foldl") + , $(createBgroup "last" "last") + ] , bgroup "transformation" - [ bgroup "map" - [ bench "conduit" $ nfIO $ runIOC sourceC (C.map (+1)) - , bench "pipes" $ nfIO $ runIOP sourceP (P.map (+1)) - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.mapping (+1)) - , bench "streaming" $ nfIO $ runIOS sourceS (S.map (+1)) - , bench "streamly" $ nfIO $ runIOA sourceA (fmap (+1)) - -- , bench "simple-conduit" $ nfIO $ runIOSC sourceSC (SC.mapC (+1)) - , bench "list-transformer" $ nfIO $ runIOL sourceL (lift . return . (+1)) - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) (V.map (+1)) - ] - , bgroup "mapM" - [ bench "conduit" $ nfIO $ runIOC sourceC (C.mapM return) - , bench "pipes" $ nfIO $ runIOP sourceP (P.mapM return) - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.autoM return) - , bench "streaming" $ nfIO $ runIOS sourceS (S.mapM return) - , bench "streamly" $ nfIO $ runIOA sourceA (A.mapM return) - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) (V.mapM return) - ] - ] + [ $(createBgroup "scan" "scan") + , $(createBgroup "map" "map") + , $(createBgroup "mapM" "mapM") + , $(createBgroup "concat" "concat") + ] , bgroup "filtering" - [ bgroup "filter-even" - [ bench "conduit" $ nfIO $ runIOC sourceC (C.filter even) - , bench "pipes" $ nfIO $ runIOP sourceP (P.filter even) - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.filtered even) - , bench "streaming" $ nfIO $ runIOS sourceS (S.filter even) - , bench "streamly" $ nfIO $ runIOA sourceA (A.filter even) - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) (V.filter even) - ] - , bgroup "filter-all-out" - [ bench "conduit" $ nfIO $ runIOC sourceC (C.filter (> maxValue)) - , bench "pipes" $ nfIO $ runIOP sourceP (P.filter (> maxValue)) - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.filtered (> maxValue)) - , bench "streaming" $ nfIO $ runIOS sourceS (S.filter (> maxValue)) - , bench "streamly" $ nfIO $ runIOA sourceA (A.filter (> maxValue)) - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) (V.filter (> maxValue)) - ] - , bgroup "filter-all-in" - [ bench "conduit" $ nfIO $ runIOC sourceC (C.filter (<= maxValue)) - , bench "pipes" $ nfIO $ runIOP sourceP (P.filter (<= maxValue)) - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.filtered (<= maxValue)) - , bench "streaming" $ nfIO $ runIOS sourceS (S.filter (<= maxValue)) - , bench "streamly" $ nfIO $ runIOA sourceA (A.filter (<= maxValue)) - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) (V.filter (<= maxValue)) - ] - , bgroup "take-one" - [ bench "conduit" $ nfIO $ runIOC sourceC (C.isolate 1) - , bench "pipes" $ nfIO $ runIOP sourceP (P.take 1) - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.taking 1) - , bench "streaming" $ nfIO $ runIOS sourceS (S.take 1) - , bench "streamly" $ nfIO $ runIOA sourceA (A.take 1) - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) (V.take 1) - ] - -- XXX variance need to be fixed, value used is not correct - , bgroup "take-all" - [ bench "conduit" $ nfIO $ runIOC sourceC (C.isolate maxValue) - , bench "pipes" $ nfIO $ runIOP sourceP (P.take maxValue) - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.taking maxValue) - , bench "streaming" $ nfIO $ runIOS sourceS (S.take maxValue) - , bench "streamly" $ nfIO $ runIOA sourceA (A.take maxValue) - -- , bench "list-transformer" $ nfIO $ (runIdentity . L.runListT) (L.take value sourceL :: L.ListT Identity Int) - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) (V.take maxValue) - ] - , bgroup "takeWhile-true" - [ bench "conduit" $ nfIO $ runIOC sourceC (CC.takeWhile (<= maxValue)) - , bench "pipes" $ nfIO $ runIOP sourceP (P.takeWhile (<= maxValue)) - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.takingWhile (<= maxValue)) - , bench "streaming" $ nfIO $ runIOS sourceS (S.takeWhile (<= maxValue)) - , bench "streamly" $ nfIO $ runIOA sourceA (A.takeWhile (<= maxValue)) - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) (V.takeWhile (<= maxValue)) - ] - , bgroup "drop-all" - [ bench "conduit" $ nfIO $ runIOC sourceC (C.drop maxValue) - , bench "pipes" $ nfIO $ runIOP sourceP (P.drop maxValue) - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.dropping maxValue) - , bench "streaming" $ nfIO $ runIOS sourceS (S.drop maxValue) - , bench "streamly" $ nfIO $ runIOA sourceA (A.drop maxValue) - -- , bench "simple-conduit" $ whnf drainSC (SC.dropC value) - --, bench "list-transformer" $ whnf (runIdentity . L.runListT) (L.drop value sourceL :: L.ListT Identity Int) - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) (V.drop maxValue) - ] - , bgroup "dropWhile-true" - [ bench "conduit" $ nfIO $ runIOC sourceC (CC.dropWhile (<= maxValue)) - , bench "pipes" $ nfIO $ runIOP sourceP (P.dropWhile (<= maxValue)) - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) (M.droppingWhile (<= maxValue)) - , bench "streaming" $ nfIO $ runIOS sourceS (S.dropWhile (<= maxValue)) - , bench "streamly" $ nfIO $ runIOA sourceA (A.dropWhile (<= maxValue)) - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) (V.dropWhile (<= maxValue)) - ] - ] - , bgroup "zip" - [ bench "conduit" $ nfIO $ C.runConduit $ (C.getZipSource $ (,) <$> C.ZipSource sourceC <*> C.ZipSource sourceC) C..| C.sinkNull - , bench "pipes" $ nfIO $ P.runEffect $ P.for (P.zip sourceP sourceP) P.discard - , bench "machines" $ nfIO $ getRandom >>= \v1 -> getRandom >>= \v2 -> M.runT_ (M.capT (sourceM v1) (sourceM v2) M.zipping) - , bench "streaming" $ nfIO $ S.effects (S.zip sourceS sourceS) - , bench "streamly" $ nfIO $ A.runStreamT $ (A.zipWith (,) sourceA sourceA) - , bench "vector" $ nfIO $ getRandom >>= \v1 -> getRandom >>= \v2 -> V.mapM_ return $ (V.zipWith (,) (sourceV v1) (sourceV v2)) - ] - -- Composing multiple stages of a pipeline + [ $(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") + ] + , $(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) + ] + {- + -- 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 + ] + -} , bgroup "compose" - [ - {- - let f x = - if (x `mod` 4 == 0) - then - randomIO - else return x - -} - let f = return - c = C.mapM f - p = P.mapM f - m = M.autoM f - s = S.mapM f - a = A.mapM f - u = V.mapM f - lb = lift . f - l = lift . f - lg = lift . f - in bgroup "mapM" - [ bench "conduit" $ nfIO $ runIOC sourceC $ c C..| c C..| c C..| c - , bench "pipes" $ nfIO $ runIOP sourceP $ p P.>-> p P.>-> p P.>-> p - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) $ m M.~> m M.~> m M.~> m - , bench "streaming" $ nfIO $ runIOS sourceS $ \x -> s x & s & s & s - , bench "streamly" $ nfIO $ runIOA sourceA $ \x -> a x & a & a & a - , bench "list-t" $ nfIO $ runIOLT sourceLT $ \x -> lb x >>= lb >>= lb >>= lb - , bench "list-transformer" $ nfIO $ runIOL sourceL $ \x -> l x >>= l >>= l >>= l - , bench "logict" $ nfIO $ getRandom >>= \v -> runIOLG (sourceLG v) $ \x -> lg x >>= lg >>= lg >>= lg - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) $ \x -> u x & u & u & u - ] - - -- XXX should we use a monadic mapM instead? - , let m = M.mapping (subtract 1) M.~> M.filtered (<= maxValue) - s = S.filter (<= maxValue) . S.map (subtract 1) - a = A.filter (<= maxValue) . fmap (subtract 1) - p = P.map (subtract 1) P.>-> P.filter (<= maxValue) - c = C.map (subtract 1) C..| C.filter (<= maxValue) - u = V.filter (<= maxValue) . V.map (subtract 1) - in bgroup "map-with-all-in-filter" - [ bench "conduit" $ nfIO $ runIOC sourceC $ c C..| c C..| c C..| c - , bench "pipes" $ nfIO $ runIOP sourceP $ p P.>-> p P.>-> p P.>-> p - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) $ m M.~> m M.~> m M.~> m - , bench "streaming" $ nfIO $ runIOS sourceS $ \x -> s x & s & s & s - , bench "streamly" $ nfIO $ runIOA sourceA $ \x -> a x & a & a & a - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) $ \x -> u x & u & u & u - ] - - -- Compose multiple ops, all stages letting everything through. - -- Note, IO monad makes a big difference especially for machines. - , let m = M.filtered (<= maxValue) - a = A.filter (<= maxValue) - s = S.filter (<= maxValue) - p = P.filter (<= maxValue) - c = C.filter (<= maxValue) - u = V.filter (<= maxValue) - in bgroup "all-in-filters" - [ bench "conduit" $ nfIO $ runIOC sourceC $ c C..| c C..| c C..| c - , bench "pipes" $ nfIO $ runIOP sourceP $ p P.>-> p P.>-> p P.>-> p - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) $ m M.~> m M.~> m M.~> m - , bench "streaming" $ nfIO $ runIOS sourceS $ \x -> s x & s & s & s - , bench "streamly" $ nfIO $ runIOA sourceA $ \x -> a x & a & a & a - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) $ \x -> u x & u & u & u - ] - - -- how filtering affects the subsequent composition - , let m = M.filtered (> maxValue) - a = A.filter (> maxValue) - s = S.filter (> maxValue) - p = P.filter (> maxValue) - c = C.filter (> maxValue) - u = V.filter (> maxValue) - in bgroup "all-out-filters" - [ bench "conduit" $ nfIO $ runIOC sourceC $ c C..| c C..| c C..| c - , bench "pipes" $ nfIO $ runIOP sourceP $ p P.>-> p P.>-> p P.>-> p - , bench "machines" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) $ m M.~> m M.~> m M.~> m - , bench "streaming" $ nfIO $ runIOS sourceS $ \x -> s x & s & s & s - , bench "streamly" $ nfIO $ runIOA sourceA $ \x -> a x & a & a & a - , bench "vector" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) $ \x -> u x & u & u & u - ] - ] + [ $(createBgroup "mapM" "composeMapM") + , $(createBgroup "map-with-all-in-filter" "composeMapAllInFilter") + , $(createBgroup "all-in-filters" "composeAllInFilters") + , $(createBgroup "all-out-filters" "composeAllOutFilters") + ] + -- 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 - let f = M.filtered (<= maxValue) - in bgroup "machines-filters" - [ bench "1" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) f - , bench "2" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) $ f M.~> f - , bench "3" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) $ f M.~> f M.~> f - , bench "4" $ nfIO $ getRandom >>= \v -> runIOM (sourceM v) $ f M.~> f M.~> f M.~> f - ] - , let f = A.filter (<= maxValue) - in bgroup "streamly-filters" - [ bench "1" $ nfIO $ runIOA sourceA (\x -> f x) - , bench "2" $ nfIO $ runIOA sourceA $ \x -> f x & f - , bench "3" $ nfIO $ runIOA sourceA $ \x -> f x & f & f - , bench "4" $ nfIO $ runIOA sourceA $ \x -> f x & f & f & f - ] - , let f = S.filter (<= maxValue) - in bgroup "streaming-filters" - [ bench "1" $ nfIO $ runIOS sourceS (\x -> f x) - , bench "2" $ nfIO $ runIOS sourceS $ \x -> f x & f - , bench "3" $ nfIO $ runIOS sourceS $ \x -> f x & f & f - , bench "4" $ nfIO $ runIOS sourceS $ \x -> f x & f & f & f - ] - , let f = P.filter (<= maxValue) - in bgroup "pipes-filters" - [ bench "1" $ nfIO $ runIOP sourceP f - , bench "2" $ nfIO $ runIOP sourceP $ f P.>-> f - , bench "3" $ nfIO $ runIOP sourceP $ f P.>-> f P.>-> f - , bench "4" $ nfIO $ runIOP sourceP $ f P.>-> f P.>-> f P.>-> f - ] - , let f = C.filter (<= maxValue) - in bgroup "conduit-filters" - [ bench "1" $ nfIO $ runIOC sourceC f - , bench "2" $ nfIO $ runIOC sourceC $ f C..| f - , bench "3" $ nfIO $ runIOC sourceC $ f C..| f C..| f - , bench "4" $ nfIO $ runIOC sourceC $ f C..| f C..| f C..| f - ] - , let f = V.filter (<= maxValue) - in bgroup "vector-filters" - [ bench "1" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) (\x -> f x) - , bench "2" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) $ \x -> f x & f - , bench "3" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) $ \x -> f x & f & f - , bench "4" $ nfIO $ getRandom >>= \v -> runIOV (sourceV v) $ \x -> f x & f & f & f - ] - ] - ] + [ $(createScaling "vector-filters" "Vector") + , $(createScaling "streamly-filters" "Streamly") + , $(createScaling "streaming-filters" "Streaming") + , $(createScaling "machines-filters" "Machines") + , $(createScaling "pipes-filters" "Pipes") + , $(createScaling "conduit-filters" "Conduit") + ] + -} + ] diff --git a/Benchmarks/BenchmarkTH.hs b/Benchmarks/BenchmarkTH.hs new file mode 100644 --- /dev/null +++ b/Benchmarks/BenchmarkTH.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Benchmarks.BenchmarkTH (createBgroup, createScaling) where + +import Benchmarks.Common (benchIO, benchPure) +--import Benchmarks.Common (benchId) +import Language.Haskell.TH.Syntax (Q, Exp, mkName) +import Language.Haskell.TH.Lib (varE) + +createBgroup :: String -> String -> Q Exp +createBgroup 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))) + ] + |] + +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) + ] + |] diff --git a/Benchmarks/Common.hs b/Benchmarks/Common.hs new file mode 100644 --- /dev/null +++ b/Benchmarks/Common.hs @@ -0,0 +1,39 @@ +-- | +-- Module : Benchmarks.Common +-- Copyright : (c) 2018 Harendra Kumar +-- +-- License : MIT +-- Maintainer : harendra.kumar@gmail.com + +module Benchmarks.Common + ( value + , maxValue + , benchIO + , benchId + , benchPure + ) where + +import Control.DeepSeq (NFData) +import Data.Functor.Identity (Identity, runIdentity) +import System.Random (randomRIO) + +import Gauge + +value, maxValue :: Int +value = 1000000 +maxValue = value + 1000 + +-- 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 + +{-# 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) diff --git a/Benchmarks/Conduit.hs b/Benchmarks/Conduit.hs new file mode 100644 --- /dev/null +++ b/Benchmarks/Conduit.hs @@ -0,0 +1,151 @@ +-- | +-- Module : Benchmarks.Conduit +-- Copyright : (c) 2018 Harendra Kumar +-- +-- License : MIT +-- Maintainer : harendra.kumar@gmail.com + +module Benchmarks.Conduit where + +import Benchmarks.Common (value, maxValue) +import Prelude + (Monad, Int, (+), ($), return, even, (>), (<=), + subtract, undefined, replicate, (<$>), (<*>), Maybe(..), foldMap, (.)) + +import qualified Data.Conduit as S +import qualified Data.Conduit.Combinators as S +import qualified Data.Conduit.List as SL +-- 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 +------------------------------------------------------------------------------- + +type Source m i a = S.ConduitT i a m () +type Sink m a r = S.ConduitT a S.Void m r +type Pipe m a b = S.ConduitT a b m () + +{-# INLINE source #-} +source :: Monad m => Int -> Source m () Int +-- source n = sourceList [n..n+value] +source n = SL.unfoldM step n + where + step cnt = + if cnt > n + value + then return Nothing + else return (Just (cnt, cnt + 1)) + +------------------------------------------------------------------------------- +-- Append +------------------------------------------------------------------------------- + +{-# INLINE appendSource #-} +appendSource :: Monad m => Int -> Source m () Int +appendSource n = foldMap (S.yieldM . return) [n..n+value] + +{-# INLINE runStream #-} +runStream :: Monad m => Sink m Int a -> Source m () Int -> m a +runStream t src = S.runConduit $ src S..| t + +------------------------------------------------------------------------------- +-- Elimination +------------------------------------------------------------------------------- + +eliminate :: Monad m => Sink m Int a -> Source m () Int -> m a +eliminate = runStream + +toNull = eliminate $ S.sinkNull +toList = eliminate $ S.sinkList +foldl = eliminate $ S.foldl (+) 0 +last = eliminate $ S.last + +------------------------------------------------------------------------------- +-- Transformation +------------------------------------------------------------------------------- + +{-# 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.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) + +------------------------------------------------------------------------------- +-- Zipping and concat +------------------------------------------------------------------------------- + +zip src = S.runConduit $ + ( S.getZipSource $ (,) + <$> S.ZipSource src + <*> S.ZipSource src) S..| S.sinkNull +concat = transform (S.map (replicate 3) S..| S.concat) + +------------------------------------------------------------------------------- +-- Composition +------------------------------------------------------------------------------- + +{-# 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)) + +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) diff --git a/Benchmarks/Drinkery.hs b/Benchmarks/Drinkery.hs new file mode 100644 --- /dev/null +++ b/Benchmarks/Drinkery.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE RankNTypes #-} +module Benchmarks.Drinkery where + +import Benchmarks.Common (value, maxValue) +import Control.Monad (void) +import Prelude + (Monad, Int, (+), ($), return, even, (>), (<=), + subtract, undefined, replicate, (<$>), (<*>), fst, id) + +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 +------------------------------------------------------------------------------- + +type Source m i o = S.Source () o m +type Pipe m i o = S.Pipe i o m +type Sink m a r = S.Sink (S.Source () a) m r + +{-# 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 + +------------------------------------------------------------------------------- +-- Elimination +------------------------------------------------------------------------------- + +{-# INLINE eliminate #-} +eliminate :: Monad m => Sink m Int a -> Source m () Int -> m () +eliminate s src = void $ src S.++& s + +toNull = eliminate $ S.drainFrom S.consume +toList = eliminate S.drinkUp +foldl = eliminate $ S.foldlFrom' S.consume (+) 0 +last = eliminate $ S.lastFrom S.consume + +------------------------------------------------------------------------------- +-- Transformation +------------------------------------------------------------------------------- + +{-# INLINE transform #-} +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) + +------------------------------------------------------------------------------- +-- Zipping and concat +------------------------------------------------------------------------------- + +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 + +------------------------------------------------------------------------------- +-- Composition +------------------------------------------------------------------------------- + +{-# 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) + +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)) + +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) diff --git a/Benchmarks/List.hs b/Benchmarks/List.hs new file mode 100644 --- /dev/null +++ b/Benchmarks/List.hs @@ -0,0 +1,114 @@ +-- | +-- Module : Benchmarks.List +-- Copyright : (c) 2018 Harendra Kumar +-- +-- License : MIT +-- Maintainer : harendra.kumar@gmail.com + +module Benchmarks.List where + +import Benchmarks.Common (value, maxValue) +import Prelude (Int, (+), id, ($), (.), even, (>), (<=), subtract, undefined) + +import qualified Data.List 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, scan, map, filterEven, mapM, filterAllOut, + filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, + concat, composeMapM, composeAllInFilters, composeAllOutFilters, + composeMapAllInFilter + :: [Int] -> [Int] + +foldl :: [Int] -> Int +last :: [Int] -> Int +zip :: [Int] -> [(Int, Int)] + +------------------------------------------------------------------------------- +-- Stream generation and elimination +------------------------------------------------------------------------------- + +source :: Int -> [Int] +source v = [v..v+value] + +------------------------------------------------------------------------------- +-- Elimination +------------------------------------------------------------------------------- + +toNull = id +toList = id +foldl = S.foldl' (+) 0 +last = S.last + +------------------------------------------------------------------------------- +-- Transformation +------------------------------------------------------------------------------- + +{-# INLINE transform #-} +transform :: [a] -> [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 :: ([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)) + +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) diff --git a/Benchmarks/Machines.hs b/Benchmarks/Machines.hs new file mode 100644 --- /dev/null +++ b/Benchmarks/Machines.hs @@ -0,0 +1,129 @@ +-- | +-- Module : Benchmarks.Machines +-- Copyright : (c) 2018 Harendra Kumar +-- +-- License : MIT +-- Maintainer : harendra.kumar@gmail.com + +{-# LANGUAGE RankNTypes #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} +module Benchmarks.Machines where + +import Benchmarks.Common (value, maxValue) +import Prelude + (Monad, Int, (+), ($), return, even, (>), (<=), + subtract, replicate, Maybe(..)) + +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 +------------------------------------------------------------------------------- + +type Source m o = S.SourceT m o +type Pipe m i o = S.ProcessT m i o + +source :: Monad m => Int -> Source m Int +-- source n = S.source [n..n+value] +source n = S.unfoldT step n + where + step cnt = + if cnt > n + value + 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 + +------------------------------------------------------------------------------- +-- Elimination +------------------------------------------------------------------------------- + +toNull = S.runT_ +toList = S.runT +foldl = runStream $ S.fold (+) 0 +last = runStream $ S.final + +------------------------------------------------------------------------------- +-- Transformation +------------------------------------------------------------------------------- + +{-# INLINE transform #-} +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) + +------------------------------------------------------------------------------- +-- Zipping and concat +------------------------------------------------------------------------------- + +zip _src = S.runT_ (S.capT (source 10) (source 20) S.zipping) +concat = transform (S.mapping (replicate 3) S.~> S.asParts) + +------------------------------------------------------------------------------- +-- Composition +------------------------------------------------------------------------------- + +compose :: Monad m => Pipe m Int Int -> S.MachineT m k Int -> m () +compose f = transform $ (f S.~> f S.~> f S.~> f) + +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)) + +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) diff --git a/Benchmarks/Pipes.hs b/Benchmarks/Pipes.hs new file mode 100644 --- /dev/null +++ b/Benchmarks/Pipes.hs @@ -0,0 +1,140 @@ +-- | +-- Module : Benchmarks.Pipes +-- Copyright : (c) 2018 Harendra Kumar +-- +-- License : MIT +-- Maintainer : harendra.kumar@gmail.com + +{-# LANGUAGE RankNTypes #-} + +module Benchmarks.Pipes where + +import Benchmarks.Common (value, maxValue) +import Data.Void (Void) +import Prelude + (Monad, Int, (+), ($), id, return, even, (>), (<=), + subtract, undefined, replicate, Maybe, Either(..), foldMap) + +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 +------------------------------------------------------------------------------- + +type Source m i o = S.Producer o m i +type Sink m i r = S.Proxy () i () Void m r +type Pipe m i o = S.Proxy () i () o m () + +{-# INLINE source #-} +source :: Monad m => Int -> Source m () Int +-- source n = S.each [n..n+value] +source n = S.unfoldr step n + where + step cnt = + if cnt > n + value + then return $ Left () + else return (Right (cnt, cnt + 1)) + +------------------------------------------------------------------------------- +-- Append +------------------------------------------------------------------------------- + +{-# INLINE appendSource #-} +appendSource :: Monad m => Int -> Source m () Int +appendSource n = foldMap S.yield [n..n+value] + +------------------------------------------------------------------------------- +-- Elimination +------------------------------------------------------------------------------- + +toNull src = S.runEffect $ S.for src S.discard +toList = S.toListM +foldl = S.fold (+) 0 id +last = S.last + +------------------------------------------------------------------------------- +-- Transformation +------------------------------------------------------------------------------- + +{-# INLINE transform #-} +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) + +------------------------------------------------------------------------------- +-- Zipping and concat +------------------------------------------------------------------------------- + +zip src = S.runEffect $ S.for (S.zip src src) S.discard +concat = transform (S.map (replicate 3) S.>-> S.concat) + +------------------------------------------------------------------------------- +-- Composition +------------------------------------------------------------------------------- + +{-# 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)) + +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) diff --git a/Benchmarks/Streaming.hs b/Benchmarks/Streaming.hs new file mode 100644 --- /dev/null +++ b/Benchmarks/Streaming.hs @@ -0,0 +1,147 @@ +-- | +-- Module : Benchmarks.Streaming +-- Copyright : (c) 2018 Harendra Kumar +-- +-- License : MIT +-- Maintainer : harendra.kumar@gmail.com + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Benchmarks.Streaming where + +import Benchmarks.Common (value, maxValue) +import Control.DeepSeq (NFData) +import Prelude + (Monad, Int, (+), id, ($), (.), return, even, (>), (<=), + subtract, undefined, Maybe, Either(..), foldMap) +--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 +------------------------------------------------------------------------------- + +-- Orphan instance to use nfIO on streaming +instance (NFData a, NFData b) => NFData (S.Of a b) + +type Stream m a = S.Stream (S.Of a) m () + +{-# INLINE source #-} +source :: Monad m => Int -> Stream m Int +-- source n = S.each [n..n+value] +source n = S.unfoldr step n + where + step cnt = + if cnt > n + value + then return $ Left () + else return (Right (cnt, cnt + 1)) + +------------------------------------------------------------------------------- +-- Append +------------------------------------------------------------------------------- + +{-# INLINE appendSource #-} +appendSource :: Monad m => Int -> Stream m Int +appendSource n = foldMap S.yield [n..n+value] + +{-# INLINE runStream #-} +runStream :: Monad m => Stream m a -> m () +runStream = S.mapM_ (\_ -> return ()) + +------------------------------------------------------------------------------- +-- Elimination +------------------------------------------------------------------------------- + +toNull = runStream +toList = S.toList +foldl = S.fold (+) 0 id +last = S.last + +------------------------------------------------------------------------------- +-- Transformation +------------------------------------------------------------------------------- + +{-# INLINE transform #-} +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) + +------------------------------------------------------------------------------- +-- Zipping and concat +------------------------------------------------------------------------------- + +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)) + +------------------------------------------------------------------------------- +-- Composition +------------------------------------------------------------------------------- + +{-# 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)) + +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) diff --git a/Benchmarks/Streamly.hs b/Benchmarks/Streamly.hs new file mode 100644 --- /dev/null +++ b/Benchmarks/Streamly.hs @@ -0,0 +1,167 @@ +-- | +-- Module : Benchmarks.Streamly +-- Copyright : (c) 2018 Harendra Kumar +-- +-- License : MIT +-- Maintainer : harendra.kumar@gmail.com + +{-# LANGUAGE FlexibleContexts #-} +module Benchmarks.Streamly where + +import Benchmarks.Common (value, maxValue) +import Prelude + (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=), + subtract, undefined, Maybe(..), foldMap) +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 +------------------------------------------------------------------------------- + +type Stream m a = S.SerialT m a + +{-# INLINE source #-} +source :: S.MonadAsync m => Int -> Stream m Int +-- source n = S.fromFoldable [n..n+value] +source n = S.unfoldrM step n + where + step cnt = + if cnt > n + value + then return Nothing + else return (Just (cnt, cnt + 1)) + {- +source n = S.unfoldr step n + where + step cnt = + if cnt > n + value + then Nothing + else (Just (cnt, cnt + 1)) + -} + +{-# INLINE sourceN #-} +sourceN :: S.MonadAsync 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)) + +------------------------------------------------------------------------------- +-- 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 runStream #-} +runStream :: Monad m => Stream m a -> m () +runStream = S.runStream + +------------------------------------------------------------------------------- +-- Elimination +------------------------------------------------------------------------------- + +toNull = runStream +toList = S.toList +foldl = S.foldl' (+) 0 +last = S.last + +------------------------------------------------------------------------------- +-- Transformation +------------------------------------------------------------------------------- + +{-# INLINE transform #-} +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) + +------------------------------------------------------------------------------- +-- Zipping and concat +------------------------------------------------------------------------------- + +zip src = transform $ (S.zipWith (,) src src) +concat _n = return () + +------------------------------------------------------------------------------- +-- Composition +------------------------------------------------------------------------------- + +{-# 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) . fmap (subtract 1)) + +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) diff --git a/Benchmarks/Vector.hs b/Benchmarks/Vector.hs new file mode 100644 --- /dev/null +++ b/Benchmarks/Vector.hs @@ -0,0 +1,165 @@ +-- | +-- Module : Benchmarks.Vector +-- Copyright : (c) 2018 Harendra Kumar +-- (c) 2018 Philipp Schuster +-- +-- License : MIT +-- Maintainer : harendra.kumar@gmail.com + +module Benchmarks.Vector where + +import Benchmarks.Common (value, maxValue) +import Prelude + (Monad, Int, (+), ($), (.), return, even, (>), (<=), + subtract, undefined, replicate, 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 + +------------------------------------------------------------------------------- +-- 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)) + +------------------------------------------------------------------------------- +-- 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 runStream #-} +runStream :: Monad m => Stream m a -> m () +runStream = S.mapM_ (\_ -> return ()) + +------------------------------------------------------------------------------- +-- Elimination +------------------------------------------------------------------------------- + +toNull = runStream +toList = S.toList +foldl = S.foldl' (+) 0 +last = S.last + +------------------------------------------------------------------------------- +-- Transformation +------------------------------------------------------------------------------- + +{-# INLINE transform #-} +transform :: Monad m => Stream m a -> m () +transform = runStream + +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) + +------------------------------------------------------------------------------- +-- Zipping and concat +------------------------------------------------------------------------------- + +zip src = transform $ (S.zipWith (,) src src) +concat src = transform $ (S.concatMap (S.fromList . replicate 3) src) + +------------------------------------------------------------------------------- +-- Composition +------------------------------------------------------------------------------- + +{-# 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)) + +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) diff --git a/Benchmarks/VectorPure.hs b/Benchmarks/VectorPure.hs new file mode 100644 --- /dev/null +++ b/Benchmarks/VectorPure.hs @@ -0,0 +1,116 @@ +-- | +-- 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) diff --git a/Changelog.md b/Changelog.md new file mode 100644 --- /dev/null +++ b/Changelog.md @@ -0,0 +1,24 @@ +## 0.2.0 + +* Added benchmarks for pure lists +* Added benchmarks for pure `vector` +* Added benchmarks for `vector` monadic streaming library +* Added `drinkery` streaming library +* The code is modular now, package specific ops for each benchmarked package + are contained in a separate own module. It is much easier to add a new + package now. +* The benchmarking code now works for `IO` as well as `Identity` monad. +* Used the same stream generation method for all libraries for a fair + comparison. +* Use a monadic API (`unfoldrM`) for generating the stream. +* conduit-1.3.0 has a performance issue with `mapM_`. Avoided using `mapM_` and + used `sinkNull` instead. See https://github.com/snoyberg/conduit/issues/363. + This workaround improves the performance of all conduit benchmarks that drain + the stream. +* pipes also had an issue similar to that of conduit. The code was using + `mapM_` which was very inefficient, used `discard` instead and got a + significant boost in numbers. + +## 0.1.0 + +* Initial release diff --git a/Charts.hs b/Charts.hs --- a/Charts.hs +++ b/Charts.hs @@ -1,200 +1,148 @@ -import Control.Arrow (second) -import Data.Char (isSpace) -import Data.List.Split (splitOn) -import Data.Maybe (fromMaybe, catMaybes, fromJust) -import Debug.Trace (trace) -import System.Directory (createDirectoryIfMissing) -import System.Environment (getArgs) -import System.Process.Typed (readProcess_) -import Text.CSV (CSV, parseCSVFromFile) - -import qualified Data.Text.Lazy.Encoding as T -import qualified Data.Text.Lazy as T +{-# LANGUAGE FlexibleContexts #-} -import Graphics.Rendering.Chart.Easy -import Graphics.Rendering.Chart.Backend.Diagrams +module Main where -------------------------------------------------------------------------------- --- Configurable stuff -------------------------------------------------------------------------------- +import Data.Char (isSpace) +import Data.List.Split (splitOn) +import Data.Maybe (catMaybes) +import System.Exit (ExitCode(..)) +import System.Process.Typed (readProcess) +import BenchGraph (bgraph, defaultConfig, Config(..), ComparisonStyle(..)) +import WithCli (withCli) -outputDir :: String -outputDir = "charts" +import Data.List -packages :: [String] -packages = ["streamly", "streaming", "pipes", "conduit", "machines", "vector"] +import qualified Data.Text.Lazy as T +import qualified Data.Text.Lazy.Encoding as T -- pairs of benchmark group titles and corresponding list of benchmark -- prefixes i.e. without the package name at the end. -bmGroups :: [(String, [String])] -bmGroups = +charts :: [(String, [String])] +charts = [ -- Operations are listed in increasing cost order - ( "All Operations at a Glance (Shorter is Faster)" + {- + ( "Key Operations" , [ - -- "filtering/take-one" - "elimination/toNull" - , "filtering/drop-all" - , "elimination/last" - , "elimination/fold" - - , "filtering/filter-all-out" - , "filtering/dropWhile-true" - , "filtering/take-all" - , "filtering/takeWhile-true" - , "transformation/map" - , "filtering/filter-all-in" - , "filtering/filter-even" - - , "elimination/scan" + "elimination/fold" , "transformation/mapM" - , "zip" - - , "elimination/toList" - , "elimination/concat" + , "filtering/filter-even" + , "zip" ] ) - , ( "Discarding and Folding (Shorter is Faster)" + , -} ( "Append Operation" + , [ "append" + ] + ) + , ( "Key Operations" , [ - -- "filtering/take-one" - "elimination/toNull" + "elimination/drain" , "filtering/drop-all" + -- , "filtering/dropWhile-true" + -- , "filtering/filter-all-out" , "elimination/last" , "elimination/fold" - ] - ) - , ( "Pure Transformation and Filtering (Shorter is Faster)" - , [ - "filtering/filter-all-out" - , "filtering/dropWhile-true" - , "filtering/take-all" - , "filtering/takeWhile-true" + -- "filtering/take-one" , "transformation/map" - , "filtering/filter-all-in" + , "filtering/take-all" + --, "filtering/takeWhile-true" + -- , "filtering/filter-all-in" , "filtering/filter-even" - , "elimination/scan" - ] - ) - , ( "Monadic Transformation (Shorter is Faster)" - , [ - "transformation/mapM" - ] - ) - , ( "Folding to List (Shorter is Faster)" - , [ - "elimination/toList" + , "transformation/scan" + , "transformation/mapM" + , "zip" + -- , "transformation/concat" ] ) - , ( "Zipping and Concating Streams (Shorter is Faster)" - , [ "zip" - , "elimination/concat" + , ( "toList Operation" + , [ "elimination/toList" ] ) - , ( "Composing Pipeline Stages (Shorter is Faster)" - , [ - "compose/all-out-filters" + , ( "Composed Operations: 4 times" + , [ "compose/mapM" , "compose/all-in-filters" , "compose/map-with-all-in-filter" - , "compose/mapM" ] ) ] ------------------------------------------------------------------------------- --- "values" has results for each package for each title in bmTitles -genGroupGraph :: String -> [String] -> [(String, [Maybe Double])] -> IO () -genGroupGraph bmGroupName bmTitles values = - toFile def (outputDir - ++ "/" - -- links in README.rst eat up the space so we match the same - ++ (filter (not . isSpace) (takeWhile (/= '(') bmGroupName)) - ++ ".svg") $ do - layout_title .= bmGroupName - layout_title_style . font_size .= 25 - layout_x_axis . laxis_generate .= autoIndexAxis (map fst values) - layout_x_axis . laxis_style . axis_label_style . font_size .= 12 - - -- layout_y_axis . laxis_override .= axisGridAtTicks - let modifyLabels ad = ad { - _axis_labels = map (map (second (++ " ms"))) (_axis_labels ad) - } - layout_y_axis . laxis_override .= modifyLabels - -- XXX We are mapping a missing value to 0, can we label it missing - -- instead? - let modifyVal x = map ((*1000) . fromMaybe 0) (snd x) - plot $ fmap plotBars $ bars bmTitles (addIndexes (map modifyVal values)) - --- Given a package name (e.g. streaming) and benchmark prefixes (e.g. --- [elimination/null, elimination/toList]) get the corresponding results e.g. --- [8.1 ms, 5.4 ms]. The corresponding result file entries will have --- elimination/null/streaming etc. as the names of the entries. -getResultsForPackage :: CSV -> String -> [String] -> [Maybe Double] -getResultsForPackage csvData pkgname bmPrefixes = - map (getBenchmarkMean csvData) - $ map (++ "/" ++ pkgname) bmPrefixes - - where +-- returns [(packagename, version)] +getPkgVersions :: [String] -> IO [(String, String)] +getPkgVersions packages = do + (ecode, out, _) <- readProcess "stack --system-ghc list-dependencies --bench" - getBenchmarkMean entries bmname = - case filter ((== bmname) . head) entries of - [] -> trace - ("Warning! Benchmark [" ++ bmname ++"] not found in csv data") - Nothing - xs -> Just (read ((last xs) !! 1)) + case ecode of + ExitSuccess -> do + -- Get our streaming packages and their versions + let match [] = Nothing + match (_ : []) = Nothing + match (x : y : _) = + case elem x packages of + False -> Nothing + True -> Just (x, y) -genOneGraph :: CSV -> [(String, String)] -> (String, [String]) -> IO () -genOneGraph csvData pkginfo (bmGroupTitle, prefixes) = - genGroupGraph bmGroupTitle bmTitles bmResults + in return + $ catMaybes + $ map match + $ map words (lines (T.unpack $ T.decodeUtf8 out)) + ExitFailure _ -> do + putStrLn $ "Warning! Cannot determine package versions, " + ++ "the 'stack list-dependencies' command failed." + return [] - where +-- suffix versions to packages +suffixVersion :: [(String, String)] -> String -> String +suffixVersion pkginfo p = + case lookup p pkginfo of + Nothing -> p + Just v -> p ++ "-" ++ v - bmTitles = map (last . splitOn "/" ) prefixes +createCharts :: String -> String -> Bool -> IO () +createCharts input pkgList delta = 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 + , classifyBenchmark = \bm -> + case any (`isPrefixOf` bm) prefixes of + True -> + let xs = reverse (splitOn "/" bm) + grp = xs !! 0 + bench = xs !! 1 + in case grp `elem` packages of + True -> Just (suffixVersion pkgInfo grp, bench) + False -> Nothing + False -> Nothing + , 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) + } - pkgName = fst - pkgVersion = snd - pkgNameWithVersion pkgInfo = pkgName pkgInfo ++ "-" ++ pkgVersion pkgInfo - pkgGetResults pkgInfo = - let vals = getResultsForPackage csvData (pkgName pkgInfo) prefixes - in (pkgNameWithVersion pkgInfo, vals) + -- links in README.rst eat up the space so we match the same + let toOutfile title field = + (filter (not . isSpace) (takeWhile (/= '(') title)) + ++ "-" + ++ field - -- this produces results for all packages for all prefixes - -- [(packagenamewithversion, [Maybe Double])] - bmResults = map pkgGetResults pkginfo + makeOneGraph infile field (title, prefixes) = do + let title' = + title + ++ " (" ++ field ++ ")" + ++ " (Lower is Better)" + bgraph infile (toOutfile title field) field (cfg (title', prefixes)) -genGraphs :: CSV -> [(String, String)] -> IO () -genGraphs csvData pkginfo = mapM_ (genOneGraph csvData pkginfo) bmGroups + mapM_ (makeOneGraph input "time") charts + mapM_ (makeOneGraph input "allocated") charts + mapM_ (makeOneGraph input "maxrss") charts --- XXX display GHC version as well --- XXX display the OS/arch --- XXX fix the y axis labels --- XXX fix the legend position +-- Pass main :: IO () -main = do - args <- getArgs - - createDirectoryIfMissing True outputDir - - (out, _) <- readProcess_ "stack --system-ghc list-dependencies --bench" - - -- Get our streaming packages and their versions - let match [] = Nothing - match (_ : []) = Nothing - match (x : y : _) = - case elem x packages of - False -> Nothing - True -> Just (x, y) - pkginfo = - catMaybes - $ map match - $ map words (lines (T.unpack $ T.decodeUtf8 out)) - - -- order them in the order specified in packages so that the order is - -- can be controlled by the user. - let pkginfo' = map (\x -> (x, fromJust $ lookup x pkginfo)) packages - - csvData <- parseCSVFromFile (head args) - case csvData of - Left e -> error $ show e - Right dat -> genGraphs dat pkginfo' - return () +main = withCli createCharts diff --git a/README.rst b/README.rst --- a/README.rst +++ b/README.rst @@ -1,214 +1,442 @@ Streaming Benchmarks --------------------- +==================== -Comprehensive, carefully crafted benchmarks for streaming operations and their -comparisons across notable Haskell streaming libraries including `streaming`, -`machines`, `pipes`, `conduit` and `streamly`. `Streamly -`_ is a brand new streaming library -with beautiful high level and composable concurrency built-in, it is the -primary motivation for these benchmarks. We go to great lengths to make sure -that the benchmarks are correct, fair and reproducible. Please report if you -find something that is not right. +.. image:: https://badges.gitter.im/composewell/gitter.svg? + :target: https://gitter.im/composewell/streamly + :alt: Gitter chat -Benchmarks & Results --------------------- +.. image:: https://img.shields.io/hackage/v/streaming-benchmarks.svg?style=flat + :target: https://hackage.haskell.org/package/streaming-benchmarks + :alt: Hackage -In all the benchmarks we work on a stream of a million consecutive numbers. We -start the sequence using a random number between 1 and 1000 and enumerate it to -make a total of a million elements using the streaming library's native -sequence enumeration API. Note that the efficiency of this sequence generation -may affect all performance numbers of the library because this is a constant -cost involved in all the benchmarks. +.. image:: https://travis-ci.org/composewell/streaming-benchmarks.svg?branch=master + :target: https://travis-ci.org/composewell/streaming-benchmarks + :alt: Unix Build Status -Note that, these benchmarks show results for conduit-1.3.0 which is a recently -released major version, it perhaps requires some work to get at par with the -earlier version i.e. -conduit-1.2.13.1 `which showed significantly better performance -`_ -compared to the newer version. +.. 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 -When choosing a streaming library to use we should not be over obsessed about -the performance numbers as long as the performance is within reasonable bounds. -Whether the absolute performance or the differential among various libraries matters -or not may depend on your workload. If the cost of processing the data is -significantly higher then the streaming operations' overhead will just pale in -comparison and may not matter at all. Unless you are performing huge number of -tiny operations, performance difference may not be significant. +.. contents:: Table of Contents + :depth: 1 -Composing Pipeline Stages -~~~~~~~~~~~~~~~~~~~~~~~~~ +This package compares `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 +`_, 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. -These benchmarks compare the performance when multiple operations are composed -serially in a pipeline. This is how the streaming libraries are supposed to be -used in real applications. +Benchmarks & Results +-------------------- -The `mapM` benchmark introduces four stages of `mapM` between the source and -the sink. +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. -`all-in-filters` composes four stages of a `filter` operation that passes all -the items through. Note that passing or blocking nature of the filter may -impact the results. Some libraries can do blocking more optimally by short -circuiting. +Highlights +~~~~~~~~~~ -`all-out-filters` composes four stages of a `filter` operation that `blocks` -all the items i.e. does not let anything pass through. +* ``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. -The `map-with-all-in-filter` benchmark introduces four identical stages between -the source and the sink where each stage performs a simple `map` operation -followed by a `filter` operation that passes all the items through. +Key Operations +~~~~~~~~~~~~~~ -.. image:: charts/Composing Pipeline Stages.svg - :alt: Composing Pipeline Stages +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.* -Individual Operations -~~~~~~~~~~~~~~~~~~~~~ +.. |keyoperations-time| image:: charts-0/KeyOperations-time.svg + :width: 75% + :target: charts-0/KeyOperations-time.svg + :alt: Time Cost of Key Streaming Operations -This chart shows microbenchmarks for all individual streaming operations for a -quick comparison. Operations are ordered more or less by increasing cost for -better visualization. If an operation is not present in a library then an empty -space is displayed instead of a colored bar in its slot. See the following -sections for details about what the benchmarks do. +|keyoperations-time| -.. image:: charts/All Operations at a Glance.svg - :alt: All Operations at a Glance +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. -Discarding and Folding -^^^^^^^^^^^^^^^^^^^^^^ +.. |keyoperations-allocated| image:: charts-0/KeyOperations-allocated.svg + :width: 75% + :target: charts-0/KeyOperations-allocated.svg + :alt: Heap allocations for Key Streaming Operations -This chart shows the cheapest of all operations, they include operations that -iterate over the stream and either discard all the elements or fold them to a -single value. They all do similar stuff and are generally expected to have -similar cost. Benchmarks include: +|keyoperations-allocated| -* `toNull:` Just discards all the elements in the stream. -* `drop-all`: drops ``n`` elements from the stream where ``n`` is set to the - length of the stream. -* `last`: drops all the elements except the last one. -* `fold`: adds all the elements in the stream to produces the sum. +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. -.. image:: charts/Discarding and Folding.svg - :alt: Discarding and Folding +.. |keyoperations-maxrss| image:: charts-0/KeyOperations-maxrss.svg + :width: 75 % + :target: charts-0/KeyOperations-maxrss.svg + :alt: Maximum rss for Key Streaming Operations -Pure Transformation and Filtering -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +|keyoperations-maxrss| -This is the next category which is a bit costlier than the previous one. Unlike -previous category these operations inspect the elements in the stream and -form a transformed stream based on a function on the value. Benchmarks include: ++------------------------+----------------------------------------------------+ +| 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 | ++------------------------+----------------------------------------------------+ -* `filter-all-out`: A filter that discards all the elements in the stream. -* `filter-all-in`: A filter that retains all the elements in the stream. -* `take-all`: take `n` elements from the stream where `n` is set to the length - of the stream. Effectively iterates through the stream and retains all of it. -* `takeWhile-true`: retains all elements of the stream using a condition that - always wvaluates to true. -* `map`: A pure transformation that increments each element by 1. -* `filter-even`: A filter that passes even elements in the stream i.e. half the - elements are kept and the other half discarded. -* `scan`: scans the stream using ``+`` operation. +Append Operation +~~~~~~~~~~~~~~~~ -.. image:: charts/Pure Transformation and Filtering.svg - :alt: Pure Transformation and Filtering +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. -Monadic Transformation -^^^^^^^^^^^^^^^^^^^^^^ +.. |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 -This benchmark compares the monadic transformation of the stream using -``mapM``. +|append| -.. image:: charts/Monadic Transformation.svg - :alt: Monadic Transformation +toList Operation +~~~~~~~~~~~~~~~~ -Folding to List -^^^^^^^^^^^^^^^ +A stream of a million elements is generated using ``unfoldrM`` and then +converted to a list. -This benchmark compares folding the stream 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 -.. image:: charts/Folding to List.svg - :alt: Folding to List +|toList| -Zip and Concat -^^^^^^^^^^^^^^ +Composing Multiple Operations +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Zip combines corresponding elements of the two streams together. Concat turns a -stream of containers into a stream of their elements. +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. -.. image:: charts/Zipping and Concating Streams.svg - :alt: Zipping and Concating Streams +*Note: the time for streamly and vector is very low (600-700 microseconds) and +therefore can barely be seen in this graph.* -Studying the Scaling of Composition -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +.. |composed| image:: charts-0/ComposedOperations%3A4times-time.svg + :width: 60 % + :target: charts-0/ComposedOperations%3A4times-time.svg + :alt: Cost when operations are composed -This category of benchmarks studies the effect of adding more stages in a -composition pipeline. For each library it displays the results when 1, 2, 3 or -4 pipeline stages are used. There are no graphs you can see the results in the -benchmark output. +|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: + :: - ./run.sh + # Chart all the default packages + ./run.sh --quick -After running you can find the charts generated in the ``charts`` directory. If -you are impatient use ``./run.sh --quick`` and you will get the results much -sooner though a tiny bit less precise. Note that quick mode won't generate the -graphs unless the latest ``gauge`` is used from github repo. + # 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 aboslutely sure that +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. -Important Points about Benchmarking Methodology ------------------------------------------------ +Adding New Libraries +~~~~~~~~~~~~~~~~~~~~ -``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. +It is trivial to add a new package. This is how `a +benchmark file +`_ +for a streaming package looks like. Pull requests are welcome, I will be happy +to help, `just join the gitter chat +`_ +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 -`_ package instead of criterion. We -spent a lot of time figuring out why benchmarking was not producing accurate -results. Criterion had several bugs due to which results were not reliable. We -fixed those bugs in ``gauge``. For example due to GC or CAF evaluation -interaction across benchmarks, the results of benchmarks running later in the -sequence were sometimes totally off the mark. We fixed that by running each -benchmark in a separate process in gauge. Another bug caused criterion to -report wrong mean. +`_ 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. -``Iterations:`` We pass a million elements through the streaming pipelines. We -do not rely on the benchmarking tool for this, it is explicitly done by the -benchmarking code and the benchmarking tool is asked to perform just one -iteration. We added fine grained control in `gauge -`_ to be able to do this. +Benchmarking Code +~~~~~~~~~~~~~~~~~ -``Effects of Optimizations:`` In some cases fusion or other optimizations can -just optimize out everything and produce ridiculously low results. To avoid -that we generate random numbers in the IO monad and pass those through the -pipeline rather than using some constant or predictable source. +* ``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. -``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. +* ``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. -``Benchmark Categories:`` We have two categories of benchmarks, one to measure -the performance of individual operations in isolation and the other to measure -the performance when multiple similar or different operations are composed -together in a pipeline. +* 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. -Benchmarking Errors +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 ------------------- -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. +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 `__ + ++-----------------------------------------------------------------------------+ +| 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. | ++------------------------+----------------------------------------------------+ + diff --git a/run.sh b/run.sh --- a/run.sh +++ b/run.sh @@ -1,8 +1,12 @@ #!/bin/bash print_help () { - echo "Usage: $0 [--quick] [--pedantic] [--no-graph] [--no-measure] [min-samples]" - echo "Any arguments after a '--' will be passed as it is to guage" + echo "Usage: $0 [--quick] [--select] [--delta] [--append] [--pedantic] [--no-graphs] [--no-measure] -- " + 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 } @@ -12,13 +16,18 @@ 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-graph) GRAPH=0; shift ;; + --no-graphs) GRAPH=0; shift ;; --no-measure) MEASURE=0; shift ;; --) shift; break ;; -*|--*) print_help ;; @@ -26,6 +35,13 @@ 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 @@ -83,21 +99,32 @@ if test "$MEASURE" != "0" then - if test -e results.csv + if test -e results.csv -a "$APPEND" != 1 then mv -f -v results.csv results.csv.prev fi - # We set min-samples to 1 so that we run with default benchmark duration of 5 - # seconds, whatever number of samples are possible in that. - # We run just one iteration for each sample. Anyway the default is to run - # for 30 ms and most our benchmarks are close to that or more. + 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 1 \ - --min-duration 0 \ - --csv=results.csv \ + --min-samples 3 \ + --match exact \ + --csvraw=results.csv \ -v 2 \ + $MATCH_ARGS \ $BENCH_PROG $*" || die "Benchmarking failed" fi @@ -105,5 +132,5 @@ then echo echo "Generating charts from results.csv..." - $STACK exec makecharts results.csv + $STACK exec makecharts results.csv $SELECTED $DELTA fi diff --git a/stack-8.2.yaml b/stack-8.2.yaml new file mode 100644 --- /dev/null +++ b/stack-8.2.yaml @@ -0,0 +1,21 @@ +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 diff --git a/stack-pedantic.yaml b/stack-pedantic.yaml --- a/stack-pedantic.yaml +++ b/stack-pedantic.yaml @@ -1,22 +1,16 @@ -resolver: lts-11.0 +resolver: lts-12.0 packages: - '.' extra-deps: - - gauge-0.2.1 - - list-transformer-1.0.3 - - streamly-0.1.1 + - streamly-0.4.1 + - drinkery-0.3 - # for lts-11.0 - - Chart-diagrams-1.8.3 + # for lts-12.0 + - bench-graph-0.1.3 + - Chart-1.9 + - Chart-diagrams-1.9 - 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 +rebuild-ghc-options: true ghc-options: "$everything": -O2 diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,19 +1,14 @@ -resolver: lts-11.0 +resolver: lts-12.0 packages: - '.' extra-deps: - - gauge-0.2.1 - - list-transformer-1.0.3 - - streamly-0.1.1 + - streamly-0.4.1 + - drinkery-0.3 - # for lts-11.0 - - Chart-diagrams-1.8.3 + # for lts-12.0 + - bench-graph-0.1.3 + - Chart-1.9 + - Chart-diagrams-1.9 - 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 + +rebuild-ghc-options: true diff --git a/streaming-benchmarks.cabal b/streaming-benchmarks.cabal --- a/streaming-benchmarks.cabal +++ b/streaming-benchmarks.cabal @@ -1,6 +1,6 @@ name: streaming-benchmarks category: Benchmark -version: 0.1.0 +version: 0.2.0 license: MIT license-file: LICENSE author: Harendra Kumar @@ -11,31 +11,39 @@ copyright: Copyright (c) 2017 Harendra Kumar synopsis: Benchmarks to compare streaming packages description: - Comprehensive, carefully crafted benchmarks for streaming operations and - their comparisons across notable Haskell streaming libraries including - `streaming`, `machines`, `pipes`, `conduit` and `streamly`. - is a new - streaming library with high level and composable concurrency built-in, it is - the primary motivation for these benchmarks. We have put a lot of effort to - make sure that the benchmarks are correct, fair and reproducible. Please - report if you find something that is not right. + 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`. + 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 use @./run.sh@ to run the benchmarks; - charts will be generated in the `charts` directory. + 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. . - With any build tool, run the benchmarks with - @--csv=results.csv@ as arguments and then use @makecharts results.csv@ to - create the charts. In case you want to be pedantic about accurate results - then you can run the benchmarks in the same way as @run.sh@ invokes them. + 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. + . + See the README file shipped with the package or + + for more details. The github repo also shows the latest comparative graphs. cabal-version: >= 1.10 -tested-with: GHC==8.2.2 +tested-with: GHC==8.2.2, GHC==8.4.3 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 @@ -48,6 +56,20 @@ type: exitcode-stdio-1.0 hs-source-dirs: . main-is: Benchmarks.hs + other-modules: Benchmarks.Common + , Benchmarks.BenchmarkTH + , Benchmarks.Streamly + , Benchmarks.Vector + , Benchmarks.Streaming + -- , Benchmarks.LogicT + -- , Benchmarks.ListT + -- , Benchmarks.ListTransformer + , Benchmarks.Conduit + , Benchmarks.Pipes + , Benchmarks.Machines + , Benchmarks.Drinkery + , Benchmarks.List + , Benchmarks.VectorPure ghc-options: -O2 -Wall -with-rtsopts "-T" if impl(ghc >= 8.0) ghc-options: -Wcompat @@ -62,22 +84,24 @@ build-depends: base == 4.*, deepseq >= 1.4.0 && < 1.5, - gauge >= 0.2.1 && < 0.3, + gauge >= 0.2.3 && < 0.3, mtl >= 2 && < 2.3, random >= 1.0 && < 2.0, transformers >= 0.4 && < 0.6, + template-haskell >= 2.10 && < 2.14, - conduit >= 1.3 && < 1.4, - list-transformer >= 1.0.2 && < 1.1, - list-t >= 0.4.6 && < 1.1, - logict >= 0.5.0 && < 0.7, + vector >= 0.12 && < 0.13, + streamly >= 0.2.1 && < 0.5, + streaming >= 0.1.4 && < 0.3, machines >= 0.6.0 && < 0.7, pipes >= 4 && < 4.4, + conduit >= 1.3 && < 1.4, + drinkery >= 0.3 && < 0.4 -- does not build with lts-11.0 -- simple-conduit >= 0.4.0 && < 0.7, - streaming >= 0.1.4 && < 0.3, - vector >= 0.12 && < 0.13, - streamly >= 0.1.1 && < 0.2 + -- list-transformer >= 1.0.2 && < 1.1, + -- list-t >= 0.4.6 && < 1.1, + -- logict >= 0.5.0 && < 0.7, executable makecharts default-language: Haskell2010 @@ -88,11 +112,14 @@ build-depends: base == 4.* + , bench-graph >= 0.1 && < 0.2 , bytestring >= 0.9 && < 0.11 - , Chart >= 1.6 && < 1.9 - , Chart-diagrams >= 1.6 && < 1.9 + , 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