@@ -7,6 +7,7 @@ import Control.Applicative (Alternative(..))
77import Control.Exception (assert)
88import Control.Monad (guard)
99import Criterion.Main (defaultMain, bgroup, bench, nfIO)
10+import Data.Function ((&))
1011
1112import qualified Asyncly as A
1213import qualified Asyncly.Prelude as A
@@ -37,7 +38,9 @@ main = do
3738 ap = asyncly_parallel
3839 defaultMain [
3940 bgroup "asyncly"
40− [ bgroup "serial bind"
41+ [ bench "function style all serial" $ nfIO asyncly_function_style
42+
43+ , bgroup "serial bind"
4144 [ bench "serial" $ nfIO (as (A.<>))
4245 , bench "fair serial" $ nfIO (as (A.<=>))
4346 , bench "left parallel" $ nfIO (as (A.<|))
@@ -103,18 +106,31 @@ afilter = Main.filter
103106
104107{-# INLINE asyncly_basic #-}
105108asyncly_basic
106− :: (Alternative (s IO), Monad (s IO), Monoid (s IO Int), A.Streaming s) => (forall a. s IO a -> IO [a])
107− -> (s IO Int -> s IO Int -> s IO Int)
109+ :: (Alternative (t IO), Monad (t IO), A.Streaming t)
110+ => (forall a. t IO a -> IO [a])
111+ -> (t IO Int -> t IO Int -> t IO Int)
108112 -> IO Int
109113asyncly_basic tl g = do
110114 xs <- tl $ do
111115 A.drop 100 (A.forEachWith g [1..100000 :: Int] $ \x ->
112− afilter even x `f` amap (+1))
113− `f` amap (+1)
114− `f` afilter (\y -> y `mod` 2 == 0)
116+ afilter even x >>= amap (+1))
117+ >>= amap (+1)
118+ >>= afilter (\y -> y `mod` 2 == 0)
119+ assert (Prelude.length xs == 49900) $
120+ return (Prelude.length xs)
121+
122+{-# INLINE asyncly_function_style #-}
123+asyncly_function_style :: IO Int
124+asyncly_function_style = do
125+ xs <- A.toList $ A.serially $
126+ A.each [1..100000 :: Int]
127+ & A.filter even
128+ & fmap (+1)
129+ & A.drop 100
130+ & fmap (+1)
131+ & A.filter (\y -> y `mod` 2 == 0)
115132 assert (Prelude.length xs == 49900) $
116133 return (Prelude.length xs)
117− where f = (>>=)
118134
119135{-# INLINE asyncly_serial #-}
120136asyncly_serial