diff --git a/bench/Main.hs b/bench/Main.hs index d329095c6..7a3e64f24 100644 --- a/bench/Main.hs +++ b/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) diff --git a/bench2/Benchmark/Effect.hs b/bench2/Benchmark/Effect.hs new file mode 100644 index 000000000..d59635de7 --- /dev/null +++ b/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 + ] diff --git a/bench2/Benchmark/Effect/EmbedIO.hs b/bench2/Benchmark/Effect/EmbedIO.hs new file mode 100644 index 000000000..494edc69e --- /dev/null +++ b/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) diff --git a/bench2/Benchmark/Effect/Output.hs b/bench2/Benchmark/Effect/Output.hs new file mode 100644 index 000000000..4789f049c --- /dev/null +++ b/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) diff --git a/bench2/Benchmark/Effect/Reader.hs b/bench2/Benchmark/Effect/Reader.hs new file mode 100644 index 000000000..c2c522044 --- /dev/null +++ b/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) diff --git a/bench2/Benchmark/Effect/ReaderH.hs b/bench2/Benchmark/Effect/ReaderH.hs new file mode 100644 index 000000000..e6a0d73d8 --- /dev/null +++ b/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)) diff --git a/bench2/Benchmark/Effect/State.hs b/bench2/Benchmark/Effect/State.hs new file mode 100644 index 000000000..6424bf839 --- /dev/null +++ b/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) diff --git a/bench2/Main.hs b/bench2/Main.hs new file mode 100644 index 000000000..d32513e14 --- /dev/null +++ b/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 + ] diff --git a/package.yaml b/package.yaml index c4b3126ec..d2402bf6f 100644 --- a/package.yaml +++ b/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 diff --git a/src/Juvix/Prelude/Effects.hs b/src/Juvix/Prelude/Effects.hs index 0659c9773..67cff4a90 100644 --- a/src/Juvix/Prelude/Effects.hs +++ b/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 diff --git a/src/Juvix/Prelude/Effects/Accum.hs b/src/Juvix/Prelude/Effects/Accum.hs index f284556e9..076967ba6 100644 --- a/src/Juvix/Prelude/Effects/Accum.hs +++ b/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 diff --git a/src/Juvix/Prelude/Effects/Output.hs b/src/Juvix/Prelude/Effects/Output.hs index 8ec8da15d..0758685b4 100644 --- a/src/Juvix/Prelude/Effects/Output.hs +++ b/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 ()