Comparing the GHC optimizer on MTL vs Capability

capability-mtl.md

Comparing the GHC optimizer on MTL vs Capability

Only considering very simple examples. GHC Core produced with the following alias and passing -O.

alias ghc-core="ghc -ddump-simpl -dsuppress-idinfo \
    -dsuppress-coercions -dsuppress-type-applications \
    -dsuppress-uniques -dsuppress-module-prefixes"

MTL Reader State Stack

Uses StateT on Reader to provide MonadState and MonadReader.

{-# LANGUAGE FlexibleContexts #-}

module MtlReaderState where

import Control.Monad.Reader
import Control.Monad.State


addCtx :: (MonadReader Int m, MonadState Int m) => m ()
addCtx = ask >>= modify' . (+)

app :: Int -> Int -> Int
app r s = runReader (execStateT addCtx s) r

-- -- RHS size: {terms: 12, types: 6, coercions: 0, joins: 0/0}
-- app :: Int -> Int -> Int
-- app
--   = \ (r :: Int) (s :: Int) ->
--       case r of { I# x -> case s of { I# y -> I# (+# x y) } }

Capability using MTL underneath

Capability has strategies to use MTL's MonadReader and MonadState directly to provide HasReader and HasState. The generated Core is identical to the MTL example above.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeInType #-}

module CapMtlReaderState where

import Capability.Reader
import Capability.State
import Control.Monad.Reader (Reader, ReaderT (..))
import Control.Monad.State (StateT (..))
import Data.Functor.Identity (Identity (..))


addCtx :: (HasReader "r" Int m, HasState "s" Int m) => m ()
addCtx = ask @"r" >>= modify' @"s" . (+)

newtype AppM a = AppM { runAppM :: Int -> Int -> (a, Int) }
  deriving (Functor, Applicative, Monad) via StateT Int (Reader Int)
  deriving (HasReader "r" Int) via MonadReader (StateT Int (Reader Int))
  deriving (HasState "s" Int) via MonadState (StateT Int (Reader Int))

app :: Int -> Int -> Int
app r s = snd $ runAppM addCtx s r

-- -- RHS size: {terms: 12, types: 6, coercions: 0, joins: 0/0}
-- app :: Int -> Int -> Int
-- app
--   = \ (r :: Int) (s :: Int) ->
--       case r of { I# x -> case s of { I# y -> I# (+# x y) } }

Capability using ReaderT pattern

Lastly, using the ReaderT pattern to provide HasReader and HasState. The ReaderT environment holds a record of two fields. The first field carries the value for HasReader, the second field carries a mutable reference (IOPRef from mutable-containers) for HasState. Core shows that GHC erased all capability and generic-lens code.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeInType #-}

module CapMtlReaderState where

import Capability.Reader
import Capability.State
import Control.Monad.Reader (ReaderT (..))
import Data.Mutable
import GHC.Generics (Generic)


addCtx :: (HasReader "r" Int m, HasState "s" Int m) => m ()
addCtx = ask @"r" >>= modify' @"s" . (+)

data Ctx = Ctx { ctxInt :: !Int, ctxRef :: !(IOPRef Int) }
  deriving Generic

newtype AppM a = AppM { runAppM :: Ctx -> IO a }
  deriving (Functor, Applicative, Monad) via ReaderT Ctx IO
  deriving (HasReader "r" Int) via
    Rename "ctxInt" (Field "ctxInt" "ctx" (MonadReader (ReaderT Ctx IO)))
  deriving (HasState "s" Int) via
    Rename "ctxRef" (ReaderRef (Field "ctxRef" "ctx" (MonadReader (ReaderT Ctx IO))))

app :: Int -> Int -> IO Int
app r s = do
  ref <- newRef s
  let ctx = Ctx { ctxInt = r, ctxRef = ref }
  runAppM addCtx ctx
  readRef ref

-- -- RHS size: {terms: 46, types: 120, coercions: 228, joins: 0/0}
-- app1
--   :: Int -> Int -> State# RealWorld -> (# State# RealWorld, Int #)
-- app1
--   = \ (w :: Int) (w1 :: Int) (w2 :: State# RealWorld) ->
--       case w of { I# ww1 ->
--       case w1 of { I# ww3 ->
--       case newByteArray# 8# (w2 `cast` <Co:16>) of { (# ipv, ipv1 #) ->
--       case writeIntArray# ipv1 0# ww3 ipv of s'# { __DEFAULT ->
--       case readIntArray# (ipv1 `cast` <Co:25>) 0# (s'# `cast` <Co:78>) of
--       { (# ipv2, ipv3 #) ->
--       case writeIntArray# (ipv1 `cast` <Co:25>) 0# (+# ww1 ipv3) ipv2
--       of s'#1
--       { __DEFAULT ->
--       case readIntArray# ipv1 0# (s'#1 `cast` <Co:72>) of
--       { (# ipv4, ipv5 #) ->
--       (# ipv4, I# ipv5 #) `cast` <Co:12>
--       }
--       }
--       }
--       }
--       }
--       }
--       }
-- 
-- -- RHS size: {terms: 1, types: 0, coercions: 7, joins: 0/0}
-- app :: Int -> Int -> IO Int
-- app = app1 `cast` <Co:7>