@@ -17,16 +17,20 @@ import Conduit.Simple as S
1717
1818-- Transient
1919import Control.Monad (guard)
20+import Control.Applicative (Alternative)
2021import Data.IORef (IORef, newIORef, writeIORef)
2122import Data.Atomics (atomicModifyIORefCAS)
2223import System.IO.Unsafe (unsafePerformIO)
2324import Transient.Internals as T
2425import Transient.Indeterminism as T
2526
27+import Asyncly as A
28+
2629main :: IO ()
2730main = do
2831 defaultMain [
29− bgroup "basic" [ bench "transient" $ nfIO transient_basic
32+ bgroup "basic" [ bench "asyncly" $ nfIO asyncly_basic
33+ , bench "transient" $ nfIO transient_basic
3034 , bench "stream" $ nfIO stream_basic
3135 , bench "iostreams" $ nfIO iostreams_basic
3236 , bench "pipes" $ nfIO pipes_basic
@@ -38,18 +42,18 @@ main = do
3842 ]
3943
4044{-# INLINABLE map #-}
41−map :: (a -> Int) -> a -> TransIO Int
45+map :: Monad m => (a -> Int) -> a -> m Int
4246map f x = return $ f x
4347
4448{-# INLINABLE filter #-}
45−filter :: (a -> Bool) -> a -> TransIO a
49+filter :: (Monad m, Alternative m) => (a -> Bool) -> a -> m a
4650filter cond x = guard (cond x) >> return x
4751
4852{-# NOINLINE count #-}
4953count :: IORef Int
5054count = unsafePerformIO $ newIORef 0
5155
52−drop :: Int -> Int -> TransIO Int
56+drop :: (MonadIO m, Alternative m) => Int -> Int -> m Int
5357drop num x = do
5458
5559 mn <- liftIO $ atomicModifyIORefCAS count $ \n ->
@@ -58,20 +62,52 @@ drop num x = do
5862 guard mn
5963 return x
6064
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+
6174transient_basic :: IO Int
6275transient_basic = T.keep' $ T.threads 0 $ do
6376 xs <- T.group 499000 $ do
6477 liftIO $ writeIORef count 0
65− T.choose [1..1000000::Int]
66− >>= Main.filter even
67− >>= Main.map (+1)
68− >>= Main.drop 1000
69− >>= Main.map (+1)
70− >>= Main.filter (\x -> x `mod` 2 == 0)
78+ T.choose [1..1000000 :: Int]
79+ >>= tfilter even
80+ >>= tmap (+1)
81+ >>= tdrop 1000
82+ >>= tmap (+1)
83+ >>= tfilter (\x -> x `mod` 2 == 0)
7184
7285 assert (Prelude.length xs == 499000) $
7386 T.exit (Prelude.length xs)
7487
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+
75111pipes_basic :: IO Int
76112pipes_basic = do
77113 xs <- P.toListM $ P.each [1..1000000]