miloignis/kraken
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add java ocaml and swift tests

Browse Source
This commit is contained in:
Nathan Braswell
2022-05-19 00:43:27 -04:00
parent 62c0958006
commit fefae631e2
21 changed files with 1675 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
koka_bench/CMakeLists.txt
View File

@@ -12,3 +12,6 @@ add_subdirectory(kraken)
add_subdirectory(koka) add_subdirectory(koka)
add_subdirectory(cpp) add_subdirectory(cpp)
add_subdirectory(haskell) add_subdirectory(haskell)
add_subdirectory(java)
add_subdirectory(ocaml)
add_subdirectory(swift)

11
koka_bench/cfold_table.md
View File

@@ -1,6 +1,9 @@
| Command | Mean [ms] | Min [ms] | Max [ms] | Relative | | 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/kraken/out/bench/kraken-cfold 5` | 24.4 ± 0.8 | 22.9 | 26.8 | 56.36 ± 42.56 |
| `build/cpp/cpp-cfold 5` | 0.9 ± 0.3 | 0.6 | 3.0 | 1.75 ± 1.02 | | `build/java/out/bench/cfold 5` | 73.5 ± 8.4 | 57.5 | 85.0 | 170.13 ± 129.81 |
| `build/haskell/hs-cfold 5` | 0.8 ± 0.3 | 0.6 | 2.5 | 1.60 ± 0.91 | | `build/ocaml/ml-cfold 5` | 0.4 ± 0.2 | 0.2 | 2.2 | 1.03 ± 0.96 |
| `build/koka/out/bench/kk-cfold 5` | 0.5 ± 0.2 | 0.3 | 2.1 | 1.00 | | `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 |

11
koka_bench/deriv_table.md
View File

@@ -1,6 +1,9 @@
| Command | Mean [s] | Min [s] | Max [s] | Relative | | 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/kraken/out/bench/kraken-deriv 8` | 3.559 ± 0.014 | 3.536 | 3.582 | 236.58 ± 13.05 |
| `build/cpp/cpp-deriv 8` | 0.020 ± 0.001 | 0.020 | 0.022 | 1.24 ± 0.05 | | `build/java/out/bench/deriv 8` | 0.112 ± 0.020 | 0.085 | 0.131 | 7.45 ± 1.41 |
| `build/haskell/hs-deriv 8` | 0.036 ± 0.001 | 0.035 | 0.037 | 2.15 ± 0.08 | | `build/ocaml/ml-deriv 8` | 0.015 ± 0.001 | 0.014 | 0.018 | 1.00 |
| `build/koka/out/bench/kk-deriv 8` | 0.016 ± 0.001 | 0.016 | 0.021 | 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 |

22
koka_bench/java/CMakeLists.txt Normal file
View File

@@ -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 ()

156
koka_bench/java/cfold.java Normal file
View File

@@ -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 );
}
}

235
koka_bench/java/deriv.java Normal file
View File

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

78
koka_bench/java/nqueens.java Normal file
View File

@@ -0,0 +1,78 @@
class List<T> {
T head;
List<T> tail;
List(T h, List<T> t) {
head = h;
tail = t;
}
static <T> int len( List<T> xs ) {
int n = 0;
while(xs != null) {
n++;
xs = xs.tail;
}
return n;
}
static<T> List<T> Cons( T h, List<T> t ) {
return new List<T>(h,t);
}
}
public class nqueens {
static boolean safe( int queen, List<Integer> 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<List<Integer>> appendSafe( int k, List<Integer> soln, List<List<Integer>> solns ) {
List<List<Integer>> acc = solns;
while(k > 0) {
if (safe(k,soln)) {
acc = List.Cons(List.Cons(k,soln),acc);
}
k--;
}
return acc;
}
static List<List<Integer>> extend( int n, List<List<Integer>> solns ) {
List<List<Integer>> acc = null;
List<List<Integer>> cur = solns;
while(cur != null) {
acc = appendSafe(n, cur.head, acc);
cur = cur.tail;
}
return acc;
}
static List<List<Integer>> findSolutions( int n ) {
int k = 0;
List<List<Integer>> 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])) );
}
}

159
koka_bench/java/rbtree.java Normal file
View File

@@ -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])) );
}
}

11
koka_bench/java_wrapper.sh Executable file
View File

@@ -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"

39
koka_bench/ocaml/CMakeLists.txt Normal file
View File

@@ -0,0 +1,39 @@
#see <https://github.com/ocaml-multicore/multicore-opam> 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} "$<SHELL_PATH:${CMAKE_CURRENT_SOURCE_DIR}/${source}>"
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 ()

72
koka_bench/ocaml/cfold.ml Normal file
View File

@@ -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;;

85
koka_bench/ocaml/deriv.ml Normal file
View File

@@ -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;;

24
koka_bench/ocaml/nqueens.ml Normal file
View File

@@ -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)));;

72
koka_bench/ocaml/rbtree.ml Normal file
View File

@@ -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));;

13
koka_bench/rbnqueens_table.md
View File

@@ -1,7 +1,10 @@
| Command | Mean [s] | Min [s] | Max [s] | Relative | | 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/kraken/out/bench/kraken-nqueens 10` | 2.225 ± 0.016 | 2.187 | 2.246 | 480.72 ± 59.09 |
| `build/cpp/cpp-nqueens 10` | 0.006 ± 0.000 | 0.006 | 0.008 | 1.36 ± 0.14 | | `build/java/out/bench/nqueens 10` | 0.057 ± 0.005 | 0.053 | 0.070 | 12.37 ± 1.92 |
| `build/haskell/hs-nqueens 10` | 0.035 ± 0.000 | 0.035 | 0.037 | 8.02 ± 0.70 | | `build/ocaml/ml-nqueens 10` | 0.005 ± 0.001 | 0.004 | 0.007 | 1.03 ± 0.17 |
| `build/koka/out/bench/kk-nqueens 10` | 0.004 ± 0.000 | 0.004 | 0.006 | 1.00 | | `build/swift/sw-nqueens 10` | 0.016 ± 0.001 | 0.015 | 0.018 | 3.48 ± 0.45 |
| `build/koka/out/bench/kk-nqueens-int 10` | 0.007 ± 0.001 | 0.006 | 0.009 | 1.52 ± 0.19 | | `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 |

13
koka_bench/rbtree_table.md
View File

@@ -1,7 +1,10 @@
| Command | Mean [s] | Min [s] | Max [s] | Relative | | 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-opt 42000` | 3.924 ± 0.196 | 3.786 | 4.307 | 863.93 ± 83.96 |
| `build/kraken/out/bench/kraken-rbtree 42000` | 4.082 ± 0.015 | 4.063 | 4.103 | 933.07 ± 97.15 | | `build/kraken/out/bench/kraken-rbtree 42000` | 4.116 ± 0.105 | 4.070 | 4.415 | 906.34 ± 79.00 |
| `build/cpp/cpp-rbtree 42000` | 0.006 ± 0.001 | 0.005 | 0.008 | 1.27 ± 0.19 | | `build/java/out/bench/rbtree 42000` | 0.086 ± 0.010 | 0.075 | 0.130 | 18.96 ± 2.79 |
| `build/haskell/hs-rbtree 42000` | 0.016 ± 0.001 | 0.016 | 0.018 | 3.72 ± 0.41 | | `build/ocaml/ml-rbtree 42000` | 0.008 ± 0.000 | 0.008 | 0.010 | 1.80 ± 0.18 |
| `build/koka/out/bench/kk-rbtree 42000` | 0.004 ± 0.000 | 0.004 | 0.007 | 1.00 | | `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 |

30
koka_bench/swift/CMakeLists.txt Normal file
View File

@@ -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} "$<SHELL_PATH:${CMAKE_CURRENT_SOURCE_DIR}/${source}>"
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 ()

103
koka_bench/swift/cfold.swift Normal file
View File

@@ -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₂)

176
koka_bench/swift/deriv.swift Normal file
View File

@@ -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)

253
koka_bench/swift/nqueens.swift Normal file
View File

@@ -0,0 +1,253 @@
indirect enum List<T> {
case Nil
case Cons(T,List<T>)
}
func len<T>( _ xs : List<T> ) -> Int64 {
var n : Int64 = 0;
var cur : List<T> = xs
while true {
switch(cur) {
case .Nil: return n
case let .Cons(_,xx): do {
n += 1
cur = xx
}
}
}
}
func safe( _ queen : Int64, _ xs : List<Int64> ) -> Bool {
var cur : List<Int64> = 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<Int64>, _ solns : List<List<Int64>> ) -> List<List<Int64>> {
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<Int64>> ) -> List<List<Int64>> {
var acc : List<List<Int64>> = .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<List<Int64>> {
var k = 0
var acc : List<List<Int64>> = .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)
*/

127
koka_bench/swift/rbtree.swift Normal file
View File

@@ -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)