mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 19:47:10 +03:00
Add benchmarks including transient
This commit is contained in:
parent
d64225fe30
commit
b1068152b7
@ -59,6 +59,28 @@ test-suite test
|
||||
, monad-recorder
|
||||
default-language: Haskell2010
|
||||
|
||||
benchmark bench
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Main.hs
|
||||
hs-source-dirs: benchmark
|
||||
ghc-options: -Wall -fwarn-identities -fwarn-incomplete-record-updates
|
||||
-fwarn-incomplete-uni-patterns -fwarn-tabs
|
||||
-O2 -funbox-strict-fields
|
||||
build-depends:
|
||||
asyncly
|
||||
, atomic-primops
|
||||
, base >= 4.7 && < 5
|
||||
, conduit
|
||||
, conduit-combinators
|
||||
, criterion
|
||||
, io-streams
|
||||
, mtl
|
||||
, pipes
|
||||
, simple-conduit
|
||||
, streaming
|
||||
, transient
|
||||
default-language: Haskell2010
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/harendra-kumar/asyncly
|
||||
|
145
benchmark/Main.hs
Normal file
145
benchmark/Main.hs
Normal file
@ -0,0 +1,145 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Main where
|
||||
|
||||
import Criterion.Main (defaultMain, bgroup, bench, nfIO)
|
||||
import Control.Exception (assert)
|
||||
--
|
||||
-- import Fusion as F hiding ((&))
|
||||
import Data.Function ((&))
|
||||
|
||||
import Data.Conduit as C
|
||||
import Data.Conduit.Combinators as C
|
||||
import Pipes as P
|
||||
import qualified Pipes.Prelude as P
|
||||
import qualified Streaming.Prelude as Str
|
||||
import qualified System.IO.Streams as IOS
|
||||
import Conduit.Simple as S
|
||||
|
||||
-- Transient
|
||||
import Control.Monad (guard)
|
||||
import Data.IORef (IORef, newIORef, writeIORef)
|
||||
import Data.Atomics (atomicModifyIORefCAS)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import Transient.Internals as T
|
||||
import Transient.Indeterminism as T
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
defaultMain [
|
||||
bgroup "basic" [ bench "transient" $ nfIO transient_basic
|
||||
, bench "stream" $ nfIO stream_basic
|
||||
, bench "iostreams" $ nfIO iostreams_basic
|
||||
, bench "pipes" $ nfIO pipes_basic
|
||||
, bench "conduit" $ nfIO conduit_basic
|
||||
-- , bench "simple-conduit" $ nfIO simple_conduit_basic
|
||||
-- , bench "fusion" $ nfIO fusion_basic
|
||||
|
||||
]
|
||||
]
|
||||
|
||||
{-# INLINABLE map #-}
|
||||
map :: (a -> Int) -> a -> TransIO Int
|
||||
map f x = return $ f x
|
||||
|
||||
{-# INLINABLE filter #-}
|
||||
filter :: (a -> Bool) -> a -> TransIO a
|
||||
filter cond x = guard (cond x) >> return x
|
||||
|
||||
{-# NOINLINE count #-}
|
||||
count :: IORef Int
|
||||
count = unsafePerformIO $ newIORef 0
|
||||
|
||||
drop :: Int -> Int -> TransIO Int
|
||||
drop num x = do
|
||||
|
||||
mn <- liftIO $ atomicModifyIORefCAS count $ \n ->
|
||||
let n' = n + 1
|
||||
in if n' < num then (n + 1, False) else (n + 1, True)
|
||||
guard mn
|
||||
return x
|
||||
|
||||
transient_basic :: IO Int
|
||||
transient_basic = T.keep' $ T.threads 0 $ do
|
||||
xs <- T.group 499000 $ do
|
||||
liftIO $ writeIORef count 0
|
||||
T.choose [1..1000000::Int]
|
||||
>>= Main.filter even
|
||||
>>= Main.map (+1)
|
||||
>>= Main.drop 1000
|
||||
>>= Main.map (+1)
|
||||
>>= Main.filter (\x -> x `mod` 2 == 0)
|
||||
|
||||
assert (Prelude.length xs == 499000) $
|
||||
T.exit (Prelude.length xs)
|
||||
|
||||
pipes_basic :: IO Int
|
||||
pipes_basic = do
|
||||
xs <- P.toListM $ P.each [1..1000000]
|
||||
>-> P.filter even
|
||||
>-> P.map (+1)
|
||||
>-> P.drop 1000
|
||||
>-> P.map (+1)
|
||||
>-> P.filter (\x -> x `mod` 2 == 0)
|
||||
assert (Prelude.length xs == 499000) $
|
||||
return (Prelude.length (xs ::[Int]))
|
||||
|
||||
conduit_basic :: IO Int
|
||||
conduit_basic = do
|
||||
xs <- C.yieldMany [1..1000000]
|
||||
C.$= C.filter even
|
||||
C.$= C.map ((+1) :: Int -> Int)
|
||||
C.$= (C.drop 1000 >> C.awaitForever C.yield)
|
||||
C.$= C.map ((+1) :: Int -> Int)
|
||||
C.$= C.filter (\x -> x `mod` 2 == 0)
|
||||
C.$$ C.sinkList
|
||||
assert (Prelude.length xs == 499000) $
|
||||
return (Prelude.length (xs :: [Int]))
|
||||
|
||||
simple_conduit_basic :: IO Int
|
||||
simple_conduit_basic = do
|
||||
xs <- S.sourceList [1..1000000]
|
||||
S.$= S.filterC even
|
||||
S.$= S.mapC ((+1) :: Int -> Int)
|
||||
S.$= S.dropC 1000
|
||||
S.$= S.mapC ((+1) :: Int -> Int)
|
||||
S.$= S.filterC (\x -> x `mod` 2 == 0)
|
||||
S.$$ S.sinkList
|
||||
assert (Prelude.length xs == 499000) $
|
||||
return (Prelude.length (xs :: [Int]))
|
||||
|
||||
|
||||
|
||||
-- fusion_basic :: IO Int
|
||||
-- fusion_basic = do
|
||||
-- xs <- F.toListM $ F.each [1..1000000]
|
||||
-- & F.filter even
|
||||
-- & F.map (+1)
|
||||
-- & F.drop 1000
|
||||
-- & F.map (+1)
|
||||
-- & F.filter (\x -> x `mod` 2 == 0)
|
||||
-- assert (Prelude.length xs == 499000) $
|
||||
-- return (Prelude.length (xs :: [Int]))
|
||||
|
||||
stream_basic :: IO Int
|
||||
stream_basic = do
|
||||
let ns = [1..1000000] :: [Int]
|
||||
xs <- Str.toList $ Str.each ns
|
||||
& Str.filter even
|
||||
& Str.map (+1)
|
||||
& Str.drop 1000
|
||||
& Str.map (+1)
|
||||
& Str.filter (\x -> x `mod` 2 == 0)
|
||||
assert (Prelude.length xs == 499000) $
|
||||
return (Prelude.length xs)
|
||||
|
||||
iostreams_basic :: IO Int
|
||||
iostreams_basic = do
|
||||
s0 <- IOS.fromList [1..1000000]
|
||||
s1 <- IOS.filter even s0
|
||||
s2 <- IOS.map (+1) s1
|
||||
s3 <- IOS.drop 1000 s2
|
||||
s4 <- IOS.map (+1) s3
|
||||
s5 <- IOS.filter (\x -> x `mod` 2 == 0) s4
|
||||
xs <- IOS.toList s5
|
||||
assert (Prelude.length xs == 499000) $
|
||||
return (Prelude.length (xs :: [Int]))
|
@ -5,7 +5,8 @@ packages:
|
||||
git: https://github.com/harendra-kumar/monad-recorder
|
||||
commit: 05bb0cfd827d9f955108d3b03dfb20b7c6820c25
|
||||
extra-dep: true
|
||||
extra-deps: []
|
||||
extra-deps:
|
||||
- simple-conduit-0.6.0
|
||||
flags: {}
|
||||
extra-package-dbs: []
|
||||
pvp-bounds: both
|
||||
|
Loading…
Reference in New Issue
Block a user