on master help sign in
Add asyncly to benchmarks
5457bbdHarendra Kumar
benchmark/Main.hs+46−10
@@ -17,16 +17,20 @@ import Conduit.Simple as S
17
17
18-- Transient
18-- Transient
19import Control.Monad (guard)
19import Control.Monad (guard)
20+import Control.Applicative (Alternative)
20import Data.IORef (IORef, newIORef, writeIORef)
21import Data.IORef (IORef, newIORef, writeIORef)
21import Data.Atomics (atomicModifyIORefCAS)
22import Data.Atomics (atomicModifyIORefCAS)
22import System.IO.Unsafe (unsafePerformIO)
23import System.IO.Unsafe (unsafePerformIO)
23import Transient.Internals as T
24import Transient.Internals as T
24import Transient.Indeterminism as T
25import Transient.Indeterminism as T
25
26
27+import Asyncly as A
28+
26main :: IO ()
29main :: IO ()
27main = do
30main = do
28 defaultMain [
31 defaultMain [
32+ bgroup "basic" [ bench "asyncly" $ nfIO asyncly_basic
29− bgroup "basic" [ bench "transient" $ nfIO transient_basic
33+ , bench "transient" $ nfIO transient_basic
30 , bench "stream" $ nfIO stream_basic
34 , bench "stream" $ nfIO stream_basic
31 , bench "iostreams" $ nfIO iostreams_basic
35 , bench "iostreams" $ nfIO iostreams_basic
32 , bench "pipes" $ nfIO pipes_basic
36 , bench "pipes" $ nfIO pipes_basic
@@ -38,18 +42,18 @@ main = do
38 ]
42 ]
39
43
40{-# INLINABLE map #-}
44{-# INLINABLE map #-}
41−map :: (a -> Int) -> a -> TransIO Int
45+map :: Monad m => (a -> Int) -> a -> m Int
42map f x = return $ f x
46map f x = return $ f x
43
47
44{-# INLINABLE filter #-}
48{-# INLINABLE filter #-}
45−filter :: (a -> Bool) -> a -> TransIO a
49+filter :: (Monad m, Alternative m) => (a -> Bool) -> a -> m a
46filter cond x = guard (cond x) >> return x
50filter cond x = guard (cond x) >> return x
47
51
48{-# NOINLINE count #-}
52{-# NOINLINE count #-}
49count :: IORef Int
53count :: IORef Int
50count = unsafePerformIO $ newIORef 0
54count = unsafePerformIO $ newIORef 0
51
55
52−drop :: Int -> Int -> TransIO Int
56+drop :: (MonadIO m, Alternative m) => Int -> Int -> m Int
53drop num x = do
57drop num x = do
54
58
55 mn <- liftIO $ atomicModifyIORefCAS count $ \n ->
59 mn <- liftIO $ atomicModifyIORefCAS count $ \n ->
@@ -58,20 +62,52 @@ drop num x = do
58 guard mn
62 guard mn
59 return x
63 return x
60
64
65+tmap :: (a -> Int) -> a -> TransIO Int
66+tmap = Main.map
67+
68+tfilter :: (a -> Bool) -> a -> TransIO a
69+tfilter = Main.filter
70+
71+tdrop :: Int -> Int -> TransIO Int
72+tdrop = Main.drop
73+
61transient_basic :: IO Int
74transient_basic :: IO Int
62transient_basic = T.keep' $ T.threads 0 $ do
75transient_basic = T.keep' $ T.threads 0 $ do
63 xs <- T.group 499000 $ do
76 xs <- T.group 499000 $ do
64 liftIO $ writeIORef count 0
77 liftIO $ writeIORef count 0
65− T.choose [1..1000000::Int]
78+ T.choose [1..1000000 :: Int]
66− >>= Main.filter even
79+ >>= tfilter even
67− >>= Main.map (+1)
80+ >>= tmap (+1)
68− >>= Main.drop 1000
81+ >>= tdrop 1000
69− >>= Main.map (+1)
82+ >>= tmap (+1)
70− >>= Main.filter (\x -> x `mod` 2 == 0)
83+ >>= tfilter (\x -> x `mod` 2 == 0)
71
84
72 assert (Prelude.length xs == 499000) $
85 assert (Prelude.length xs == 499000) $
73 T.exit (Prelude.length xs)
86 T.exit (Prelude.length xs)
74
87
88+amap :: (a -> Int) -> a -> AsyncT IO Int
89+amap = Main.map
90+
91+afilter :: (a -> Bool) -> a -> AsyncT IO a
92+afilter = Main.filter
93+
94+adrop :: Int -> Int -> AsyncT IO Int
95+adrop = Main.drop
96+
97+asyncly_basic :: IO Int
98+asyncly_basic = do
99+ writeIORef count 0
100+ xs <- wait $ A.threads 0 $ do
101+ A.each [1..1000000 :: Int]
102+ >>= afilter even
103+ >>= amap (+1)
104+ >>= adrop 1000
105+ >>= amap (+1)
106+ >>= afilter (\x -> x `mod` 2 == 0)
107+
108+ assert (Prelude.length xs == 499000) $
109+ return (Prelude.length xs)
110+
75pipes_basic :: IO Int
111pipes_basic :: IO Int
76pipes_basic = do
112pipes_basic = do
77 xs <- P.toListM $ P.each [1..1000000]
113 xs <- P.toListM $ P.each [1..1000000]