accursed-state.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                 5.238 μs   (5.168 μs .. 5.339 μs)
                     0.996 R²   (0.991 R² .. 0.999 R²)
mean                 5.280 μs   (5.234 μs .. 5.348 μs)
std dev              178.3 ns   (136.3 ns .. 263.1 ns)
variance introduced by outliers: 15% (moderately inflated)

benchmarked state
time                 9.086 μs   (9.030 μs .. 9.126 μs)
                     0.999 R²   (0.998 R² .. 1.000 R²)
mean                 9.256 μs   (9.215 μs .. 9.354 μs)
std dev              201.8 ns   (105.8 ns .. 373.5 ns)
-}

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

composeN :: Int -> (a -> a) -> (a -> a)
composeN !0 !f x = x
composeN !n !f x = composeN (n - 1) f x

main = do
  let count = 10000

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