@@ -0,0 +1,145 @@
1+{-# LANGUAGE RecordWildCards #-}
2+module Main where
3+
4+import Criterion.Main (defaultMain, bgroup, bench, nfIO)
5+import Control.Exception (assert)
6+--
7+-- import Fusion as F hiding ((&))
8+import Data.Function ((&))
9+
10+import Data.Conduit as C
11+import Data.Conduit.Combinators as C
12+import Pipes as P
13+import qualified Pipes.Prelude as P
14+import qualified Streaming.Prelude as Str
15+import qualified System.IO.Streams as IOS
16+import Conduit.Simple as S
17+
18+-- Transient
19+import Control.Monad (guard)
20+import Data.IORef (IORef, newIORef, writeIORef)
21+import Data.Atomics (atomicModifyIORefCAS)
22+import System.IO.Unsafe (unsafePerformIO)
23+import Transient.Internals as T
24+import Transient.Indeterminism as T
25+
26+main :: IO ()
27+main = do
28+ defaultMain [
29+ bgroup "basic" [ bench "transient" $ nfIO transient_basic
30+ , bench "stream" $ nfIO stream_basic
31+ , bench "iostreams" $ nfIO iostreams_basic
32+ , bench "pipes" $ nfIO pipes_basic
33+ , bench "conduit" $ nfIO conduit_basic
34+ -- , bench "simple-conduit" $ nfIO simple_conduit_basic
35+ -- , bench "fusion" $ nfIO fusion_basic
36+
37+ ]
38+ ]
39+
40+{-# INLINABLE map #-}
41+map :: (a -> Int) -> a -> TransIO Int
42+map f x = return $ f x
43+
44+{-# INLINABLE filter #-}
45+filter :: (a -> Bool) -> a -> TransIO a
46+filter cond x = guard (cond x) >> return x
47+
48+{-# NOINLINE count #-}
49+count :: IORef Int
50+count = unsafePerformIO $ newIORef 0
51+
52+drop :: Int -> Int -> TransIO Int
53+drop num x = do
54+
55+ mn <- liftIO $ atomicModifyIORefCAS count $ \n ->
56+ let n' = n + 1
57+ in if n' < num then (n + 1, False) else (n + 1, True)
58+ guard mn
59+ return x
60+
61+transient_basic :: IO Int
62+transient_basic = T.keep' $ T.threads 0 $ do
63+ xs <- T.group 499000 $ do
64+ 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)
71+
72+ assert (Prelude.length xs == 499000) $
73+ T.exit (Prelude.length xs)
74+
75+pipes_basic :: IO Int
76+pipes_basic = do
77+ xs <- P.toListM $ P.each [1..1000000]
78+ >-> P.filter even
79+ >-> P.map (+1)
80+ >-> P.drop 1000
81+ >-> P.map (+1)
82+ >-> P.filter (\x -> x `mod` 2 == 0)
83+ assert (Prelude.length xs == 499000) $
84+ return (Prelude.length (xs ::[Int]))
85+
86+conduit_basic :: IO Int
87+conduit_basic = do
88+ xs <- C.yieldMany [1..1000000]
89+ C.$= C.filter even
90+ C.$= C.map ((+1) :: Int -> Int)
91+ C.$= (C.drop 1000 >> C.awaitForever C.yield)
92+ C.$= C.map ((+1) :: Int -> Int)
93+ C.$= C.filter (\x -> x `mod` 2 == 0)
94+ C.$$ C.sinkList
95+ assert (Prelude.length xs == 499000) $
96+ return (Prelude.length (xs :: [Int]))
97+
98+simple_conduit_basic :: IO Int
99+simple_conduit_basic = do
100+ xs <- S.sourceList [1..1000000]
101+ S.$= S.filterC even
102+ S.$= S.mapC ((+1) :: Int -> Int)
103+ S.$= S.dropC 1000
104+ S.$= S.mapC ((+1) :: Int -> Int)
105+ S.$= S.filterC (\x -> x `mod` 2 == 0)
106+ S.$$ S.sinkList
107+ assert (Prelude.length xs == 499000) $
108+ return (Prelude.length (xs :: [Int]))
109+
110+
111+
112+-- fusion_basic :: IO Int
113+-- fusion_basic = do
114+-- xs <- F.toListM $ F.each [1..1000000]
115+-- & F.filter even
116+-- & F.map (+1)
117+-- & F.drop 1000
118+-- & F.map (+1)
119+-- & F.filter (\x -> x `mod` 2 == 0)
120+-- assert (Prelude.length xs == 499000) $
121+-- return (Prelude.length (xs :: [Int]))
122+
123+stream_basic :: IO Int
124+stream_basic = do
125+ let ns = [1..1000000] :: [Int]
126+ xs <- Str.toList $ Str.each ns
127+ & Str.filter even
128+ & Str.map (+1)
129+ & Str.drop 1000
130+ & Str.map (+1)
131+ & Str.filter (\x -> x `mod` 2 == 0)
132+ assert (Prelude.length xs == 499000) $
133+ return (Prelude.length xs)
134+
135+iostreams_basic :: IO Int
136+iostreams_basic = do
137+ s0 <- IOS.fromList [1..1000000]
138+ s1 <- IOS.filter even s0
139+ s2 <- IOS.map (+1) s1
140+ s3 <- IOS.drop 1000 s2
141+ s4 <- IOS.map (+1) s3
142+ s5 <- IOS.filter (\x -> x `mod` 2 == 0) s4
143+ xs <- IOS.toList s5
144+ assert (Prelude.length xs == 499000) $
145+ return (Prelude.length (xs :: [Int]))