benchmark

_output

benchmarking pure/SS
time                 8.744 ns   (8.708 ns .. 8.782 ns)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 8.748 ns   (8.719 ns .. 8.813 ns)
std dev              147.4 ps   (87.72 ps .. 285.9 ps)
variance introduced by outliers: 24% (moderately inflated)

benchmarking pure/CS
time                 8.709 ns   (8.700 ns .. 8.719 ns)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 8.704 ns   (8.692 ns .. 8.717 ns)
std dev              39.69 ps   (33.87 ps .. 47.35 ps)

benchmarking pure/ES
time                 8.771 ns   (8.761 ns .. 8.782 ns)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 8.776 ns   (8.762 ns .. 8.792 ns)
std dev              47.47 ps   (37.27 ps .. 66.83 ps)

benchmarking IO/SSIO
time                 1.139 ms   (1.135 ms .. 1.144 ms)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 1.147 ms   (1.141 ms .. 1.154 ms)
std dev              22.20 μs   (17.91 μs .. 27.57 μs)

benchmarking IO/CSIO
time                 1.123 ms   (1.118 ms .. 1.129 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 1.122 ms   (1.118 ms .. 1.128 ms)
std dev              15.49 μs   (10.25 μs .. 27.76 μs)

benchmarking IO/ESIO
time                 8.496 ns   (8.486 ns .. 8.504 ns)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 8.495 ns   (8.481 ns .. 8.511 ns)
std dev              50.99 ps   (42.22 ps .. 66.27 ps)

StateBench.hs

{-# LANGUAGE FlexibleContexts, TypeOperators #-}
import qualified Control.Monad.State.Strict as SS
import qualified CState as CS
import qualified Control.Eff.State.Strict as ES
import Criterion.Main
import Control.Monad
import Control.Monad.State.Class
import Data.Functor.Identity
import Control.Eff
import Data.Typeable
import Control.Eff.Lift as E

loopN = 500
objN = 3000

xs = [i*2|i<-[1..objN]]

-- 8.7ns
updateSS :: [Int] -> Int
updateSS = sum . fmap (SS.execState go) where
  go :: SS.State Int ()
  go = forM_ [1..loopN] $ \i -> modify (+i)

-- 8.7ns
updateCS :: [Int] -> Int
updateCS = sum . fmap (CS.execState go) where
  go :: CS.State Int ()
  go = forM_ [1..loopN] $ \i -> modify (+i)

-- 8.7ns
updateES :: [Int] -> Int
updateES = sum . fmap (run . \x -> ES.execState x go) where
  go :: (Member (ES.State Int) r) => Eff r ()
  go = forM_ [1..loopN] $ \i -> ES.modify (+i)

{-
-- 100~ ms
updateSSIO :: [Int] -> IO Int
updateSSIO = fmap sum . mapM (\k -> SS.execStateT go $ k) where
  go :: SS.StateT Int IO ()
  go = forM_ [1..loopN] $ \i -> modify (+i)
-}

-- 1.13 ms
updateSSIO :: [Int] -> IO Int
updateSSIO = fmap sum . mapM (\k -> SS.execStateT go $! k) where
  go :: SS.StateT Int IO ()
  go = forM_ [1..loopN] $ \i -> modify (+i)

-- 1.11 ms
updateCSIO :: [Int] -> IO Int
updateCSIO = fmap sum . mapM (\k -> CS.execStateT go $! k) where
  go :: CS.StateT Int IO ()
  go = forM_ [1..loopN] $ \i -> modify (+i)

-- 8.6ns
updateESIO :: [Int] -> IO Int
updateESIO = fmap sum . mapM (runLift . \x -> ES.execState x go) where
  go :: Eff (ES.State Int :> Lift IO :> ()) ()
  go = forM_ [1..loopN] $ \i -> ES.modify (+i)

{-
main = do
  print $ updateSS xs
  print $ updateCS xs
  print $ updateES xs
  print =<< updateSSIO xs
  print =<< updateCSIO xs
  print =<< updateESIO xs
-}

main = defaultMain [
  bgroup "pure" [
    bench "SS" (whnf id $ updateSS xs)
  , bench "CS" (whnf id $ updateCS xs)
  , bench "ES" (whnf id $ updateES xs)
  ],
  bgroup "IO" [
    bench "SSIO" (whnfIO $ updateSSIO xs)
  , bench "CSIO" (whnfIO $ updateCSIO xs)
  , bench "ESIO" (whnf id $ updateESIO xs)
  ]
  ]