@@ -1,51 +1,34 @@
1−{-# LANGUAGE RecordWildCards #-}
21module Main where
32
4−import Criterion.Main (defaultMain, bgroup, bench, nfIO)
3+import Control.Applicative (Alternative(..))
54import Control.Exception (assert)
6−import Control.Monad.IO.Class (MonadIO (liftIO))
7−--
8−-- import Fusion as F hiding ((&))
9−import Data.Function ((&))
10−
11−import qualified Data.Conduit as C
12−import qualified Data.Conduit.Combinators as C
13−import qualified Pipes as P
14−import qualified Pipes.Prelude as P
15−import qualified Streaming.Prelude as Str
16−import qualified System.IO.Streams as IOS
17−import qualified Conduit.Simple as S
18−
19−-- Transient
205import Control.Monad (guard)
21−import Control.Applicative (Alternative(..))
22−import Data.IORef (IORef, newIORef, writeIORef)
6+import Control.Monad.IO.Class (MonadIO (liftIO))
7+import Criterion.Main (defaultMain, bgroup, bench, nfIO)
238import Data.Atomics (atomicModifyIORefCAS)
9+import Data.IORef (IORef, newIORef, writeIORef)
2410import System.IO.Unsafe (unsafePerformIO)
25−import qualified Transient.Internals as T
26−import qualified Transient.Indeterminism as T
2711
12+import qualified Asyncly as A
13+import qualified Control.Monad.Logic as LG
2814import qualified Data.Machine as M
15+import qualified Transient.Internals as T
16+import qualified Transient.Indeterminism as T
2917import qualified ListT as LT
30−import qualified Control.Monad.Logic as LG
31−import qualified Asyncly as A
3218
3319main :: IO ()
3420main = do
3521 defaultMain [
36− bgroup "basic" [ bench "asyncly" $ nfIO asyncly_basic
37− , bench "logict" $ nfIO logict_basic
38− , bench "list-t" $ nfIO list_t_basic
39− , bench "transient" $ nfIO transient_basic
40− , bench "machines" $ nfIO machines_basic
41− , bench "stream" $ nfIO stream_basic
42− , bench "conduit" $ nfIO conduit_basic
43− , bench "pipes" $ nfIO pipes_basic
44− , bench "simple-conduit" $ nfIO simple_conduit_basic
45− , bench "iostreams" $ nfIO iostreams_basic
46− -- , bench "fusion" $ nfIO fusion_basic
47−
48− ]
22+ bgroup "basic"
23+ [ bench "asyncly (<>)" $ nfIO (asyncly_basic (A.<>))
24+ , bench "asyncly (<=>)" $ nfIO (asyncly_basic (A.<=>))
25+ , bench "asyncly (<|)" $ nfIO (asyncly_basic (A.<|))
26+ , bench "asyncly (<|>)" $ nfIO (asyncly_basic (A.<|>))
27+ , bench "transient" $ nfIO transient_basic
28+ , bench "logict" $ nfIO logict_basic
29+ , bench "list-t" $ nfIO list_t_basic
30+ , bench "machines" $ nfIO machines_basic
31+ ]
4932 ]
5033
5134{-# INLINABLE map #-}
@@ -77,18 +60,18 @@ tfilter = Main.filter
7760tdrop :: Int -> Int -> T.TransIO Int
7861tdrop = Main.drop
7962
80−transient_basic :: IO Int
63+transient_basic :: IO (Maybe Int)
8164transient_basic = T.keep' $ T.threads 0 $ do
8265 liftIO $ writeIORef count 0
83− xs <- T.group 499001 $ do
84− T.choose [1..1000001 :: Int]
66+ xs <- T.group 49900 $ do
67+ T.choose [1..100000 :: Int]
8568 >>= tfilter even
8669 >>= tmap (+1)
87− >>= tdrop 1000
70+ >>= tdrop 100
8871 >>= tmap (+1)
8972 >>= tfilter (\x -> x `mod` 2 == 0)
9073
91− assert (Prelude.length xs == 499000) $
74+ assert (Prelude.length xs == 49900) $
9275 T.exit (Prelude.length xs)
9376
9477amap :: (Int -> Int) -> Int -> A.AsyncT IO Int
@@ -100,18 +83,20 @@ afilter = Main.filter
10083adrop :: Int -> Int -> A.AsyncT IO Int
10184adrop = Main.drop
10285
103−asyncly_basic :: IO Int
104−asyncly_basic = do
86+{-# INLINE asyncly_basic #-}
87+asyncly_basic :: (A.AsyncT IO Int -> A.AsyncT IO Int -> A.AsyncT IO Int)
88+ -> IO Int
89+asyncly_basic f = do
10590 writeIORef count 0
10691 xs <- A.toList $ do
107− (A.forEachWith (A.<|) [1..1000000 :: Int] $ \x ->
92+ (A.forEachWith f [1..100000 :: Int] $ \x ->
10893 return x
10994 >>= afilter even
11095 >>= amap (+1)
111− >>= adrop 1000
96+ >>= adrop 100
11297 >>= amap (+1)
11398 >>= afilter (\y -> y `mod` 2 == 0))
114− assert (Prelude.length xs == 499000) $
99+ assert (Prelude.length xs == 49900) $
115100 return (Prelude.length xs)
116101
117102lfilter :: (Int -> Bool) -> Int -> LT.ListT IO Int
@@ -127,13 +112,13 @@ list_t_basic :: IO Int
127112list_t_basic = do
128113 writeIORef count 0
129114 xs <- LT.toList $ do
130− LT.fromFoldable [1..1000000 :: Int]
115+ LT.fromFoldable [1..100000 :: Int]
131116 >>= lfilter even
132117 >>= lmap (+1)
133− >>= ldrop 1000
118+ >>= ldrop 100
134119 >>= lmap (+1)
135120 >>= lfilter (\x -> x `mod` 2 == 0)
136− assert (Prelude.length xs == 499000) $
121+ assert (Prelude.length xs == 49900) $
137122 return (Prelude.length xs)
138123
139124lgfilter :: (Int -> Bool) -> Int -> LG.LogicT IO Int
@@ -150,94 +135,22 @@ logict_basic = do
150135 writeIORef count 0
151136 --xs <- LG.observeManyT 2900 $ do
152137 xs <- LG.observeAllT $ do
153− LG.msum $ Prelude.map return [1..1000000]
138+ LG.msum $ Prelude.map return [1..100000]
154139 >>= lgfilter even
155140 >>= lgmap (+1)
156− >>= lgdrop 1000
141+ >>= lgdrop 100
157142 >>= lgmap (+1)
158143 >>= lgfilter (\x -> x `mod` 2 == 0)
159− assert (Prelude.length xs == 499000) $
144+ assert (Prelude.length xs == 49900) $
160145 return (Prelude.length xs)
161146
162147machines_basic :: IO Int
163148machines_basic = do
164− xs <- M.runT $ M.source [1..1000000]
149+ xs <- M.runT $ M.source [1..100000]
165150 M.~> M.filtered even
166151 M.~> M.mapping (+1)
167− M.~> M.dropping 1000
152+ M.~> M.dropping 100
168153 M.~> M.mapping (+1)
169154 M.~> M.filtered (\x -> x `mod` 2 == 0)
170− assert (Prelude.length xs == 499000) $
171− return (Prelude.length (xs ::[Int]))
172−
173−pipes_basic :: IO Int
174−pipes_basic = do
175− xs <- P.toListM $ P.each [1..1000000]
176− P.>-> P.filter even
177− P.>-> P.map (+1)
178− P.>-> P.drop 1000
179− P.>-> P.map (+1)
180− P.>-> P.filter (\x -> x `mod` 2 == 0)
181− assert (Prelude.length xs == 499000) $
155+ assert (Prelude.length xs == 49900) $
182156 return (Prelude.length (xs ::[Int]))
183−
184−conduit_basic :: IO Int
185−conduit_basic = do
186− xs <- C.yieldMany [1..1000000]
187− C.$= C.filter even
188− C.$= C.map ((+1) :: Int -> Int)
189− C.$= (C.drop 1000 >> C.awaitForever C.yield)
190− C.$= C.map ((+1) :: Int -> Int)
191− C.$= C.filter (\x -> x `mod` 2 == 0)
192− C.$$ C.sinkList
193− assert (Prelude.length xs == 499000) $
194− return (Prelude.length (xs :: [Int]))
195−
196−simple_conduit_basic :: IO Int
197−simple_conduit_basic = do
198− xs <- S.sourceList [1..1000000]
199− S.$= S.filterC even
200− S.$= S.mapC ((+1) :: Int -> Int)
201− S.$= S.dropC 1000
202− S.$= S.mapC ((+1) :: Int -> Int)
203− S.$= S.filterC (\x -> x `mod` 2 == 0)
204− S.$$ S.sinkList
205− assert (Prelude.length xs == 499000) $
206− return (Prelude.length (xs :: [Int]))
207−
208−
209−
210−-- fusion_basic :: IO Int
211−-- fusion_basic = do
212−-- xs <- F.toListM $ F.each [1..1000000]
213−-- & F.filter even
214−-- & F.map (+1)
215−-- & F.drop 1000
216−-- & F.map (+1)
217−-- & F.filter (\x -> x `mod` 2 == 0)
218−-- assert (Prelude.length xs == 499000) $
219−-- return (Prelude.length (xs :: [Int]))
220−
221−stream_basic :: IO Int
222−stream_basic = do
223− let ns = [1..1000000] :: [Int]
224− xs Str.:> _ <- Str.toList $ Str.each ns
225− & Str.filter even
226− & Str.map (+1)
227− & Str.drop 1000
228− & Str.map (+1)
229− & Str.filter (\x -> x `mod` 2 == 0)
230− assert (Prelude.length xs == 499000) $
231− return (Prelude.length xs)
232−
233−iostreams_basic :: IO Int
234−iostreams_basic = do
235− s0 <- IOS.fromList [1..1000000]
236− s1 <- IOS.filter even s0
237− s2 <- IOS.map (+1) s1
238− s3 <- IOS.drop 1000 s2
239− s4 <- IOS.map (+1) s3
240− s5 <- IOS.filter (\x -> x `mod` 2 == 0) s4
241− xs <- IOS.toList s5
242− assert (Prelude.length xs == 499000) $
243− return (Prelude.length (xs :: [Int]))