Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Machines benchmark modified to include vector stream fusion. Addapted from https://gist.github.com/michaelt/f19bef01423b17f29ffd, which is in turn based on https://github.com/ekmett/machines/blob/master/benchmarks/Benchmarks.hs
{-#LANGUAGE NoMonomorphismRestriction #-}
module Main (main) where
import Control.Monad (void)
import Control.Monad.Identity
import Criterion.Main
import qualified Data.Conduit as C
import qualified Data.Conduit.Combinators as CC
import qualified Data.Conduit.List as C
import qualified Data.Machine as M
import qualified Pipes as P
import qualified Pipes.Prelude as P
import qualified Streaming.Prelude as S
import Streaming (Of (..), Stream)
import qualified Data.Vector.Fusion.Stream.Monadic as V
import Data.Strict.Tuple as Strict
import Data.Strict.Maybe as Strict
value :: Int
value = 1000000
drainS :: (Stream (Of Int) Identity () -> Stream (Of o) Identity ()) -> ()
drainS p = runIdentity $ S.effects $ p sourceS
drainM :: M.ProcessT Identity Int o -> ()
drainM m = runIdentity $ M.runT_ (sourceM M.~> m)
drainP :: P.Proxy () Int () a Identity () -> ()
drainP p = runIdentity $ P.runEffect $ P.for (sourceP P.>-> p) P.discard
drainC :: C.Conduit Int Identity a -> ()
drainC c = runIdentity $ (sourceC C.$= c) C.$$ C.sinkNull
drainSC :: C.Sink Int Identity b -> b
drainSC c = runIdentity $ sourceC C.$$ c
drainV :: (V.Stream Identity Int -> V.Stream Identity a) -> ()
drainV f = runIdentity $ effectsV $ f sourceV
effectsV :: Monad m => V.Stream m a -> m ()
effectsV = V.foldl' (\_ _ -> ()) ()
{-# INLINABLE scanV #-}
scanV :: Monad m => (x -> a -> x) -> x -> (x -> b) -> V.Stream m a -> V.Stream m b
scanV f x0 g (V.Stream step t) = V.Stream step' (Strict.Just (t :!: x0))
where
step' Strict.Nothing = return V.Done
step' (Strict.Just (s :!: x)) = do
r <- step s
case r of
V.Yield a s' -> return $ V.Yield (g x) (Strict.Just (s' :!: f x a))
V.Skip s' -> return $ V.Skip (Strict.Just (s' :!: x))
V.Done -> return $ V.Yield (g x) Strict.Nothing
sourceM = M.enumerateFromTo 1 value
sourceC = C.enumFromTo 1 value
sourceP = P.each [1..value]
sourceS = S.take value $ S.enumFrom 1
sourceV = V.enumFromTo 1 value
main :: IO ()
main =
defaultMain
[ bgroup "map"
[ bench "vector" $ whnf drainV (V.map (+1))
, bench "streaming" $ whnf drainS (S.map (+1))
, bench "conduit" $ whnf drainC (C.map (+1))
, bench "pipes" $ whnf drainP (P.map (+1))
, bench "machines" $ whnf drainM (M.auto (+1))
]
, bgroup "drop"
[ bench "vector" $ whnf drainV (V.drop value)
, bench "streaming" $ whnf drainS (S.drop value)
, bench "conduit" $ whnf drainC (C.drop value)
, bench "pipes" $ whnf drainP (P.drop value)
, bench "machines" $ whnf drainM (M.dropping value)
]
, bgroup "dropWhile"
[ bench "vector" $ whnf drainV (V.dropWhile (<= value))
, bench "streaming" $ whnf drainS (S.dropWhile (<= value))
, bench "conduit" $ whnf drainC (CC.dropWhile (<= value))
, bench "pipes" $ whnf drainP (P.dropWhile (<= value))
, bench "machines" $ whnf drainM (M.droppingWhile (<= value))
]
, bgroup "scan"
[ bench "vector (my)" $ whnf drainV (scanV (+) 0 id)
, bench "vector" $ whnf drainV (V.scanl (+) 0)
, bench "streaming" $ whnf drainS (S.scan (+) 0 id)
, bench "conduit" $ whnf drainC (CC.scanl (+) 0)
, bench "pipes" $ whnf drainP (P.scan (+) 0 id)
, bench "machines" $ whnf drainM (M.scan (+) 0)
]
, bgroup "take"
[ bench "vector" $ whnf drainV (V.take value)
, bench "streaming" $ whnf drainS (S.take value)
, bench "conduit" $ whnf drainC (C.isolate value)
, bench "pipes" $ whnf drainP (P.take value)
, bench "machines" $ whnf drainM (M.taking value)
]
, bgroup "takeWhile"
[ bench "vector" $ whnf drainV (V.takeWhile (<= value))
, bench "streaming" $ whnf drainS (S.takeWhile (<= value))
, bench "conduit" $ whnf drainC (CC.takeWhile (<= value) C.=$= C.sinkNull)
, bench "pipes" $ whnf drainP (P.takeWhile (<= value))
, bench "machines" $ whnf drainM (M.takingWhile (<= value))
]
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.