Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 6 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,12 @@ hie.yaml
/scripts/bug-reports
/booster/test/rpc-integration/resources/*.dylib
/booster/test/*/definition/*kompiled/
/booster/benchmarks.csv
/booster/booster-bench.hp
/plan.md

# the LLVM bindings from ./booster/cbits are symlinked to the root ./cbits to make HLS work
/cbits

# git worktrees
/.worktrees/
8 changes: 8 additions & 0 deletions booster/bench/BenchData.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
{- |
Re-export benchmark fixture helpers for the benchmark executable.
-}
module BenchData (
module Booster.Benchmark.Data,
) where

import Booster.Benchmark.Data
148 changes: 148 additions & 0 deletions booster/bench/Main.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,148 @@
{-# LANGUAGE OverloadedRecordDot #-}

module Main (main) where

import BenchData
import Booster.Benchmark.Ops
import Booster.Pattern.Base
import Test.Tasty.Bench

main :: IO ()
main =
defaultMain
[ bgroup "kmap" (map kmapBenchFor benchmarkSizes)
, bgroup "kset" (map ksetBenchFor benchmarkSizes)
, bgroup "klist" (map klistBenchFor benchmarkSizes)
, pipelineBenchmarks
]

kmapBenchFor :: Int -> Benchmark
kmapBenchFor size =
let mapTerm = mkMapTerm size
existingKey = mkLookupExistingKey size
missingKey = mkLookupMissingKey size
insertKey = mkInsertKey size
insertValue = mkUpdatedValue (size + 1)
updateValue = mkUpdatedValue (size + 2)
duplicatePairs = case mapTerm of
KMap _ pairs _ -> pairs <> reverse pairs
_ -> []
coreBenches =
[ bench "lookup-existing" $ nf (runMapLookup mapTerm) existingKey
, bench "lookup-missing" $ nf (runMapLookup mapTerm) missingKey
, bench "size" $ nf runMapSize mapTerm
]
heavyBenches =
[ bench "insert" $ nf (\(m, k, v) -> runMapUpdate m k v) (mapTerm, insertKey, insertValue)
, bench "update" $ nf (\(m, k, v) -> runMapUpdate m k v) (mapTerm, existingKey, updateValue)
, bench "remove" $ nf (\(m, k) -> runMapRemove m k) (mapTerm, existingKey)
, bench "keys" $ nf runMapKeys mapTerm
, bench "values" $ nf runMapValues mapTerm
Comment on lines +36 to +40

Copy link
Copy Markdown
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Some of these tests are measuring the generation of the large test data structures (such as mapTerm) as well as the operation they are trying to measure. It might be better to evaluate the data structure in full beforehand (using force) - which may require a NFData instance.

See the long comment on the nf function in Test.Tasty.Bench for more information.

, bench "in_keys" $ nf (runMapInKeys mapTerm) existingKey
, bench "sortAndDeduplicate" $ nf (\pairs -> KMap benchmarkKMapDef pairs Nothing) duplicatePairs
]
in bgroup
("size-" <> show size)
(coreBenches <> whenSizeAtMost 10000 size heavyBenches)

ksetBenchFor :: Int -> Benchmark
ksetBenchFor size =
let leftSet = mkSetTerm size
rightSet = mkSetTerm (max 1 (size `div` 2))
probe = mkSetElement (max 1 (size `div` 3))
duplicateElements = case leftSet of
KSet _ elements _ -> elements <> reverse elements
_ -> []
coreBenches =
[ bench "in" $ nf (ksetIn probe) leftSet
, bench "size" $ nf ksetSize leftSet
]
heavyBenches =
[ bench "difference" $ nf (\(l, r) -> ksetDifference l r) (leftSet, rightSet)
, bench "union" $ nf (\(l, r) -> ksetUnion l r) (leftSet, rightSet)
, bench "intersection" $ nf (\(l, r) -> ksetIntersection l r) (leftSet, rightSet)
, bench "sortAndDeduplicate" $
nf (\elements -> KSet benchmarkKSetDef elements Nothing) duplicateElements
]
in bgroup
("size-" <> show size)
(coreBenches <> whenSizeAtMost 10000 size heavyBenches)

klistBenchFor :: Int -> Benchmark
klistBenchFor size =
let listTerm = mkListTerm size
concatRhs = mkListConcatRhs size
idxMiddle = size `div` 2
idxLast = max 0 (size - 1)
rangeTrim = max 0 (size `div` 4)
coreBenches =
[ bench "get-0" $ nf (runListGet listTerm) 0
, bench "get-middle" $ nf (runListGet listTerm) idxMiddle
, bench "get-last" $ nf (runListGet listTerm) idxLast
, bench "size" $ nf runListSize listTerm
]
heavyBenches =
[ bench "range" $ nf (\(l, f, b) -> runListRange l f b) (listTerm, rangeTrim, rangeTrim)
, bench "concat" $ nf (\(l, r) -> runListConcat l r) (listTerm, concatRhs)
]
in bgroup
("size-" <> show size)
(coreBenches <> whenSizeAtMost 10000 size heavyBenches)

pipelineBenchmarks :: Benchmark
pipelineBenchmarks =
bgroup
"pipeline"
[ bgroup "kmap-matchMaps" (map mapMatchBenchFor matchMapBenchSizes)
, bgroup "ord-term" (map ordBenchFor pipelineBenchSizes)
, bgroup "substitution" (map substitutionBenchFor pipelineBenchSizes)
, bench "full-single-rule-pipeline" $ nfIO runPipelineOnce
]

matchMapBenchSizes :: [Int]
matchMapBenchSizes = [10, 100, 1000]

pipelineBenchSizes :: [Int]
pipelineBenchSizes = [10, 100, 1000, 5000]

mapMatchBenchFor :: Int -> Benchmark
mapMatchBenchFor size =
let patternMap = mkPatternMapForMatch size
subjectMap = mkSubjectMapForMatch size
in bgroup
("size-" <> show size)
[ bench "matchMaps" $ whnf (\(p, s) -> matchMapTerms p s) (patternMap, subjectMap)
]

whenSizeAtMost :: Int -> Int -> [Benchmark] -> [Benchmark]
whenSizeAtMost limit size benchmarks
| size <= limit = benchmarks
| otherwise = []

ordBenchFor :: Int -> Benchmark
ordBenchFor size =
let left = mkMapTerm size
right =
case mkMapTerm size of
KMap def pairs rest ->
KMap def ((mkInsertKey (size + 7), mkUpdatedValue (size + 7)) : pairs) rest
other -> other
in bgroup
("size-" <> show size)
[ bench "derived" $ whnf (\(a, b) -> compare a b) (left, right)
, bench "hash-first" $ whnf (\(a, b) -> compareTermHashFirst a b) (left, right)
]

substitutionBenchFor :: Int -> Benchmark
substitutionBenchFor size =
let unchangedKeyMap = mkMapWithValueVariables size
unchangedKeySubst = mkValueSubstitution size
changedKeyMap = mkMapWithKeyVariables size
changedKeySubst = mkKeySubstitution size
in bgroup
("size-" <> show size)
[ bench "unchanged-keys" $
nf (\(subst, term) -> substituteMap subst term) (unchangedKeySubst, unchangedKeyMap)
, bench "changed-keys" $
nf (\(subst, term) -> substituteMap subst term) (changedKeySubst, changedKeyMap)
]
38 changes: 37 additions & 1 deletion booster/hs-backend-booster.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -223,6 +223,11 @@ source-repository head
type: git
location: https://github.com/runtimeverification/hs-backend-booster

flag profiling
description: Enable profiling-friendly build options for benchmark runs.
manual: True
default: False

library
exposed-modules:
Booster.Builtin
Expand All @@ -232,6 +237,8 @@ library
Booster.Builtin.KEQUAL
Booster.Builtin.LIST
Booster.Builtin.MAP
Booster.Benchmark.Data
Booster.Benchmark.Ops
Booster.CLOptions
Booster.Definition.Attributes.Base
Booster.Definition.Attributes.Reader
Expand Down Expand Up @@ -330,6 +337,8 @@ library
, unix
, unliftio
, unordered-containers
if flag(profiling)
ghc-options: -prof -fprof-auto
default-language: Haskell2010

executable kore-rpc-booster
Expand Down Expand Up @@ -440,7 +449,7 @@ test-suite predicates-integration
test/predicates-integration
default-extensions:
BangPatterns DataKinds DefaultSignatures DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia DuplicateRecordFields EmptyCase FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving ImportQualifiedPost KindSignatures LambdaCase MultiParamTypeClasses NamedFieldPuns OverloadedRecordDot OverloadedStrings PolyKinds ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies ViewPatterns
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -j6
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -j6 -rtsopts -threaded -with-rtsopts=-N
build-depends:
base
, bytestring
Expand All @@ -461,6 +470,7 @@ test-suite unit-tests
type: exitcode-stdio-1.0
main-is: Driver.hs
other-modules:
Test.Booster.Benchmarks
Test.Booster.Builtin
Test.Booster.Definition.Internalise
Test.Booster.Fixture
Expand Down Expand Up @@ -507,3 +517,29 @@ test-suite unit-tests
, text
, transformers
default-language: Haskell2010

benchmark booster-bench
type: exitcode-stdio-1.0
main-is: Main.hs
other-modules:
BenchData
Paths_hs_backend_booster
hs-source-dirs:
bench
default-extensions:
BangPatterns DataKinds DefaultSignatures DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia DuplicateRecordFields EmptyCase FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving ImportQualifiedPost KindSignatures LambdaCase MultiParamTypeClasses NamedFieldPuns OverloadedRecordDot OverloadedStrings PolyKinds ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies ViewPatterns
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -j6 -rtsopts -threaded -with-rtsopts=-N
build-depends:
base
, bytestring
, containers
, deepseq
, hashable
, hs-backend-booster
, monad-logger
, tasty-bench
, text
, transformers
if flag(profiling)
ghc-options: -prof -fprof-auto
default-language: Haskell2010
Loading
Loading