bench.hs

module Main where

import Data.Monoid
import Control.Monad
import Criterion.Main
import Data.IORef
import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Concurrent.MVar

modBench :: Int -> IORef Bool -> MVar Bool -> TVar Bool -> TMVar Bool -> Benchmark
modBench n ioref mvar tvar tmvar = bgroup "modify"
    [ bench "modifyIORef'" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ modifyIORef' ioref $ \x -> not x) [1..n]
    , bench "atomicModifyIORef'" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ atomicModifyIORef' ioref $ \x -> (not x, ())) [1..n]
    , bench "modifyMVar_" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ modifyMVar_ mvar $ return . not) [1..n]
    , bench "modifyTVar'" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ atomically $ modifyTVar' tvar not) [1..n]
    , bench "putTMVar . takeTMVar" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ atomically $ takeTMVar tmvar >>= \x -> putTMVar tmvar $! not x) [1..n]
    ]

readBench :: Int -> IORef Bool -> MVar Bool -> TVar Bool -> TMVar Bool -> Benchmark
readBench n ioref mvar tvar tmvar = bgroup "read"
    [ bench "readIORef'" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ readIORef ioref) [1..n]
    , bench "readMVar" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ readMVar mvar) [1..n]
    , bench "readTVarIO" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ readTVarIO tvar) [1..n]
    , bench "atomically . readTVar" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ atomically $ readTVar tvar) [1..n]
    , bench "readTMVar" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ atomically $ readTMVar tmvar) [1..n]
    ]

writeBench :: Int -> IORef Bool -> MVar Bool -> TVar Bool -> TMVar Bool -> Benchmark
writeBench n ioref mvar tvar tmvar = bgroup "write"
    [ bench "writeIORef" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ writeIORef ioref True) [1..n]
    , bench "atomicWriteIORef" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ atomicWriteIORef ioref True) [1..n]
--    , bench "swapMVar" $ whnfIO $
--          mapConcurrently (const $ replicateM_ (8192 `div` n) $ swapMVar mvar True) [1..100]
    , bench "writeTVar" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ atomically $ writeTVar tvar True) [1..n]
    , bench "swapTMVar" $ whnfIO $
          mapConcurrently (const $ replicateM_ (8192 `div` n) $ atomically $ swapTMVar tmvar True) [1..n]
    ]

main :: IO ()
main = do
    ioref <- newIORef True
    mvar <- newMVar True
    tvar <- newTVarIO True
    tmvar <- newTMVarIO True
    defaultMain $ do
        n <- [2^m | m <- [0..7]]
        return $ bgroup (show n <> " threads") $
            [ bench "mapConcurrently" $ whnfIO $ mapConcurrently (const $ return ()) [1..n]
            , modBench n ioref mvar tvar tmvar
            , readBench n ioref mvar tvar tmvar
            , writeBench n ioref mvar tvar tmvar
            ]