diff --git a/koka_bench/CMakeLists.txt b/koka_bench/CMakeLists.txt index 50618bb..0ab96c7 100644 --- a/koka_bench/CMakeLists.txt +++ b/koka_bench/CMakeLists.txt @@ -12,3 +12,6 @@ add_subdirectory(kraken) add_subdirectory(koka) add_subdirectory(cpp) add_subdirectory(haskell) +add_subdirectory(java) +add_subdirectory(ocaml) +add_subdirectory(swift) diff --git a/koka_bench/cfold_table.md b/koka_bench/cfold_table.md index 0ea5741..1649c08 100644 --- a/koka_bench/cfold_table.md +++ b/koka_bench/cfold_table.md @@ -1,6 +1,9 @@ | Command | Mean [ms] | Min [ms] | Max [ms] | Relative | |:---|---:|---:|---:|---:| -| `build/kraken/out/bench/kraken-cfold 5` | 24.7 ± 0.9 | 23.2 | 28.7 | 47.91 ± 21.85 | -| `build/cpp/cpp-cfold 5` | 0.9 ± 0.3 | 0.6 | 3.0 | 1.75 ± 1.02 | -| `build/haskell/hs-cfold 5` | 0.8 ± 0.3 | 0.6 | 2.5 | 1.60 ± 0.91 | -| `build/koka/out/bench/kk-cfold 5` | 0.5 ± 0.2 | 0.3 | 2.1 | 1.00 | +| `build/kraken/out/bench/kraken-cfold 5` | 24.4 ± 0.8 | 22.9 | 26.8 | 56.36 ± 42.56 | +| `build/java/out/bench/cfold 5` | 73.5 ± 8.4 | 57.5 | 85.0 | 170.13 ± 129.81 | +| `build/ocaml/ml-cfold 5` | 0.4 ± 0.2 | 0.2 | 2.2 | 1.03 ± 0.96 | +| `build/swift/sw-cfold 5` | 2.1 ± 0.5 | 1.6 | 4.5 | 4.86 ± 3.82 | +| `build/cpp/cpp-cfold 5` | 0.8 ± 0.4 | 0.5 | 2.8 | 1.95 ± 1.72 | +| `build/haskell/hs-cfold 5` | 0.7 ± 0.4 | 0.5 | 2.7 | 1.67 ± 1.54 | +| `build/koka/out/bench/kk-cfold 5` | 0.4 ± 0.3 | 0.2 | 2.2 | 1.00 | diff --git a/koka_bench/deriv_table.md b/koka_bench/deriv_table.md index 14bd3ee..73e1049 100644 --- a/koka_bench/deriv_table.md +++ b/koka_bench/deriv_table.md @@ -1,6 +1,9 @@ | Command | Mean [s] | Min [s] | Max [s] | Relative | |:---|---:|---:|---:|---:| -| `build/kraken/out/bench/kraken-deriv 8` | 3.562 ± 0.012 | 3.545 | 3.581 | 215.89 ± 7.06 | -| `build/cpp/cpp-deriv 8` | 0.020 ± 0.001 | 0.020 | 0.022 | 1.24 ± 0.05 | -| `build/haskell/hs-deriv 8` | 0.036 ± 0.001 | 0.035 | 0.037 | 2.15 ± 0.08 | -| `build/koka/out/bench/kk-deriv 8` | 0.016 ± 0.001 | 0.016 | 0.021 | 1.00 | +| `build/kraken/out/bench/kraken-deriv 8` | 3.559 ± 0.014 | 3.536 | 3.582 | 236.58 ± 13.05 | +| `build/java/out/bench/deriv 8` | 0.112 ± 0.020 | 0.085 | 0.131 | 7.45 ± 1.41 | +| `build/ocaml/ml-deriv 8` | 0.015 ± 0.001 | 0.014 | 0.018 | 1.00 | +| `build/swift/sw-deriv 8` | 0.037 ± 0.000 | 0.036 | 0.038 | 2.44 ± 0.14 | +| `build/cpp/cpp-deriv 8` | 0.020 ± 0.000 | 0.020 | 0.022 | 1.35 ± 0.08 | +| `build/haskell/hs-deriv 8` | 0.035 ± 0.001 | 0.035 | 0.038 | 2.36 ± 0.14 | +| `build/koka/out/bench/kk-deriv 8` | 0.017 ± 0.000 | 0.016 | 0.018 | 1.10 ± 0.07 | diff --git a/koka_bench/java/CMakeLists.txt b/koka_bench/java/CMakeLists.txt new file mode 100644 index 0000000..d1406ed --- /dev/null +++ b/koka_bench/java/CMakeLists.txt @@ -0,0 +1,22 @@ + +set(java_wrapper "../../java_wrapper.sh") + +set(sources rbtree.java nqueens.java deriv.java cfold.java) +foreach (source IN LISTS sources) + + get_filename_component(name "${source}" NAME_WE) + + set(out_dir "${CMAKE_CURRENT_BINARY_DIR}/out/bench") + set(out_path "${out_dir}/${name}") + + add_custom_command( + OUTPUT ${out_path} + COMMAND ${java_wrapper} "${CMAKE_CURRENT_SOURCE_DIR}/${source}" ${out_dir} ${name} + DEPENDS ${source} + VERBATIM) + + add_custom_target(update-${name} ALL DEPENDS "${out_path}") + add_executable(${name}-exe IMPORTED) + set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${out_path}") +endforeach () + diff --git a/koka_bench/java/cfold.java b/koka_bench/java/cfold.java new file mode 100644 index 0000000..b6e69d8 --- /dev/null +++ b/koka_bench/java/cfold.java @@ -0,0 +1,156 @@ +interface XExpr { +} + +final class ValXExpr implements XExpr { + long value; + ValXExpr(long i) { + value = i; + } +} + +final class VarXExpr implements XExpr { + long name; + VarXExpr(long i) { + name = i; + } +} + + +final class AddXExpr implements XExpr { + XExpr left; + XExpr right; + AddXExpr(XExpr l, XExpr r) { + left = l; + right = r; + } +} + +final class MulXExpr implements XExpr { + XExpr left; + XExpr right; + MulXExpr(XExpr l, XExpr r) { + left = l; + right = r; + } +} + + +public class cfold { + static XExpr mk_expr( long n, long v ) { + if (n == 0) { + return (v==0 ? new VarXExpr(1) : new ValXExpr(v)); + } + else { + return new AddXExpr( mk_expr(n-1, v+1), mk_expr(n - 1, v == 0 ? 0 : v - 1)); + } + } + + static XExpr append_add( XExpr e1, XExpr e2 ) { + if (e1 instanceof AddXExpr a) { + return new AddXExpr(a.left, append_add(a.right, e2)); + } + else { + return new AddXExpr(e1,e2); + } + } + + static XExpr tail_append_add( XExpr e1, XExpr e2 ) { + AddXExpr hd = null; + AddXExpr acc = null; + while(e1 instanceof AddXExpr x) { + if (acc==null) { + hd = acc = new AddXExpr(x.left,null); + } + else { + AddXExpr y = new AddXExpr(x.left,null); + acc.right = y; + acc = y; + } + e1 = x.right; + } + if (acc==null) hd = acc = new AddXExpr(e1,e2); + else acc.right = new AddXExpr(e1,e2); + return hd; + } + + static XExpr append_mul( XExpr e1, XExpr e2 ) { + if (e1 instanceof MulXExpr a) { + return new MulXExpr(a.left, append_mul(a.right, e2)); + } + else { + return new MulXExpr(e1,e2); + } + } + + static XExpr reassoc( XExpr e ) { + if (e instanceof AddXExpr a) { + return append_add( reassoc(a.left), reassoc(a.right) ); + } + else if (e instanceof MulXExpr m) { + return append_mul( reassoc(m.left), reassoc(m.right) ); + } + else return e; + } + + static XExpr const_folding( XExpr e ) { + if (e instanceof AddXExpr x) { + XExpr e1 = const_folding(x.left); + XExpr e2 = const_folding(x.right); + if (e1 instanceof ValXExpr a && e2 instanceof ValXExpr b) { + return new ValXExpr(a.value + b.value ); + } + else if (e1 instanceof ValXExpr a && e2 instanceof AddXExpr b && b.right instanceof ValXExpr br) { + return new AddXExpr( new ValXExpr(a.value + br.value), b.left ); + } + else if (e1 instanceof ValXExpr a && e2 instanceof AddXExpr b && b.left instanceof ValXExpr bl) { + return new AddXExpr( new ValXExpr(a.value + bl.value), b.right ); + } + else { + return new AddXExpr(e1,e2); + } + } + else if (e instanceof MulXExpr x) { + XExpr e1 = const_folding(x.left); + XExpr e2 = const_folding(x.right); + if (e1 instanceof ValXExpr a && e2 instanceof ValXExpr b) { + return new ValXExpr(a.value * b.value ); + } + else if (e1 instanceof ValXExpr a && e2 instanceof MulXExpr b && b.right instanceof ValXExpr br) { + return new MulXExpr( new ValXExpr(a.value * br.value), b.left ); + } + else if (e1 instanceof ValXExpr a && e2 instanceof MulXExpr b && b.left instanceof ValXExpr bl) { + return new MulXExpr( new ValXExpr(a.value * bl.value), b.right ); + } + else { + return new MulXExpr(e1,e2); + } + } + else return e; + } + + static long eval( XExpr e ) { + if (e instanceof VarXExpr x) { + return 0; + } + else if (e instanceof ValXExpr x) { + return x.value; + } + else if (e instanceof AddXExpr x) { + return eval(x.left) + eval(x.right); + } + else if (e instanceof MulXExpr x) { + return eval(x.left) * eval(x.right); + } + else { + return 0; + } + } + + public static void main(String args[]) + { + XExpr e = mk_expr(Integer.parseInt(args[0]),1); + long v1 = eval(e); + long v2 = eval(const_folding(reassoc(e))); + System.out.println( v1 + ", " + v2 ); + } +} diff --git a/koka_bench/java/deriv.java b/koka_bench/java/deriv.java new file mode 100644 index 0000000..cb4a4bd --- /dev/null +++ b/koka_bench/java/deriv.java @@ -0,0 +1,235 @@ +interface Expr { +} + +final class ValExpr implements Expr { + long value; + ValExpr(long i) { + value = i; + } +} + +final class VarExpr implements Expr { + String name; + VarExpr(String s) { + name = s; + } +} + +final class LnExpr implements Expr { + Expr expr; + LnExpr(Expr e) { + expr = e; + } +} + +final class AddExpr implements Expr { + Expr left; + Expr right; + AddExpr(Expr l, Expr r) { + left = l; + right = r; + } +} + +final class MulExpr implements Expr { + Expr left; + Expr right; + MulExpr(Expr l, Expr r) { + left = l; + right = r; + } +} + +final class PowExpr implements Expr { + Expr left; + Expr right; + PowExpr(Expr l, Expr r) { + left = l; + right = r; + } +} + + + +public class deriv { + 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 Expr add( Expr x, Expr y ) { + if (x instanceof ValExpr a && y instanceof ValExpr b) { + return new ValExpr( a.value + b.value ); + } + else if (x instanceof ValExpr a && a.value == 0) { + return y; + } + else if (y instanceof ValExpr b && b.value == 0) { + return x; + } + else if (y instanceof ValExpr b) { + return add(y,x); + } + else if (x instanceof ValExpr a && y instanceof AddExpr b && b.left instanceof ValExpr bl) { + return add(new ValExpr(a.value + bl.value), b.right); + } + else if (y instanceof AddExpr b && b.left instanceof ValExpr) { + return add(b.left, add(x,b.right)); + } + else if (x instanceof AddExpr a) { + return add(a.left, add(a.right,y)); + } + else { + return new AddExpr(x,y); + } + } + + static Expr mul( Expr x, Expr y ) { + if (x instanceof ValExpr a && y instanceof ValExpr b) { + return new ValExpr( a.value * b.value ); + } + else if (x instanceof ValExpr a && a.value == 0) { + return x; + } + else if (y instanceof ValExpr b && b.value == 0) { + return y; + } + else if (x instanceof ValExpr a && a.value == 1) { + return y; + } + else if (y instanceof ValExpr b && b.value == 1) { + return x; + } + else if (y instanceof ValExpr b) { + return mul(y,x); + } + else if (x instanceof ValExpr a && y instanceof MulExpr b && b.left instanceof ValExpr bl) { + return mul(new ValExpr(a.value * bl.value), b.right); + } + else if (y instanceof MulExpr b && b.left instanceof MulExpr) { + return mul(b.left, mul(x,b.right)); + } + else if (x instanceof MulExpr a) { + return mul(a.left, mul(a.right,y)); + } + else { + return new MulExpr(x,y); + } + } + + static Expr powr( Expr x, Expr y ) { + if (x instanceof ValExpr a && y instanceof ValExpr b) { + return new ValExpr(pown(a.value,b.value)); + } + else if (y instanceof ValExpr b && b.value == 0) { + return new ValExpr(1); + } + else if (y instanceof ValExpr b && b.value == 1) { + return x; + } + else if (x instanceof ValExpr a && a.value == 0) { + return new ValExpr(0); + } + else { + return new PowExpr(x,y); + } + } + + static Expr ln( Expr x ) { + if (x instanceof ValExpr a && a.value == 1) { + return new ValExpr(0); + } + else { + return new LnExpr(x); + } + } + + static Expr d( String x, Expr e ) { + if (e instanceof ValExpr) { + return new ValExpr(0); + } + else if (e instanceof VarExpr a) { + return new ValExpr(a.name == x ? 1 : 0); + } + else if (e instanceof AddExpr a) { + Expr f = a.left; + Expr g = a.right; + return add(d(x,f),d(x,g)); + } + else if (e instanceof MulExpr a) { + Expr f = a.left; + Expr g = a.right; + return add(mul(f,d(x,g)),mul(g,d(x,f))); + } + else if (e instanceof PowExpr a) { + Expr f = a.left; + Expr g = a.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 instanceof LnExpr a) { + Expr f = a.expr; + return mul(d(x,f),powr(f,new ValExpr(-1))); + } + else { + return e; + } + } + + static long count( Expr e ) { + if (e instanceof ValExpr) { + return 1; + } + else if (e instanceof VarExpr) { + return 1; + } + else if (e instanceof AddExpr a) { + Expr f = a.left; + Expr g = a.right; + return count(f) + count(g); + } + else if (e instanceof MulExpr a) { + Expr f = a.left; + Expr g = a.right; + return count(f) + count(g); + } + else if (e instanceof PowExpr a) { + Expr f = a.left; + Expr g = a.right; + return count(f) + count(g); + } + else if (e instanceof LnExpr a) { + Expr f = a.expr; + return count(f); + } + else { + return 0; + } + } + + static Expr deriv( long i, Expr e) { + Expr f = d("x",e); + System.out.println( (i+1) + " count: " + count(f) ); + return f; + } + + static Expr nest( long s, Expr e) { + long n = s; + while(n > 0) { + e = deriv(s - n, e); + n--; + } + return e; + } + + public static void main(String args[]) + { + Expr x = new VarExpr("x"); + Expr e = powr(x,x); + nest(Integer.parseInt(args[0]),e); + System.out.println( "done" ); + } +} diff --git a/koka_bench/java/nqueens.java b/koka_bench/java/nqueens.java new file mode 100644 index 0000000..2d3acb5 --- /dev/null +++ b/koka_bench/java/nqueens.java @@ -0,0 +1,78 @@ +class List { + T head; + List tail; + + List(T h, List t) { + head = h; + tail = t; + } + + static int len( List xs ) { + int n = 0; + while(xs != null) { + n++; + xs = xs.tail; + } + return n; + } + + static List Cons( T h, List t ) { + return new List(h,t); + } + +} + +public class nqueens { + static boolean safe( int queen, List xs ) { + int diag = 1; + while(xs != null) { + int q = xs.head; + if (queen == q || queen == (q + diag) || queen == (q - diag)) { + return false; + } + diag++; + xs = xs.tail; + } + return true; + } + + static List> appendSafe( int k, List soln, List> solns ) { + List> acc = solns; + while(k > 0) { + if (safe(k,soln)) { + acc = List.Cons(List.Cons(k,soln),acc); + } + k--; + } + return acc; + } + + static List> extend( int n, List> solns ) { + List> acc = null; + List> cur = solns; + while(cur != null) { + acc = appendSafe(n, cur.head, acc); + cur = cur.tail; + } + return acc; + } + + static List> findSolutions( int n ) { + int k = 0; + List> acc = List.Cons(null,null); + while(k < n) { + acc = extend(n,acc); + k++; + } + return acc; + } + + + static int nqueens(int n) { + return List.len(findSolutions(n)); + } + public static void main(String args[]) + { + System.out.println( nqueens(Integer.parseInt(args[0])) ); + } +} diff --git a/koka_bench/java/rbtree.java b/koka_bench/java/rbtree.java new file mode 100644 index 0000000..329eaa0 --- /dev/null +++ b/koka_bench/java/rbtree.java @@ -0,0 +1,159 @@ + +enum Color { + Red, + Black +} + + +interface FoldFun { + int Apply(int k, boolean v, int acc); +} + +class Tree { + Color color; + Tree left; + int key; + boolean val; + Tree right; + + Tree( Color c, Tree l, int k, boolean v, Tree r) { + color = c; + left = l; + key = k; + val = v; + right = r; + } + + static Tree Node( Color c, Tree l, int k, boolean v, Tree r) { + return new Tree(c,l,k,v,r); + } + + static boolean isRed( Tree t ) { + return (t != null && t.color == Color.Red); + } + + static Tree balanceRight( int kv, boolean vv, Tree t, Tree n ) { + if (n == null) { + return null; + } + else if (n.left != null && n.left.color == Color.Red) { + //case let .Node(_, .Node(.Red, l, kx, vx, r1), ky, vy, r2): + // return .Node(.Red, .Node(.Black, l, kx, vx, r1), ky, vy, .Node(.Black, r2, kv, vv, t)) + Tree l = n.left; + 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)); + } + else if (n.right != null && n.right.color == Color.Red) { + //case let .Node(_, l1, ky, vy, .Node(.Red, l2, kx, vx, r)): + // return .Node(.Red, .Node(.Black, l1, ky, vy, l2), kx, vx, .Node(.Black, r, kv, vv, t)) + Tree r = n.right; + 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)); + } + else { + //case let .Node(_, l, ky, vy, r): + // return .Node(.Black, .Node(.Red, l, ky, vy, r), kv, vv, t) + return Node(Color.Black, Node(Color.Red, n.left, n.key, n.val, n.right), kv, vv, t); + } + } + + static Tree balanceLeft( Tree t, int kv, boolean vv, Tree n ) { + if (n == null) { + return null; + } + else if (n.left != null && n.left.color == Color.Red) { + //case let .Node(_, .Node(.Red, l, kx1, vx1, r1), ky, vy, r2): + // return .Node(.Red, .Node(.Black, t, kv, vv, l), kx1, vx1, .Node(.Black, r1, ky, vy, r2)) + Tree l = n.left; + 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)); + } + else if (n.right != null && n.right.color == Color.Red) { + //case let .Node(_, l1, ky, vy, .Node(.Red, l2, kx2, vx2, r2)): + // return .Node(.Red, .Node(.Black, t, kv, vv, l1), ky, vy, .Node(.Black, l2, kx2, vx2, r2)) + Tree r = n.right; + 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)); + } + else { + //case let .Node (_, l, ky, vy, r): + // return .Node(.Black, t, kv, vv, .Node(.Red, l, ky, vy, r)) + return Node(Color.Black, t, kv, vv, Node(Color.Red, n.left, n.key, n.val, n.right)); + } + } + + static Tree ins(Tree t, int kx, boolean vx ) { + if (t==null) { + return Node(Color.Red, null, kx, vx, null); + } + else if (t.color == Color.Red) { + //case let .Node(.Red, a, ky, vy, b): + if (kx < t.key) { + return Node(Color.Red, ins(t.left, kx, vx), t.key, t.val, t.right); + } else if (t.key == kx) { + return Node(Color.Red, t.left, kx, vx, t.right); + } else { + return Node(Color.Red, t.left, t.key, t.val, ins(t.right, kx, vx)); + } + } + else { // t.color == Black + if (kx < t.key) { + if (isRed(t.left)) { + return balanceRight(t.key, t.val, t.right, ins(t.left, kx, vx)); + } else { + return Node(Color.Black, ins(t.left, kx, vx), t.key, t.val, t.right); + } + } else if (kx == t.key) { + return Node(Color.Black, t.left, kx, vx, t.right); + } else { + if (isRed(t.right)) { + return balanceLeft(t.left, t.key, t.val, ins(t.right, kx, vx)); + } else { + return Node(Color.Black, t.left, t.key, t.val, ins(t.right, kx, vx)); + } + } + } + } + + static Tree setBlack( Tree t ) { + if (t == null) return t; + return Node(Color.Black, t.left, t.key, t.val, t.right); + } + + static Tree insert (Tree t, int k, boolean v) { + if (isRed(t)) { + return setBlack(ins(t, k, v)); + } else { + return ins(t, k, v); + } + } + + static int Fold( FoldFun f, Tree t, int acc ) { + while(t != null) { + acc = Fold(f,t.left,acc); + acc = f.Apply(t.key,t.val,acc); + t = t.right; + } + return acc; + } + +} + + +public class rbtree +{ + static Tree mkMap( int n ) { + Tree t = null; + while(n > 0) { + n--; + t = Tree.insert(t, n, (n%10)==0); + } + return t; + } + + static int Test(int n ) { + Tree t = mkMap(n); + return Tree.Fold( (k,v,acc) -> { return (v ? acc + 1 : acc); }, t, 0); + } + + public static void main(String args[]) + { + System.out.println( Test(Integer.parseInt(args[0])) ); + } +} diff --git a/koka_bench/java_wrapper.sh b/koka_bench/java_wrapper.sh new file mode 100755 index 0000000..fabd51a --- /dev/null +++ b/koka_bench/java_wrapper.sh @@ -0,0 +1,11 @@ +#!/usr/bin/env bash +OUR_DIR="$(dirname $(readlink -f $0))" +SOURCE="$1" +OUT_DIR="$2" +OUT_NAME="$3" + +mkdir -p "$OUT_DIR" +javac --enable-preview -source 17 -d "$OUT_DIR" $SOURCE + +printf '#!/usr/bin/env bash\njava -Xss1024m --enable-preview -classpath "$(dirname $(readlink -f $0))" '"$OUT_NAME"' $@' > "$OUT_DIR/$OUT_NAME" +chmod 755 "$OUT_DIR/$OUT_NAME" diff --git a/koka_bench/ocaml/CMakeLists.txt b/koka_bench/ocaml/CMakeLists.txt new file mode 100644 index 0000000..94ffae7 --- /dev/null +++ b/koka_bench/ocaml/CMakeLists.txt @@ -0,0 +1,39 @@ +#see for installation (including domainslib) +#> opam update +#> opam switch create 4.12.0+domains+effects --repositories=multicore=git+https://github.com/ocaml-multicore/multicore-opam.git,default +#> opam install dune domainslib +# +#compile as: +#> ocamlopt -O2 -o ./mcml_bintrees -I ~/.opam/4.12.0+domains+effects/lib/domainslib/ domainslib.cmxa test/bench/ocaml/binarytrees_mc.ml + + +set(sources cfold.ml deriv.ml nqueens.ml rbtree.ml) + +# find_program(ocamlopt "ocamlopt" REQUIRED) +set(ocamlopt "ocamlopt") + +# no domains +set(domainslib "unix.cmxa") + +# with domains +# set(domainslib "-I $ENV{HOME}/.opam/4.12.0+domains+effects/lib/domainslib/ domainslib.cmxa") +# set(sources cfold.ml deriv.ml nqueens.ml rbtree.ml rbtree-ck.ml binarytrees.ml) + +foreach (source IN LISTS sources) + get_filename_component(name "${source}" NAME_WE) + set(name "ml-${name}") + + add_custom_command( + OUTPUT ${name} + COMMAND ${ocamlopt} -O2 -o ${name} ${domainslib} "$" + DEPENDS ${source} + VERBATIM) + + add_custom_target(update-${name} ALL DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/${name}) + + add_executable(${name}-exe IMPORTED) + set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${CMAKE_CURRENT_BINARY_DIR}/${name}") + + add_test(NAME ${name} COMMAND ${name}-exe) + set_tests_properties(${name} PROPERTIES LABELS ocaml) +endforeach () diff --git a/koka_bench/ocaml/cfold.ml b/koka_bench/ocaml/cfold.ml new file mode 100644 index 0000000..c5e1404 --- /dev/null +++ b/koka_bench/ocaml/cfold.ml @@ -0,0 +1,72 @@ +type expr = +| Var of int +| Val of int +| Add of expr * expr +| Mul of expr * expr;; + +let dec n = + if n == 0 then 0 else n - 1;; + +let rec mk_expr n v = + if n == 0 then (if v == 0 then Var 1 else Val v) + else Add (mk_expr (n-1) (v+1), mk_expr (n-1) (dec v));; + +let rec append_add e0 e3 = +match (e0) with +| Add (e1, e2) -> Add (e1, append_add e2 e3) +| _ -> Add (e0, e3);; + +let rec append_mul e0 e3 = +match e0 with +| Mul (e1, e2) -> Mul (e1, append_mul e2 e3) +| _ -> Mul (e0, e3);; + +let rec reassoc e = +match e with +| Add (e1, e2) -> + let e1' = reassoc e1 in + let e2' = reassoc e2 in + append_add e1' e2' +| Mul (e1, e2) -> + let e1' = reassoc e1 in + let e2' = reassoc e2 in + append_mul e1' e2' +| e -> e;; + +let rec const_folding e = +match e with +| Add (e1, e2) -> + let e1 = const_folding e1 in + let e2 = const_folding e2 in + (match (e1, e2) with + | (Val a, Val b) -> Val (a+b) + | (Val a, Add (e, Val b)) -> Add (Val (a+b), e) + | (Val a, Add (Val b, e)) -> Add (Val (a+b), e) + | _ -> Add (e1, e2)) +| Mul (e1, e2) -> + let e1 = const_folding e1 in + let e2 = const_folding e2 in + (match (e1, e2) with + | (Val a, Val b) -> Val (a*b) + | (Val a, Mul (e, Val b)) -> Mul (Val (a*b), e) + | (Val a, Mul (Val b, e)) -> Mul (Val (a*b), e) + | _ -> Mul (e1, e2)) +| e -> e;; + +let rec size e = +match e with +| Add (e1, e2) -> size e1 + size e2 + 1 +| Mul (e1, e2) -> size e1 + size e2 + 1 +| e -> 1;; + +let rec eeval e = + match e with + | Val n -> n + | Var x -> 0 + | Add (e1, e2) -> eeval e1 + eeval e2 + | Mul (e1, e2) -> eeval e1 * eeval e2;; + +let e = (mk_expr (int_of_string Sys.argv.(1)) 1) in +let v1 = eeval e in +let v2 = eeval (const_folding (reassoc e)) in +Printf.printf "%8d %8d\n" v1 v2;; diff --git a/koka_bench/ocaml/deriv.ml b/koka_bench/ocaml/deriv.ml new file mode 100644 index 0000000..0c984ef --- /dev/null +++ b/koka_bench/ocaml/deriv.ml @@ -0,0 +1,85 @@ +type expr = +| Val of int +| Var of string +| Add of expr * expr +| Mul of expr * expr +| Pow of expr * expr +| Ln of expr;; + +let rec pown a n = +if n == 0 then 1 +else if n == 1 then a +else let b = pown a (n / 2) in +b * b * (if n mod 2 == 0 then 1 else a);; + +let rec add n m = +match (n, m) with +| (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);; + +let rec mul n m = +match (n, m) with +| (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);; + +let rec pow m n = +match (m, n) with +| (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);; + +let rec ln n = +match n with +| (Val 1) -> Val 0 +| f -> Ln f;; + +let rec d x f = +match f with +| 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 (pow f g) (add (mul (mul g (d x f)) (pow f (Val (-1)))) (mul (ln f) (d x g))) +| Ln f -> mul (d x f) (pow f (Val (-1)));; + +let rec count f = +match f with +| Val _ -> 1 +| Var _ -> 1 +| Add (f, g) -> count f + count g +| Mul (f, g) -> count f + count g +| Pow (f, g) -> count f + count g +| Ln f -> count f;; + +let rec nest_aux s f n x = +if n == 0 then x +else let x = f (s - n) x in + nest_aux s f (n - 1) x;; + +let nest f n e = +nest_aux n f n e;; + +let deriv i f = + let d = d "x" f in + Printf.printf "%8d count: %8d\n" (i+1) (count d); + d;; + +let x = Var "x" in +let f = pow x x in +nest deriv (int_of_string Sys.argv.(1)) f;; diff --git a/koka_bench/ocaml/nqueens.ml b/koka_bench/ocaml/nqueens.ml new file mode 100644 index 0000000..97b01cd --- /dev/null +++ b/koka_bench/ocaml/nqueens.ml @@ -0,0 +1,24 @@ +open List;; + +let rec safe queen diag xs = + match xs with + | q :: qs -> queen <> q && queen <> q + diag && queen <> q - diag && safe queen (diag + 1) qs + | [] -> true;; + +let rec append_safe queen xs xss = + if (queen <= 0) then xss + else if (safe queen 1 xs) then append_safe (queen - 1) xs ((queen :: xs) :: xss) + else append_safe (queen - 1) xs xss;; + +let rec extend queen acc xss = + match xss with + | xs :: rest -> extend queen (append_safe queen xs acc) rest + | [] -> acc;; + +let rec find_solutions n queen = + if (queen == 0) then [[]] + else extend n [] (find_solutions n (queen - 1));; + +let queens n = List.length (find_solutions n n);; + +Printf.printf "%8d\n" (queens (int_of_string Sys.argv.(1)));; diff --git a/koka_bench/ocaml/rbtree.ml b/koka_bench/ocaml/rbtree.ml new file mode 100644 index 0000000..c0cdedc --- /dev/null +++ b/koka_bench/ocaml/rbtree.ml @@ -0,0 +1,72 @@ +(* Adapted from https://github.com/leanprover/lean4/blob/IFL19/tests/bench/rbmap.ml *) + +type color = +| Red +| Black;; + +type node = +| Leaf +| Node of color * node * int * bool * node;; + +let balance1 kv vv t n = +match n with +| 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)) +| 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)) +| Node (c, l, ky, vy, r) -> Node (Black, Node (Red, l, ky, vy, r), kv, vv, t) +| n -> Leaf;; + +let balance2 t kv vv n = +match n with +| 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)) +| 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)) +| Node (_, l, ky, vy, r) -> Node (Black, t, kv, vv, Node (Red, l, ky, vy, r)) +| n -> Leaf;; + +let is_red t = +match t with +| Node (Red, _, _, _, _) -> true +| _ -> false;; + +let rec ins t kx vx = +match t with +| Leaf -> Node (Red, Leaf, kx, vx, Leaf) +| Node (Red, a, ky, vy, b) -> + if kx < ky then Node (Red, ins a kx vx, ky, vy, b) + else if ky = kx then Node (Red, a, kx, vx, b) + else Node (Red, a, ky, vy, ins b kx vx) +| Node (Black, a, ky, vy, b) -> + if kx < ky then + (if is_red a then balance1 ky vy b (ins a kx vx) + else Node (Black, (ins a kx vx), ky, vy, b)) + else if kx = ky then Node (Black, a, kx, vx, b) + else if is_red b then balance2 a ky vy (ins b kx vx) + else Node (Black, a, ky, vy, (ins b kx vx));; + +let set_black n = +match n with +| Node (_, l, k, v, r) -> Node (Black, l, k, v, r) +| e -> e;; + +let insert t k v = +if is_red t then set_black (ins t k v) +else ins t k v;; + +let rec fold f n d = +match n with +| Leaf -> d +| Node(_, l, k, v, r) -> fold f r (f k v (fold f l d));; + +let rec mk_map_aux n m = +if n = 0 then m +else let n1 = n-1 in + mk_map_aux n1 (insert m n1 (n1 mod 10 == 0));; + +let mk_map n = mk_map_aux n Leaf;; + +let main n = +let m = mk_map n in +let v = fold (fun k v r -> if v then r + 1 else r) m 0 in +Printf.printf "%8d\n" v; +v;; + +main (int_of_string Sys.argv.(1));; diff --git a/koka_bench/rbnqueens_table.md b/koka_bench/rbnqueens_table.md index d511807..0ec6d5d 100644 --- a/koka_bench/rbnqueens_table.md +++ b/koka_bench/rbnqueens_table.md @@ -1,7 +1,10 @@ | Command | Mean [s] | Min [s] | Max [s] | Relative | |:---|---:|---:|---:|---:| -| `build/kraken/out/bench/kraken-nqueens 10` | 2.223 ± 0.009 | 2.202 | 2.231 | 503.18 ± 43.65 | -| `build/cpp/cpp-nqueens 10` | 0.006 ± 0.000 | 0.006 | 0.008 | 1.36 ± 0.14 | -| `build/haskell/hs-nqueens 10` | 0.035 ± 0.000 | 0.035 | 0.037 | 8.02 ± 0.70 | -| `build/koka/out/bench/kk-nqueens 10` | 0.004 ± 0.000 | 0.004 | 0.006 | 1.00 | -| `build/koka/out/bench/kk-nqueens-int 10` | 0.007 ± 0.001 | 0.006 | 0.009 | 1.52 ± 0.19 | +| `build/kraken/out/bench/kraken-nqueens 10` | 2.225 ± 0.016 | 2.187 | 2.246 | 480.72 ± 59.09 | +| `build/java/out/bench/nqueens 10` | 0.057 ± 0.005 | 0.053 | 0.070 | 12.37 ± 1.92 | +| `build/ocaml/ml-nqueens 10` | 0.005 ± 0.001 | 0.004 | 0.007 | 1.03 ± 0.17 | +| `build/swift/sw-nqueens 10` | 0.016 ± 0.001 | 0.015 | 0.018 | 3.48 ± 0.45 | +| `build/cpp/cpp-nqueens 10` | 0.006 ± 0.001 | 0.006 | 0.009 | 1.34 ± 0.20 | +| `build/haskell/hs-nqueens 10` | 0.036 ± 0.001 | 0.035 | 0.038 | 7.77 ± 0.97 | +| `build/koka/out/bench/kk-nqueens 10` | 0.005 ± 0.001 | 0.004 | 0.007 | 1.00 | +| `build/koka/out/bench/kk-nqueens-int 10` | 0.006 ± 0.000 | 0.006 | 0.008 | 1.39 ± 0.19 | diff --git a/koka_bench/rbtree_table.md b/koka_bench/rbtree_table.md index 726d81b..66e792d 100644 --- a/koka_bench/rbtree_table.md +++ b/koka_bench/rbtree_table.md @@ -1,7 +1,10 @@ | Command | Mean [s] | Min [s] | Max [s] | Relative | |:---|---:|---:|---:|---:| -| `build/kraken/out/bench/kraken-rbtree-opt 42000` | 3.822 ± 0.037 | 3.785 | 3.886 | 873.63 ± 91.30 | -| `build/kraken/out/bench/kraken-rbtree 42000` | 4.082 ± 0.015 | 4.063 | 4.103 | 933.07 ± 97.15 | -| `build/cpp/cpp-rbtree 42000` | 0.006 ± 0.001 | 0.005 | 0.008 | 1.27 ± 0.19 | -| `build/haskell/hs-rbtree 42000` | 0.016 ± 0.001 | 0.016 | 0.018 | 3.72 ± 0.41 | -| `build/koka/out/bench/kk-rbtree 42000` | 0.004 ± 0.000 | 0.004 | 0.007 | 1.00 | +| `build/kraken/out/bench/kraken-rbtree-opt 42000` | 3.924 ± 0.196 | 3.786 | 4.307 | 863.93 ± 83.96 | +| `build/kraken/out/bench/kraken-rbtree 42000` | 4.116 ± 0.105 | 4.070 | 4.415 | 906.34 ± 79.00 | +| `build/java/out/bench/rbtree 42000` | 0.086 ± 0.010 | 0.075 | 0.130 | 18.96 ± 2.79 | +| `build/ocaml/ml-rbtree 42000` | 0.008 ± 0.000 | 0.008 | 0.010 | 1.80 ± 0.18 | +| `build/swift/sw-rbtree 42000` | 0.039 ± 0.000 | 0.039 | 0.041 | 8.70 ± 0.73 | +| `build/cpp/cpp-rbtree 42000` | 0.005 ± 0.000 | 0.005 | 0.008 | 1.21 ± 0.14 | +| `build/haskell/hs-rbtree 42000` | 0.016 ± 0.000 | 0.016 | 0.018 | 3.53 ± 0.31 | +| `build/koka/out/bench/kk-rbtree 42000` | 0.005 ± 0.000 | 0.004 | 0.006 | 1.00 | diff --git a/koka_bench/swift/CMakeLists.txt b/koka_bench/swift/CMakeLists.txt new file mode 100644 index 0000000..bef2993 --- /dev/null +++ b/koka_bench/swift/CMakeLists.txt @@ -0,0 +1,30 @@ +find_program(swiftc "swiftc" REQUIRED + HINTS /opt/swift/bin + $ENV{SWIFT_ROOT}/bin + /usr/local/swift/bin) + +if(APPLE) + set(swopts -Xlinker -stack_size -Xlinker 0x8000000) +else() + set(swopts "") +endif() + +set(sources cfold.swift deriv.swift rbtree.swift nqueens.swift) +foreach (source IN LISTS sources) + get_filename_component(name "${source}" NAME_WE) + set(name "sw-${name}") + + add_custom_command( + OUTPUT ${name} + COMMAND ${swiftc} -O -whole-module-optimization -o ${name} ${swopts} "$" + DEPENDS ${source} + VERBATIM) + + add_custom_target(update-${name} ALL DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/${name}) + + add_executable(${name}-exe IMPORTED) + set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${CMAKE_CURRENT_BINARY_DIR}/${name}") + + add_test(NAME ${name} COMMAND ${name}-exe) + set_tests_properties(${name} PROPERTIES LABELS swift) +endforeach () diff --git a/koka_bench/swift/cfold.swift b/koka_bench/swift/cfold.swift new file mode 100644 index 0000000..c5ebe26 --- /dev/null +++ b/koka_bench/swift/cfold.swift @@ -0,0 +1,103 @@ +indirect enum Expr { + case Var(UInt64) + case Val(UInt64) + case Add(Expr, Expr) + case Mul(Expr, Expr) +} + +func mk_expr(_ n: UInt64, _ v: UInt64) -> Expr { + if n == 0 { + return v == 0 ? .Var(1) : .Val(v) + } else { + return .Add(mk_expr(n - 1, v+1), mk_expr(n - 1, v == 0 ? 0 : v - 1)) + } +} + +func append_add(_ e₁: Expr, _ e₂: Expr) -> Expr { + switch e₁ { + case let .Add(e₁₁, e₁₂): + return .Add(e₁₁, append_add(e₁₂, e₂)) + default: + return .Add(e₁, e₂) + } +} + +func append_mul(_ e₁: Expr, _ e₂: Expr) -> Expr { + switch e₁ { + case let .Mul(e₁₁, e₁₂): + return .Mul(e₁₁, append_mul(e₁₂, e₂)) + default: + return .Mul(e₁, e₂) + } +} + +func reassoc(_ e: Expr) -> Expr { + switch e { + case let .Add(e₁, e₂): + let e₁ = reassoc(e₁) + let e₂ = reassoc(e₂) + return append_add(e₁, e₂) + case let .Mul(e₁, e₂): + let e₁ = reassoc(e₁) + let e₂ = reassoc(e₂) + return append_mul(e₁, e₂) + default: + return e + } +} + +func const_folding(_ e: Expr) -> Expr { + switch e { + case let .Add(e₁, e₂): + let e₁ = const_folding(e₁) + let e₂ = const_folding(e₂) + switch (e₁, e₂) { + case let (.Val(a), .Val(b)): + return .Val(a+b) + case let (.Val(a), .Add(e, .Val(b))): + return .Add(.Val(a+b), e) + case let (.Val(a), .Add(.Val(b), e)): + return .Add(.Val(a+b), e) + default: + return .Add(e₁, e₂) + } + case let .Mul(e₁, e₂): + let e₁ = const_folding(e₁) + let e₂ = const_folding(e₂) + switch (e₁, e₂) { + case let (.Val(a), .Val(b)): + return .Val(a*b) + case let (.Val(a), .Mul(e, .Val(b))): + return .Mul(.Val(a*b), e) + case let (.Val(a), .Mul(.Val(b), e)): + return .Mul(.Val(a*b), e) + default: + return .Mul(e₁, e₂) + } + default: + return e + } +} + +func eval(_ e: Expr) -> UInt64 { + switch e { + case .Var(_): + return 0 + case let .Val(v): + return v + case let .Add(l, r): + return eval(l) + eval(r) + case let .Mul(l, r): + return eval(l) * eval(r) + } +} + +var num: UInt64? = 20 +if CommandLine.arguments.count >= 2 { + num = UInt64(CommandLine.arguments[1]) +} + +let e = mk_expr(num!, 1) +let v₁ = eval(e) +let v₂ = eval(const_folding(reassoc(e))) +print(v₁, v₂) diff --git a/koka_bench/swift/deriv.swift b/koka_bench/swift/deriv.swift new file mode 100644 index 0000000..adda5f3 --- /dev/null +++ b/koka_bench/swift/deriv.swift @@ -0,0 +1,176 @@ +indirect enum Expr { + case Val(Int64) + case Var(String) + case Add(Expr, Expr) + case Mul(Expr, Expr) + case Pow(Expr, Expr) + case Ln(Expr) +} + +func pown(_ a : Int64, _ n : Int64) -> Int64 { + if n == 0 { + return 1 + } else if n == 1 { + return a + } else { + let b = pown(a, n/2) + if n % 2 == 0 { + return b*b*a + } else { + return b*b + } + } +} + +func add (_ e1 : Expr, _ e2 : Expr) -> Expr { + switch (e1, e2) { + case let (.Val(n), .Val(m)) : + return .Val(n+m) + case let (.Val(0), f): + return f + case let (f, .Val(0)): + return f + case let (f, .Val(n)): + return add(.Val(n), f) + case let (.Val(n), .Add(.Val(m), f)): + return add(.Val(n+m), f) + case let (f, .Add(.Val(n), g)): + return add(.Val(n), add(f, g)) + case let (.Add(f, g), h): + return add(f, add(g, h)) + default: + return .Add(e1, e2) + } +} + +func mul (_ e1 : Expr, _ e2 : Expr) -> Expr { + switch (e1, e2) { + case let (.Val(n), .Val(m)): + return .Val(n*m) + case (.Val(0), _): + return .Val(0) + case (_, .Val(0)): + return .Val(0) + case let (.Val(1), f): + return f + case let (f, .Val(1)): + return f + case let (f, .Val(n)): + return mul(.Val(n), f) + case let (.Val(n), .Mul(.Val(m), f)): + return mul(.Val(n*m), f) + case let (f, .Mul(.Val(n), g)): + return mul(.Val(n), mul(f, g)) + case let (.Mul(f, g), h): + return mul(f, mul(g, h)) + default: + return .Mul(e1, e2) + } +} + +func pow (_ e1 : Expr, _ e2 : Expr) -> Expr { + switch (e1, e2) { + case let (.Val(m), .Val(n)): + return .Val(pown(m, n)) + case (_, .Val(0)): + return .Val(1) + case let (f, .Val(1)): + return f + case (.Val(0), _): + return .Val(0) + default: + return .Pow(e1, e2) + } +} + +func ln (_ e : Expr) -> Expr { + switch e { + case .Val(1): + return .Val(0) + default: + return .Ln(e) + } +} + +func d (_ x : String, _ e : Expr) -> Expr { + switch e { + case .Val(_): + return .Val(0) + case let .Var(y): + if x == y { + return .Val(1) + } else { + return .Val(0) + } + case let .Add(f, g): + return add(d(x, f), d(x, g)) + case let .Mul(f, g): + return add(mul(f, d(x, g)), mul(g, d(x, f))) + case let .Pow(f, g): + return mul(pow(f, g), add(mul(mul(g, d(x, f)), pow(f, .Val(-1))), mul(ln(f), d(x, g)))) + case let .Ln(f): + return mul(d(x, f), pow(f, .Val(-1))) + } +} + +func toString (_ e : Expr) -> String { + switch e { + case let .Val(n): + return String(n) + case let .Var(x): + return x + case let .Add(f, g): + return "(" + toString(f) + " + " + toString(g) + ")" + case let .Mul(f, g): + return "(" + toString(f) + " * " + toString(g) + ")" + case let .Pow(f, g): + return "(" + toString(f) + " ^ " + toString(g) + ")" + case let .Ln(f): + return "ln(" + toString(f) + ")" + } +} + +func count (_ e : Expr) -> UInt32 { + switch e { + case .Val(_): + return 1 + case .Var(_): + return 1 + case let .Add(f, g): + return count(f) + count(g) + case let .Mul(f, g): + return count(f) + count(g) + case let .Pow(f, g): + return count(f) + count(g) + case let .Ln(f): + return count(f) + } +} + +func nest_aux (_ s : UInt32, _ f : (_ n : UInt32, _ e : Expr) -> Expr, _ n : UInt32, _ x : Expr) -> Expr { + if n == 0 { + return x + } else { + let x = f(s - n, x) + return nest_aux(s, f, n-1, x) + } +} + +func nest (_ f : (_ n : UInt32, _ e : Expr) -> Expr, _ n : UInt32, _ e : Expr) -> Expr { + return nest_aux(n, f, n, e) +} + +func deriv (_ i : UInt32, _ f : Expr) -> Expr { + let e = d("x", f) + print(i+1, " count: ", count(e)) + return e +} + +var num: UInt32? = 10 +if CommandLine.arguments.count >= 2 { + num = UInt32(CommandLine.arguments[1]) +} + +let x = Expr.Var("x") +let f = pow(x, x) +let e = nest(deriv, num!, f) diff --git a/koka_bench/swift/nqueens.swift b/koka_bench/swift/nqueens.swift new file mode 100644 index 0000000..01e4cf9 --- /dev/null +++ b/koka_bench/swift/nqueens.swift @@ -0,0 +1,253 @@ +indirect enum List { + case Nil + case Cons(T,List) +} + +func len( _ xs : List ) -> Int64 { + var n : Int64 = 0; + var cur : List = xs + while true { + switch(cur) { + case .Nil: return n + case let .Cons(_,xx): do { + n += 1 + cur = xx + } + } + } +} + +func safe( _ queen : Int64, _ xs : List ) -> Bool { + var cur : List = xs + var diag : Int64 = 1 + while true { + switch(cur) { + case .Nil: return true + case let .Cons(q,xx): do { + if (queen == q || queen == (q + diag) || queen == (q - diag)) { + return false + } + diag += 1 + cur = xx + } + } + } +} + +// todo: use while? +func appendSafe( _ k : Int64, _ soln : List, _ solns : List> ) -> List> { + var acc = solns + var n = k + while(n > 0) { + if (safe(n,soln)) { + acc = .Cons(.Cons(n,soln),acc) + } + n -= 1; + } + return acc +} + + +func extend( _ n : Int64, _ solns : List> ) -> List> { + var acc : List> = .Nil + var cur = solns + while(true) { + switch(cur) { + case .Nil: return acc + case let .Cons(soln,rest): do { + acc = appendSafe(n,soln,acc) + cur = rest + } + } + } +} + +func findSolutions(_ n : Int64 ) -> List> { + var k = 0 + var acc : List> = .Cons(.Nil,.Nil) + while( k < n ) { + acc = extend(n,acc) + k += 1 + } + return acc +} + +func nqueens(_ n : Int64) -> Int64 { + return len(findSolutions(n)) +} + +var num: Int64? = 13 +if CommandLine.arguments.count >= 2 { + num = Int64(CommandLine.arguments[1]) +} +print(nqueens(num!)) + +/* +len xs + = len' xs 0 + +len' xs acc + = case xs of + Nil -> acc + Cons _ t -> len' t $! (acc+1) + +safe queen diag xs + = case xs of + Nil -> True + Cons q t -> queen /= q && queen /= q + diag && queen /= q - diag && safe queen (diag + 1) t + +appendSafe k soln solns + = if (k <= 0) + then solns + else if safe k 1 soln + then appendSafe (k-1) soln (Cons (Cons k soln) solns) + else appendSafe (k-1) soln solns + + +extend n acc solns + = case solns of + Nil -> acc + Cons soln rest -> extend n (appendSafe n soln acc) rest + +find_solutions n k + = if k == 0 + then Cons Nil Nil + else extend n Nil (find_solutions n (k-1)) + +-- fst_solution n = head (find_solutions n n) + +queens n + = len (find_solutions n n) + +main + = print (queens 13) + + +enum Color { + case Red + case Black +} + +indirect enum Tree { + case Leaf + case Node(Color, Tree, UInt64, Bool, Tree) +} + +func balance1(_ kv : UInt64, _ vv : Bool, _ t : Tree, _ n : Tree) -> Tree { + switch n { + case let .Node(_, .Node(.Red, l, kx, vx, r1), ky, vy, r2): + return .Node(.Red, .Node(.Black, l, kx, vx, r1), ky, vy, .Node(.Black, r2, kv, vv, t)) + case let .Node(_, l1, ky, vy, .Node(.Red, l2, kx, vx, r)): + return .Node(.Red, .Node(.Black, l1, ky, vy, l2), kx, vx, .Node(.Black, r, kv, vv, t)) + case let .Node(_, l, ky, vy, r): + return .Node(.Black, .Node(.Red, l, ky, vy, r), kv, vv, t) + default: + return .Leaf + } +} + +func balance2(_ t : Tree, _ kv : UInt64, _ vv : Bool, _ n : Tree) -> Tree { + switch n { + case let .Node(_, .Node(.Red, l, kx1, vx1, r1), ky, vy, r2): + return .Node(.Red, .Node(.Black, t, kv, vv, l), kx1, vx1, .Node(.Black, r1, ky, vy, r2)) + case let .Node(_, l1, ky, vy, .Node(.Red, l2, kx2, vx2, r2)): + return .Node(.Red, .Node(.Black, t, kv, vv, l1), ky, vy, .Node(.Black, l2, kx2, vx2, r2)) + case let .Node (_, l, ky, vy, r): + return .Node(.Black, t, kv, vv, .Node(.Red, l, ky, vy, r)) + default: + return .Leaf + } +} + +func is_red (_ t : Tree) -> Bool { + switch t { + case .Node(.Red, _, _, _, _): + return true + default: + return false + } +} + +func ins(_ t : Tree, _ kx : UInt64, _ vx : Bool) -> Tree { + switch t { + case .Leaf: + return .Node(.Red, .Leaf, kx, vx, .Leaf) + case let .Node(.Red, a, ky, vy, b): + if kx < ky { + return .Node(.Red, ins(a, kx, vx), ky, vy, b) + } else if ky == kx { + return .Node(.Red, a, kx, vx, b) + } else { + return .Node(.Red, a, ky, vy, ins(b, kx, vx)) + } + case let .Node(.Black, a, ky, vy, b): + if kx < ky { + if is_red(a) { + return balance1(ky, vy, b, ins(a, kx, vx)) + } else { + return .Node(.Black, ins(a, kx, vx), ky, vy, b) + } + } else if kx == ky { + return .Node(.Black, a, kx, vx, b) + } else { + if is_red(b) { + return balance2(a, ky, vy, ins(b, kx, vx)) + } else { + return .Node(.Black, a, ky, vy, ins(b, kx, vx)) + } + } + } +} + +func set_black (_ n : Tree) -> Tree { + switch n { + case let .Node (_, l, k, v, r): + return .Node (.Black, l, k, v, r) + default: + return n + } +} + +func insert (_ t : Tree, _ k : UInt64, _ v : Bool) -> Tree { + if is_red(t) { + return set_black(ins(t, k, v)) + } else { + return ins(t, k, v) + } +} + +func fold (_ f : (_ k : UInt64, _ v : Bool, _ d : UInt64) -> UInt64, _ n : Tree, _ d : UInt64) -> UInt64 { + switch n { + case .Leaf: + return d + case let .Node(_, l, k, v, r): + return fold(f, r, f(k, v, fold(f, l, d))) + } +} + +func mk_map (_ n : UInt64) -> Tree { + var i = n + var m : Tree = .Leaf + while i > 0 { + i = i - 1 + m = insert(m, i, (i%10 == 0)) + } + return m +} + +func aux (_ k : UInt64, _ v : Bool, _ r : UInt64) -> UInt64 { + if v { + return r + 1 + } else { + return r + } +} + +var num: UInt64? = 4200000 +if CommandLine.arguments.count >= 2 { + num = UInt64(CommandLine.arguments[1]) +} +let m = mk_map(num!) +let v = fold(aux, m, 0) +print(v) +*/ diff --git a/koka_bench/swift/rbtree.swift b/koka_bench/swift/rbtree.swift new file mode 100644 index 0000000..949cfb9 --- /dev/null +++ b/koka_bench/swift/rbtree.swift @@ -0,0 +1,127 @@ +enum Color { + case Red + case Black +} + +indirect enum Tree { + case Leaf + case Node(Color, Tree, UInt64, Bool, Tree) +} + +func balance1(_ kv : UInt64, _ vv : Bool, _ t : Tree, _ n : Tree) -> Tree { + switch n { + case let .Node(_, .Node(.Red, l, kx, vx, r1), ky, vy, r2): + return .Node(.Red, .Node(.Black, l, kx, vx, r1), ky, vy, .Node(.Black, r2, kv, vv, t)) + case let .Node(_, l1, ky, vy, .Node(.Red, l2, kx, vx, r)): + return .Node(.Red, .Node(.Black, l1, ky, vy, l2), kx, vx, .Node(.Black, r, kv, vv, t)) + case let .Node(_, l, ky, vy, r): + return .Node(.Black, .Node(.Red, l, ky, vy, r), kv, vv, t) + default: + return .Leaf + } +} + +func balance2(_ t : Tree, _ kv : UInt64, _ vv : Bool, _ n : Tree) -> Tree { + switch n { + case let .Node(_, .Node(.Red, l, kx1, vx1, r1), ky, vy, r2): + return .Node(.Red, .Node(.Black, t, kv, vv, l), kx1, vx1, .Node(.Black, r1, ky, vy, r2)) + case let .Node(_, l1, ky, vy, .Node(.Red, l2, kx2, vx2, r2)): + return .Node(.Red, .Node(.Black, t, kv, vv, l1), ky, vy, .Node(.Black, l2, kx2, vx2, r2)) + case let .Node (_, l, ky, vy, r): + return .Node(.Black, t, kv, vv, .Node(.Red, l, ky, vy, r)) + default: + return .Leaf + } +} + +func is_red (_ t : Tree) -> Bool { + switch t { + case .Node(.Red, _, _, _, _): + return true + default: + return false + } +} + +func ins(_ t : Tree, _ kx : UInt64, _ vx : Bool) -> Tree { + switch t { + case .Leaf: + return .Node(.Red, .Leaf, kx, vx, .Leaf) + case let .Node(.Red, a, ky, vy, b): + if kx < ky { + return .Node(.Red, ins(a, kx, vx), ky, vy, b) + } else if ky == kx { + return .Node(.Red, a, kx, vx, b) + } else { + return .Node(.Red, a, ky, vy, ins(b, kx, vx)) + } + case let .Node(.Black, a, ky, vy, b): + if kx < ky { + if is_red(a) { + return balance1(ky, vy, b, ins(a, kx, vx)) + } else { + return .Node(.Black, ins(a, kx, vx), ky, vy, b) + } + } else if kx == ky { + return .Node(.Black, a, kx, vx, b) + } else { + if is_red(b) { + return balance2(a, ky, vy, ins(b, kx, vx)) + } else { + return .Node(.Black, a, ky, vy, ins(b, kx, vx)) + } + } + } +} + +func set_black (_ n : Tree) -> Tree { + switch n { + case let .Node (_, l, k, v, r): + return .Node (.Black, l, k, v, r) + default: + return n + } +} + +func insert (_ t : Tree, _ k : UInt64, _ v : Bool) -> Tree { + if is_red(t) { + return set_black(ins(t, k, v)) + } else { + return ins(t, k, v) + } +} + +func fold (_ f : (_ k : UInt64, _ v : Bool, _ d : UInt64) -> UInt64, _ n : Tree, _ d : UInt64) -> UInt64 { + switch n { + case .Leaf: + return d + case let .Node(_, l, k, v, r): + return fold(f, r, f(k, v, fold(f, l, d))) + } +} + +func mk_map (_ n : UInt64) -> Tree { + var i = n + var m : Tree = .Leaf + while i > 0 { + i = i - 1 + m = insert(m, i, (i%10 == 0)) + } + return m +} + +func aux (_ k : UInt64, _ v : Bool, _ r : UInt64) -> UInt64 { + if v { + return r + 1 + } else { + return r + } +} + +var num: UInt64? = 4200000 +if CommandLine.arguments.count >= 2 { + num = UInt64(CommandLine.arguments[1]) +} +let m = mk_map(num!) +let v = fold(aux, m, 0) +print(v)