@@ -1,305 +0,0 @@
2−{-# LANGUAGE RankNTypes #-}
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 ((&))
12−import qualified Streamly as A
13−import qualified Streamly.Prelude as A
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)
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
28−import qualified ListT as LT
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
38− ap = streamly_parallel
41− [ bench "function style all serial" $ nfIO streamly_function_style
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))
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))
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))
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))
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))
79−#ifdef EXTRA_BENCHMARKS
80−#if MIN_VERSION_transient(0,5,1)
82− [ bench "transient" $ nfIO transient_basic
83− , bench "transient-nil" $ nfIO transient_nil
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
95−map :: Monad m => (a -> Int) -> a -> m Int
96−map f x = return $ f x
98−guard' :: (A.IsStream t, Applicative (t m)) => Bool -> t m ()
102−{-# INLINABLE filter #-}
103−filter :: (Monad m, Alternative m) => (a -> Bool) -> a -> m a
104−filter cond x = guard (not $ cond x) >> return x
106−amap :: Monad (s IO) => (Int -> Int) -> Int -> s IO Int
109−afilter :: (A.IsStream s, Monad (s IO)) => (Int -> Bool) -> Int -> s IO Int
110−afilter cond x = guard' (not $ cond x) >> return x
112−{-# INLINE 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)
118−streamly_basic tl g = do
120− A.drop 100 (A.forEachWith g [1..100000 :: Int] $ \x ->
121− afilter even x >>= amap (+1))
123− >>= afilter (\y -> y `mod` 2 == 0)
124− assert (Prelude.length xs == 49900) $
125− return (Prelude.length xs)
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]
136− & A.filter (\y -> y `mod` 2 == 0)
137− assert (Prelude.length xs == 49900) $
138− return (Prelude.length xs)
140−{-# INLINE streamly_serial #-}
142− :: (A.SerialT IO Int -> A.SerialT IO Int -> A.SerialT IO Int)
144−streamly_serial = streamly_basic (A.toList . A.serially)
146−{-# INLINE streamly_interleaved #-}
148− :: (A.CoserialT IO Int -> A.CoserialT IO Int -> A.CoserialT IO Int)
150−streamly_interleaved = streamly_basic (A.toList . A.coserially)
152−{-# INLINE streamly_async #-}
154− :: (A.CoparallelT IO Int -> A.CoparallelT IO Int -> A.CoparallelT IO Int)
156−streamly_async = streamly_basic (A.toList . A.coparallely)
158−{-# INLINE streamly_parallel #-}
160− :: (A.ParallelT IO Int -> A.ParallelT IO Int -> A.ParallelT IO Int)
162−streamly_parallel = streamly_basic (A.toList . A.parallely)
164−{-# INLINE streamly_nil #-}
165−streamly_nil :: (A.SerialT IO Int -> A.SerialT IO Int -> A.SerialT IO Int)
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)
174−#ifdef EXTRA_BENCHMARKS
175−#if MIN_VERSION_transient(0,5,1)
177−{-# NOINLINE count #-}
179−count = unsafePerformIO $ newIORef 0
181−drop :: (MonadIO m, Alternative m) => Int -> Int -> m Int
184− mn <- liftIO $ atomicModifyIORefCAS count $ \n ->
185− if n < num then (n + 1, False) else (n, True)
189−tmap :: (a -> Int) -> a -> T.TransIO Int
192−tfilter :: (a -> Bool) -> a -> T.TransIO a
193−tfilter = Main.filter
195−tdrop :: Int -> Int -> T.TransIO Int
198−transient_basic :: IO (Maybe Int)
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]
208− >>= tfilter (\x -> x `mod` 2 == 0)
210− assert (Prelude.length xs == 49900) $
211− T.exit (Prelude.length xs)
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)
221−lfilter :: (Int -> Bool) -> Int -> LT.ListT IO Int
222−lfilter = Main.filter
224−lmap :: (Int -> Int) -> Int -> LT.ListT IO Int
227−ldrop :: Int -> Int -> LT.ListT IO Int
230−list_t_basic :: IO Int
233− xs <- LT.toList $ do
234− LT.fromFoldable [1..100000 :: Int]
239− >>= lfilter (\x -> x `mod` 2 == 0)
240− assert (Prelude.length xs == 49900) $
241− return (Prelude.length xs)
243−lgfilter :: (Int -> Bool) -> Int -> LG.LogicT IO Int
244−lgfilter = Main.filter
246−lgmap :: (Int -> Int) -> Int -> LG.LogicT IO Int
249−lgdrop :: Int -> Int -> LG.LogicT IO Int
252−logict_basic :: IO Int
255− --xs <- LG.observeManyT 2900 $ do
256− xs <- LG.observeAllT $ do
257− LG.msum $ Prelude.map return [1..100000]
262− >>= lgfilter (\x -> x `mod` 2 == 0)
263− assert (Prelude.length xs == 49900) $
264− return (Prelude.length xs)
266−simple_conduit_basic :: IO Int
267−simple_conduit_basic = do
268− xs <- S.sourceList [1..100000]
270− S.$= S.mapC ((+1) :: Int -> Int)
272− S.$= S.mapC ((+1) :: Int -> Int)
273− S.$= S.filterC (\x -> x `mod` 2 == 0)
275− assert (Prelude.length xs == 49900) $
276− return (Prelude.length (xs :: [Int]))
278−smap :: Monad (s IO) => (Int -> Int) -> Int -> s IO Int
281−sfilter :: (Alternative (s IO), Monad (s IO)) => (Int -> Bool) -> Int -> s IO Int
282−sfilter = Main.filter
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))
291− >>= sfilter (\y -> y `mod` 2 == 0)
292− assert (Prelude.length xs == 49900) $
293− return (Prelude.length xs)
295−machines_basic :: IO Int
297− xs <- M.runT $ M.source [1..100000]
298− M.~> M.filtered even
302− M.~> M.filtered (\x -> x `mod` 2 == 0)
303− assert (Prelude.length xs == 49900) $
304− return (Prelude.length (xs ::[Int]))