ilyakooo0/streamly
1
0
Fork 0
mirror of https://github.com/ilyakooo0/streamly.git synced 2024-10-06 21:27:35 +03:00
Code Issues Packages Projects Releases Wiki Activity

Add machine benchmark and fix others

Browse Source
This commit is contained in:
Harendra Kumar 2017-07-22 19:49:52 +05:30
parent 4d4894c6f1
commit cc4743cb5f
2 changed files with 25 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
asyncly.cabal
View File

@ -68,6 +68,7 @@ benchmark bench
ghc-options: -Wall -fwarn-identities -fwarn-incomplete-record-updates
-fwarn-incomplete-uni-patterns -fwarn-tabs
-O2 -funbox-strict-fields
-fno-ignore-asserts
build-depends:
asyncly
, atomic-primops
@ -76,6 +77,7 @@ benchmark bench
, conduit-combinators
, criterion
, io-streams
, machines
, mtl
, pipes
, simple-conduit

35
benchmark/Main.hs
View File

@ -24,6 +24,7 @@ import System.IO.Unsafe (unsafePerformIO)
import Transient.Internals as T
import Transient.Indeterminism as T
import Data.Machine as M
import Asyncly as A
main :: IO ()
@ -31,11 +32,12 @@ main = do
defaultMain [
bgroup "basic" [ bench "asyncly" $ nfIO asyncly_basic
, bench "transient" $ nfIO transient_basic
, bench "machines" $ nfIO machines_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 "pipes" $ nfIO pipes_basic
, bench "simple-conduit" $ nfIO simple_conduit_basic
, bench "iostreams" $ nfIO iostreams_basic
-- , bench "fusion" $ nfIO fusion_basic
]
@ -47,7 +49,7 @@ map f x = return $ f x
{-# INLINABLE filter #-}
filter :: (Monad m, Alternative m) => (a -> Bool) -> a -> m a
filter cond x = guard (cond x) >> return x
filter cond x = guard (not $ cond x) >> return x
{-# NOINLINE count #-}
count :: IORef Int
@ -57,8 +59,7 @@ drop :: (MonadIO m, Alternative m) => Int -> Int -> m 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)
if n < num then (n + 1, False) else (n, True)
guard mn
return x
@ -73,13 +74,13 @@ tdrop = Main.drop
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]
liftIO $ writeIORef count 0
xs <- T.group 499001 $ do
T.choose [1..1000001 :: Int]
>>= tfilter even
>>= tmap (+1)
>>= tdrop 1000
>>= tmap (+1)
>>= tmap (+1)
>>= tfilter (\x -> x `mod` 2 == 0)
assert (Prelude.length xs == 499000) $
@ -104,10 +105,20 @@ asyncly_basic = do
>>= adrop 1000
>>= amap (+1)
>>= afilter (\x -> x `mod` 2 == 0)
assert (Prelude.length xs == 499000) $
return (Prelude.length xs)
machines_basic :: IO Int
machines_basic = do
xs <- M.runT $ M.source [1..1000000]
M.~> M.filtered even
M.~> M.mapping (+1)
M.~> M.dropping 1000
M.~> M.mapping (+1)
M.~> M.filtered (\x -> x `mod` 2 == 0)
assert (Prelude.length xs == 499000) $
return (Prelude.length (xs ::[Int]))
pipes_basic :: IO Int
pipes_basic = do
xs <- P.toListM $ P.each [1..1000000]
@ -159,7 +170,7 @@ simple_conduit_basic = do
stream_basic :: IO Int
stream_basic = do
let ns = [1..1000000] :: [Int]
xs <- Str.toList $ Str.each ns
xs Str.:> _ <- Str.toList $ Str.each ns
& Str.filter even
& Str.map (+1)
& Str.drop 1000