Add java ocaml and swift tests

2022-05-19 00:43:27 -04:00
parent 62c0958006
commit fefae631e2
21 changed files with 1675 additions and 18 deletions
--- a/koka_bench/swift/CMakeLists.txt
+++ 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} "$<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 ()
--- a/koka_bench/swift/cfold.swift
+++ 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₂)
--- a/koka_bench/swift/deriv.swift
+++ 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)
--- a/koka_bench/swift/nqueens.swift
+++ b/koka_bench/swift/nqueens.swift
@@ -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)
+*/
--- a/koka_bench/swift/rbtree.swift
+++ 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)