f56627f · effectful · git.iko.soy

git.iko.soy/effectful

Benchmark multiple implementations of asyncWithUnmask

commitf56627fc01c746426604d7c15b005b73cc90a172 authorAndrzej Rybczak <andrzej@rybczak.net> dateSat 10 Jul 2021, 16:56 (5 years ago) parenta526f2b

5 files changed+115−29

compare with master

unifiedsplit

bench/Concurrency.hs+77 bench/Main.hs+3−1 bench/Unlift.hs+11−27 bench/Utils.hs+20 effectful.cabal+4−1

bench/Concurrency.hsnew file+77

@@ -0,0 +1,77 @@

1+{-# LANGUAGE CPP #-}

2+module Concurrency (concurrencyBenchmark) where

4+#ifdef VERSION_criterion

5+import Criterion

6+import Criterion.Main

7+#endif

9+#ifdef VERSION_tasty_bench

10+import Test.Tasty.Bench hiding (env)

11+#endif

12+

13+import Control.Concurrent.Async

14+import Control.Monad

15+import Control.Monad.IO.Class

16+import qualified Effectful.Async as A

17+

18+import Effectful

19+import Utils

20+

21+concurrencyBenchmark :: Benchmark

22+concurrencyBenchmark = bgroup "concurrency"

23+ [ bench "async (IO)" $ nfAppIO asyncBenchIO (pure 1)

24+ , bgroup "shallow"

25+ [ bench "async (Eff)" $ nfAppIO (runShallow . A.runAsyncE . asyncBench) (pure 1)

26+ , bench "Fork (unlift)" $ nfAppIO (runShallow . runFork1 . forkBench) (pure 1)

27+ , bench "Fork (lift/unlift)" $ nfAppIO (runShallow . runFork2 . forkBench) (pure 1)

28+ ]

29+ , bgroup "deep"

30+ [ bench "async (Eff)" $ nfAppIO (runDeep . A.runAsyncE . asyncBench) (pure 1)

31+ , bench "Fork (unlift)" $ nfAppIO (runDeep . runFork1 . forkBench) (pure 1)

32+ , bench "Fork (lift/unlift)" $ nfAppIO (runDeep . runFork2 . forkBench) (pure 1)

33+ ]

34+ ]

35+

36+----------------------------------------

37+

38+data Fork :: Effect where

39+ ForkWithUnmask :: ((forall a. m a -> m a) -> m r) -> Fork m (Async r)

40+

41+-- | Uses 'localUnliftIO' and 'withLiftSeqOp'.

42+runFork1 :: IOE :> es => Eff (Fork : es) a -> Eff es a

43+runFork1 = interpretM $ \env (ForkWithUnmask m) -> withLiftSeqOp $ \liftSeqOp -> do

44+ localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do

45+ asyncWithUnmask $ \unmask -> unlift $ m $ liftSeqOp unmask

46+

47+-- | Uses 'localLiftUnliftIO', slower than (1).

48+runFork2 :: IOE :> es => Eff (Fork : es) a -> Eff es a

49+runFork2 = interpretM $ \env (ForkWithUnmask m) -> do

50+ localLiftUnliftIO env (ConcUnlift Persistent $ Limited 1) $ \lift unlift -> do

51+ asyncWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift

52+

53+----------------------------------------

54+

55+n :: Int

56+n = 100

57+

58+asyncBenchIO :: IO Int -> IO Int

59+asyncBenchIO f = do

60+ a <- asyncWithUnmask $ \unmask -> do

61+ sum <$> replicateM n (unmask f)

62+ wait a

63+{-# NOINLINE asyncBenchIO #-}

64+

65+asyncBench :: A.AsyncE :> es => Eff es Int -> Eff es Int

66+asyncBench f = do

67+ a <- A.asyncWithUnmask $ \unmask -> do

68+ sum <$> replicateM n (unmask f)

69+ A.wait a

70+{-# NOINLINE asyncBench #-}

71+

72+forkBench :: (IOE :> es, Fork :> es) => Eff es Int -> Eff es Int

73+forkBench f = do

74+ a <- send $ ForkWithUnmask $ \unmask -> do

75+ sum <$> replicateM n (unmask f)

76+ liftIO $ wait a

77+{-# NOINLINE forkBench #-}

bench/Main.hs+3−1

@@ -10,13 +10,15 @@ import Criterion.Main

1010import Test.Tasty.Bench

1111#endif

1212

13+import Concurrency

1314import Countdown

1415import FileSizes

1516import Unlift

1617

1718main :: IO ()

1819main = defaultMain

19− [ unliftBenchmark

20+ [ concurrencyBenchmark

21+ , unliftBenchmark

2022 , bgroup "countdown" $ map countdown [1000, 10000]

2123 , bgroup "filesize" $ map filesize [100, 1000]

2224 ]

bench/Unlift.hs+11−27

@@ -14,6 +14,7 @@ import UnliftIO

1414

1515import Effectful

1616import Effectful.State.Dynamic

17+import Utils

1718

1819unliftBenchmark :: Benchmark

1920unliftBenchmark = bgroup "unlift"

@@ -24,7 +25,7 @@ unliftBenchmark = bgroup "unlift"

2425 ]

2526 , bgroup "shallow"

2627 [ bgroup "dummy"

27− [ bench "seq" $ nfAppIO (runShallow SeqUnlift) benchDummy

28+ [ bench "seq" $ nfAppIO (runShallow . withUnliftStrategy SeqUnlift) benchDummy

2829 , shallowConc "conc" 1 benchDummy

2930 ]

3031 , shallowConc "async" 1 benchAsync

@@ -32,7 +33,7 @@ unliftBenchmark = bgroup "unlift"

3233 ]

3334 , bgroup "deep"

3435 [ bgroup "dummy"

35− [ bench "seq" $ nfAppIO (runDeep SeqUnlift) benchDummy

36+ [ bench "seq" $ nfAppIO (runDeep . withUnliftStrategy SeqUnlift) benchDummy

3637 , deepConc "conc" 1 benchDummy

3738 ]

3839 , deepConc "async" 1 benchAsync

@@ -42,23 +43,6 @@ unliftBenchmark = bgroup "unlift"

4243

4344----------------------------------------

4445

45−runShallow :: UnliftStrategy -> Eff '[IOE] a -> IO a

46−runShallow s = runIOE . withUnliftStrategy s

47−

48−runDeep

49− :: UnliftStrategy

50− -> Eff '[ State (), State (), State (), State (), State ()

51− , State (), State (), State (), State (), State ()

52− , IOE

53− ] a

54− -> IO a

55−runDeep s = runIOE

56− . evalState () . evalState () . evalState () . evalState () . evalState ()

57− . evalState () . evalState () . evalState () . evalState () . evalState ()

58− . withUnliftStrategy s

59−

60−----------------------------------------

61−

6246shallowConc

6347 :: String

6448 -> Int

@@ -66,13 +50,13 @@ shallowConc

6650 -> Benchmark

6751shallowConc name n f = bgroup name

6852 [ bench "ephemeral/limited" $ nfAppIO

69− (runShallow (ConcUnlift Ephemeral $ Limited n)) f

53+ (runShallow . withUnliftStrategy (ConcUnlift Ephemeral $ Limited n)) f

7054 , bench "ephemeral/unlimited" $ nfAppIO

71− (runShallow (ConcUnlift Ephemeral Unlimited)) f

55+ (runShallow . withUnliftStrategy (ConcUnlift Ephemeral Unlimited)) f

7256 , bench "persistent/limited" $ nfAppIO

73− (runShallow (ConcUnlift Persistent $ Limited n)) f

57+ (runShallow . withUnliftStrategy (ConcUnlift Persistent $ Limited n)) f

7458 , bench "persistent/unlimited" $ nfAppIO

75− (runShallow (ConcUnlift Persistent Unlimited)) f

59+ (runShallow . withUnliftStrategy (ConcUnlift Persistent Unlimited)) f

7660 ]

7761

7862deepConc

@@ -84,13 +68,13 @@ deepConc

8468 -> Benchmark

8569deepConc name n f = bgroup name

8670 [ bench "ephemeral/limited" $ nfAppIO

87− (runDeep (ConcUnlift Ephemeral $ Limited n)) f

71+ (runDeep . withUnliftStrategy (ConcUnlift Ephemeral $ Limited n)) f

8872 , bench "ephemeral/unlimited" $ nfAppIO

89− (runDeep (ConcUnlift Ephemeral Unlimited)) f

73+ (runDeep . withUnliftStrategy (ConcUnlift Ephemeral Unlimited)) f

9074 , bench "persistent/limited" $ nfAppIO

91− (runDeep (ConcUnlift Persistent $ Limited n)) f

75+ (runDeep . withUnliftStrategy (ConcUnlift Persistent $ Limited n)) f

9276 , bench "persistent/unlimited" $ nfAppIO

93− (runDeep (ConcUnlift Persistent Unlimited)) f

77+ (runDeep . withUnliftStrategy (ConcUnlift Persistent Unlimited)) f

9478 ]

9579

9680----------------------------------------

bench/Utils.hsnew file+20

@@ -0,0 +1,20 @@

1+module Utils

2+ ( runShallow

3+ , runDeep

4+ ) where

6+import Effectful

7+import Effectful.State.Dynamic

9+runShallow :: Eff '[IOE] a -> IO a

10+runShallow = runIOE

11+

12+runDeep

13+ :: Eff '[ State (), State (), State (), State (), State ()

14+ , State (), State (), State (), State (), State ()

15+ , IOE

16+ ] a

17+ -> IO a

18+runDeep = runIOE

19+ . evalState () . evalState () . evalState () . evalState () . evalState ()

20+ . evalState () . evalState () . evalState () . evalState () . evalState ()

effectful.cabal+4−1

@@ -149,12 +149,15 @@ benchmark bench

149149 , tasty-bench

150150 , unix

151151 , unliftio

152+ , async

152153

153154 hs-source-dirs: bench

154155

155156 type: exitcode-stdio-1.0

156157 main-is: Main.hs

157158

158− other-modules: Countdown

159+ other-modules: Concurrency

160+ Countdown

159161 FileSizes

160162 Unlift

163+ Utils