@@ -1,305 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE RankNTypes #-}
3−
4−module Main where
5−
6−import Control.Applicative (Alternative(..))
7−import Control.Exception (assert)
8−import Control.Monad (guard)
9−import Gauge.Main (defaultMain, bgroup, bench, nfIO)
10−import Data.Function ((&))
11−
12−import qualified Streamly as A
13−import qualified Streamly.Prelude as A
14−
15−#ifdef EXTRA_BENCHMARKS
16−import Control.Monad.IO.Class (MonadIO (liftIO))
17−import Data.Atomics (atomicModifyIORefCAS)
18−import Data.IORef (IORef, newIORef, writeIORef)
19−import System.IO.Unsafe (unsafePerformIO)
20−
21−import qualified Conduit.Simple as S
22−import qualified Control.Monad.Logic as LG
23−import qualified Data.Machine as M
24−#if MIN_VERSION_transient(0,5,1)
25−import qualified Transient.Internals as T
26−import qualified Transient.Indeterminism as T
27−#endif
28−import qualified ListT as LT
29−#endif
30−
31−main :: IO ()
32−main = do
33− -- XXX due to a GHC bug passing bind as an argument causes perf
34− -- degradation, so we should keep that in account when comparing.
35− let as = streamly_serial
36− ai = streamly_interleaved
37− aa = streamly_async
38− ap = streamly_parallel
39− defaultMain [
40− bgroup "streamly"
41− [ bench "function style all serial" $ nfIO streamly_function_style
42−
43− , bgroup "serial bind"
44− [ bench "serial" $ nfIO (as (A.serial))
45− , bench "fair serial" $ nfIO (as (A.coserial))
46− , bench "left parallel" $ nfIO (as (A.coparallel))
47− , bench "fair parallel" $ nfIO (as (A.parallel))
48− ]
49−
50− , bgroup "interleaved bind"
51− [ bench "serial" $ nfIO (ai (A.serial))
52− , bench "fair serial" $ nfIO (ai (A.coserial))
53− , bench "left parallel" $ nfIO (ai (A.coparallel))
54− , bench "fair parallel" $ nfIO (ai (A.parallel))
55− ]
56−
57− , bgroup "async bind"
58− [ bench "serial" $ nfIO (aa (A.serial))
59− , bench "fair serial" $ nfIO (aa (A.coserial))
60− , bench "left parallel" $ nfIO (aa (A.coparallel))
61− , bench "fair parallel" $ nfIO (aa (A.parallel))
62− ]
63−
64− , bgroup "parallel bind"
65− [ bench "serial" $ nfIO (ap (A.serial))
66− , bench "fair serial" $ nfIO (ap (A.coserial))
67− , bench "left parallel" $ nfIO (ap (A.coparallel))
68− , bench "fair parallel" $ nfIO (ap (A.parallel))
69− ]
70−
71− -- Benchmark smallest possible actions composed together
72− , bgroup "serial bind nil"
73− [ bench "serial" $ nfIO (streamly_nil (A.serial))
74− , bench "fair serial" $ nfIO (streamly_nil (A.coserial))
75− , bench "left parallel" $ nfIO (streamly_nil (A.coparallel))
76− , bench "fair parallel" $ nfIO (streamly_nil (A.parallel))
77− ]
78− ]
79−#ifdef EXTRA_BENCHMARKS
80−#if MIN_VERSION_transient(0,5,1)
81− , bgroup "others"
82− [ bench "transient" $ nfIO transient_basic
83− , bench "transient-nil" $ nfIO transient_nil
84−#endif
85− , bench "logict" $ nfIO logict_basic
86− , bench "list-t" $ nfIO list_t_basic
87− , bench "simple-conduit" $ nfIO simple_conduit_basic
88− , bench "simple-conduit-bind" $ nfIO simple_conduit_bind
89− , bench "machines" $ nfIO machines_basic
90− ]
91−#endif
92− ]
93−
94−{-# INLINABLE map #-}
95−map :: Monad m => (a -> Int) -> a -> m Int
96−map f x = return $ f x
97−
98−guard' :: (A.IsStream t, Applicative (t m)) => Bool -> t m ()
99−guard' True = pure ()
100−guard' False = A.nil
101−
102−{-# INLINABLE filter #-}
103−filter :: (Monad m, Alternative m) => (a -> Bool) -> a -> m a
104−filter cond x = guard (not $ cond x) >> return x
105−
106−amap :: Monad (s IO) => (Int -> Int) -> Int -> s IO Int
107−amap = Main.map
108−
109−afilter :: (A.IsStream s, Monad (s IO)) => (Int -> Bool) -> Int -> s IO Int
110−afilter cond x = guard' (not $ cond x) >> return x
111−
112−{-# INLINE streamly_basic #-}
113−streamly_basic
114− :: (Monad (t IO), A.IsStream t)
115− => (forall a. t IO a -> IO [a])
116− -> (t IO Int -> t IO Int -> t IO Int)
117− -> IO Int
118−streamly_basic tl g = do
119− xs <- tl $ do
120− A.drop 100 (A.forEachWith g [1..100000 :: Int] $ \x ->
121− afilter even x >>= amap (+1))
122− >>= amap (+1)
123− >>= afilter (\y -> y `mod` 2 == 0)
124− assert (Prelude.length xs == 49900) $
125− return (Prelude.length xs)
126−
127−{-# INLINE streamly_function_style #-}
128−streamly_function_style :: IO Int
129−streamly_function_style = do
130− xs <- A.toList $ A.serially $
131− A.fromFoldable [1..100000 :: Int]
132− & A.filter even
133− & fmap (+1)
134− & A.drop 100
135− & fmap (+1)
136− & A.filter (\y -> y `mod` 2 == 0)
137− assert (Prelude.length xs == 49900) $
138− return (Prelude.length xs)
139−
140−{-# INLINE streamly_serial #-}
141−streamly_serial
142− :: (A.SerialT IO Int -> A.SerialT IO Int -> A.SerialT IO Int)
143− -> IO Int
144−streamly_serial = streamly_basic (A.toList . A.serially)
145−
146−{-# INLINE streamly_interleaved #-}
147−streamly_interleaved
148− :: (A.CoserialT IO Int -> A.CoserialT IO Int -> A.CoserialT IO Int)
149− -> IO Int
150−streamly_interleaved = streamly_basic (A.toList . A.coserially)
151−
152−{-# INLINE streamly_async #-}
153−streamly_async
154− :: (A.CoparallelT IO Int -> A.CoparallelT IO Int -> A.CoparallelT IO Int)
155− -> IO Int
156−streamly_async = streamly_basic (A.toList . A.coparallely)
157−
158−{-# INLINE streamly_parallel #-}
159−streamly_parallel
160− :: (A.ParallelT IO Int -> A.ParallelT IO Int -> A.ParallelT IO Int)
161− -> IO Int
162−streamly_parallel = streamly_basic (A.toList . A.parallely)
163−
164−{-# INLINE streamly_nil #-}
165−streamly_nil :: (A.SerialT IO Int -> A.SerialT IO Int -> A.SerialT IO Int)
166− -> IO Int
167−streamly_nil f = do
168− xs <- (A.toList . A.serially) $ do
169− (A.forEachWith f [1..100000:: Int] $
170− \x -> return x >>= return . id)
171− assert (Prelude.length xs == 100000) $
172− return (Prelude.length xs)
173−
174−#ifdef EXTRA_BENCHMARKS
175−#if MIN_VERSION_transient(0,5,1)
176−
177−{-# NOINLINE count #-}
178−count :: IORef Int
179−count = unsafePerformIO $ newIORef 0
180−
181−drop :: (MonadIO m, Alternative m) => Int -> Int -> m Int
182−drop num x = do
183−
184− mn <- liftIO $ atomicModifyIORefCAS count $ \n ->
185− if n < num then (n + 1, False) else (n, True)
186− guard mn
187− return x
188−
189−tmap :: (a -> Int) -> a -> T.TransIO Int
190−tmap = Main.map
191−
192−tfilter :: (a -> Bool) -> a -> T.TransIO a
193−tfilter = Main.filter
194−
195−tdrop :: Int -> Int -> T.TransIO Int
196−tdrop = Main.drop
197−
198−transient_basic :: IO (Maybe Int)
199−
200−transient_basic = T.keep' $ T.threads 0 $ do
201− liftIO $ writeIORef count 0
202− xs <- T.group 49900 $ do
203− T.choose [1..100000 :: Int]
204− >>= tfilter even
205− >>= tmap (+1)
206− >>= tdrop 100
207− >>= tmap (+1)
208− >>= tfilter (\x -> x `mod` 2 == 0)
209−
210− assert (Prelude.length xs == 49900) $
211− T.exit (Prelude.length xs)
212−
213−transient_nil :: IO (Maybe Int)
214−transient_nil = T.keep' $ T.threads 0 $ do
215− xs <- T.group 49900 $ do
216− T.choose [1..100000 :: Int]
217− assert (Prelude.length xs == 49900) $
218− T.exit (Prelude.length xs)
219−#endif
220−
221−lfilter :: (Int -> Bool) -> Int -> LT.ListT IO Int
222−lfilter = Main.filter
223−
224−lmap :: (Int -> Int) -> Int -> LT.ListT IO Int
225−lmap = Main.map
226−
227−ldrop :: Int -> Int -> LT.ListT IO Int
228−ldrop = Main.drop
229−
230−list_t_basic :: IO Int
231−list_t_basic = do
232− writeIORef count 0
233− xs <- LT.toList $ do
234− LT.fromFoldable [1..100000 :: Int]
235− >>= lfilter even
236− >>= lmap (+1)
237− >>= ldrop 100
238− >>= lmap (+1)
239− >>= lfilter (\x -> x `mod` 2 == 0)
240− assert (Prelude.length xs == 49900) $
241− return (Prelude.length xs)
242−
243−lgfilter :: (Int -> Bool) -> Int -> LG.LogicT IO Int
244−lgfilter = Main.filter
245−
246−lgmap :: (Int -> Int) -> Int -> LG.LogicT IO Int
247−lgmap = Main.map
248−
249−lgdrop :: Int -> Int -> LG.LogicT IO Int
250−lgdrop = Main.drop
251−
252−logict_basic :: IO Int
253−logict_basic = do
254− writeIORef count 0
255− --xs <- LG.observeManyT 2900 $ do
256− xs <- LG.observeAllT $ do
257− LG.msum $ Prelude.map return [1..100000]
258− >>= lgfilter even
259− >>= lgmap (+1)
260− >>= lgdrop 100
261− >>= lgmap (+1)
262− >>= lgfilter (\x -> x `mod` 2 == 0)
263− assert (Prelude.length xs == 49900) $
264− return (Prelude.length xs)
265−
266−simple_conduit_basic :: IO Int
267−simple_conduit_basic = do
268− xs <- S.sourceList [1..100000]
269− S.$= S.filterC even
270− S.$= S.mapC ((+1) :: Int -> Int)
271− S.$= S.dropC 100
272− S.$= S.mapC ((+1) :: Int -> Int)
273− S.$= S.filterC (\x -> x `mod` 2 == 0)
274− S.$$ S.sinkList
275− assert (Prelude.length xs == 49900) $
276− return (Prelude.length (xs :: [Int]))
277−
278−smap :: Monad (s IO) => (Int -> Int) -> Int -> s IO Int
279−smap = Main.map
280−
281−sfilter :: (Alternative (s IO), Monad (s IO)) => (Int -> Bool) -> Int -> s IO Int
282−sfilter = Main.filter
283−
284−{-# INLINE simple_conduit_bind #-}
285−simple_conduit_bind :: IO Int
286−simple_conduit_bind = do
287− xs <- S.sinkList $ do
288− S.dropC 100 (S.sourceList [1..100000 :: Int] >>= \x ->
289− sfilter even x >>= smap (+1))
290− >>= smap (+1)
291− >>= sfilter (\y -> y `mod` 2 == 0)
292− assert (Prelude.length xs == 49900) $
293− return (Prelude.length xs)
294−
295−machines_basic :: IO Int
296−machines_basic = do
297− xs <- M.runT $ M.source [1..100000]
298− M.~> M.filtered even
299− M.~> M.mapping (+1)
300− M.~> M.dropping 100
301− M.~> M.mapping (+1)
302− M.~> M.filtered (\x -> x `mod` 2 == 0)
303− assert (Prelude.length xs == 49900) $
304− return (Prelude.length (xs ::[Int]))
305−#endif