From b1b060292e8d401d4a7cc594a8ca0f0ea202f622 Mon Sep 17 00:00:00 2001 From: Nathan Braswell Date: Mon, 16 May 2022 02:33:10 -0400 Subject: [PATCH] Moved over first rbtree test from koka_bench and integrated Kraken via compiler wrapper script that calls the partial_evaluator / compiler and then emits a wrapper script that runs the resulting wasm via wasmtime. --- koka_bench/.gitignore | 5 + koka_bench/CMakeLists.txt | 13 ++ koka_bench/LICENSE | 210 ++++++++++++++++++++++ koka_bench/README.md | 131 ++++++++++++++ koka_bench/cpp/CMakeLists.txt | 16 ++ koka_bench/cpp/rbtree.cpp | 43 +++++ koka_bench/koka/CMakeLists.txt | 22 +++ koka_bench/koka/rbtree.kk | 87 +++++++++ koka_bench/kraken_wrapper.sh | 10 ++ koka_bench/rbtree_table.md | 5 + koka_bench/test.sh | 13 ++ rb_tree_test/matching.kp | 310 --------------------------------- working_files/rb_profile.txt | 29 +++ 13 files changed, 584 insertions(+), 310 deletions(-) create mode 100644 koka_bench/.gitignore create mode 100644 koka_bench/CMakeLists.txt create mode 100644 koka_bench/LICENSE create mode 100644 koka_bench/README.md create mode 100644 koka_bench/cpp/CMakeLists.txt create mode 100644 koka_bench/cpp/rbtree.cpp create mode 100644 koka_bench/koka/CMakeLists.txt create mode 100644 koka_bench/koka/rbtree.kk create mode 100755 koka_bench/kraken_wrapper.sh create mode 100644 koka_bench/rbtree_table.md create mode 100755 koka_bench/test.sh delete mode 100644 rb_tree_test/matching.kp create mode 100644 working_files/rb_profile.txt diff --git a/koka_bench/.gitignore b/koka_bench/.gitignore new file mode 100644 index 0000000..3d337b2 --- /dev/null +++ b/koka_bench/.gitignore @@ -0,0 +1,5 @@ +build/ +*.hi +*.o +*.cmi +*.cmx diff --git a/koka_bench/CMakeLists.txt b/koka_bench/CMakeLists.txt new file mode 100644 index 0000000..6f31a3a --- /dev/null +++ b/koka_bench/CMakeLists.txt @@ -0,0 +1,13 @@ +cmake_minimum_required(VERSION 3.16) +project(KokaBench) + +get_property(isMultiConfig GLOBAL PROPERTY GENERATOR_IS_MULTI_CONFIG) +if (NOT isMultiConfig AND NOT DEFINED CMAKE_BUILD_TYPE) + set(CMAKE_BUILD_TYPE Release) +endif () + +enable_testing() + +add_subdirectory(kraken) +add_subdirectory(koka) +add_subdirectory(cpp) diff --git a/koka_bench/LICENSE b/koka_bench/LICENSE new file mode 100644 index 0000000..7ac37df --- /dev/null +++ b/koka_bench/LICENSE @@ -0,0 +1,210 @@ +Copyright 2012-2021, Microsoft Research, Daan Leijen - modified 2022 by Nathan Braswell. + +Koka is free software; You can redistribute it and/or +modify it under the terms of this license. + + +Apache License, Version 2.0 +Apache License +Version 2.0, January 2004 +http://www.apache.org/licenses/ + +TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + +1. Definitions. + +"License" shall mean the terms and conditions for use, reproduction, and +distribution as defined by Sections 1 through 9 of this document. + +"Licensor" shall mean the copyright owner or entity authorized by the +copyright owner that is granting the License. + +"Legal Entity" shall mean the union of the acting entity and all other +entities that control, are controlled by, or are under common control +with that entity. For the purposes of this definition, "control" means +(i) the power, direct or indirect, to cause the direction or management +of such entity, whether by contract or otherwise, or (ii) ownership of +fifty percent (50%) or more of the outstanding shares, or (iii) +beneficial ownership of such entity. + +"You" (or "Your") shall mean an individual or Legal Entity exercising +permissions granted by this License. + +"Source" form shall mean the preferred form for making modifications, +including but not limited to software source code, documentation source, +and configuration files. + +"Object" form shall mean any form resulting from mechanical +transformation or translation of a Source form, including but not limited +to compiled object code, generated documentation, and conversions to +other media types. + +"Work" shall mean the work of authorship, whether in Source or Object +form, made available under the License, as indicated by a copyright +notice that is included in or attached to the work (an example is +provided in the Appendix below). + +"Derivative Works" shall mean any work, whether in Source or Object form, +that is based on (or derived from) the Work and for which the editorial +revisions, annotations, elaborations, or other modifications represent, +as a whole, an original work of authorship. For the purposes of this +License, Derivative Works shall not include works that remain separable +from, or merely link (or bind by name) to the interfaces of, the Work and +Derivative Works thereof. + +"Contribution" shall mean any work of authorship, including the original +version of the Work and any modifications or additions to that Work or +Derivative Works thereof, that is intentionally submitted to Licensor for +inclusion in the Work by the copyright owner or by an individual or Legal +Entity authorized to submit on behalf of the copyright owner. For the +purposes of this definition, "submitted" means any form of electronic, +verbal, or written communication sent to the Licensor or its +representatives, including but not limited to communication on electronic +mailing lists, source code control systems, and issue tracking systems +that are managed by, or on behalf of, the Licensor for the purpose of +discussing and improving the Work, but excluding communication that is +conspicuously marked or otherwise designated in writing by the copyright +owner as "Not a Contribution." + +"Contributor" shall mean Licensor and any individual or Legal Entity on +behalf of whom a Contribution has been received by Licensor and +subsequently incorporated within the Work. + +2. Grant of Copyright License. + +Subject to the terms and conditions of this License, each Contributor +hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, +royalty-free, irrevocable copyright license to reproduce, prepare +Derivative Works of, publicly display, publicly perform, sublicense, and +distribute the Work and such Derivative Works in Source or Object form. + +3. Grant of Patent License. + +Subject to the terms and conditions of this License, each Contributor +hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, +royalty-free, irrevocable (except as stated in this section) patent +license to make, have made, use, offer to sell, sell, import, and +otherwise transfer the Work, where such license applies only to those +patent claims licensable by such Contributor that are necessarily +infringed by their Contribution(s) alone or by combination of their +Contribution(s) with the Work to which such Contribution(s) was +submitted. If You institute patent litigation against any entity +(including a cross-claim or counterclaim in a lawsuit) alleging that the +Work or a Contribution incorporated within the Work constitutes direct or +contributory patent infringement, then any patent licenses granted to You +under this License for that Work shall terminate as of the date such +litigation is filed. + +4. Redistribution. + +You may reproduce and distribute copies of the Work or Derivative Works +thereof in any medium, with or without modifications, and in Source or +Object form, provided that You meet the following conditions: + +You must give any other recipients of the Work or Derivative Works a copy +of this License; and +You must cause any modified files to carry prominent notices stating that +You changed the files; and +You must retain, in the Source form of any Derivative Works that You +distribute, all copyright, patent, trademark, and attribution notices +from the Source form of the Work, excluding those notices that do not +pertain to any part of the Derivative Works; and +If the Work includes a "NOTICE" text file as part of its distribution, +then any Derivative Works that You distribute must include a readable +copy of the attribution notices contained within such NOTICE file, +excluding those notices that do not pertain to any part of the Derivative +Works, in at least one of the following places: within a NOTICE text file +distributed as part of the Derivative Works; within the Source form or +documentation, if provided along with the Derivative Works; or, within a +display generated by the Derivative Works, if and wherever such +third-party notices normally appear. The contents of the NOTICE file are +for informational purposes only and do not modify the License. You may +add Your own attribution notices within Derivative Works that You +distribute, alongside or as an addendum to the NOTICE text from the Work, +provided that such additional attribution notices cannot be construed as +modifying the License. +You may add Your own copyright statement to Your modifications and may +provide additional or different license terms and conditions for use, +reproduction, or distribution of Your modifications, or for any such +Derivative Works as a whole, provided Your use, reproduction, and +distribution of the Work otherwise complies with the conditions stated in +this License. + +5. Submission of Contributions. + +Unless You explicitly state otherwise, any Contribution intentionally +submitted for inclusion in the Work by You to the Licensor shall be under +the terms and conditions of this License, without any additional terms or +conditions. Notwithstanding the above, nothing herein shall supersede or +modify the terms of any separate license agreement you may have executed +with Licensor regarding such Contributions. + +6. Trademarks. + +This License does not grant permission to use the trade names, +trademarks, service marks, or product names of the Licensor, except as +required for reasonable and customary use in describing the origin of the +Work and reproducing the content of the NOTICE file. + +7. Disclaimer of Warranty. + +Unless required by applicable law or agreed to in writing, Licensor +provides the Work (and each Contributor provides its Contributions) on an +"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either +express or implied, including, without limitation, any warranties or +conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A +PARTICULAR PURPOSE. You are solely responsible for determining the +appropriateness of using or redistributing the Work and assume any risks +associated with Your exercise of permissions under this License. + +8. Limitation of Liability. + +In no event and under no legal theory, whether in tort (including +negligence), contract, or otherwise, unless required by applicable law +(such as deliberate and grossly negligent acts) or agreed to in writing, +shall any Contributor be liable to You for damages, including any direct, +indirect, special, incidental, or consequential damages of any character +arising as a result of this License or out of the use or inability to use +the Work (including but not limited to damages for loss of goodwill, work +stoppage, computer failure or malfunction, or any and all other +commercial damages or losses), even if such Contributor has been advised +of the possibility of such damages. + +9. Accepting Warranty or Additional Liability. + +While redistributing the Work or Derivative Works thereof, You may choose +to offer, and charge a fee for, acceptance of support, warranty, +indemnity, or other liability obligations and/or rights consistent with +this License. However, in accepting such obligations, You may act only on +Your own behalf and on Your sole responsibility, not on behalf of any +other Contributor, and only if You agree to indemnify, defend, and hold +each Contributor harmless for any liability incurred by, or claims +asserted against, such Contributor by reason of your accepting any such +warranty or additional liability. + +END OF TERMS AND CONDITIONS + +APPENDIX: How to apply the Apache License to your work + +To apply the Apache License to your work, attach the following +boilerplate notice, with the fields enclosed by brackets "[]" replaced +with your own identifying information. (Don't include the brackets!) The +text should be enclosed in the appropriate comment syntax for the file +format. We also recommend that a file or class name and description of +purpose be included on the same "printed page" as the copyright notice +for easier identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/koka_bench/README.md b/koka_bench/README.md new file mode 100644 index 0000000..aec991c --- /dev/null +++ b/koka_bench/README.md @@ -0,0 +1,131 @@ +# NOTE + +These are the benchmarks extracted from the Koka repository https://github.com/koka-lang/koka +at b1670308f88dd1fc6c22cad28385fcb185d5b27d from the test/bench directory +and modified by me to run inside a reproducable environment defined by a Nix Flake, +and to use Bash to coordinate and Hyperfine to time instead of the Koka based runner. + +./test.sh will build and run the benchmarks. + +I'm slowly porting them over to the Kraken project, and adding Kraken versions of each one. + + +## Some explanation from a PLDI Readme originally included: + +Available languages are: + +- `kk` : Koka v2.1.1 compiling using gcc 9.3.0. +- `kkx` : Koka v2.1.1 compiling using gcc 9.3.0 but without reuse optimization (Section 2.4). +- `ml` : OCaml v4.08.1 using the optimizing compiler (`ocamlopt`) +- `hs` : Haskell GHC 8.6.5. +- `sw` : Swift 5.3.3. +- `jv` : Java 15.0.2, Java(TM) SE Runtime Environment (build 15.0.2+7-27), + Java HotSpot(TM) 64-Bit Server VM (build 15.0.2+7-27, mixed mode, sharing). +- `cpp` : GCC 9.3.0, + +Available tests are described in detail in Section 4 and are: + +- `rbtree` : inserts 42 million items into a red-black tree. +- `rbtree-ck` : a variant of rbtree that keeps a list of every 5th subtree and thus shares many subtrees. +- `deriv` : the symbolic derivative of a large expression. +- `nqueens` : calculates all solutions for the n-queens problem of size 13 into a list, and returns the length of that list. +- `cfold` : constant-folding over a large symbolic expression. + + +# Original README follows: + + +# Build and run benchmarks + +This contains the standard benchmark suite (discussed in detail in [Perceus] paper). +It is still basic but more benchmarks +with effect handlers are coming. The suite can run on (Ubuntu Linux), WSL2, and macOS, +and the benchmarks need: + +- `gcc`. Should be there, otherwise use `sudo apt install gcc`, +- `ghc`. Use `sudo apt install ghc`, +- `ocamlopt`. Use `sudo apt install ocaml`. + We used the new multi-core OCaml, see + for installation instructions (including `domainslib` for the binarytrees benchmark) + ``` + > opam update + > opam switch create 4.12.0+domains+effects --repositories=multicore=git+https://github.com/ocaml-multicore/multicore-opam.git,default + > opam install dune domainslib + ``` + +- `swiftc`. The Swift compiler can be downloaded [here](https://swift.org/download/). + The benchmarks expect `swiftc` to be installed at `/opt/swift/bin`, + so unpack and copy everything under `swift-.../usr` to `/opt/swift/bin`: + ``` + > tar -xzf swift-5.5-RELEASE-ubuntu20.04.tar.gz + > cd swift-5.5-RELEASE-ubuntu20.04/usr + > sudo mkdir /opt/swift + > sudo cp -r * /opt/swift + ``` + +- `javac`/`java`. We used these [instructions](https://www.linuxcapable.com/how-to-install-java-17-lts-jdk-17-on-ubuntu-20-04/) + to install the Java SE 17 Hotspot compiler: + ``` + > sudo apt update + > sudo add-apt-repository ppa:linuxuprising/java + > sudo apt-get -y install oracle-java17-installer oracle-java17-set-default + > java --version + java 17 2021-09-14 LTS + Java(TM) SE Runtime Environment (build 17+35-LTS-2724) + Java HotSpot(TM) 64-Bit Server VM (build 17+35-LTS-2724, mixed mode, sharing) + ``` + +The benchmarks can now be build using: + +``` +> cd test/bench +> mkdir build +> cd build +> cmake .. -DCMAKE_BUILD_TYPE=Release +> cmake --build . +``` + +For some benchmarks, like `cfold`, we may need a large stack, so it may be good to raise the limit: +``` +> ulimit -s unlimited +``` + +We can then run all benchmarks as: +``` +> ctest . +``` +Or only run benchmarks for one language with `-L `: +``` +> ctest -L koka +``` +Or run specific benchmarks using `-R `, +like the symbolic derivative benchmark: +``` +> ctest -R deriv +Test project /home/daan/dev/koka/test/bench/build + Start 4: hs-deriv +1/4 Test #4: hs-deriv ......................... Passed 2.29 sec + Start 10: kk-deriv +2/4 Test #10: kk-deriv ......................... Passed 1.25 sec + Start 19: ml-deriv +3/4 Test #19: ml-deriv ......................... Passed 1.73 sec + Start 25: sw-deriv +4/4 Test #25: sw-deriv ......................... Passed 2.88 sec + +100% tests passed, 0 tests failed out of 4 +... +``` + +We can also run the tests using the `test/bench/bench.kk` script instead of +using `ctest` which also measures peak working set and calculates +normalized scores. For example, from the `build` directory, we can run all benchmarks as: +``` +> koka -e ../bench +``` +Use the `--lang` or `--test` options to specify a comma separated list of +languages or benchmarks: +``` +> koka -e ../bench -- --lang=koka,ocaml --test=rbtree,rbtree-ck +``` +The `-i` switch runs `N` iterations on each benchmark and calculates +the average and the error interval. diff --git a/koka_bench/cpp/CMakeLists.txt b/koka_bench/cpp/CMakeLists.txt new file mode 100644 index 0000000..f587560 --- /dev/null +++ b/koka_bench/cpp/CMakeLists.txt @@ -0,0 +1,16 @@ +set(CMAKE_CXX_STANDARD 17) +set(CMAKE_CXX_STANDARD_REQUIRED YES) +set(CMAKE_CXX_EXTENSIONS NO) + +foreach (source IN ITEMS rbtree.cpp) + get_filename_component(name "${source}" NAME_WE) + set(name "cpp-${name}") + + add_executable(${name} ${source}) + if(source MATCHES "binarytrees.cpp") + target_link_libraries(${name} pthread) + endif() + + add_test(NAME ${name} COMMAND ${name}) + set_tests_properties(${name} PROPERTIES LABELS cpp) +endforeach () diff --git a/koka_bench/cpp/rbtree.cpp b/koka_bench/cpp/rbtree.cpp new file mode 100644 index 0000000..b4d264f --- /dev/null +++ b/koka_bench/cpp/rbtree.cpp @@ -0,0 +1,43 @@ +// Using standard STL to test the red-black tree in C++ +// In glibc++ this uses +// With the LLVM libc++ this uses +// In glibc this uses eventually: +// (Highly optimized in-place red-black tree using the low pointer bit to encode color information.) + +#include +#include +#include +using std::for_each; + +typedef int nat; + +struct nat_lt_fn { + bool operator()(nat const & n1, nat const & n2) const { return n1 < n2; } +}; + +typedef std::map map; + +map mk_map(unsigned n) { + map m; + while (n > 0) { + --n; + m.insert(std::make_pair(nat(n), n%10 == 0)); + } + return m; +} + +nat fold(map const & m) { + nat r(0); + for_each(m.begin(), m.end(), [&](std::pair const & p) { if (p.second) r = r + nat(1); }); + return r; +} + +int main(int argc, char ** argv) { + unsigned n = 4200000; + if (argc == 2) { + n = atoi(argv[1]); + } + map m = mk_map(n); + std::cout << fold(m) << "\n"; + return 0; +} diff --git a/koka_bench/koka/CMakeLists.txt b/koka_bench/koka/CMakeLists.txt new file mode 100644 index 0000000..495a82d --- /dev/null +++ b/koka_bench/koka/CMakeLists.txt @@ -0,0 +1,22 @@ +set(sources rbtree.kk) + +set(koka koka) + + +foreach (source IN LISTS sources) + get_filename_component(basename "${source}" NAME_WE) + set(name "kk-${basename}") + + set(out_dir "${CMAKE_CURRENT_BINARY_DIR}/out/bench") + set(out_path "${out_dir}/${name}") + + add_custom_command( + OUTPUT ${out_path} + COMMAND ${koka} --target=c --stack=128M --outputdir=${out_dir} --buildname=${name} -v -O2 -i$ "${source}" + DEPENDS ${source} + VERBATIM) + + add_custom_target(update-${name} ALL DEPENDS "${out_path}") + add_executable(${name}-exe IMPORTED) + set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${out_path}") +endforeach () diff --git a/koka_bench/koka/rbtree.kk b/koka_bench/koka/rbtree.kk new file mode 100644 index 0000000..4651e0b --- /dev/null +++ b/koka_bench/koka/rbtree.kk @@ -0,0 +1,87 @@ +// Adapted from https://github.com/leanprover/lean4/blob/IFL19/tests/bench/rbmap.lean +import std/num/int32 +import std/os/env + +type color + Red + Black + + +type tree + Node(color : color, lchild : tree, key : int32, value : bool, rchild : tree) + Leaf() + + +fun is-red(t : tree) : bool + match t + Node(Red) -> True + _ -> False + + +fun balance-left(l :tree, k : int32, v : bool, r : tree) : tree + match l + Node(_, Node(Red, lx, kx, vx, rx), ky, vy, ry) + -> Node(Red, Node(Black, lx, kx, vx, rx), ky, vy, Node(Black, ry, k, v, r)) + Node(_, ly, ky, vy, Node(Red, lx, kx, vx, rx)) + -> Node(Red, Node(Black, ly, ky, vy, lx), kx, vx, Node(Black, rx, k, v, r)) + Node(_, lx, kx, vx, rx) + -> Node(Black, Node(Red, lx, kx, vx, rx), k, v, r) + Leaf -> Leaf + + +fun balance-right(l : tree, k : int32, v : bool, r : tree) : tree + match r + Node(_, Node(Red, lx, kx, vx, rx), ky, vy, ry) + -> Node(Red, Node(Black, l, k, v, lx), kx, vx, Node(Black, rx, ky, vy, ry)) + Node(_, lx, kx, vx, Node(Red, ly, ky, vy, ry)) + -> Node(Red, Node(Black, l, k, v, lx), kx, vx, Node(Black, ly, ky, vy, ry)) + Node(_, lx, kx, vx, rx) + -> Node(Black, l, k, v, Node(Red, lx, kx, vx, rx)) + Leaf -> Leaf + + +fun ins(t : tree, k : int32, v : bool) : tree + match t + Node(Red, l, kx, vx, r) + -> if k < kx then Node(Red, ins(l, k, v), kx, vx, r) + elif k > kx then Node(Red, l, kx, vx, ins(r, k, v)) + else Node(Red, l, k, v, r) + Node(Black, l, kx, vx, r) + -> if k < kx then (if is-red(l) then balance-left(ins(l,k,v), kx, vx, r) + else Node(Black, ins(l, k, v), kx, vx, r)) + elif k > kx then (if is-red(r) then balance-right(l, kx, vx, ins(r,k,v)) + else Node(Black, l, kx, vx, ins(r, k, v))) + else Node(Black, l, k, v, r) + Leaf -> Node(Red, Leaf, k, v, Leaf) + + +fun set-black(t : tree) : tree + match t + Node(_, l, k, v, r) -> Node(Black, l, k, v, r) + _ -> t + + +fun insert(t : tree, k : int32, v : bool) : tree + ins(t, k, v).set-black + + +fun fold(t : tree, b : a, f: (int32, bool, a) -> a) : a + match t + Node(_, l, k, v, r) -> r.fold( f(k, v, l.fold(b, f)), f) + Leaf -> b + + +fun make-tree-aux(n : int32, t : tree) : div tree + if n <= zero then t else + val n1 = n.dec + make-tree-aux(n1, insert(t, n1, n1 % 10.int32 == zero)) + +pub fun make-tree(n : int32) : div tree + make-tree-aux(n, Leaf) + + +pub fun main() + val n = get-args().head("").parse-int.default(4200000).int32 + val t = make-tree(n) + val v = t.fold(zero) fn(k,v,r:int32){ if (v) then r.inc else r } + v.show.println diff --git a/koka_bench/kraken_wrapper.sh b/koka_bench/kraken_wrapper.sh new file mode 100755 index 0000000..6270af5 --- /dev/null +++ b/koka_bench/kraken_wrapper.sh @@ -0,0 +1,10 @@ +#!/usr/bin/env bash +OUR_DIR="$(dirname $(readlink -f $0))" +SOURCE="$1" +OUT_DIR="$2" +OUT_NAME="$3" +scheme --script "$OUR_DIR/../partial_eval.scm" $SOURCE +mkdir -p "$OUT_DIR" +mv ./csc_out.wasm "$OUT_DIR/$OUT_NAME.wasm" +printf '#!/usr/bin/env bash\nwasmtime "$(dirname $(readlink -f $0))/'"$OUT_NAME"'.wasm" $@' > "$OUT_DIR/$OUT_NAME" +chmod 755 "$OUT_DIR/$OUT_NAME" diff --git a/koka_bench/rbtree_table.md b/koka_bench/rbtree_table.md new file mode 100644 index 0000000..76fc576 --- /dev/null +++ b/koka_bench/rbtree_table.md @@ -0,0 +1,5 @@ +| Command | Mean [s] | Min [s] | Max [s] | Relative | +|:---|---:|---:|---:|---:| +| `build/kraken/out/bench/kraken-rbtree 42000` | 4.116 ± 0.030 | 4.078 | 4.160 | 862.26 ± 110.34 | +| `build/cpp/cpp-rbtree 42000` | 0.006 ± 0.001 | 0.005 | 0.008 | 1.22 ± 0.20 | +| `build/koka/out/bench/kk-rbtree 42000` | 0.005 ± 0.001 | 0.004 | 0.008 | 1.00 | diff --git a/koka_bench/test.sh b/koka_bench/test.sh new file mode 100755 index 0000000..32ddb99 --- /dev/null +++ b/koka_bench/test.sh @@ -0,0 +1,13 @@ +#!/usr/bin/env bash +set -e + +if [[ ! -d "build" ]] +then + mkdir build + pushd build + nix develop -i -c bash -c 'cmake .. -DCMAKE_BUILD_TYPE=Release && cmake --build .' + popd + rm -rf ./build/CMakeFiles || true +fi + +nix develop -i -c bash -c 'ulimit -s unlimited && find build -type f -executable -name \*rbtree -printf "\"%p 42000\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown rbtree_table.md' diff --git a/rb_tree_test/matching.kp b/rb_tree_test/matching.kp deleted file mode 100644 index 84483ef..0000000 --- a/rb_tree_test/matching.kp +++ /dev/null @@ -1,310 +0,0 @@ -((wrap (vau root_env (quote) -((wrap (vau (let1) -(let1 lambda (vau se (p b1) (wrap (eval (array vau p b1) se))) -(let1 current-env (vau de () de) -(let1 cons (lambda (h t) (concat (array h) t)) -(let1 Y (lambda (f3) - ((lambda (x1) (x1 x1)) - (lambda (x2) (f3 (wrap (vau app_env (& y) (lapply (x2 x2) y app_env))))))) -(let1 vY (lambda (f) - ((lambda (x3) (x3 x3)) - (lambda (x4) (f (vau de1 (& y) (vapply (x4 x4) y de1)))))) -(let1 let (vY (lambda (recurse) (vau de2 (vs b) (cond (= (len vs) 0) (eval b de2) - true (vapply let1 (array (idx vs 0) (idx vs 1) (array recurse (slice vs 2 -1) b)) de2))))) - (let ( - lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args))))) - rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se)) - if (vau de (con than & else) (eval (array cond con than - true (cond (> (len else) 0) (idx else 0) - true false)) de)) - - map (lambda (f5 l5) - (let (helper (rec-lambda recurse (f4 l4 n4 i4) - (cond (= i4 (len l4)) n4 - (<= i4 (- (len l4) 4)) (recurse f4 l4 (concat n4 (array - (f4 (idx l4 (+ i4 0))) - (f4 (idx l4 (+ i4 1))) - (f4 (idx l4 (+ i4 2))) - (f4 (idx l4 (+ i4 3))) - )) (+ i4 4)) - true (recurse f4 l4 (concat n4 (array (f4 (idx l4 i4)))) (+ i4 1))))) - (helper f5 l5 (array) 0))) - - - map_i (lambda (f l) - (let (helper (rec-lambda recurse (f l n i) - (cond (= i (len l)) n - (<= i (- (len l) 4)) (recurse f l (concat n (array - (f (+ i 0) (idx l (+ i 0))) - (f (+ i 1) (idx l (+ i 1))) - (f (+ i 2) (idx l (+ i 2))) - (f (+ i 3) (idx l (+ i 3))) - )) (+ i 4)) - true (recurse f l (concat n (array (f i (idx l i)))) (+ i 1))))) - (helper f l (array) 0))) - - filter_i (lambda (f l) - (let (helper (rec-lambda recurse (f l n i) - (if (= i (len l)) - n - (if (f i (idx l i)) (recurse f l (concat n (array (idx l i))) (+ i 1)) - (recurse f l n (+ i 1)))))) - (helper f l (array) 0))) - filter (lambda (f l) (filter_i (lambda (i x) (f x)) l)) - - ; Huge thanks to Oleg Kiselyov for his fantastic website - ; http://okmij.org/ftp/Computation/fixed-point-combinators.html - Y* (lambda (& l) - ((lambda (u) (u u)) - (lambda (p) - (map (lambda (li) (lambda (& x) (lapply (lapply li (p p)) x))) l)))) - vY* (lambda (& l) - ((lambda (u) (u u)) - (lambda (p) - (map (lambda (li) (vau ide (& x) (vapply (lapply li (p p)) x ide))) l)))) - - let-rec (vau de (name_func body) - (let (names (filter_i (lambda (i x) (= 0 (% i 2))) name_func) - funcs (filter_i (lambda (i x) (= 1 (% i 2))) name_func) - overwrite_name (idx name_func (- (len name_func) 2))) - (eval (array let (concat (array overwrite_name (concat (array Y*) (map (lambda (f) (array lambda names f)) funcs))) - (lapply concat (map_i (lambda (i n) (array n (array idx overwrite_name i))) names))) - body) de))) - let-vrec (vau de (name_func body) - (let (names (filter_i (lambda (i x) (= 0 (% i 2))) name_func) - funcs (filter_i (lambda (i x) (= 1 (% i 2))) name_func) - overwrite_name (idx name_func (- (len name_func) 2))) - (eval (array let (concat (array overwrite_name (concat (array vY*) (map (lambda (f) (array lambda names f)) funcs))) - (lapply concat (map_i (lambda (i n) (array n (array idx overwrite_name i))) names))) - body) de))) - - flat_map (lambda (f l) - (let (helper (rec-lambda recurse (f l n i) - (if (= i (len l)) - n - (recurse f l (concat n (f (idx l i))) (+ i 1))))) - (helper f l (array) 0))) - flat_map_i (lambda (f l) - (let (helper (rec-lambda recurse (f l n i) - (if (= i (len l)) - n - (recurse f l (concat n (f i (idx l i))) (+ i 1))))) - (helper f l (array) 0))) - - ; with all this, we make a destrucutring-capable let - let (let ( - destructure_helper (rec-lambda recurse (vs i r) - (cond (= (len vs) i) r - (array? (idx vs i)) (let (bad_sym (str-to-symbol (str (idx vs i))) - new_vs (flat_map_i (lambda (i x) (array x (array idx bad_sym i))) (idx vs i)) - ) - (recurse (concat new_vs (slice vs (+ i 2) -1)) 0 (concat r (array bad_sym (idx vs (+ i 1)))))) - true (recurse vs (+ i 2) (concat r (slice vs i (+ i 2)))) - ))) (vau de (vs b) (vapply let (array (destructure_helper vs 0 (array)) b) de))) - - ; and a destructuring-capable lambda! - only_symbols (rec-lambda recurse (a i) (cond (= i (len a)) true - (symbol? (idx a i)) (recurse a (+ i 1)) - true false)) - - ; Note that if macro_helper is inlined, the mapping lambdas will close over - ; se, and then not be able to be taken in as values to the maps, and the vau - ; will fail to partially evaluate away. - lambda (let (macro_helper (lambda (p b) (let ( - sym_params (map (lambda (param) (if (symbol? param) param - (str-to-symbol (str param)))) p) - body (array let (flat_map_i (lambda (i x) (array (idx p i) x)) sym_params) b) - ) (array vau sym_params body)))) - (vau se (p b) (if (only_symbols p 0) (vapply lambda (array p b) se) - (wrap (eval (macro_helper p b) se))))) - - ; and rec-lambda - yes it's the same definition again - rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se)) - - nil (array) - not (lambda (x) (if x false true)) - or (let (macro_helper (rec-lambda recurse (bs i) (cond (= i (len bs)) false - (= (+ 1 i) (len bs)) (idx bs i) - true (array let (array 'tmp (idx bs i)) (array if 'tmp 'tmp (recurse bs (+ i 1))))))) - (vau se (& bs) (eval (macro_helper bs 0) se))) - and (let (macro_helper (rec-lambda recurse (bs i) (cond (= i (len bs)) true - (= (+ 1 i) (len bs)) (idx bs i) - true (array let (array 'tmp (idx bs i)) (array if 'tmp (recurse bs (+ i 1)) 'tmp))))) - (vau se (& bs) (eval (macro_helper bs 0) se))) - - - - foldl (let (helper (rec-lambda recurse (f z vs i) (if (= i (len (idx vs 0))) z - (recurse f (lapply f (cons z (map (lambda (x) (idx x i)) vs))) vs (+ i 1))))) - (lambda (f z & vs) (helper f z vs 0))) - foldr (let (helper (rec-lambda recurse (f z vs i) (if (= i (len (idx vs 0))) z - (lapply f (cons (recurse f z vs (+ i 1)) (map (lambda (x) (idx x i)) vs)))))) - (lambda (f z & vs) (helper f z vs 0))) - reverse (lambda (x) (foldl (lambda (acc i) (cons i acc)) (array) x)) - zip (lambda (& xs) (lapply foldr (concat (array (lambda (a & ys) (cons ys a)) (array)) xs))) - - match (let ( - evaluate_case (rec-lambda evaluate_case (access c) (cond - (symbol? c) (array true (lambda (b) (array let (array c access) b))) - (and (array? c) (= 2 (len c)) (= 'unquote (idx c 0))) (array (array = access (idx c 1)) (lambda (b) b)) - (and (array? c) (= 2 (len c)) (= 'quote (idx c 0))) (array (array = access c) (lambda (b) b)) - (array? c) (let ( - tests (array and (array array? access) (array = (len c) (array len access))) - (tests body_func) ((rec-lambda recurse (tests body_func i) (if (= i (len c)) - (array tests body_func) - (let ( (inner_test inner_body_func) (evaluate_case (array idx access i) (idx c i)) ) - (recurse (concat tests (array inner_test)) - (lambda (b) (body_func (inner_body_func b))) - (+ i 1))))) - tests (lambda (b) b) 0) - ) (array tests body_func)) - true (array (array = access c) (lambda (b) b)) - )) - helper (rec-lambda helper (x_sym cases i) (cond (< i (- (len cases) 1)) (let ( (test body_func) (evaluate_case x_sym (idx cases i)) ) - (concat (array test (body_func (idx cases (+ i 1)))) (helper x_sym cases (+ i 2)))) - true (array true (array error "none matched")))) - ) (vau de (x & cases) (eval (array let (array '___MATCH_SYM x) (concat (array cond) (helper '___MATCH_SYM cases 0))) de))) - - ; This is based on https://www.cs.cornell.edu/courses/cs3110/2020sp/a4/deletion.pdf - ; and the figure references refer to it - ; Insert is taken from the same paper, but is origional to Okasaki, I belive - - ; The tree has been modified slightly to take in a comparison function - ; and override if insert replaces or not to allow use as a set or as a map - - ; I think this is actually pretty cool - instead of having a bunch of seperate ['B] - ; be our leaf node, we use ['B] with all nils. This allows us to not use -B, as - ; both leaf and non-leaf 'BB has the same structure with children! Also, we make - ; sure to use empty itself so we don't make a ton of empties... - empty (array 'B nil nil nil) - E empty - EE (array 'BB nil nil nil) - - size (rec-lambda recurse (t) (match t - ,E 0 - (c a x b) (+ 1 (recurse a) (recurse b)))) - - generic-foldl (rec-lambda recurse (f z t) (match t - ,E z - (c a x b) (recurse f (f (recurse f z a) x) b))) - - generic-contains? (rec-lambda recurse (t cmp v found not-found) (match t - ,E (not-found) - (c a x b) (match (cmp v x) '< (recurse a cmp v found not-found) - '= (found x) - '> (recurse b cmp v found not-found)))) - blacken (lambda (t) (match t - ('R a x b) (array 'B a x b) - t t)) - balance (lambda (t) (match t - ; figures 1 and 2 - ('B ('R ('R a x b) y c) z d) (array 'R (array 'B a x b) y (array 'B c z d)) - ('B ('R a x ('R b y c)) z d) (array 'R (array 'B a x b) y (array 'B c z d)) - ('B a x ('R ('R b y c) z d)) (array 'R (array 'B a x b) y (array 'B c z d)) - ('B a x ('R b y ('R c z d))) (array 'R (array 'B a x b) y (array 'B c z d)) - ; figure 8, double black cases - ('BB ('R a x ('R b y c)) z d) (array 'B (array 'B a x b) y (array 'B c z d)) - ('BB a x ('R ('R b y c) z d)) (array 'B (array 'B a x b) y (array 'B c z d)) - ; already balenced - t t)) - generic-insert (lambda (t cmp v replace) (let ( - ins (rec-lambda ins (t) (match t - ,E (array 'R t v t) - (c a x b) (match (cmp v x) '< (balance (array c (ins a) x b)) - '= (if replace (array c a v b) - t) - '> (balance (array c a x (ins b)))))) - ) (blacken (ins t)))) - - rotate (lambda (t) (match t - ; case 1, fig 6 - ('R ('BB a x b) y ('B c z d)) (balance (array 'B (array 'R (array 'B a x b) y c) z d)) - ('R ('B a x b) y ('BB c z d)) (balance (array 'B a x (array 'R b y (array 'B c z d)))) - ; case 2, figure 7 - ('B ('BB a x b) y ('B c z d)) (balance (array 'BB (array 'R (array 'B a x b) y c) z d)) - ('B ('B a x b) y ('BB c z d)) (balance (array 'BB a x (array 'R b y (array 'B c z d)))) - ; case 3, figure 9 - ('B ('BB a w b) x ('R ('B c y d) z e)) (array 'B (balance (array 'B (array 'R (array 'B a w b) x c) y d)) z e) - ('B ('R a w ('B b x c)) y ('BB d z e)) (array 'B a w (balance (array 'B b x (array 'R c y (array 'B d z e))))) - ; fall through - t t)) - - redden (lambda (t) (match t - ('B a x b) (if (and (= 'B (idx a 0)) (= 'B (idx b 0))) (array 'R a x b) - t) - t t)) - - min_delete (rec-lambda recurse (t) (match t - ,E (error "min_delete empty tree") - ('R ,E x ,E) (array x E) - ('B ,E x ,E) (array x EE) - ('B ,E x ('R a y b)) (array x (array 'B a y b)) - (c a x b) (let ((v ap) (recurse a)) (array v (rotate (array c ap x b)))))) - - generic-delete (lambda (t cmp v) (let ( - del (rec-lambda del (t v) (match t - ; figure 3 - ,E t - ; figure 4 - ('R ,E x ,E) (match (cmp v x) '= E - _ t) - ('B ('R a x b) y ,E) (match (cmp v y) '< (rotate (array 'B (del (array 'R a x b) v) y E)) - '= (array 'B a x b) - '> t) - ; figure 5 - ('B ,E x ,E) (match (cmp v x) '= EE - _ t) - (c a x b) (match (cmp v x) '< (rotate (array c (del a v) x b)) - '= (let ((array vp bp) (min_delete b)) - (rotate (array c a vp bp))) - '> (rotate (array c a x (del b v)))))) - ) (del (redden t) v))) - - set-cmp (lambda (a b) (cond (< a b) '< - (= a b) '= - true '>)) - set-empty empty - set-foldl generic-foldl - set-insert (lambda (t x) (generic-insert t set-cmp x false)) - set-contains? (lambda (t x) (generic-contains? t set-cmp x (lambda (f) true) (lambda () false))) - set-remove (lambda (t x) (generic-delete t set-cmp x)) - - map-cmp (lambda (a b) (let (ak (idx a 0) - bk (idx b 0)) - (cond (< ak bk) '< - (= ak bk) '= - true '>))) - map-empty empty - map-insert (lambda (t k v) (generic-insert t map-cmp (array k v) true)) - map-contains-key? (lambda (t k) (generic-contains? t map-cmp (array k nil) (lambda (f) true) (lambda () false))) - map-get (lambda (t k) (generic-contains? t map-cmp (array k nil) (lambda (f) (idx f 1)) (lambda () (error (str "didn't find key " k " in map " t))))) - map-get-or-default (lambda (t k d) (generic-contains? t map-cmp (array k nil) (lambda (f) (idx f 1)) (lambda () d))) - map-get-with-default (lambda (t k d) (generic-contains? t map-cmp (array k nil) (lambda (f) (idx f 1)) (lambda () (d)))) - map-remove (lambda (t k) (generic-delete t map-cmp (array k nil))) - - ; This could be 2x as efficent by being implmented on generic instead of map, - ; as we wouldn't have to traverse once to find and once to insert - multimap-empty map-empty - multimap-insert (lambda (t k v) (map-insert t k (set-insert (map-get-or-default t k set-empty) v))) - multimap-get (lambda (t k) (map-get-or-default t k set-empty)) - - - - make-test-tree (rec-lambda make-test-tree (n t) (cond (<= n 0) t - true (make-test-tree (- n 1) (map-insert t n (= 0 (% n 10)))))) - reduce-test-tree (lambda (tree) (generic-foldl (lambda (a x) (if (idx x 1) (+ a 1) a)) 0 tree)) - - monad (array 'write 1 (str "running tree test") (vau (written code) - (array 'exit (log (reduce-test-tree (make-test-tree (log 420000) map-empty)))) - ;(array 'read 0 60 (vau (data code) - ; (array 'exit (log (reduce-test-tree (make-test-tree (read-string data) map-empty)))) - ;)) - )) - - ) monad) -; end of all lets -)))))) -; impl of let1 -)) (vau de (s v b) (eval (array (array wrap (array vau (array s) b)) v) de))) -; impl of quote -)) (vau (x5) x5)) diff --git a/working_files/rb_profile.txt b/working_files/rb_profile.txt new file mode 100644 index 0000000..34e0bb3 --- /dev/null +++ b/working_files/rb_profile.txt @@ -0,0 +1,29 @@ +Samples: 27K of event 'cycles:u', Event count (approx.): 16890753964 +Overhead Command Shared Object Symbol + 33.05% wasmtime jitted-1267703-13.so [.] wasm::wasm-function[16] + 12.64% wasmtime jitted-1267703-12.so [.] wasm::wasm-function[15] + 10.48% wasmtime jitted-1267703-2.so [.] wasm::wasm-function[5] + 10.11% wasmtime jitted-1267703-0.so [.] wasm::wasm-function[3] + 9.95% wasmtime jitted-1267703-528.so [.] wasm::wasm-function[531] + 4.12% wasmtime jitted-1267703-526.so [.] wasm::wasm-function[529] + 4.02% wasmtime jitted-1267703-85.so [.] wasm::wasm-function[88] + 3.01% wasmtime jitted-1267703-39.so [.] wasm::wasm-function[42] + 2.42% wasmtime jitted-1267703-1.so [.] wasm::wasm-function[4] + 1.19% wasmtime jitted-1267703-87.so [.] wasm::wasm-function[90] + 1.18% wasmtime jitted-1267703-37.so [.] wasm::wasm-function[40] + 0.97% wasmtime jitted-1267703-3.so [.] wasm::wasm-function[6] + 0.88% wasmtime jitted-1267703-23.so [.] wasm::wasm-function[26] + 0.83% wasmtime jitted-1267703-134.so [.] wasm::wasm-function[137] + 0.79% wasmtime jitted-1267703-582.so [.] wasm::wasm-function[585] + 0.63% wasmtime jitted-1267703-132.so [.] wasm::wasm-function[135] + 0.49% wasmtime jitted-1267703-99.so [.] wasm::wasm-function[102] + 0.30% wasmtime jitted-1267703-524.so [.] wasm::wasm-function[527] + 0.29% wasmtime jitted-1267703-14.so [.] wasm::wasm-function[17] + 0.28% wasmtime jitted-1267703-133.so [.] wasm::wasm-function[136] + 0.24% wasmtime jitted-1267703-525.so [.] wasm::wasm-function[528] + 0.23% wasmtime jitted-1267703-41.so [.] wasm::wasm-function[44] + 0.17% wasmtime jitted-1267703-581.so [.] wasm::wasm-function[584] + 0.14% wasmtime jitted-1267703-488.so [.] wasm::wasm-function[491] + 0.14% wasmtime jitted-1267703-523.so [.] wasm::wasm-function[526] + 0.12% wasmtime jitted-1267703-131.so [.] wasm::wasm-function[134] +