From 7a663bcabe63a1fa5c3d691123194cfbad112562 Mon Sep 17 00:00:00 2001
From: zapashcanon <leo@ndrs.fr>
Date: Tue, 22 Oct 2024 22:39:53 +0200
Subject: [PATCH] more runtime

---
 wasm/imports.wat          | 43 +++++++++++++++------
 wasm/runtime.wat          | 10 +++++
 wasm/test/binary_trees.ml | 48 +++++++++++-------------
 wasm/test/main.js         | 78 ++++++++++++++++++---------------------
 wasm/test/main_node.mjs   | 25 ++-----------
 wasm/test/test.sh         |  5 +--
 6 files changed, 104 insertions(+), 105 deletions(-)

diff --git a/wasm/imports.wat b/wasm/imports.wat
index ee2a3c277..ce39b3dca 100644
--- a/wasm/imports.wat
+++ b/wasm/imports.wat
@@ -28,6 +28,9 @@
   (import "runtime" "string_eq"
     (func $string_eq (param $a (ref eq)) (param $b (ref eq)) (result (ref eq))))
 
+  (import "runtime" "string_neq"
+    (func $string_neq (param $a (ref eq)) (param $b (ref eq)) (result (ref eq))))
+
   ;; (import "js_runtime" "memory"
           (memory $mem 1)
   ;; )
@@ -132,6 +135,7 @@
 
   (export "caml_bytes_equal" (func $string_eq))
   (export "caml_string_equal" (func $string_eq))
+  (export "caml_string_notequal" (func $string_eq))
 
    ;; Stolen from Jerome's wasm_of_ocaml
    (func $compare_strings
@@ -197,7 +201,7 @@
   ;; ==========
 
   ;; int < block < unknown
-  (func (export "caml_compare") (param $a (ref eq)) (param $b (ref eq)) (result (ref eq))
+  (func $compare (export "caml_compare") (param $a (ref eq)) (param $b (ref eq)) (result (ref eq))
     (local $a_block (ref $Gen_block))
     (local $b_block (ref $Gen_block))
     (if (result (ref i31)) (ref.test (ref i31) (local.get $a))
@@ -322,9 +326,7 @@
 
 
   (func (export "caml_notequal") (param (ref eq)) (param (ref eq)) (result (ref eq))
-    local.get 0
-    local.get 1
-    call $caml_equal
+    (call $caml_equal (local.get 0) (local.get 1))
     ref.cast (ref i31)
     i31.get_s
     i32.eqz
@@ -332,16 +334,35 @@
   )
 
   (func (export "caml_lessequal") (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; TODO
-      (unreachable))
+    (i32.le_s
+      (i31.get_s (ref.cast (ref i31) (call $compare (local.get 0) (local.get 1))))
+      (i32.const 0)
+    )
+    ref.i31
+  )
 
   (func (export "caml_greaterequal") (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; TODO
-      (unreachable))
+    (i32.ge_s
+      (i31.get_s (ref.cast (ref i31) (call $compare (local.get 0) (local.get 1))))
+      (i32.const 0)
+    )
+    ref.i31
+  )
 
-  (func $C_caml_greaterthan (export "caml_greaterthan")
-        (param (ref eq) (ref eq)) (result (ref eq))
-    unreachable
+  (func $C_caml_greaterthan (export "caml_greaterthan") (param (ref eq)) (param (ref eq)) (result (ref eq))
+    (i32.gt_s
+      (i31.get_s (ref.cast (ref i31) (call $compare (local.get 0) (local.get 1))))
+      (i32.const 0)
+    )
+    ref.i31
+  )
+
+  (func $C_caml_lessthan (export "caml_lessthan") (param (ref eq)) (param (ref eq)) (result (ref eq))
+    (i32.lt_s
+      (i31.get_s (ref.cast (ref i31) (call $compare (local.get 0) (local.get 1))))
+      (i32.const 0)
+    )
+    ref.i31
   )
 
 
diff --git a/wasm/runtime.wat b/wasm/runtime.wat
index 9fa580184..8f8e9ed0a 100644
--- a/wasm/runtime.wat
+++ b/wasm/runtime.wat
@@ -251,11 +251,21 @@
     (unreachable)
   )
 
+  (func $string_neq (param $a (ref $String)) (param $b (ref $String)) (result i32)
+    (call $string_eq (local.get $a) (local.get $b))
+    i32.eqz
+  )
+
   (func (export "string_eq") (param $a (ref eq)) (param $b (ref eq)) (result (ref eq))
     (ref.i31
       (call $string_eq (ref.cast (ref $String) (local.get $a)) (ref.cast (ref $String) (local.get $b))))
   )
 
+  (func (export "string_neq") (param $a (ref eq)) (param $b (ref eq)) (result (ref eq))
+    (ref.i31
+      (call $string_neq (ref.cast (ref $String) (local.get $a)) (ref.cast (ref $String) (local.get $b))))
+  )
+
 
   ;; ==========
   ;; Exceptions
diff --git a/wasm/test/binary_trees.ml b/wasm/test/binary_trees.ml
index 070e4f92e..2779fd68f 100644
--- a/wasm/test/binary_trees.ml
+++ b/wasm/test/binary_trees.ml
@@ -10,16 +10,22 @@ type 'a tree =
   | Node of 'a tree * 'a * 'a tree
 
 let rec make i d =
-  (* if d = 0 then Empty *)
   if d = 0
   then Node (Empty, i, Empty)
   else
-    let i2 = 2 * i and d = d - 1 in
-    Node (make (i2 - 1) d, i, make i2 d)
+    let i2 = 2 * i in
+    let d = d - 1 in
+    let l = make (i2 - 1) in
+    let r = make i2 d in
+    let l = l d in
+    Node (l, i, r)
 
 let rec check = function
   | Empty -> 0
-  | Node (l, i, r) -> i + check l - check r
+  | Node (l, i, r) ->
+    let l = check l in
+    let r = check r in
+    i + l + r
 
 let min_depth = 4
 
@@ -27,36 +33,26 @@ let max_depth =
   let n = 10 in
   max (min_depth + 2) n
 
-let stretch_depth = max_depth + 1
-
-let () =
-  (* Gc.set { (Gc.get()) with Gc.minor_heap_size = 1024 * 1024; max_overhead = -1; }; *)
-  let _c = check (make 0 stretch_depth) in
-  ( (*
-  Printf.printf "stretch tree of depth %i\t check: %i\n" stretch_depth c
- *) )
-
 let long_lived_tree = make 0 max_depth
 
 let loop_depths d =
   for i = 0 to ((max_depth - d) / 2) + 1 - 1 do
     let d = d + (i * 2) in
-    let niter = 1 lsl (max_depth - d + min_depth) in
+    let r_lsl = max_depth - d + min_depth in
+    let niter = 1 lsl r_lsl in
     let c = ref 0 in
     for i = 1 to niter do
-      c := !c + check (make i d) + check (make (-i) d)
+      let a = check (make i d) in
+      let b = check (make (-i) d) in
+      c := !c + a + b;
     done;
-    ( (*
-      Printf.printf "%i\t trees of depth %i\t check: %i\n" (2 * niter) d !c;
- *) )
+    print_int (2 * niter);
+    print_string " trees of depth ";
+    print_int d;
+    print_string " check ";
+    print_int !c;
+    print_string "\n"
   done
 
 let () =
-  (*
-  flush stdout;
-*)
-  loop_depths min_depth;
-  ( (*
-  Printf.printf "long lived tree of depth %i\t check: %i\n"
-    max_depth (check long_lived_tree)
- *) )
+  loop_depths min_depth
diff --git a/wasm/test/main.js b/wasm/test/main.js
index 46fc5387f..3dfe71e17 100644
--- a/wasm/test/main.js
+++ b/wasm/test/main.js
@@ -1,72 +1,64 @@
-
 const memory = new WebAssembly.Memory({
   initial: 1,
   maximum: 1,
 });
 
 function print_string(str) {
-        console.log('print_string');
-        var res = "";
-        for (i = 0; i < get_length(str); i++) {
-            res = res + String.fromCharCode(get_char(str, i));
-        }
-        console.log(res);
-    };
-var str_buff = "";
-function print_string_mem(off, len) {
-        // console.log('print_string_mem');
-        const buff = new Uint8Array(memory.buffer);
-        // console.log(buff);
-        var i = 0;
-        for (i = 0; i < len; i++) {
-            var char = String.fromCharCode(buff[i+off]);
-            str_buff = str_buff + char;
-        }
-    };
+  let res = "";
+  for (i = 0; i < get_length(str); i++) {
+    res = res + String.fromCharCode(get_char(str, i));
+  }
+  console.log(res);
+};
+
+let str_buff = "";
 
 function print_i32(arg) {
-        str_buff = str_buff + arg.toString();
-    };
+  str_buff = str_buff + arg.toString();
+};
+
 function print_f64(arg) {
-        console.log(arg);
-    };
+  console.log(arg);
+};
 
 function print_endline() {
-    console.log(str_buff);
-    str_buff = "";
+  console.log(str_buff);
+  str_buff = "";
 }
 
 function putchar(i_char) {
-    var char = String.fromCharCode(i_char);
-    str_buff = str_buff + char;
+  let char = String.fromCharCode(i_char);
+  str_buff = str_buff + char;
 };
 
 function flush() {
-    console.log(str_buff);
-    str_buff = "";
+  console.log(str_buff);
+  str_buff = "";
 }
 
 const bindings = {
-    "print_i32": print_i32,
-    "print_f64": print_f64,
-    "print_string": print_string,
-    "print_string_mem": print_string_mem,
-    "print_endline": print_endline,
-    "putchar": putchar,
-    "flush": flush,
-    "memory": memory
+  "print_i32": print_i32,
+  "print_f64": print_f64,
+  "print_string": print_string,
+  "print_endline": print_endline,
+  "putchar": putchar,
+  "flush": flush,
+  "atan2": Math.atan2,
+  "sin": Math.sin,
+  "asin": Math.asin,
+  "fmod": (x, y) => x % y,
+  "cos": Math.cos,
 }
 
 const src = "./a.out.wasm"
 const code = fetch(src, {
-    // ...
     referrerPolicy: "unsafe-url"
 });
-const imports = {"js_runtime":bindings}
+const imports = {
+  "js_runtime" : bindings
+}
+
 const wasmModule = await WebAssembly.instantiateStreaming(code, imports).then(module => {
-    console.log("module loaded! listing its exports:");
-    for (let key in module.instance.exports) {
-            console.log(key);
-    }
+    console.log("module loaded!");
     console.log("done!");
 });
diff --git a/wasm/test/main_node.mjs b/wasm/test/main_node.mjs
index 5042f821c..45497f0ae 100644
--- a/wasm/test/main_node.mjs
+++ b/wasm/test/main_node.mjs
@@ -1,10 +1,5 @@
 import { readFile } from 'fs/promises';
 
-const memory = new WebAssembly.Memory({
-  initial: 1,
-  maximum: 1,
-});
-
 function print_string(str) {
   let res = "";
   for (let i = 0; i < get_length(str); i++) {
@@ -15,14 +10,6 @@ function print_string(str) {
 
 let str_buff = "";
 
-function print_string_mem(off, len) {
-  const buff = new Uint8Array(memory.buffer);
-  for (let i = off; i < len + off; i++) {
-    let char = String.fromCharCode(buff[i]);
-    str_buff = str_buff + char;
-  }
-};
-
 function print_i32(arg) {
   str_buff = str_buff + arg.toString();
 };
@@ -50,11 +37,9 @@ const bindings = {
   "print_i32": print_i32,
   "print_f64": print_f64,
   "print_string": print_string,
-  "print_string_mem": print_string_mem,
   "print_endline": print_endline,
   "putchar": putchar,
   "flush": flush,
-  "memory": memory,
   "atan2": Math.atan2,
   "sin": Math.sin,
   "asin": Math.asin,
@@ -65,17 +50,13 @@ const bindings = {
 const src = "./a.out.wasm"
 
 const code = await readFile(src);
-const imports = {"js_runtime":bindings}
-
+const imports = {
+  "js_runtime" : bindings
+}
 
 async function f() {
 
   const wasmModule = await WebAssembly.instantiate(code, imports).then(module => {
-    //process.stdout.write("module loaded!");
-    //for (let key in module.instance.exports) {
-    //  process.stdout.write(key);
-    //}
-    //process.stdout.write("done!");
   });
 }
 
diff --git a/wasm/test/test.sh b/wasm/test/test.sh
index 2dfb58a97..8f07a2a2f 100755
--- a/wasm/test/test.sh
+++ b/wasm/test/test.sh
@@ -77,12 +77,11 @@ bench() {
   echo ""
 }
 
-
 #bench "Almabench" "almabench" # global init must have correct type
-#bench "Binary Trees" "binary_trees" # unreachable
+bench "Binary Trees" "binary_trees" # unreachable
 #bench "Boyer" "boyer" # unreachable
 #bench "Boyer no exceptions" "boyer_no_exc" # unreachable
-#bench "Pfannkuchen" "fannkuch" # unreachable
+bench "Pfannkuchen" "fannkuch" # unreachable
 #bench "Pfannkuchen 2" "fannkuch2" # missing "caml_string_notequal" and "caml_lessthan"
 #bench "Fast Fourier Transform" "fft" # unreachable
 #bench "Hamming" "hamming" # missing value let-rec