Skip to content

Commit

Permalink
Benchmarks: Switched from gauge to tasty-bench
Browse files Browse the repository at this point in the history
  • Loading branch information
mmhat committed Nov 7, 2024
1 parent 1bf48bf commit ff9a915
Show file tree
Hide file tree
Showing 12 changed files with 47 additions and 56 deletions.
21 changes: 10 additions & 11 deletions dhall/benchmark/deep-nested-large-record/Main.hs
Original file line number Diff line number Diff line change
@@ -1,14 +1,13 @@
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

import Data.Void (Void)
import Gauge (defaultMain)
import Data.Void (Void)
import Test.Tasty.Bench

import qualified Data.Sequence as Seq
import qualified Dhall.Core as Core
import qualified Dhall.Import as Import
import qualified Dhall.TypeCheck as TypeCheck
import qualified Gauge

dhallPreludeImport :: Core.Import
dhallPreludeImport = Core.Import
Expand All @@ -22,8 +21,8 @@ dhallPreludeImport = Core.Import
}
}

issue412 :: Core.Expr s Void -> Gauge.Benchmarkable
issue412 prelude = Gauge.whnf TypeCheck.typeOf expr
issue412 :: Core.Expr s Void -> Benchmarkable
issue412 prelude = whnf TypeCheck.typeOf expr
where
expr
= Core.Let (Core.Binding Nothing "prelude" Nothing Nothing Nothing prelude)
Expand All @@ -34,8 +33,8 @@ issue412 prelude = Gauge.whnf TypeCheck.typeOf expr
little = Core.makeFieldSelection "little"
foo = Core.makeFieldSelection "Foo"

unionPerformance :: Core.Expr s Void -> Gauge.Benchmarkable
unionPerformance prelude = Gauge.whnf TypeCheck.typeOf expr
unionPerformance :: Core.Expr s Void -> Benchmarkable
unionPerformance prelude = whnf TypeCheck.typeOf expr
where
expr =
Core.Let
Expand Down Expand Up @@ -64,10 +63,10 @@ unionPerformance prelude = Gauge.whnf TypeCheck.typeOf expr
main :: IO ()
main =
defaultMain
[ Gauge.env prelude $ \p ->
Gauge.bgroup "Prelude"
[ Gauge.bench "issue 412" (issue412 p)
, Gauge.bench "union performance" (unionPerformance p)
[ env prelude $ \p ->
bgroup "Prelude"
[ bench "issue 412" (issue412 p)
, bench "union performance" (unionPerformance p)
]
]
where prelude = Import.load (Core.Embed dhallPreludeImport)
69 changes: 35 additions & 34 deletions dhall/benchmark/parser/Main.hs
Original file line number Diff line number Diff line change
@@ -1,63 +1,63 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Exception (throw)
import Control.Monad (forM)
import Data.Map (Map, foldrWithKey, singleton, unions)
import Data.Map (Map)
import Data.Text (Text)
import Data.Void (Void)
import Gauge (bench, bgroup, defaultMain, env, nf, whnf)

import System.Directory
import Test.Tasty.Bench

import qualified Data.ByteString.Lazy
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Text.IO
import qualified Dhall.Binary
import qualified Dhall.Core as Dhall
import qualified Dhall.Parser as Dhall
import qualified Gauge
import qualified System.Directory as Directory

type PreludeFiles = Map FilePath T.Text
type PreludeFiles = Map FilePath Text

loadPreludeFiles :: IO PreludeFiles
loadPreludeFiles = loadDirectory "./dhall-lang/Prelude"
where
loadDirectory :: FilePath -> IO PreludeFiles
loadDirectory dir =
withCurrentDirectory dir $ do
files <- getCurrentDirectory >>= listDirectory
Directory.withCurrentDirectory dir $ do
files <- Directory.getCurrentDirectory >>= Directory.listDirectory
results <- forM files $ \file -> do
file' <- makeAbsolute file
doesExist <- doesFileExist file'
file' <- Directory.makeAbsolute file
doesExist <- Directory.doesFileExist file'
if doesExist
then loadFile file'
else loadDirectory file'
pure $ unions results
pure $ Map.unions results

loadFile :: FilePath -> IO PreludeFiles
loadFile path = singleton path <$> TIO.readFile path
loadFile path = Map.singleton path <$> Data.Text.IO.readFile path

benchParser :: PreludeFiles -> Gauge.Benchmark
benchParser :: PreludeFiles -> Benchmark
benchParser =
bgroup "exprFromText"
. foldrWithKey (\name expr -> (benchExprFromText name expr :)) []
. Map.foldrWithKey (\name expr -> (benchExprFromText name expr :)) []

benchExprFromText :: String -> T.Text -> Gauge.Benchmark
benchExprFromText name expr =
benchExprFromText :: String -> Text -> Benchmark
benchExprFromText name !expr =
bench name $ whnf (Dhall.exprFromText "(input)") expr

benchExprFromBytes
:: String -> Data.ByteString.Lazy.ByteString -> Gauge.Benchmark
benchExprFromBytes :: String -> Data.ByteString.Lazy.ByteString -> Benchmark
benchExprFromBytes name bs = bench name (nf f bs)
where
f bytes =
case Dhall.Binary.decodeExpression bytes of
Left exception -> error (show exception)
Right expression -> expression :: Dhall.Expr Void Dhall.Import

benchNfExprFromText :: String -> T.Text -> Gauge.Benchmark
benchNfExprFromText name expr =
benchNfExprFromText :: String -> Text -> Benchmark
benchNfExprFromText name !expr =
bench name $ nf (either throw id . Dhall.exprFromText "(input)") expr

main :: IO ()
Expand All @@ -71,20 +71,21 @@ main = do
]
, env kubernetesExample $
benchExprFromBytes "Kubernetes/Binary"
, benchExprFromText "Long variable names" (T.replicate 1000000 "x")
, benchExprFromText "Large number of function arguments" (T.replicate 10000 "x ")
, benchExprFromText "Long double-quoted strings" ("\"" <> T.replicate 1000000 "x" <> "\"")
, benchExprFromText "Long single-quoted strings" ("''" <> T.replicate 1000000 "x" <> "''")
, benchExprFromText "Whitespace" (T.replicate 1000000 " " <> "x")
, benchExprFromText "Line comment" ("x -- " <> T.replicate 1000000 " ")
, benchExprFromText "Block comment" ("x {- " <> T.replicate 1000000 " " <> "-}")
, benchExprFromText "Long variable names" (Text.replicate 1000000 "x")
, benchExprFromText "Large number of function arguments" (Text.replicate 10000 "x ")
, benchExprFromText "Long double-quoted strings" ("\"" <> Text.replicate 1000000 "x" <> "\"")
, benchExprFromText "Long single-quoted strings" ("''" <> Text.replicate 1000000 "x" <> "''")
, benchExprFromText "Whitespace" (Text.replicate 1000000 " " <> "x")
, benchExprFromText "Line comment" ("x -- " <> Text.replicate 1000000 " ")
, benchExprFromText "Block comment" ("x {- " <> Text.replicate 1000000 " " <> "-}")
, benchExprFromText "Deeply nested parentheses" "((((((((((((((((x))))))))))))))))"
, benchParser prelude
, env cpkgExample $
benchNfExprFromText "CPkg/Text"
]
where cpkgExample = TIO.readFile "benchmark/examples/cpkg.dhall"
issue108Text = TIO.readFile "benchmark/examples/issue108.dhall"
issue108Bytes = Data.ByteString.Lazy.readFile "benchmark/examples/issue108.dhall.bin"
issues = (,) <$> issue108Text <*> issue108Bytes
kubernetesExample = Data.ByteString.Lazy.readFile "benchmark/examples/kubernetes.dhall.bin"
where
cpkgExample = Data.Text.IO.readFile "benchmark/parser/examples/cpkg.dhall"
issue108Text = Data.Text.IO.readFile "benchmark/parser/examples/issue108.dhall"
issue108Bytes = Data.ByteString.Lazy.readFile "benchmark/parser/examples/issue108.dhallb"
issues = (,) <$> issue108Text <*> issue108Bytes
kubernetesExample = Data.ByteString.Lazy.readFile "benchmark/parser/examples/kubernetes.dhallb"
File renamed without changes.
File renamed without changes.
File renamed without changes.
4 changes: 2 additions & 2 deletions dhall/dhall.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -475,7 +475,7 @@ Benchmark dhall-parser
Main-Is: Main.hs
Build-Depends:
dhall ,
gauge >= 0.2.3 && < 0.3,
tasty-bench >= 0.4 && < 0.5,
Default-Language: Haskell2010
Other-Extensions:
TypeApplications
Expand All @@ -488,5 +488,5 @@ Benchmark deep-nested-large-record
Main-Is: Main.hs
Build-Depends:
dhall ,
gauge >= 0.2.3 && < 0.3
tasty-bench >= 0.4 && < 0.5,
Default-Language: Haskell2010
9 changes: 0 additions & 9 deletions nix/shared.nix
Original file line number Diff line number Diff line change
Expand Up @@ -230,15 +230,6 @@ let
'';
}
);

gauge =
pkgsNew.haskell.lib.appendPatch
haskellPackagesOld.gauge
(pkgsNew.fetchpatch {
url = "https://github.com/vincenthz/hs-gauge/commit/303a6b611804c85b9a6bc1cea5de4e6ce3429d24.patch";

sha256 = "sha256-4osUMo0cvTvyDTXF8lY9tQbFqLywRwsc3RkHIhqSriQ=";
});
};

in
Expand Down

0 comments on commit ff9a915

Please sign in to comment.