on master help sign in
Add fair bind benchmarks
0dffdd7Harendra Kumar
benchmark/Main.hs+19−10
@@ -27,12 +27,19 @@ import qualified ListT as LT
27
27
28main :: IO ()
28main :: IO ()
29main = do
29main = do
30+ -- XXX due to a GHC bug passing bind as an argument causes perf
31+ -- degradation, so we should keep that in account when comparing.
32+ let as = asyncly_basic
30 defaultMain [
33 defaultMain [
31 bgroup "basic"
34 bgroup "basic"
32− [ bench "asyncly-serial" $ nfIO (asyncly_basic (A.<>))
35+ [ bench "asyncly-serial" $ nfIO (as (>>=) (A.<>))
33− , bench "asyncly-interleaved" $ nfIO (asyncly_basic (A.<=>))
36+ , bench "asyncly-interleaved" $ nfIO (as (>>=) (A.<=>))
37+ , bench "asyncly-serial-fairbind" $ nfIO (as (A.>->) (A.<>))
38+ , bench "asyncly-interleaved-fairbind" $ nfIO (as (A.>->) (A.<=>))
34− , bench "asyncly-parleft" $ nfIO (asyncly_basic (A.<|))
39+ , bench "asyncly-parleft" $ nfIO (as (>>=) (A.<|))
35− , bench "asyncly-parinterleaved" $ nfIO (asyncly_basic (A.<|>))
40+ , bench "asyncly-parinterleaved" $ nfIO (as (>>=) (A.<|>))
41+ , bench "asyncly-parleft-fairbind" $ nfIO (as (A.>->) (A.<|))
42+ , bench "asyncly-parinterleaved-fairbind" $ nfIO (as (A.>->) (A.<|>))
36 , bench "asyncly-serial-nil" $ nfIO (asyncly_nil (A.<>))
43 , bench "asyncly-serial-nil" $ nfIO (asyncly_nil (A.<>))
37 , bench "asyncly-interleaved-nil" $ nfIO (asyncly_nil (A.<=>))
44 , bench "asyncly-interleaved-nil" $ nfIO (asyncly_nil (A.<=>))
38 , bench "asyncly-parleft-nil" $ nfIO (asyncly_nil (A.<|))
45 , bench "asyncly-parleft-nil" $ nfIO (asyncly_nil (A.<|))
@@ -65,14 +72,16 @@ afilter :: (Int -> Bool) -> Int -> A.AsyncT IO Int
65afilter = Main.filter
72afilter = Main.filter
66
73
67{-# INLINE asyncly_basic #-}
74{-# INLINE asyncly_basic #-}
75+asyncly_basic
76+ :: (A.AsyncT IO Int -> (Int -> A.AsyncT IO Int) -> A.AsyncT IO Int)
68−asyncly_basic :: (A.AsyncT IO Int -> A.AsyncT IO Int -> A.AsyncT IO Int)
77+ -> (A.AsyncT IO Int -> A.AsyncT IO Int -> A.AsyncT IO Int)
69 -> IO Int
78 -> IO Int
70−asyncly_basic f = do
79+asyncly_basic f g = do
71 xs <- A.toList $ do
80 xs <- A.toList $ do
72− A.drop 100 (A.forEachWith f [1..100000 :: Int] $ \x ->
81+ A.drop 100 (A.foldMapWith g return [1..100000 :: Int] `f` \x ->
73− afilter even x >>= amap (+1))
82+ afilter even x `f` amap (+1))
74− >>= amap (+1)
83+ `f` amap (+1)
75− >>= afilter (\y -> y `mod` 2 == 0)
84+ `f` afilter (\y -> y `mod` 2 == 0)
76 assert (Prelude.length xs == 49900) $
85 assert (Prelude.length xs == 49900) $
77 return (Prelude.length xs)
86 return (Prelude.length xs)
78
87