some basic multistate benchmarking

A_multistate-benchmark.txt

------------------
run-time: criterion results
------------------

benchmarking extensible-effects
time                 1.337 s    (1.308 s .. 1.387 s)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 1.314 s    (1.304 s .. 1.322 s)
std dev              13.22 ms   (0.0 s .. 14.55 ms)
variance introduced by outliers: 19% (moderately inflated)

benchmarking vipervm-multistate
time                 358.2 ms   (296.6 ms .. 390.4 ms)
                     0.996 R²   (0.992 R² .. 1.000 R²)
mean                 362.1 ms   (351.6 ms .. 368.2 ms)
std dev              9.461 ms   (0.0 s .. 10.58 ms)
variance introduced by outliers: 19% (moderately inflated)

benchmarking multistate
time                 21.93 ms   (21.27 ms .. 22.39 ms)
                     0.995 R²   (0.987 R² .. 0.999 R²)
mean                 22.69 ms   (22.24 ms .. 23.68 ms)
std dev              1.525 ms   (787.4 μs .. 2.552 ms)
variance introduced by outliers: 28% (moderately inflated)


------------------
memory: single-execution +RTS -s statistics:
------------------

(this is not on-top the criterion execution, but on a plain, single execution
 of the tested block, compiled separately into an executable.)

extensible-effects:

  45,571,495,080 bytes allocated in the heap
      77,064,560 bytes copied during GC
          44,312 bytes maximum residency (2 sample(s))
          26,408 bytes maximum slop
               1 MB total memory in use (0 MB lost due to fragmentation)

vipervm-multistate (using HArray)

   5,483,251,584 bytes allocated in the heap
     651,801,144 bytes copied during GC
         254,992 bytes maximum residency (599 sample(s))
          31,504 bytes maximum slop
               2 MB total memory in use (0 MB lost due to fragmentation)

multistate

     935,604,888 bytes allocated in the heap
      32,588,720 bytes copied during GC
         142,520 bytes maximum residency (2 sample(s))
          22,536 bytes maximum slop
               1 MB total memory in use (0 MB lost due to fragmentation)

Bench.hs

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}

module Main where

import Criterion.Main
import Control.Monad
import Control.Monad.Writer
import Control.Monad.Reader
import Control.Monad.Cont

import GHC.Generics (Generic)
import Control.DeepSeq

import Data.Functor.Identity

import Control.Monad.Trans.MultiState.Lazy

import Control.Eff
import Control.Eff.State.Lazy as State

import qualified ViperVM.Utils.MultiState as VVMMS
import qualified ViperVM.Utils.HArray as HArray

main = defaultMain
    [ bench "extensible-effects" $ nf ee    (0, -0.00001)
    , bench "vipervm-multistate" $ nf vvmms (0, -0.00001)
    , bench "multistate"         $ nf ms    (0, -0.00001)
    ]

newtype A = A Float deriving (Show, Generic)
newtype B = B Float deriving (Show, Generic)
newtype C = C Float deriving (Show, Generic)
newtype I = I Int   deriving (Show, Generic)

instance NFData A
instance NFData B
instance NFData C
instance NFData I

ms :: (Int, Float) -> (A, (B, (C, (I, Float))))
ms (i, a) = runIdentity
        $ runMultiStateTNil
        $ withMultiStateSA (A $ a)
        $ withMultiStateSA (B $ 0.0)
        $ withMultiStateSA (C $ 0.0)
        $ withMultiStateSA (I $ i)
        $ step
  where
    step = do
      C c <- mGet
      if c>=100.0
        then return c
        else do
          replicateM_ 1000 $ do
            A !a <- mGet
            mSet $! A $ a + 0.0000000001
            B !b <- mGet
            mSet $! B $ b + a
            C !c <- mGet
            mSet $! C $ c + b
            I !i <- mGet
            mSet $! I $ i + 1
          step

ee :: (Int, Float) -> (A, (B, (C, (I, Float))))
ee (i, a) = run
        $ runState (A $ a)
        $ runState (B $ 0.0)
        $ runState (C $ 0.0)
        $ runState (I $ i)
        $ step
  where
    step = do
      C c <- State.get
      if c>=100.0
        then return c
        else do
          replicateM_ 1000 $ do
            A !a <- State.get
            State.put $! A $ a + 0.0000000001
            B !b <- State.get
            State.put $! B $ b + a
            C !c <- State.get
            State.put $! C $ c + b
            I !i <- State.get
            State.put $! I $ i + 1
          step

vvmms :: (Int, Float) -> (A, (B, (C, (I, Float))))
vvmms (i, a) = case VVMMS.runMState step iArr of
  (x, arr) -> (HArray.getHArrayT arr, (HArray.getHArrayT arr, (HArray.getHArrayT arr, (HArray.getHArrayT arr, x))))
 where
  iArr = HArray.prependHArray (A a)
       $ HArray.prependHArray (B 0)
       $ HArray.prependHArray (C 0)
       $ HArray.prependHArray (I i)
       $ HArray.emptyHArray
  step = do
    C c <- VVMMS.mGet
    if c>=100.0
      then return c
      else do
        replicateM_ 1000 $ do
          A !a <- VVMMS.mGet
          VVMMS.mSet $! A $ a + 0.0000000001
          B !b <- VVMMS.mGet
          VVMMS.mSet $! B $ b + a
          C !c <- VVMMS.mGet
          VVMMS.mSet $! C $ c + b
          I !i <- VVMMS.mGet
          VVMMS.mSet $! I $ i + 1
        step