accursed-bench.hs

{-# LANGUAGE BangPatterns #-}
import Gauge.Main
import Control.Monad
import Control.Monad.State.Strict
import qualified Data.Vector.Unboxed.Mutable as V
import Data.ByteString.Internal (accursedUnutterablePerformIO)

{-
benchmarked accursed
time                 136.3 μs   (135.7 μs .. 137.0 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 135.9 μs   (135.6 μs .. 136.1 μs)
std dev              834.5 ns   (648.9 ns .. 1.084 μs)

benchmarked io
time                 137.2 μs   (136.9 μs .. 137.6 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 136.6 μs   (136.4 μs .. 136.9 μs)
std dev              752.2 ns   (618.8 ns .. 931.7 ns)

benchmarked state
time                 50.82 μs   (50.50 μs .. 51.15 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 50.85 μs   (50.72 μs .. 51.02 μs)
std dev              509.8 ns   (405.8 ns .. 740.3 ns)
-}

umodify :: V.Unbox a => Int -> (a -> a) -> V.IOVector a -> V.IOVector a
umodify !i !f !vec =
  accursedUnutterablePerformIO $ V.unsafeModify vec f i >> return vec

composeN :: Int -> (a -> a) -> (a -> a)
composeN n f x = loop n x
 where
  loop n x | n <= 0    = x
           | otherwise = loop (n - 1) (f x)

main = do
  let count = 100000

  avec <- V.replicate 1 (0 :: Int)
  io   <- V.replicate 1 (0 :: Int)
  defaultMain
    [ bench "accursed" $ nf (\c -> composeN c (umodify 0 (+ 1)) avec) count
    , bench "io" $ nfAppIO (\c -> replicateM_ c (V.modify io (+ 1) 0)) count
    , bench "state" $ nf
      (\c -> flip execState (0 :: Int) $ replicateM_ c $ modify' (+ 1))
      count
    ]