@@ -27,12 +27,19 @@ import qualified ListT as LT
2727
2828main :: IO ()
2929main = 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
3033 defaultMain [
3134 bgroup "basic"
32− [ bench "asyncly-serial" $ nfIO (asyncly_basic (A.<>))
33− , bench "asyncly-interleaved" $ nfIO (asyncly_basic (A.<=>))
34− , bench "asyncly-parleft" $ nfIO (asyncly_basic (A.<|))
35− , bench "asyncly-parinterleaved" $ nfIO (asyncly_basic (A.<|>))
35+ [ bench "asyncly-serial" $ nfIO (as (>>=) (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.<=>))
39+ , bench "asyncly-parleft" $ nfIO (as (>>=) (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.<|>))
3643 , bench "asyncly-serial-nil" $ nfIO (asyncly_nil (A.<>))
3744 , bench "asyncly-interleaved-nil" $ nfIO (asyncly_nil (A.<=>))
3845 , bench "asyncly-parleft-nil" $ nfIO (asyncly_nil (A.<|))
@@ -65,14 +72,16 @@ afilter :: (Int -> Bool) -> Int -> A.AsyncT IO Int
6572afilter = Main.filter
6673
6774{-# INLINE asyncly_basic #-}
68−asyncly_basic :: (A.AsyncT IO Int -> A.AsyncT IO Int -> A.AsyncT IO Int)
75+asyncly_basic
76+ :: (A.AsyncT IO Int -> (Int -> A.AsyncT IO Int) -> A.AsyncT IO Int)
77+ -> (A.AsyncT IO Int -> A.AsyncT IO Int -> A.AsyncT IO Int)
6978 -> IO Int
70−asyncly_basic f = do
79+asyncly_basic f g = do
7180 xs <- A.toList $ do
72− A.drop 100 (A.forEachWith f [1..100000 :: Int] $ \x ->
73− afilter even x >>= amap (+1))
74− >>= amap (+1)
75− >>= afilter (\y -> y `mod` 2 == 0)
81+ A.drop 100 (A.foldMapWith g return [1..100000 :: Int] `f` \x ->
82+ afilter even x `f` amap (+1))
83+ `f` amap (+1)
84+ `f` afilter (\y -> y `mod` 2 == 0)
7685 assert (Prelude.length xs == 49900) $
7786 return (Prelude.length xs)
7887