├── .gitignore ├── LICENCE.md ├── README.md ├── flake.lock ├── flake.nix ├── ki ├── .gitignore ├── Cargo.lock ├── Cargo.toml ├── build.rs └── src │ ├── grammar.lalrpop │ ├── lib.rs │ ├── main.rs │ └── test.rs ├── koka_bench ├── .gitignore ├── CMakeLists.txt ├── LICENSE ├── README.md ├── copy_wrapper.sh ├── cpp │ ├── CMakeLists.txt │ ├── cfold.cpp │ ├── deriv.cpp │ ├── fib.cpp │ ├── nqueens.cpp │ └── rbtree.cpp ├── haskell │ ├── CMakeLists.txt │ ├── cfold.hs │ ├── deriv.hs │ ├── nqueens.hs │ └── rbtree.hs ├── java │ ├── CMakeLists.txt │ ├── cfold.java │ ├── deriv.java │ ├── nqueens.java │ └── rbtree.java ├── java_wrapper.sh ├── koka │ ├── CMakeLists.txt │ ├── cfold.kk │ ├── deriv.kk │ ├── fib.kk │ ├── nqueens-int.kk │ ├── nqueens.kk │ └── rbtree.kk ├── kraken │ ├── CMakeLists.txt │ ├── cfold.kp │ ├── deriv.kp │ ├── fib-let.kp │ ├── fib.kp │ ├── nqueens.kp │ ├── rbtree-opt.kp │ ├── rbtree.kp │ └── test.sh ├── kraken_wrapper.sh ├── new_test.sh ├── newlisp │ ├── CMakeLists.txt │ ├── newlisp-builtin-rbtree.nl │ ├── newlisp-fib-let.nl │ ├── newlisp-fib.nl │ ├── newlisp-macro-cfold.nl │ ├── newlisp-macro-deriv.nl │ ├── newlisp-macro-fib-let.nl │ ├── newlisp-macro-fib.nl │ ├── newlisp-macro-nqueens.nl │ ├── newlisp-macro-rbtree.nl │ ├── newlisp-slow-fexpr-cfold.nl │ ├── newlisp-slow-fexpr-deriv.nl │ ├── newlisp-slow-fexpr-fib-let.nl │ ├── newlisp-slow-fexpr-fib.nl │ ├── newlisp-slow-fexpr-nqueens.nl │ └── newlisp-slow-fexpr-rbtree.nl ├── ocaml │ ├── CMakeLists.txt │ ├── cfold.ml │ ├── deriv.ml │ ├── nqueens.ml │ └── rbtree.ml ├── picolisp │ ├── CMakeLists.txt │ ├── picolisp-cfold.l │ ├── picolisp-deriv.l │ ├── picolisp-fib-let.l │ ├── picolisp-fib.l │ ├── picolisp-nqueens.l │ └── picolisp-rbtree.l ├── plot_demo.py ├── python │ ├── CMakeLists.txt │ ├── python-fib-let.py │ └── python-fib.py ├── relative.py ├── scheme │ ├── CMakeLists.txt │ ├── scheme-fib-let.scm │ ├── scheme-fib.scm │ └── scheme-nqueens.scm ├── swift │ ├── CMakeLists.txt │ ├── cfold.swift │ ├── deriv.swift │ ├── nqueens.swift │ └── rbtree.swift └── test.sh ├── slj ├── Cargo.lock ├── Cargo.toml ├── build.rs └── src │ ├── grammar.lalrpop │ ├── grammer.lalrpoplib.rs │ ├── lib.rs │ └── main.rs └── website ├── Inter.var.woff2 ├── JetBrainsMono-Regular.woff2 ├── LICENSE ├── Recursive.woff2 ├── codejar.js ├── default.min.css ├── favicon.ico ├── highlight.min.js ├── images ├── Kraken_Call_PE_Semantics.png ├── Kraken_NonCall_PE_Semantics.png ├── Kraken_aux_helpers.png ├── Kraken_aux_helpers2.png ├── Kraken_aux_helpers3.png ├── Kraken_pe_primitives.png ├── cfold_table.csv_.png ├── cfold_table.csv_log.png ├── deriv_table.csv_.png ├── deriv_table.csv_log.png ├── fib_table.csv_.png ├── fib_table.csv_log.png ├── lisp_timeline_screenshot.png ├── lisp_timeline_screenshot_edited.png ├── lisp_timeline_screenshot_edited.xcf ├── nqueens_table.csv_.png ├── nqueens_table.csv_log.png ├── overview.png ├── rbtree_table.csv_.png ├── rbtree_table.csv_log.png ├── slow_cfold_table.csv_.png ├── slow_cfold_table.csv_log.png ├── slow_deriv_table.csv_.png ├── slow_deriv_table.csv_log.png ├── slow_fib_table.csv_.png ├── slow_fib_table.csv_log.png ├── slow_ish_rbtree_table.csv_.png ├── slow_ish_rbtree_table.csv_log.png ├── slow_nqueens_table.csv_.png ├── slow_nqueens_table.csv_log.png ├── slow_rbtree_table.csv_.png └── slow_rbtree_table.csv_log.png ├── index.html ├── index2.html ├── quals_presentation.html ├── recursive.css ├── remark-latest.min.js └── slick.css /.gitignore: -------------------------------------------------------------------------------- 1 | _site 2 | build 3 | build-ninja 4 | *.swp 5 | *.swm 6 | *.swn 7 | *.swo 8 | *.swl 9 | *.swi 10 | *.swj 11 | *.swk 12 | .*.un~ 13 | callgrind* 14 | .stfolder 15 | *.wasm 16 | */target 17 | -------------------------------------------------------------------------------- /LICENCE.md: -------------------------------------------------------------------------------- 1 | Copyright Nathan Braswell 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 4 | 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 6 | 7 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 8 | 9 | Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by: 10 | 11 | (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of contributors, in source or binary form) alone; or 12 | 13 | (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution. 14 | 15 | Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this license, whether expressly, by implication, estoppel or otherwise. 16 | 17 | DISCLAIMER 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Kraken 2 | ====== 3 | 4 | The Kraken Programming Language 5 | 6 | (more information online at http://kraken-lang.org/ which is also under construction / needs to be updated / has a try-it-online feature for an older version without partial evaluation) 7 | 8 | *Heavily* inspiried by John Shutt's thesis: https://web.wpi.edu/Pubs/ETD/Available/etd-090110-124904/unrestricted/jshutt.pdf 9 | with partial evaluation during compilation to make it efficient. 10 | 11 | Currently developing the fourth iteration, a Scheme-like based on a functional Vau calculus JIT compiled for speed. 12 | 13 | Working up to a JIT for fexprs by starting with 14 | 15 | - [ ] slj - a Simple Lisp JIT (WIP) 16 | - [ ] clj - a continuation lisp JIT? 17 | - [ ] mlj - a mutation lisp JIT? 18 | - [ ] flj - a fexpr Lisp JIT? 19 | - [x] ki - A fexpr interpeter with mutation and delimited continuations 20 | - [ ] kj - A fexpr+mutation+delimited continuations JIT 21 | 22 | 23 | koka_bench: Licensed under Apache-2.0, as they are derived from the benchmarks of the Koka project, see the readme and license in koka_bench for more, or https://github.com/koka-lang/koka for the source project. 24 | 25 | Kraken (everything else besides the benchmarks in koka_bench, and Recursive/CodeJar/Highlight.js in website/) Licensed under 26 | SPDX-License-Identifier: BSD-2-Clause-Patent 27 | 28 | Note: This license is designed to provide: a) a simple permissive license; b) that is compatible with the GNU General Public License (GPL), version 2; and c) which also has an express patent grant included. 29 | 30 | (Note taken from https://opensource.org/licenses/BSDplusPatent ) 31 | 32 | 33 | 34 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "flake-utils": { 4 | "inputs": { 5 | "systems": "systems" 6 | }, 7 | "locked": { 8 | "lastModified": 1694529238, 9 | "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=", 10 | "owner": "numtide", 11 | "repo": "flake-utils", 12 | "rev": "ff7b65b44d01cf9ba6a71320833626af21126384", 13 | "type": "github" 14 | }, 15 | "original": { 16 | "owner": "numtide", 17 | "repo": "flake-utils", 18 | "type": "github" 19 | } 20 | }, 21 | "flake-utils_2": { 22 | "inputs": { 23 | "systems": "systems_2" 24 | }, 25 | "locked": { 26 | "lastModified": 1681202837, 27 | "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=", 28 | "owner": "numtide", 29 | "repo": "flake-utils", 30 | "rev": "cfacdce06f30d2b68473a46042957675eebb3401", 31 | "type": "github" 32 | }, 33 | "original": { 34 | "owner": "numtide", 35 | "repo": "flake-utils", 36 | "type": "github" 37 | } 38 | }, 39 | "moz_overlay": { 40 | "inputs": { 41 | "flake-utils": "flake-utils_2", 42 | "nixpkgs": "nixpkgs" 43 | }, 44 | "locked": { 45 | "lastModified": 1700360261, 46 | "narHash": "sha256-8fRSHx5osjDELHSL7OHEfj/cOh8q+B7M9EF/yPR3bw8=", 47 | "owner": "oxalica", 48 | "repo": "rust-overlay", 49 | "rev": "45066cb0b2505d8da581be8432a16238c867f199", 50 | "type": "github" 51 | }, 52 | "original": { 53 | "owner": "oxalica", 54 | "repo": "rust-overlay", 55 | "type": "github" 56 | } 57 | }, 58 | "nixpkgs": { 59 | "locked": { 60 | "lastModified": 1681358109, 61 | "narHash": "sha256-eKyxW4OohHQx9Urxi7TQlFBTDWII+F+x2hklDOQPB50=", 62 | "owner": "NixOS", 63 | "repo": "nixpkgs", 64 | "rev": "96ba1c52e54e74c3197f4d43026b3f3d92e83ff9", 65 | "type": "github" 66 | }, 67 | "original": { 68 | "owner": "NixOS", 69 | "ref": "nixpkgs-unstable", 70 | "repo": "nixpkgs", 71 | "type": "github" 72 | } 73 | }, 74 | "nixpkgs_unstable": { 75 | "locked": { 76 | "lastModified": 1700412808, 77 | "narHash": "sha256-1yU5WT0sfRJ2DOVZ+6oDdpUZ6j0hz0JBPpbqj8/VCJQ=", 78 | "owner": "NixOS", 79 | "repo": "nixpkgs", 80 | "rev": "38b1656c2d775b6abc6d08cfc8f38b8847a73ec4", 81 | "type": "github" 82 | }, 83 | "original": { 84 | "owner": "NixOS", 85 | "repo": "nixpkgs", 86 | "type": "github" 87 | } 88 | }, 89 | "root": { 90 | "inputs": { 91 | "flake-utils": "flake-utils", 92 | "moz_overlay": "moz_overlay", 93 | "nixpkgs_unstable": "nixpkgs_unstable" 94 | } 95 | }, 96 | "systems": { 97 | "locked": { 98 | "lastModified": 1681028828, 99 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 100 | "owner": "nix-systems", 101 | "repo": "default", 102 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 103 | "type": "github" 104 | }, 105 | "original": { 106 | "owner": "nix-systems", 107 | "repo": "default", 108 | "type": "github" 109 | } 110 | }, 111 | "systems_2": { 112 | "locked": { 113 | "lastModified": 1681028828, 114 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 115 | "owner": "nix-systems", 116 | "repo": "default", 117 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 118 | "type": "github" 119 | }, 120 | "original": { 121 | "owner": "nix-systems", 122 | "repo": "default", 123 | "type": "github" 124 | } 125 | } 126 | }, 127 | "root": "root", 128 | "version": 7 129 | } 130 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "Env for Kraken and the extacted Koka bencmarks"; 3 | inputs = { 4 | # For some reason the newer one has broken koka/emscripten (probs same change) 5 | #nixpkgs_stable_new.url = "nixpkgs/nixos-22.11"; 6 | #nixpkgs_stable_old.url = "nixpkgs/nixos-21.11"; 7 | nixpkgs_unstable.url = "github:NixOS/nixpkgs"; 8 | moz_overlay.url = "github:oxalica/rust-overlay"; 9 | flake-utils.url = "github:numtide/flake-utils"; 10 | }; 11 | outputs = { self, 12 | #nixpkgs_stable_new, nixpkgs_stable_old, 13 | nixpkgs_unstable, moz_overlay, flake-utils }: 14 | (flake-utils.lib.eachDefaultSystem (system: 15 | let 16 | pkgs_new = import nixpkgs_unstable { 17 | inherit system; 18 | overlays = [ moz_overlay.overlay ]; 19 | }; 20 | #pkgs_old = import nixpkgs_stable_old { 21 | # inherit system; 22 | # overlays = [ moz_overlay.overlay ]; 23 | #}; 24 | #newlisp = pkgs.stdenv.mkDerivation rec { 25 | #pname = "newLisp"; 26 | #version = "10.7.5"; 27 | 28 | #src = pkgs.fetchurl { 29 | #url = "http://www.newlisp.org/downloads/newlisp-10.7.5.tgz"; 30 | #sha256 = "sha256-3C0P9lHCsnW8SvOvi6WYUab7bh6t3CCudftgsekBJuw="; 31 | #}; 32 | 33 | #nativeBuildInputs = [ 34 | #pkgs.autoPatchelfHook 35 | #]; 36 | 37 | #buildInputs = [ 38 | #pkgs.stdenv.cc.cc.lib 39 | #pkgs.libffi 40 | #pkgs.readline 41 | #]; 42 | 43 | #installPhase = '' 44 | #mkdir -p $out/bin 45 | #cp newlisp $out/bin 46 | #''; 47 | 48 | #meta = with pkgs.lib; { 49 | #homepage = "http://www.newlisp.org/index.cgi"; 50 | #description = "A Lisp-like, general-purpose scripting language"; 51 | #platforms = platforms.linux; 52 | #}; 53 | #}; 54 | #wavm = pkgs.stdenv.mkDerivation rec { 55 | #pname = "wavm"; 56 | #version = "0.0.0"; 57 | 58 | #src = pkgs.fetchurl { 59 | #url = "https://github.com/WAVM/WAVM/releases/download/nightly%2F2022-05-14/wavm-0.0.0-prerelease-linux.tar.gz"; 60 | #sha256 = "sha256-+PpnwPJDty6XCjjuHVFwiHc1q+k0zPF11EbRpqSKfyY="; 61 | #}; 62 | 63 | #nativeBuildInputs = [ 64 | #pkgs.autoPatchelfHook 65 | #]; 66 | 67 | #buildInputs = [ 68 | #pkgs.stdenv.cc.cc.lib 69 | #]; 70 | 71 | #sourceRoot = "."; 72 | 73 | #installPhase = '' 74 | #mkdir -p $out/bin 75 | #cp -r bin/wavm $out/bin/ 76 | #cp -r include/ $out 77 | #cp -r lib64/ $out 78 | #cp -r share/ $out 79 | ##install -m755 -D studio-link-standalone-v${version} $out/bin/studio-link 80 | #''; 81 | 82 | #meta = with pkgs.lib; { 83 | #homepage = "https://wavm.github.io/"; 84 | #description = "WAVM WebAssembly Engine"; 85 | #platforms = platforms.linux; 86 | #}; 87 | #}; 88 | in { 89 | devShell = pkgs_new.mkShell { 90 | buildInputs = with pkgs_new; [ 91 | which # used for shell stuff when inside pure env 92 | 93 | hyperfine 94 | graph-cli # is this just for python?! 95 | 96 | chicken gambit-unstable chez 97 | #gambit 98 | 99 | wabt wasmtime #wavm 100 | #wasm3 101 | 102 | clang cmake 103 | cargo cargo-flamegraph 104 | #(rust-bin.stable.latest.default.override { targets = [ "wasm32-wasi" ]; }) 105 | #stack (haskellPackages.ghcWithPackages (p: [p.parallel])) 106 | koka 107 | #pkgs_old.emscripten 108 | 109 | #picolisp 110 | #newlisp 111 | ]; 112 | }; 113 | } 114 | )); 115 | } 116 | -------------------------------------------------------------------------------- /ki/.gitignore: -------------------------------------------------------------------------------- 1 | target 2 | -------------------------------------------------------------------------------- /ki/Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | name = "ki" 3 | version = "0.1.0" 4 | edition = "2021" 5 | build = "build.rs" 6 | 7 | # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html 8 | 9 | 10 | [profile.bench] 11 | debug = true 12 | 13 | [dependencies] 14 | lalrpop-util = {version="0.19.7", features=["lexer"]} 15 | regex = "1" 16 | once_cell = "1.17.0" 17 | anyhow = "1" 18 | 19 | [build-dependencies] 20 | lalrpop = "0.19.7" 21 | -------------------------------------------------------------------------------- /ki/build.rs: -------------------------------------------------------------------------------- 1 | extern crate lalrpop; 2 | 3 | fn main() { 4 | lalrpop::process_root().unwrap(); 5 | } 6 | -------------------------------------------------------------------------------- /ki/src/grammar.lalrpop: -------------------------------------------------------------------------------- 1 | use std::str::FromStr; 2 | use std::rc::Rc; 3 | use ki::Form; 4 | 5 | grammar; 6 | 7 | pub Term: Rc
= { 8 | NUM => Rc::new(Form::Int(i32::from_str(<>).unwrap())), 9 | SYM => Rc::new(Form::Symbol(<>.to_owned())), 10 | "(" ")" => <>.unwrap_or(Rc::new(Form::Nil)), 11 | "'" => Rc::new(Form::Pair(Rc::new(Form::Symbol("quote".to_owned())), Rc::new(Form::Pair(<>, Rc::new(Form::Nil))))), 12 | "!" => { 13 | h.append(t).unwrap() 14 | }, 15 | }; 16 | ListInside: Rc = { 17 | => Rc::new(Form::Pair(<>, Rc::new(Form::Nil))), 18 | => Rc::new(Form::Pair(h, t)), 19 | "." => Rc::new(Form::Pair(a, d)), 20 | } 21 | match { 22 | "(", 23 | ")", 24 | ".", 25 | "'", 26 | "!", 27 | r"[0-9]+" => NUM, 28 | r"[a-zA-Z+*/_=?%&|^<>-][\w+*/=_?%&|^<>-]*" => SYM, 29 | r"(;[^\n]*\n)|\s+" => { } 30 | } 31 | 32 | -------------------------------------------------------------------------------- /ki/src/main.rs: -------------------------------------------------------------------------------- 1 | #[macro_use] extern crate lalrpop_util; 2 | lalrpop_mod!(pub grammar); 3 | 4 | use std::rc::Rc; 5 | 6 | use ki::{root_env,eval}; 7 | 8 | #[cfg(test)] 9 | mod test; 10 | 11 | fn main() { 12 | //let input = "(= 17 ((vau d p (+ (eval (car p) d) 13)) (+ 1 3)))"; 13 | //let input = "(+ 1 3)"; 14 | let input = "(= (+ 1 3) (* 2 2))"; 15 | let parsed_input = grammar::TermParser::new().parse(input).unwrap(); 16 | //println!("Parsed input is {} - {:?}", parsed_input, parsed_input); 17 | let root = root_env(); 18 | let result = eval(Rc::clone(&root), Rc::clone(&parsed_input)); 19 | println!("Result is {} - {:?}", result, result); 20 | } 21 | 22 | -------------------------------------------------------------------------------- /koka_bench/.gitignore: -------------------------------------------------------------------------------- 1 | build/ 2 | *.hi 3 | *.o 4 | *.cmi 5 | *.cmx 6 | -------------------------------------------------------------------------------- /koka_bench/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.16) 2 | project(KokaBench) 3 | 4 | get_property(isMultiConfig GLOBAL PROPERTY GENERATOR_IS_MULTI_CONFIG) 5 | if (NOT isMultiConfig AND NOT DEFINED CMAKE_BUILD_TYPE) 6 | set(CMAKE_BUILD_TYPE Release) 7 | endif () 8 | 9 | enable_testing() 10 | 11 | add_subdirectory(kraken) 12 | #add_subdirectory(koka) 13 | #add_subdirectory(cpp) 14 | #add_subdirectory(haskell) 15 | #add_subdirectory(java) 16 | #add_subdirectory(ocaml) 17 | #add_subdirectory(swift) 18 | 19 | add_subdirectory(python) 20 | add_subdirectory(scheme) 21 | add_subdirectory(picolisp) 22 | add_subdirectory(newlisp) 23 | -------------------------------------------------------------------------------- /koka_bench/README.md: -------------------------------------------------------------------------------- 1 | # NOTE 2 | 3 | These are the benchmarks extracted from the Koka repository https://github.com/koka-lang/koka 4 | at b1670308f88dd1fc6c22cad28385fcb185d5b27d from the test/bench directory 5 | and modified by me to run inside a reproducable environment defined by a Nix Flake, 6 | and to use Bash to coordinate and Hyperfine to time instead of the Koka based runner. 7 | 8 | **It is under the Apache 2 License to match the source Koka, not BSD-2-Clause-Patent of the rest of Kraken** 9 | 10 | ./test.sh will build and run the benchmarks. 11 | 12 | I'm slowly porting them over to the Kraken project, and adding Kraken versions of each one. 13 | 14 | 15 | ## Some explanation from a PLDI Readme originally included: 16 | 17 | Available languages are: 18 | 19 | - `kk` : Koka v2.1.1 compiling using gcc 9.3.0. 20 | - `kkx` : Koka v2.1.1 compiling using gcc 9.3.0 but without reuse optimization (Section 2.4). 21 | - `ml` : OCaml v4.08.1 using the optimizing compiler (`ocamlopt`) 22 | - `hs` : Haskell GHC 8.6.5. 23 | - `sw` : Swift 5.3.3. 24 | - `jv` : Java 15.0.2, Java(TM) SE Runtime Environment (build 15.0.2+7-27), 25 | Java HotSpot(TM) 64-Bit Server VM (build 15.0.2+7-27, mixed mode, sharing). 26 | - `cpp` : GCC 9.3.0, 27 | 28 | Available tests are described in detail in Section 4 and are: 29 | 30 | - `rbtree` : inserts 42 million items into a red-black tree. 31 | - `rbtree-ck` : a variant of rbtree that keeps a list of every 5th subtree and thus shares many subtrees. 32 | - `deriv` : the symbolic derivative of a large expression. 33 | - `nqueens` : calculates all solutions for the n-queens problem of size 13 into a list, and returns the length of that list. 34 | - `cfold` : constant-folding over a large symbolic expression. 35 | 36 | 37 | # Original README follows: 38 | 39 | 40 | # Build and run benchmarks 41 | 42 | This contains the standard benchmark suite (discussed in detail in [Perceus] paper). 43 | It is still basic but more benchmarks 44 | with effect handlers are coming. The suite can run on (Ubuntu Linux), WSL2, and macOS, 45 | and the benchmarks need: 46 | 47 | - `gcc`. Should be there, otherwise use `sudo apt install gcc`, 48 | - `ghc`. Use `sudo apt install ghc`, 49 | - `ocamlopt`. Use `sudo apt install ocaml`. 50 | We used the new multi-core OCaml, see 51 | for installation instructions (including `domainslib` for the binarytrees benchmark) 52 | ``` 53 | > opam update 54 | > opam switch create 4.12.0+domains+effects --repositories=multicore=git+https://github.com/ocaml-multicore/multicore-opam.git,default 55 | > opam install dune domainslib 56 | ``` 57 | 58 | - `swiftc`. The Swift compiler can be downloaded [here](https://swift.org/download/). 59 | The benchmarks expect `swiftc` to be installed at `/opt/swift/bin`, 60 | so unpack and copy everything under `swift-.../usr` to `/opt/swift/bin`: 61 | ``` 62 | > tar -xzf swift-5.5-RELEASE-ubuntu20.04.tar.gz 63 | > cd swift-5.5-RELEASE-ubuntu20.04/usr 64 | > sudo mkdir /opt/swift 65 | > sudo cp -r * /opt/swift 66 | ``` 67 | 68 | - `javac`/`java`. We used these [instructions](https://www.linuxcapable.com/how-to-install-java-17-lts-jdk-17-on-ubuntu-20-04/) 69 | to install the Java SE 17 Hotspot compiler: 70 | ``` 71 | > sudo apt update 72 | > sudo add-apt-repository ppa:linuxuprising/java 73 | > sudo apt-get -y install oracle-java17-installer oracle-java17-set-default 74 | > java --version 75 | java 17 2021-09-14 LTS 76 | Java(TM) SE Runtime Environment (build 17+35-LTS-2724) 77 | Java HotSpot(TM) 64-Bit Server VM (build 17+35-LTS-2724, mixed mode, sharing) 78 | ``` 79 | 80 | The benchmarks can now be build using: 81 | 82 | ``` 83 | > cd test/bench 84 | > mkdir build 85 | > cd build 86 | > cmake .. -DCMAKE_BUILD_TYPE=Release 87 | > cmake --build . 88 | ``` 89 | 90 | For some benchmarks, like `cfold`, we may need a large stack, so it may be good to raise the limit: 91 | ``` 92 | > ulimit -s unlimited 93 | ``` 94 | 95 | We can then run all benchmarks as: 96 | ``` 97 | > ctest . 98 | ``` 99 | Or only run benchmarks for one language with `-L `: 100 | ``` 101 | > ctest -L koka 102 | ``` 103 | Or run specific benchmarks using `-R `, 104 | like the symbolic derivative benchmark: 105 | ``` 106 | > ctest -R deriv 107 | Test project /home/daan/dev/koka/test/bench/build 108 | Start 4: hs-deriv 109 | 1/4 Test #4: hs-deriv ......................... Passed 2.29 sec 110 | Start 10: kk-deriv 111 | 2/4 Test #10: kk-deriv ......................... Passed 1.25 sec 112 | Start 19: ml-deriv 113 | 3/4 Test #19: ml-deriv ......................... Passed 1.73 sec 114 | Start 25: sw-deriv 115 | 4/4 Test #25: sw-deriv ......................... Passed 2.88 sec 116 | 117 | 100% tests passed, 0 tests failed out of 4 118 | ... 119 | ``` 120 | 121 | We can also run the tests using the `test/bench/bench.kk` script instead of 122 | using `ctest` which also measures peak working set and calculates 123 | normalized scores. For example, from the `build` directory, we can run all benchmarks as: 124 | ``` 125 | > koka -e ../bench 126 | ``` 127 | Use the `--lang` or `--test` options to specify a comma separated list of 128 | languages or benchmarks: 129 | ``` 130 | > koka -e ../bench -- --lang=koka,ocaml --test=rbtree,rbtree-ck 131 | ``` 132 | The `-i` switch runs `N` iterations on each benchmark and calculates 133 | the average and the error interval. 134 | -------------------------------------------------------------------------------- /koka_bench/copy_wrapper.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | OUR_DIR="$(dirname $(readlink -f $0))" 3 | SOURCE="$1" 4 | OUT_DIR="$2" 5 | OUT_NAME="$3" 6 | 7 | mkdir -p "$OUT_DIR" 8 | cp $SOURCE "$OUT_DIR/$OUT_NAME" 9 | -------------------------------------------------------------------------------- /koka_bench/cpp/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | set(CMAKE_CXX_STANDARD 17) 2 | set(CMAKE_CXX_STANDARD_REQUIRED YES) 3 | set(CMAKE_CXX_EXTENSIONS NO) 4 | 5 | foreach (source IN ITEMS rbtree.cpp nqueens.cpp cfold.cpp deriv.cpp fib.cpp) 6 | get_filename_component(name "${source}" NAME_WE) 7 | set(name "cpp-${name}") 8 | 9 | add_executable(${name} ${source}) 10 | if(source MATCHES "binarytrees.cpp") 11 | target_link_libraries(${name} pthread) 12 | endif() 13 | 14 | add_test(NAME ${name} COMMAND ${name}) 15 | set_tests_properties(${name} PROPERTIES LABELS cpp) 16 | endforeach () 17 | -------------------------------------------------------------------------------- /koka_bench/cpp/cfold.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | enum Kind { 6 | Val, 7 | Var, 8 | Add, 9 | Mul, 10 | }; 11 | 12 | class Expr { 13 | public: 14 | Kind kind; 15 | Expr(Kind k) { 16 | this->kind = k; 17 | } 18 | }; 19 | 20 | class ValExpr : public Expr { 21 | public: 22 | long value; 23 | ValExpr(long i) : Expr(Val) { 24 | this->value = i; 25 | } 26 | }; 27 | 28 | class VarExpr : public Expr { 29 | public: 30 | long name; 31 | VarExpr( long n ) : Expr(Var) { 32 | this->name = n; 33 | } 34 | }; 35 | 36 | class AddExpr : public Expr { 37 | public: 38 | const Expr* left; 39 | const Expr* right; 40 | AddExpr( const Expr* e1, const Expr* e2 ) : Expr(Add) { 41 | this->left = e1; 42 | this->right = e2; 43 | } 44 | }; 45 | 46 | class MulExpr : public Expr { 47 | public: 48 | const Expr* left; 49 | const Expr* right; 50 | MulExpr( const Expr* e1, const Expr* e2 ) : Expr(Mul) { 51 | this->left = e1; 52 | this->right = e2; 53 | } 54 | }; 55 | 56 | 57 | static const Expr* mk_expr( long n, long v ) { 58 | if (n==0) { 59 | if (v==0) return new VarExpr(1); 60 | else return new ValExpr(v); 61 | } 62 | else { 63 | return new AddExpr(mk_expr(n-1,v+1),mk_expr(n-1,v == 0 ? 0 : v - 1)); 64 | } 65 | } 66 | 67 | static const Expr* append_add( const Expr* e1, const Expr* e2 ) { 68 | if (e1->kind == Add) { 69 | const AddExpr* x = (AddExpr*)e1; 70 | return new AddExpr( x->left, append_add(x->right, e2)); 71 | } 72 | else { 73 | return new AddExpr(e1,e2); 74 | } 75 | } 76 | 77 | static const Expr* append_mul( const Expr* e1, const Expr* e2 ) { 78 | if (e1->kind == Mul) { 79 | const MulExpr* x = (MulExpr*)e1; 80 | return new MulExpr( x->left, append_mul(x->right, e2)); 81 | } 82 | else { 83 | return new MulExpr(e1,e2); 84 | } 85 | } 86 | 87 | static const Expr* reassoc( const Expr* e ) { 88 | if (e->kind == Add) { 89 | const AddExpr* x = (AddExpr*)e; 90 | return append_add( reassoc(x->left), reassoc(x->right) ); 91 | } 92 | else if (e->kind == Mul) { 93 | const MulExpr* x = (MulExpr*)e; 94 | return append_mul( reassoc(x->left), reassoc(x->right) ); 95 | } 96 | else return e; 97 | } 98 | 99 | static const Expr* const_folding( const Expr* e ) { 100 | if (e->kind == Add) { 101 | const Expr* e1 = ((AddExpr*)e)->left; 102 | const Expr* e2 = ((AddExpr*)e)->right; 103 | if (e1->kind == Val && e2->kind==Val) { 104 | return new ValExpr( ((ValExpr*)e1)->value + ((ValExpr*)e2)->value ); 105 | } 106 | else if (e1->kind == Val && e2->kind==Add && ((AddExpr*)e2)->right->kind == Val) { 107 | AddExpr* b = (AddExpr*)e2; 108 | ValExpr* v = (ValExpr*)(b->right); 109 | return new AddExpr( new ValExpr(((ValExpr*)e1)->value + v->value ), b->left ); 110 | } 111 | else if (e1->kind == Val && e2->kind==Add && ((AddExpr*)e2)->left->kind == Val) { 112 | AddExpr* b = (AddExpr*)e2; 113 | ValExpr* v = (ValExpr*)(b->left); 114 | return new AddExpr( new ValExpr(((ValExpr*)e1)->value + v->value ), b->right ); 115 | } 116 | else { 117 | return new AddExpr(e1,e2); 118 | } 119 | } 120 | else if (e->kind == Mul) { 121 | const Expr* e1 = ((MulExpr*)e)->left; 122 | const Expr* e2 = ((MulExpr*)e)->right; 123 | if (e1->kind == Val && e2->kind==Val) { 124 | return new ValExpr( ((ValExpr*)e1)->value * ((ValExpr*)e2)->value ); 125 | } 126 | else if (e1->kind == Val && e2->kind==Mul && ((MulExpr*)e2)->right->kind == Val) { 127 | MulExpr* b = (MulExpr*)e2; 128 | ValExpr* v = (ValExpr*)(b->right); 129 | return new MulExpr( new ValExpr(((ValExpr*)e1)->value * v->value ), b->left ); 130 | } 131 | else if (e1->kind == Val && e2->kind==Mul && ((MulExpr*)e2)->left->kind == Val) { 132 | MulExpr* b = (MulExpr*)e2; 133 | ValExpr* v = (ValExpr*)(b->left); 134 | return new MulExpr( new ValExpr(((ValExpr*)e1)->value * v->value ), b->right ); 135 | } 136 | else { 137 | return new MulExpr(e1,e2); 138 | } 139 | } 140 | else return e; 141 | } 142 | 143 | static long eval( const Expr* e ) { 144 | if (e->kind == Var) { 145 | return 0; 146 | } 147 | else if (e->kind == Val) { 148 | return ((ValExpr*)e)->value; 149 | } 150 | else if (e->kind == Add) { 151 | return eval(((AddExpr*)e)->left) + eval(((AddExpr*)e)->right); 152 | } 153 | else if (e->kind == Mul) { 154 | return eval(((MulExpr*)e)->left) * eval(((MulExpr*)e)->right); 155 | } 156 | else { 157 | return 0; 158 | } 159 | } 160 | 161 | 162 | int main(int argc, char ** argv) { 163 | int n = 20; 164 | if (argc == 2) { 165 | n = atoi(argv[1]); 166 | } 167 | const Expr* e = mk_expr(n,1); 168 | long v1 = eval(e); 169 | long v2 = eval(const_folding(reassoc(e))); 170 | std::cout << v1 << ", " << v2 << "\n"; 171 | return 0; 172 | } 173 | -------------------------------------------------------------------------------- /koka_bench/cpp/deriv.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | enum Kind { 6 | Val, 7 | Var, 8 | Add, 9 | Mul, 10 | Pow, 11 | Ln 12 | }; 13 | 14 | class Expr { 15 | public: 16 | Kind kind; 17 | Expr(Kind k) { 18 | this->kind = k; 19 | } 20 | }; 21 | 22 | class ValExpr : public Expr { 23 | public: 24 | long value; 25 | ValExpr(long i) : Expr(Val) { 26 | this->value = i; 27 | } 28 | }; 29 | 30 | class VarExpr : public Expr { 31 | public: 32 | const char* name; 33 | VarExpr( const char* n ) : Expr(Var) { 34 | this->name = n; 35 | } 36 | }; 37 | 38 | class UnaryExpr : public Expr { 39 | public: 40 | const Expr* expr; 41 | UnaryExpr( Kind k, const Expr* e ) : Expr(k) { 42 | this->expr = e; 43 | } 44 | }; 45 | 46 | class BinExpr : public Expr { 47 | public: 48 | const Expr* left; 49 | const Expr* right; 50 | BinExpr( Kind k, const Expr* e1, const Expr* e2 ) : Expr(k) { 51 | this->left = e1; 52 | this->right = e2; 53 | } 54 | 55 | }; 56 | 57 | static long pown(long x, long n) { 58 | if (n==0) return 1; 59 | else if (n == 1) return x; 60 | else { 61 | long y = pown(x, n/2); 62 | return (y * y * (n%2 == 0 ? 1 : x)); 63 | } 64 | } 65 | 66 | static const Expr* add( const Expr* x, const Expr* y ) { 67 | if (x->kind == Val && y->kind == Val) { 68 | return new ValExpr(((ValExpr*)x)->value + ((ValExpr*)y)->value); 69 | } 70 | else if (x->kind==Val && ((ValExpr*)x)->value==0) { 71 | return y; 72 | } 73 | else if (y->kind==Val && ((ValExpr*)y)->value==0) { 74 | return x; 75 | } 76 | else if (y->kind==Val) { 77 | return add(y,x); 78 | } 79 | else if (x->kind==Val && y->kind==Add && ((BinExpr*)y)->left->kind==Val) { 80 | long lval = ((ValExpr*)((BinExpr*)y)->left)->value; 81 | return add(new ValExpr(((ValExpr*)x)->value + lval), ((BinExpr*)y)->right); 82 | } 83 | else if (y->kind==Add && ((BinExpr*)y)->left->kind==Val) { 84 | return add(((BinExpr*)y)->left,add(x,((BinExpr*)y)->right)); 85 | } 86 | else if (x->kind==Add) { 87 | return add(((BinExpr*)x)->left,add(((BinExpr*)x)->right,y)); 88 | } 89 | else { 90 | return new BinExpr(Add,x,y); 91 | } 92 | } 93 | 94 | static const Expr* mul( const Expr* x, const Expr* y ) { 95 | if (x->kind == Val && y->kind == Val) { 96 | return new ValExpr(((ValExpr*)x)->value * ((ValExpr*)y)->value); 97 | } 98 | else if (x->kind==Val && ((ValExpr*)x)->value==0) { 99 | return x; 100 | } 101 | else if (y->kind==Val && ((ValExpr*)y)->value==0) { 102 | return y; 103 | } 104 | else if (x->kind==Val && ((ValExpr*)x)->value==1) { 105 | return y; 106 | } 107 | else if (y->kind==Val && ((ValExpr*)y)->value==1) { 108 | return x; 109 | } 110 | else if (y->kind==Val) { 111 | return mul(y,x); 112 | } 113 | else if (x->kind==Val && y->kind==Mul && ((BinExpr*)y)->left->kind==Val) { 114 | long lval = ((ValExpr*)((BinExpr*)y)->left)->value; 115 | return mul(new ValExpr(((ValExpr*)x)->value * lval), ((BinExpr*)y)->right); 116 | } 117 | else if (y->kind==Mul && ((BinExpr*)y)->left->kind==Val) { 118 | return mul(((BinExpr*)y)->left,mul(x,((BinExpr*)y)->right)); 119 | } 120 | else if (x->kind==Mul) { 121 | return mul(((BinExpr*)x)->left,mul(((BinExpr*)x)->right,y)); 122 | } 123 | else { 124 | return new BinExpr(Mul,x,y); 125 | } 126 | } 127 | 128 | static const Expr* powr( const Expr* x, const Expr* y) { 129 | if (x->kind == Val && y->kind == Val) { 130 | return new ValExpr( pown(((ValExpr*)x)->value,((ValExpr*)y)->value)); 131 | } 132 | else if (y->kind==Val && ((ValExpr*)y)->value == 0) { 133 | return new ValExpr(1); 134 | } 135 | else if (y->kind==Val && ((ValExpr*)y)->value == 1) { 136 | return x; 137 | } 138 | else if (x->kind==Val && ((ValExpr*)x)->value == 0) { 139 | return new ValExpr(0); 140 | } 141 | else { 142 | return new BinExpr(Pow,x,y); 143 | } 144 | } 145 | 146 | static const Expr* ln(const Expr* n) { 147 | if (n->kind == Val && ((ValExpr*)n)->value == 1) { 148 | return new ValExpr(0); 149 | } 150 | else { 151 | return new UnaryExpr(Ln,n); 152 | } 153 | } 154 | 155 | static const Expr* d( const char* x, const Expr* e) { 156 | if (e->kind == Val) { 157 | return new ValExpr(0); 158 | } 159 | else if (e->kind==Var) { 160 | return new ValExpr( strcmp(((VarExpr*)e)->name,x)==0 ? 1 : 0); 161 | } 162 | else if (e->kind==Add) { 163 | const Expr* f = ((BinExpr*)e)->left; 164 | const Expr* g = ((BinExpr*)e)->right; 165 | return add(d(x,f),d(x,g)); 166 | } 167 | else if (e->kind==Mul) { 168 | const Expr* f = ((BinExpr*)e)->left; 169 | const Expr* g = ((BinExpr*)e)->right; 170 | return add(mul(f,d(x,g)),mul(g,d(x,f))); 171 | } 172 | else if (e->kind==Pow) { 173 | const Expr* f = ((BinExpr*)e)->left; 174 | const Expr* g = ((BinExpr*)e)->right; 175 | return mul(powr(f,g),add(mul(mul(g,d(x,f)),powr(f,new ValExpr(-1))),mul(ln(f),d(x,g)))); 176 | } 177 | else { // if (e->kind==Ln) { 178 | const Expr* f = ((UnaryExpr*)e)->expr; 179 | return mul(d(x,f),powr(f,new ValExpr(-1))); 180 | } 181 | } 182 | 183 | static long count( const Expr* e) { 184 | if (e->kind == Val) { 185 | return 1; 186 | } 187 | else if (e->kind==Var) { 188 | return 1; 189 | } 190 | else if (e->kind==Add) { 191 | const Expr* f = ((BinExpr*)e)->left; 192 | const Expr* g = ((BinExpr*)e)->right; 193 | return count(f) + count(g); 194 | } 195 | else if (e->kind==Mul) { 196 | const Expr* f = ((BinExpr*)e)->left; 197 | const Expr* g = ((BinExpr*)e)->right; 198 | return count(f) + count(g); 199 | } 200 | else if (e->kind==Pow) { 201 | const Expr* f = ((BinExpr*)e)->left; 202 | const Expr* g = ((BinExpr*)e)->right; 203 | return count(f) + count(g); 204 | } 205 | else { // if (e->kind==Ln) { 206 | const Expr* f = ((UnaryExpr*)e)->expr; 207 | return count(f); 208 | } 209 | } 210 | 211 | static const Expr* deriv(long i, const Expr* e) { 212 | const Expr* f = d("x",e); 213 | std::cout << (i+1) << " count: " << count(f) << "\n"; 214 | return f; 215 | } 216 | 217 | static const Expr* nest( long s, const Expr* e) { 218 | long n = s; 219 | while(n > 0) { 220 | e = deriv(s - n, e); 221 | n--; 222 | } 223 | return e; 224 | } 225 | 226 | 227 | int main(int argc, char ** argv) { 228 | unsigned n = 10; 229 | if (argc == 2) { 230 | n = atoi(argv[1]); 231 | } 232 | const Expr* x = new VarExpr("x"); 233 | const Expr* e = powr(x,x); 234 | nest(n,e); 235 | std::cout << "done\n"; 236 | return 0; 237 | } 238 | -------------------------------------------------------------------------------- /koka_bench/cpp/fib.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | int fib(int n) { 6 | if (n == 0) { 7 | return 1; 8 | } else if (n == 1) { 9 | return 1; 10 | } else { 11 | return fib(n-1) + fib(n-2); 12 | } 13 | } 14 | int main(int argc, char **argv) { 15 | printf("%d\n", fib(atoi(argv[1]))); 16 | return 0; 17 | } 18 | -------------------------------------------------------------------------------- /koka_bench/cpp/nqueens.cpp: -------------------------------------------------------------------------------- 1 | // NQueens solution in C++ 2 | // Note: does not free memory as that is difficult to do 3 | // since many subsolutions are shared 4 | #include 5 | 6 | template 7 | class list { 8 | public: 9 | T head; 10 | list* tail; 11 | list(T hd, list* tl) { 12 | head = hd; 13 | tail = tl; 14 | } 15 | ~list() { 16 | delete head; 17 | delete tail; 18 | } 19 | }; 20 | 21 | template 22 | list* Cons( T hd, list* tl ) { 23 | return new list(hd,tl); 24 | } 25 | 26 | template 27 | int len(list* xs) { 28 | int n = 0; 29 | while(xs != NULL) { 30 | n++; 31 | xs = xs->tail; 32 | } 33 | return n; 34 | } 35 | 36 | bool safe( int queen, list* xs ) { 37 | list* cur = xs; 38 | int diag = 1; 39 | while(cur != NULL) { 40 | int q = cur->head; 41 | if (queen == q || queen == (q+diag) || queen == (q-diag)) { 42 | return false; 43 | } 44 | diag++; 45 | cur = cur->tail; 46 | } 47 | return true; 48 | } 49 | 50 | list*>* append_safe( int k, list* soln, list*>* solns ) { 51 | list*>* acc = solns; 52 | int n = k; 53 | while(n > 0) { 54 | if (safe(n,soln)) { 55 | acc = Cons(Cons(n,soln),acc); 56 | } 57 | n--; 58 | } 59 | return acc; 60 | } 61 | 62 | list*>* extend( int n, list*>* solns ) { 63 | list*>* acc = NULL; 64 | list*>* cur = solns; 65 | while(cur != NULL) { 66 | list* soln = cur->head; 67 | acc = append_safe(n,soln,acc); 68 | cur = cur->tail; 69 | } 70 | return acc; 71 | } 72 | 73 | list*>* find_solutions( int n ) { 74 | int k = 0; 75 | list*>* acc = Cons*>(NULL,NULL); 76 | while(k < n) { 77 | acc = extend(n,acc); 78 | k++; 79 | } 80 | return acc; 81 | } 82 | 83 | int nqueens(int n) { 84 | return len(find_solutions(n)); 85 | } 86 | 87 | int main(int argc, char ** argv) { 88 | int n = 13; 89 | if (argc == 2) { 90 | n = atoi(argv[1]); 91 | } 92 | std::cout << nqueens(n) << "\n"; 93 | return 0; 94 | } 95 | -------------------------------------------------------------------------------- /koka_bench/cpp/rbtree.cpp: -------------------------------------------------------------------------------- 1 | // Using standard STL to test the red-black tree in C++ 2 | // In glibc++ this uses 3 | // With the LLVM libc++ this uses 4 | // In glibc this uses eventually: 5 | // (Highly optimized in-place red-black tree using the low pointer bit to encode color information.) 6 | 7 | #include 8 | #include 9 | #include 10 | using std::for_each; 11 | 12 | typedef int nat; 13 | 14 | struct nat_lt_fn { 15 | bool operator()(nat const & n1, nat const & n2) const { return n1 < n2; } 16 | }; 17 | 18 | typedef std::map map; 19 | 20 | map mk_map(unsigned n) { 21 | map m; 22 | while (n > 0) { 23 | --n; 24 | m.insert(std::make_pair(nat(n), n%10 == 0)); 25 | } 26 | return m; 27 | } 28 | 29 | nat fold(map const & m) { 30 | nat r(0); 31 | for_each(m.begin(), m.end(), [&](std::pair const & p) { if (p.second) r = r + nat(1); }); 32 | return r; 33 | } 34 | 35 | int main(int argc, char ** argv) { 36 | unsigned n = 4200000; 37 | if (argc == 2) { 38 | n = atoi(argv[1]); 39 | } 40 | map m = mk_map(n); 41 | std::cout << fold(m) << "\n"; 42 | return 0; 43 | } 44 | -------------------------------------------------------------------------------- /koka_bench/haskell/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | find_program(GHC ghc REQUIRED) 2 | 3 | #find_program(GHC "stack") 4 | #if (GHC) 5 | # list(APPEND GHC ghc --) 6 | #else () 7 | # find_program(GHC ghc REQUIRED) 8 | #endif () 9 | 10 | # run `$ cabal install --lib parallel` to compile binarytrees 11 | 12 | set(sources cfold.hs deriv.hs nqueens.hs rbtree.hs) 13 | foreach (source IN LISTS sources) 14 | get_filename_component(name "${source}" NAME_WE) 15 | set(name "hs-${name}") 16 | 17 | add_custom_command( 18 | OUTPUT ${name} 19 | COMMAND ${GHC} -O2 -o ${name} "$" 20 | DEPENDS ${source} 21 | VERBATIM) 22 | 23 | add_custom_target(update-${name} ALL DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/${name}) 24 | 25 | add_executable(${name}-exe IMPORTED) 26 | set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${CMAKE_CURRENT_BINARY_DIR}/${name}") 27 | 28 | add_test(NAME ${name} COMMAND ${name}-exe) 29 | set_tests_properties(${name} PROPERTIES LABELS haskell) 30 | endforeach () 31 | 32 | 33 | 34 | -------------------------------------------------------------------------------- /koka_bench/haskell/cfold.hs: -------------------------------------------------------------------------------- 1 | -- Adapted from https://github.com/leanprover/lean4/blob/IFL19/tests/bench/const_fold.hs 2 | 3 | import System.Environment 4 | 5 | data Expr = Var Integer 6 | | Val Integer 7 | | Add Expr Expr 8 | | Mul Expr Expr 9 | 10 | mk_expr :: Integer -> Integer -> Expr 11 | mk_expr 0 v = if v == 0 then Var 1 else Val v 12 | mk_expr n v = Add (mk_expr (n-1) (v+1)) (mk_expr (n-1) (max (v-1) 0)) 13 | 14 | append_add :: Expr -> Expr -> Expr 15 | append_add (Add e₁ e₂) e₃ = Add e₁ (append_add e₂ e₃) 16 | append_add e₁ e₂ = Add e₁ e₂ 17 | 18 | append_mul :: Expr -> Expr -> Expr 19 | append_mul (Mul e₁ e₂) e₃ = Mul e₁ (append_mul e₂ e₃) 20 | append_mul e₁ e₂ = Mul e₁ e₂ 21 | 22 | reassoc :: Expr -> Expr 23 | reassoc (Add e₁ e₂) = 24 | let e₁' = reassoc e₁ in 25 | let e₂' = reassoc e₂ in 26 | append_add e₁' e₂' 27 | reassoc (Mul e₁ e₂) = 28 | let e₁' = reassoc e₁ in 29 | let e₂' = reassoc e₂ in 30 | append_mul e₁' e₂' 31 | reassoc e = e 32 | 33 | const_folding :: Expr -> Expr 34 | const_folding (Add e₁ e₂) = 35 | let e₁' = const_folding e₁ in 36 | let e₂' = const_folding e₂ in 37 | (case (e₁', e₂') of 38 | (Val a, Val b ) -> Val (a+b) 39 | (Val a, Add e (Val b)) -> Add (Val (a+b)) e 40 | (Val a, Add (Val b) e) -> Add (Val (a+b)) e 41 | (_, _ ) -> Add e₁' e₂') 42 | const_folding (Mul e₁ e₂) = 43 | let e₁' = const_folding e₁ in 44 | let e₂' = const_folding e₂ in 45 | (case (e₁', e₂') of 46 | (Val a, Val b ) -> Val (a*b) 47 | (Val a, Mul e (Val b)) -> Mul (Val (a*b)) e 48 | (Val a, Mul (Val b) e) -> Mul (Val (a*b)) e 49 | (_, _ ) -> Mul e₁' e₂') 50 | const_folding e = e 51 | 52 | eval :: Expr -> Integer 53 | eval (Var _) = 0 54 | eval (Val v) = v 55 | eval (Add l r) = eval l + eval r 56 | eval (Mul l r) = eval l * eval r 57 | 58 | main :: IO () 59 | main = do 60 | [arg] <- getArgs 61 | let n = read arg 62 | let e = (mk_expr n 1) 63 | let v₁ = eval e 64 | let v₂ = eval (const_folding (reassoc e)) 65 | putStrLn (show v₁ ++ " " ++ show v₂) 66 | -------------------------------------------------------------------------------- /koka_bench/haskell/deriv.hs: -------------------------------------------------------------------------------- 1 | -- Adapted from: https://raw.githubusercontent.com/leanprover/lean4/IFL19/tests/bench/deriv.hs 2 | 3 | import System.Environment 4 | 5 | data Expr = 6 | Val Int 7 | | Var String 8 | | Add Expr Expr 9 | | Mul Expr Expr 10 | | Pow Expr Expr 11 | | Ln Expr 12 | 13 | pown :: Int -> Int -> Int 14 | pown a 0 = 1 15 | pown a 1 = a 16 | pown a n = 17 | let b = pown a (n `div` 2) in 18 | b * b * (if n `mod` 2 == 0 then 1 else a) 19 | 20 | add :: Expr -> Expr -> Expr 21 | add (Val n) (Val m) = Val (n + m) 22 | add (Val 0) f = f 23 | add f (Val 0) = f 24 | add f (Val n) = add (Val n) f 25 | add (Val n) (Add (Val m) f) = add (Val (n+m)) f 26 | add f (Add (Val n) g) = add (Val n) (add f g) 27 | add (Add f g) h = add f (add g h) 28 | add f g = Add f g 29 | 30 | mul :: Expr -> Expr -> Expr 31 | mul (Val n) (Val m) = Val (n*m) 32 | mul (Val 0) _ = Val 0 33 | mul _ (Val 0) = Val 0 34 | mul (Val 1) f = f 35 | mul f (Val 1) = f 36 | mul f (Val n) = mul (Val n) f 37 | mul (Val n) (Mul (Val m) f) = mul (Val (n*m)) f 38 | mul f (Mul (Val n) g) = mul (Val n) (mul f g) 39 | mul (Mul f g) h = mul f (mul g h) 40 | mul f g = Mul f g 41 | 42 | pow :: Expr -> Expr -> Expr 43 | pow (Val m) (Val n) = Val (pown m n) 44 | pow _ (Val 0) = Val 1 45 | pow f (Val 1) = f 46 | pow (Val 0) _ = Val 0 47 | pow f g = Pow f g 48 | 49 | ln :: Expr -> Expr 50 | ln (Val 1) = Val 0 51 | ln f = Ln f 52 | 53 | d :: String -> Expr -> Expr 54 | d x (Val _) = Val 0 55 | d x (Var y) = if x == y then Val 1 else Val 0 56 | d x (Add f g) = add (d x f) (d x g) 57 | d x (Mul f g) = add (mul f (d x g)) (mul g (d x f)) 58 | d x (Pow f g) = mul (pow f g) (add (mul (mul g (d x f)) (pow f (Val (-1)))) (mul (ln f) (d x g))) 59 | d x (Ln f) = mul (d x f) (pow f (Val (-1))) 60 | 61 | count :: Expr -> Integer 62 | count (Val _) = 1 63 | count (Var _) = 1 64 | count (Add f g) = count f + count g 65 | count (Mul f g) = count f + count g 66 | count (Pow f g) = count f + count g 67 | count (Ln f) = count f 68 | 69 | nest_aux :: Int -> (Int -> Expr -> IO Expr) -> Int -> Expr -> IO Expr 70 | nest_aux s f 0 x = pure x 71 | nest_aux s f m x = f (s - m) x >>= nest_aux s f (m-1) 72 | 73 | nest f n e = nest_aux n f n e 74 | 75 | deriv :: Int -> Expr -> IO Expr 76 | deriv i f = do 77 | let f' = d "x" f 78 | putStrLn (show (i+1) ++ " count: " ++ (show $ count f')) 79 | pure f' 80 | 81 | main = do 82 | let x = Var "x" 83 | let f = pow x x 84 | [arg] <- getArgs 85 | let n = read arg 86 | nest deriv n f 87 | -------------------------------------------------------------------------------- /koka_bench/haskell/nqueens.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Environment 3 | 4 | data List a = Nil | Cons !a !(List a) 5 | 6 | len xs 7 | = len' xs 0 8 | 9 | len' xs acc 10 | = case xs of 11 | Nil -> acc 12 | Cons _ t -> len' t $! (acc+1) 13 | 14 | safe queen diag xs 15 | = case xs of 16 | Nil -> True 17 | Cons q t -> queen /= q && queen /= q + diag && queen /= q - diag && safe queen (diag + 1) t 18 | 19 | appendSafe k soln solns 20 | = if (k <= 0) 21 | then solns 22 | else if safe k 1 soln 23 | then appendSafe (k-1) soln (Cons (Cons k soln) solns) 24 | else appendSafe (k-1) soln solns 25 | 26 | 27 | extend n acc solns 28 | = case solns of 29 | Nil -> acc 30 | Cons soln rest -> extend n (appendSafe n soln acc) rest 31 | 32 | find_solutions n k 33 | = if k == 0 34 | then Cons Nil Nil 35 | else extend n Nil (find_solutions n (k-1)) 36 | 37 | -- fst_solution n = head (find_solutions n n) 38 | 39 | queens n 40 | = len (find_solutions n n) 41 | 42 | main = do 43 | [arg] <- getArgs 44 | print (queens (read arg)) 45 | -------------------------------------------------------------------------------- /koka_bench/haskell/rbtree.hs: -------------------------------------------------------------------------------- 1 | -- Adapted from https://github.com/leanprover/lean4/blob/IFL19/tests/bench/rbmap.hs 2 | -- Modified to be strict in the Tree fields 3 | import System.Environment 4 | 5 | data Color = 6 | Red | Black 7 | 8 | data Tree α β = 9 | Leaf 10 | | Node !Color !(Tree α β) !α !β !(Tree α β) 11 | 12 | fold :: (α -> β -> σ -> σ) -> Tree α β -> σ -> σ 13 | fold _ Leaf b = b 14 | fold f (Node _ l k v r) b = fold f r (f k v (fold f l b)) 15 | 16 | balance1 :: Tree α β -> Tree α β -> Tree α β 17 | balance1 (Node _ _ kv vv t) (Node _ (Node Red l kx vx r₁) ky vy r₂) = Node Red (Node Black l kx vx r₁) ky vy (Node Black r₂ kv vv t) 18 | balance1 (Node _ _ kv vv t) (Node _ l₁ ky vy (Node Red l₂ kx vx r)) = Node Red (Node Black l₁ ky vy l₂) kx vx (Node Black r kv vv t) 19 | balance1 (Node _ _ kv vv t) (Node _ l ky vy r) = Node Black (Node Red l ky vy r) kv vv t 20 | balance1 _ _ = Leaf 21 | 22 | balance2 :: Tree α β -> Tree α β -> Tree α β 23 | balance2 (Node _ t kv vv _) (Node _ (Node Red l kx₁ vx₁ r₁) ky vy r₂) = Node Red (Node Black t kv vv l) kx₁ vx₁ (Node Black r₁ ky vy r₂) 24 | balance2 (Node _ t kv vv _) (Node _ l₁ ky vy (Node Red l₂ kx₂ vx₂ r₂)) = Node Red (Node Black t kv vv l₁) ky vy (Node Black l₂ kx₂ vx₂ r₂) 25 | balance2 (Node _ t kv vv _) (Node _ l ky vy r) = Node Black t kv vv (Node Red l ky vy r) 26 | balance2 _ _ = Leaf 27 | 28 | is_red :: Tree α β -> Bool 29 | is_red (Node Red _ _ _ _) = True 30 | is_red _ = False 31 | 32 | lt x y = x < y 33 | 34 | ins :: Ord α => Tree α β -> α -> β -> Tree α β 35 | ins Leaf kx vx = Node Red Leaf kx vx Leaf 36 | ins (Node Red a ky vy b) kx vx = 37 | (if lt kx ky then Node Red (ins a kx vx) ky vy b 38 | else if lt ky kx then Node Red a ky vy (ins b kx vx) 39 | else Node Red a ky vy (ins b kx vx)) 40 | ins (Node Black a ky vy b) kx vx = 41 | if lt kx ky then 42 | (if is_red a then balance1 (Node Black Leaf ky vy b) (ins a kx vx) 43 | else Node Black (ins a kx vx) ky vy b) 44 | else if lt ky kx then 45 | (if is_red b then balance2 (Node Black a ky vy Leaf) (ins b kx vx) 46 | else Node Black a ky vy (ins b kx vx)) 47 | else Node Black a kx vx b 48 | 49 | set_black :: Tree α β -> Tree α β 50 | set_black (Node _ l k v r) = Node Black l k v r 51 | set_black e = e 52 | 53 | insert t k v = 54 | if is_red t then set_black (ins t k v) 55 | else ins t k v 56 | 57 | type Map = Tree Int Bool 58 | 59 | mk_Map_aux :: Int -> Map -> Map 60 | mk_Map_aux 0 m = m 61 | mk_Map_aux n m = let n' = n-1 in mk_Map_aux n' (insert m n' (n' `mod` 10 == 0)) 62 | 63 | mk_Map n = mk_Map_aux n Leaf 64 | 65 | main = do 66 | [arg] <- getArgs 67 | let n = read arg 68 | let m = mk_Map n 69 | let v = fold (\_ v r -> if v then r + 1 else r) m 0 70 | print v 71 | -------------------------------------------------------------------------------- /koka_bench/java/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | 2 | set(java_wrapper "../../java_wrapper.sh") 3 | 4 | set(sources rbtree.java nqueens.java deriv.java cfold.java) 5 | foreach (source IN LISTS sources) 6 | 7 | get_filename_component(name "${source}" NAME_WE) 8 | 9 | set(out_dir "${CMAKE_CURRENT_BINARY_DIR}/out/bench") 10 | set(out_path "${out_dir}/${name}") 11 | 12 | add_custom_command( 13 | OUTPUT ${out_path} 14 | COMMAND ${java_wrapper} "${CMAKE_CURRENT_SOURCE_DIR}/${source}" ${out_dir} ${name} 15 | DEPENDS ${source} 16 | VERBATIM) 17 | 18 | add_custom_target(update-${name} ALL DEPENDS "${out_path}") 19 | add_executable(${name}-exe IMPORTED) 20 | set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${out_path}") 21 | endforeach () 22 | 23 | -------------------------------------------------------------------------------- /koka_bench/java/cfold.java: -------------------------------------------------------------------------------- 1 | interface XExpr { 2 | } 3 | 4 | final class ValXExpr implements XExpr { 5 | long value; 6 | ValXExpr(long i) { 7 | value = i; 8 | } 9 | } 10 | 11 | final class VarXExpr implements XExpr { 12 | long name; 13 | VarXExpr(long i) { 14 | name = i; 15 | } 16 | } 17 | 18 | 19 | final class AddXExpr implements XExpr { 20 | XExpr left; 21 | XExpr right; 22 | AddXExpr(XExpr l, XExpr r) { 23 | left = l; 24 | right = r; 25 | } 26 | } 27 | 28 | final class MulXExpr implements XExpr { 29 | XExpr left; 30 | XExpr right; 31 | MulXExpr(XExpr l, XExpr r) { 32 | left = l; 33 | right = r; 34 | } 35 | } 36 | 37 | 38 | public class cfold { 39 | static XExpr mk_expr( long n, long v ) { 40 | if (n == 0) { 41 | return (v==0 ? new VarXExpr(1) : new ValXExpr(v)); 42 | } 43 | else { 44 | return new AddXExpr( mk_expr(n-1, v+1), mk_expr(n - 1, v == 0 ? 0 : v - 1)); 45 | } 46 | } 47 | 48 | static XExpr append_add( XExpr e1, XExpr e2 ) { 49 | if (e1 instanceof AddXExpr a) { 50 | return new AddXExpr(a.left, append_add(a.right, e2)); 51 | } 52 | else { 53 | return new AddXExpr(e1,e2); 54 | } 55 | } 56 | 57 | static XExpr tail_append_add( XExpr e1, XExpr e2 ) { 58 | AddXExpr hd = null; 59 | AddXExpr acc = null; 60 | while(e1 instanceof AddXExpr x) { 61 | if (acc==null) { 62 | hd = acc = new AddXExpr(x.left,null); 63 | } 64 | else { 65 | AddXExpr y = new AddXExpr(x.left,null); 66 | acc.right = y; 67 | acc = y; 68 | } 69 | e1 = x.right; 70 | } 71 | if (acc==null) hd = acc = new AddXExpr(e1,e2); 72 | else acc.right = new AddXExpr(e1,e2); 73 | return hd; 74 | } 75 | 76 | static XExpr append_mul( XExpr e1, XExpr e2 ) { 77 | if (e1 instanceof MulXExpr a) { 78 | return new MulXExpr(a.left, append_mul(a.right, e2)); 79 | } 80 | else { 81 | return new MulXExpr(e1,e2); 82 | } 83 | } 84 | 85 | static XExpr reassoc( XExpr e ) { 86 | if (e instanceof AddXExpr a) { 87 | return append_add( reassoc(a.left), reassoc(a.right) ); 88 | } 89 | else if (e instanceof MulXExpr m) { 90 | return append_mul( reassoc(m.left), reassoc(m.right) ); 91 | } 92 | else return e; 93 | } 94 | 95 | static XExpr const_folding( XExpr e ) { 96 | if (e instanceof AddXExpr x) { 97 | XExpr e1 = const_folding(x.left); 98 | XExpr e2 = const_folding(x.right); 99 | if (e1 instanceof ValXExpr a && e2 instanceof ValXExpr b) { 100 | return new ValXExpr(a.value + b.value ); 101 | } 102 | else if (e1 instanceof ValXExpr a && e2 instanceof AddXExpr b && b.right instanceof ValXExpr br) { 103 | return new AddXExpr( new ValXExpr(a.value + br.value), b.left ); 104 | } 105 | else if (e1 instanceof ValXExpr a && e2 instanceof AddXExpr b && b.left instanceof ValXExpr bl) { 106 | return new AddXExpr( new ValXExpr(a.value + bl.value), b.right ); 107 | } 108 | else { 109 | return new AddXExpr(e1,e2); 110 | } 111 | } 112 | else if (e instanceof MulXExpr x) { 113 | XExpr e1 = const_folding(x.left); 114 | XExpr e2 = const_folding(x.right); 115 | if (e1 instanceof ValXExpr a && e2 instanceof ValXExpr b) { 116 | return new ValXExpr(a.value * b.value ); 117 | } 118 | else if (e1 instanceof ValXExpr a && e2 instanceof MulXExpr b && b.right instanceof ValXExpr br) { 119 | return new MulXExpr( new ValXExpr(a.value * br.value), b.left ); 120 | } 121 | else if (e1 instanceof ValXExpr a && e2 instanceof MulXExpr b && b.left instanceof ValXExpr bl) { 122 | return new MulXExpr( new ValXExpr(a.value * bl.value), b.right ); 123 | } 124 | else { 125 | return new MulXExpr(e1,e2); 126 | } 127 | } 128 | else return e; 129 | } 130 | 131 | static long eval( XExpr e ) { 132 | if (e instanceof VarXExpr x) { 133 | return 0; 134 | } 135 | else if (e instanceof ValXExpr x) { 136 | return x.value; 137 | } 138 | else if (e instanceof AddXExpr x) { 139 | return eval(x.left) + eval(x.right); 140 | } 141 | else if (e instanceof MulXExpr x) { 142 | return eval(x.left) * eval(x.right); 143 | } 144 | else { 145 | return 0; 146 | } 147 | } 148 | 149 | public static void main(String args[]) 150 | { 151 | XExpr e = mk_expr(Integer.parseInt(args[0]),1); 152 | long v1 = eval(e); 153 | long v2 = eval(const_folding(reassoc(e))); 154 | System.out.println( v1 + ", " + v2 ); 155 | } 156 | } 157 | -------------------------------------------------------------------------------- /koka_bench/java/deriv.java: -------------------------------------------------------------------------------- 1 | interface Expr { 2 | } 3 | 4 | final class ValExpr implements Expr { 5 | long value; 6 | ValExpr(long i) { 7 | value = i; 8 | } 9 | } 10 | 11 | final class VarExpr implements Expr { 12 | String name; 13 | VarExpr(String s) { 14 | name = s; 15 | } 16 | } 17 | 18 | final class LnExpr implements Expr { 19 | Expr expr; 20 | LnExpr(Expr e) { 21 | expr = e; 22 | } 23 | } 24 | 25 | final class AddExpr implements Expr { 26 | Expr left; 27 | Expr right; 28 | AddExpr(Expr l, Expr r) { 29 | left = l; 30 | right = r; 31 | } 32 | } 33 | 34 | final class MulExpr implements Expr { 35 | Expr left; 36 | Expr right; 37 | MulExpr(Expr l, Expr r) { 38 | left = l; 39 | right = r; 40 | } 41 | } 42 | 43 | final class PowExpr implements Expr { 44 | Expr left; 45 | Expr right; 46 | PowExpr(Expr l, Expr r) { 47 | left = l; 48 | right = r; 49 | } 50 | } 51 | 52 | 53 | 54 | public class deriv { 55 | static long pown(long x, long n) { 56 | if (n==0) return 1; 57 | else if (n == 1) return x; 58 | else { 59 | long y = pown(x, n/2); 60 | return (y * y * (n%2 == 0 ? 1 : x)); 61 | } 62 | } 63 | 64 | static Expr add( Expr x, Expr y ) { 65 | if (x instanceof ValExpr a && y instanceof ValExpr b) { 66 | return new ValExpr( a.value + b.value ); 67 | } 68 | else if (x instanceof ValExpr a && a.value == 0) { 69 | return y; 70 | } 71 | else if (y instanceof ValExpr b && b.value == 0) { 72 | return x; 73 | } 74 | else if (y instanceof ValExpr b) { 75 | return add(y,x); 76 | } 77 | else if (x instanceof ValExpr a && y instanceof AddExpr b && b.left instanceof ValExpr bl) { 78 | return add(new ValExpr(a.value + bl.value), b.right); 79 | } 80 | else if (y instanceof AddExpr b && b.left instanceof ValExpr) { 81 | return add(b.left, add(x,b.right)); 82 | } 83 | else if (x instanceof AddExpr a) { 84 | return add(a.left, add(a.right,y)); 85 | } 86 | else { 87 | return new AddExpr(x,y); 88 | } 89 | } 90 | 91 | static Expr mul( Expr x, Expr y ) { 92 | if (x instanceof ValExpr a && y instanceof ValExpr b) { 93 | return new ValExpr( a.value * b.value ); 94 | } 95 | else if (x instanceof ValExpr a && a.value == 0) { 96 | return x; 97 | } 98 | else if (y instanceof ValExpr b && b.value == 0) { 99 | return y; 100 | } 101 | else if (x instanceof ValExpr a && a.value == 1) { 102 | return y; 103 | } 104 | else if (y instanceof ValExpr b && b.value == 1) { 105 | return x; 106 | } 107 | else if (y instanceof ValExpr b) { 108 | return mul(y,x); 109 | } 110 | else if (x instanceof ValExpr a && y instanceof MulExpr b && b.left instanceof ValExpr bl) { 111 | return mul(new ValExpr(a.value * bl.value), b.right); 112 | } 113 | else if (y instanceof MulExpr b && b.left instanceof MulExpr) { 114 | return mul(b.left, mul(x,b.right)); 115 | } 116 | else if (x instanceof MulExpr a) { 117 | return mul(a.left, mul(a.right,y)); 118 | } 119 | else { 120 | return new MulExpr(x,y); 121 | } 122 | } 123 | 124 | static Expr powr( Expr x, Expr y ) { 125 | if (x instanceof ValExpr a && y instanceof ValExpr b) { 126 | return new ValExpr(pown(a.value,b.value)); 127 | } 128 | else if (y instanceof ValExpr b && b.value == 0) { 129 | return new ValExpr(1); 130 | } 131 | else if (y instanceof ValExpr b && b.value == 1) { 132 | return x; 133 | } 134 | else if (x instanceof ValExpr a && a.value == 0) { 135 | return new ValExpr(0); 136 | } 137 | else { 138 | return new PowExpr(x,y); 139 | } 140 | } 141 | 142 | static Expr ln( Expr x ) { 143 | if (x instanceof ValExpr a && a.value == 1) { 144 | return new ValExpr(0); 145 | } 146 | else { 147 | return new LnExpr(x); 148 | } 149 | } 150 | 151 | static Expr d( String x, Expr e ) { 152 | if (e instanceof ValExpr) { 153 | return new ValExpr(0); 154 | } 155 | else if (e instanceof VarExpr a) { 156 | return new ValExpr(a.name == x ? 1 : 0); 157 | } 158 | else if (e instanceof AddExpr a) { 159 | Expr f = a.left; 160 | Expr g = a.right; 161 | return add(d(x,f),d(x,g)); 162 | } 163 | else if (e instanceof MulExpr a) { 164 | Expr f = a.left; 165 | Expr g = a.right; 166 | return add(mul(f,d(x,g)),mul(g,d(x,f))); 167 | } 168 | else if (e instanceof PowExpr a) { 169 | Expr f = a.left; 170 | Expr g = a.right; 171 | return mul(powr(f,g),add(mul(mul(g,d(x,f)),powr(f,new ValExpr(-1))),mul(ln(f),d(x,g)))); 172 | } 173 | else if (e instanceof LnExpr a) { 174 | Expr f = a.expr; 175 | return mul(d(x,f),powr(f,new ValExpr(-1))); 176 | } 177 | else { 178 | return e; 179 | } 180 | } 181 | 182 | static long count( Expr e ) { 183 | if (e instanceof ValExpr) { 184 | return 1; 185 | } 186 | else if (e instanceof VarExpr) { 187 | return 1; 188 | } 189 | else if (e instanceof AddExpr a) { 190 | Expr f = a.left; 191 | Expr g = a.right; 192 | return count(f) + count(g); 193 | } 194 | else if (e instanceof MulExpr a) { 195 | Expr f = a.left; 196 | Expr g = a.right; 197 | return count(f) + count(g); 198 | } 199 | else if (e instanceof PowExpr a) { 200 | Expr f = a.left; 201 | Expr g = a.right; 202 | return count(f) + count(g); 203 | } 204 | else if (e instanceof LnExpr a) { 205 | Expr f = a.expr; 206 | return count(f); 207 | } 208 | else { 209 | return 0; 210 | } 211 | } 212 | 213 | static Expr deriv( long i, Expr e) { 214 | Expr f = d("x",e); 215 | System.out.println( (i+1) + " count: " + count(f) ); 216 | return f; 217 | } 218 | 219 | static Expr nest( long s, Expr e) { 220 | long n = s; 221 | while(n > 0) { 222 | e = deriv(s - n, e); 223 | n--; 224 | } 225 | return e; 226 | } 227 | 228 | public static void main(String args[]) 229 | { 230 | Expr x = new VarExpr("x"); 231 | Expr e = powr(x,x); 232 | nest(Integer.parseInt(args[0]),e); 233 | System.out.println( "done" ); 234 | } 235 | } 236 | -------------------------------------------------------------------------------- /koka_bench/java/nqueens.java: -------------------------------------------------------------------------------- 1 | class List { 2 | T head; 3 | List tail; 4 | 5 | List(T h, List t) { 6 | head = h; 7 | tail = t; 8 | } 9 | 10 | static int len( List xs ) { 11 | int n = 0; 12 | while(xs != null) { 13 | n++; 14 | xs = xs.tail; 15 | } 16 | return n; 17 | } 18 | 19 | static List Cons( T h, List t ) { 20 | return new List(h,t); 21 | } 22 | 23 | } 24 | 25 | public class nqueens { 26 | static boolean safe( int queen, List xs ) { 27 | int diag = 1; 28 | while(xs != null) { 29 | int q = xs.head; 30 | if (queen == q || queen == (q + diag) || queen == (q - diag)) { 31 | return false; 32 | } 33 | diag++; 34 | xs = xs.tail; 35 | } 36 | return true; 37 | } 38 | 39 | static List> appendSafe( int k, List soln, List> solns ) { 40 | List> acc = solns; 41 | while(k > 0) { 42 | if (safe(k,soln)) { 43 | acc = List.Cons(List.Cons(k,soln),acc); 44 | } 45 | k--; 46 | } 47 | return acc; 48 | } 49 | 50 | static List> extend( int n, List> solns ) { 51 | List> acc = null; 52 | List> cur = solns; 53 | while(cur != null) { 54 | acc = appendSafe(n, cur.head, acc); 55 | cur = cur.tail; 56 | } 57 | return acc; 58 | } 59 | 60 | static List> findSolutions( int n ) { 61 | int k = 0; 62 | List> acc = List.Cons(null,null); 63 | while(k < n) { 64 | acc = extend(n,acc); 65 | k++; 66 | } 67 | return acc; 68 | } 69 | 70 | 71 | static int nqueens(int n) { 72 | return List.len(findSolutions(n)); 73 | } 74 | public static void main(String args[]) 75 | { 76 | System.out.println( nqueens(Integer.parseInt(args[0])) ); 77 | } 78 | } 79 | -------------------------------------------------------------------------------- /koka_bench/java/rbtree.java: -------------------------------------------------------------------------------- 1 | 2 | enum Color { 3 | Red, 4 | Black 5 | } 6 | 7 | 8 | interface FoldFun { 9 | int Apply(int k, boolean v, int acc); 10 | } 11 | 12 | class Tree { 13 | Color color; 14 | Tree left; 15 | int key; 16 | boolean val; 17 | Tree right; 18 | 19 | Tree( Color c, Tree l, int k, boolean v, Tree r) { 20 | color = c; 21 | left = l; 22 | key = k; 23 | val = v; 24 | right = r; 25 | } 26 | 27 | static Tree Node( Color c, Tree l, int k, boolean v, Tree r) { 28 | return new Tree(c,l,k,v,r); 29 | } 30 | 31 | static boolean isRed( Tree t ) { 32 | return (t != null && t.color == Color.Red); 33 | } 34 | 35 | static Tree balanceRight( int kv, boolean vv, Tree t, Tree n ) { 36 | if (n == null) { 37 | return null; 38 | } 39 | else if (n.left != null && n.left.color == Color.Red) { 40 | //case let .Node(_, .Node(.Red, l, kx, vx, r1), ky, vy, r2): 41 | // return .Node(.Red, .Node(.Black, l, kx, vx, r1), ky, vy, .Node(.Black, r2, kv, vv, t)) 42 | Tree l = n.left; 43 | return Node( Color.Red, Node( Color.Black, l.left, l.key, l.val, l.right), n.key, n.val, Node(Color.Black, n.right, kv, vv, t)); 44 | } 45 | else if (n.right != null && n.right.color == Color.Red) { 46 | //case let .Node(_, l1, ky, vy, .Node(.Red, l2, kx, vx, r)): 47 | // return .Node(.Red, .Node(.Black, l1, ky, vy, l2), kx, vx, .Node(.Black, r, kv, vv, t)) 48 | Tree r = n.right; 49 | return Node( Color.Red, Node( Color.Black, n.left, n.key, n.val, r.left), r.key, r.val, Node(Color.Black, r.right, kv, vv, t)); 50 | } 51 | else { 52 | //case let .Node(_, l, ky, vy, r): 53 | // return .Node(.Black, .Node(.Red, l, ky, vy, r), kv, vv, t) 54 | return Node(Color.Black, Node(Color.Red, n.left, n.key, n.val, n.right), kv, vv, t); 55 | } 56 | } 57 | 58 | static Tree balanceLeft( Tree t, int kv, boolean vv, Tree n ) { 59 | if (n == null) { 60 | return null; 61 | } 62 | else if (n.left != null && n.left.color == Color.Red) { 63 | //case let .Node(_, .Node(.Red, l, kx1, vx1, r1), ky, vy, r2): 64 | // return .Node(.Red, .Node(.Black, t, kv, vv, l), kx1, vx1, .Node(.Black, r1, ky, vy, r2)) 65 | Tree l = n.left; 66 | return Node( Color.Red, Node( Color.Black, t, kv, vv, l.left), l.key, l.val, Node(Color.Black, l.right, n.key, n.val, n.right)); 67 | } 68 | else if (n.right != null && n.right.color == Color.Red) { 69 | //case let .Node(_, l1, ky, vy, .Node(.Red, l2, kx2, vx2, r2)): 70 | // return .Node(.Red, .Node(.Black, t, kv, vv, l1), ky, vy, .Node(.Black, l2, kx2, vx2, r2)) 71 | Tree r = n.right; 72 | return Node( Color.Red, Node( Color.Black, t, kv, vv, n.left), n.key, n.val, Node(Color.Black, r.left, r.key, r.val, r.right)); 73 | } 74 | else { 75 | //case let .Node (_, l, ky, vy, r): 76 | // return .Node(.Black, t, kv, vv, .Node(.Red, l, ky, vy, r)) 77 | return Node(Color.Black, t, kv, vv, Node(Color.Red, n.left, n.key, n.val, n.right)); 78 | } 79 | } 80 | 81 | static Tree ins(Tree t, int kx, boolean vx ) { 82 | if (t==null) { 83 | return Node(Color.Red, null, kx, vx, null); 84 | } 85 | else if (t.color == Color.Red) { 86 | //case let .Node(.Red, a, ky, vy, b): 87 | if (kx < t.key) { 88 | return Node(Color.Red, ins(t.left, kx, vx), t.key, t.val, t.right); 89 | } else if (t.key == kx) { 90 | return Node(Color.Red, t.left, kx, vx, t.right); 91 | } else { 92 | return Node(Color.Red, t.left, t.key, t.val, ins(t.right, kx, vx)); 93 | } 94 | } 95 | else { // t.color == Black 96 | if (kx < t.key) { 97 | if (isRed(t.left)) { 98 | return balanceRight(t.key, t.val, t.right, ins(t.left, kx, vx)); 99 | } else { 100 | return Node(Color.Black, ins(t.left, kx, vx), t.key, t.val, t.right); 101 | } 102 | } else if (kx == t.key) { 103 | return Node(Color.Black, t.left, kx, vx, t.right); 104 | } else { 105 | if (isRed(t.right)) { 106 | return balanceLeft(t.left, t.key, t.val, ins(t.right, kx, vx)); 107 | } else { 108 | return Node(Color.Black, t.left, t.key, t.val, ins(t.right, kx, vx)); 109 | } 110 | } 111 | } 112 | } 113 | 114 | static Tree setBlack( Tree t ) { 115 | if (t == null) return t; 116 | return Node(Color.Black, t.left, t.key, t.val, t.right); 117 | } 118 | 119 | static Tree insert (Tree t, int k, boolean v) { 120 | if (isRed(t)) { 121 | return setBlack(ins(t, k, v)); 122 | } else { 123 | return ins(t, k, v); 124 | } 125 | } 126 | 127 | static int Fold( FoldFun f, Tree t, int acc ) { 128 | while(t != null) { 129 | acc = Fold(f,t.left,acc); 130 | acc = f.Apply(t.key,t.val,acc); 131 | t = t.right; 132 | } 133 | return acc; 134 | } 135 | 136 | } 137 | 138 | 139 | public class rbtree 140 | { 141 | static Tree mkMap( int n ) { 142 | Tree t = null; 143 | while(n > 0) { 144 | n--; 145 | t = Tree.insert(t, n, (n%10)==0); 146 | } 147 | return t; 148 | } 149 | 150 | static int Test(int n ) { 151 | Tree t = mkMap(n); 152 | return Tree.Fold( (k,v,acc) -> { return (v ? acc + 1 : acc); }, t, 0); 153 | } 154 | 155 | public static void main(String args[]) 156 | { 157 | System.out.println( Test(Integer.parseInt(args[0])) ); 158 | } 159 | } 160 | -------------------------------------------------------------------------------- /koka_bench/java_wrapper.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | OUR_DIR="$(dirname $(readlink -f $0))" 3 | SOURCE="$1" 4 | OUT_DIR="$2" 5 | OUT_NAME="$3" 6 | 7 | mkdir -p "$OUT_DIR" 8 | javac --enable-preview -source 17 -d "$OUT_DIR" $SOURCE 9 | 10 | printf '#!/usr/bin/env bash\njava -Xss1024m --enable-preview -classpath "$(dirname $(readlink -f $0))" '"$OUT_NAME"' $@' > "$OUT_DIR/$OUT_NAME" 11 | chmod 755 "$OUT_DIR/$OUT_NAME" 12 | -------------------------------------------------------------------------------- /koka_bench/koka/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | set(sources rbtree.kk nqueens.kk nqueens-int.kk cfold.kk deriv.kk fib.kk) 2 | 3 | set(koka koka) 4 | 5 | 6 | foreach (source IN LISTS sources) 7 | get_filename_component(basename "${source}" NAME_WE) 8 | set(name "kk-${basename}") 9 | 10 | set(out_dir "${CMAKE_CURRENT_BINARY_DIR}/out/bench") 11 | set(out_path "${out_dir}/${name}") 12 | 13 | add_custom_command( 14 | OUTPUT ${out_path} 15 | COMMAND ${koka} --target=c --stack=128M --outputdir=${out_dir} --buildname=${name} -v -O2 -i$ "${source}" 16 | DEPENDS ${source} 17 | VERBATIM) 18 | 19 | add_custom_target(update-${name} ALL DEPENDS "${out_path}") 20 | add_executable(${name}-exe IMPORTED) 21 | set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${out_path}") 22 | endforeach () 23 | -------------------------------------------------------------------------------- /koka_bench/koka/cfold.kk: -------------------------------------------------------------------------------- 1 | // Adapted from https://github.com/leanprover/lean4/blob/IFL19/tests/bench/const_fold.hs 2 | import std/os/env 3 | type expr 4 | Var( : int ) 5 | Val( : int ) 6 | Add( l : expr, r : expr ) 7 | Mul( l : expr, r : expr ) 8 | 9 | fun mk_expr( n : int, v : int ) : div expr 10 | if n==0 11 | then (if v==0 then Var(1) else Val(v)) 12 | else Add( mk_expr(n - 1, v+1), mk_expr(n - 1, max(v - 1,0)) ) 13 | 14 | fun append_add( e0 : expr, e3 : expr ) : expr 15 | match e0 16 | Add(e1,e2) -> Add(e1, append_add(e2,e3)) 17 | _ -> Add(e0,e3) 18 | 19 | fun append_mul( e0 : expr, e3 : expr ) : expr 20 | match e0 21 | Mul(e1,e2) -> Mul(e1, append_mul(e2,e3)) 22 | _ -> Mul(e0,e3) 23 | 24 | fun reassoc( e : expr ) : expr 25 | match e 26 | Add(e1,e2) -> append_add(reassoc(e1), reassoc(e2)) 27 | Mul(e1,e2) -> append_mul(reassoc(e1), reassoc(e2)) 28 | _ -> e 29 | 30 | fun cfold( e : expr ) : expr 31 | match e 32 | Add(e1,e2) -> 33 | val e1' = cfold(e1) 34 | val e2' = cfold(e2) 35 | match e1' 36 | Val(a) -> match e2' 37 | Val(b) -> Val(a+b) 38 | Add(f,Val(b)) -> Add(Val(a+b),f) 39 | Add(Val(b),f) -> Add(Val(a+b),f) 40 | _ -> Add(e1',e2') 41 | _ -> Add(e1',e2') 42 | Mul(e1,e2) -> 43 | val e1' = cfold(e1) 44 | val e2' = cfold(e2) 45 | match e1' 46 | Val(a) -> match e2' 47 | Val(b) -> Val(a*b) 48 | Mul(f,Val(b)) -> Mul(Val(a*b),f) 49 | Mul(Val(b),f) -> Mul(Val(a*b),f) 50 | _ -> Mul(e1',e2') 51 | _ -> Mul(e1',e2') 52 | _ -> e 53 | 54 | 55 | fun eval(e : expr) : int 56 | match e 57 | Var -> 0 58 | Val(v) -> v 59 | Add(l,r) -> eval(l) + eval(r) 60 | Mul(l,r) -> eval(l) * eval(r) 61 | 62 | 63 | pub fun main() 64 | val n = get-args().head("").parse-int.default(20) 65 | val e = mk_expr(n,1) 66 | val v1 = eval(e) 67 | val v2 = e.reassoc.cfold.eval 68 | println( v1.show ) 69 | println( v2.show ) 70 | 71 | -------------------------------------------------------------------------------- /koka_bench/koka/deriv.kk: -------------------------------------------------------------------------------- 1 | // Adapted from: https://raw.githubusercontent.com/leanprover/lean4/IFL19/tests/bench/deriv.ml 2 | import std/os/env 3 | type expr 4 | Val(value : int) 5 | Var(name : string) 6 | Add(l : expr, r : expr) 7 | Mul(l : expr, r : expr) 8 | Pow(l : expr, r : expr) 9 | Ln(e : expr) 10 | 11 | fun pown(a : int, b : int) : int 12 | pow(a,b) 13 | 14 | fun add(n0 : expr, m0 : expr) : div expr 15 | match(n0,m0) 16 | (Val(n),Val(m)) -> Val(n+m) 17 | (Val(0),f) -> f 18 | (f,Val(0)) -> f 19 | (f,Val(n)) -> add(Val(n),f) 20 | (Val(n),Add(Val(m),f)) -> add(Val(n+m),f) 21 | (f,Add(Val(n),g)) -> add(Val(n),add(f,g)) 22 | (Add(f, g), h) -> add(f,add(g,h)) 23 | (f,g) -> Add(f, g) 24 | 25 | fun mul(n0 : expr, m0 : expr) : div expr 26 | match (n0,m0) 27 | (Val(n), Val(m)) -> Val(n*m) 28 | (Val(0), _) -> Val(0) 29 | (_, Val(0)) -> Val(0) 30 | (Val(1), f) -> f 31 | (f, Val(1)) -> f 32 | (f, Val(n)) -> mul(Val(n),f) 33 | (Val(n), Mul(Val(m), f)) -> mul(Val(n*m),f) 34 | (f, Mul(Val(n), g)) -> mul(Val(n),mul(f,g)) 35 | (Mul(f, g), h) -> mul(f,mul(g,h)) 36 | (f, g) -> Mul(f, g) 37 | 38 | fun powr(m0 : expr, n0 : expr) : div expr 39 | match (m0,n0) 40 | (Val(m), Val(n)) -> Val(pown(m,n)) 41 | (_, Val(0)) -> Val(1) 42 | (f, Val(1)) -> f 43 | (Val(0), _) -> Val(0) 44 | (f, g) -> Pow(f, g) 45 | 46 | fun ln( n : expr) : expr 47 | match n 48 | Val(1) -> Val(0) 49 | f -> Ln(f) 50 | 51 | fun d( x : string, ^e : expr) : div expr 52 | match e 53 | Val(_) -> Val(0) 54 | Var(y) -> if x == y then Val(1) else Val(0) 55 | Add(f, g) -> add(d(x,f),d(x,g)) 56 | Mul(f, g) -> add(mul(f,d(x,g)),mul(g,d(x,f))) 57 | Pow(f, g) -> mul(powr(f,g),add(mul(mul(g,d(x,f)),powr(f,Val(-1))),mul(ln(f),d(x,g)))) 58 | Ln(f) -> mul(d(x,f),powr(f,Val(-1))) 59 | 60 | 61 | 62 | fun count( ^e : expr) : int 63 | match e 64 | Val(_) -> 1 65 | Var(_) -> 1 66 | Add(f,g) -> count(f) + count(g) // + 1 67 | Mul(f,g) -> count(f) + count(g) // + 1 68 | Pow(f,g) -> count(f) + count(g) // + 1 69 | Ln(f) -> count(f) // + 1 70 | 71 | fun nest_aux(s : int, f : (int,expr) -> expr, n : int, x : expr ) : expr 72 | if n == 0 then x else 73 | val y = f(s - n, x) 74 | nest_aux(s,f,n - 1,y) 75 | 76 | fun nest(f : (int,expr) -> expr, n : int, e : expr ) : expr 77 | nest_aux(n,f,n,e) 78 | 79 | 80 | fun deriv(i : int, f : expr) 81 | val d = d("x",f) 82 | println(show(i+1) ++ " count: " ++ count(d).show) // ++ ", " ++ count(f).show) 83 | d 84 | 85 | pub fun main() 86 | val n = get-args().head("").parse-int.default(10) 87 | val x = Var("x") 88 | val f = powr(x,x) 89 | nest(deriv,n,f) 90 | println("done") 91 | 92 | -------------------------------------------------------------------------------- /koka_bench/koka/fib.kk: -------------------------------------------------------------------------------- 1 | module nqueens 2 | import std/num/int32 3 | import std/os/env 4 | 5 | 6 | pub fun fib( n : int ) : div int 7 | match n 8 | 0 -> 1 9 | 1 -> 1 10 | x -> fib(x - 1) + fib(x - 2) 11 | 12 | pub fun main() 13 | fib(get-args().head("").parse-int.default(30)).println 14 | -------------------------------------------------------------------------------- /koka_bench/koka/nqueens-int.kk: -------------------------------------------------------------------------------- 1 | module nqueens-int 2 | import std/os/env 3 | 4 | alias solution = list 5 | alias solutions = list> 6 | 7 | fun safe( queen : int, diag : int, ^xs : solution ) : bool 8 | match xs 9 | Cons(q,qs) -> (queen != q && queen != q + diag && queen != q - diag && safe(queen,diag + 1,qs)) 10 | _ -> True 11 | 12 | fun append-safe( queen : int, xs : solution, xss : solutions ) : div solutions 13 | if queen <= 0 then xss 14 | elif safe(queen,1,xs) then append-safe( queen - 1, xs, Cons(Cons(queen,xs),xss) ) 15 | else append-safe( queen - 1, xs, xss ) 16 | 17 | fun extend(queen : int, acc : solutions, xss : solutions ) : div solutions 18 | match xss 19 | Cons(xs,rest) -> extend(queen, append-safe(queen,xs,acc), rest) 20 | Nil -> acc 21 | 22 | fun find-solutions( n : int, queen : int ) : div solutions 23 | if queen == 0 24 | then [[]] 25 | else extend(n,[], find-solutions(n,queen - 1)) 26 | 27 | pub fun queens( n : int ) : div int 28 | find-solutions(n,n).length 29 | 30 | pub fun main() 31 | queens(get-args().head("").parse-int.default(13)).println 32 | -------------------------------------------------------------------------------- /koka_bench/koka/nqueens.kk: -------------------------------------------------------------------------------- 1 | module nqueens 2 | import std/num/int32 3 | import std/os/env 4 | 5 | alias solution = list 6 | alias solutions = list> 7 | 8 | fun safe( queen : int32, diag : int32, ^xs : solution ) : bool 9 | match xs 10 | Cons(q,qs) -> (queen != q && queen != (q+diag) && queen != (q - diag) && safe(queen,diag.inc,qs)) 11 | _ -> True 12 | 13 | fun append-safe( queen : int32, xs : solution, xss : solutions ) : div solutions 14 | if queen <= 0.int32 then xss 15 | elif safe(queen,1.int32,xs) then append-safe( queen.dec, xs, Cons(Cons(queen,xs),xss) ) 16 | else append-safe( queen.dec, xs, xss ) 17 | 18 | fun extend( queen : int32, acc : solutions, xss : solutions ) : div solutions 19 | match xss 20 | Cons(xs,rest) -> extend(queen, append-safe(queen,xs,acc), rest) 21 | Nil -> acc 22 | 23 | fun find-solutions( n : int32, queen : int32 ) : div solutions 24 | if queen.is-zero 25 | then [[]] 26 | else extend(n, [], find-solutions(n,queen.dec)) 27 | 28 | pub fun queens( n : int32 ) : div int 29 | find-solutions(n,n).length 30 | 31 | pub fun main() 32 | queens(get-args().head("").parse-int.default(13).int32).println 33 | -------------------------------------------------------------------------------- /koka_bench/koka/rbtree.kk: -------------------------------------------------------------------------------- 1 | // Adapted from https://github.com/leanprover/lean4/blob/IFL19/tests/bench/rbmap.lean 2 | import std/num/int32 3 | import std/os/env 4 | 5 | type color 6 | Red 7 | Black 8 | 9 | 10 | type tree 11 | Node(color : color, lchild : tree, key : int32, value : bool, rchild : tree) 12 | Leaf() 13 | 14 | 15 | fun is-red(t : tree) : bool 16 | match t 17 | Node(Red) -> True 18 | _ -> False 19 | 20 | 21 | fun balance-left(l :tree, k : int32, v : bool, r : tree) : tree 22 | match l 23 | Node(_, Node(Red, lx, kx, vx, rx), ky, vy, ry) 24 | -> Node(Red, Node(Black, lx, kx, vx, rx), ky, vy, Node(Black, ry, k, v, r)) 25 | Node(_, ly, ky, vy, Node(Red, lx, kx, vx, rx)) 26 | -> Node(Red, Node(Black, ly, ky, vy, lx), kx, vx, Node(Black, rx, k, v, r)) 27 | Node(_, lx, kx, vx, rx) 28 | -> Node(Black, Node(Red, lx, kx, vx, rx), k, v, r) 29 | Leaf -> Leaf 30 | 31 | 32 | fun balance-right(l : tree, k : int32, v : bool, r : tree) : tree 33 | match r 34 | Node(_, Node(Red, lx, kx, vx, rx), ky, vy, ry) 35 | -> Node(Red, Node(Black, l, k, v, lx), kx, vx, Node(Black, rx, ky, vy, ry)) 36 | Node(_, lx, kx, vx, Node(Red, ly, ky, vy, ry)) 37 | -> Node(Red, Node(Black, l, k, v, lx), kx, vx, Node(Black, ly, ky, vy, ry)) 38 | Node(_, lx, kx, vx, rx) 39 | -> Node(Black, l, k, v, Node(Red, lx, kx, vx, rx)) 40 | Leaf -> Leaf 41 | 42 | 43 | fun ins(t : tree, k : int32, v : bool) : tree 44 | match t 45 | Node(Red, l, kx, vx, r) 46 | -> if k < kx then Node(Red, ins(l, k, v), kx, vx, r) 47 | elif k > kx then Node(Red, l, kx, vx, ins(r, k, v)) 48 | else Node(Red, l, k, v, r) 49 | Node(Black, l, kx, vx, r) 50 | -> if k < kx then (if is-red(l) then balance-left(ins(l,k,v), kx, vx, r) 51 | else Node(Black, ins(l, k, v), kx, vx, r)) 52 | elif k > kx then (if is-red(r) then balance-right(l, kx, vx, ins(r,k,v)) 53 | else Node(Black, l, kx, vx, ins(r, k, v))) 54 | else Node(Black, l, k, v, r) 55 | Leaf -> Node(Red, Leaf, k, v, Leaf) 56 | 57 | 58 | fun set-black(t : tree) : tree 59 | match t 60 | Node(_, l, k, v, r) -> Node(Black, l, k, v, r) 61 | _ -> t 62 | 63 | 64 | fun insert(t : tree, k : int32, v : bool) : tree 65 | ins(t, k, v).set-black 66 | 67 | 68 | fun fold(t : tree, b : a, f: (int32, bool, a) -> a) : a 69 | match t 70 | Node(_, l, k, v, r) -> r.fold( f(k, v, l.fold(b, f)), f) 71 | Leaf -> b 72 | 73 | 74 | fun make-tree-aux(n : int32, t : tree) : div tree 75 | if n <= zero then t else 76 | val n1 = n.dec 77 | make-tree-aux(n1, insert(t, n1, n1 % 10.int32 == zero)) 78 | 79 | pub fun make-tree(n : int32) : div tree 80 | make-tree-aux(n, Leaf) 81 | 82 | 83 | pub fun main() 84 | val n = get-args().head("").parse-int.default(4200000).int32 85 | val t = make-tree(n) 86 | val v = t.fold(zero) fn(k,v,r:int32){ if (v) then r.inc else r } 87 | v.show.println 88 | -------------------------------------------------------------------------------- /koka_bench/kraken/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | set(sources rbtree.kp rbtree-opt.kp nqueens.kp cfold.kp deriv.kp fib.kp fib-let.kp) 2 | 3 | set(kraken "../../kraken_wrapper.sh") 4 | 5 | 6 | foreach (source IN LISTS sources) 7 | get_filename_component(basename "${source}" NAME_WE) 8 | set(name "kraken-${basename}") 9 | 10 | set(out_dir "${CMAKE_CURRENT_BINARY_DIR}/out/bench") 11 | set(out_path "${out_dir}/${name}") 12 | 13 | add_custom_command( 14 | OUTPUT ${out_path} 15 | COMMAND ${kraken} "${CMAKE_CURRENT_SOURCE_DIR}/${source}" ${out_dir} ${name} 16 | DEPENDS ${source} 17 | VERBATIM) 18 | 19 | add_custom_target(update-${name} ALL DEPENDS "${out_path}") 20 | add_executable(${name}-exe IMPORTED) 21 | set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${out_path}") 22 | endforeach () 23 | -------------------------------------------------------------------------------- /koka_bench/kraken/fib-let.kp: -------------------------------------------------------------------------------- 1 | 2 | ((wrap (vau root_env (quote) 3 | ((wrap (vau (let1) 4 | (let1 lambda (vau se (p b1) (wrap (eval (array vau p b1) se))) 5 | (let1 current-env (vau de () de) 6 | (let1 cons (lambda (h t) (concat (array h) t)) 7 | (let1 Y (lambda (f3) 8 | ((lambda (x1) (x1 x1)) 9 | (lambda (x2) (f3 (wrap (vau app_env (& y) (lapply (x2 x2) y app_env))))))) 10 | (let1 vY (lambda (f) 11 | ((lambda (x3) (x3 x3)) 12 | (lambda (x4) (f (vau de1 (& y) (vapply (x4 x4) y de1)))))) 13 | (let1 let (vY (lambda (recurse) (vau de2 (vs b) (cond (= (len vs) 0) (eval b de2) 14 | true (vapply let1 (array (idx vs 0) (idx vs 1) (array recurse (slice vs 2 -1) b)) de2))))) 15 | (let ( 16 | lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args))))) 17 | rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se)) 18 | 19 | fib (rec-lambda fib (n) (cond (= 0 n) 1 20 | (= 1 n) 1 21 | true (let ( 22 | fib_minus_1 (fib (- n 1)) 23 | fib_minus_2 (fib (- n 2)) 24 | ) (+ fib_minus_1 fib_minus_2)))) 25 | 26 | monad (array 'write 1 (str "running fib") (vau (written code) 27 | (array 'args (vau (args code) 28 | (array 'exit (fib (read-string (idx args 1)))) 29 | )) 30 | )) 31 | 32 | ) monad) 33 | ; end of all lets 34 | )))))) 35 | ; impl of let1 36 | )) (vau de (s v b) (eval (array (array wrap (array vau (array s) b)) v) de))) 37 | ; impl of quote 38 | )) (vau (x5) x5)) 39 | -------------------------------------------------------------------------------- /koka_bench/kraken/fib.kp: -------------------------------------------------------------------------------- 1 | 2 | ((wrap (vau root_env (quote) 3 | ((wrap (vau (let1) 4 | (let1 lambda (vau se (p b1) (wrap (eval (array vau p b1) se))) 5 | (let1 current-env (vau de () de) 6 | (let1 cons (lambda (h t) (concat (array h) t)) 7 | (let1 Y (lambda (f3) 8 | ((lambda (x1) (x1 x1)) 9 | (lambda (x2) (f3 (wrap (vau app_env (& y) (lapply (x2 x2) y app_env))))))) 10 | (let1 vY (lambda (f) 11 | ((lambda (x3) (x3 x3)) 12 | (lambda (x4) (f (vau de1 (& y) (vapply (x4 x4) y de1)))))) 13 | (let1 let (vY (lambda (recurse) (vau de2 (vs b) (cond (= (len vs) 0) (eval b de2) 14 | true (vapply let1 (array (idx vs 0) (idx vs 1) (array recurse (slice vs 2 -1) b)) de2))))) 15 | (let ( 16 | lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args))))) 17 | rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se)) 18 | 19 | fib (rec-lambda fib (n) (cond (= 0 n) 1 20 | (= 1 n) 1 21 | true (+ (fib (- n 1)) (fib (- n 2))))) 22 | 23 | monad (array 'write 1 (str "running fib") (vau (written code) 24 | (array 'args (vau (args code) 25 | (array 'exit (fib (read-string (idx args 1)))) 26 | )) 27 | )) 28 | 29 | ) monad) 30 | ; end of all lets 31 | )))))) 32 | ; impl of let1 33 | )) (vau de (s v b) (eval (array (array wrap (array vau (array s) b)) v) de))) 34 | ; impl of quote 35 | )) (vau (x5) x5)) 36 | -------------------------------------------------------------------------------- /koka_bench/kraken/test.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | set -e 3 | NUMBER=42000 4 | 5 | #rm rbtree.wasm || true 6 | #scheme --script ../../partial_eval.scm rbtree.kp && mv csc_out.wasm rbtree.wasm 7 | #hyperfine --warmup 2 "wasmtime ./rbtree.wasm $NUMBER" "wasmtime ./old_rbtree.wasm $NUMBER" 8 | 9 | rm rbtree-opt.wasm || true 10 | scheme --script ../../partial_eval.scm rbtree-opt.kp && mv csc_out.wasm rbtree-opt.wasm 11 | hyperfine --warmup 2 "wasmtime ./rbtree-opt.wasm $NUMBER" "wasmtime ./old_rbtree-opt.wasm $NUMBER" 12 | 13 | #rm rbtree.wasm || true 14 | #rm rbtree-opt.wasm || true 15 | #scheme --script ../../partial_eval.scm rbtree.kp && mv csc_out.wasm rbtree.wasm 16 | #scheme --script ../../partial_eval.scm rbtree-opt.kp && mv csc_out.wasm rbtree-opt.wasm 17 | #hyperfine --warmup 2 "wasmtime ./rbtree.wasm $NUMBER" "wasmtime ./rbtree-opt.wasm $NUMBER" "wasmtime ./old_rbtree.wasm $NUMBER" "wasmtime ./old_rbtree-opt.wasm $NUMBER" 18 | 19 | -------------------------------------------------------------------------------- /koka_bench/kraken_wrapper.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | OUR_DIR="$(dirname $(readlink -f $0))" 3 | SOURCE="$1" 4 | OUT_DIR="$2" 5 | OUT_NAME="$3" 6 | 7 | doit() { 8 | TAG=$1 9 | OPTION=$2 10 | scheme --script "$OUR_DIR/../partial_eval.scm" $SOURCE $OPTION 11 | mkdir -p "$OUT_DIR" 12 | mv ./csc_out.wasm "$OUT_DIR/$OUT_NAME$TAG.wasm" 13 | printf '#!/usr/bin/env bash\nwasmtime "$(dirname $(readlink -f $0))/'"$OUT_NAME$TAG"'.wasm" $@' > "$OUT_DIR/$OUT_NAME$TAG" 14 | chmod 755 "$OUT_DIR/$OUT_NAME$TAG" 15 | 16 | printf '#!/usr/bin/env bash\nWAVM_OBJECT_CACHE_DIR=$(pwd) wavm run "$(dirname $(readlink -f $0))/'"$OUT_NAME$TAG"'.wasm" $@' > "$OUT_DIR/$OUT_NAME$TAG-wavm" 17 | chmod 755 "$OUT_DIR/$OUT_NAME$TAG-wavm" 18 | } 19 | 20 | doit "-n" "" 21 | doit -slow no_compile 22 | doit -no_lazy_env no_lazy_env 23 | doit -no_y_comb no_y_comb 24 | doit -no_prim_inline no_prim_inline 25 | doit -no_closure_inline no_closure_inline 26 | -------------------------------------------------------------------------------- /koka_bench/new_test.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | set -e 3 | 4 | SCRIPT_DIR=$( cd -- "$( dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd ) 5 | pushd "$SCRIPT_DIR" 6 | 7 | # Yeet ourselves inside a pure flake shell (-i for ignore-environment) 8 | if [[ -z "${INSIDE_FLAKE}" ]]; then 9 | echo "Not inside flake, entering" 10 | # thanks to https://stackoverflow.com/questions/59895/how-do-i-get-the-directory-where-a-bash-script-is-located-from-within-the-script 11 | echo "about to run nix develop" 12 | nix develop -i -c env INSIDE_FLAKE=true bash -c "$SCRIPT_DIR/new_test.sh" 13 | exit 14 | else 15 | echo "Inside flake, running!" 16 | fi 17 | 18 | rm -rf build || true 19 | mkdir build 20 | 21 | pushd build 22 | # workaround thanks to https://github.com/NixOS/nixpkgs/issues/139943 23 | cp -r "$(dirname $(dirname $(which emcc)))/share/emscripten/cache" ./emcache 24 | chmod u+rwX -R emcache 25 | export EM_CACHE="$(pwd)/emcache" 26 | 27 | #no_compile 28 | #no_lazy_env 29 | #no_y_comb 30 | #no_prim_inline 31 | #no_closure_inline 32 | 33 | echo "RB-Tree" 34 | ITERS=420000 35 | scheme --script ../../partial_eval.scm ../kraken/rbtree-opt.kp && mv csc_out.wasm kraken-rbtree-opt.wasm 36 | koka --target=wasm -v -O2 ../koka/rbtree.kk && mv ./.koka/v*/emcc-wasm32-drelease/koka_rbtree.wasm ./ 37 | #koka --target=c -v -O2 ../koka/rbtree.kk && mv ./.koka/v*/cc-drelease/koka_rbtree ./ 38 | 39 | hyperfine --warmup 2 "wasmtime ./koka_rbtree.wasm $ITERS" "wasmtime ./kraken-rbtree-opt.wasm $ITERS" --export-markdown rbtree_table.md --export-csv rbtree_table.csv 40 | 41 | echo "Fib" 42 | ITERS=40 43 | scheme --script ../../partial_eval.scm ../kraken/fib.kp && mv csc_out.wasm kraken-fib.wasm 44 | koka --target=wasm -v -O2 ../koka/fib.kk && mv ./.koka/v*/emcc-wasm32-drelease/koka_fib.wasm ./ 45 | hyperfine --warmup 2 "wasmtime ./koka_fib.wasm $ITERS" "wasmtime ./kraken-fib.wasm $ITERS" --export-markdown fib_table.md --export-csv fib_table.csv 46 | 47 | 48 | echo "CFold" 49 | ITERS=9 50 | scheme --script ../../partial_eval.scm ../kraken/cfold.kp && mv csc_out.wasm kraken-cfold.wasm 51 | koka --target=wasm -v -O2 ../koka/cfold.kk && mv ./.koka/v*/emcc-wasm32-drelease/koka_cfold.wasm ./ 52 | hyperfine --warmup 2 "wasmtime ./koka_cfold.wasm $ITERS" "wasmtime ./kraken-cfold.wasm $ITERS" --export-markdown cfold_table.md --export-csv cfold_table.csv 53 | 54 | echo "N-Queens" 55 | ITERS=10 56 | scheme --script ../../partial_eval.scm ../kraken/nqueens.kp && mv csc_out.wasm kraken-nqueens.wasm 57 | koka --target=wasm -v -O2 ../koka/nqueens.kk && mv ./.koka/v*/emcc-wasm32-drelease/koka_nqueens.wasm ./ 58 | hyperfine --warmup 2 "wasmtime ./koka_nqueens.wasm $ITERS" "wasmtime ./kraken-nqueens.wasm $ITERS" --export-markdown nqueens_table.md --export-csv nqueens_table.csv 59 | 60 | echo "Deriv" 61 | ITERS=9 62 | scheme --script ../../partial_eval.scm ../kraken/deriv.kp && mv csc_out.wasm kraken-deriv.wasm 63 | koka --target=wasm -v -O2 ../koka/deriv.kk && mv ./.koka/v*/emcc-wasm32-drelease/koka_deriv.wasm ./ 64 | hyperfine --warmup 2 "wasmtime ./koka_deriv.wasm $ITERS" "wasmtime ./kraken-deriv.wasm $ITERS" --export-markdown deriv_table.md --export-csv deriv_table.csv 65 | popd 66 | popd 67 | -------------------------------------------------------------------------------- /koka_bench/newlisp/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | 2 | set(copy_wrapper "../../copy_wrapper.sh") 3 | 4 | set(sources newlisp-fib.nl newlisp-fib-let.nl newlisp-builtin-rbtree.nl newlisp-slow-fexpr-rbtree.nl newlisp-macro-rbtree.nl ) 5 | foreach (source IN LISTS sources) 6 | 7 | get_filename_component(name "${source}" NAME_WE) 8 | 9 | set(out_dir "${CMAKE_CURRENT_BINARY_DIR}/out/bench") 10 | set(out_path "${out_dir}/${name}") 11 | 12 | add_custom_command( 13 | OUTPUT ${out_path} 14 | COMMAND ${copy_wrapper} "${CMAKE_CURRENT_SOURCE_DIR}/${source}" ${out_dir} ${name} 15 | DEPENDS ${source} 16 | VERBATIM) 17 | 18 | add_custom_target(update-${name} ALL DEPENDS "${out_path}") 19 | add_executable(${name}-exe IMPORTED) 20 | set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${out_path}") 21 | endforeach () 22 | 23 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-builtin-rbtree.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | 3 | (new Tree 'Foo) 4 | 5 | (define (make-test-tree n t) (cond ((<= n 0) t) 6 | (true (make-test-tree (- n 1) (begin (t n (= 0 (% n 10))) t))))) 7 | (define (reduce-test-tree t) (let ((sum 0)) (dolist (item (t)) (if (item 1) (setq sum (+ sum 1)))))) 8 | 9 | 10 | (println (reduce-test-tree (make-test-tree (integer (main-args 2)) Foo))) 11 | 12 | (exit) 13 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-fib-let.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | ;; 3 | ;; fibonacci series 4 | ;; mostly from http://www.newlisp.org/syntax.cgi?benchmarks/fibo.newlisp.txt 5 | ;; modified slightly to match others 6 | ;; 7 | 8 | (define (fib n) 9 | (cond ((= 0 n) 1) 10 | ((= 1 n) 1) 11 | (true (let (a (fib (- n 1)) 12 | b (fib (- n 2)) 13 | ) (+ a b))))) 14 | 15 | (println (fib (integer (main-args 2)))) 16 | 17 | (exit) 18 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-fib.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | ;; 3 | ;; fibonacci series 4 | ;; mostly from http://www.newlisp.org/syntax.cgi?benchmarks/fibo.newlisp.txt 5 | ;; modified slightly to match others 6 | ;; 7 | 8 | (define (fib n) 9 | (cond ((= 0 n) 1) 10 | ((= 1 n) 1) 11 | (true (+ (fib (- n 1)) (fib (- n 2)))))) 12 | 13 | (println (fib (integer (main-args 2)))) 14 | 15 | (exit) 16 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-macro-cfold.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | 3 | (define cont list) 4 | (define cont? list?) 5 | ;(define cont (lambda (l) (array (length l) l))) 6 | ;(define cont? array?) 7 | 8 | (define (evaluate_case access c) (cond 9 | ((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b))) 10 | ((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access))) 11 | ((list? c) (letn ( 12 | tests (list and (list list? access) (list = (length c) (list length access))) 13 | tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c)) 14 | (list tests body_func) 15 | (letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i)) 16 | inner_test (inner_test__inner_body_func 0) 17 | inner_body_func (inner_test__inner_body_func 1) 18 | ) 19 | (recurse (append tests (list inner_test)) 20 | (expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func) 21 | (+ i 1)))))) 22 | (recurse tests (lambda (b) b) 0)) 23 | ) tests__body_func)) 24 | (true (list (list = access c) (lambda (b) b))) 25 | )) 26 | 27 | (define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i))) 28 | (append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2))))) 29 | (true '((true ("none matched")))))) 30 | 31 | (macro (my-match X) X) 32 | (constant 'my-match (lambda-macro (X) (expand (list let (list '__MATCH_SYM 'X) (cons cond (my-match-helper '__MATCH_SYM (args) 0))) 'X))) 33 | 34 | (define (mk-expr n v) (cond ((= n 0) (cond ((= v 0) (list 'VR 1 0)) 35 | (true (list 'VL v 0)))) 36 | (true (list 'A (mk-expr (- n 1) (+ v 1)) (mk-expr (- n 1) (max (- v 1) 0)))))) 37 | 38 | (define (append-add a b) (my-match a 39 | ('A c d) (list 'A c (append-add d b)) 40 | a (list 'A a b))) 41 | 42 | (define (append-mul a b) (my-match a 43 | ('M c d) (list 'M c (append-mul d b)) 44 | a (list 'M a b))) 45 | 46 | (define (reassoc e) (my-match e 47 | ('A a b) (append-add (reassoc a) (reassoc b)) 48 | ('M c d) (append-mul (reassoc a) (reassoc b)) 49 | e e)) 50 | 51 | (define (cfoldD e) (my-match e 52 | ('A a b) (letn (ap (cfoldD a) 53 | bp (cfoldD b)) 54 | (my-match ap 55 | ('VL s t) (my-match bp 56 | ('VL m n) (list 'VL (+ s m) 0) 57 | ('A m ('VL n p)) (list 'A (list 'VL (+ s n) 0) m) 58 | ('A ('VL m n) p) (list 'A (list 'VL (+ s m) 0) p) 59 | ep (list 'A ap bp) 60 | ) 61 | ep (list 'A ap bp) 62 | ) 63 | ) 64 | ('M c d) (letn (cp (cfoldD c) 65 | dp (cfoldD dec)) 66 | (my-match cp 67 | ('VL s t) (my-match dp 68 | ('VL m n) (list 'VL (* s m) 0) 69 | ('M m ('VL n p)) (list 'M (list 'VL (* s n) 0) m) 70 | ('M ('VL m n) p) (list 'M (list 'VL (* s m) 0) p) 71 | ep (list 'M cp dp) 72 | ) 73 | ep (list 'M ap bp) 74 | ) 75 | ) 76 | e e)) 77 | 78 | (define (evalD e) (my-match e 79 | ('VR a b) 0 80 | ('VL c d) c 81 | ('A e f) (+ (evalD e) (evalD f)) 82 | ('M l r) (* (evalD l) (evalD r)))) 83 | 84 | 85 | (println (evalD (cfoldD (reassoc (mk-expr (integer (main-args 2)) 1))))) 86 | 87 | (exit) 88 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-macro-deriv.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | 3 | (define cont list) 4 | (define cont? list?) 5 | ;(define cont (lambda (l) (array (length l) l))) 6 | ;(define cont? array?) 7 | 8 | (define (evaluate_case access c) (cond 9 | ((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b))) 10 | ((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access))) 11 | ((list? c) (letn ( 12 | tests (list and (list list? access) (list = (length c) (list length access))) 13 | tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c)) 14 | (list tests body_func) 15 | (letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i)) 16 | inner_test (inner_test__inner_body_func 0) 17 | inner_body_func (inner_test__inner_body_func 1) 18 | ) 19 | (recurse (append tests (list inner_test)) 20 | (expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func) 21 | (+ i 1)))))) 22 | (recurse tests (lambda (b) b) 0)) 23 | ) tests__body_func)) 24 | (true (list (list = access c) (lambda (b) b))) 25 | )) 26 | 27 | (define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i))) 28 | (append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2))))) 29 | (true '((true ("none matched")))))) 30 | 31 | (macro (my-match X) X) 32 | (constant 'my-match (lambda-macro (X) (expand (list let (list '__MATCH_SYM 'X) (cons cond (my-match-helper '__MATCH_SYM (args) 0))) 'X))) 33 | 34 | 35 | (define (addD nI mI) (my-match (list nI mI) 36 | (('VL n x) ('VL m y)) (list 'VL (+ n m) x) 37 | (('VL 0 x) f) f 38 | (f ('VL 0 y)) f 39 | (f ('VL n y)) (addD (list 'VL n y) f) 40 | (('VL n x) ('A ('VL m y) f)) (addD (list 'VL (+ n m) y) f) 41 | (f ('A ('VL m y) g)) (addD (list 'VL m y) (addD f g)) 42 | (('A f g) h) (addD f (addD g h)) 43 | (f g) (list 'A f g))) 44 | 45 | (define (mulD nI mI) (my-match (list nI mI) 46 | (('VL n x) ('VL m y)) (list 'VL (* n m) x) 47 | (('VL 0 x) f) (list 'VL 0 x) 48 | (f ('VL 0 y)) (list 'VL 0 y) 49 | (('VL 1 x) f) f 50 | (f ('VL 1 y)) f 51 | (f ('VL n y)) (mulD (list 'VL n y) f) 52 | (('VL n x) ('M ('VL m y) f)) (mulD (list 'VL (* n m) y) f) 53 | (f ('M ('VL m y) g)) (mulD (list 'VL m y) (mulD f g)) 54 | (('M f g) h) (mulD f (mulD g h)) 55 | (f g) (list 'M f g))) 56 | 57 | (define (powD nI mI) (my-match (list nI mI) 58 | (('VL n x) ('VL m y)) (list 'VL (pow n m) x) 59 | (f ('VL 0 y)) (list 'VL 1 y) 60 | (f ('VL 1 y)) f 61 | (('VL 0 y) f) (list 'VL 1 y) 62 | (f g) (list 'P f g))) 63 | 64 | (define (lnD nI) (my-match nI 65 | ('VL 1 x) (list 'VL 0 x) 66 | f (list 'L f 0))) 67 | 68 | (define (derv x e) (my-match e 69 | ('VL a b) (list 'VL 0 b) 70 | ('VR y b) (cond ((= x y) (list 'VL 1 b)) 71 | (true (list 'VL 0 b))) 72 | ('A f g) (addD (derv x f) (derv x g)) 73 | ('M f g) (addD (mulD f (derv x g)) (mulD g (derv x f))) 74 | ('P f g) (mulD (powD f g) (addD (mulD (mulD g (derv x f)) (powD f (list 'VL -1 0))) (mulD (lnD f) (derv x g)))) 75 | ('L f) (mulD (derv x f) (powD f (list 'VL -1 0))) 76 | 77 | )) 78 | 79 | (define (countD nI) (my-match nI 80 | ('VL a x) 1 81 | ('VR b x) 1 82 | ('A f g) (+ (countD f) (countD g)) 83 | ('M f g) (+ (countD f) (countD g)) 84 | ('P f g) (+ (countD f) (countD g)) 85 | ('L f g) (countD f))) 86 | 87 | (define (nest-aux s f n x) (cond ((= n 0) x) 88 | (true (nest-aux s f (- n 1) (f (- s n) x))))) 89 | 90 | (define (nest f n e) (nest-aux n f n e)) 91 | 92 | (define (deriv i f) (letn (d (derv "x" f) 93 | y (println (+ i 1) " countL: " (countD d)) 94 | )d)) 95 | 96 | (println (nest deriv (integer (main-args 2)) (powD (list 'VR "x" 0) (list 'VR "x" 0)))) 97 | 98 | (exit) 99 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-macro-fib-let.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | ;; 3 | ;; fibonacci series 4 | ;; mostly from http://www.newlisp.org/syntax.cgi?benchmarks/fibo.newlisp.txt 5 | ;; modified slightly to match others 6 | ;; 7 | 8 | (define (fib n) 9 | (my-match (0 1) 10 | (1 1) 11 | (n (let (a (fib (- n 1)) 12 | b (fib (- n 2)) 13 | ) (+ a b))))) 14 | 15 | (define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i))) 16 | (append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2))))) 17 | (true '((true ("none matched")))))) 18 | 19 | (macro (my-match X) X) 20 | (constant 'my-match (lambda-macro (X) (expand (list let (list '__MATCH_SYM 'X) (cons cond (my-match-helper '__MATCH_SYM (args) 0))) 'X))) 21 | 22 | (println (fib (integer (main-args 2)))) 23 | 24 | (exit) 25 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-macro-fib.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | ;; 3 | ;; fibonacci series 4 | ;; mostly from http://www.newlisp.org/syntax.cgi?benchmarks/fibo.newlisp.txt 5 | ;; modified slightly to match others 6 | ;; 7 | 8 | (define (fib n) 9 | (my-match (0 1) 10 | (1 1) 11 | (n (+ (fib (- n 1)) (fib (- n 2)))))) 12 | 13 | (define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i))) 14 | (append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2))))) 15 | (true '((true ("none matched")))))) 16 | 17 | (macro (my-match X) X) 18 | (constant 'my-match (lambda-macro (X) (expand (list let (list '__MATCH_SYM 'X) (cons cond (my-match-helper '__MATCH_SYM (args) 0))) 'X))) 19 | 20 | (println (fib (integer (main-args 2)))) 21 | 22 | (exit) 23 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-macro-nqueens.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | 3 | (define cont list) 4 | (define cont? list?) 5 | ;(define cont (lambda (l) (array (length l) l))) 6 | ;(define cont? array?) 7 | 8 | (define (evaluate_case access c) (cond 9 | ((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b))) 10 | ((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access))) 11 | ((list? c) (letn ( 12 | tests (list and (list list? access) (list = (length c) (list length access))) 13 | tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c)) 14 | (list tests body_func) 15 | (letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i)) 16 | inner_test (inner_test__inner_body_func 0) 17 | inner_body_func (inner_test__inner_body_func 1) 18 | ) 19 | (recurse (append tests (list inner_test)) 20 | (expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func) 21 | (+ i 1)))))) 22 | (recurse tests (lambda (b) b) 0)) 23 | ) tests__body_func)) 24 | (true (list (list = access c) (lambda (b) b))) 25 | )) 26 | 27 | (define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i))) 28 | (append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2))))) 29 | (true '((true ("none matched")))))) 30 | 31 | (macro (my-match X) X) 32 | (constant 'my-match (lambda-macro (X) (expand (list let (list '__MATCH_SYM 'X) (cons cond (my-match-helper '__MATCH_SYM (args) 0))) 'X))) 33 | 34 | (define (extendS q acc xss) (my-match xss 35 | )) 36 | 37 | (define (findS n q) (cond ((= q 0) (list nil)) 38 | true (extendS n nil (findS n (- q 1))))) 39 | 40 | (define (nqueens n) (length (findS n n))) 41 | 42 | (println (nqueens (integer (main-args 2)))) 43 | 44 | (exit) 45 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-macro-rbtree.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | 3 | (define cont list) 4 | (define cont? list?) 5 | ;(define cont (lambda (l) (array (length l) l))) 6 | ;(define cont? array?) 7 | 8 | ; Sigh, newLisp doesn't seem to be expand 'a to (quote a) so we can't look for it, and 9 | ; it doesn't support unquoting or splice-unquoting at all. As a hack, we instead 10 | ; do some string manipulation on symbols starting with the special characters ~ or @ 11 | 12 | ; OH WAIT NO WE DON'T 13 | ; we just write it out explicitly 14 | ; ugly, but fair 15 | 16 | (define (evaluate_case access c) (cond 17 | ((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b))) 18 | ((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access))) 19 | ((list? c) (letn ( 20 | tests (list and (list list? access) (list = (length c) (list length access))) 21 | tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c)) 22 | (list tests body_func) 23 | (letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i)) 24 | inner_test (inner_test__inner_body_func 0) 25 | inner_body_func (inner_test__inner_body_func 1) 26 | ) 27 | (recurse (append tests (list inner_test)) 28 | (expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func) 29 | (+ i 1)))))) 30 | (recurse tests (lambda (b) b) 0)) 31 | ) tests__body_func)) 32 | (true (list (list = access c) (lambda (b) b))) 33 | )) 34 | 35 | (define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i))) 36 | (append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2))))) 37 | (true '((true ("none matched")))))) 38 | 39 | (macro (my-match X) X) 40 | (constant 'my-match (lambda-macro (X) (expand (list let (list '__MATCH_SYM 'X) (cons cond (my-match-helper '__MATCH_SYM (args) 0))) 'X))) 41 | ;(define-macro (my-match x) (eval (list let (list '__MATCH_SYM x) (cons cond (my-match-helper '__MATCH_SYM (args) 0))))) 42 | ;(define-macro (my-match x) (list let (list '__MATCH_SYM x) (cons cond (my-match-helper '__MATCH_SYM (args) 0)))) 43 | 44 | ;(println "Hodwy!") 45 | ;(define myvar1 (list 'ASDF 1 2 3)) 46 | ;(define myvar myvar1) 47 | ;(define searche (list 'ASDF 1 2 3)) 48 | ;(println "match result " (my-match searche 49 | ; 1 2 50 | ; (1 a) (string "list!" a) 51 | ; (unquote myvar) (list searche "oooh fancy" searche) 52 | ; 'a "haha" 53 | ; 2 3)) 54 | ;(println "blacken test " (my-match (list 'R 1 2 3) 55 | ; (unquote myvar) "oooh fancy" 56 | ; (c a x b) (list 'B c a x b) 57 | ; t t)) 58 | ;(println "done") 59 | 60 | (define empty (list 'B nil nil nil)) 61 | (define E empty) 62 | (define EE (list 'BB nil nil nil)) 63 | 64 | (define (map-foldl f z t) (my-match t 65 | (unquote E) z 66 | 67 | (c a x b) (letn (new_left_result (map-foldl f z a) 68 | folded (f new_left_result x) 69 | ) (map-foldl f folded b)))) 70 | ;(c a x b) (map-foldl f (f (map-foldl f z a) x) b))) 71 | 72 | (define (blacken t) (my-match t 73 | ('R a x b) (list 'B a x b) 74 | t t)) 75 | (define (balance t) (my-match t 76 | ; figures 1 and 2 77 | ('B ('R ('R a x b) y c) z d) (list 'R (list 'B a x b) y (list 'B c z d)) 78 | ('B ('R a x ('R b y c)) z d) (list 'R (list 'B a x b) y (list 'B c z d)) 79 | ('B a x ('R ('R b y c) z d)) (list 'R (list 'B a x b) y (list 'B c z d)) 80 | ('B a x ('R b y ('R c z d))) (list 'R (list 'B a x b) y (list 'B c z d)) 81 | ; figure 8, double black cases 82 | ('BB ('R a x ('R b y c)) z d) (list 'B (list 'B a x b) y (list 'B c z d)) 83 | ('BB a x ('R ('R b y c) z d)) (list 'B (list 'B a x b) y (list 'B c z d)) 84 | ; already balenced 85 | t t)) 86 | 87 | (define (map-insert-helper t k v) (my-match t 88 | (unquote E) (list 'R t (list k v) t) 89 | (c a x b) (cond ((< k (x 0)) (balance (list c (map-insert-helper a k v) x b))) 90 | ((= k (x 0)) (list c a (list k v) b)) 91 | (true (balance (list c a x (map-insert-helper b k v))))))) 92 | (define (map-insert t k v) (blacken (map-insert-helper t k v))) 93 | 94 | (define map-empty empty) 95 | 96 | (define (make-test-tree n t) (cond ((<= n 0) t) 97 | (true (make-test-tree (- n 1) (map-insert t n (= 0 (% n 10))))))) 98 | (define (reduce-test-tree t) (map-foldl (lambda (a x) (if (x 1) (+ a 1) a)) 0 t)) 99 | 100 | 101 | (println (reduce-test-tree (make-test-tree (integer (main-args 2)) map-empty))) 102 | 103 | (exit) 104 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-slow-fexpr-cfold.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | 3 | (define cont list) 4 | (define cont? list?) 5 | ;(define cont (lambda (l) (array (length l) l))) 6 | ;(define cont? array?) 7 | 8 | (define (evaluate_case access c) (cond 9 | ((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b))) 10 | ((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access))) 11 | ((list? c) (letn ( 12 | tests (list and (list list? access) (list = (length c) (list length access))) 13 | tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c)) 14 | (list tests body_func) 15 | (letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i)) 16 | inner_test (inner_test__inner_body_func 0) 17 | inner_body_func (inner_test__inner_body_func 1) 18 | ) 19 | (recurse (append tests (list inner_test)) 20 | (expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func) 21 | (+ i 1)))))) 22 | (recurse tests (lambda (b) b) 0)) 23 | ) tests__body_func)) 24 | (true (list (list = access c) (lambda (b) b))) 25 | )) 26 | 27 | (define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i))) 28 | (append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2))))) 29 | (true '((true ("none matched")))))) 30 | (define-macro (my-match x) (eval (list let (list '__MATCH_SYM x) (cons cond (my-match-helper '__MATCH_SYM (args) 0))))) 31 | 32 | 33 | (define (mk-expr n v) (cond ((= n 0) (cond ((= v 0) (list 'VR 1 0)) 34 | (true (list 'VL v 0)))) 35 | (true (list 'A (mk-expr (- n 1) (+ v 1)) (mk-expr (- n 1) (max (- v 1) 0)))))) 36 | 37 | (define (append-add a b) (my-match a 38 | ('A c d) (list 'A c (append-add d b)) 39 | a (list 'A a b))) 40 | 41 | (define (append-mul a b) (my-match a 42 | ('M c d) (list 'M c (append-mul d b)) 43 | a (list 'M a b))) 44 | 45 | (define (reassoc e) (my-match e 46 | ('A a b) (append-add (reassoc a) (reassoc b)) 47 | ('M c d) (append-mul (reassoc a) (reassoc b)) 48 | e e)) 49 | 50 | (define (cfoldD e) (my-match e 51 | ('A a b) (letn (ap (cfoldD a) 52 | bp (cfoldD b)) 53 | (my-match ap 54 | ('VL s t) (my-match bp 55 | ('VL m n) (list 'VL (+ s m) 0) 56 | ('A m ('VL n p)) (list 'A (list 'VL (+ s n) 0) m) 57 | ('A ('VL m n) p) (list 'A (list 'VL (+ s m) 0) p) 58 | ep (list 'A ap bp) 59 | ) 60 | ep (list 'A ap bp) 61 | ) 62 | ) 63 | ('M c d) (letn (cp (cfoldD c) 64 | dp (cfoldD dec)) 65 | (my-match cp 66 | ('VL s t) (my-match dp 67 | ('VL m n) (list 'VL (* s m) 0) 68 | ('M m ('VL n p)) (list 'M (list 'VL (* s n) 0) m) 69 | ('M ('VL m n) p) (list 'M (list 'VL (* s m) 0) p) 70 | ep (list 'M cp dp) 71 | ) 72 | ep (list 'M ap bp) 73 | ) 74 | ) 75 | e e)) 76 | 77 | (define (evalD e) (my-match e 78 | ('VR a b) 0 79 | ('VL c d) c 80 | ('A e f) (+ (evalD e) (evalD f)) 81 | ('M l r) (* (evalD l) (evalD r)))) 82 | 83 | 84 | (println (evalD (cfoldD (reassoc (mk-expr (integer (main-args 2)) 1))))) 85 | 86 | (exit) 87 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-slow-fexpr-deriv.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | 3 | (define cont list) 4 | (define cont? list?) 5 | ;(define cont (lambda (l) (array (length l) l))) 6 | ;(define cont? array?) 7 | 8 | (define (evaluate_case access c) (cond 9 | ((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b))) 10 | ((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access))) 11 | ((list? c) (letn ( 12 | tests (list and (list list? access) (list = (length c) (list length access))) 13 | tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c)) 14 | (list tests body_func) 15 | (letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i)) 16 | inner_test (inner_test__inner_body_func 0) 17 | inner_body_func (inner_test__inner_body_func 1) 18 | ) 19 | (recurse (append tests (list inner_test)) 20 | (expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func) 21 | (+ i 1)))))) 22 | (recurse tests (lambda (b) b) 0)) 23 | ) tests__body_func)) 24 | (true (list (list = access c) (lambda (b) b))) 25 | )) 26 | 27 | (define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i))) 28 | (append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2))))) 29 | (true '((true ("none matched")))))) 30 | (define-macro (my-match x) (eval (list let (list '__MATCH_SYM x) (cons cond (my-match-helper '__MATCH_SYM (args) 0))))) 31 | 32 | (define (addD nI mI) (my-match (list nI mI) 33 | (('VL n x) ('VL m y)) (list 'VL (+ n m) x) 34 | (('VL 0 x) f) f 35 | (f ('VL 0 y)) f 36 | (f ('VL n y)) (addD (list 'VL n y) f) 37 | (('VL n x) ('A ('VL m y) f)) (addD (list 'VL (+ n m) y) f) 38 | (f ('A ('VL m y) g)) (addD (list 'VL m y) (addD f g)) 39 | (('A f g) h) (addD f (addD g h)) 40 | (f g) (list 'A f g))) 41 | 42 | (define (mulD nI mI) (my-match (list nI mI) 43 | (('VL n x) ('VL m y)) (list 'VL (* n m) x) 44 | (('VL 0 x) f) (list 'VL 0 x) 45 | (f ('VL 0 y)) (list 'VL 0 y) 46 | (('VL 1 x) f) f 47 | (f ('VL 1 y)) f 48 | (f ('VL n y)) (mulD (list 'VL n y) f) 49 | (('VL n x) ('M ('VL m y) f)) (mulD (list 'VL (* n m) y) f) 50 | (f ('M ('VL m y) g)) (mulD (list 'VL m y) (mulD f g)) 51 | (('M f g) h) (mulD f (mulD g h)) 52 | (f g) (list 'M f g))) 53 | 54 | (define (powD nI mI) (my-match (list nI mI) 55 | (('VL n x) ('VL m y)) (list 'VL (pow n m) x) 56 | (f ('VL 0 y)) (list 'VL 1 y) 57 | (f ('VL 1 y)) f 58 | (('VL 0 y) f) (list 'VL 1 y) 59 | (f g) (list 'P f g))) 60 | 61 | (define (lnD nI) (my-match nI 62 | ('VL 1 x) (list 'VL 0 x) 63 | f (list 'L f 0))) 64 | 65 | (define (derv x e) (my-match e 66 | ('VL a b) (list 'VL 0 b) 67 | ('VR y b) (cond ((= x y) (list 'VL 1 b)) 68 | (true (list 'VL 0 b))) 69 | ('A f g) (addD (derv x f) (derv x g)) 70 | ('M f g) (addD (mulD f (derv x g)) (mulD g (derv x f))) 71 | ('P f g) (mulD (powD f g) (addD (mulD (mulD g (derv x f)) (powD f (list 'VL -1 0))) (mulD (lnD f) (derv x g)))) 72 | ('L f) (mulD (derv x f) (powD f (list 'VL -1 0))) 73 | 74 | )) 75 | 76 | (define (countD nI) (my-match nI 77 | ('VL a x) 1 78 | ('VR b x) 1 79 | ('A f g) (+ (countD f) (countD g)) 80 | ('M f g) (+ (countD f) (countD g)) 81 | ('P f g) (+ (countD f) (countD g)) 82 | ('L f g) (countD f))) 83 | 84 | (define (nest-aux s f n x) (cond ((= n 0) x) 85 | (true (nest-aux s f (- n 1) (f (- s n) x))))) 86 | 87 | (define (nest f n e) (nest-aux n f n e)) 88 | 89 | (define (deriv i f) (letn (d (derv "x" f) 90 | y (println (+ i 1) " countL: " (countD d)) 91 | )d)) 92 | 93 | (println (nest deriv (integer (main-args 2)) (powD (list 'VR "x" 0) (list 'VR "x" 0)))) 94 | 95 | (exit) 96 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-slow-fexpr-fib-let.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | ;; 3 | ;; fibonacci series 4 | ;; mostly from http://www.newlisp.org/syntax.cgi?benchmarks/fibo.newlisp.txt 5 | ;; modified slightly to match others 6 | ;; 7 | 8 | (define (fib n) 9 | (my-match (0 1) 10 | (1 1) 11 | (n (let (a (fib (- n 1)) 12 | b (fib (- n 2)) 13 | ) (+ a b))))) 14 | 15 | (define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i))) 16 | (append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2))))) 17 | (true '((true ("none matched")))))) 18 | (define-macro (my-match x) (eval (list let (list '__MATCH_SYM x) (cons cond (my-match-helper '__MATCH_SYM (args) 0))))) 19 | 20 | (println (fib (integer (main-args 2)))) 21 | 22 | (exit) 23 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-slow-fexpr-fib.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | ;; 3 | ;; fibonacci series 4 | ;; mostly from http://www.newlisp.org/syntax.cgi?benchmarks/fibo.newlisp.txt 5 | ;; modified slightly to match others 6 | ;; 7 | 8 | (define (fib n) 9 | (my-match (0 1) 10 | (1 1) 11 | (n (+ (fib (- n 1)) (fib (- n 2)))))) 12 | 13 | (define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i))) 14 | (append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2))))) 15 | (true '((true ("none matched")))))) 16 | (define-macro (my-match x) (eval (list let (list '__MATCH_SYM x) (cons cond (my-match-helper '__MATCH_SYM (args) 0))))) 17 | 18 | (println (fib (integer (main-args 2)))) 19 | 20 | (exit) 21 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-slow-fexpr-nqueens.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | 3 | (define cont list) 4 | (define cont? list?) 5 | ;(define cont (lambda (l) (array (length l) l))) 6 | ;(define cont? array?) 7 | 8 | (define (evaluate_case access c) (cond 9 | ((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b))) 10 | ((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access))) 11 | ((list? c) (letn ( 12 | tests (list and (list list? access) (list = (length c) (list length access))) 13 | tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c)) 14 | (list tests body_func) 15 | (letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i)) 16 | inner_test (inner_test__inner_body_func 0) 17 | inner_body_func (inner_test__inner_body_func 1) 18 | ) 19 | (recurse (append tests (list inner_test)) 20 | (expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func) 21 | (+ i 1)))))) 22 | (recurse tests (lambda (b) b) 0)) 23 | ) tests__body_func)) 24 | (true (list (list = access c) (lambda (b) b))) 25 | )) 26 | 27 | (define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i))) 28 | (append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2))))) 29 | (true '((true ("none matched")))))) 30 | (define-macro (my-match x) (eval (list let (list '__MATCH_SYM x) (cons cond (my-match-helper '__MATCH_SYM (args) 0))))) 31 | 32 | (define (safe q d xs) ()) 33 | 34 | (define (extendS q acc xss) (my-match xss 35 | )) 36 | 37 | (define (findS n q) (cond ((= q 0) (list nil)) 38 | true (extendS n nil (findS n (- q 1))))) 39 | 40 | (define (nqueens n) (length (findS n n))) 41 | 42 | (println (nqueens (integer (main-args 2)))) 43 | 44 | (exit) 45 | -------------------------------------------------------------------------------- /koka_bench/newlisp/newlisp-slow-fexpr-rbtree.nl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env newlisp 2 | 3 | (define cont list) 4 | (define cont? list?) 5 | ;(define cont (lambda (l) (array (length l) l))) 6 | ;(define cont? array?) 7 | 8 | ; Sigh, newLisp doesn't seem to be expand 'a to (quote a) so we can't look for it, and 9 | ; it doesn't support unquoting or splice-unquoting at all. As a hack, we instead 10 | ; do some string manipulation on symbols starting with the special characters ~ or @ 11 | 12 | ; OH WAIT NO WE DON'T 13 | ; we just write it out explicitly 14 | ; ugly, but fair 15 | 16 | (define (evaluate_case access c) (cond 17 | ((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b))) 18 | ((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access))) 19 | ((list? c) (letn ( 20 | tests (list and (list list? access) (list = (length c) (list length access))) 21 | tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c)) 22 | (list tests body_func) 23 | (letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i)) 24 | inner_test (inner_test__inner_body_func 0) 25 | inner_body_func (inner_test__inner_body_func 1) 26 | ) 27 | (recurse (append tests (list inner_test)) 28 | (expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func) 29 | (+ i 1)))))) 30 | (recurse tests (lambda (b) b) 0)) 31 | ) tests__body_func)) 32 | (true (list (list = access c) (lambda (b) b))) 33 | )) 34 | 35 | (define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i))) 36 | (append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2))))) 37 | (true '((true ("none matched")))))) 38 | (define-macro (my-match x) (eval (list let (list '__MATCH_SYM x) (cons cond (my-match-helper '__MATCH_SYM (args) 0))))) 39 | ;(define-macro (my-match x) (list let (list '__MATCH_SYM x) (cons cond (my-match-helper '__MATCH_SYM (args) 0)))) 40 | 41 | ;(println "Hodwy!") 42 | ;(define myvar 4) 43 | ;(println "match result " (my-match 4 44 | ; 1 2 45 | ; (1 2) "list!" 46 | ; 'a "haha" 47 | ; (unquote myvar) "oooh fancy" 48 | ; 2 3)) 49 | ;(println "blacken test " (my-match (list 'R 1 2 3) 50 | ; (c a x b) (list 'B c a x b) 51 | ; t t)) 52 | ;(println "done") 53 | 54 | (define empty (list 'B nil nil nil)) 55 | (define E empty) 56 | (define EE (list 'BB nil nil nil)) 57 | 58 | (define (map-foldl f z t) (my-match t 59 | (unquote E) z 60 | 61 | (c a x b) (letn (new_left_result (map-foldl f z a) 62 | folded (f new_left_result x) 63 | ) (map-foldl f folded b)))) 64 | ;(c a x b) (map-foldl f (f (map-foldl f z a) x) b))) 65 | 66 | (define (blacken t) (my-match t 67 | ('R a x b) (list 'B a x b) 68 | t t)) 69 | (define (balance t) (my-match t 70 | ; figures 1 and 2 71 | ('B ('R ('R a x b) y c) z d) (list 'R (list 'B a x b) y (list 'B c z d)) 72 | ('B ('R a x ('R b y c)) z d) (list 'R (list 'B a x b) y (list 'B c z d)) 73 | ('B a x ('R ('R b y c) z d)) (list 'R (list 'B a x b) y (list 'B c z d)) 74 | ('B a x ('R b y ('R c z d))) (list 'R (list 'B a x b) y (list 'B c z d)) 75 | ; figure 8, double black cases 76 | ('BB ('R a x ('R b y c)) z d) (list 'B (list 'B a x b) y (list 'B c z d)) 77 | ('BB a x ('R ('R b y c) z d)) (list 'B (list 'B a x b) y (list 'B c z d)) 78 | ; already balenced 79 | t t)) 80 | 81 | (define (map-insert-helper t k v) (my-match t 82 | (unquote E) (list 'R t (list k v) t) 83 | (c a x b) (cond ((< k (x 0)) (balance (list c (map-insert-helper a k v) x b))) 84 | ((= k (x 0)) (list c a (list k v) b)) 85 | (true (balance (list c a x (map-insert-helper b k v))))))) 86 | (define (map-insert t k v) (blacken (map-insert-helper t k v))) 87 | 88 | (define map-empty empty) 89 | 90 | (define (make-test-tree n t) (cond ((<= n 0) t) 91 | (true (make-test-tree (- n 1) (map-insert t n (= 0 (% n 10))))))) 92 | (define (reduce-test-tree t) (map-foldl (lambda (a x) (if (x 1) (+ a 1) a)) 0 t)) 93 | 94 | 95 | (println (reduce-test-tree (make-test-tree (integer (main-args 2)) map-empty))) 96 | 97 | (exit) 98 | -------------------------------------------------------------------------------- /koka_bench/ocaml/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | #see for installation (including domainslib) 2 | #> opam update 3 | #> opam switch create 4.12.0+domains+effects --repositories=multicore=git+https://github.com/ocaml-multicore/multicore-opam.git,default 4 | #> opam install dune domainslib 5 | # 6 | #compile as: 7 | #> ocamlopt -O2 -o ./mcml_bintrees -I ~/.opam/4.12.0+domains+effects/lib/domainslib/ domainslib.cmxa test/bench/ocaml/binarytrees_mc.ml 8 | 9 | 10 | set(sources cfold.ml deriv.ml nqueens.ml rbtree.ml) 11 | 12 | # find_program(ocamlopt "ocamlopt" REQUIRED) 13 | set(ocamlopt "ocamlopt") 14 | 15 | # no domains 16 | set(domainslib "unix.cmxa") 17 | 18 | # with domains 19 | # set(domainslib "-I $ENV{HOME}/.opam/4.12.0+domains+effects/lib/domainslib/ domainslib.cmxa") 20 | # set(sources cfold.ml deriv.ml nqueens.ml rbtree.ml rbtree-ck.ml binarytrees.ml) 21 | 22 | foreach (source IN LISTS sources) 23 | get_filename_component(name "${source}" NAME_WE) 24 | set(name "ml-${name}") 25 | 26 | add_custom_command( 27 | OUTPUT ${name} 28 | COMMAND ${ocamlopt} -O2 -o ${name} ${domainslib} "$" 29 | DEPENDS ${source} 30 | VERBATIM) 31 | 32 | add_custom_target(update-${name} ALL DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/${name}) 33 | 34 | add_executable(${name}-exe IMPORTED) 35 | set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${CMAKE_CURRENT_BINARY_DIR}/${name}") 36 | 37 | add_test(NAME ${name} COMMAND ${name}-exe) 38 | set_tests_properties(${name} PROPERTIES LABELS ocaml) 39 | endforeach () 40 | -------------------------------------------------------------------------------- /koka_bench/ocaml/cfold.ml: -------------------------------------------------------------------------------- 1 | type expr = 2 | | Var of int 3 | | Val of int 4 | | Add of expr * expr 5 | | Mul of expr * expr;; 6 | 7 | let dec n = 8 | if n == 0 then 0 else n - 1;; 9 | 10 | let rec mk_expr n v = 11 | if n == 0 then (if v == 0 then Var 1 else Val v) 12 | else Add (mk_expr (n-1) (v+1), mk_expr (n-1) (dec v));; 13 | 14 | let rec append_add e0 e3 = 15 | match (e0) with 16 | | Add (e1, e2) -> Add (e1, append_add e2 e3) 17 | | _ -> Add (e0, e3);; 18 | 19 | let rec append_mul e0 e3 = 20 | match e0 with 21 | | Mul (e1, e2) -> Mul (e1, append_mul e2 e3) 22 | | _ -> Mul (e0, e3);; 23 | 24 | let rec reassoc e = 25 | match e with 26 | | Add (e1, e2) -> 27 | let e1' = reassoc e1 in 28 | let e2' = reassoc e2 in 29 | append_add e1' e2' 30 | | Mul (e1, e2) -> 31 | let e1' = reassoc e1 in 32 | let e2' = reassoc e2 in 33 | append_mul e1' e2' 34 | | e -> e;; 35 | 36 | let rec const_folding e = 37 | match e with 38 | | Add (e1, e2) -> 39 | let e1 = const_folding e1 in 40 | let e2 = const_folding e2 in 41 | (match (e1, e2) with 42 | | (Val a, Val b) -> Val (a+b) 43 | | (Val a, Add (e, Val b)) -> Add (Val (a+b), e) 44 | | (Val a, Add (Val b, e)) -> Add (Val (a+b), e) 45 | | _ -> Add (e1, e2)) 46 | | Mul (e1, e2) -> 47 | let e1 = const_folding e1 in 48 | let e2 = const_folding e2 in 49 | (match (e1, e2) with 50 | | (Val a, Val b) -> Val (a*b) 51 | | (Val a, Mul (e, Val b)) -> Mul (Val (a*b), e) 52 | | (Val a, Mul (Val b, e)) -> Mul (Val (a*b), e) 53 | | _ -> Mul (e1, e2)) 54 | | e -> e;; 55 | 56 | let rec size e = 57 | match e with 58 | | Add (e1, e2) -> size e1 + size e2 + 1 59 | | Mul (e1, e2) -> size e1 + size e2 + 1 60 | | e -> 1;; 61 | 62 | let rec eeval e = 63 | match e with 64 | | Val n -> n 65 | | Var x -> 0 66 | | Add (e1, e2) -> eeval e1 + eeval e2 67 | | Mul (e1, e2) -> eeval e1 * eeval e2;; 68 | 69 | let e = (mk_expr (int_of_string Sys.argv.(1)) 1) in 70 | let v1 = eeval e in 71 | let v2 = eeval (const_folding (reassoc e)) in 72 | Printf.printf "%8d %8d\n" v1 v2;; 73 | -------------------------------------------------------------------------------- /koka_bench/ocaml/deriv.ml: -------------------------------------------------------------------------------- 1 | type expr = 2 | | Val of int 3 | | Var of string 4 | | Add of expr * expr 5 | | Mul of expr * expr 6 | | Pow of expr * expr 7 | | Ln of expr;; 8 | 9 | let rec pown a n = 10 | if n == 0 then 1 11 | else if n == 1 then a 12 | else let b = pown a (n / 2) in 13 | b * b * (if n mod 2 == 0 then 1 else a);; 14 | 15 | let rec add n m = 16 | match (n, m) with 17 | | (Val n, Val m) -> Val (n+m) 18 | | (Val 0, f) -> f 19 | | (f, Val 0) -> f 20 | | (f, Val n) -> add (Val n) f 21 | | (Val n, Add(Val m, f)) -> add (Val (n+m)) f 22 | | (f, Add(Val n, g)) -> add (Val n) (add f g) 23 | | (Add(f, g), h) -> add f (add g h) 24 | | (f, g) -> Add (f, g);; 25 | 26 | let rec mul n m = 27 | match (n, m) with 28 | | (Val n, Val m) -> Val (n*m) 29 | | (Val 0, _) -> Val 0 30 | | (_, Val 0) -> Val 0 31 | | (Val 1, f) -> f 32 | | (f, Val 1) -> f 33 | | (f, Val n) -> mul (Val n) f 34 | | (Val n, Mul (Val m, f)) -> mul (Val (n*m)) f 35 | | (f, Mul (Val n, g)) -> mul (Val n) (mul f g) 36 | | (Mul (f, g), h) -> mul f (mul g h) 37 | | (f, g) -> Mul (f, g);; 38 | 39 | let rec pow m n = 40 | match (m, n) with 41 | | (Val m, Val n) -> Val (pown m n) 42 | | (_, Val 0) -> Val 1 43 | | (f, Val 1) -> f 44 | | (Val 0, _) -> Val 0 45 | | (f, g) -> Pow (f, g);; 46 | 47 | let rec ln n = 48 | match n with 49 | | (Val 1) -> Val 0 50 | | f -> Ln f;; 51 | 52 | let rec d x f = 53 | match f with 54 | | Val _ -> Val 0 55 | | Var y -> if x = y then Val 1 else Val 0 56 | | Add (f, g) -> add (d x f) (d x g) 57 | | Mul (f, g) -> add (mul f (d x g)) (mul g (d x f)) 58 | | Pow (f, g) -> mul (pow f g) (add (mul (mul g (d x f)) (pow f (Val (-1)))) (mul (ln f) (d x g))) 59 | | Ln f -> mul (d x f) (pow f (Val (-1)));; 60 | 61 | let rec count f = 62 | match f with 63 | | Val _ -> 1 64 | | Var _ -> 1 65 | | Add (f, g) -> count f + count g 66 | | Mul (f, g) -> count f + count g 67 | | Pow (f, g) -> count f + count g 68 | | Ln f -> count f;; 69 | 70 | let rec nest_aux s f n x = 71 | if n == 0 then x 72 | else let x = f (s - n) x in 73 | nest_aux s f (n - 1) x;; 74 | 75 | let nest f n e = 76 | nest_aux n f n e;; 77 | 78 | let deriv i f = 79 | let d = d "x" f in 80 | Printf.printf "%8d count: %8d\n" (i+1) (count d); 81 | d;; 82 | 83 | let x = Var "x" in 84 | let f = pow x x in 85 | nest deriv (int_of_string Sys.argv.(1)) f;; 86 | -------------------------------------------------------------------------------- /koka_bench/ocaml/nqueens.ml: -------------------------------------------------------------------------------- 1 | open List;; 2 | 3 | let rec safe queen diag xs = 4 | match xs with 5 | | q :: qs -> queen <> q && queen <> q + diag && queen <> q - diag && safe queen (diag + 1) qs 6 | | [] -> true;; 7 | 8 | let rec append_safe queen xs xss = 9 | if (queen <= 0) then xss 10 | else if (safe queen 1 xs) then append_safe (queen - 1) xs ((queen :: xs) :: xss) 11 | else append_safe (queen - 1) xs xss;; 12 | 13 | let rec extend queen acc xss = 14 | match xss with 15 | | xs :: rest -> extend queen (append_safe queen xs acc) rest 16 | | [] -> acc;; 17 | 18 | let rec find_solutions n queen = 19 | if (queen == 0) then [[]] 20 | else extend n [] (find_solutions n (queen - 1));; 21 | 22 | let queens n = List.length (find_solutions n n);; 23 | 24 | Printf.printf "%8d\n" (queens (int_of_string Sys.argv.(1)));; 25 | -------------------------------------------------------------------------------- /koka_bench/ocaml/rbtree.ml: -------------------------------------------------------------------------------- 1 | (* Adapted from https://github.com/leanprover/lean4/blob/IFL19/tests/bench/rbmap.ml *) 2 | 3 | type color = 4 | | Red 5 | | Black;; 6 | 7 | type node = 8 | | Leaf 9 | | Node of color * node * int * bool * node;; 10 | 11 | let balance1 kv vv t n = 12 | match n with 13 | | Node (c, Node (Red, l, kx, vx, r1), ky, vy, r2) -> Node (Red, Node (Black, l, kx, vx, r1), ky, vy, Node (Black, r2, kv, vv, t)) 14 | | Node (c, l1, ky, vy, Node (Red, l2, kx, vx, r)) -> Node (Red, Node (Black, l1, ky, vy, l2), kx, vx, Node (Black, r, kv, vv, t)) 15 | | Node (c, l, ky, vy, r) -> Node (Black, Node (Red, l, ky, vy, r), kv, vv, t) 16 | | n -> Leaf;; 17 | 18 | let balance2 t kv vv n = 19 | match n with 20 | | Node (_, Node (Red, l, kx1, vx1, r1), ky, vy, r2) -> Node (Red, Node (Black, t, kv, vv, l), kx1, vx1, Node (Black, r1, ky, vy, r2)) 21 | | Node (_, l1, ky, vy, Node (Red, l2, kx2, vx2, r2)) -> Node (Red, Node (Black, t, kv, vv, l1), ky, vy, Node (Black, l2, kx2, vx2, r2)) 22 | | Node (_, l, ky, vy, r) -> Node (Black, t, kv, vv, Node (Red, l, ky, vy, r)) 23 | | n -> Leaf;; 24 | 25 | let is_red t = 26 | match t with 27 | | Node (Red, _, _, _, _) -> true 28 | | _ -> false;; 29 | 30 | let rec ins t kx vx = 31 | match t with 32 | | Leaf -> Node (Red, Leaf, kx, vx, Leaf) 33 | | Node (Red, a, ky, vy, b) -> 34 | if kx < ky then Node (Red, ins a kx vx, ky, vy, b) 35 | else if ky = kx then Node (Red, a, kx, vx, b) 36 | else Node (Red, a, ky, vy, ins b kx vx) 37 | | Node (Black, a, ky, vy, b) -> 38 | if kx < ky then 39 | (if is_red a then balance1 ky vy b (ins a kx vx) 40 | else Node (Black, (ins a kx vx), ky, vy, b)) 41 | else if kx = ky then Node (Black, a, kx, vx, b) 42 | else if is_red b then balance2 a ky vy (ins b kx vx) 43 | else Node (Black, a, ky, vy, (ins b kx vx));; 44 | 45 | let set_black n = 46 | match n with 47 | | Node (_, l, k, v, r) -> Node (Black, l, k, v, r) 48 | | e -> e;; 49 | 50 | let insert t k v = 51 | if is_red t then set_black (ins t k v) 52 | else ins t k v;; 53 | 54 | let rec fold f n d = 55 | match n with 56 | | Leaf -> d 57 | | Node(_, l, k, v, r) -> fold f r (f k v (fold f l d));; 58 | 59 | let rec mk_map_aux n m = 60 | if n = 0 then m 61 | else let n1 = n-1 in 62 | mk_map_aux n1 (insert m n1 (n1 mod 10 == 0));; 63 | 64 | let mk_map n = mk_map_aux n Leaf;; 65 | 66 | let main n = 67 | let m = mk_map n in 68 | let v = fold (fun k v r -> if v then r + 1 else r) m 0 in 69 | Printf.printf "%8d\n" v; 70 | v;; 71 | 72 | main (int_of_string Sys.argv.(1));; 73 | -------------------------------------------------------------------------------- /koka_bench/picolisp/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | 2 | set(copy_wrapper "../../copy_wrapper.sh") 3 | 4 | set(sources picolisp-fib.l picolisp-fib-let.l) 5 | foreach (source IN LISTS sources) 6 | 7 | get_filename_component(name "${source}" NAME_WE) 8 | 9 | set(out_dir "${CMAKE_CURRENT_BINARY_DIR}/out/bench") 10 | set(out_path "${out_dir}/${name}") 11 | 12 | add_custom_command( 13 | OUTPUT ${out_path} 14 | COMMAND ${copy_wrapper} "${CMAKE_CURRENT_SOURCE_DIR}/${source}" ${out_dir} ${name} 15 | DEPENDS ${source} 16 | VERBATIM) 17 | 18 | add_custom_target(update-${name} ALL DEPENDS "${out_path}") 19 | add_executable(${name}-exe IMPORTED) 20 | set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${out_path}") 21 | endforeach () 22 | 23 | -------------------------------------------------------------------------------- /koka_bench/picolisp/picolisp-deriv.l: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | #{ 3 | # Thanks to http://rosettacode.org/wiki/Multiline_shebang#PicoLisp 4 | exec pil $0 $1 5 | # }# 6 | 7 | 8 | 9 | (de fib (n) (cond ((= 0 n) 1) 10 | ((= 1 n) 1) 11 | (T (+ (fib (- n 1)) (fib (- n 2)))))) 12 | 13 | (bye (println (fib (car (str (opt)))))) 14 | -------------------------------------------------------------------------------- /koka_bench/picolisp/picolisp-fib-let.l: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | #{ 3 | # Thanks to http://rosettacode.org/wiki/Multiline_shebang#PicoLisp 4 | exec pil $0 $1 5 | # }# 6 | 7 | 8 | 9 | (de fib (N) (cond ((= 0 N) 1) 10 | ((= 1 N) 1) 11 | (T (let (A (fib (- N 1)) 12 | B (fib (- N 2)) 13 | ) (+ A B))))) 14 | 15 | (bye (println (fib (car (str (opt)))))) 16 | -------------------------------------------------------------------------------- /koka_bench/picolisp/picolisp-fib.l: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | #{ 3 | # Thanks to http://rosettacode.org/wiki/Multiline_shebang#PicoLisp 4 | exec pil $0 $1 5 | # }# 6 | 7 | 8 | 9 | (de fib (n) (cond ((= 0 n) 1) 10 | ((= 1 n) 1) 11 | (T (+ (fib (- n 1)) (fib (- n 2)))))) 12 | 13 | (bye (println (fib (car (str (opt)))))) 14 | -------------------------------------------------------------------------------- /koka_bench/picolisp/picolisp-nqueens.l: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | #{ 3 | # Thanks to http://rosettacode.org/wiki/Multiline_shebang#PicoLisp 4 | exec pil $0 $1 5 | # }# 6 | 7 | (de safe (Q D S) (let (C (car S)) 8 | (case C 9 | (NIL T) 10 | (T (and (<> Q C) (<> Q (+ C D)) (<> Q (- C D)) (safe Q (+ D 1) (cdr S)) )) 11 | ) 12 | ) 13 | ) 14 | 15 | (de appendS (Q S X) (cond ((<= Q 0) X) 16 | ((safe Q 1 S) (appendS (- Q 1) S (cons (cons Q S) X))) 17 | (T (appendS (- Q 1) S X) ) 18 | ) 19 | 20 | ) 21 | 22 | (de extendS (Q A X) (let (S (car X)) 23 | (case S 24 | (NIL A) 25 | (T (extendS Q (appendS Q S A) (cdr X))) 26 | ) 27 | ) 28 | ) 29 | 30 | (de findS (N Q) (cond ((= 0 Q) (cons (cons NIL NIL) NIL)) 31 | (T (extendS N NIL (findS N (- Q 1)))))) 32 | 33 | (de nqueens (N) (length (findS N N))) 34 | 35 | (bye (println (nqueens (car (str (opt)))))) 36 | 37 | 38 | -------------------------------------------------------------------------------- /koka_bench/plot_demo.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | # -*- coding: utf-8 -*- 3 | """ 4 | 5 | Created on Mon Apr 18 18:47:57 2022 6 | Modified Wednesday July 7th 7 | 8 | @author: bodhisatwa, Nathan Braswell 9 | 10 | """ 11 | 12 | import matplotlib.pyplot as plt 13 | import numpy as np 14 | import math 15 | 16 | def plot_graph3(): 17 | n_groups = 10 18 | a = [0.02,0.04,0.04,1.15,2.21,1.01,1.58,0.92,0.21,0.39] 19 | d = ["Single Pointer","Simple Loop","Loop Nest","519.lbm","505.mcf","525.x264","bzip2","gzip","grep","tar"] 20 | 21 | fig, ax = plt.subplots() 22 | index = np.arange(n_groups) 23 | bar_width = 0.4 24 | opacity = 0.9 25 | 26 | ax.set_facecolor('gainsboro') 27 | #ax.set_facecolor((1.0, 0.47, 0.42)) 28 | 29 | rects1 = plt.bar(index, a, bar_width, alpha=opacity, color='orange') 30 | 31 | plt.xlabel('Benchmarks') 32 | #plt.xlabel('Mix #') 33 | 34 | plt.ylabel('Improvement in Execution Time (%)') 35 | #plt.title("Performance Improvement of Parallelization") 36 | #plt.title("Mix$_{16}$ execution time normalized to original time") 37 | 38 | ax.ticklabel_format(useOffset=False, style='plain') 39 | plt.xticks(index, d, rotation=0) 40 | plt.legend() 41 | 42 | plt.tight_layout() 43 | plt.xticks(rotation = 45) 44 | plt.subplots_adjust(bottom=0.25) 45 | plt.savefig("performance-backend.png", dpi = 96 * 2 * 2) 46 | plt.show() 47 | 48 | def plot_graph2(): 49 | 50 | n_groups = 10 51 | a = [0.02,0.03,0.21,2.97,4.01,1.63,3.16,2.62,0.92,0.64] 52 | d = ["Single Pointer","Simple Loop","Loop Nest","519.lbm","505.mcf","525.x264","bzip2","gzip","grep","tar"] 53 | 54 | fig, ax = plt.subplots() 55 | index = np.arange(n_groups) 56 | bar_width = 0.4 57 | opacity = 0.9 58 | 59 | ax.set_facecolor('gainsboro') 60 | #ax.set_facecolor((1.0, 0.47, 0.42)) 61 | 62 | rects1 = plt.bar(index, a, bar_width, alpha=opacity, color='orange') 63 | 64 | plt.xlabel('Benchmarks') 65 | #plt.xlabel('Mix #') 66 | plt.ylabel('Binary Size Reduction (%)') 67 | #plt.title("Performance Improvement of Parallelization") 68 | #plt.title("Mix$_{16}$ execution time normalized to original time") 69 | 70 | ax.ticklabel_format(useOffset=False, style='plain') 71 | plt.xticks(index, d, rotation=0) 72 | plt.legend() 73 | 74 | plt.tight_layout() 75 | plt.xticks(rotation = 45) 76 | plt.subplots_adjust(bottom=0.25) 77 | plt.savefig("size_reduction.png", dpi = 96 * 2 * 2) 78 | plt.show() 79 | 80 | def plot_graph(): 81 | n_groups = 6 82 | a = [3.383796596,44.3223119,0.467799154,8.831168831,26.36934002,4.855710338] 83 | b = [10.04489527,5.241043846,0.4112731088,6.908163265,3.153844655,10.67011095] 84 | d = ['Adi', 'Fdtd-2D', 'Heat-3D', "Jacobi-1D", "Jacobi-2D", "Seidel-2D"] 85 | 86 | fig, ax = plt.subplots() 87 | index = np.arange(n_groups) 88 | bar_width = 0.4 89 | opacity = 0.9 90 | 91 | ax.set_facecolor('gainsboro') 92 | 93 | #ax.set_facecolor((1.0, 0.47, 0.42)) 94 | rects1 = plt.bar(index-0.2, a, bar_width, alpha=opacity, color='orange', label="Apple M1 Pro") 95 | 96 | rects3 = plt.bar(index+0.2, b, bar_width, alpha=opacity, color='cornflowerblue', label='Intel Xeon E5-2660') 97 | 98 | plt.xlabel('Benchmarks') 99 | #plt.xlabel('Mix #') 100 | plt.ylabel('Improvement in Execution Time (X)') 101 | #plt.title("Performance Improvement of Parallelization") 102 | #plt.title("Mix$_{16}$ execution time normalized to original time") 103 | 104 | ax.ticklabel_format(useOffset=False, style='plain') 105 | plt.xticks(index, d, rotation=0) 106 | plt.legend() 107 | 108 | plt.tight_layout() 109 | plt.savefig("bin_style1.png", dpi = 96 * 2) 110 | plt.show() 111 | 112 | def plot_graph4(): 113 | n_groups = 22 114 | a = [2,2,2,2,6,4,4,4,5,15,6,4,5,2,2,7,3,4,5,5,5,2] 115 | b = [0,0,0,0,0,0,0,0,1,7,0,0,1,0,0,1,1,0,0,1,1,0] 116 | d = ['1', '2', '3', "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22"] 117 | 118 | fig, ax = plt.subplots() 119 | index = np.arange(n_groups) 120 | bar_width = 0.4 121 | opacity = 0.9 122 | 123 | 124 | ax.set_facecolor('gainsboro') 125 | #ax.set_facecolor((1.0, 0.47, 0.42)) 126 | 127 | rects1 = plt.bar(index-0.2, a, bar_width, alpha=opacity, color='orange', label="Without Invariant Knowledge") 128 | 129 | rects3 = plt.bar(index+0.2, b, bar_width, alpha=opacity, color='cornflowerblue', label='With Invariant Knowledge') 130 | 131 | plt.xlabel('Chapter 2 Loop Nest #') 132 | #plt.xlabel('Mix #') 133 | plt.ylabel('Number of Dependencies') 134 | #plt.title("Performance Improvement of Parallelization") 135 | #plt.title("Mix$_{16}$ execution time normalized to original time") 136 | 137 | ax.ticklabel_format(useOffset=False, style='plain') 138 | plt.xticks(index, d, rotation=0) 139 | plt.legend() 140 | 141 | plt.tight_layout() 142 | plt.savefig("bin_style1.png", dpi = 96 * 2) 143 | plt.show() 144 | 145 | plot_graph() 146 | plot_graph2() 147 | plot_graph3() 148 | plot_graph4() 149 | 150 | 151 | -------------------------------------------------------------------------------- /koka_bench/python/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | 2 | set(copy_wrapper "../../copy_wrapper.sh") 3 | 4 | set(sources python-fib.py python-fib-let.py) 5 | foreach (source IN LISTS sources) 6 | 7 | get_filename_component(name "${source}" NAME_WE) 8 | 9 | set(out_dir "${CMAKE_CURRENT_BINARY_DIR}/out/bench") 10 | set(out_path "${out_dir}/${name}") 11 | 12 | add_custom_command( 13 | OUTPUT ${out_path} 14 | COMMAND ${copy_wrapper} "${CMAKE_CURRENT_SOURCE_DIR}/${source}" ${out_dir} ${name} 15 | DEPENDS ${source} 16 | VERBATIM) 17 | 18 | add_custom_target(update-${name} ALL DEPENDS "${out_path}") 19 | add_executable(${name}-exe IMPORTED) 20 | set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${out_path}") 21 | endforeach () 22 | 23 | -------------------------------------------------------------------------------- /koka_bench/python/python-fib-let.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | 3 | import sys 4 | def fib(n): 5 | if n == 0: 6 | return 1 7 | elif n == 1: 8 | return 1 9 | else: 10 | r1 = fib(n-1) 11 | r2 = fib(n-2) 12 | return r1 + r2 13 | print(fib(int(sys.argv[1]))) 14 | -------------------------------------------------------------------------------- /koka_bench/python/python-fib.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | 3 | import sys 4 | def fib(n): 5 | if n == 0: 6 | return 1 7 | elif n == 1: 8 | return 1 9 | else: 10 | return fib(n-1) + fib(n-2) 11 | print(fib(int(sys.argv[1]))) 12 | -------------------------------------------------------------------------------- /koka_bench/relative.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | 3 | import sys 4 | import matplotlib.pyplot as plt 5 | import numpy as np 6 | import math 7 | 8 | with open(sys.argv[1], "r") as f: 9 | csv = [ [ v.strip() for v in l.split(',') ] for l in f.readlines() ] 10 | csv[0] = csv[0] + [ 'relative' ] 11 | min = min( float(r[1]) for r in csv[1:] ) 12 | subset = csv[1:] 13 | for i in range(len(subset)): 14 | subset[i] = subset[i] + [ float(subset[i][1]) / min ] 15 | csv[1:] = sorted(subset, key=lambda x: x[8]) 16 | 17 | out = "\n".join(",".join(str(x) for x in r) for r in csv) 18 | with open(sys.argv[1] + "with_relative.csv", "w") as f: 19 | f.write(out) 20 | 21 | print(csv) 22 | csv = [ x for x in csv if 'slow' in x[0] or 'rbtree' not in x[0] or 'kraken' not in x[0] or 'opt' in x[0] ] 23 | print(csv) 24 | 25 | def make_name(n): 26 | replace_dict = {"kk": "Koka", "cpp": "C++", "ml": "ML", "hs": "Haskell", "sw": "Swift", "wavm": "WAVM"} 27 | out = " ".join(replace_dict.get(word, word.title()) for word in n.split('/')[-1]\ 28 | .split(' ')[0]\ 29 | .replace("-", " ").split(" ")\ 30 | if word not in {"rbtree"}) 31 | if "java" in n: 32 | out = "Java" 33 | print(f"changed {n} to {out}") 34 | return out 35 | names = [ make_name(x[0]) for x in csv[1:] ] 36 | benchmark_size = csv[1][0].split('/')[-1].split(' ')[1] 37 | times = [ float(x[1]) for x in csv[1:] ] 38 | relative = [ float(x[8]) for x in csv[1:] ] 39 | print(names) 40 | print(times) 41 | print(relative) 42 | out_name = " ".join(sys.argv[1].removesuffix('.csv')\ 43 | .replace("_", " ").title()\ 44 | .replace("Rbtree", "RB-Tree")\ 45 | .split(" ")[:-1] + [benchmark_size]) 46 | 47 | n_groups = len(names) 48 | a = times 49 | d = names 50 | 51 | for do_log in [False, True]: 52 | fig, ax = plt.subplots() 53 | index = np.arange(n_groups) 54 | bar_width = 0.4 55 | opacity = 0.9 56 | 57 | ax.set_facecolor('gainsboro') 58 | rects1 = plt.bar(index, a, bar_width, alpha=opacity, color='orange') 59 | for k_index in (i for i in range(len(d)) if 'Kraken' in d[i]): 60 | rects1[k_index].set_color('r') 61 | plt.xlabel(f"{out_name} Benchmark" + (" (Log Scale)" if do_log else "")) 62 | plt.ylabel('Runtime (s)' + (" (Log Scale)" if do_log else "")) 63 | ax.ticklabel_format(useOffset=False, style='plain') 64 | plt.xticks(index, d, rotation=0) 65 | plt.legend() 66 | 67 | plt.tight_layout() 68 | #plt.xticks(rotation = 45) 69 | plt.xticks(rotation = 90) 70 | if do_log: 71 | #plt.subplots_adjust(left=0.10) 72 | plt.subplots_adjust(left=0.15) 73 | plt.semilogy() 74 | #plt.subplots_adjust(bottom=0.32) 75 | plt.subplots_adjust(bottom=0.65) 76 | plt.savefig(f"{sys.argv[1]}_{'log' if do_log else ''}.png", dpi = 96 * 2 * 2) 77 | #plt.show() 78 | -------------------------------------------------------------------------------- /koka_bench/scheme/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | 2 | set(copy_wrapper "../../copy_wrapper.sh") 3 | 4 | set(sources scheme-fib.scm scheme-fib-let.scm) 5 | foreach (source IN LISTS sources) 6 | 7 | get_filename_component(name "${source}" NAME_WE) 8 | 9 | set(out_dir "${CMAKE_CURRENT_BINARY_DIR}/out/bench") 10 | set(out_path "${out_dir}/${name}") 11 | 12 | add_custom_command( 13 | OUTPUT ${out_path} 14 | COMMAND ${copy_wrapper} "${CMAKE_CURRENT_SOURCE_DIR}/${source}" ${out_dir} ${name} 15 | DEPENDS ${source} 16 | VERBATIM) 17 | 18 | add_custom_target(update-${name} ALL DEPENDS "${out_path}") 19 | add_executable(${name}-exe IMPORTED) 20 | set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${out_path}") 21 | endforeach () 22 | 23 | -------------------------------------------------------------------------------- /koka_bench/scheme/scheme-fib-let.scm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env -S scheme --script 2 | (pretty-print ((letrec ((fib (lambda (n) (cond ((equal? n 0) 1) 3 | ((equal? n 1) 1) 4 | (#t (let ( 5 | (r1 (fib (- n 1))) 6 | (r2 (fib (- n 2))) 7 | ) (+ r1 r2))))))) 8 | fib) (read (open-input-string (list-ref (command-line) 1))))) 9 | -------------------------------------------------------------------------------- /koka_bench/scheme/scheme-fib.scm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env -S scheme --script 2 | (pretty-print ((letrec ((fib (lambda (n) (cond ((equal? n 0) 1) 3 | ((equal? n 1) 1) 4 | (#t (+ (fib (- n 1)) (fib (- n 2)))))))) 5 | fib) (read (open-input-string (list-ref (command-line) 1))))) 6 | -------------------------------------------------------------------------------- /koka_bench/scheme/scheme-nqueens.scm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/koka_bench/scheme/scheme-nqueens.scm -------------------------------------------------------------------------------- /koka_bench/swift/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | find_program(swiftc "swiftc" REQUIRED 2 | HINTS /opt/swift/bin 3 | $ENV{SWIFT_ROOT}/bin 4 | /usr/local/swift/bin) 5 | 6 | if(APPLE) 7 | set(swopts -Xlinker -stack_size -Xlinker 0x8000000) 8 | else() 9 | set(swopts "") 10 | endif() 11 | 12 | set(sources cfold.swift deriv.swift rbtree.swift nqueens.swift) 13 | foreach (source IN LISTS sources) 14 | get_filename_component(name "${source}" NAME_WE) 15 | set(name "sw-${name}") 16 | 17 | add_custom_command( 18 | OUTPUT ${name} 19 | COMMAND ${swiftc} -O -whole-module-optimization -o ${name} ${swopts} "$" 20 | DEPENDS ${source} 21 | VERBATIM) 22 | 23 | add_custom_target(update-${name} ALL DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/${name}) 24 | 25 | add_executable(${name}-exe IMPORTED) 26 | set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${CMAKE_CURRENT_BINARY_DIR}/${name}") 27 | 28 | add_test(NAME ${name} COMMAND ${name}-exe) 29 | set_tests_properties(${name} PROPERTIES LABELS swift) 30 | endforeach () 31 | -------------------------------------------------------------------------------- /koka_bench/swift/cfold.swift: -------------------------------------------------------------------------------- 1 | indirect enum Expr { 2 | case Var(UInt64) 3 | case Val(UInt64) 4 | case Add(Expr, Expr) 5 | case Mul(Expr, Expr) 6 | } 7 | 8 | func mk_expr(_ n: UInt64, _ v: UInt64) -> Expr { 9 | if n == 0 { 10 | return v == 0 ? .Var(1) : .Val(v) 11 | } else { 12 | return .Add(mk_expr(n - 1, v+1), mk_expr(n - 1, v == 0 ? 0 : v - 1)) 13 | } 14 | } 15 | 16 | func append_add(_ e₁: Expr, _ e₂: Expr) -> Expr { 17 | switch e₁ { 18 | case let .Add(e₁₁, e₁₂): 19 | return .Add(e₁₁, append_add(e₁₂, e₂)) 20 | default: 21 | return .Add(e₁, e₂) 22 | } 23 | } 24 | 25 | func append_mul(_ e₁: Expr, _ e₂: Expr) -> Expr { 26 | switch e₁ { 27 | case let .Mul(e₁₁, e₁₂): 28 | return .Mul(e₁₁, append_mul(e₁₂, e₂)) 29 | default: 30 | return .Mul(e₁, e₂) 31 | } 32 | } 33 | 34 | func reassoc(_ e: Expr) -> Expr { 35 | switch e { 36 | case let .Add(e₁, e₂): 37 | let e₁ = reassoc(e₁) 38 | let e₂ = reassoc(e₂) 39 | return append_add(e₁, e₂) 40 | case let .Mul(e₁, e₂): 41 | let e₁ = reassoc(e₁) 42 | let e₂ = reassoc(e₂) 43 | return append_mul(e₁, e₂) 44 | default: 45 | return e 46 | } 47 | } 48 | 49 | func const_folding(_ e: Expr) -> Expr { 50 | switch e { 51 | case let .Add(e₁, e₂): 52 | let e₁ = const_folding(e₁) 53 | let e₂ = const_folding(e₂) 54 | switch (e₁, e₂) { 55 | case let (.Val(a), .Val(b)): 56 | return .Val(a+b) 57 | case let (.Val(a), .Add(e, .Val(b))): 58 | return .Add(.Val(a+b), e) 59 | case let (.Val(a), .Add(.Val(b), e)): 60 | return .Add(.Val(a+b), e) 61 | default: 62 | return .Add(e₁, e₂) 63 | } 64 | case let .Mul(e₁, e₂): 65 | let e₁ = const_folding(e₁) 66 | let e₂ = const_folding(e₂) 67 | switch (e₁, e₂) { 68 | case let (.Val(a), .Val(b)): 69 | return .Val(a*b) 70 | case let (.Val(a), .Mul(e, .Val(b))): 71 | return .Mul(.Val(a*b), e) 72 | case let (.Val(a), .Mul(.Val(b), e)): 73 | return .Mul(.Val(a*b), e) 74 | default: 75 | return .Mul(e₁, e₂) 76 | } 77 | default: 78 | return e 79 | } 80 | } 81 | 82 | func eval(_ e: Expr) -> UInt64 { 83 | switch e { 84 | case .Var(_): 85 | return 0 86 | case let .Val(v): 87 | return v 88 | case let .Add(l, r): 89 | return eval(l) + eval(r) 90 | case let .Mul(l, r): 91 | return eval(l) * eval(r) 92 | } 93 | } 94 | 95 | var num: UInt64? = 20 96 | if CommandLine.arguments.count >= 2 { 97 | num = UInt64(CommandLine.arguments[1]) 98 | } 99 | 100 | let e = mk_expr(num!, 1) 101 | let v₁ = eval(e) 102 | let v₂ = eval(const_folding(reassoc(e))) 103 | print(v₁, v₂) 104 | -------------------------------------------------------------------------------- /koka_bench/swift/deriv.swift: -------------------------------------------------------------------------------- 1 | indirect enum Expr { 2 | case Val(Int64) 3 | case Var(String) 4 | case Add(Expr, Expr) 5 | case Mul(Expr, Expr) 6 | case Pow(Expr, Expr) 7 | case Ln(Expr) 8 | } 9 | 10 | func pown(_ a : Int64, _ n : Int64) -> Int64 { 11 | if n == 0 { 12 | return 1 13 | } else if n == 1 { 14 | return a 15 | } else { 16 | let b = pown(a, n/2) 17 | if n % 2 == 0 { 18 | return b*b*a 19 | } else { 20 | return b*b 21 | } 22 | } 23 | } 24 | 25 | func add (_ e1 : Expr, _ e2 : Expr) -> Expr { 26 | switch (e1, e2) { 27 | case let (.Val(n), .Val(m)) : 28 | return .Val(n+m) 29 | case let (.Val(0), f): 30 | return f 31 | case let (f, .Val(0)): 32 | return f 33 | case let (f, .Val(n)): 34 | return add(.Val(n), f) 35 | case let (.Val(n), .Add(.Val(m), f)): 36 | return add(.Val(n+m), f) 37 | case let (f, .Add(.Val(n), g)): 38 | return add(.Val(n), add(f, g)) 39 | case let (.Add(f, g), h): 40 | return add(f, add(g, h)) 41 | default: 42 | return .Add(e1, e2) 43 | } 44 | } 45 | 46 | func mul (_ e1 : Expr, _ e2 : Expr) -> Expr { 47 | switch (e1, e2) { 48 | case let (.Val(n), .Val(m)): 49 | return .Val(n*m) 50 | case (.Val(0), _): 51 | return .Val(0) 52 | case (_, .Val(0)): 53 | return .Val(0) 54 | case let (.Val(1), f): 55 | return f 56 | case let (f, .Val(1)): 57 | return f 58 | case let (f, .Val(n)): 59 | return mul(.Val(n), f) 60 | case let (.Val(n), .Mul(.Val(m), f)): 61 | return mul(.Val(n*m), f) 62 | case let (f, .Mul(.Val(n), g)): 63 | return mul(.Val(n), mul(f, g)) 64 | case let (.Mul(f, g), h): 65 | return mul(f, mul(g, h)) 66 | default: 67 | return .Mul(e1, e2) 68 | } 69 | } 70 | 71 | func pow (_ e1 : Expr, _ e2 : Expr) -> Expr { 72 | switch (e1, e2) { 73 | case let (.Val(m), .Val(n)): 74 | return .Val(pown(m, n)) 75 | case (_, .Val(0)): 76 | return .Val(1) 77 | case let (f, .Val(1)): 78 | return f 79 | case (.Val(0), _): 80 | return .Val(0) 81 | default: 82 | return .Pow(e1, e2) 83 | } 84 | } 85 | 86 | func ln (_ e : Expr) -> Expr { 87 | switch e { 88 | case .Val(1): 89 | return .Val(0) 90 | default: 91 | return .Ln(e) 92 | } 93 | } 94 | 95 | func d (_ x : String, _ e : Expr) -> Expr { 96 | switch e { 97 | case .Val(_): 98 | return .Val(0) 99 | case let .Var(y): 100 | if x == y { 101 | return .Val(1) 102 | } else { 103 | return .Val(0) 104 | } 105 | case let .Add(f, g): 106 | return add(d(x, f), d(x, g)) 107 | case let .Mul(f, g): 108 | return add(mul(f, d(x, g)), mul(g, d(x, f))) 109 | case let .Pow(f, g): 110 | return mul(pow(f, g), add(mul(mul(g, d(x, f)), pow(f, .Val(-1))), mul(ln(f), d(x, g)))) 111 | case let .Ln(f): 112 | return mul(d(x, f), pow(f, .Val(-1))) 113 | } 114 | } 115 | 116 | func toString (_ e : Expr) -> String { 117 | switch e { 118 | case let .Val(n): 119 | return String(n) 120 | case let .Var(x): 121 | return x 122 | case let .Add(f, g): 123 | return "(" + toString(f) + " + " + toString(g) + ")" 124 | case let .Mul(f, g): 125 | return "(" + toString(f) + " * " + toString(g) + ")" 126 | case let .Pow(f, g): 127 | return "(" + toString(f) + " ^ " + toString(g) + ")" 128 | case let .Ln(f): 129 | return "ln(" + toString(f) + ")" 130 | } 131 | } 132 | 133 | func count (_ e : Expr) -> UInt32 { 134 | switch e { 135 | case .Val(_): 136 | return 1 137 | case .Var(_): 138 | return 1 139 | case let .Add(f, g): 140 | return count(f) + count(g) 141 | case let .Mul(f, g): 142 | return count(f) + count(g) 143 | case let .Pow(f, g): 144 | return count(f) + count(g) 145 | case let .Ln(f): 146 | return count(f) 147 | } 148 | } 149 | 150 | func nest_aux (_ s : UInt32, _ f : (_ n : UInt32, _ e : Expr) -> Expr, _ n : UInt32, _ x : Expr) -> Expr { 151 | if n == 0 { 152 | return x 153 | } else { 154 | let x = f(s - n, x) 155 | return nest_aux(s, f, n-1, x) 156 | } 157 | } 158 | 159 | func nest (_ f : (_ n : UInt32, _ e : Expr) -> Expr, _ n : UInt32, _ e : Expr) -> Expr { 160 | return nest_aux(n, f, n, e) 161 | } 162 | 163 | func deriv (_ i : UInt32, _ f : Expr) -> Expr { 164 | let e = d("x", f) 165 | print(i+1, " count: ", count(e)) 166 | return e 167 | } 168 | 169 | var num: UInt32? = 10 170 | if CommandLine.arguments.count >= 2 { 171 | num = UInt32(CommandLine.arguments[1]) 172 | } 173 | 174 | let x = Expr.Var("x") 175 | let f = pow(x, x) 176 | let e = nest(deriv, num!, f) 177 | -------------------------------------------------------------------------------- /koka_bench/swift/nqueens.swift: -------------------------------------------------------------------------------- 1 | indirect enum List { 2 | case Nil 3 | case Cons(T,List) 4 | } 5 | 6 | func len( _ xs : List ) -> Int64 { 7 | var n : Int64 = 0; 8 | var cur : List = xs 9 | while true { 10 | switch(cur) { 11 | case .Nil: return n 12 | case let .Cons(_,xx): do { 13 | n += 1 14 | cur = xx 15 | } 16 | } 17 | } 18 | } 19 | 20 | func safe( _ queen : Int64, _ xs : List ) -> Bool { 21 | var cur : List = xs 22 | var diag : Int64 = 1 23 | while true { 24 | switch(cur) { 25 | case .Nil: return true 26 | case let .Cons(q,xx): do { 27 | if (queen == q || queen == (q + diag) || queen == (q - diag)) { 28 | return false 29 | } 30 | diag += 1 31 | cur = xx 32 | } 33 | } 34 | } 35 | } 36 | 37 | // todo: use while? 38 | func appendSafe( _ k : Int64, _ soln : List, _ solns : List> ) -> List> { 39 | var acc = solns 40 | var n = k 41 | while(n > 0) { 42 | if (safe(n,soln)) { 43 | acc = .Cons(.Cons(n,soln),acc) 44 | } 45 | n -= 1; 46 | } 47 | return acc 48 | } 49 | 50 | 51 | func extend( _ n : Int64, _ solns : List> ) -> List> { 52 | var acc : List> = .Nil 53 | var cur = solns 54 | while(true) { 55 | switch(cur) { 56 | case .Nil: return acc 57 | case let .Cons(soln,rest): do { 58 | acc = appendSafe(n,soln,acc) 59 | cur = rest 60 | } 61 | } 62 | } 63 | } 64 | 65 | func findSolutions(_ n : Int64 ) -> List> { 66 | var k = 0 67 | var acc : List> = .Cons(.Nil,.Nil) 68 | while( k < n ) { 69 | acc = extend(n,acc) 70 | k += 1 71 | } 72 | return acc 73 | } 74 | 75 | func nqueens(_ n : Int64) -> Int64 { 76 | return len(findSolutions(n)) 77 | } 78 | 79 | var num: Int64? = 13 80 | if CommandLine.arguments.count >= 2 { 81 | num = Int64(CommandLine.arguments[1]) 82 | } 83 | print(nqueens(num!)) 84 | 85 | /* 86 | len xs 87 | = len' xs 0 88 | 89 | len' xs acc 90 | = case xs of 91 | Nil -> acc 92 | Cons _ t -> len' t $! (acc+1) 93 | 94 | safe queen diag xs 95 | = case xs of 96 | Nil -> True 97 | Cons q t -> queen /= q && queen /= q + diag && queen /= q - diag && safe queen (diag + 1) t 98 | 99 | appendSafe k soln solns 100 | = if (k <= 0) 101 | then solns 102 | else if safe k 1 soln 103 | then appendSafe (k-1) soln (Cons (Cons k soln) solns) 104 | else appendSafe (k-1) soln solns 105 | 106 | 107 | extend n acc solns 108 | = case solns of 109 | Nil -> acc 110 | Cons soln rest -> extend n (appendSafe n soln acc) rest 111 | 112 | find_solutions n k 113 | = if k == 0 114 | then Cons Nil Nil 115 | else extend n Nil (find_solutions n (k-1)) 116 | 117 | -- fst_solution n = head (find_solutions n n) 118 | 119 | queens n 120 | = len (find_solutions n n) 121 | 122 | main 123 | = print (queens 13) 124 | 125 | 126 | enum Color { 127 | case Red 128 | case Black 129 | } 130 | 131 | indirect enum Tree { 132 | case Leaf 133 | case Node(Color, Tree, UInt64, Bool, Tree) 134 | } 135 | 136 | func balance1(_ kv : UInt64, _ vv : Bool, _ t : Tree, _ n : Tree) -> Tree { 137 | switch n { 138 | case let .Node(_, .Node(.Red, l, kx, vx, r1), ky, vy, r2): 139 | return .Node(.Red, .Node(.Black, l, kx, vx, r1), ky, vy, .Node(.Black, r2, kv, vv, t)) 140 | case let .Node(_, l1, ky, vy, .Node(.Red, l2, kx, vx, r)): 141 | return .Node(.Red, .Node(.Black, l1, ky, vy, l2), kx, vx, .Node(.Black, r, kv, vv, t)) 142 | case let .Node(_, l, ky, vy, r): 143 | return .Node(.Black, .Node(.Red, l, ky, vy, r), kv, vv, t) 144 | default: 145 | return .Leaf 146 | } 147 | } 148 | 149 | func balance2(_ t : Tree, _ kv : UInt64, _ vv : Bool, _ n : Tree) -> Tree { 150 | switch n { 151 | case let .Node(_, .Node(.Red, l, kx1, vx1, r1), ky, vy, r2): 152 | return .Node(.Red, .Node(.Black, t, kv, vv, l), kx1, vx1, .Node(.Black, r1, ky, vy, r2)) 153 | case let .Node(_, l1, ky, vy, .Node(.Red, l2, kx2, vx2, r2)): 154 | return .Node(.Red, .Node(.Black, t, kv, vv, l1), ky, vy, .Node(.Black, l2, kx2, vx2, r2)) 155 | case let .Node (_, l, ky, vy, r): 156 | return .Node(.Black, t, kv, vv, .Node(.Red, l, ky, vy, r)) 157 | default: 158 | return .Leaf 159 | } 160 | } 161 | 162 | func is_red (_ t : Tree) -> Bool { 163 | switch t { 164 | case .Node(.Red, _, _, _, _): 165 | return true 166 | default: 167 | return false 168 | } 169 | } 170 | 171 | func ins(_ t : Tree, _ kx : UInt64, _ vx : Bool) -> Tree { 172 | switch t { 173 | case .Leaf: 174 | return .Node(.Red, .Leaf, kx, vx, .Leaf) 175 | case let .Node(.Red, a, ky, vy, b): 176 | if kx < ky { 177 | return .Node(.Red, ins(a, kx, vx), ky, vy, b) 178 | } else if ky == kx { 179 | return .Node(.Red, a, kx, vx, b) 180 | } else { 181 | return .Node(.Red, a, ky, vy, ins(b, kx, vx)) 182 | } 183 | case let .Node(.Black, a, ky, vy, b): 184 | if kx < ky { 185 | if is_red(a) { 186 | return balance1(ky, vy, b, ins(a, kx, vx)) 187 | } else { 188 | return .Node(.Black, ins(a, kx, vx), ky, vy, b) 189 | } 190 | } else if kx == ky { 191 | return .Node(.Black, a, kx, vx, b) 192 | } else { 193 | if is_red(b) { 194 | return balance2(a, ky, vy, ins(b, kx, vx)) 195 | } else { 196 | return .Node(.Black, a, ky, vy, ins(b, kx, vx)) 197 | } 198 | } 199 | } 200 | } 201 | 202 | func set_black (_ n : Tree) -> Tree { 203 | switch n { 204 | case let .Node (_, l, k, v, r): 205 | return .Node (.Black, l, k, v, r) 206 | default: 207 | return n 208 | } 209 | } 210 | 211 | func insert (_ t : Tree, _ k : UInt64, _ v : Bool) -> Tree { 212 | if is_red(t) { 213 | return set_black(ins(t, k, v)) 214 | } else { 215 | return ins(t, k, v) 216 | } 217 | } 218 | 219 | func fold (_ f : (_ k : UInt64, _ v : Bool, _ d : UInt64) -> UInt64, _ n : Tree, _ d : UInt64) -> UInt64 { 220 | switch n { 221 | case .Leaf: 222 | return d 223 | case let .Node(_, l, k, v, r): 224 | return fold(f, r, f(k, v, fold(f, l, d))) 225 | } 226 | } 227 | 228 | func mk_map (_ n : UInt64) -> Tree { 229 | var i = n 230 | var m : Tree = .Leaf 231 | while i > 0 { 232 | i = i - 1 233 | m = insert(m, i, (i%10 == 0)) 234 | } 235 | return m 236 | } 237 | 238 | func aux (_ k : UInt64, _ v : Bool, _ r : UInt64) -> UInt64 { 239 | if v { 240 | return r + 1 241 | } else { 242 | return r 243 | } 244 | } 245 | 246 | var num: UInt64? = 4200000 247 | if CommandLine.arguments.count >= 2 { 248 | num = UInt64(CommandLine.arguments[1]) 249 | } 250 | let m = mk_map(num!) 251 | let v = fold(aux, m, 0) 252 | print(v) 253 | */ 254 | -------------------------------------------------------------------------------- /koka_bench/swift/rbtree.swift: -------------------------------------------------------------------------------- 1 | enum Color { 2 | case Red 3 | case Black 4 | } 5 | 6 | indirect enum Tree { 7 | case Leaf 8 | case Node(Color, Tree, UInt64, Bool, Tree) 9 | } 10 | 11 | func balance1(_ kv : UInt64, _ vv : Bool, _ t : Tree, _ n : Tree) -> Tree { 12 | switch n { 13 | case let .Node(_, .Node(.Red, l, kx, vx, r1), ky, vy, r2): 14 | return .Node(.Red, .Node(.Black, l, kx, vx, r1), ky, vy, .Node(.Black, r2, kv, vv, t)) 15 | case let .Node(_, l1, ky, vy, .Node(.Red, l2, kx, vx, r)): 16 | return .Node(.Red, .Node(.Black, l1, ky, vy, l2), kx, vx, .Node(.Black, r, kv, vv, t)) 17 | case let .Node(_, l, ky, vy, r): 18 | return .Node(.Black, .Node(.Red, l, ky, vy, r), kv, vv, t) 19 | default: 20 | return .Leaf 21 | } 22 | } 23 | 24 | func balance2(_ t : Tree, _ kv : UInt64, _ vv : Bool, _ n : Tree) -> Tree { 25 | switch n { 26 | case let .Node(_, .Node(.Red, l, kx1, vx1, r1), ky, vy, r2): 27 | return .Node(.Red, .Node(.Black, t, kv, vv, l), kx1, vx1, .Node(.Black, r1, ky, vy, r2)) 28 | case let .Node(_, l1, ky, vy, .Node(.Red, l2, kx2, vx2, r2)): 29 | return .Node(.Red, .Node(.Black, t, kv, vv, l1), ky, vy, .Node(.Black, l2, kx2, vx2, r2)) 30 | case let .Node (_, l, ky, vy, r): 31 | return .Node(.Black, t, kv, vv, .Node(.Red, l, ky, vy, r)) 32 | default: 33 | return .Leaf 34 | } 35 | } 36 | 37 | func is_red (_ t : Tree) -> Bool { 38 | switch t { 39 | case .Node(.Red, _, _, _, _): 40 | return true 41 | default: 42 | return false 43 | } 44 | } 45 | 46 | func ins(_ t : Tree, _ kx : UInt64, _ vx : Bool) -> Tree { 47 | switch t { 48 | case .Leaf: 49 | return .Node(.Red, .Leaf, kx, vx, .Leaf) 50 | case let .Node(.Red, a, ky, vy, b): 51 | if kx < ky { 52 | return .Node(.Red, ins(a, kx, vx), ky, vy, b) 53 | } else if ky == kx { 54 | return .Node(.Red, a, kx, vx, b) 55 | } else { 56 | return .Node(.Red, a, ky, vy, ins(b, kx, vx)) 57 | } 58 | case let .Node(.Black, a, ky, vy, b): 59 | if kx < ky { 60 | if is_red(a) { 61 | return balance1(ky, vy, b, ins(a, kx, vx)) 62 | } else { 63 | return .Node(.Black, ins(a, kx, vx), ky, vy, b) 64 | } 65 | } else if kx == ky { 66 | return .Node(.Black, a, kx, vx, b) 67 | } else { 68 | if is_red(b) { 69 | return balance2(a, ky, vy, ins(b, kx, vx)) 70 | } else { 71 | return .Node(.Black, a, ky, vy, ins(b, kx, vx)) 72 | } 73 | } 74 | } 75 | } 76 | 77 | func set_black (_ n : Tree) -> Tree { 78 | switch n { 79 | case let .Node (_, l, k, v, r): 80 | return .Node (.Black, l, k, v, r) 81 | default: 82 | return n 83 | } 84 | } 85 | 86 | func insert (_ t : Tree, _ k : UInt64, _ v : Bool) -> Tree { 87 | if is_red(t) { 88 | return set_black(ins(t, k, v)) 89 | } else { 90 | return ins(t, k, v) 91 | } 92 | } 93 | 94 | func fold (_ f : (_ k : UInt64, _ v : Bool, _ d : UInt64) -> UInt64, _ n : Tree, _ d : UInt64) -> UInt64 { 95 | switch n { 96 | case .Leaf: 97 | return d 98 | case let .Node(_, l, k, v, r): 99 | return fold(f, r, f(k, v, fold(f, l, d))) 100 | } 101 | } 102 | 103 | func mk_map (_ n : UInt64) -> Tree { 104 | var i = n 105 | var m : Tree = .Leaf 106 | while i > 0 { 107 | i = i - 1 108 | m = insert(m, i, (i%10 == 0)) 109 | } 110 | return m 111 | } 112 | 113 | func aux (_ k : UInt64, _ v : Bool, _ r : UInt64) -> UInt64 { 114 | if v { 115 | return r + 1 116 | } else { 117 | return r 118 | } 119 | } 120 | 121 | var num: UInt64? = 4200000 122 | if CommandLine.arguments.count >= 2 { 123 | num = UInt64(CommandLine.arguments[1]) 124 | } 125 | let m = mk_map(num!) 126 | let v = fold(aux, m, 0) 127 | print(v) 128 | -------------------------------------------------------------------------------- /koka_bench/test.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | set -e 3 | 4 | if [[ ! -d "build" ]] 5 | then 6 | mkdir build 7 | pushd build 8 | nix develop -i -c bash -c 'cmake .. -DCMAKE_BUILD_TYPE=Release && cmake --build .' 9 | popd 10 | fi 11 | pushd build 12 | nix develop -i -c bash -c 'make' 13 | popd 14 | 15 | mkdir -p slow 16 | find build -type f -name \*slow\* -exec mv {} slow \; 17 | cp ./slow/newlisp-slow-fexpr-rbtree ./build/newlisp/out/bench/ 18 | #cp ./build/kraken/out/bench/kraken-* ./slow 19 | cp ./build/kraken/out/bench/kraken-*-n* ./slow 20 | mv ./build/kraken/out/bench/kraken-cfold-n ./slow 21 | #mv ./build/newlisp/out/bench/* ./slow 22 | 23 | 24 | nix develop -i -c bash -c 'ulimit -s unlimited && find build -type f -executable -name \*rbtree\* -printf "\"%p 880\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown rbtree_table.md --export-csv rbtree_table.csv' 25 | #nix develop -i -c bash -c 'ulimit -s unlimited && find build -type f -executable -name \*rbtree\* -printf "\"%p 420000\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown rbtree_table.md --export-csv rbtree_table.csv' 26 | nix develop -i -c bash -c 'ulimit -s unlimited && find build -type f -executable -name \*fib\* -printf "\"%p 30\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown fib_table.md --export-csv fib_table.csv' 27 | nix develop -i -c bash -c 'ulimit -s unlimited && find build -type f -executable -name \*nqueens\* -printf "\"%p 8\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown nqueens_table.md --export-csv nqueens_table.csv' 28 | #nix develop -i -c bash -c 'ulimit -s unlimited && find build -type f -executable -name \*nqueens\* -printf "\"%p 10\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown nqueens_table.md --export-csv nqueens_table.csv' 29 | nix develop -i -c bash -c 'ulimit -s unlimited && find build -type f -executable -name \*deriv\* -printf "\"%p 8\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown deriv_table.md --export-csv deriv_table.csv' 30 | nix develop -i -c bash -c 'ulimit -s unlimited && find build -type f -executable -name \*cfold\* -printf "\"%p 7\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown cfold_table.md --export-csv cfold_table.csv' 31 | #nix develop -i -c bash -c 'ulimit -s unlimited && find build -type f -executable -name \*cfold\* -printf "\"%p 20\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown cfold_table.md --export-csv cfold_table.csv' 32 | 33 | 34 | #nix develop -i -c bash -c 'ulimit -s unlimited && find slow -type f -executable -name \*rbtree\* -printf "\"%p 10\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown slow_rbtree_table.md --export-csv slow_rbtree_table.csv' 35 | nix develop -i -c bash -c 'ulimit -s unlimited && find slow -type f -executable -name \*rbtree\* -printf "\"%p 100\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown slow_rbtree_table.md --export-csv slow_rbtree_table.csv' 36 | nix develop -i -c bash -c 'ulimit -s unlimited && find slow -type f -executable -name \*fib\* -printf "\"%p 30\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown slow_fib_table.md --export-csv slow_fib_table.csv' 37 | nix develop -i -c bash -c 'ulimit -s unlimited && find slow -type f -executable -name \*nqueens\* -printf "\"%p 7\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown slow_nqueens_table.md --export-csv slow_nqueens_table.csv' 38 | nix develop -i -c bash -c 'ulimit -s unlimited && find slow -type f -executable -name \*deriv\* -printf "\"%p 3\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown slow_deriv_table.md --export-csv slow_deriv_table.csv' 39 | nix develop -i -c bash -c 'ulimit -s unlimited && find slow -type f -executable -name \*cfold\* -printf "\"%p 5\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown slow_cfold_table.md --export-csv slow_cfold_table.csv' 40 | 41 | #nix develop -i -c bash -c 'ulimit -s unlimited && hyperfine --ignore-failure --warmup 2 --export-markdown slow_ish_rbtree_table.md --export-csv slow_ish_rbtree_table.csv "./slow/kraken-rbtree-opt 890" "./slow/kraken-rbtree-opt-wavm 890" "./slow/newlisp-slow-fexpr-rbtree 890" "./slow/newlisp-macro-rbtree 890"' 42 | #nix develop -i -c bash -c 'ulimit -s unlimited && hyperfine --ignore-failure --warmup 2 --export-markdown slow_rbtree_table.md --export-csv slow_rbtree_table.csv "./slow/kraken-rbtree-opt 100" "./slow/kraken-rbtree-opt-wavm 100" "./slow/newlisp-slow-fexpr-rbtree 100" "./slow/newlisp-macro-rbtree 100" "./slow/kraken-rbtree-slow-wavm 100"' 43 | 44 | for x in *_table.csv 45 | do 46 | nix develop -i -c bash -c "./relative.py $x" 47 | done 48 | 49 | printf "# Benchmarks\n\n" > benchmarks.md 50 | for x in *_table.md 51 | do 52 | printf "## $x\n\n" >> benchmarks.md 53 | cat "$x" >> benchmarks.md 54 | printf "\n\n\n" >> benchmarks.md 55 | done 56 | cp *.png ~/school/vau_partial_eval_paper/images/ 57 | cp *.cssv ~/school/vau_partial_eval_paper/ 58 | -------------------------------------------------------------------------------- /slj/Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | name = "sl" 3 | version = "0.1.0" 4 | edition = "2021" 5 | 6 | # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html 7 | 8 | [profile.bench] 9 | debug = true 10 | 11 | [dependencies] 12 | lalrpop-util = {version="0.20", features=["lexer"]} 13 | regex = "1" 14 | once_cell = "1" 15 | anyhow = "1" 16 | cranelift = "0.101.4" 17 | cranelift-codegen = "0.101.4" 18 | cranelift-module = "0.101.4" 19 | cranelift-jit = "0.101.4" 20 | cranelift-native = "0.101.4" 21 | 22 | [build-dependencies] 23 | lalrpop = "0.20" 24 | -------------------------------------------------------------------------------- /slj/build.rs: -------------------------------------------------------------------------------- 1 | extern crate lalrpop; 2 | 3 | fn main() { 4 | lalrpop::process_root().unwrap(); 5 | } 6 | -------------------------------------------------------------------------------- /slj/src/grammar.lalrpop: -------------------------------------------------------------------------------- 1 | use std::str::FromStr; 2 | use sl::Form; 3 | 4 | grammar; 5 | 6 | pub Term: Form = { 7 | "true" => Form::new_bool(true), 8 | "false" => Form::new_bool(false), 9 | NUM => Form::new_int(isize::from_str(<>).unwrap()), 10 | SYM => Form::new_symbol(<>), 11 | "(" ")" => <>.unwrap_or(Form::new_nil()), 12 | "'" => Form::new_pair(Form::new_symbol("quote"), Form::new_pair(<>, Form::new_nil())), 13 | "!" => { 14 | h.append(t).unwrap() 15 | }, 16 | }; 17 | ListInside: Form = { 18 | =>Form::new_pair(<>, Form::new_nil()), 19 | => Form::new_pair(h, t), 20 | "." => Form::new_pair(a, d), 21 | } 22 | match { 23 | "true", 24 | "false", 25 | "(", 26 | ")", 27 | ".", 28 | "'", 29 | "!", 30 | r"[0-9]+" => NUM, 31 | r"[a-zA-Z+*/_=?%&|^<>-][\w+*/=_?%&|^<>-]*" => SYM, 32 | r"(;[^\n]*\n)|\s+" => { } 33 | } 34 | 35 | -------------------------------------------------------------------------------- /slj/src/grammer.lalrpoplib.rs: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/slj/src/grammer.lalrpoplib.rs -------------------------------------------------------------------------------- /slj/src/main.rs: -------------------------------------------------------------------------------- 1 | #[macro_use] extern crate lalrpop_util; 2 | lalrpop_mod!(pub grammar); 3 | 4 | use std::mem; 5 | 6 | use anyhow::Result; 7 | 8 | use sl::{eval,Form,Crc,Cvec,Prim,ID,JIT}; 9 | 10 | fn main() -> Result<()> { 11 | // our Form shennigins will only work on 64 bit platforms 12 | assert!(std::mem::size_of::() == 8); 13 | assert!(std::mem::size_of::() == 8); 14 | assert!(std::mem::size_of::>() == 8); 15 | 16 | //let res = ptr_b(); 17 | //println!("sucessful run with result {res}"); 18 | //let res = ptr_a(23); 19 | //println!("sucessful 2 run with result {res}"); 20 | 21 | //let res = ptr_b(); 22 | //println!("sucessful 2 run with result {res}"); 23 | 24 | //let res = ptr_c(Form::new_int(1337)); 25 | //println!("sucessful 3 run with result {res}"); 26 | 27 | //return Ok(()); 28 | 29 | fn alias(a: Crc, b: Crc) { 30 | println!("a: {}, b: {}", *a, *b); 31 | } 32 | let x = Crc::new(1); 33 | alias(Crc::clone(&x), x); 34 | let rc_u64_size = std::mem::size_of::>(); 35 | assert!(rc_u64_size == 8); 36 | println!("for our Crc, we have size {}", rc_u64_size); 37 | 38 | let begn = Form::new_symbol("begin"); 39 | println!("this should be begin {begn}"); 40 | 41 | let i = Form::new_int(23); 42 | let n = Form::new_nil(); 43 | let bf = Form::new_bool(false); 44 | let bt = Form::new_bool(true); 45 | 46 | let p = Form::new_pair(Form::new_int(50), Form::new_nil()); 47 | 48 | let pra = Form::new_prim(Prim::Add); 49 | let pre = Form::new_prim(Prim::Eq); 50 | 51 | let s = Form::new_symbol("woopwpp"); 52 | 53 | 54 | let mut params = Cvec::new(); 55 | params.push("a".to_owned()); 56 | params.push("b".to_owned()); 57 | 58 | println!("{i} {n} {bf} {bt} {p} {pra} {pre} {s}"); 59 | 60 | let mut my_vec: Cvec = Cvec::new(); 61 | my_vec.push(i); 62 | my_vec.push(n); 63 | my_vec.push(bf); 64 | my_vec.push(bt); 65 | my_vec.push(p); 66 | my_vec.push(pra); 67 | my_vec.push(pre); 68 | my_vec.push(s); 69 | my_vec.push(begn); 70 | 71 | 72 | println!(" from vec {}", my_vec[3]); 73 | for i in my_vec.iter() { 74 | println!(" from vec {}", i); 75 | } 76 | println!("{my_vec}"); 77 | 78 | my_vec[3] = Form::new_symbol("replaced"); 79 | 80 | println!(" from vec {}", my_vec[3]); 81 | for i in my_vec.iter() { 82 | println!(" from vec {}", i); 83 | } 84 | println!("{my_vec}"); 85 | 86 | 87 | let input = " 88 | (begin 89 | (debug 1) 90 | ;(debug (= 1 2)) 91 | ;(debug (+ 2 3)) 92 | ;(define a (+ 1 (* 3 4))) 93 | 94 | ;(define fact (lambda (n) (if (= n 1) 1 (* n (fact (- n 1)))))) 95 | ;(debug 'gonna_fact_it) 96 | ;(debug fact) 97 | ;(debug (fact 400)) 98 | 99 | ;(define fact2 (lambda (n a) (if (= n 1) a (fact2 (- n 1) (* n a))))) 100 | ;(debug 'gonna_fact2_it) 101 | ;(debug fact2) 102 | ;(debug (fact2 400 1)) 103 | 104 | 105 | 106 | 107 | 108 | (define faft_h (lambda (faft_h n) (if (= n 1) (debug 1) (+ n (faft_h faft_h (- n 1)))))) 109 | (define faft (lambda (n) (faft_h faft_h n))) 110 | 111 | (debug 'gonna_faft_it) 112 | (debug faft) 113 | (debug (faft 8)) 114 | (debug 'gonna_faft_it2) 115 | (debug (faft 10)) 116 | ;(debug (faft 400)) 117 | 118 | ;(define faft2 (lambda (n a) (if (= n 1) a (faft2 (- n 1) (+ n a))))) 119 | ;(debug 'gonna_faft2_it) 120 | ;(debug faft2) 121 | ;(debug (faft2 6 1)) 122 | ;(debug (faft2 400 1)) 123 | 124 | 125 | 126 | 127 | 128 | ;(define fib (lambda (n) (if (or (= n 0) (= n 1)) 1 (+ (fib (- n 1)) (fib (- n 2)))))) 129 | ;(debug 'gonna_fib_it) 130 | ;(debug fib) 131 | ;(debug (fib 10)) 132 | 133 | ;(debug a) 134 | ;(define b (cons 1 (cons 2 (cons 3 nil)))) 135 | ;(debug b) 136 | ;(debug (car b)) 137 | ;(debug (cdr b)) 138 | ;(if (= 1 2) (+ 2 3) (* 2 2)) 139 | (or false false ) 140 | ) 141 | "; 142 | let parsed_input = grammar::TermParser::new().parse(input)?; 143 | //println!("Hello, world: {parsed_input:?}"); 144 | println!("Hello, world: {parsed_input}"); 145 | println!("Yep that was all?"); 146 | let evaled = eval(parsed_input.clone())?; 147 | println!("evaled: {evaled}"); 148 | Ok(()) 149 | } 150 | -------------------------------------------------------------------------------- /website/Inter.var.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/Inter.var.woff2 -------------------------------------------------------------------------------- /website/JetBrainsMono-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/JetBrainsMono-Regular.woff2 -------------------------------------------------------------------------------- /website/Recursive.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/Recursive.woff2 -------------------------------------------------------------------------------- /website/default.min.css: -------------------------------------------------------------------------------- 1 | /*! 2 | Theme: Default 3 | Description: Original highlight.js style 4 | Author: (c) Ivan Sagalaev 5 | Maintainer: @highlightjs/core-team 6 | Website: https://highlightjs.org/ 7 | License: see project LICENSE 8 | Touched: 2021 9 | */pre code.hljs{display:block;overflow-x:auto;padding:1em}code.hljs{padding:3px 5px}.hljs{background:#f3f3f3;color:#444}.hljs-comment{color:#697070}.hljs-punctuation,.hljs-tag{color:#444a}.hljs-tag .hljs-attr,.hljs-tag .hljs-name{color:#444}.hljs-attribute,.hljs-doctag,.hljs-keyword,.hljs-meta .hljs-keyword,.hljs-name,.hljs-selector-tag{font-weight:700}.hljs-deletion,.hljs-number,.hljs-quote,.hljs-selector-class,.hljs-selector-id,.hljs-string,.hljs-template-tag,.hljs-type{color:#800}.hljs-section,.hljs-title{color:#800;font-weight:700}.hljs-link,.hljs-operator,.hljs-regexp,.hljs-selector-attr,.hljs-selector-pseudo,.hljs-symbol,.hljs-template-variable,.hljs-variable{color:#ab5656}.hljs-literal{color:#695}.hljs-addition,.hljs-built_in,.hljs-bullet,.hljs-code{color:#397300}.hljs-meta{color:#1f7199}.hljs-meta .hljs-string{color:#38a}.hljs-emphasis{font-style:italic}.hljs-strong{font-weight:700} -------------------------------------------------------------------------------- /website/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/favicon.ico -------------------------------------------------------------------------------- /website/images/Kraken_Call_PE_Semantics.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/Kraken_Call_PE_Semantics.png -------------------------------------------------------------------------------- /website/images/Kraken_NonCall_PE_Semantics.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/Kraken_NonCall_PE_Semantics.png -------------------------------------------------------------------------------- /website/images/Kraken_aux_helpers.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/Kraken_aux_helpers.png -------------------------------------------------------------------------------- /website/images/Kraken_aux_helpers2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/Kraken_aux_helpers2.png -------------------------------------------------------------------------------- /website/images/Kraken_aux_helpers3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/Kraken_aux_helpers3.png -------------------------------------------------------------------------------- /website/images/Kraken_pe_primitives.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/Kraken_pe_primitives.png -------------------------------------------------------------------------------- /website/images/cfold_table.csv_.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/cfold_table.csv_.png -------------------------------------------------------------------------------- /website/images/cfold_table.csv_log.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/cfold_table.csv_log.png -------------------------------------------------------------------------------- /website/images/deriv_table.csv_.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/deriv_table.csv_.png -------------------------------------------------------------------------------- /website/images/deriv_table.csv_log.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/deriv_table.csv_log.png -------------------------------------------------------------------------------- /website/images/fib_table.csv_.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/fib_table.csv_.png -------------------------------------------------------------------------------- /website/images/fib_table.csv_log.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/fib_table.csv_log.png -------------------------------------------------------------------------------- /website/images/lisp_timeline_screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/lisp_timeline_screenshot.png -------------------------------------------------------------------------------- /website/images/lisp_timeline_screenshot_edited.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/lisp_timeline_screenshot_edited.png -------------------------------------------------------------------------------- /website/images/lisp_timeline_screenshot_edited.xcf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/lisp_timeline_screenshot_edited.xcf -------------------------------------------------------------------------------- /website/images/nqueens_table.csv_.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/nqueens_table.csv_.png -------------------------------------------------------------------------------- /website/images/nqueens_table.csv_log.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/nqueens_table.csv_log.png -------------------------------------------------------------------------------- /website/images/overview.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/overview.png -------------------------------------------------------------------------------- /website/images/rbtree_table.csv_.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/rbtree_table.csv_.png -------------------------------------------------------------------------------- /website/images/rbtree_table.csv_log.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/rbtree_table.csv_log.png -------------------------------------------------------------------------------- /website/images/slow_cfold_table.csv_.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/slow_cfold_table.csv_.png -------------------------------------------------------------------------------- /website/images/slow_cfold_table.csv_log.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/slow_cfold_table.csv_log.png -------------------------------------------------------------------------------- /website/images/slow_deriv_table.csv_.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/slow_deriv_table.csv_.png -------------------------------------------------------------------------------- /website/images/slow_deriv_table.csv_log.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/slow_deriv_table.csv_log.png -------------------------------------------------------------------------------- /website/images/slow_fib_table.csv_.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/slow_fib_table.csv_.png -------------------------------------------------------------------------------- /website/images/slow_fib_table.csv_log.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/slow_fib_table.csv_log.png -------------------------------------------------------------------------------- /website/images/slow_ish_rbtree_table.csv_.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/slow_ish_rbtree_table.csv_.png -------------------------------------------------------------------------------- /website/images/slow_ish_rbtree_table.csv_log.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/slow_ish_rbtree_table.csv_log.png -------------------------------------------------------------------------------- /website/images/slow_nqueens_table.csv_.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/slow_nqueens_table.csv_.png -------------------------------------------------------------------------------- /website/images/slow_nqueens_table.csv_log.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/slow_nqueens_table.csv_log.png -------------------------------------------------------------------------------- /website/images/slow_rbtree_table.csv_.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/slow_rbtree_table.csv_.png -------------------------------------------------------------------------------- /website/images/slow_rbtree_table.csv_log.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Limvot/kraken/c3315f04e5619df0aaaa01106ff12bf114bfe3d8/website/images/slow_rbtree_table.csv_log.png -------------------------------------------------------------------------------- /website/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |

Kraken

10 | FOSS Fexprs: https://github.com/limvot/kraken 11 | 12 |
13 | 25 |

Concept:

26 |
    27 |
  • Minimal, purely functional Kernel/Scheme as core language, with Kernel/Vau calculus inspiration oblivating the need for non-reader macros (Kernel/Vau calculus thesis) 28 |
  • Partial evaluation (or now, maybe tracing JIT compilation) to make fexprs fast (my PhD research! First paper on arXiv) 29 |
  • Implement Type Systems as Macros (but using Fexprs instead of macros) (paper, up to System Fω) (second paper, up to dependent types) 30 |
  • Use above "type systems as fexprs" to add types and create a statically-typed language on top (with Algebraic Effects using the underlying delimited continuations, etc) 31 |
32 |

About:

33 |

This is my 4th run at this Lisp concept, with tracing JIT compilation to make fexprs fast forming the core of my current PhD research. (tiny personal PhD website here)

34 |

Vau/Kernel as simple core:

35 | By constructing our core language on a very simple Vau/Kernel base, we can keep the base truely tiny, and build up normal Lisp functions and programming language features in the language itself. This should help implement other programming languages concisely, and will hopefully make optimization easier and more broadly applicable. 36 |
37 |

Next Steps

38 |
    39 |
  • Implement persistent functional data structures 40 |
      41 |
    • ✔ RB-Tree 42 |
    • ☐ Hash Array-Mapped Trie (HAMT) / Relaxed Radix Balance Tree (RRB-Tree) 43 |
    • ☐ Hash Map based on the above 44 |
    • ☐ Hash Set based on the above 45 |
    46 |
  • Sketch out Kraken language on top of core Lisp, includes basic Hindley-Milner type system 47 |
  • Re-self-host using functional approach in above Kraken language 48 |
49 | 50 | 51 | 52 | 58 | 85 | 86 | 87 | 88 | -------------------------------------------------------------------------------- /website/index2.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 96 | 97 | 98 |
99 |
100 |

Kraken

101 |
102 | FOSS Fexprs: https://github.com/limvot/kraken 103 | 104 |
105 |

Concept:

106 |
    107 |
  • Minimal, purely functional Kernel/Scheme as core language, with Kernel/Vau calculus inspiration oblivating the need for non-reader macros (Kernel/Vau calculus thesis) 108 |
  • Partial evaluation (or now, maybe tracing JIT compilation) to make fexprs fast (my PhD research! First paper on arXiv) 109 |
  • Implement Type Systems as Macros (but using Fexprs instead of macros) (paper, up to System Fω) (second paper, up to dependent types) 110 |
  • Use above "type systems as fexprs" to add types and create a statically-typed language on top (with Algebraic Effects using the underlying delimited continuations, etc) 111 |
112 |

About:

113 |

This is my 4th run at this Lisp concept, with tracing JIT compilation to make fexprs fast forming the core of my current PhD research. (tiny personal PhD website here)

114 |

Vau/Kernel as simple core:

115 | By constructing our core language on a very simple Vau/Kernel base, we can keep the base truely tiny, and build up normal Lisp functions and programming language features in the language itself. This should help implement other programming languages concisely, and will hopefully make optimization easier and more broadly applicable. 116 |
117 |

Next Steps

118 |
    119 |
  • Implement persistent functional data structures 120 |
      121 |
    • ✔ RB-Tree 122 |
    • ☐ Hash Array-Mapped Trie (HAMT) / Relaxed Radix Balance Tree (RRB-Tree) 123 |
    • ☐ Hash Map based on the above 124 |
    • ☐ Hash Set based on the above 125 |
    126 |
  • Sketch out Kraken language on top of core Lisp, includes basic Hindley-Milner type system 127 |
  • Re-self-host using functional approach in above Kraken language 128 |
129 | 130 | 131 | 132 | 138 | 165 | 166 | 167 | 168 | -------------------------------------------------------------------------------- /website/recursive.css: -------------------------------------------------------------------------------- 1 | @font-face { 2 | font-family: 'Recursive'; 3 | font-style: oblique 0deg 15deg; 4 | font-weight: 300 1000; 5 | font-display: swap; 6 | src: url(./Recursive.woff2) format('woff2'); 7 | unicode-range: U+0000-00FF, U+0131, U+0152-0153, U+02BB-02BC, U+02C6, U+02DA, U+02DC, U+2000-206F, U+2074, U+20AC, U+2122, U+2191, U+2193, U+2212, U+2215, U+FEFF, U+FFFD; 8 | } 9 | :root { 10 | --rec-wght: 400; 11 | --rec-slnt: 0; 12 | --rec-mono: 0; 13 | --rec-casl: 0; 14 | --rec-csrv: 0; 15 | } 16 | * { 17 | font-variation-settings: "wght" var(--rec-wght), 18 | "slnt" var(--rec-slnt), 19 | "MONO" var(--rec-mono), 20 | "CASL" var(--rec-casl), 21 | "CRSV" var(--rec-csrv); 22 | } 23 | body { 24 | max-width: 45em; 25 | margin: 1em auto; 26 | padding: 0 .62em; 27 | font: 1.2em/1.62 'Recursive', sans-serif; 28 | } 29 | //body, .remark-slide-content { background-color: #eff3f5; } 30 | //body, .remark-slide-content { background-color: #f5f3ef; } 31 | body, .remark-slide-content { background-color: #f0f6f0; color: #222323; } 32 | h1, h2, h3, h4 { 33 | line-height:0.4; 34 | --rec-wght: 900; 35 | --rec-slnt: -10; 36 | --rec-casl: 0.5; 37 | --rec-crsv: 1; 38 | --rec-mono: 0; 39 | letter-spacing: -0.015em; 40 | font-size: 4em; 41 | } 42 | .top_spacer { 43 | position: static; 44 | height: 20vh; 45 | } 46 | .word { 47 | /*height: 20vh;*/ 48 | /*font-size: 7cqw;*/ 49 | font-size: 6cqw; 50 | font-family: 'Recursive', monospace; 51 | --rec-mono: 1; 52 | letter-spacing: normal; 53 | tab-size: 4; 54 | 55 | position: absolute; 56 | top: 15%; 57 | bottom: auto; 58 | right: auto; 59 | display: block; 60 | } 61 | .logo { 62 | text-decoration: underline; 63 | text-decoration-thickness: 0.4rem; 64 | 65 | /*font-size: 13em;*/ 66 | /*font-size: 15vw;*/ 67 | font-size: 28cqw; 68 | /*line-height:0.4;*/ 69 | --rec-wght: 900; 70 | --rec-slnt: 0; 71 | --rec-casl: 0.0; 72 | --rec-crsv: 1; 73 | --rec-mono: 0; 74 | /*letter-spacing: -0.015em;*/ 75 | letter-spacing: 0em; 76 | position: absolute; 77 | top: auto; 78 | bottom: 2%; 79 | right: auto; 80 | display: block; 81 | /*overflow: hidden;*/ 82 | } 83 | .logo_container { 84 | position: static; 85 | /*height: 100vh;*/ 86 | height: 100vh; 87 | container-type: inline-size; 88 | /*max-width: initial;*/ 89 | } 90 | h2 { font-size: 3em; } 91 | h3 { font-size: 1.5em; } 92 | h4 { font-size: 1.2em; } 93 | i { --rec-slnt: -14; } 94 | em { --rec-slnt: -14; } 95 | b { --rec-wght: 600; } 96 | strong { --rec-wght: 600; } 97 | .run_container { position: relative; } 98 | .editor, .remark-code, .remark-inline-code { 99 | font-family: 'Recursive', monospace; 100 | font-size: 1rem; 101 | --rec-mono: 1; 102 | border-radius: 6px; 103 | box-shadow: 0 2px 2px 0 rgba(0, 0, 0, 0.14), 0 1px 5px 0 rgba(0, 0, 0, 0.12), 0 3px 1px -2px rgba(0, 0, 0, 0.2); 104 | //height: 7em; 105 | letter-spacing: normal; 106 | tab-size: 4; 107 | } 108 | .output { 109 | margin-block-start: 1rem; 110 | font-family: 'Recursive', monospace; 111 | font-size: 1rem; 112 | --rec-mono: 1; 113 | tab-size: 4; 114 | height: 5em; 115 | width: 100%; 116 | } 117 | .run_button { 118 | font-family: 'Recursive', sans-serif; 119 | font-size: 1em; 120 | --rec-wght: 900; 121 | --rec-slnt: -10; 122 | --rec-casl: 0.5; 123 | --rec-crsv: 1; 124 | --rec-mono: 0; 125 | letter-spacing: -0.015em; 126 | position: absolute; 127 | top: 0; 128 | right: 0; 129 | } 130 | -------------------------------------------------------------------------------- /website/slick.css: -------------------------------------------------------------------------------- 1 | @font-face { 2 | font-family: 'Inter'; 3 | font-weight: 100 900; 4 | font-display: swap; 5 | font-style: oblique 0deg 10deg; 6 | src: url("./Inter.var.woff2?v=3.19") format("woff2"); 7 | } 8 | @font-face { 9 | font-family: 'JetBrains Mono'; 10 | font-weight: 400; 11 | font-display: swap; 12 | src: url("./JetBrainsMono-Regular.woff2") format("woff2"); 13 | } 14 | :root { 15 | --rec-wght: 400; 16 | --rec-slnt: 0; 17 | } 18 | * { 19 | font-variation-settings: "wght" var(--rec-wght), 20 | "slnt" var(--rec-slnt); 21 | } 22 | body { 23 | max-width: 45em; 24 | margin: 1em auto; 25 | padding: 0 .62em; 26 | font: 1.2em/1.62 'Inter', sans-serif; 27 | } 28 | h1, h2, h3, h4 { 29 | line-height:1.0; 30 | --rec-wght: 700; 31 | } 32 | h1 { 33 | font-size: 4em; 34 | --rec-wght: 900; 35 | letter-spacing: -0.025em; 36 | //--rec-slnt: -15; 37 | line-height:0.2; 38 | text-decoration: underline; 39 | text-decoration-thickness: 0.4rem; 40 | //border-bottom: 0.08em solid; 41 | //border-left: 0.1em solid; 42 | //display: inline-block; 43 | } 44 | h2 { font-size: 3em; } 45 | h3 { font-size: 1.5em; } 46 | h4 { font-size: 1.2em; } 47 | i { --rec-slnt: -14; } 48 | b { --rec-wght: 600; } 49 | .run_container { position: relative; } 50 | .editor { 51 | font-family: 'JetBrains Mono', monospace; 52 | font-size: 1rem; 53 | --rec-mono: 1; 54 | border-radius: 6px; 55 | box-shadow: 0 2px 2px 0 rgba(0, 0, 0, 0.14), 0 1px 5px 0 rgba(0, 0, 0, 0.12), 0 3px 1px -2px rgba(0, 0, 0, 0.2); 56 | height: 7em; 57 | letter-spacing: normal; 58 | tab-size: 4; 59 | } 60 | .output { 61 | margin-block-start: 1rem; 62 | font-family: 'JetBrains Mono', monospace; 63 | font-size: 1rem; 64 | --rec-mono: 1; 65 | tab-size: 4; 66 | height: 5em; 67 | width: 100%; 68 | } 69 | .run_button { 70 | font-family: 'Inter', sans-serif; 71 | font-size: 1em; 72 | --rec-wght: 900; 73 | --rec-slnt: -15; 74 | position: absolute; 75 | top: 0; 76 | right: 0; 77 | } 78 | --------------------------------------------------------------------------------