diff --git a/koka_bench/cpp/CMakeLists.txt b/koka_bench/cpp/CMakeLists.txt index 6bafe8e..3183c1f 100644 --- a/koka_bench/cpp/CMakeLists.txt +++ b/koka_bench/cpp/CMakeLists.txt @@ -2,7 +2,7 @@ set(CMAKE_CXX_STANDARD 17) set(CMAKE_CXX_STANDARD_REQUIRED YES) set(CMAKE_CXX_EXTENSIONS NO) -foreach (source IN ITEMS rbtree.cpp nqueens.cpp cfold.cpp) +foreach (source IN ITEMS rbtree.cpp nqueens.cpp cfold.cpp deriv.cpp) get_filename_component(name "${source}" NAME_WE) set(name "cpp-${name}") diff --git a/koka_bench/cpp/deriv.cpp b/koka_bench/cpp/deriv.cpp new file mode 100644 index 0000000..8fcba07 --- /dev/null +++ b/koka_bench/cpp/deriv.cpp @@ -0,0 +1,237 @@ +#include +#include +#include + +enum Kind { + Val, + Var, + Add, + Mul, + Pow, + Ln +}; + +class Expr { +public: + Kind kind; + Expr(Kind k) { + this->kind = k; + } +}; + +class ValExpr : public Expr { +public: + long value; + ValExpr(long i) : Expr(Val) { + this->value = i; + } +}; + +class VarExpr : public Expr { +public: + const char* name; + VarExpr( const char* n ) : Expr(Var) { + this->name = n; + } +}; + +class UnaryExpr : public Expr { +public: + const Expr* expr; + UnaryExpr( Kind k, const Expr* e ) : Expr(k) { + this->expr = e; + } +}; + +class BinExpr : public Expr { +public: + const Expr* left; + const Expr* right; + BinExpr( Kind k, const Expr* e1, const Expr* e2 ) : Expr(k) { + this->left = e1; + this->right = e2; + } + +}; + +static long pown(long x, long n) { + if (n==0) return 1; + else if (n == 1) return x; + else { + long y = pown(x, n/2); + return (y * y * (n%2 == 0 ? 1 : x)); + } +} + +static const Expr* add( const Expr* x, const Expr* y ) { + if (x->kind == Val && y->kind == Val) { + return new ValExpr(((ValExpr*)x)->value + ((ValExpr*)y)->value); + } + else if (x->kind==Val && ((ValExpr*)x)->value==0) { + return y; + } + else if (y->kind==Val && ((ValExpr*)y)->value==0) { + return x; + } + else if (y->kind==Val) { + return add(y,x); + } + else if (x->kind==Val && y->kind==Add && ((BinExpr*)y)->left->kind==Val) { + long lval = ((ValExpr*)((BinExpr*)y)->left)->value; + return add(new ValExpr(((ValExpr*)x)->value + lval), ((BinExpr*)y)->right); + } + else if (y->kind==Add && ((BinExpr*)y)->left->kind==Val) { + return add(((BinExpr*)y)->left,add(x,((BinExpr*)y)->right)); + } + else if (x->kind==Add) { + return add(((BinExpr*)x)->left,add(((BinExpr*)x)->right,y)); + } + else { + return new BinExpr(Add,x,y); + } +} + +static const Expr* mul( const Expr* x, const Expr* y ) { + if (x->kind == Val && y->kind == Val) { + return new ValExpr(((ValExpr*)x)->value * ((ValExpr*)y)->value); + } + else if (x->kind==Val && ((ValExpr*)x)->value==0) { + return x; + } + else if (y->kind==Val && ((ValExpr*)y)->value==0) { + return y; + } + else if (x->kind==Val && ((ValExpr*)x)->value==1) { + return y; + } + else if (y->kind==Val && ((ValExpr*)y)->value==1) { + return x; + } + else if (y->kind==Val) { + return mul(y,x); + } + else if (x->kind==Val && y->kind==Mul && ((BinExpr*)y)->left->kind==Val) { + long lval = ((ValExpr*)((BinExpr*)y)->left)->value; + return mul(new ValExpr(((ValExpr*)x)->value * lval), ((BinExpr*)y)->right); + } + else if (y->kind==Mul && ((BinExpr*)y)->left->kind==Val) { + return mul(((BinExpr*)y)->left,mul(x,((BinExpr*)y)->right)); + } + else if (x->kind==Mul) { + return mul(((BinExpr*)x)->left,mul(((BinExpr*)x)->right,y)); + } + else { + return new BinExpr(Mul,x,y); + } +} + +static const Expr* powr( const Expr* x, const Expr* y) { + if (x->kind == Val && y->kind == Val) { + return new ValExpr( pown(((ValExpr*)x)->value,((ValExpr*)y)->value)); + } + else if (y->kind==Val && ((ValExpr*)y)->value == 0) { + return new ValExpr(1); + } + else if (y->kind==Val && ((ValExpr*)y)->value == 1) { + return x; + } + else if (x->kind==Val && ((ValExpr*)x)->value == 0) { + return new ValExpr(0); + } + else { + return new BinExpr(Pow,x,y); + } +} + +static const Expr* ln(const Expr* n) { + if (n->kind == Val && ((ValExpr*)n)->value == 1) { + return new ValExpr(0); + } + else { + return new UnaryExpr(Ln,n); + } +} + +static const Expr* d( const char* x, const Expr* e) { + if (e->kind == Val) { + return new ValExpr(0); + } + else if (e->kind==Var) { + return new ValExpr( strcmp(((VarExpr*)e)->name,x)==0 ? 1 : 0); + } + else if (e->kind==Add) { + const Expr* f = ((BinExpr*)e)->left; + const Expr* g = ((BinExpr*)e)->right; + return add(d(x,f),d(x,g)); + } + else if (e->kind==Mul) { + const Expr* f = ((BinExpr*)e)->left; + const Expr* g = ((BinExpr*)e)->right; + return add(mul(f,d(x,g)),mul(g,d(x,f))); + } + else if (e->kind==Pow) { + const Expr* f = ((BinExpr*)e)->left; + const Expr* g = ((BinExpr*)e)->right; + return mul(powr(f,g),add(mul(mul(g,d(x,f)),powr(f,new ValExpr(-1))),mul(ln(f),d(x,g)))); + } + else { // if (e->kind==Ln) { + const Expr* f = ((UnaryExpr*)e)->expr; + return mul(d(x,f),powr(f,new ValExpr(-1))); + } +} + +static long count( const Expr* e) { + if (e->kind == Val) { + return 1; + } + else if (e->kind==Var) { + return 1; + } + else if (e->kind==Add) { + const Expr* f = ((BinExpr*)e)->left; + const Expr* g = ((BinExpr*)e)->right; + return count(f) + count(g); + } + else if (e->kind==Mul) { + const Expr* f = ((BinExpr*)e)->left; + const Expr* g = ((BinExpr*)e)->right; + return count(f) + count(g); + } + else if (e->kind==Pow) { + const Expr* f = ((BinExpr*)e)->left; + const Expr* g = ((BinExpr*)e)->right; + return count(f) + count(g); + } + else { // if (e->kind==Ln) { + const Expr* f = ((UnaryExpr*)e)->expr; + return count(f); + } +} + +static const Expr* deriv(long i, const Expr* e) { + const Expr* f = d("x",e); + std::cout << (i+1) << " count: " << count(f) << "\n"; + return f; +} + +static const Expr* nest( long s, const Expr* e) { + long n = s; + while(n > 0) { + e = deriv(s - n, e); + n--; + } + return e; +} + + +int main(int argc, char ** argv) { + unsigned n = 10; + if (argc == 2) { + n = atoi(argv[1]); + } + const Expr* x = new VarExpr("x"); + const Expr* e = powr(x,x); + nest(n,e); + std::cout << "done\n"; + return 0; +} diff --git a/koka_bench/deriv_table.md b/koka_bench/deriv_table.md new file mode 100644 index 0000000..8ad3526 --- /dev/null +++ b/koka_bench/deriv_table.md @@ -0,0 +1,5 @@ +| Command | Mean [s] | Min [s] | Max [s] | Relative | +|:---|---:|---:|---:|---:| +| `build/kraken/out/bench/kraken-deriv 8` | 3.555 ± 0.011 | 3.536 | 3.575 | 212.40 ± 8.29 | +| `build/cpp/cpp-deriv 8` | 0.021 ± 0.001 | 0.020 | 0.023 | 1.24 ± 0.06 | +| `build/koka/out/bench/kk-deriv 8` | 0.017 ± 0.001 | 0.016 | 0.018 | 1.00 | diff --git a/koka_bench/koka/CMakeLists.txt b/koka_bench/koka/CMakeLists.txt index 2743a71..34da0df 100644 --- a/koka_bench/koka/CMakeLists.txt +++ b/koka_bench/koka/CMakeLists.txt @@ -1,4 +1,4 @@ -set(sources rbtree.kk nqueens.kk nqueens-int.kk cfold.kk) +set(sources rbtree.kk nqueens.kk nqueens-int.kk cfold.kk deriv.kk) set(koka koka) diff --git a/koka_bench/koka/deriv.kk b/koka_bench/koka/deriv.kk new file mode 100644 index 0000000..0adfa77 --- /dev/null +++ b/koka_bench/koka/deriv.kk @@ -0,0 +1,91 @@ +// Adapted from: https://raw.githubusercontent.com/leanprover/lean4/IFL19/tests/bench/deriv.ml +import std/os/env +type expr + Val(value : int) + Var(name : string) + Add(l : expr, r : expr) + Mul(l : expr, r : expr) + Pow(l : expr, r : expr) + Ln(e : expr) + +fun pown(a : int, b : int) : int + pow(a,b) + +fun add(n0 : expr, m0 : expr) : div expr + match(n0,m0) + (Val(n),Val(m)) -> Val(n+m) + (Val(0),f) -> f + (f,Val(0)) -> f + (f,Val(n)) -> add(Val(n),f) + (Val(n),Add(Val(m),f)) -> add(Val(n+m),f) + (f,Add(Val(n),g)) -> add(Val(n),add(f,g)) + (Add(f, g), h) -> add(f,add(g,h)) + (f,g) -> Add(f, g) + +fun mul(n0 : expr, m0 : expr) : div expr + match (n0,m0) + (Val(n), Val(m)) -> Val(n*m) + (Val(0), _) -> Val(0) + (_, Val(0)) -> Val(0) + (Val(1), f) -> f + (f, Val(1)) -> f + (f, Val(n)) -> mul(Val(n),f) + (Val(n), Mul(Val(m), f)) -> mul(Val(n*m),f) + (f, Mul(Val(n), g)) -> mul(Val(n),mul(f,g)) + (Mul(f, g), h) -> mul(f,mul(g,h)) + (f, g) -> Mul(f, g) + +fun powr(m0 : expr, n0 : expr) : div expr + match (m0,n0) + (Val(m), Val(n)) -> Val(pown(m,n)) + (_, Val(0)) -> Val(1) + (f, Val(1)) -> f + (Val(0), _) -> Val(0) + (f, g) -> Pow(f, g) + +fun ln( n : expr) : expr + match n + Val(1) -> Val(0) + f -> Ln(f) + +fun d( x : string, ^e : expr) : div expr + match e + Val(_) -> Val(0) + Var(y) -> if x == y then Val(1) else Val(0) + Add(f, g) -> add(d(x,f),d(x,g)) + Mul(f, g) -> add(mul(f,d(x,g)),mul(g,d(x,f))) + Pow(f, g) -> mul(powr(f,g),add(mul(mul(g,d(x,f)),powr(f,Val(-1))),mul(ln(f),d(x,g)))) + Ln(f) -> mul(d(x,f),powr(f,Val(-1))) + + + +fun count( ^e : expr) : int + match e + Val(_) -> 1 + Var(_) -> 1 + Add(f,g) -> count(f) + count(g) // + 1 + Mul(f,g) -> count(f) + count(g) // + 1 + Pow(f,g) -> count(f) + count(g) // + 1 + Ln(f) -> count(f) // + 1 + +fun nest_aux(s : int, f : (int,expr) -> expr, n : int, x : expr ) : expr + if n == 0 then x else + val y = f(s - n, x) + nest_aux(s,f,n - 1,y) + +fun nest(f : (int,expr) -> expr, n : int, e : expr ) : expr + nest_aux(n,f,n,e) + + +fun deriv(i : int, f : expr) + val d = d("x",f) + println(show(i+1) ++ " count: " ++ count(d).show) // ++ ", " ++ count(f).show) + d + +pub fun main() + val n = get-args().head("").parse-int.default(10) + val x = Var("x") + val f = powr(x,x) + nest(deriv,n,f) + println("done") + diff --git a/koka_bench/test.sh b/koka_bench/test.sh index 75d7d5c..e65ee14 100755 --- a/koka_bench/test.sh +++ b/koka_bench/test.sh @@ -15,3 +15,4 @@ popd 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 rbnqueens_table.md' nix develop -i -c bash -c 'ulimit -s unlimited && find build -type f -executable -name \*rbtree\* -printf "\"%p 42000\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown rbtree_table.md' nix develop -i -c bash -c 'ulimit -s unlimited && find build -type f -executable -name \*cfold\* -printf "\"%p 5\"\n" | xargs hyperfine --ignore-failure --warmup 2 --export-markdown cfold_table.md' +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' diff --git a/partial_eval.scm b/partial_eval.scm index 877cf70..84ce0d0 100644 --- a/partial_eval.scm +++ b/partial_eval.scm @@ -4654,9 +4654,7 @@ (single_num_type_check (lambda (code) (concat (local.set '$prim_tmp_a code) (_if '$not_num (i64.ne (i64.const 0) (i64.and (i64.const 1) (local.get '$prim_tmp_a))) - (then (unreachable)) - - ;(then (local.set '$prim_tmp_a (call '$debug (call '$array1_alloc (local.get '$prim_tmp_a)) (i64.const nil_val) (i64.const nil_val)))) + (then (local.set '$prim_tmp_a (call '$debug (call '$array1_alloc (local.get '$prim_tmp_a)) (i64.const nil_val) (i64.const nil_val)))) ) (local.get '$prim_tmp_a)))) (gen_numeric_impl (lambda (operation)