anoma/juvix
1
1
Fork 0
mirror of https://github.com/anoma/juvix.git synced 2024-09-12 00:28:17 +03:00
Code Issues Projects Releases Wiki Activity

Effect benchmarks (#2640)

Browse Source 
# Overview
This pr implements a simple benchmark suite to compare the efficiency of
[`effectful-core`](https://hackage.haskell.org/package/effectful-core)
and [`polysemy`](https://hackage.haskell.org/package/polysemy).

I've implemented the suite with the help of
[`tasty-bench`](https://hackage.haskell.org/package/tasty-bench). It is
a simple benchmarking library that has minimal dependencies and it can
be run with a default main using the same cli options as our
[`tasty`](https://hackage.haskell.org/package/tasty) test suite.

# How to run

```
stack run juvixbench
```

If you only want to run a particular benchmark:
```
stack run juvixbench -- -p "/Output/"
```

# Results
The results show that `effectful` is the clear winner, in some cases it
is extremely close to the raw version.

## State
This benchmark adds the first 2 ^ 22 first naturals:
```
countRaw :: Natural -> Natural
countRaw = go 0
  where
    go :: Natural -> Natural -> Natural
    go acc = \case
      0 -> acc
      m -> go (acc + m) (pred m)
```

Results:
```
   State
      Eff State (Static): OK
        25.2 ms ± 2.4 ms
      Sem State:          OK
        2.526 s ± 5.1 ms
      Raw State:          OK
        22.3 ms ± 1.5 ms
``` 

## Output
This benchmark collects the first 2 ^ 21 naturals in a list and adds
them.

```
countdownRaw :: Natural -> Natural
countdownRaw = sum' . reverse . go []
  where
    go :: [Natural] -> Natural -> [Natural]
    go acc = \case
      0 -> acc
      m -> go (m : acc) (pred m)
```

Results:
```
      Eff Output (Dynamic): OK
        693  ms ±  61 ms
      Eff Accum (Static):   OK
        553  ms ±  36 ms
      Sem Output:           OK
        2.606 s ±  91 ms
      Raw Output:           OK
        604  ms ±  26 ms
```

## Reader (First Order)
Repeats a constant in a list and adds it. The effects based version ask
the constant value in each iteration.

```
countRaw :: Natural -> Natural
countRaw = sum' . go []
  where
    go :: [Natural] -> Natural -> [Natural]
    go acc = \case
      0 -> acc
      m -> go (c : acc) (pred m)
```

Results:
```
    Reader (First order)
      Eff Reader (Static): OK
        103  ms ± 6.9 ms
      Sem Reader:          OK
        328  ms ±  31 ms
      Raw Reader:          OK
        106  ms ± 1.9 ms
```

## Reader (Higher Order)
Adds the first 2 ^ 21 naturals. The effects based version use `local`
(from the `Reader`) effect to pass down the argument that counts the
iterations.

```
countRaw :: Natural -> Natural
countRaw = sum' . go []
  where
    go :: [Natural] -> Natural -> [Natural]
    go acc = \case
      0 -> acc
      m -> go (m : acc) (pred m)
```

Results: 
```
    Reader (Higher order)
      Eff Reader (Static): OK
        720  ms ±  56 ms
      Sem Reader:          OK
        2.094 s ± 182 ms
      Raw Reader:          OK
        154  ms ± 2.2 ms
```

## Embed IO 
Opens a temporary file and appends a character to it a number of times.
```
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)
```

Results: 
```
   Embed IO
      Raw IO:       OK
        464  ms ±  12 ms
      Eff RIO:      OK
        487  ms ± 3.5 ms
      Sem Embed IO: OK
        582  ms ±  33 ms
```
This commit is contained in:
Jan Mas Rovira 2024-02-14 15:12:39 +01:00 committed by GitHub
parent 97030f8cb4
commit 3e680da057
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
12 changed files with 283 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bench/Main.hs
View File

@ -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)

19
bench2/Benchmark/Effect.hs Normal file
View File

@ -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
]

46
bench2/Benchmark/Effect/EmbedIO.hs Normal file
View File

@ -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)

51
bench2/Benchmark/Effect/Output.hs Normal file
View File

@ -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)

49
bench2/Benchmark/Effect/Reader.hs Normal file
View File

@ -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)

46
bench2/Benchmark/Effect/ReaderH.hs Normal file
View File

@ -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))

42
bench2/Benchmark/Effect/State.hs Normal file
View File

@ -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)

11
bench2/Main.hs Normal file
View File

@ -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
]

9
package.yaml
View File

@ -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

2
src/Juvix/Prelude/Effects.hs
View File

@ -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

3
src/Juvix/Prelude/Effects/Accum.hs
View File

@ -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

5
src/Juvix/Prelude/Effects/Output.hs
View File

@ -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 ()