Merge pull request #347 from fused-effects/get-in-line

Benchmark Reader and inline its requests.

benchmark/Bench.hs

@@ -19,11 +19,13 @@ import           Control.Monad (replicateM_)
 import           Data.Monoid (Sum(..))
 import           Gauge
 
+import qualified Bench.Reader as Reader
 import qualified Bench.NonDet as NonDet
 
 main :: IO ()
 main = defaultMain
-  [ NonDet.benchmark
+  [ Reader.benchmark
+  , NonDet.benchmark
   , bgroup "WriterC"
     [ bench "100"   $ whnf (run . execWriter @(Sum Int) . tellLoop) 100
     , bench "1000"  $ whnf (run . execWriter @(Sum Int) . tellLoop) 1000

benchmark/Bench/Reader.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Bench.Reader
+( benchmark
+) where
+
+import Control.Carrier.Reader
+import Control.Monad
+
+import Gauge hiding (benchmark)
+
+asking :: Has (Reader Char) sig m => Int -> m ()
+asking i = replicateM_ i (ask @Char)
+
+locally :: Has (Reader Char) sig m => Int -> m ()
+locally i = replicateM_ i (local @Char succ (ask @Char))
+
+benchmark :: Gauge.Benchmark
+benchmark = bgroup "Control.Carrier.Reader"
+  [ bgroup "ask"
+    [ bench "10" $ whnf (run . runReader 'a' . asking) 10
+    , bench "100" $ whnf (run . runReader 'b' . asking) 100
+    , bench "1000" $ whnf (run . runReader 'c' . asking) 1000
+    ]
+  , bgroup "local"
+    [ bench "10" $ whnf (run . runReader 'a' . locally) 10
+    , bench "100" $ whnf (run . runReader 'b' . locally) 100
+    , bench "1000" $ whnf (run . runReader 'c' . locally) 1000
+    ]
+  ]

fused-effects.cabal

@@ -181,6 +181,7 @@ benchmark benchmark
   hs-source-dirs: benchmark
   main-is:        Bench.hs
   other-modules:
+    Bench.Reader
     Bench.NonDet
     Bench.NonDet.NQueens
   build-depends:

src/Control/Effect/Reader.hs

@@ -38,6 +38,7 @@ import Control.Effect.Reader.Internal (Reader(..))
 -- @since 0.1.0.0
 ask :: Has (Reader r) sig m => m r
 ask = send (Ask pure)
+{-# INLINE ask #-}
 
 -- | Project a function out of the current environment value.
 --
@@ -48,6 +49,7 @@ ask = send (Ask pure)
 -- @since 0.1.0.0
 asks :: Has (Reader r) sig m => (r -> a) -> m a
 asks f = send (Ask (pure . f))
+{-# INLINE asks #-}
 
 -- | Run a computation with an environment value locally modified by the passed function.
 --
@@ -58,3 +60,4 @@ asks f = send (Ask (pure . f))
 -- @since 0.1.0.0
 local :: Has (Reader r) sig m => (r -> r) -> m a -> m a
 local f m = send (Local f m pure)
+{-# INLINE local #-}

src/Control/Effect/Reader/Labelled.hs

@@ -32,6 +32,7 @@ import           Control.Effect.Reader.Internal
 -- @since 1.0.2.0
 ask :: forall label r m sig . HasLabelled label (Reader r) sig m => m r
 ask = runUnderLabel @label R.ask
+{-# INLINE ask #-}
 
 -- | Project a function out of the current environment value.
 --
@@ -42,6 +43,7 @@ ask = runUnderLabel @label R.ask
 -- @since 1.0.2.0
 asks :: forall label r m a sig . HasLabelled label (Reader r) sig m => (r -> a) -> m a
 asks f = runUnderLabel @label (R.asks f)
+{-# INLINE asks #-}
 
 -- | Run a computation with an environment value locally modified by the passed function.
 --
@@ -52,3 +54,4 @@ asks f = runUnderLabel @label (R.asks f)
 -- @since 1.0.2.0
 local :: forall label r m a sig . HasLabelled label (Reader r) sig m => (r -> r) -> m a -> m a
 local f m = runUnderLabel @label (R.local f (UnderLabel m))
+{-# INLINE local #-}