RwoR_bench.hs

-- https://github.com/ekmett/free/tree/35467bea6916a2efdd7182d071751af685344b1a

import Control.Monad.Identity
import qualified Control.Monad.Trans.Iter as I
import qualified Control.Monad.Trans.Iter.Reflection as R
import Control.Monad.State
import Data.IORef

destruct :: I.IterT IO a -> IO a
destruct m = do
    h <- I.runIterT m
    case h of
        Left a -> return a
        Right m' -> destruct m'

destruct' :: R.IterT IO a -> IO a
destruct' m = do
    h <- R.view m
    case h of
        R.Pure a -> return a
        R.Iter m' -> destruct' m'

constructBad :: Monad m => Int -> I.IterT m Int
constructBad n = foldl (\m n -> I.delay m >>= return . (n +)) (return 0) [1..n]

constructBad' :: Monad m => Int -> R.IterT m Int
constructBad' n = foldl (\m n -> R.unview (return (R.Iter m)) >>= return . (n +)) (return 0) [1..n]

-- test 8192 --> 9.52s (ghc -O2)
test :: Int -> IO Int
test n = destruct $ constructBad n 

-- test' 8192 --> 0.02s (ghc -O2)
test' :: Int -> IO Int
test' n = destruct' $ constructBad' n