Benchmarking async

benchmark-async.hs

#!/usr/bin/env stack
-- stack exec ghc --resolver lts-16.2 --package async --package criterion -- -threaded -O2 -rtsopts -with-rtsopts=-N


import           Control.Concurrent.Async (async, mapConcurrently_)
import           Control.Monad            (replicateM_, void)
import           Criterion.Main

main :: IO ()
main = defaultMain
    [
        bgroup "tests" [ bench "sync" $ whnfIO syncTest
                       , bench "async" $ whnfIO asyncTest
                       ]
    ]

xs :: [Int]
xs = [1..35]

syncTest :: IO ()
syncTest = mapM_ dummy xs

asyncTest :: IO ()
asyncTest = mapConcurrently_ dummy xs

dummy :: Int -> IO Int
dummy n = return $! fib n

fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib n = fib (n - 1) + fib (n - 2)

out

% ./bench-async
benchmarking tests/sync
time                 136.8 ms   (134.6 ms .. 139.5 ms)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 136.3 ms   (134.9 ms .. 137.6 ms)
std dev              2.004 ms   (1.385 ms .. 2.704 ms)
variance introduced by outliers: 11% (moderately inflated)

benchmarking tests/async
time                 72.41 ms   (66.39 ms .. 78.85 ms)
                     0.981 R²   (0.954 R² .. 0.994 R²)
mean                 72.74 ms   (69.59 ms .. 78.59 ms)
std dev              6.967 ms   (3.758 ms .. 11.26 ms)
variance introduced by outliers: 34% (moderately inflated)