Effect benchmarks

bench/Main.hs

@@ -105,7 +105,7 @@ csvRules s =
               | (v, r) <- zipExact (s ^. suiteVariants) rows
             ]
           header' = "Color," <> header
-      writeFile (toFilePath csv) (Text.unlines (header' : rows'))
+      writeFileEnsureLn csv (Text.unlines (header' : rows'))
 
 fromSuite :: Suite -> [Benchmark]
 fromSuite s = map go (s ^. suiteVariants)

bench2/Benchmark/Effect.hs

@@ -0,0 +1,19 @@
+module Benchmark.Effect where
+
+import Benchmark.Effect.EmbedIO qualified as EmbedIO
+import Benchmark.Effect.Output qualified as Output
+import Benchmark.Effect.Reader qualified as Reader
+import Benchmark.Effect.ReaderH qualified as ReaderH
+import Benchmark.Effect.State qualified as State
+import Test.Tasty.Bench
+
+bm :: Benchmark
+bm =
+  bgroup
+    "Effect"
+    [ Output.bm,
+      State.bm,
+      ReaderH.bm,
+      EmbedIO.bm,
+      Reader.bm
+    ]

bench2/Benchmark/Effect/EmbedIO.hs

@@ -0,0 +1,46 @@
+module Benchmark.Effect.EmbedIO where
+
+import Juvix.Prelude
+import Juvix.Prelude.Effects (Eff)
+import Juvix.Prelude.Effects qualified as E
+import Test.Tasty.Bench
+
+bm :: Benchmark
+bm =
+  bgroup
+    "Embed IO"
+    [ bench "Raw IO" $ nfAppIO countRaw k,
+      bench "Eff RIO" $ nfAppIO countEff k,
+      bench "Sem Embed IO" $ nfAppIO countSem k
+    ]
+
+k :: Natural
+k = 2 ^ (23 :: Natural)
+
+c :: Char
+c = 'x'
+
+countRaw :: Natural -> IO ()
+countRaw n =
+  withSystemTempFile "tmp" $ \_ h -> go h n
+  where
+    go :: Handle -> Natural -> IO ()
+    go h = \case
+      0 -> return ()
+      a -> hPutChar h c >> go h (pred a)
+
+countSem :: Natural -> IO ()
+countSem n = withSystemTempFile "tmp" $ \_ h -> runM (go h n)
+  where
+    go :: Handle -> Natural -> Sem '[Embed IO] ()
+    go h = \case
+      0 -> return ()
+      a -> liftIO (hPutChar h c) >> go h (pred a)
+
+countEff :: Natural -> IO ()
+countEff n = withSystemTempFile "tmp" $ \_ h -> E.runEff (go h n)
+  where
+    go :: Handle -> Natural -> Eff '[E.IOE] ()
+    go h = \case
+      0 -> return ()
+      a -> liftIO (hPutChar h c) >> go h (pred a)

bench2/Benchmark/Effect/Output.hs

@@ -0,0 +1,51 @@
+module Benchmark.Effect.Output where
+
+import Juvix.Prelude
+import Juvix.Prelude.Effects (Eff, (:>))
+import Juvix.Prelude.Effects qualified as E
+import Test.Tasty.Bench
+
+bm :: Benchmark
+bm =
+  bgroup
+    "Output"
+    [ bench "Eff Output (Dynamic)" $ nf countdownEff k,
+      bench "Eff Accum (Static)" $ nf countdownAccum k,
+      bench "Sem Output" $ nf countdownSem k,
+      bench "Raw Output" $ nf countdownRaw k
+    ]
+
+k :: Natural
+k = 2 ^ (22 :: Natural)
+
+countdownRaw :: Natural -> Natural
+countdownRaw = sum' . reverse . go []
+  where
+    go :: [Natural] -> Natural -> [Natural]
+    go acc = \case
+      0 -> acc
+      m -> go (m : acc) (pred m)
+
+countdownAccum :: Natural -> Natural
+countdownAccum = sum' . E.runPureEff . E.execAccumList . go
+  where
+    go :: (E.Accum Natural :> r) => Natural -> Eff r ()
+    go = \case
+      0 -> return ()
+      m -> E.accum m >> go (pred m)
+
+countdownEff :: Natural -> Natural
+countdownEff = sum' . E.runPureEff . E.execOutputList . go
+  where
+    go :: (E.Output Natural :> r) => Natural -> Eff r ()
+    go = \case
+      0 -> return ()
+      m -> E.output m >> go (pred m)
+
+countdownSem :: Natural -> Natural
+countdownSem = sum' . run . execOutputList . go
+  where
+    go :: (Members '[Output Natural] r) => Natural -> Sem r ()
+    go = \case
+      0 -> return ()
+      m -> output m >> go (pred m)

bench2/Benchmark/Effect/Reader.hs

@@ -0,0 +1,49 @@
+module Benchmark.Effect.Reader where
+
+import Juvix.Prelude
+import Juvix.Prelude.Effects (Eff, (:>))
+import Juvix.Prelude.Effects qualified as E
+import Test.Tasty.Bench
+
+bm :: Benchmark
+bm =
+  bgroup
+    "Reader (First order)"
+    [ bench "Eff Reader (Static)" $ nf countEff k,
+      bench "Sem Reader" $ nf countSem k,
+      bench "Raw Reader" $ nf countRaw k
+    ]
+
+k :: Natural
+k = 2 ^ (21 :: Natural)
+
+c :: Natural
+c = 5
+
+countRaw :: Natural -> Natural
+countRaw = sum' . go []
+  where
+    go :: [Natural] -> Natural -> [Natural]
+    go acc = \case
+      0 -> acc
+      m -> go (c : acc) (pred m)
+
+countEff :: Natural -> Natural
+countEff = sum' . E.runPureEff . E.runReader c . go []
+  where
+    go :: (E.Reader Natural :> r) => [Natural] -> Natural -> Eff r [Natural]
+    go acc = \case
+      0 -> return acc
+      n -> do
+        i <- E.ask
+        go (i : acc) (pred n)
+
+countSem :: Natural -> Natural
+countSem = sum' . run . runReader c . go []
+  where
+    go :: (Member (Reader Natural) r) => [Natural] -> Natural -> Sem r [Natural]
+    go acc = \case
+      0 -> return acc
+      n -> do
+        i <- ask
+        go (i : acc) (pred n)

bench2/Benchmark/Effect/ReaderH.hs

@@ -0,0 +1,46 @@
+module Benchmark.Effect.ReaderH where
+
+import Juvix.Prelude
+import Juvix.Prelude.Effects (Eff, (:>))
+import Juvix.Prelude.Effects qualified as E
+import Test.Tasty.Bench
+
+bm :: Benchmark
+bm =
+  bgroup
+    "Reader (Higher order)"
+    [ bench "Eff Reader (Static)" $ nf countEff k,
+      bench "Sem Reader" $ nf countSem k,
+      bench "Raw Reader" $ nf countRaw k
+    ]
+
+k :: Natural
+k = 2 ^ (21 :: Natural)
+
+countRaw :: Natural -> Natural
+countRaw = sum' . go []
+  where
+    go :: [Natural] -> Natural -> [Natural]
+    go acc = \case
+      0 -> acc
+      m -> go (m : acc) (pred m)
+
+countEff :: Natural -> Natural
+countEff x = sum' . E.runPureEff . E.runReader x $ go []
+  where
+    go :: (E.Reader Natural :> r) => [Natural] -> Eff r [Natural]
+    go acc = do
+      n <- E.ask
+      case n of
+        0 -> return acc
+        m -> E.local @Natural pred (go (m : acc))
+
+countSem :: Natural -> Natural
+countSem x = sum . run . runReader x $ go []
+  where
+    go :: (Members '[Reader Natural] r) => [Natural] -> Sem r [Natural]
+    go acc = do
+      n :: Natural <- ask
+      case n of
+        0 -> return acc
+        m -> local @Natural pred (go (m : acc))

bench2/Benchmark/Effect/State.hs

@@ -0,0 +1,42 @@
+module Benchmark.Effect.State where
+
+import Juvix.Prelude
+import Juvix.Prelude.Effects (Eff, (:>))
+import Juvix.Prelude.Effects qualified as E
+import Test.Tasty.Bench
+
+bm :: Benchmark
+bm =
+  bgroup
+    "State"
+    [ bench "Eff State (Static)" $ nf countEff k,
+      bench "Sem State" $ nf countSem k,
+      bench "Raw State" $ nf countRaw k
+    ]
+
+k :: Natural
+k = 2 ^ (22 :: Natural)
+
+countRaw :: Natural -> Natural
+countRaw = go 0
+  where
+    go :: Natural -> Natural -> Natural
+    go acc = \case
+      0 -> acc
+      m -> go (acc + m) (pred m)
+
+countEff :: Natural -> Natural
+countEff = E.runPureEff . E.execState 0 . go
+  where
+    go :: (E.State Natural :> r) => Natural -> Eff r ()
+    go = \case
+      0 -> return ()
+      m -> E.modify (+ m) >> go (pred m)
+
+countSem :: Natural -> Natural
+countSem = run . execState 0 . go
+  where
+    go :: (Members '[State Natural] r) => Natural -> Sem r ()
+    go = \case
+      0 -> return ()
+      m -> modify (+ m) >> go (pred m)

bench2/Main.hs

@@ -0,0 +1,11 @@
+module Main where
+
+import Benchmark.Effect qualified as Effect
+import Juvix.Prelude
+import Test.Tasty.Bench
+
+main :: IO ()
+main =
+  defaultMain
+    [ Effect.bm
+    ]

package.yaml

@@ -162,6 +162,15 @@ library:
     default-language: GHC2021
 
 executables:
+  juvixbench:
+    main: Main.hs
+    source-dirs: bench2
+    dependencies:
+      - juvix
+      - tasty-bench == 0.3.*
+    verbatim:
+      default-language: GHC2021
+
   juvix:
     main: Main.hs
     source-dirs: app

src/Juvix/Prelude/Effects.hs

@@ -1,8 +1,10 @@
 module Juvix.Prelude.Effects
   ( module Juvix.Prelude.Effects.Output,
     module Juvix.Prelude.Effects.Base,
+    module Juvix.Prelude.Effects.Accum,
   )
 where
 
+import Juvix.Prelude.Effects.Accum
 import Juvix.Prelude.Effects.Base
 import Juvix.Prelude.Effects.Output

src/Juvix/Prelude/Effects/Accum.hs

@@ -17,6 +17,9 @@ runAccumList m = do
   (a, Accum s) <- runStaticRep (Accum mempty) m
   return (reverse s, a)
 
+execAccumList :: Eff (Accum o ': r) a -> Eff r [o]
+execAccumList = fmap fst . runAccumList
+
 ignoreAccum :: Eff (Accum o ': r) a -> Eff r a
 ignoreAccum m = snd <$> runAccumList m
 

src/Juvix/Prelude/Effects/Output.hs

@@ -4,7 +4,7 @@ module Juvix.Prelude.Effects.Output where
 
 import Data.Kind qualified as GHC
 import Effectful.Dispatch.Dynamic
-import Juvix.Prelude.Base hiding (Effect, Output, interpret, output, reinterpret, runOutputList)
+import Juvix.Prelude.Base hiding (Effect, Output, State, interpret, modify, output, reinterpret, runOutputList, runState)
 import Juvix.Prelude.Effects.Accum
 import Juvix.Prelude.Effects.Base
 
@@ -22,6 +22,9 @@ runOutputList :: Eff (Output o ': r) a -> Eff r ([o], a)
 runOutputList = reinterpret runAccumList $ \_ -> \case
   Output x -> accum x
 
+execOutputList :: Eff (Output o ': r) a -> Eff r [o]
+execOutputList = fmap fst . runOutputList
+
 ignoreOutput :: Eff (Output o ': r) a -> Eff r a
 ignoreOutput = interpret $ \_ -> \case
   Output {} -> return ()