git.iko.soy/streamly
on 93ffb85 help sign in
streamly/benchmark/Main.hs
238 lines 7.6 kB history raw
1{-# LANGUAGE CPP #-}
3module Main where
5import Control.Applicative (Alternative(..))
6import Control.Exception (assert)
7import Control.Monad (guard)
8import Criterion.Main (defaultMain, bgroup, bench, nfIO)
10import qualified Asyncly as A
11import qualified Asyncly.Prelude as A
13#ifdef EXTRA_BENCHMARKS
14import Control.Monad.IO.Class (MonadIO (liftIO))
15import Data.Atomics (atomicModifyIORefCAS)
16import Data.IORef (IORef, newIORef, writeIORef)
17import System.IO.Unsafe (unsafePerformIO)
19import qualified Conduit.Simple as S
20import qualified Control.Monad.Logic as LG
21import qualified Data.Machine as M
22#if MIN_VERSION_transient(0,5,1)
23import qualified Transient.Internals as T
24import qualified Transient.Indeterminism as T
25#endif
26import qualified ListT as LT
27#endif
29main :: IO ()
30main = do
31 -- XXX due to a GHC bug passing bind as an argument causes perf
32 -- degradation, so we should keep that in account when comparing.
33 let as = asyncly_basic
34 defaultMain [
35 bgroup "asyncly"
36 [ bgroup "serial bind"
37 [ bench "serial" $ nfIO (as (>>=) (A.<>))
38 , bench "fair serial" $ nfIO (as (>>=) (A.<=>))
39 , bench "left parallel" $ nfIO (as (>>=) (A.<|))
40 , bench "fair parallel" $ nfIO (as (>>=) (A.<|>))
41 ]
43 , bgroup "fair bind"
44 [ bench "serial" $ nfIO (as (A.>->) (A.<>))
45 , bench "fair serial" $ nfIO (as (A.>->) (A.<=>))
46 , bench "left parallel" $ nfIO (as (A.>->) (A.<|))
47 , bench "fair parallel" $ nfIO (as (A.>->) (A.<|>))
48 ]
50 , bgroup "parallel bind"
51 [ bench "serial" $ nfIO (as (A.>>|) (A.<>))
52 , bench "fair serial" $ nfIO (as (A.>>|) (A.<=>))
53 , bench "left parallel" $ nfIO (as (A.>>|) (A.<|))
54 , bench "fair parallel" $ nfIO (as (A.>>|) (A.<|>))
55 ]
57 , bgroup "fair parallel bind"
58 [ bench "serial" $ nfIO (as (A.>|>) (A.<>))
59 , bench "fair serial" $ nfIO (as (A.>|>) (A.<=>))
60 , bench "left parallel" $ nfIO (as (A.>|>) (A.<|))
61 , bench "fair parallel" $ nfIO (as (A.>|>) (A.<|>))
62 ]
64 -- Benchmark smallest possible actions composed together
65 , bgroup "serial bind nil"
66 [ bench "serial" $ nfIO (asyncly_nil (A.<>))
67 , bench "fair serial" $ nfIO (asyncly_nil (A.<=>))
68 , bench "left parallel" $ nfIO (asyncly_nil (A.<|))
69 , bench "fair parallel" $ nfIO (asyncly_nil (A.<|>))
70 ]
71 ]
72#ifdef EXTRA_BENCHMARKS
73#if MIN_VERSION_transient(0,5,1)
74 , bgroup "others"
75 [ bench "transient" $ nfIO transient_basic
76 , bench "transient-nil" $ nfIO transient_nil
77#endif
78 , bench "logict" $ nfIO logict_basic
79 , bench "list-t" $ nfIO list_t_basic
80 , bench "simple-conduit" $ nfIO simple_conduit_basic
81 , bench "machines" $ nfIO machines_basic
82 ]
83#endif
84 ]
86{-# INLINABLE map #-}
87map :: Monad m => (a -> Int) -> a -> m Int
88map f x = return $ f x
90{-# INLINABLE filter #-}
91filter :: (Monad m, Alternative m) => (a -> Bool) -> a -> m a
92filter cond x = guard (not $ cond x) >> return x
94amap :: (Int -> Int) -> Int -> A.AsyncT IO Int
95amap = Main.map
97afilter :: (Int -> Bool) -> Int -> A.AsyncT IO Int
98afilter = Main.filter
100{-# INLINE asyncly_basic #-}
101asyncly_basic
102 :: (A.AsyncT IO Int -> (Int -> A.AsyncT IO Int) -> A.AsyncT IO Int)
103 -> (A.AsyncT IO Int -> A.AsyncT IO Int -> A.AsyncT IO Int)
104 -> IO Int
105asyncly_basic f g = do
106 xs <- A.toList $ do
107 A.drop 100 (A.forEachWith g [1..100000 :: Int] $ \x ->
108 afilter even x `f` amap (+1))
109 `f` amap (+1)
110 `f` afilter (\y -> y `mod` 2 == 0)
111 assert (Prelude.length xs == 49900) $
112 return (Prelude.length xs)
114{-# INLINE asyncly_nil #-}
115asyncly_nil :: (A.AsyncT IO Int -> A.AsyncT IO Int -> A.AsyncT IO Int)
116 -> IO Int
117asyncly_nil f = do
118 xs <- A.toList $ do
119 (A.forEachWith f [1..100000:: Int] $
120 \x -> return x >>= return . id)
121 assert (Prelude.length xs == 100000) $
122 return (Prelude.length xs)
124#ifdef EXTRA_BENCHMARKS
125#if MIN_VERSION_transient(0,5,1)
127{-# NOINLINE count #-}
128count :: IORef Int
129count = unsafePerformIO $ newIORef 0
131drop :: (MonadIO m, Alternative m) => Int -> Int -> m Int
132drop num x = do
134 mn <- liftIO $ atomicModifyIORefCAS count $ \n ->
135 if n < num then (n + 1, False) else (n, True)
136 guard mn
137 return x
139tmap :: (a -> Int) -> a -> T.TransIO Int
140tmap = Main.map
142tfilter :: (a -> Bool) -> a -> T.TransIO a
143tfilter = Main.filter
145tdrop :: Int -> Int -> T.TransIO Int
146tdrop = Main.drop
148transient_basic :: IO (Maybe Int)
150transient_basic = T.keep' $ T.threads 0 $ do
151 liftIO $ writeIORef count 0
152 xs <- T.group 49900 $ do
153 T.choose [1..100000 :: Int]
154 >>= tfilter even
155 >>= tmap (+1)
156 >>= tdrop 100
157 >>= tmap (+1)
158 >>= tfilter (\x -> x `mod` 2 == 0)
160 assert (Prelude.length xs == 49900) $
161 T.exit (Prelude.length xs)
163transient_nil :: IO (Maybe Int)
164transient_nil = T.keep' $ T.threads 0 $ do
165 xs <- T.group 49900 $ do
166 T.choose [1..100000 :: Int]
167 assert (Prelude.length xs == 49900) $
168 T.exit (Prelude.length xs)
169#endif
171lfilter :: (Int -> Bool) -> Int -> LT.ListT IO Int
172lfilter = Main.filter
174lmap :: (Int -> Int) -> Int -> LT.ListT IO Int
175lmap = Main.map
177ldrop :: Int -> Int -> LT.ListT IO Int
178ldrop = Main.drop
180list_t_basic :: IO Int
181list_t_basic = do
182 writeIORef count 0
183 xs <- LT.toList $ do
184 LT.fromFoldable [1..100000 :: Int]
185 >>= lfilter even
186 >>= lmap (+1)
187 >>= ldrop 100
188 >>= lmap (+1)
189 >>= lfilter (\x -> x `mod` 2 == 0)
190 assert (Prelude.length xs == 49900) $
191 return (Prelude.length xs)
193lgfilter :: (Int -> Bool) -> Int -> LG.LogicT IO Int
194lgfilter = Main.filter
196lgmap :: (Int -> Int) -> Int -> LG.LogicT IO Int
197lgmap = Main.map
199lgdrop :: Int -> Int -> LG.LogicT IO Int
200lgdrop = Main.drop
202logict_basic :: IO Int
203logict_basic = do
204 writeIORef count 0
205 --xs <- LG.observeManyT 2900 $ do
206 xs <- LG.observeAllT $ do
207 LG.msum $ Prelude.map return [1..100000]
208 >>= lgfilter even
209 >>= lgmap (+1)
210 >>= lgdrop 100
211 >>= lgmap (+1)
212 >>= lgfilter (\x -> x `mod` 2 == 0)
213 assert (Prelude.length xs == 49900) $
214 return (Prelude.length xs)
216simple_conduit_basic :: IO Int
217simple_conduit_basic = do
218 xs <- S.sourceList [1..100000]
219 S.$= S.filterC even
220 S.$= S.mapC ((+1) :: Int -> Int)
221 S.$= S.dropC 100
222 S.$= S.mapC ((+1) :: Int -> Int)
223 S.$= S.filterC (\x -> x `mod` 2 == 0)
224 S.$$ S.sinkList
225 assert (Prelude.length xs == 49900) $
226 return (Prelude.length (xs :: [Int]))
228machines_basic :: IO Int
229machines_basic = do
230 xs <- M.runT $ M.source [1..100000]
231 M.~> M.filtered even
232 M.~> M.mapping (+1)
233 M.~> M.dropping 100
234 M.~> M.mapping (+1)
235 M.~> M.filtered (\x -> x `mod` 2 == 0)
236 assert (Prelude.length xs == 49900) $
237 return (Prelude.length (xs ::[Int]))
238#endif