From 24d0e16e6eec118b5ce2ffeb53daa255f0ab6492 Mon Sep 17 00:00:00 2001
From: zapashcanon <leo@ndrs.fr>
Date: Fri, 11 Oct 2024 23:11:41 +0200
Subject: [PATCH 1/7] fmt

---
 wasm/emit_wat.ml | 2 +-
 wasm/wexpr.ml    | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/wasm/emit_wat.ml b/wasm/emit_wat.ml
index e08c62b6d..1c16391ed 100644
--- a/wasm/emit_wat.ml
+++ b/wasm/emit_wat.ml
@@ -2088,7 +2088,7 @@ module ToWasm = struct
     | Abs_float -> Cst.node "f64.abs" [ arg ]
     | Neg_float -> Cst.node "f64.neg" [ arg ]
     | Tuple_extract { arity; field } ->
-        C.tuple_extract ~arity ~field arg
+      C.tuple_extract ~arity ~field arg
 
   let irelop_name nn (op : Expr.irelop) =
     match op with
diff --git a/wasm/wexpr.ml b/wasm/wexpr.ml
index 9fde1b670..c6ff636ea 100644
--- a/wasm/wexpr.ml
+++ b/wasm/wexpr.ml
@@ -346,7 +346,7 @@ let print_unop ppf = function
   | Abs_float -> Format.fprintf ppf "Abs_float"
   | Neg_float -> Format.fprintf ppf "Neg_float"
   | Tuple_extract { arity = _; field = i } ->
-      Format.fprintf ppf "Tuple_extract.%i" i
+    Format.fprintf ppf "Tuple_extract.%i" i
 
 let rec print ppf = function
   | Var l -> Local.print ppf l

From 4d446c572ed05d9431fa692cef39983cb65dfd13 Mon Sep 17 00:00:00 2001
From: zapashcanon <leo@ndrs.fr>
Date: Sat, 12 Oct 2024 00:29:22 +0200
Subject: [PATCH 2/7] remove tuples

---
 wasm/emit_wat.ml |  91 ++++++++-----------------
 wasm/wat.ml      |   2 -
 wasm/wexpr.ml    | 173 ++++-------------------------------------------
 wasm/wmodule.ml  |  72 --------------------
 wasm/wtype.ml    |  24 -------
 5 files changed, 41 insertions(+), 321 deletions(-)

diff --git a/wasm/emit_wat.ml b/wasm/emit_wat.ml
index 1c16391ed..a27ca4b0f 100644
--- a/wasm/emit_wat.ml
+++ b/wasm/emit_wat.ml
@@ -84,18 +84,22 @@ module Conv = struct
     let function_call_handling handler ~tail call : Expr.t =
       if tail then call
       else
-        let var = Local.fresh "call_result" in
+        let var1 = Local.fresh "call_result1" in
+        let var2 = Local.fresh "call_result2" in
+
         let body : Expr.t =
           If_then_else
-            { cond = Unop (Tuple_extract { arity = 2; field = 0 }, Var (V var))
+            { cond = Var (V var1)
             ; if_expr =
-                NR (raise handler (Unop (Tuple_extract { arity = 2; field = 1 }, Var (V var))))
-            ; else_expr = Unop (Tuple_extract { arity = 2; field = 1 }, Var (V var))
+                NR (raise handler (Var (V var2)))
+            ; else_expr = Var (V var2)
             }
         in
-        Let
-          { var
-          ; typ = Type.Tuple [ I32; ref_eq ]
+        Let2
+          { var1
+          ; var2
+          ; typ1 = I32
+          ; typ2 = ref_eq
           ; defining_expr = call
           ; body
           }
@@ -2087,8 +2091,6 @@ module ToWasm = struct
       Cst.node name [ arg ]
     | Abs_float -> Cst.node "f64.abs" [ arg ]
     | Neg_float -> Cst.node "f64.neg" [ arg ]
-    | Tuple_extract { arity; field } ->
-      C.tuple_extract ~arity ~field arg
 
   let irelop_name nn (op : Expr.irelop) =
     match op with
@@ -2127,6 +2129,11 @@ module ToWasm = struct
     | Let { var; typ = _; defining_expr; body } ->
       C.local_set (Expr.Local.V var) (conv_expr_group defining_expr)
       :: conv_expr body
+    | Let2 { var1; typ1 = _; var2; typ2 = _; defining_expr; body } ->
+      C.local_set (Expr.Local.V var1)
+        (C.local_set (Expr.Local.V var2)
+            (conv_expr_group defining_expr))
+      :: conv_expr body
     | I32 i -> [ C.i32 i ]
     | I64 i -> [ C.i64 i ]
     | F64 f -> [ C.f64 f ]
@@ -2141,18 +2148,11 @@ module ToWasm = struct
     | Call_ref { typ; args; func; tail } ->
       let args = List.map conv_expr_group args @ [ conv_expr_group func ] in
       if tail then [ C.return_call_ref typ args ] else [ C.call_ref typ args ]
-    | Call { typ; args; func; tail } ->
+    | Call { typ = _; args; func; tail } ->
       let args = List.map conv_expr_group args in
       if tail then
-        (* This should be
-           {[ [ C.return_call func args ] ]}
-           But return call is not handled by the gc branch so we play a trick
-           with return_call_ref
-        *)
-        let _ = typ in
         (* TODO do something about C calls that does not return exceptions ? *)
         [ C.return_call func args ]
-        (* [ C.return_call_ref typ (args @ [ C.ref_func func ]) ] *)
       else [ C.call func args ]
     | Ref_cast { typ; r } -> [ C.ref_cast typ [ conv_expr_group r ] ]
     | Global_get g -> [ C.global_get g ]
@@ -2171,45 +2171,16 @@ module ToWasm = struct
           C.block cont result_types [ C.br fallthrough [ conv_expr_group body ] ]
         in
         let handler_expr = conv_expr handler in
-        (*
-        match mode with
-        | Reference ->
-          let handler =
-            List.map
-              (fun (var, _typ) ->
-                  match var with
-                  | Some var -> C.local_set' (Expr.Local.V var)
-                  | None -> C.drop' )
-              params
-            @ handler_expr
-          in
-          [ C.block fallthrough [ ref_eq ] (body :: handler) ]
-        | Binarien ->
-            *)
-        let set_locals =
-          match params with
-          | [] -> [ body ]
-          | [ (None, _typ) ] -> [ C.drop body ]
-          | [ (Some var, _typ) ] -> [ C.local_set (Expr.Local.V var) body ]
-          | _ ->
-            let arity = List.length params in
-            let local_tuple = Expr.Local.Block_result cont in
-            let _i, assigns =
-              List.fold_left
-                (fun (i, assigns) (var, _typ) ->
-                    match var with
-                    | Some var ->
-                      let project =
-                        C.tuple_extract ~arity ~field:i (C.local_get (Expr.Local.V local_tuple))
-                      in
-                      let expr = C.local_set (Expr.Local.V var) project in
-                      (i + 1, expr :: assigns)
-                    | None -> (i + 1, assigns) )
-                (0, []) params
-            in
-            [ C.local_set (Expr.Local.V local_tuple) body ] @ assigns
+        let handler =
+          List.map
+            (fun (var, _typ) ->
+                match var with
+                | Some var -> C.local_set' (Expr.Local.V var)
+                | None -> C.drop' )
+            params
+          @ handler_expr
         in
-        [ C.block fallthrough [ ref_eq ] (set_locals @ handler_expr) ]
+        [ C.block fallthrough [ ref_eq ] (body :: handler) ]
       end
     | Br_on_cast { value; typ; if_cast; if_else } ->
       [ C.drop (C.br_on_cast if_cast typ (conv_expr_group value)) ]
@@ -2406,11 +2377,8 @@ let output_file ~output_prefix ~module_ =
         output_wat ppf module_;
         Format.fprintf ppf "@\n")
 
-let run ~output_prefix (flambda : Flambda.program) =
+let run (flambda : Flambda.program) =
   State.reset ();
-  let print_everything =
-    match Sys.getenv_opt "WASMPRINT" with None -> false | Some _ -> true
-  in
   let offsets = Wasm_closure_offsets.compute flambda in
   let top_env = Conv.{ offsets } in
   let m = Conv.conv_body top_env flambda.program_body [] in
@@ -2425,10 +2393,7 @@ let run ~output_prefix (flambda : Flambda.program) =
   in
   let functions = Conv.conv_functions ~top_env flambda in
   let m = closure_types @ m @ functions in
-  if print_everything then
-    Format.printf "WASM %s@.%a@." output_prefix Module.print m;
   let common = Conv.make_common () in
-  if print_everything then Format.printf "COMMON@.%a@." Module.print common;
   let wasm =
     Profile.record_call "ToWasm" (fun () -> ToWasm.conv_module (common @ m))
   in
@@ -2438,7 +2403,7 @@ let run ~output_prefix (flambda : Flambda.program) =
   Wat.{ module_ = wasm }
 
 let emit ~to_file ~output_prefix (flambda : Flambda.program) =
-  let r = run ~output_prefix flambda in
+  let r = run flambda in
   if to_file then
     Profile.record_call "output_wasm" (fun () ->
       output_file ~output_prefix ~module_:r.module_  );
diff --git a/wasm/wat.ml b/wasm/wat.ml
index 1b0403f1f..74eb481c1 100644
--- a/wasm/wat.ml
+++ b/wasm/wat.ml
@@ -360,8 +360,6 @@ module C = struct
   let opt_tuple fields =
     [ tuple_make fields ]
 
-  let tuple_extract ~arity ~field tuple = node "tuple.extract" [ int arity; int field; tuple ]
-
   let rec_ l = node "rec" l
 
   let import module_ name e = node "import" [ String (module_name module_); String (Wident.acceptable_string name); e ]
diff --git a/wasm/wexpr.ml b/wasm/wexpr.ml
index c6ff636ea..408830269 100644
--- a/wasm/wexpr.ml
+++ b/wasm/wexpr.ml
@@ -102,7 +102,6 @@ type unop =
       }
   | Abs_float
   | Neg_float
-  | Tuple_extract of { field : int; arity : int }
 
 (* Every expression returns exactly one value *)
 type t =
@@ -117,6 +116,14 @@ type t =
       ; defining_expr : t
       ; body : t
       }
+  | Let2 of
+      { var1 : Local.var
+      ; typ1 : Type.atom
+      ; var2 : Local.var
+      ; typ2 : Type.atom
+      ; defining_expr : t
+      ; body : t
+      }
   | If_then_else of
       { cond : t
       ; if_expr : t
@@ -318,165 +325,6 @@ let print_sign ppf = function
   | S -> Format.fprintf ppf "s"
   | U -> Format.fprintf ppf "u"
 
-let print_unop ppf = function
-  | I31_get_s -> Format.fprintf ppf "I31_get_s"
-  | I31_new -> Format.fprintf ppf "I31_new"
-  | Struct_get { typ; field } ->
-    Format.fprintf ppf "@[<hov 2>Struct_get(%a).(%i)@]" Type.Var.print typ field
-  | Struct_get_packed { typ; field; extend } ->
-    let str = match extend with S -> "_s" | U -> "_u" in
-    Format.fprintf ppf "@[<hov 2>Struct_get%s(%a).(%i)@]" str Type.Var.print typ
-      field
-  | Ref_cast_i31 -> Format.fprintf ppf "Ref_cast_i31"
-  | Is_i31 -> Format.fprintf ppf "Is_i31"
-  | Array_len typ ->
-    Format.fprintf ppf "@[<hov 2>Array_len(%a)@]" Type.Var.print typ
-  | Reinterpret { from_type; to_type } ->
-    Format.fprintf ppf "%a.reinterpret_%a" print_num_type to_type print_num_type
-      from_type
-  | I32_wrap_i64 -> Format.fprintf ppf "I32_wrap_i64"
-  | I64_extend_i32 sign ->
-    Format.fprintf ppf "I64_extend_i32_%a" print_sign sign
-  | Convert { from_type; to_type; sign } ->
-    Format.fprintf ppf "f%a.convert_i%a_%a" print_nn to_type print_nn from_type
-      print_sign sign
-  | Trunc { from_type; to_type; sign } ->
-    Format.fprintf ppf "i%a.trunc_i%a_%a" print_nn to_type print_nn from_type
-      print_sign sign
-  | Abs_float -> Format.fprintf ppf "Abs_float"
-  | Neg_float -> Format.fprintf ppf "Neg_float"
-  | Tuple_extract { arity = _; field = i } ->
-    Format.fprintf ppf "Tuple_extract.%i" i
-
-let rec print ppf = function
-  | Var l -> Local.print ppf l
-  | I32 i -> Format.fprintf ppf "%li" i
-  | I64 i -> Format.fprintf ppf "%Li" i
-  | F64 f -> Format.fprintf ppf "%g" f
-  | Ref_func f -> Format.fprintf ppf "Ref_func %a" Func_id.print f
-  | Let { var; defining_expr; body } ->
-    Format.fprintf ppf "@[<hov 2>Let %a =@ %a@]@ in@ %a" Local.print_var var
-      print defining_expr print body
-  | I_relop (nn, op, (arg1, arg2)) ->
-    Format.fprintf ppf "@[<hov 2>I_relop(%a_%a:@ %a,@ %a)@]" print_irelop op
-      print_nn nn print arg1 print arg2
-  | F_relop (nn, op, (arg1, arg2)) ->
-    Format.fprintf ppf "@[<hov 2>F_relop(%a_%a:@ %a,@ %a)@]" print_frelop op
-      print_nn nn print arg1 print arg2
-  | Binop (binop, (arg1, arg2)) ->
-    Format.fprintf ppf "@[<hov 2>Binop(%a:@ %a,@ %a)@]" print_binop binop print
-      arg1 print arg2
-  | Unop (unop, arg) ->
-    Format.fprintf ppf "@[<hov 2>Unop(%a:@ %a)@]" print_unop unop print arg
-  | Struct_new (typ, args) ->
-    Format.fprintf ppf "@[<hov 2>Struct_new(%a:@ %a)@]" Type.Var.print typ
-      (print_list print ",") args
-  | Array_new_fixed { typ; fields } ->
-    Format.fprintf ppf "@[<hov 2>Array_new_fixed(%a:@ %a)@]" Type.Var.print typ
-      (print_list print ",") fields
-  | Call_ref { typ; args; func } ->
-    Format.fprintf ppf "@[<hov 2>Call_ref(%a:@ %a(%a))@]" Type.Var.print typ
-      print func (print_list print ",") args
-  | Call { args; func } ->
-    Format.fprintf ppf "@[<hov 2>Call(%a(%a))@]" Func_id.print func
-      (print_list print ",") args
-  | Ref_cast { typ; r } ->
-    Format.fprintf ppf "@[<hov 2>Ref_cast(%a:@ %a)@]" Type.Var.print typ print r
-  | Global_get g ->
-    Format.fprintf ppf "@[<hov 2>Global_get(%a)@]" Global.print g
-  | Seq (effects, last) ->
-    Format.fprintf ppf "@[<v 2>Seq(%a;%a)@]"
-      (print_list print_no_value ";")
-      effects print last
-  | If_then_else { cond; if_expr; else_expr } ->
-    Format.fprintf ppf "@[<hov 2>If(%a)@ Then(%a)@ Else(%a)@]" print cond print
-      if_expr print else_expr
-  | Let_cont { cont; params; handler; body } ->
-    Format.fprintf ppf "@[<hov 2>Let_cont %a(%a) =@ %a@]@ in@ %a" Block_id.print
-      cont
-      (print_list
-          (fun ppf (local, typ) ->
-              Format.fprintf ppf "%a : %a"
-                (Format.pp_print_option Local.print_var)
-                local Type.print_atom typ )
-          ", " )
-      params print handler print body
-  | Br_on_cast { value; typ; if_cast; if_else } ->
-    Format.fprintf ppf "@[<hov 2>Br_on_cast(%a %a -> (%a) else %a)@]" print
-      value Type.Var.print typ Block_id.print if_cast print if_else
-  | Br_if { cond; if_true; if_else } ->
-    Format.fprintf ppf "@[<hov 2>Br_if(%a -> (%a) else %a)@]" print cond
-      Block_id.print if_true print if_else
-  | Br_table { cond; cases; default } ->
-    Format.fprintf ppf "@[<hov 2>Br_table(%a -> (%a) %a@]" print cond
-      (print_list Block_id.print " ")
-      cases Block_id.print default
-  | Try { body; param = var, typ; result_typ; handler } ->
-    Format.fprintf ppf
-      "@[<v>@[<hov 2>Try -> %a {@ @[<hov 2>%a@ @]}@]@ @[<hov 2>With@ @[<hov \
-       2>%a : %a@ ->@ @[<hov>%a@]@]@]@]"
-      Type.print_atom result_typ print body Local.print_var var Type.print_atom
-      typ print handler
-  | Unit nv -> Format.fprintf ppf "@[<hov 2>Unit (@ %a@ )@]" print_no_value nv
-  | NR nr -> print_no_return ppf nr
-
-and print_no_value ppf no_value =
-  match no_value with
-  | NV_seq effects ->
-    Format.fprintf ppf "@[<v 2>Seq(%a)@]"
-      (print_list print_no_value ";")
-      effects
-  | NV_drop e -> Format.fprintf ppf "@[<hov 2>Drop (@ %a@ )@]" print e
-  | NV_binop (binop, (arg1, arg2)) ->
-    Format.fprintf ppf "@[<hov 2>Binop(%a:@ %a,@ %a)@]" print_nv_binop binop
-      print arg1 print arg2
-  | Assign { being_assigned; new_value } ->
-    Format.fprintf ppf "@[<v 2>Assign(%a <- %a)@]" Local.print_var
-      being_assigned print new_value
-  | Array_set { typ; array; field; value } ->
-    Format.fprintf ppf "@[<hov 2>Array_set(%a:@ %a.(%a) <- %a)@]" Type.Var.print
-      typ print array print field print value
-  | Loop { cont; body } ->
-    Format.fprintf ppf "@[<hov 2>Loop %a@ %a@]" Block_id.print cont
-      print_no_value body
-  | NV -> Format.fprintf ppf "Nil"
-  | NV_if_then_else { cond; if_expr; else_expr } ->
-    Format.fprintf ppf "@[<hov 2>If(%a)Then(%a)Else(%a)@]" print cond
-      print_no_value if_expr print_no_value else_expr
-  | NV_br_if { cond; if_true } ->
-    Format.fprintf ppf "@[<hov 2>Br_if(%a -> (%a))@]" print cond Block_id.print
-      if_true
-  | NV_call { args; func } ->
-    Format.fprintf ppf "@[<hov 2>Call(%a(%a))@]" Func_id.print func
-      (print_list print ",") args
-
-and print_no_return ppf no_return =
-  match no_return with
-  | NR_if_then_else { cond; if_expr; else_expr } ->
-    Format.fprintf ppf "@[<hov 2>If(%a)Then(%a)Else(%a)@]" print cond
-      print_no_return if_expr print_no_return else_expr
-  | NR_br_table { cond; cases; default } ->
-    Format.fprintf ppf "@[<hov 2>Br_table(%a -> (%a) %a@]" print cond
-      (print_list Block_id.print " ")
-      cases Block_id.print default
-  | NR_let_cont { cont; params; handler; body } ->
-    Format.fprintf ppf "@[<hov 2>Let_cont %a(%a) =@ %a@]@ in@ %a" Block_id.print
-      cont
-      (print_list
-          (fun ppf (local, typ) ->
-              Format.fprintf ppf "%a : %a"
-                (Format.pp_print_option Local.print_var)
-                local Type.print_atom typ )
-          ", " )
-      params print_no_return handler print_no_return body
-  | NR_br { cont; args } ->
-    Format.fprintf ppf "@[<hov 2>Br(%a(%a))@]" Block_id.print cont
-      (print_list print ",") args
-  | NR_return args ->
-    Format.fprintf ppf "@[<hov 2>Return(%a)@]" (print_list print ",") args
-  | Throw e -> Format.fprintf ppf "@[<hov 2>Throw (@ %a@ )@]" print e
-  | Unreachable -> Format.fprintf ppf "Unreachable"
-
 let let_ var typ defining_expr body = Let { var; typ; defining_expr; body }
 
 type function_body =
@@ -513,6 +361,11 @@ let required_locals body =
       let acc = add var typ acc in
       let acc = loop acc defining_expr in
       loop acc body
+    | Let2 { var1; var2; typ1; typ2; defining_expr; body } ->
+      let acc = add var1 typ1 acc in
+      let acc = add var2 typ2 acc in
+      let acc = loop acc defining_expr in
+      loop acc body
     | I_relop (_, _, (arg1, arg2))
     | F_relop (_, _, (arg1, arg2))
     | Binop (_, (arg1, arg2)) ->
diff --git a/wasm/wmodule.ml b/wasm/wmodule.ml
index 66a17a10d..23deb1e2c 100644
--- a/wasm/wmodule.ml
+++ b/wasm/wmodule.ml
@@ -4,14 +4,6 @@ module Func_id = Wident.Func_id
 module Global = Wident.Global
 module Expr = Wexpr
 
-let print_list f sep ppf l =
-  Format.pp_print_list
-    ~pp_sep:(fun ppf () -> Format.fprintf ppf "%s@ " sep)
-    f ppf l
-
-let printconv f g ppf e =
-  g ppf (f e)
-
 module Func = struct
   type t =
     | Decl of
@@ -27,29 +19,6 @@ module Func = struct
         ; name : string
         }
 
-  let print ppf = function
-    | Decl { params; body } ->
-      let param ppf (p, typ) =
-        Format.fprintf ppf "(%a: %a)" Param.print p Type.print_atom typ
-      in
-      let print_body ppf = function
-        | Expr.Value [e, typ] ->
-          Format.fprintf ppf " -> %a@ {@ %a@ }" Type.print_atom typ Expr.print e
-        | Expr.Value l ->
-          Format.fprintf ppf " -> %a@ {@ @[<v>%a@]@ }"
-            (print_list (printconv snd Type.print_atom) " ") l
-            (print_list (printconv fst Expr.print) ";") l
-        | Expr.No_value e ->
-          Format.fprintf ppf "@ {@ %a@ }" Expr.print_no_value e
-      in
-      Format.fprintf ppf "@[<hov 2>Func (%a)%a@]" (print_list param ",") params
-        print_body body
-    | Import { params; result; typ = _; module_; name } ->
-      Format.fprintf ppf "@[<hov 2>Import %s %s : (%a) -> %a @]" module_ name
-        (print_list Type.print_atom ",")
-        params
-        (print_list Type.print_atom ",")
-        result
 end
 
 module Const = struct
@@ -79,12 +48,6 @@ module Const = struct
         ; name : string
         }
 
-  let print_field ppf = function
-    | I8 i -> Format.fprintf ppf "i8(%i)" i
-    | I16 i -> Format.fprintf ppf "i16(%i)" i
-    | I31 i -> Format.fprintf ppf "i31(%i)" i
-    | Ref_func f -> Format.fprintf ppf "Ref_func %a" Func_id.print f
-    | Global g -> Format.fprintf ppf "%a" Global.print g
 end
 
 module Decl = struct
@@ -103,43 +66,8 @@ module Decl = struct
         }
     | Const of const
 
-  let print ppf = function
-    | Type (var, descr) ->
-      Format.fprintf ppf "type %a = %a" Type.Var.print var Type.print_descr
-        descr
-    | Type_rec l ->
-      let pp ppf (var, descr) =
-        Format.fprintf ppf "(%a = %a)" Type.Var.print var Type.print_descr descr
-      in
-      Format.fprintf ppf "type_rec %a" (print_list pp "") l
-    | Func { name; descr } ->
-      Format.fprintf ppf "@[<hov 2>func %a =@ %a@]" Func_id.print name
-        Func.print descr
-    | Const { name; descr = Struct { typ; fields } } ->
-      Format.fprintf ppf "@[<hov 2>const %a : %a =@ {%a}@]" Global.print name
-        Type.Var.print typ
-        (print_list Const.print_field ";")
-        fields
-    | Const { name; descr = Array { typ; fields } } ->
-      Format.fprintf ppf "@[<hov 2>const %a : %a =@ [%a]@]" Global.print name
-        Type.Var.print typ
-        (print_list Const.print_field ";")
-        fields
-    | Const { name; descr = Expr { typ; e } } ->
-      Format.fprintf ppf "@[<hov 2>const %a : %a =@ {%a}@]" Global.print name
-        Type.print_atom typ Expr.print e
-    | Const { name; descr = Import { typ; module_; name = import_name } } ->
-      Format.fprintf ppf "@[<hov 2>const %a : %a =@ {%s %s}@]" Global.print name
-        Type.print_atom typ module_ import_name
 end
 
 module Module = struct
   type t = Decl.t list
-
-  let print ppf l =
-    Format.fprintf ppf "@[<v 2>Module {@ %a@ }@]"
-      (Format.pp_print_list
-          ~pp_sep:(fun ppf () -> Format.fprintf ppf "@ ")
-          Decl.print )
-      l
 end
diff --git a/wasm/wtype.ml b/wasm/wtype.ml
index 03cc57ddb..e172b3d61 100644
--- a/wasm/wtype.ml
+++ b/wasm/wtype.ml
@@ -116,27 +116,3 @@ let rec print_atom ppf = function
   | F64 -> Format.fprintf ppf "f64"
   | Rvar v -> Format.fprintf ppf "ref_%a" Var.print v
   | Tuple l -> Format.fprintf ppf "Tuple (%a)" (print_list print_atom " ") l
-
-let print_descr ppf = function
-  | Struct { sub; fields = atoms } ->
-    let pp_sub ppf = function
-      | None -> ()
-      | Some sub -> Format.fprintf ppf "sub: %a;@ " Var.print sub
-    in
-    Format.fprintf ppf "@[<hov 2>Struct {%a%a}@]" pp_sub sub
-      (print_list print_atom ";")
-      atoms
-  | Array { sub; fields = atom } ->
-    let pp_sub ppf = function
-      | None -> ()
-      | Some sub -> Format.fprintf ppf "sub: %a;@ " Var.print sub
-    in
-    Format.fprintf ppf "@[<hov 2>Array {%a%a}@]" pp_sub sub print_atom atom
-  | Func { params; results = [] } ->
-    Format.fprintf ppf "@[<hov 2>Func {%a}@]" (print_list print_atom ",") params
-  | Func { params; results } ->
-    Format.fprintf ppf "@[<hov 2>Func {%a} ->@ %a@]"
-      (print_list print_atom ",")
-      params
-      (print_list print_atom ",")
-      results

From c22217679749ab7b43787ba282b6b311b3f6c850 Mon Sep 17 00:00:00 2001
From: zapashcanon <leo@ndrs.fr>
Date: Thu, 17 Oct 2024 18:25:03 +0200
Subject: [PATCH 3/7] do not use exception runtime when using multi-return, fix
 segfault in node by setting stack size and ulimit correctly

---
 wasm/emit_wat.ml       |  1 +
 wasm/link_wat.ml       | 10 +++++++---
 wasm/runtime.wat       | 11 ++++++++---
 wasm/test/test_node.sh |  8 ++++++--
 wasm/wat.ml            |  5 ++++-
 5 files changed, 26 insertions(+), 9 deletions(-)

diff --git a/wasm/emit_wat.ml b/wasm/emit_wat.ml
index a27ca4b0f..6f19062b7 100644
--- a/wasm/emit_wat.ml
+++ b/wasm/emit_wat.ml
@@ -492,6 +492,7 @@ module Conv = struct
     match e with
     | Var _ | I32 _ | I64 _ | F64 _ | Global_get _ -> true
     | Unop (I31_new, e) -> expr_is_pure e
+    | Let2 { defining_expr; body; _ }
     | Let { defining_expr; body } ->
       expr_is_pure defining_expr && expr_is_pure body
     | _ -> false
diff --git a/wasm/link_wat.ml b/wasm/link_wat.ml
index 7c319e277..ea7fc7e7a 100644
--- a/wasm/link_wat.ml
+++ b/wasm/link_wat.ml
@@ -29,13 +29,17 @@ let options =
   [ "--enable-multivalue"
   ; "--enable-gc"
   ; "--enable-reference-types"
-  ; "--enable-exception-handling"
   ; "--enable-tail-call"
-  ]
+  ] @ match Wstate.exception_repr with
+    | Native_exceptions -> [ "--enable-exception-handling" ]
+    | Multi_return ->  []
 
 let wasm_merge = "wasm-merge"
 
-let runtime = [ "exn_tag"; "runtime"; "imports" ]
+let runtime = [  "runtime"; "imports" ]
+  @ match Wstate.exception_repr with
+    | Native_exceptions -> [ "exn_tag" ]
+    | Multi_return ->  []
 
 let merge_files ~runtime_dir ~text files output =
   let text = if text then [ emit_text ] else [] in
diff --git a/wasm/runtime.wat b/wasm/runtime.wat
index 5374d131f..9fa580184 100644
--- a/wasm/runtime.wat
+++ b/wasm/runtime.wat
@@ -4,7 +4,8 @@
   (type $Array (sub (array (mut (ref eq)))))
   (type $FloatArray (sub (array (mut f64))))
   (type $Gen_block (sub (array (mut (ref eq)))))
-  (import "exn_tag" "exc" (tag $exc (param (ref eq))))
+  ;; TODO: re-enable exception
+  ;;(import "exn_tag" "exc" (tag $exc (param (ref eq))))
 
   ;; ==========
   ;; Exceptions
@@ -216,11 +217,15 @@
               (ref.cast (ref $String) (local.get $arr))
               (local.get $field))))
         (else
-          (throw $exc
+          unreachable
+          ;; TODO: re-enable exception
+          (;(throw $exc
             (array.new_fixed $Gen_block 3
               (ref.i31 (i32.const 0))
               (global.get $invalid_argument)
-              (global.get $index_out_of_bound_string)))))
+              (global.get $index_out_of_bound_string)))
+          ;)
+          ))
   )
 
   (func $string_eq (param $a (ref $String)) (param $b (ref $String)) (result i32)
diff --git a/wasm/test/test_node.sh b/wasm/test/test_node.sh
index 9651b305a..b3ae5323e 100755
--- a/wasm/test/test_node.sh
+++ b/wasm/test/test_node.sh
@@ -4,14 +4,18 @@ set -eu
 
 alias time='/usr/bin/time -f"real %e user %U sys %S"'
 
-NODE='node-canary --stack-size=10000'
+ULIMIT_STACK_SIZE=20000
+STACK_SIZE=10000
+NODE="node-canary --stack-size=${STACK_SIZE}"
+
+ulimit -s $ULIMIT_STACK_SIZE
 
 bench() {
   echo "*** Running ${1}"
   echo -n "Wasocaml (node):            "
   ../../ocamlopt -O3 ./${2}.ml > /dev/null
   time $NODE ./main_node.mjs > /dev/null
-  wasm-opt --enable-gc --enable-reference-types --enable-exception-handling --enable-multivalue --enable-tail-call a.out.wasm -o a.out.wasm -O3
+  wasm-opt --enable-gc --enable-reference-types --enable-multivalue --enable-tail-call a.out.wasm -o a.out.wasm -O3
   echo -n "Wasocaml + wasm-opt (node): "
   time $NODE ./main_node.mjs > /dev/null
   echo -n "OCaml native:               "
diff --git a/wasm/wat.ml b/wasm/wat.ml
index 74eb481c1..f362ab379 100644
--- a/wasm/wat.ml
+++ b/wasm/wat.ml
@@ -371,7 +371,10 @@ module C = struct
       (node "tag" [ !$"exc"; node "param" [ node "ref" [ atom "eq" ] ] ])
 
   let module_ m =
-    let m = import_tag :: m in
+    let m = match Wstate.exception_repr with
+      | Native_exceptions -> import_tag :: m
+      | Multi_return -> m
+    in
     nodev "module" m
 
 end

From d68266134105d4d8bdca52bd89d029420f4e6919 Mon Sep 17 00:00:00 2001
From: Pierre Chambart <pierre.chambart@ocamlpro.com>
Date: Thu, 17 Oct 2024 18:53:08 +0200
Subject: [PATCH 4/7] Fix continuation param order

---
 wasm/emit_wat.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/wasm/emit_wat.ml b/wasm/emit_wat.ml
index a27ca4b0f..97ba38cea 100644
--- a/wasm/emit_wat.ml
+++ b/wasm/emit_wat.ml
@@ -2177,7 +2177,7 @@ module ToWasm = struct
                 match var with
                 | Some var -> C.local_set' (Expr.Local.V var)
                 | None -> C.drop' )
-            params
+            (List.rev params)
           @ handler_expr
         in
         [ C.block fallthrough [ ref_eq ] (body :: handler) ]

From d2f6bcf5921982315ec21e9484aadc3df731325b Mon Sep 17 00:00:00 2001
From: Pierre Chambart <pierre.chambart@ocamlpro.com>
Date: Thu, 17 Oct 2024 18:54:13 +0200
Subject: [PATCH 5/7] Remove remaining tuples

---
 wasm/emit_wat.ml |  1 -
 wasm/wat.ml      | 19 +++----------------
 wasm/wexpr.ml    | 16 ++++++++--------
 wasm/wtype.ml    |  4 +---
 4 files changed, 12 insertions(+), 28 deletions(-)

diff --git a/wasm/emit_wat.ml b/wasm/emit_wat.ml
index 97ba38cea..b85044a89 100644
--- a/wasm/emit_wat.ml
+++ b/wasm/emit_wat.ml
@@ -2320,7 +2320,6 @@ module ToWasm = struct
                     body
                 in
                 let _, typs = List.split body in
-                let exprs = [ C.tuple_make exprs ] in
                 (exprs, List.map C.result typs)
             end
           | No_value body -> (conv_no_value body, [])
diff --git a/wasm/wat.ml b/wasm/wat.ml
index 74eb481c1..6415cb725 100644
--- a/wasm/wat.ml
+++ b/wasm/wat.ml
@@ -243,7 +243,7 @@ module C = struct
   let declare_func f =
     node "elem" [ atom "declare"; atom "func"; !$(Func_id.name f) ]
 
-  let rec type_atom (t : Type.atom) =
+  let type_atom (t : Type.atom) =
     match t with
     | I8 -> atom "i8"
     | I16 -> atom "i16"
@@ -251,14 +251,6 @@ module C = struct
     | I64 -> atom "i64"
     | F64 -> atom "f64"
     | Rvar v -> reft v
-    | Tuple l -> node "tuple" (List.map type_atom l)
-
-  let tuple_make fields =
-    match fields with
-    | [] -> assert false
-    | [ field ] ->  field
-    | fields ->
-      node "tuple.make" (Atom (List.length fields |> string_of_int) :: fields )
 
   let local l t = node "local" [ !$(Expr.Local.var_name l); type_atom t ]
 
@@ -317,15 +309,12 @@ module C = struct
     nodehv "loop" [ !$(Block_id.name id); results result ] body
 
   let br id args =
-    match args with
-    | [] -> node "br" [ !$(Block_id.name id)]
-    | [arg] -> node "br" [ !$(Block_id.name id); arg ]
-    | _ -> node "br" [ !$(Block_id.name id); tuple_make args ]
+    node "br" ((!$(Block_id.name id)) :: args)
 
   let br' id = node "br" [ !$(Block_id.name id) ]
 
   let return args =
-    node "return" [ tuple_make args ]
+    node "return" args
 
   let br_on_cast id typ arg =
     node "br_on_cast" [ !$(Block_id.name id); type_name typ; arg ]
@@ -357,8 +346,6 @@ module C = struct
     | None -> node "sub" [ descr ]
     | Some name -> node "sub" [ type_name name; descr ]
 
-  let opt_tuple fields =
-    [ tuple_make fields ]
 
   let rec_ l = node "rec" l
 
diff --git a/wasm/wexpr.ml b/wasm/wexpr.ml
index 408830269..db9ceb36b 100644
--- a/wasm/wexpr.ml
+++ b/wasm/wexpr.ml
@@ -339,20 +339,20 @@ let required_locals body =
       acc
     | exception Not_found -> Local.Map.add var typ acc
   in
-  let let_cont_reqs acc ~cont ~params =
+  let let_cont_reqs acc ~cont:_ ~params =
     let acc =
       List.fold_left
         (fun acc (var, typ) ->
             match var with None -> acc | Some var -> add var typ acc )
         acc params
     in
-    let acc =
-      match ( params) with
-      | _ :: _ :: _ ->
-        let var = Local.Block_result cont in
-        add var (Type.Tuple (List.map snd params)) acc
-      | _ -> acc
-    in
+    (* let acc = *)
+    (*   match ( params) with *)
+    (*   | _ :: _ :: _ -> *)
+    (*     let var = Local.Block_result cont in *)
+    (*     add var (Type.Tuple (List.map snd params)) acc *)
+    (*   | _ -> acc *)
+    (* in *)
     acc
   in
   let rec loop acc = function
diff --git a/wasm/wtype.ml b/wasm/wtype.ml
index e172b3d61..574d91368 100644
--- a/wasm/wtype.ml
+++ b/wasm/wtype.ml
@@ -92,7 +92,6 @@ type atom =
   | I64
   | F64
   | Rvar of Var.t
-  | Tuple of atom list
 
 type descr =
   | Struct of
@@ -108,11 +107,10 @@ type descr =
       ; results : atom list
       }
 
-let rec print_atom ppf = function
+let print_atom ppf = function
   | I8 -> Format.fprintf ppf "i8"
   | I16 -> Format.fprintf ppf "i16"
   | I32 -> Format.fprintf ppf "i32"
   | I64 -> Format.fprintf ppf "i64"
   | F64 -> Format.fprintf ppf "f64"
   | Rvar v -> Format.fprintf ppf "ref_%a" Var.print v
-  | Tuple l -> Format.fprintf ppf "Tuple (%a)" (print_list print_atom " ") l

From e4c75df2aa9327d44f7c8000118dfe329c3ed2c2 Mon Sep 17 00:00:00 2001
From: zapashcanon <leo@ndrs.fr>
Date: Thu, 17 Oct 2024 19:01:03 +0200
Subject: [PATCH 6/7] update tests

---
 wasm/test/test_node.sh | 42 ++++++++++++++++++++++++++++--------------
 1 file changed, 28 insertions(+), 14 deletions(-)

diff --git a/wasm/test/test_node.sh b/wasm/test/test_node.sh
index b3ae5323e..defff9d98 100755
--- a/wasm/test/test_node.sh
+++ b/wasm/test/test_node.sh
@@ -11,27 +11,41 @@ NODE="node-canary --stack-size=${STACK_SIZE}"
 ulimit -s $ULIMIT_STACK_SIZE
 
 bench() {
-  echo "*** Running ${1}"
-  echo -n "Wasocaml (node):            "
+  echo "*** Running ${1}:"
+
+  echo ""
+
+  echo -n "    OCaml native:               "
+  ocamlopt -O3 ./${2}.ml > /dev/null
+  time ./a.out > /dev/null
+
+  echo -n "    Wasocaml + wasm-opt (node): "
   ../../ocamlopt -O3 ./${2}.ml > /dev/null
-  time $NODE ./main_node.mjs > /dev/null
   wasm-opt --enable-gc --enable-reference-types --enable-multivalue --enable-tail-call a.out.wasm -o a.out.wasm -O3
-  echo -n "Wasocaml + wasm-opt (node): "
   time $NODE ./main_node.mjs > /dev/null
-  echo -n "OCaml native:               "
-  ocamlopt -O3 ./${2}.ml > /dev/null
-  time ./a.out > /dev/null
-  echo -n "OCaml bytecode:             "
+
+  #echo -n "    Wasocaml (node):            "
+  #../../ocamlopt -O3 ./${2}.ml > /dev/null
+  #time $NODE ./main_node.mjs > /dev/null
+
+  echo -n "    wasm_of_ocaml (node):       "
   ocamlc ./${2}.ml > /dev/null
-  time ocamlrun ./a.out > /dev/null
-  echo -n "js_of_ocaml (node):         "
-  js_of_ocaml compile --target-env=nodejs --opt=3 ./a.out
-  time $NODE ./a.js > /dev/null
-  echo -n "wasm_of_ocaml (node):       "
-  rm a.js a.wat || true 2> /dev/null
+  rm -f a.js a.wat || true 2> /dev/null
   wasm_of_ocaml compile --opt=3 ./a.out > /dev/null
   time $NODE ./a.js > /dev/null
   rm -rf a.assets*
+
+  echo -n "    js_of_ocaml (node):         "
+  ocamlc ./${2}.ml > /dev/null
+  rm -f a.js a.wat || true 2> /dev/null
+  js_of_ocaml compile --target-env=nodejs --opt=3 ./a.out
+  time $NODE ./a.js > /dev/null
+
+  echo -n "    OCaml bytecode:             "
+  ocamlc ./${2}.ml > /dev/null
+  time ocamlrun ./a.out > /dev/null
+
+  echo ""
 }
 
 bench "Knuth-Bendix" "kb"

From 8950f2538f204f07f1bfa05c9521c6d33a88a681 Mon Sep 17 00:00:00 2001
From: zapashcanon <leo@ndrs.fr>
Date: Thu, 17 Oct 2024 20:38:31 +0200
Subject: [PATCH 7/7] improve benchmarks and reduce noise by making them longer

---
 wasm/test/bdd.ml          |  13 +-
 wasm/test/boyer.ml        |   1 -
 wasm/test/boyer_no_exc.ml |   1 -
 wasm/test/fannkuch2.ml    |  36 +++--
 wasm/test/fib.ml          |  14 +-
 wasm/test/kb.ml           |   4 +-
 wasm/test/kb_no_exc.ml    | 286 +++++++++++++++++++-------------------
 wasm/test/loop.ml         |   6 +-
 wasm/test/main_node.mjs   |  81 ++++++-----
 wasm/test/quicksort.ml    |   8 +-
 wasm/test/takc.ml         |   6 +-
 wasm/test/taku.ml         |   2 +-
 wasm/test/test_node.sh    |  92 +++++++-----
 13 files changed, 278 insertions(+), 272 deletions(-)

diff --git a/wasm/test/bdd.ml b/wasm/test/bdd.ml
index 7b70eb368..6b5797283 100644
--- a/wasm/test/bdd.ml
+++ b/wasm/test/bdd.ml
@@ -243,21 +243,16 @@ let test_hwb bdd vars =
   eval bdd vars = if !ntrue > 0 then vars.(!ntrue - 1) else false
 
 let main () =
-  let n = 22 in
+  let n = 25 in
   let ntests = 100 in
   let bdd = hwb n in
   let succeeded = ref true in
   for _ = 1 to ntests do
     succeeded := !succeeded && test_hwb bdd (random_vars n)
   done;
-  assert !succeeded
-
-(*
+  assert !succeeded;
   if !succeeded
   then print_string "OK\n"
-  else print_string "FAILED\n";
-Format.eprintf "%d@." !nodeC;
-  exit 0
-*)
+  else print_string "FAILED\n"
 
-let _ = main ()
+let () = main ()
diff --git a/wasm/test/boyer.ml b/wasm/test/boyer.ml
index 1a9ae5f52..c4e4b4271 100644
--- a/wasm/test/boyer.ml
+++ b/wasm/test/boyer.ml
@@ -1206,7 +1206,6 @@ let _ =
     print_string "Proved!\n"
   else
     print_string "Cannot prove!\n";
-  exit 0
 *)
 
 (*********
diff --git a/wasm/test/boyer_no_exc.ml b/wasm/test/boyer_no_exc.ml
index f34575dec..fce3dce46 100644
--- a/wasm/test/boyer_no_exc.ml
+++ b/wasm/test/boyer_no_exc.ml
@@ -1215,7 +1215,6 @@ let _ =
     print_string "Proved!\n"
   else
     print_string "Cannot prove!\n";
-  exit 0
 *)
 
 (*********
diff --git a/wasm/test/fannkuch2.ml b/wasm/test/fannkuch2.ml
index 563580167..0137c7af3 100644
--- a/wasm/test/fannkuch2.ml
+++ b/wasm/test/fannkuch2.ml
@@ -4,6 +4,8 @@
    contributed by Isaac Gouy, transliterated from Mike Pall's Lua program
 *)
 
+exception Done
+
 let fannkuch n =
   let p = Array.make n 0 in
   let q = Array.make n 0 in
@@ -36,19 +38,19 @@ let fannkuch n =
         let qq = q.(!q0) in
         q.(!q0) <- !q0;
         (if !q0 >= 3
-         then
-           let i = ref 1 in
-           let j = ref (!q0 - 1) in
-           while
-             let t = q.(!i) in
-             q.(!i) <- q.(!j);
-             q.(!j) <- t;
-             incr i;
-             decr j;
-             !i < !j
-           do
-             ()
-           done);
+          then
+            let i = ref 1 in
+            let j = ref (!q0 - 1) in
+            while
+              let t = q.(!i) in
+              q.(!i) <- q.(!j);
+              q.(!j) <- t;
+              incr i;
+              decr j;
+              !i < !j
+            do
+              ()
+            done);
         q0 := qq;
         incr flips
       done);
@@ -73,7 +75,7 @@ let fannkuch n =
           if i = n - 1
           then (
             if false then Format.eprintf "%d %d@." !sum !maxflips;
-            exit 0);
+            raise Done);
           s.(i) <- i;
           let t = p.(0) in
           for j = 0 to i do
@@ -86,8 +88,4 @@ let fannkuch n =
 
 let n = 10
 
-let pf = fannkuch n
-
-(*
-//print(pf[0] + "\n" + "Pfannkuchen(" + n + ") = " + pf[1]);
-*)
+let () = try fannkuch n with Done -> ()
diff --git a/wasm/test/fib.ml b/wasm/test/fib.ml
index 903d9850e..629a8083c 100644
--- a/wasm/test/fib.ml
+++ b/wasm/test/fib.ml
@@ -3,14 +3,6 @@ let rec fib n =
   else fib (n - 1) + fib (n - 2)
 
 let () =
-  let n = 40 in
-  assert (fib n = 102334155)
-  (*
-  for i = 0 to 40 do
-    print_string "fib (";
-    print_int i;
-    print_string ") = ";
-    print_int (fib i);
-    print_string "\n"
-  done
-  *)
+  let n = 43 in
+  let res = fib n in
+  print_int res
diff --git a/wasm/test/kb.ml b/wasm/test/kb.ml
index ea8fdd3cc..aeb22a163 100644
--- a/wasm/test/kb.ml
+++ b/wasm/test/kb.ml
@@ -584,5 +584,5 @@ let group_order = rpo group_precedence lex_ext
 let greater pair =
   match group_order pair with Greater -> true | _ -> false
 
-let _ =
-  for i = 1 to 20 do kb_complete greater [] geom_rules done
+let () =
+  for i = 1 to 55 do kb_complete greater [] geom_rules done
diff --git a/wasm/test/kb_no_exc.ml b/wasm/test/kb_no_exc.ml
index 700bfaa42..63b5be00e 100644
--- a/wasm/test/kb_no_exc.ml
+++ b/wasm/test/kb_no_exc.ml
@@ -68,11 +68,11 @@ let rec fold_left2_opt f accu l1 l2 =
 let rec match_rec subst t1 t2 =
   match t1, t2 with
   | Var v, _ ->
-      if List.mem_assoc v subst
-      then if t2 = List.assoc v subst then Some subst else None
-      else Some ((v, t2) :: subst)
+    if List.mem_assoc v subst
+    then if t2 = List.assoc v subst then Some subst else None
+    else Some ((v, t2) :: subst)
   | Term (op1, sons1), Term (op2, sons2) ->
-      if op1 = op2 then fold_left2_opt match_rec subst sons1 sons2 else None
+    if op1 = op2 then fold_left2_opt match_rec subst sons1 sons2 else None
   | _ -> None
 
 let matching term1 term2 = match_rec [] term1 term2
@@ -89,21 +89,21 @@ let rec occurs n = function
 let rec unify term1 term2 =
   match term1, term2 with
   | Var n1, _ ->
-      if term1 = term2
-      then []
-      else if occurs n1 term2
-      then failwith "unify"
-      else [ n1, term2 ]
+    if term1 = term2
+    then []
+    else if occurs n1 term2
+    then failwith "unify"
+    else [ n1, term2 ]
   | term1, Var n2 -> if occurs n2 term1 then failwith "unify" else [ n2, term1 ]
   | Term (op1, sons1), Term (op2, sons2) ->
-      if op1 = op2
-      then
-        List.fold_left2
-          (fun s t1 t2 -> compsubst (unify (substitute s t1) (substitute s t2)) s)
-          []
-          sons1
-          sons2
-      else failwith "unify"
+    if op1 = op2
+    then
+      List.fold_left2
+        (fun s t1 t2 -> compsubst (unify (substitute s t1) (substitute s t2)) s)
+        []
+        sons1
+        sons2
+    else failwith "unify"
 
 (* We need to print terms with variables independently from input terms
    obtained by parsing. We give arbitrary names v1,v2,... to their variables.
@@ -113,39 +113,39 @@ let infixes = [ "+"; "*" ]
 
 let rec pretty_term = function
   | Var n ->
-      print_string "v";
-      print_int n
+    print_string "v";
+    print_int n
   | Term (oper, sons) ->
-      if List.mem oper infixes
-      then
-        match sons with
-        | [ s1; s2 ] ->
-            pretty_close s1;
-            print_string oper;
-            pretty_close s2
-        | _ -> failwith "pretty_term : infix arity <> 2"
-      else (
+    if List.mem oper infixes
+    then
+      match sons with
+      | [ s1; s2 ] ->
+        pretty_close s1;
         print_string oper;
-        match sons with
-        | [] -> ()
-        | t :: lt ->
-            print_string "(";
-            pretty_term t;
-            List.iter
-              (fun t ->
-                print_string ",";
-                pretty_term t)
-              lt;
-            print_string ")")
+        pretty_close s2
+      | _ -> failwith "pretty_term : infix arity <> 2"
+    else (
+      print_string oper;
+      match sons with
+      | [] -> ()
+      | t :: lt ->
+        print_string "(";
+        pretty_term t;
+        List.iter
+          (fun t ->
+              print_string ",";
+              pretty_term t)
+          lt;
+        print_string ")")
 
 and pretty_close = function
   | Term (oper, _) as m ->
-      if List.mem oper infixes
-      then (
-        print_string "(";
-        pretty_term m;
-        print_string ")")
-      else pretty_term m
+    if List.mem oper infixes
+    then (
+      print_string "(";
+      pretty_term m;
+      print_string ")")
+    else pretty_term m
   | m -> pretty_term m
 
 (***********************************************************************)
@@ -179,8 +179,8 @@ let mk_rule num m n =
   let subst =
     List.map
       (fun v ->
-        incr counter;
-        v, Var !counter)
+          incr counter;
+          v, Var !counter)
       (List.rev all_vars)
   in
   { number = num; numvars = !counter; lhs = substitute subst m; rhs = substitute subst n }
@@ -191,8 +191,8 @@ let check_rules rules =
   let counter = ref 0 in
   List.iter
     (fun r ->
-      incr counter;
-      if r.number <> !counter then failwith "Rule numbers not in sequence")
+        incr counter;
+        if r.number <> !counter then failwith "Rule numbers not in sequence")
     rules;
   !counter
 
@@ -318,31 +318,31 @@ let mult_ext order = function
       match diff_eq (eq_ord order) (sons1, sons2) with
       | [], [] -> Equal
       | l1, l2 ->
-          if List.for_all (fun n -> List.exists (fun m -> gt_ord order (m, n)) l1) l2
-          then Greater
-          else NotGE)
+        if List.for_all (fun n -> List.exists (fun m -> gt_ord order (m, n)) l1) l2
+        then Greater
+        else NotGE)
   | _ -> failwith "mult_ext"
 
 (* Lexicographic extension of order *)
 
 let lex_ext order = function
   | (Term (_, sons1) as m), (Term (_, sons2) as n) ->
-      let rec lexrec = function
-        | [], [] -> Equal
-        | [], _ -> NotGE
-        | _, [] -> Greater
-        | x1 :: l1, x2 :: l2 -> (
-            match order (x1, x2) with
-            | Greater ->
-                if List.for_all (fun n' -> gt_ord order (m, n')) l2
-                then Greater
-                else NotGE
-            | Equal -> lexrec (l1, l2)
-            | NotGE ->
-                if List.exists (fun m' -> ge_ord order (m', n)) l1 then Greater else NotGE
-            )
-      in
-      lexrec (sons1, sons2)
+    let rec lexrec = function
+      | [], [] -> Equal
+      | [], _ -> NotGE
+      | _, [] -> Greater
+      | x1 :: l1, x2 :: l2 -> (
+          match order (x1, x2) with
+          | Greater ->
+            if List.for_all (fun n' -> gt_ord order (m, n')) l2
+            then Greater
+            else NotGE
+          | Equal -> lexrec (l1, l2)
+          | NotGE ->
+            if List.exists (fun m' -> ge_ord order (m', n)) l1 then Greater else NotGE
+        )
+    in
+    lexrec (sons1, sons2)
   | _ -> failwith "lex_ext"
 
 (* Recursive path ordering *)
@@ -360,14 +360,14 @@ let rpo op_order ext =
           | Term (op2, sons2) -> (
               match op_order op1 op2 with
               | Greater ->
-                  if List.for_all (fun n' -> gt_ord rporec (m, n')) sons2
-                  then Greater
-                  else NotGE
+                if List.for_all (fun n' -> gt_ord rporec (m, n')) sons2
+                then Greater
+                else NotGE
               | Equal -> ext rporec (m, n)
               | NotGE ->
-                  if List.exists (fun m' -> ge_ord rporec (m', n)) sons1
-                  then Greater
-                  else NotGE))
+                if List.exists (fun m' -> ge_ord rporec (m', n)) sons1
+                then Greater
+                else NotGE))
   in
   rporec
 
@@ -395,8 +395,8 @@ let rec super m = function
       let rec collate n = function
         | [] -> []
         | son :: rest ->
-            List.map (fun (u, subst) -> n :: u, subst) (super m son)
-            @ collate (n + 1) rest
+          List.map (fun (u, subst) -> n :: u, subst) (super m son)
+          @ collate (n + 1) rest
       in
       let insides = collate 1 sons in
       try ([], unify m n) :: insides with Failure _ -> insides)
@@ -413,13 +413,13 @@ let rec super m = function
 
 let super_strict m = function
   | Term (_, sons) ->
-      let rec collate n = function
-        | [] -> []
-        | son :: rest ->
-            List.map (fun (u, subst) -> n :: u, subst) (super m son)
-            @ collate (n + 1) rest
-      in
-      collate 1 sons
+    let rec collate n = function
+      | [] -> []
+      | son :: rest ->
+        List.map (fun (u, subst) -> n :: u, subst) (super m son)
+        @ collate (n + 1) rest
+    in
+    collate 1 sons
   | _ -> []
 
 (* Critical pairs of l1=r1 with l2=r2 *)
@@ -464,8 +464,8 @@ let non_orientable (m, n) =
 let rec partition p = function
   | [] -> [], []
   | x :: l ->
-      let l1, l2 = partition p l in
-      if p x then x :: l1, l2 else l1, x :: l2
+    let l1, l2 = partition p l in
+    if p x then x :: l1, l2 else l1, x :: l2
 
 let rec get_rule n = function
   | [] -> raise Not_found
@@ -477,11 +477,11 @@ let kb_completion greater =
   let rec kbrec j rules =
     let rec process failures (k, l) eqs =
       (* {[
-            print_string "***kb_completion "; print_int j; print_newline();
-            pretty_rules rules;
-            List.iter non_orientable failures;
-            print_int k; print_string " "; print_int l; print_newline();
-            List.iter non_orientable eqs;
+           print_string "***kb_completion "; print_int j; print_newline();
+           pretty_rules rules;
+           List.iter non_orientable failures;
+           print_int k; print_string " "; print_int l; print_newline();
+           List.iter non_orientable eqs;
          ]}
       *)
       match eqs with
@@ -494,44 +494,44 @@ let kb_completion greater =
             match failures with
             | [] -> rules (* successful completion *)
             | _ ->
-                print_string "Non-orientable equations :";
-                print_newline ();
-                List.iter non_orientable failures;
-                failwith "kb_completion")
+              print_string "Non-orientable equations :";
+              print_newline ();
+              List.iter non_orientable failures;
+              failwith "kb_completion")
       | (m, n) :: eqs ->
-          let m' = mrewrite_all rules m
-          and n' = mrewrite_all rules n
-          and enter_rule (left, right) =
-            let new_rule = mk_rule (j + 1) left right in
-            pretty_rule new_rule;
-            let left_reducible rule = reducible left rule.lhs in
-            let redl, irredl = partition left_reducible rules in
-            List.iter deletion_message redl;
-            let right_reduce rule =
-              mk_rule rule.number rule.lhs (mrewrite_all (new_rule :: rules) rule.rhs)
-            in
-            let irreds = List.map right_reduce irredl in
-            let eqs' = List.map (fun rule -> rule.lhs, rule.rhs) redl in
-            kbrec (j + 1) (new_rule :: irreds) [] (k, l) (eqs @ eqs' @ failures)
+        let m' = mrewrite_all rules m
+        and n' = mrewrite_all rules n
+        and enter_rule (left, right) =
+          let new_rule = mk_rule (j + 1) left right in
+          pretty_rule new_rule;
+          let left_reducible rule = reducible left rule.lhs in
+          let redl, irredl = partition left_reducible rules in
+          List.iter deletion_message redl;
+          let right_reduce rule =
+            mk_rule rule.number rule.lhs (mrewrite_all (new_rule :: rules) rule.rhs)
           in
-          (* {[
-                print_string "--- Considering "; non_orientable (m', n');
-             ]}
-          *)
-          if m' = n'
-          then process failures (k, l) eqs
-          else if greater (m', n')
-          then enter_rule (m', n')
-          else if greater (n', m')
-          then enter_rule (n', m')
-          else process ((m', n') :: failures) (k, l) eqs
+          let irreds = List.map right_reduce irredl in
+          let eqs' = List.map (fun rule -> rule.lhs, rule.rhs) redl in
+          kbrec (j + 1) (new_rule :: irreds) [] (k, l) (eqs @ eqs' @ failures)
+        in
+        (* {[
+             print_string "--- Considering "; non_orientable (m', n');
+           ]}
+        *)
+        if m' = n'
+        then process failures (k, l) eqs
+        else if greater (m', n')
+        then enter_rule (m', n')
+        else if greater (n', m')
+        then enter_rule (n', m')
+        else process ((m', n') :: failures) (k, l) eqs
     and next_criticals failures (k, l) =
       (*
          {[
-            print_string "***next_criticals ";
-            print_int k; print_string " "; print_int l ; print_newline();
+           print_string "***next_criticals ";
+           print_int k; print_string " "; print_int l ; print_newline();
          ]}
-       *)
+      *)
       try
         let rl = get_rule l rules in
         let el = rl.lhs, rl.rhs in
@@ -575,17 +575,17 @@ let kb_complete greater complete_rules rules =
 (* $Id: kbmain.ml 7017 2005-08-12 09:22:04Z xleroy $ *)
 
 (*
-  {[
-      let group_rules = [
-        { number = 1; numvars = 1;
-          lhs = Term("*", [Term("U",[]); Var 1]); rhs = Var 1 };
-        { number = 2; numvars = 1;
-          lhs = Term("*", [Term("I",[Var 1]); Var 1]); rhs = Term("U",[]) };
-        { number = 3; numvars = 3;
-          lhs = Term("*", [Term("*", [Var 1; Var 2]); Var 3]);
-          rhs = Term("*", [Var 1; Term("*", [Var 2; Var 3])]) }
-      ]
-  ]}
+   {[
+     let group_rules = [
+       { number = 1; numvars = 1;
+         lhs = Term("*", [Term("U",[]); Var 1]); rhs = Var 1 };
+       { number = 2; numvars = 1;
+         lhs = Term("*", [Term("I",[Var 1]); Var 1]); rhs = Term("U",[]) };
+       { number = 3; numvars = 3;
+         lhs = Term("*", [Term("*", [Var 1; Var 2]); Var 3]);
+         rhs = Term("*", [Var 1; Term("*", [Var 2; Var 3])]) }
+     ]
+   ]}
 *)
 
 let geom_rules =
@@ -594,22 +594,22 @@ let geom_rules =
     ; numvars = 1
     ; lhs = Term ("*", [ Term ("I", [ Var 1 ]); Var 1 ])
     ; rhs = Term ("U", [])
-    }
+  }
   ; { number = 3
     ; numvars = 3
     ; lhs = Term ("*", [ Term ("*", [ Var 1; Var 2 ]); Var 3 ])
     ; rhs = Term ("*", [ Var 1; Term ("*", [ Var 2; Var 3 ]) ])
-    }
+  }
   ; { number = 4
     ; numvars = 0
     ; lhs = Term ("*", [ Term ("A", []); Term ("B", []) ])
     ; rhs = Term ("*", [ Term ("B", []); Term ("A", []) ])
-    }
+  }
   ; { number = 5
     ; numvars = 0
     ; lhs = Term ("*", [ Term ("C", []); Term ("C", []) ])
     ; rhs = Term ("U", [])
-    }
+  }
   ; { number = 6
     ; numvars = 0
     ; lhs =
@@ -617,9 +617,9 @@ let geom_rules =
           ( "*"
           , [ Term ("C", [])
             ; Term ("*", [ Term ("A", []); Term ("I", [ Term ("C", []) ]) ])
-            ] )
+          ] )
     ; rhs = Term ("I", [ Term ("A", []) ])
-    }
+  }
   ; { number = 7
     ; numvars = 0
     ; lhs =
@@ -627,9 +627,9 @@ let geom_rules =
           ( "*"
           , [ Term ("C", [])
             ; Term ("*", [ Term ("B", []); Term ("I", [ Term ("C", []) ]) ])
-            ] )
+          ] )
     ; rhs = Term ("B", [])
-    }
+  }
   ]
 
 let group_rank = function
@@ -652,7 +652,7 @@ let greater pair =
   | Greater -> true
   | _ -> false
 
-let _ =
-  for _ = 1 to 20 do
+let () =
+  for _ = 1 to 85 do
     kb_complete greater [] geom_rules
   done
diff --git a/wasm/test/loop.ml b/wasm/test/loop.ml
index 2df20f77d..7d3d85c65 100644
--- a/wasm/test/loop.ml
+++ b/wasm/test/loop.ml
@@ -1,3 +1,5 @@
-for _ = 1 to 1000000000 do
-  ()
+for _ = 1 to 3 do
+  for _ = 1 to 1_000_000_000 do
+    ()
+  done
 done
diff --git a/wasm/test/main_node.mjs b/wasm/test/main_node.mjs
index f56507ef7..04bfaa704 100644
--- a/wasm/test/main_node.mjs
+++ b/wasm/test/main_node.mjs
@@ -6,59 +6,58 @@ const memory = new WebAssembly.Memory({
 });
 
 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 = "";
+  let res = "";
+  for (let i = 0; i < get_length(str); i++) {
+    res = res + String.fromCharCode(get_char(str, i));
+  }
+  process.stdout.write(res);
+};
+
+let 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;
-        }
-    };
+  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();
-    };
+  str_buff = str_buff + arg.toString();
+};
+
 function print_f64(arg) {
-        console.log(arg);
-    };
+  process.stdout.write(arg);
+};
 
 function print_endline() {
-    console.log(str_buff);
-    str_buff = "";
+  process.stdout.write(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 = "";
+  process.stdout.write(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,
-    "atan2": Math.atan2,
-    "sin": Math.sin,
-    "cos": Math.cos,
+  "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,
+  "cos": Math.cos,
 }
 
 const src = "./a.out.wasm"
@@ -70,11 +69,11 @@ const imports = {"js_runtime":bindings}
 async function f() {
 
   const wasmModule = await WebAssembly.instantiate(code, imports).then(module => {
-    console.log("module loaded!");
+    //process.stdout.write("module loaded!");
     //for (let key in module.instance.exports) {
-    //  console.log(key);
+    //  process.stdout.write(key);
     //}
-    //console.log("done!");
+    //process.stdout.write("done!");
   });
 }
 
diff --git a/wasm/test/quicksort.ml b/wasm/test/quicksort.ml
index c8f935c62..51cd16412 100644
--- a/wasm/test/quicksort.ml
+++ b/wasm/test/quicksort.ml
@@ -102,9 +102,7 @@ let test_sort sort_fun size =
 (*print_string "failed"; print_newline()*)
 
 let main () =
-  test_sort qsort 500000;
-  test_sort qsort2 500000
+  test_sort qsort 2500000;
+  test_sort qsort2 2500000
 
-let _ = main ()
-
-(*exit 0*)
+let () = main ()
diff --git a/wasm/test/takc.ml b/wasm/test/takc.ml
index 332807588..90079504f 100644
--- a/wasm/test/takc.ml
+++ b/wasm/test/takc.ml
@@ -17,8 +17,4 @@ let rec tak x y z =
 
 let rec repeat n accu = if n <= 0 then accu else repeat (n - 1) (tak 18 12 6 + accu)
 
-let _ = assert (repeat 2000 0 = 14000)
-
-(*
- print_int (repeat 2000); print_newline(); exit 0
-*)
+let () = print_int (repeat 20000 0); print_newline ()
diff --git a/wasm/test/taku.ml b/wasm/test/taku.ml
index 3266521ff..316429beb 100644
--- a/wasm/test/taku.ml
+++ b/wasm/test/taku.ml
@@ -17,4 +17,4 @@ let rec tak (x, y, z) =
 
 let rec repeat n accu = if n <= 0 then accu else repeat (n - 1) (tak (18, 12, 6) + accu)
 
-let _ = assert (repeat 2000 0 = 14000)
+let () = print_int (repeat 20000 0)
diff --git a/wasm/test/test_node.sh b/wasm/test/test_node.sh
index defff9d98..d7057b950 100755
--- a/wasm/test/test_node.sh
+++ b/wasm/test/test_node.sh
@@ -10,61 +10,89 @@ NODE="node-canary --stack-size=${STACK_SIZE}"
 
 ulimit -s $ULIMIT_STACK_SIZE
 
-bench() {
-  echo "*** Running ${1}:"
-
-  echo ""
+#UNSAFE="-unsafe"
+UNSAFE=""
 
+bench_native() {
   echo -n "    OCaml native:               "
-  ocamlopt -O3 ./${2}.ml > /dev/null
-  time ./a.out > /dev/null
+  ocamlopt $UNSAFE -O3 ./${2}.ml > /dev/null
+  time ./a.out > output_${2}_ocaml_native.txt
+}
 
+bench_wasocaml_opt() {
   echo -n "    Wasocaml + wasm-opt (node): "
-  ../../ocamlopt -O3 ./${2}.ml > /dev/null
-  wasm-opt --enable-gc --enable-reference-types --enable-multivalue --enable-tail-call a.out.wasm -o a.out.wasm -O3
-  time $NODE ./main_node.mjs > /dev/null
+  ../../ocamlopt $UNSAFE -O3 ./${2}.ml > /dev/null
+  wasm-opt --enable-gc --enable-reference-types --enable-multivalue --enable-tail-call --enable-nontrapping-float-to-int --traps-never-happen --skip-pass=inlining-optimizing a.out.wasm -o a.out.wasm -O3
+  time $NODE ./main_node.mjs > output_${2}_wasocaml_opt.txt
+  diff output_${2}_ocaml_native.txt output_${2}_wasocaml_opt.txt
+}
 
-  #echo -n "    Wasocaml (node):            "
-  #../../ocamlopt -O3 ./${2}.ml > /dev/null
-  #time $NODE ./main_node.mjs > /dev/null
+bench_wasocaml() {
+  echo -n "    Wasocaml (node):            "
+  ../../ocamlopt $UNSAFE -O3 ./${2}.ml > /dev/null
+  time $NODE ./main_node.mjs > output_${2}_wasocaml.txt
+  diff output_${2}_ocaml_native.txt output_${2}_wasocaml.txt
+}
 
+bench_wsoo() {
   echo -n "    wasm_of_ocaml (node):       "
-  ocamlc ./${2}.ml > /dev/null
-  rm -f a.js a.wat || true 2> /dev/null
+  ocamlc $UNSAFE ./${2}.ml > /dev/null
+  rm -rf a.assets* a.js a.wat || true 2> /dev/null
   wasm_of_ocaml compile --opt=3 ./a.out > /dev/null
-  time $NODE ./a.js > /dev/null
-  rm -rf a.assets*
+  time $NODE ./a.js > output_${2}_wsoo.txt
+  diff output_${2}_ocaml_native.txt output_${2}_wsoo.txt
+}
 
+bench_jsoo() {
   echo -n "    js_of_ocaml (node):         "
-  ocamlc ./${2}.ml > /dev/null
+  ocamlc $UNSAFE ./${2}.ml > /dev/null
   rm -f a.js a.wat || true 2> /dev/null
   js_of_ocaml compile --target-env=nodejs --opt=3 ./a.out
-  time $NODE ./a.js > /dev/null
+  time $NODE ./a.js > output_${2}_jsoo.txt
+  diff output_${2}_ocaml_native.txt output_${2}_jsoo.txt
+}
 
+bench_bytecode() {
   echo -n "    OCaml bytecode:             "
-  ocamlc ./${2}.ml > /dev/null
-  time ocamlrun ./a.out > /dev/null
+  ocamlc $UNSAFE ./${2}.ml > /dev/null
+  time ocamlrun ./a.out > output_${2}_bytecode.txt
+  diff output_${2}_ocaml_native.txt output_${2}_bytecode.txt
+}
+
+bench() {
+  echo "*** Running ${1}:"
+
+  echo ""
+
+  bench_native "${1}" "${2}"
+  bench_wasocaml_opt "${1}" "${2}"
+  #bench_wasocaml "${1}" "${2}"
+  bench_wsoo "${1}" "${2}"
+  bench_jsoo "${1}" "${2}"
+  bench_bytecode "${1}" "${2}"
 
   echo ""
 }
 
-bench "Knuth-Bendix" "kb"
-bench "Knuth-Bendix (no exception)" "kb_no_exc"
-bench "Soli" "soli"
-bench "Fibonacci" "fib"
+
 #bench "Almabench" "almabench" # global init must have correct type
-bench "Binary Decision Diagram" "bdd"
 #bench "Binary Trees" "binary_trees" # unreachable
 #bench "Boyer" "boyer" # unreachable
 #bench "Boyer no exceptions" "boyer_no_exc" # unreachable
 #bench "Pfannkuchen" "fannkuch" # unreachable
-#bench "Pfannkuchen 2" "fannkuch2" # unreachable
-#bench "Fast Fourier Transform" "fft"
-#bench "Hamming" "hamming"
-bench "Loop" "loop"
+#bench "Pfannkuchen 2" "fannkuch2" # missing "caml_string_notequal" and "caml_lessthan"
+#bench "Fast Fourier Transform" "fft" # unreachable
+#bench "Hamming" "hamming" # missing value let-rec
 #bench "Nucleic" "nucleic" # unreachable
-#bench "Quicksort" "quicksort"
-#bench "Ray-Trace" "raytrace"
-#bench "Splay Tree" "splay"
+#bench "Ray-Trace" "raytrace" # global init must have correct type
+#bench "Splay Tree" "splay" # unreachable
+
+bench "Knuth-Bendix" "kb"
+bench "Knuth-Bendix (no exception)" "kb_no_exc"
+bench "Soli" "soli"
+bench "Fibonacci" "fib"
+bench "Binary Decision Diagram" "bdd"
+bench "Loop" "loop"
 bench "Takc" "takc"
 bench "Taku" "taku"
+bench "Quicksort" "quicksort"