diff --git a/bench2/Benchmark/Effect.hs b/bench2/Benchmark/Effect.hs index 2f8e19d902..d59635de71 100644 --- a/bench2/Benchmark/Effect.hs +++ b/bench2/Benchmark/Effect.hs @@ -1,5 +1,6 @@ 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 @@ -13,5 +14,6 @@ bm = [ Output.bm, State.bm, ReaderH.bm, + EmbedIO.bm, Reader.bm ] diff --git a/bench2/Benchmark/Effect/EmbedIO.hs b/bench2/Benchmark/Effect/EmbedIO.hs new file mode 100644 index 0000000000..8d01b06a27 --- /dev/null +++ b/bench2/Benchmark/Effect/EmbedIO.hs @@ -0,0 +1,49 @@ +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 = countHelper + +countHelper :: forall m. (MonadMask m, MonadIO m) => Natural -> m () +countHelper n = + withSystemTempFile "tmp" $ \_ h -> go h n + where + go :: Handle -> Natural -> m () + go h = \case + 0 -> return () + a -> liftIO (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)