Implement deriv benchmark

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}")
 

koka_bench/cpp/deriv.cpp

@@ -0,0 +1,237 @@
+#include <math.h>
+#include <string.h>
+#include <iostream>
+
+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;
+}

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 |

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)
 

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) -> <div|e> expr, n : int, x : expr ) : <div|e> 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) -> <div|e> expr, n : int, e : expr ) : <div|e> 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")
+

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'

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)