mirror of
https://github.com/anoma/juvix.git
synced 2025-01-08 16:51:53 +03:00
3e680da057
# 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 ```
125 lines
3.5 KiB
Haskell
125 lines
3.5 KiB
Haskell
module Main where
|
|
|
|
import Base
|
|
import Criterion.Main
|
|
import Criterion.Main.Options hiding (config)
|
|
import Criterion.Types
|
|
import Data.Text qualified as Text
|
|
import Development.Shake hiding ((<//>))
|
|
import Juvix.Prelude.Base
|
|
import Juvix.Prelude.Path as Path hiding (doesFileExist, (-<.>))
|
|
import Juvix.Prelude.Path qualified as Path
|
|
import Statistics.Types
|
|
import Suites
|
|
|
|
main :: IO ()
|
|
main = shakeArgs opts compileRules
|
|
where
|
|
opts :: ShakeOptions
|
|
opts = shakeOptions
|
|
|
|
compileRules :: Rules ()
|
|
compileRules = do
|
|
phony "clean" $ do
|
|
putInfo ("Deleting " <> toFilePath resultsDir)
|
|
removePathForcibly resultsDir
|
|
forM_ suites suiteRules
|
|
|
|
suiteRules :: Suite -> Rules ()
|
|
suiteRules s = do
|
|
forM_ (s ^. suiteVariants) (variantRules s)
|
|
csvRules s
|
|
plotRules s
|
|
|
|
multiRecipe :: [Path Abs File] -> Action () -> Rules ()
|
|
multiRecipe out howto = map toFilePath out &%> const howto
|
|
|
|
recipe :: Path Abs File -> Action () -> Rules ()
|
|
recipe out howto = toFilePath out %> const howto
|
|
|
|
variantRules :: Suite -> Variant -> Rules ()
|
|
variantRules s v = do
|
|
action $ do
|
|
whenM
|
|
(doesFileExist (toFilePath srcFile))
|
|
(need [toFilePath exeFile])
|
|
|
|
recipe exeFile $ do
|
|
need [toFilePath srcFile]
|
|
ensureDir outDir
|
|
(v ^. variantBuild) args
|
|
where
|
|
args :: BuildArgs
|
|
args =
|
|
BuildArgs
|
|
{ _buildSrc = srcFile,
|
|
_buildOutDir = outDir
|
|
}
|
|
lang :: Lang
|
|
lang = v ^. variantLanguage
|
|
srcFile :: Path Abs File
|
|
srcFile =
|
|
addExtension'
|
|
(langExtension lang)
|
|
(suiteSrcDir s <//> langPath lang <//> suiteBaseFile s)
|
|
exeFile :: Path Abs File
|
|
exeFile = outDir <//> replaceExtensions' (v ^. variantExtensions) (filename srcFile)
|
|
outDir :: Path Abs Dir
|
|
outDir = variantBinDir s v
|
|
|
|
plotRules :: Suite -> Rules ()
|
|
plotRules s = do
|
|
let csv :: Path Abs File = suiteCsvFile s
|
|
svg :: Path Abs File = suiteSvgFile s
|
|
out :: Path Abs File = suitePlotFile s
|
|
want [toFilePath svg]
|
|
multiRecipe [svg] $ do
|
|
need [toFilePath csv, toFilePath gnuplotFile]
|
|
ensureDir (parent svg)
|
|
command_
|
|
[]
|
|
"gnuplot"
|
|
( gpArg "name" (s ^. suiteTitle)
|
|
++ gpArg "outfile" (toFilePath out)
|
|
++ gpArg "csvfile" (toFilePath csv)
|
|
++ [toFilePath gnuplotFile]
|
|
)
|
|
where
|
|
gpArg :: String -> String -> [String]
|
|
gpArg arg val = ["-e", arg <> "='" <> val <> "'"]
|
|
|
|
csvRules :: Suite -> Rules ()
|
|
csvRules s =
|
|
recipe csv $ do
|
|
need [toFilePath (variantBinFile s v) | v <- s ^. suiteVariants]
|
|
ensureDir (parent csv)
|
|
whenM (Path.doesFileExist csv) (removeFile csv)
|
|
liftIO (runMode (Run (config s) Glob []) (fromSuite s) >> addColorColumn)
|
|
where
|
|
csv :: Path Abs File = suiteCsvFile s
|
|
addColorColumn :: IO ()
|
|
addColorColumn = do
|
|
header :| rows <- nonEmpty' . Text.lines <$> readFile (toFilePath csv)
|
|
let rows' =
|
|
[ showColour (v ^. variantColor) <> "," <> r
|
|
| (v, r) <- zipExact (s ^. suiteVariants) rows
|
|
]
|
|
header' = "Color," <> header
|
|
writeFileEnsureLn csv (Text.unlines (header' : rows'))
|
|
|
|
fromSuite :: Suite -> [Benchmark]
|
|
fromSuite s = map go (s ^. suiteVariants)
|
|
where
|
|
go :: Variant -> Benchmark
|
|
go v = bench title (nfIO ((v ^. variantRun) (variantBinFile s v)))
|
|
where
|
|
title :: String
|
|
title = show (v ^. variantLanguage) <> maybe "" (" " <>) (v ^. variantTitle)
|
|
|
|
config :: Suite -> Config
|
|
config s =
|
|
defaultConfig
|
|
{ csvFile = Just (toFilePath (suiteCsvFile s)),
|
|
confInterval = cl90
|
|
}
|