1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156
|
module Main where
import Control.Exception (SomeException(..))
import Test.Tasty.Bench (bench, bgroup, defaultMain, nfIO, whnfIO)
import qualified Control.Concurrent.Async as A
import qualified Control.Concurrent.Async.Lifted as L
import qualified Control.Concurrent.Async.Lifted.Safe as LS
main :: IO ()
main = defaultMain
[ bgroup "async-wait"
[ bench "async" $ whnfIO asyncWait_async
, bench "lifted-async" $ whnfIO asyncWait_liftedAsync
, bench "lifted-async-safe" $ whnfIO asyncWait_liftedAsyncSafe
]
-- , bgroup "async-cancel-waitCatch"
-- [ bench "async" $ whnfIO asyncCancelWaitCatch_async
-- , bench "lifted-async" $ whnfIO asyncCancelWaitCatch_liftedAsync
-- , bench "lifted-async-safe" $ whnfIO asyncCancelWaitCatch_liftedAsyncSafe
-- ]
, bgroup "waitAny"
[ bench "async" $ whnfIO waitAny_async
, bench "lifted-async" $ whnfIO waitAny_liftedAsync
, bench "lifted-async-safe" $ whnfIO waitAny_liftedAsyncSafe
]
, bgroup "race"
[ bench "async" $ nfIO race_async
, bench "lifted-async" $ nfIO race_liftedAsync
, bench "lifted-async-safe" $ nfIO race_liftedAsyncSafe
, bench "async (inlined)" $ nfIO race_async_inlined
, bench "lifted-async (inlined)" $ nfIO race_liftedAsync_inlined
]
, bgroup "concurrently"
[ bench "async" $ nfIO concurrently_async
, bench "lifted-async" $ nfIO concurrently_liftedAsync
, bench "lifted-async-safe" $ nfIO concurrently_liftedAsyncSafe
, bench "async (inlined)" $ nfIO concurrently_async_inlined
, bench "lifted-async (inlined)" $ nfIO concurrently_liftedAsync_inlined
]
, bgroup "mapConcurrently"
[ bench "async" $ nfIO mapConcurrently_async
, bench "lifted-async" $ nfIO mapConcurrently_liftedAsync
, bench "lifted-async-safe" $ nfIO mapConcurrently_liftedAsyncSafe
]
]
asyncWait_async :: IO Int
asyncWait_async = do
a <- A.async (return 1)
A.wait a
asyncWait_liftedAsync :: IO Int
asyncWait_liftedAsync = do
a <- L.async (return 1)
L.wait a
asyncWait_liftedAsyncSafe :: IO Int
asyncWait_liftedAsyncSafe = do
a <- LS.async (return 1)
LS.wait a
asyncCancelWaitCatch_async :: IO (Either SomeException Int)
asyncCancelWaitCatch_async = do
a <- A.async (return 1)
A.cancel a
A.waitCatch a
asyncCancelWaitCatch_liftedAsync :: IO (Either SomeException Int)
asyncCancelWaitCatch_liftedAsync = do
a <- L.async (return 1)
L.cancel a
L.waitCatch a
asyncCancelWaitCatch_liftedAsyncSafe :: IO (Either SomeException Int)
asyncCancelWaitCatch_liftedAsyncSafe = do
a <- LS.async (return 1)
LS.cancel a
LS.waitCatch a
waitAny_async :: IO Int
waitAny_async = do
as <- mapM (A.async . return) [1..10]
(_, n) <- A.waitAny as
return n
waitAny_liftedAsync :: IO Int
waitAny_liftedAsync = do
as <- mapM (L.async . return) [1..10]
(_, n) <- L.waitAny as
return n
waitAny_liftedAsyncSafe :: IO Int
waitAny_liftedAsyncSafe = do
as <- mapM (LS.async . return) [1..10]
(_, n) <- LS.waitAny as
return n
race_async :: IO (Either Int Int)
race_async =
A.race (return 1) (return 2)
race_liftedAsync :: IO (Either Int Int)
race_liftedAsync =
L.race (return 1) (return 2)
race_liftedAsyncSafe :: IO (Either Int Int)
race_liftedAsyncSafe =
LS.race (return 1) (return 2)
race_async_inlined :: IO (Either Int Int)
race_async_inlined =
A.withAsync (return 1) $ \a ->
A.withAsync (return 2) $ \b ->
A.waitEither a b
race_liftedAsync_inlined :: IO (Either Int Int)
race_liftedAsync_inlined =
L.withAsync (return 1) $ \a ->
L.withAsync (return 2) $ \b ->
L.waitEither a b
concurrently_async :: IO (Int, Int)
concurrently_async =
A.concurrently (return 1) (return 2)
concurrently_liftedAsync :: IO (Int, Int)
concurrently_liftedAsync =
L.concurrently (return 1) (return 2)
concurrently_liftedAsyncSafe :: IO (Int, Int)
concurrently_liftedAsyncSafe =
LS.concurrently (return 1) (return 2)
concurrently_async_inlined :: IO (Int, Int)
concurrently_async_inlined =
A.withAsync (return 1) $ \a ->
A.withAsync (return 2) $ \b ->
A.waitBoth a b
concurrently_liftedAsync_inlined :: IO (Int, Int)
concurrently_liftedAsync_inlined =
L.withAsync (return 1) $ \a ->
L.withAsync (return 2) $ \b ->
L.waitBoth a b
mapConcurrently_async :: IO [Int]
mapConcurrently_async =
A.mapConcurrently return [1..10]
mapConcurrently_liftedAsync :: IO [Int]
mapConcurrently_liftedAsync =
L.mapConcurrently return [1..10]
mapConcurrently_liftedAsyncSafe :: IO [Int]
mapConcurrently_liftedAsyncSafe =
LS.mapConcurrently return [1..10]
|