From 87d3a379dca6dd42573701efdb59003e476848eb Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Wed, 8 Feb 2023 16:29:42 +0100
Subject: [PATCH 1/8] [interpreter] Enable nesting of invocations and gets

---
 interpreter/README.md        |  10 ++-
 interpreter/script/js.ml     | 141 +++++++++++++++++++++++------------
 interpreter/script/js.mli    |   2 +
 interpreter/script/run.ml    |  24 +++---
 interpreter/script/script.ml |   7 +-
 interpreter/text/arrange.ml  |  11 ++-
 interpreter/text/parser.mly  |  10 ++-
 test/core/script.wast        |  61 +++++++++++++++
 8 files changed, 201 insertions(+), 65 deletions(-)
 create mode 100644 test/core/script.wast

diff --git a/interpreter/README.md b/interpreter/README.md
index 18aa36c05e..b5bf095f3b 100644
--- a/interpreter/README.md
+++ b/interpreter/README.md
@@ -391,10 +391,14 @@ module:
   ( module <name>? quote <string>* )         ;; module quoted in text (may be malformed)
 
 action:
-  ( invoke <name>? <string> <const>* )       ;; invoke function export
+  ( invoke <name>? <string> <arg>* )         ;; invoke function export
   ( get <name>? <string> )                   ;; get global export
 
-const:
+arg:
+  <literal>                                  ;; literal argument
+  <action>                                   ;; expression argument
+
+literal:
   ( <num_type>.const <num> )                 ;; number value
   ( <vec_type> <vec_shape> <num>+ )          ;; vector value
   ( ref.null <ref_kind> )                    ;; null reference
@@ -410,7 +414,7 @@ assertion:
   ( assert_trap <module> <failure> )         ;; assert module traps on instantiation
 
 result:
-  <const>
+  <literal>
   ( <num_type>.const <num_pat> )
   ( <vec_type>.const <vec_shape> <num_pat>+ )
   ( ref.extern )
diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml
index 2eb849a6c1..e26f921e8a 100644
--- a/interpreter/script/js.ml
+++ b/interpreter/script/js.ml
@@ -188,6 +188,13 @@ function assert_return(action, ...expected) {
 |}
 
 
+(* Errors & Tracing *)
+
+module Error = Error.Make ()
+
+exception Error = Error.Error
+
+
 (* Context *)
 
 module NameMap = Map.Make(struct type t = Ast.name let compare = compare end)
@@ -217,12 +224,26 @@ let bind (mods : modules) x_opt m =
 let lookup (mods : modules) x_opt name at =
   let exports =
     try Map.find (of_var_opt mods x_opt) mods.env with Not_found ->
-      raise (Eval.Crash (at, 
-        if x_opt = None then "no module defined within script"
-        else "unknown module " ^ of_var_opt mods x_opt ^ " within script"))
+      Error.error at 
+        (if x_opt = None then "no module defined within script"
+         else "unknown module " ^ of_var_opt mods x_opt ^ " within script")
   in try NameMap.find name exports with Not_found ->
-    raise (Eval.Crash (at, "unknown export \"" ^
-      string_of_name name ^ "\" within module"))
+    Error.error at ("unknown export \"" ^
+      string_of_name name ^ "\" within module")
+
+let lookup_func (mods : modules) x_opt name at =
+  match lookup mods x_opt name at with
+  | ExternFuncType ft -> ft
+  | _ ->
+    Error.error at ("export \"" ^
+      string_of_name name ^ "\" is not a function")
+
+let lookup_global (mods : modules) x_opt name at =
+  match lookup mods x_opt name at with
+  | ExternGlobalType gt -> gt
+  | _ ->
+    Error.error at ("export \"" ^
+      string_of_name name ^ "\" is not a global")
 
 
 (* Wrappers *)
@@ -259,21 +280,34 @@ let abs_mask_of = function
   | I32Type | F32Type -> Values.I32 Int32.max_int
   | I64Type | F64Type -> Values.I64 Int64.max_int
 
-let value v =
-  match v.it with
-  | Values.Num n -> [Const (n @@ v.at) @@ v.at]
-  | Values.Vec s -> [VecConst (s @@ v.at) @@ v.at]
-  | Values.Ref (Values.NullRef t) -> [RefNull t @@ v.at]
+(*
+let literal lit =
+  match lit.it with
+  | Values.Num n -> [Const (n @@ lit.at) @@ lit.at]
+  | Values.Vec s -> [VecConst (s @@ lit.at) @@ lit.at]
+  | Values.Ref (Values.NullRef t) -> [RefNull t @@ lit.at]
   | Values.Ref (ExternRef n) ->
-    [Const (Values.I32 n @@ v.at) @@ v.at; Call (externref_idx @@ v.at) @@ v.at]
+    [ Const (Values.I32 n @@ lit.at) @@ lit.at;
+      Call (externref_idx @@ lit.at) @@ lit.at;
+    ]
   | Values.Ref _ -> assert false
-
-let invoke ft vs at =
-  [ft @@ at], FuncImport (subject_type_idx @@ at) @@ at,
-  List.concat (List.map value vs) @ [Call (subject_idx @@ at) @@ at]
+*)
 
 let get t at =
-  [], GlobalImport t @@ at, [GlobalGet (subject_idx @@ at) @@ at]
+  [], GlobalImport t @@ at, [], [GlobalGet (subject_idx @@ at) @@ at]
+
+let invoke ft at =
+  let FuncType (ts, _) = ft in
+  [ft @@ at], FuncImport (subject_type_idx @@ at) @@ at,
+  List.mapi (fun i t ->
+    { module_name = Utf8.decode "arg";
+      item_name = Utf8.decode (string_of_int i);
+      idesc = GlobalImport (GlobalType (t, Immutable)) @@ at;
+    } @@ at
+  ) ts,
+  List.concat
+    (Lib.List32.mapi (fun i _ -> [GlobalGet (i @@ at) @@ at]) ts) @
+  [Call (subject_idx @@ at) @@ at]
 
 let run ts at =
   [], []
@@ -378,7 +412,7 @@ let assert_return ress ts at =
   in [], List.flatten (List.rev_map test ress)
 
 let wrap item_name wrap_action wrap_assertion at =
-  let itypes, idesc, action = wrap_action at in
+  let itypes, idesc, iargs, action = wrap_action at in
   let locals, assertion = wrap_assertion at in
   let types =
     (FuncType ([], []) @@ at) ::
@@ -400,7 +434,8 @@ let wrap item_name wrap_action wrap_assertion at =
       {module_name = Utf8.decode "spectest"; item_name = Utf8.decode "eq_externref";
        idesc = FuncImport (4l @@ at) @@ at} @@ at;
       {module_name = Utf8.decode "spectest"; item_name = Utf8.decode "eq_funcref";
-       idesc = FuncImport (5l @@ at) @@ at} @@ at ]
+       idesc = FuncImport (5l @@ at) @@ at} @@ at;
+    ] @ iargs
   in
   let item =
     List.fold_left
@@ -429,10 +464,10 @@ let is_js_value_type = function
   | RefType t -> true
 
 let is_js_global_type = function
-  | GlobalType (t, mut) -> is_js_value_type t && mut = Immutable
+  | GlobalType (t, mut) -> is_js_value_type t
 
 let is_js_func_type = function
-  | FuncType (ins, out) -> List.for_all is_js_value_type (ins @ out)
+  | FuncType (ts1, ts2) -> List.for_all is_js_value_type (ts1 @ ts2)
 
 
 (* Script conversion *)
@@ -473,14 +508,19 @@ let of_num n =
   let open Values in
   match n with
   | I32 i -> I32.to_string_s i
-  | I64 i -> "int64(\"" ^ I64.to_string_s i ^ "\")"
+  | I64 i -> I64.to_string_s i ^ "n"
   | F32 z -> of_float (F32.to_float z)
   | F64 z -> of_float (F64.to_float z)
 
 let of_vec v =
-  let open Values in
-  match v with
-  | V128 v -> "v128(\"" ^ V128.to_string v ^ "\")"
+  let at = Source.no_region in
+  let gtype = GlobalType (VecType (Values.type_of_vec v), Immutable) in
+  let ginit = [VecConst (v @@ at) @@ at] @@ at in
+  let globals = [{gtype; ginit} @@ at] in
+  let edesc = GlobalExport (0l @@ at) @@ at in
+  let exports = [{name = Utf8.decode "v128"; edesc} @@ at] in
+  let bs = Encode.encode ({empty_module with globals; exports} @@ at) in
+  "instance(" ^ of_bytes bs ^ ").exports.v128"
 
 let of_ref r =
   let open Values in
@@ -489,9 +529,9 @@ let of_ref r =
   | ExternRef n -> "externref(" ^ Int32.to_string n ^ ")"
   | _ -> assert false
 
-let of_value v =
+let of_literal lit =
   let open Values in
-  match v.it with
+  match lit.it with
   | Num n -> of_num n
   | Vec v -> of_vec v
   | Ref r -> of_ref r
@@ -529,43 +569,52 @@ let rec of_definition def =
     try of_definition (Parse.string_to_module s) with Parse.Syntax _ ->
       of_bytes "<malformed quote>"
 
-let of_wrapper mods x_opt name wrap_action wrap_assertion at =
+let of_arg_import i opd =
+  "arg" ^ string_of_int i ^ ": " ^ opd
+
+let of_wrapper mods x_opt name wrap_action opds wrap_assertion at =
   let x = of_var_opt mods x_opt in
   let bs = wrap name wrap_action wrap_assertion at in
-  "call(instance(" ^ of_bytes bs ^ ", " ^
-    "exports(" ^ x ^ ")), " ^ " \"run\", [])"
+  let exs = if opds = [] then "exports(" ^ x ^ ")" else
+    "{...exports(" ^ x ^ "), " ^
+    "args: [" ^ String.concat ", " (List.mapi of_arg_import opds) ^ "]}"
+  in "call(instance(" ^ of_bytes bs ^ ", " ^ exs ^ "), \"run\", [])"
 
-let of_action mods act =
+let rec of_action mods act =
   match act.it with
-  | Invoke (x_opt, name, vs) ->
+  | Invoke (x_opt, name, args) ->
     "call(" ^ of_var_opt mods x_opt ^ ", " ^ of_name name ^ ", " ^
-      "[" ^ String.concat ", " (List.map of_value vs) ^ "])",
-    (match lookup mods x_opt name act.at with
-    | ExternFuncType ft when not (is_js_func_type ft) ->
-      let FuncType (_, out) = ft in
-      Some (of_wrapper mods x_opt name (invoke ft vs), out)
-    | _ -> None
-    )
+      "[" ^ String.concat ", " (List.map (of_arg mods) args) ^ "].flat())",
+    let FuncType (_, ts2) as ft = lookup_func mods x_opt name act.at in
+    if is_js_func_type ft then None else
+    let opds = List.map (of_arg mods) args in
+    Some (of_wrapper mods x_opt name (invoke ft) opds, ts2)
   | Get (x_opt, name) ->
     "get(" ^ of_var_opt mods x_opt ^ ", " ^ of_name name ^ ")",
-    (match lookup mods x_opt name act.at with
-    | ExternGlobalType gt when not (is_js_global_type gt) ->
-      let GlobalType (t, _) = gt in
-      Some (of_wrapper mods x_opt name (get gt), [t])
-    | _ -> None
-    )
+    let GlobalType (t, _) as gt = lookup_global mods x_opt name act.at in
+    if is_js_global_type gt then None else
+    Some (of_wrapper mods x_opt name (get gt) [], [t])
+
+and of_arg mods arg =
+  match arg.it with
+  | LiteralArg lit -> of_literal lit
+  | ActionArg act ->
+    let act_js, act_wrapper_opt = of_action mods act in
+    match act_wrapper_opt with
+    | None -> act_js
+    | Some (act_wrapper, ts) -> act_wrapper (run ts) act.at
 
 let of_assertion' mods act name args wrapper_opt =
   let act_js, act_wrapper_opt = of_action mods act in
   let js = name ^ "(() => " ^ act_js ^ String.concat ", " ("" :: args) ^ ")" in
   match act_wrapper_opt with
   | None -> js ^ ";"
-  | Some (act_wrapper, out) ->
+  | Some (act_wrapper, ts) ->
     let run_name, wrapper =
       match wrapper_opt with
       | None -> name, run
       | Some wrapper -> "run", wrapper
-    in run_name ^ "(() => " ^ act_wrapper (wrapper out) act.at ^ ");  // " ^ js
+    in run_name ^ "(() => " ^ act_wrapper (wrapper ts) act.at ^ ");  // " ^ js
 
 let of_assertion mods ass =
   match ass.it with
diff --git a/interpreter/script/js.mli b/interpreter/script/js.mli
index c60d3c501b..905433462d 100644
--- a/interpreter/script/js.mli
+++ b/interpreter/script/js.mli
@@ -1 +1,3 @@
+exception Error of Source.region * string
+
 val of_script : Script.script -> string
diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml
index e0019d84a0..e703000926 100644
--- a/interpreter/script/run.ml
+++ b/interpreter/script/run.ml
@@ -114,6 +114,7 @@ let input_from get_script run =
   | Eval.Crash (at, msg) -> error at "runtime crash" msg
   | Encode.Code (at, msg) -> error at "encoding error" msg
   | Script.Error (at, msg) -> error at "script error" msg
+  | Js.Error (at, msg) -> error at "script error" msg
   | IO (at, msg) -> error at "i/o error" msg
   | Assert (at, msg) -> error at "assertion failure" msg
   | Abort _ -> false
@@ -340,21 +341,22 @@ let rec run_definition def : Ast.module_ =
     let def' = Parse.string_to_module s in
     run_definition def'
 
-let run_action act : Values.value list =
+let rec run_action act : Values.value list =
   match act.it with
-  | Invoke (x_opt, name, vs) ->
+  | Invoke (x_opt, name, args) ->
     trace ("Invoking function \"" ^ Ast.string_of_name name ^ "\"...");
     let inst = lookup_instance x_opt act.at in
     (match Instance.export inst name with
     | Some (Instance.ExternFunc f) ->
-      let Types.FuncType (ins, out) = Func.type_of f in
-      if List.length vs <> List.length ins then
+      let Types.FuncType (ts1, _) = Func.type_of f in
+      let vs = List.concat_map run_arg args in
+      if List.length vs <> List.length ts1 then
         Script.error act.at "wrong number of arguments";
-      List.iter2 (fun v t ->
-        if Values.type_of_value v.it <> t then
-          Script.error v.at "wrong type of argument"
-      ) vs ins;
-      Eval.invoke f (List.map (fun v -> v.it) vs)
+      List.iteri (fun i (v, t) ->
+        if Values.type_of_value v <> t then
+          Script.error act.at ("type mismatch for argument " ^ string_of_int i)
+      ) (List.combine vs ts1);
+      Eval.invoke f vs
     | Some _ -> Assert.error act.at "export is not a function"
     | None -> Assert.error act.at "undefined export"
     )
@@ -368,6 +370,10 @@ let run_action act : Values.value list =
     | None -> Assert.error act.at "undefined export"
     )
 
+and run_arg arg : Values.value list =
+  match arg.it with
+  | LiteralArg lit -> [lit.it]
+  | ActionArg act -> run_action act
 
 let assert_nan_pat n nan =
   let open Values in
diff --git a/interpreter/script/script.ml b/interpreter/script/script.ml
index 4c4f550f2c..8ec6e69388 100644
--- a/interpreter/script/script.ml
+++ b/interpreter/script/script.ml
@@ -13,9 +13,14 @@ and definition' =
 
 type action = action' Source.phrase
 and action' =
-  | Invoke of var option * Ast.name * literal list
+  | Invoke of var option * Ast.name * arg list
   | Get of var option * Ast.name
 
+and arg = arg' Source.phrase
+and arg' =
+  | LiteralArg of literal
+  | ActionArg of action
+
 type nanop = nanop' Source.phrase
 and nanop' = (Lib.void, Lib.void, nan, nan) Values.op
 and nan = CanonicalNan | ArithmeticNan
diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml
index dc56743eb6..2184d6eadd 100644
--- a/interpreter/text/arrange.ml
+++ b/interpreter/text/arrange.ml
@@ -699,13 +699,18 @@ let definition mode x_opt def =
 let access x_opt n =
   String.concat " " [var_opt x_opt; name n]
 
-let action mode act =
+let rec action mode act =
   match act.it with
-  | Invoke (x_opt, name, lits) ->
-    Node ("invoke" ^ access x_opt name, List.map (literal mode) lits)
+  | Invoke (x_opt, name, args) ->
+    Node ("invoke" ^ access x_opt name, List.map (arg mode) args)
   | Get (x_opt, name) ->
     Node ("get" ^ access x_opt name, [])
 
+and arg mode arg =
+  match arg.it with
+  | LiteralArg lit -> literal mode lit
+  | ActionArg act -> action mode act
+
 let nan = function
   | CanonicalNan -> "nan:canonical"
   | ArithmeticNan -> "nan:arithmetic"
diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly
index 7489acf72b..c5300e5aa0 100644
--- a/interpreter/text/parser.mly
+++ b/interpreter/text/parser.mly
@@ -1015,7 +1015,7 @@ script_module :
     { $3, Quoted ("quote:" ^ string_of_pos (at()).left, $5) @@ at() }
 
 action :
-  | LPAR INVOKE module_var_opt name literal_list RPAR
+  | LPAR INVOKE module_var_opt name arg_list RPAR
     { Invoke ($3, $4, $5) @@ at () }
   | LPAR GET module_var_opt name RPAR
     { Get ($3, $4) @@ at() }
@@ -1065,9 +1065,13 @@ literal :
   | literal_vec { Values.Vec $1 @@ at () }
   | literal_ref { Values.Ref $1 @@ at () }
 
-literal_list :
+arg :
+  | literal { LiteralArg $1 @@ at () }
+  | action { ActionArg $1 @@ at () }
+
+arg_list :
   | /* empty */ { [] }
-  | literal literal_list { $1 :: $2 }
+  | arg arg_list { $1 :: $2 }
 
 numpat :
   | num { fun sh -> vec_lane_lit sh $1.it $1.at }
diff --git a/test/core/script.wast b/test/core/script.wast
new file mode 100644
index 0000000000..624da1c840
--- /dev/null
+++ b/test/core/script.wast
@@ -0,0 +1,61 @@
+(module $m1
+  (global (export "g") i32 (i32.const 41))
+  (func (export "f") (result i32) (i32.const 41))
+  (func (export "inc") (param $x i32) (result i32)
+    (i32.add (local.get $x) (i32.const 1))
+  )
+)
+
+(module $m2
+  (global (export "g") i32 (i32.const 42))
+  (func (export "f") (result i32) (i32.const 42))
+  (func (export "add3") (param i32 i32 i32) (result i32)
+    (i32.add (i32.add (local.get 0) (local.get 1)) (local.get 2))
+  )
+  (func (export "swap") (param i32 i32) (result i32 i32)
+    (local.get 1) (local.get 0)
+  )
+)
+
+(assert_return (get "g") (i32.const 42))
+(assert_return (get $m1 "g") (i32.const 41))
+(assert_return (get $m2 "g") (i32.const 42))
+
+(assert_return (invoke "f") (i32.const 42))
+(assert_return (invoke $m1 "f") (i32.const 41))
+(assert_return (invoke $m2 "f") (i32.const 42))
+
+(assert_return (invoke $m1 "inc" (i32.const 2)) (i32.const 3))
+(assert_return (invoke $m1 "inc" (get $m1 "g")) (i32.const 42))
+(assert_return (invoke $m1 "inc" (get $m2 "g")) (i32.const 43))
+(assert_return (invoke $m1 "inc" (invoke $m1 "inc" (get "g"))) (i32.const 44))
+
+(assert_return (invoke "add3" (get $m1 "g") (invoke $m1 "inc" (get "g")) (get "g")) (i32.const 126))
+(assert_return (invoke "add3" (invoke "swap" (get $m1 "g") (invoke $m1 "inc" (get "g"))) (i32.const -20)) (i32.const 64))
+
+
+(module
+  (global (export "g-i32") i32 (i32.const 42))
+  (global (export "g-i64") i64 (i64.const 42))
+  (global (export "g-f32") f32 (f32.const 42))
+  (global (export "g-f64") f64 (f64.const 42))
+  (global (export "g-v128") v128 (v128.const i32x4 42 42 42 42))
+  (global (export "g-funcref") funcref (ref.null func))
+  (global (export "g-externref") externref (ref.null extern))
+
+  (func (export "f-i32") (param i32) (result i32) (local.get 0))
+  (func (export "f-i64") (param i64) (result i64) (local.get 0))
+  (func (export "f-f32") (param f32) (result f32) (local.get 0))
+  (func (export "f-f64") (param f64) (result f64) (local.get 0))
+  (func (export "f-v128") (param v128) (result v128) (local.get 0))
+  (func (export "f-funcref") (param funcref) (result funcref) (local.get 0))
+  (func (export "f-externref") (param externref) (result externref) (local.get 0))
+)
+
+(assert_return (invoke "f-i32" (get "g-i32")) (i32.const 42))
+(assert_return (invoke "f-i64" (get "g-i64")) (i64.const 42))
+(assert_return (invoke "f-f32" (get "g-f32")) (f32.const 42))
+(assert_return (invoke "f-f64" (get "g-f64")) (f64.const 42))
+(assert_return (invoke "f-v128" (get "g-v128")) (v128.const i32x4 42 42 42 42))
+(assert_return (invoke "f-funcref" (get "g-funcref")) (ref.null func))
+(assert_return (invoke "f-externref" (get "g-externref")) (ref.null extern))

From cbab7f71972f481bdfa6235cae6db3abbd356bce Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Wed, 8 Feb 2023 16:48:15 +0100
Subject: [PATCH 2/8] Add set action

---
 interpreter/README.md        |  1 +
 interpreter/script/js.ml     | 15 ++++++++++++---
 interpreter/script/run.ml    | 18 +++++++++++++++---
 interpreter/script/script.ml |  1 +
 interpreter/text/arrange.ml  |  6 ++++--
 interpreter/text/lexer.mll   |  1 +
 interpreter/text/parser.mly  |  4 +++-
 test/core/script.wast        | 18 +++++++++++++-----
 8 files changed, 50 insertions(+), 14 deletions(-)

diff --git a/interpreter/README.md b/interpreter/README.md
index b5bf095f3b..b64b41c401 100644
--- a/interpreter/README.md
+++ b/interpreter/README.md
@@ -393,6 +393,7 @@ module:
 action:
   ( invoke <name>? <string> <arg>* )         ;; invoke function export
   ( get <name>? <string> )                   ;; get global export
+  ( set <name>? <string> <arg> )             ;; set global export
 
 arg:
   <literal>                                  ;; literal argument
diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml
index e26f921e8a..72d9f3f2f0 100644
--- a/interpreter/script/js.ml
+++ b/interpreter/script/js.ml
@@ -296,6 +296,9 @@ let literal lit =
 let get t at =
   [], GlobalImport t @@ at, [], [GlobalGet (subject_idx @@ at) @@ at]
 
+let set t at =
+  [], GlobalImport t @@ at, [], [GlobalSet (subject_idx @@ at) @@ at]
+
 let invoke ft at =
   let FuncType (ts, _) = ft in
   [ft @@ at], FuncImport (subject_type_idx @@ at) @@ at,
@@ -583,19 +586,25 @@ let of_wrapper mods x_opt name wrap_action opds wrap_assertion at =
 let rec of_action mods act =
   match act.it with
   | Invoke (x_opt, name, args) ->
+    let opds = List.map (of_argument mods) args in
     "call(" ^ of_var_opt mods x_opt ^ ", " ^ of_name name ^ ", " ^
-      "[" ^ String.concat ", " (List.map (of_arg mods) args) ^ "].flat())",
+      "[" ^ String.concat ", " opds ^ "].flat())",
     let FuncType (_, ts2) as ft = lookup_func mods x_opt name act.at in
     if is_js_func_type ft then None else
-    let opds = List.map (of_arg mods) args in
     Some (of_wrapper mods x_opt name (invoke ft) opds, ts2)
   | Get (x_opt, name) ->
     "get(" ^ of_var_opt mods x_opt ^ ", " ^ of_name name ^ ")",
     let GlobalType (t, _) as gt = lookup_global mods x_opt name act.at in
     if is_js_global_type gt then None else
     Some (of_wrapper mods x_opt name (get gt) [], [t])
+  | Set (x_opt, name, arg) ->
+    let opd = of_argument mods arg in
+    "set(" ^ of_var_opt mods x_opt ^ ", " ^ of_name name ^ ", " ^ opd ^ ")",
+    let GlobalType (t, _) as gt = lookup_global mods x_opt name act.at in
+    if is_js_global_type gt then None else
+    Some (of_wrapper mods x_opt name (set gt) [opd], [t])
 
-and of_arg mods arg =
+and of_argument mods arg =
   match arg.it with
   | LiteralArg lit -> of_literal lit
   | ActionArg act ->
diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml
index e703000926..64938536e4 100644
--- a/interpreter/script/run.ml
+++ b/interpreter/script/run.ml
@@ -349,7 +349,7 @@ let rec run_action act : Values.value list =
     (match Instance.export inst name with
     | Some (Instance.ExternFunc f) ->
       let Types.FuncType (ts1, _) = Func.type_of f in
-      let vs = List.concat_map run_arg args in
+      let vs = List.concat_map run_argument args in
       if List.length vs <> List.length ts1 then
         Script.error act.at "wrong number of arguments";
       List.iteri (fun i (v, t) ->
@@ -360,7 +360,6 @@ let rec run_action act : Values.value list =
     | Some _ -> Assert.error act.at "export is not a function"
     | None -> Assert.error act.at "undefined export"
     )
-
  | Get (x_opt, name) ->
     trace ("Getting global \"" ^ Ast.string_of_name name ^ "\"...");
     let inst = lookup_instance x_opt act.at in
@@ -369,8 +368,21 @@ let rec run_action act : Values.value list =
     | Some _ -> Assert.error act.at "export is not a global"
     | None -> Assert.error act.at "undefined export"
     )
+ | Set (x_opt, name, arg) ->
+    trace ("Setting global \"" ^ Ast.string_of_name name ^ "\"...");
+    let inst = lookup_instance x_opt act.at in
+    let v =
+      match run_argument arg with
+      | [v] -> v
+      | _ -> Assert.error act.at "wrong number of arguments"
+    in
+    (match Instance.export inst name with
+    | Some (Instance.ExternGlobal gl) -> Global.store gl v; []
+    | Some _ -> Assert.error act.at "export is not a global"
+    | None -> Assert.error act.at "undefined export"
+    )
 
-and run_arg arg : Values.value list =
+and run_argument arg : Values.value list =
   match arg.it with
   | LiteralArg lit -> [lit.it]
   | ActionArg act -> run_action act
diff --git a/interpreter/script/script.ml b/interpreter/script/script.ml
index 8ec6e69388..fc66a59840 100644
--- a/interpreter/script/script.ml
+++ b/interpreter/script/script.ml
@@ -15,6 +15,7 @@ type action = action' Source.phrase
 and action' =
   | Invoke of var option * Ast.name * arg list
   | Get of var option * Ast.name
+  | Set of var option * Ast.name * arg
 
 and arg = arg' Source.phrase
 and arg' =
diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml
index 2184d6eadd..13e3380b48 100644
--- a/interpreter/text/arrange.ml
+++ b/interpreter/text/arrange.ml
@@ -702,11 +702,13 @@ let access x_opt n =
 let rec action mode act =
   match act.it with
   | Invoke (x_opt, name, args) ->
-    Node ("invoke" ^ access x_opt name, List.map (arg mode) args)
+    Node ("invoke" ^ access x_opt name, List.map (argument mode) args)
   | Get (x_opt, name) ->
     Node ("get" ^ access x_opt name, [])
+  | Set (x_opt, name, arg) ->
+    Node ("set" ^ access x_opt name, [argument mode arg])
 
-and arg mode arg =
+and argument mode arg =
   match arg.it with
   | LiteralArg lit -> literal mode lit
   | ActionArg act -> action mode act
diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll
index d9a12b5d21..0d8a9c7524 100644
--- a/interpreter/text/lexer.mll
+++ b/interpreter/text/lexer.mll
@@ -678,6 +678,7 @@ rule token = parse
       | "register" -> REGISTER
       | "invoke" -> INVOKE
       | "get" -> GET
+      | "set" -> SET
       | "assert_malformed" -> ASSERT_MALFORMED
       | "assert_invalid" -> ASSERT_INVALID
       | "assert_unlinkable" -> ASSERT_UNLINKABLE
diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly
index c5300e5aa0..c31e08e2a0 100644
--- a/interpreter/text/parser.mly
+++ b/interpreter/text/parser.mly
@@ -232,7 +232,7 @@ let inline_type_explicit (c : context) x ft at =
 %token FUNC START TYPE PARAM RESULT LOCAL GLOBAL
 %token TABLE ELEM MEMORY DATA DECLARE OFFSET ITEM IMPORT EXPORT
 %token MODULE BIN QUOTE
-%token SCRIPT REGISTER INVOKE GET
+%token SCRIPT REGISTER INVOKE GET SET
 %token ASSERT_MALFORMED ASSERT_INVALID ASSERT_UNLINKABLE
 %token ASSERT_RETURN ASSERT_TRAP ASSERT_EXHAUSTION
 %token<Script.nan> NAN
@@ -1019,6 +1019,8 @@ action :
     { Invoke ($3, $4, $5) @@ at () }
   | LPAR GET module_var_opt name RPAR
     { Get ($3, $4) @@ at() }
+  | LPAR SET module_var_opt name arg RPAR
+    { Set ($3, $4, $5) @@ at() }
 
 assertion :
   | LPAR ASSERT_MALFORMED script_module STRING RPAR
diff --git a/test/core/script.wast b/test/core/script.wast
index 624da1c840..81dc947ad4 100644
--- a/test/core/script.wast
+++ b/test/core/script.wast
@@ -7,7 +7,7 @@
 )
 
 (module $m2
-  (global (export "g") i32 (i32.const 42))
+  (global (export "g") (mut i32) (i32.const 42))
   (func (export "f") (result i32) (i32.const 42))
   (func (export "add3") (param i32 i32 i32) (result i32)
     (i32.add (i32.add (local.get 0) (local.get 1)) (local.get 2))
@@ -21,17 +21,25 @@
 (assert_return (get $m1 "g") (i32.const 41))
 (assert_return (get $m2 "g") (i32.const 42))
 
+(set "g" (i32.const 43))
+(assert_return (set "g" (i32.const 43)))
+(assert_return (get "g") (i32.const 43))
+(set $m2 "g" (i32.const 44))
+(assert_return (get "g") (i32.const 44))
+(set "g" (invoke $m1 "inc" (get "g")))
+(assert_return (get "g") (i32.const 45))
+
 (assert_return (invoke "f") (i32.const 42))
 (assert_return (invoke $m1 "f") (i32.const 41))
 (assert_return (invoke $m2 "f") (i32.const 42))
 
 (assert_return (invoke $m1 "inc" (i32.const 2)) (i32.const 3))
 (assert_return (invoke $m1 "inc" (get $m1 "g")) (i32.const 42))
-(assert_return (invoke $m1 "inc" (get $m2 "g")) (i32.const 43))
-(assert_return (invoke $m1 "inc" (invoke $m1 "inc" (get "g"))) (i32.const 44))
+(assert_return (invoke $m1 "inc" (get $m2 "g")) (i32.const 46))
+(assert_return (invoke $m1 "inc" (invoke $m1 "inc" (get "g"))) (i32.const 47))
 
-(assert_return (invoke "add3" (get $m1 "g") (invoke $m1 "inc" (get "g")) (get "g")) (i32.const 126))
-(assert_return (invoke "add3" (invoke "swap" (get $m1 "g") (invoke $m1 "inc" (get "g"))) (i32.const -20)) (i32.const 64))
+(assert_return (invoke "add3" (get $m1 "g") (invoke $m1 "inc" (get "g")) (get "g")) (i32.const 132))
+(assert_return (invoke "add3" (invoke "swap" (get $m1 "g") (invoke $m1 "inc" (get "g"))) (i32.const -20)) (i32.const 67))
 
 
 (module

From 97a9473906b0118d727a5fe3d09cf4cb03f49681 Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Wed, 8 Feb 2023 17:08:26 +0100
Subject: [PATCH 3/8] Test evaluation order

---
 test/core/script.wast | 21 ++++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

diff --git a/test/core/script.wast b/test/core/script.wast
index 81dc947ad4..59cb902ea6 100644
--- a/test/core/script.wast
+++ b/test/core/script.wast
@@ -15,6 +15,7 @@
   (func (export "swap") (param i32 i32) (result i32 i32)
     (local.get 1) (local.get 0)
   )
+  (func (export "nop"))
 )
 
 (assert_return (get "g") (i32.const 42))
@@ -39,7 +40,7 @@
 (assert_return (invoke $m1 "inc" (invoke $m1 "inc" (get "g"))) (i32.const 47))
 
 (assert_return (invoke "add3" (get $m1 "g") (invoke $m1 "inc" (get "g")) (get "g")) (i32.const 132))
-(assert_return (invoke "add3" (invoke "swap" (get $m1 "g") (invoke $m1 "inc" (get "g"))) (i32.const -20)) (i32.const 67))
+(assert_return (invoke "add3" (invoke "swap" (get $m1 "g") (invoke "nop") (invoke $m1 "inc" (get "g"))) (i32.const -20)) (i32.const 67))
 
 
 (module
@@ -67,3 +68,21 @@
 (assert_return (invoke "f-v128" (get "g-v128")) (v128.const i32x4 42 42 42 42))
 (assert_return (invoke "f-funcref" (get "g-funcref")) (ref.null func))
 (assert_return (invoke "f-externref" (get "g-externref")) (ref.null extern))
+
+
+(module
+  (global $g (export "g") (mut i32) (i32.const 1))
+  (func (export "inc") (global.set $g (i32.add (global.get $g) (i32.const 1))))
+  (func (export "get") (result i32) (global.get $g))
+)
+
+;; Left-to-right evaluation order
+(assert_return
+  (invoke "get"
+    (set "g" (i32.const 3))
+    (invoke "inc")
+    (set "g" (invoke $m1 "inc" (get "g")))
+    (invoke "inc")
+  )
+  (i32.const 6)
+)

From 4a7b1a1a8044e6edd9b70a621b03be4d9e8e5696 Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Thu, 9 Feb 2023 17:54:10 +0100
Subject: [PATCH 4/8] Rewrite JS translation

---
 .github/workflows/main.yml |   4 +
 interpreter/Makefile       |   2 +-
 interpreter/script/js.ml   | 646 +++++++++++++++++++------------------
 3 files changed, 342 insertions(+), 310 deletions(-)

diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml
index 00b70e8f03..2e43f200a5 100644
--- a/.github/workflows/main.yml
+++ b/.github/workflows/main.yml
@@ -19,6 +19,10 @@ jobs:
         with:
           ocaml-compiler: 4.12.x
       - run: opam install --yes ocamlbuild.0.14.0
+      - name: Setup Node.js
+        uses: actions/setup-node@v1
+        with:
+          node-version: 18.x
       - run: cd interpreter && opam exec make all
 
   ref-interpreter-js-library:
diff --git a/interpreter/Makefile b/interpreter/Makefile
index 7820e64282..b708880a2c 100644
--- a/interpreter/Makefile
+++ b/interpreter/Makefile
@@ -23,7 +23,7 @@ FLAGS = 	-lexflags -ml -cflags '-w +a-4-27-42-44-45-70 -warn-error +a-3'
 OCBA =		ocamlbuild $(FLAGS) $(DIRS:%=-I %)
 OCB =		$(OCBA) $(LIBS:%=-libs %)
 JSO =		js_of_ocaml -q --opt 3
-JS =		# set to JS shell command to run JS tests
+JS =		node  # set to JS shell command to run JS tests, empty for skip
 
 
 # Main targets
diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml
index 72d9f3f2f0..2b07bab2de 100644
--- a/interpreter/script/js.ml
+++ b/interpreter/script/js.ml
@@ -59,6 +59,7 @@ let registry = new Proxy({spectest}, handler);
 
 function register(name, instance) {
   registry[name] = instance.exports;
+  return instance;
 }
 
 function module(bytes, valid = true) {
@@ -74,7 +75,19 @@ function module(bytes, valid = true) {
     throw new Error("Wasm validate throws");
   }
   if (validated !== valid) {
-    throw new Error("Wasm validate failure" + (valid ? "" : " expected"));
+    let error;
+    skip: if (valid) {
+      try {
+        new WebAssembly.Module(buffer);
+      } catch (e) {
+        error = ": " + e;
+        break skip;
+      }
+      throw new Error("Wasm compile does not throw, although validation failed");
+    } else {
+      error = " expected";
+    }
+    throw new Error("Wasm validate failure" + error);
   }
   return new WebAssembly.Module(buffer);
 }
@@ -88,12 +101,19 @@ function call(instance, name, args) {
 }
 
 function get(instance, name) {
-  let v = instance.exports[name];
-  return (v instanceof WebAssembly.Global) ? v.value : v;
+  let global = instance.exports[name];
+  if (v instanceof WebAssembly.Global) return v.value;
+  throw new Error("Wasm global expected");
 }
 
-function exports(instance) {
-  return {module: instance.exports, spectest: spectest};
+function set(instance, name, arg) {
+  let global = instance.exports[name];
+  if (v instanceof WebAssembly.Global) {
+    try {
+      v.value = arg; return;
+    } catch (e) {}
+  }
+  throw new Error("Wasm mutable global expected");
 }
 
 function run(action) {
@@ -211,22 +231,22 @@ let exports m : exports =
 let modules () : modules = {env = Map.empty; current = 0}
 
 let current_var (mods : modules) = "$" ^ string_of_int mods.current
-let of_var_opt (mods : modules) = function
+let var_opt (mods : modules) = function
   | None -> current_var mods
   | Some x -> x.it
 
 let bind (mods : modules) x_opt m =
   let exports = exports m in
   mods.current <- mods.current + 1;
-  mods.env <- Map.add (of_var_opt mods x_opt) exports mods.env;
+  mods.env <- Map.add (var_opt mods x_opt) exports mods.env;
   if x_opt <> None then mods.env <- Map.add (current_var mods) exports mods.env
 
 let lookup (mods : modules) x_opt name at =
   let exports =
-    try Map.find (of_var_opt mods x_opt) mods.env with Not_found ->
+    try Map.find (var_opt mods x_opt) mods.env with Not_found ->
       Error.error at 
         (if x_opt = None then "no module defined within script"
-         else "unknown module " ^ of_var_opt mods x_opt ^ " within script")
+         else "unknown module " ^ var_opt mods x_opt ^ " within script")
   in try NameMap.find name exports with Not_found ->
     Error.error at ("unknown export \"" ^
       string_of_name name ^ "\" within module")
@@ -246,15 +266,70 @@ let lookup_global (mods : modules) x_opt name at =
       string_of_name name ^ "\" is not a global")
 
 
-(* Wrappers *)
+(* Dependencies for Wasm wrappers *)
+
+type deps =
+  { mutable dtypes : func_type list;
+    mutable descs : (import_desc' * int32) NameMap.t Map.t;
+    func_idx : int32 ref;
+    global_idx : int32 ref;
+  }
 
-let subject_idx = 0l
-let externref_idx = 1l
-let is_externref_idx = 2l
-let is_funcref_idx = 3l
-let eq_externref_idx = 4l
-let _eq_funcref_idx = 5l
-let subject_type_idx = 6l
+let new_deps () =
+  { dtypes = []; descs = Map.empty;
+    func_idx = ref 0l; global_idx = ref 0l }
+
+let dep deps x name idxr idesc =
+  let nmap =
+    match Map.find_opt x deps.descs with
+    | Some nmap -> nmap
+    | None -> NameMap.empty
+  in
+  match NameMap.find_opt name nmap with
+  | Some (_, idx) -> idx
+  | None ->
+    let idx = !idxr in
+    deps.descs <-
+      Map.add x (NameMap.add name (idesc, idx) nmap) deps.descs;
+    idxr := Int32.add idx 1l;
+    idx
+
+let dep_type deps ft =
+  match Lib.List.index_of ft deps.dtypes with
+  | Some i -> Int32.of_int i
+  | None ->
+    let idx = Lib.List32.length deps.dtypes in
+    deps.dtypes <- deps.dtypes @ [ft];
+    idx
+
+let dep_global deps x name gt =
+  dep deps x name deps.global_idx (GlobalImport gt)
+
+let dep_func deps x name ft =
+  dep deps x name deps.func_idx
+    (FuncImport (dep_type deps ft @@ Source.no_region))
+
+let dep_spectest deps name ft =
+  dep_func deps "spectest" (Utf8.decode name) ft
+
+let dep_spectest_externref deps =
+  dep_spectest deps "externref"
+    (FuncType ([NumType I32Type], [RefType ExternRefType]))
+let dep_spectest_is_externref deps =
+  dep_spectest deps "is_externref"
+    (FuncType ([RefType ExternRefType], [NumType I32Type]))
+let dep_spectest_is_funcref deps =
+  dep_spectest deps "is_funcref"
+    (FuncType ([RefType FuncRefType], [NumType I32Type]))
+let dep_spectest_eq_externref deps =
+  dep_spectest deps "eq_externref"
+    (FuncType ([RefType ExternRefType; RefType ExternRefType], [NumType I32Type]))
+let _dep_spectest_eq_funcref deps =
+  dep_spectest deps "eq_funcref"
+    (FuncType ([RefType FuncRefType; RefType FuncRefType], [NumType I32Type]))
+
+
+(* Script conversion to Wasm wrappers *)
 
 let eq_of = function
   | I32Type -> Values.I32 I32Op.Eq
@@ -280,200 +355,184 @@ let abs_mask_of = function
   | I32Type | F32Type -> Values.I32 Int32.max_int
   | I64Type | F64Type -> Values.I64 Int64.max_int
 
-(*
-let literal lit =
+let nan_bitmask_of = function
+  | CanonicalNan -> abs_mask_of
+  | ArithmeticNan -> canonical_nan_of
+
+
+let wasm_literal deps lit : instr list =
   match lit.it with
   | Values.Num n -> [Const (n @@ lit.at) @@ lit.at]
   | Values.Vec s -> [VecConst (s @@ lit.at) @@ lit.at]
   | Values.Ref (Values.NullRef t) -> [RefNull t @@ lit.at]
   | Values.Ref (ExternRef n) ->
+    let externref_idx = dep_spectest_externref deps in
     [ Const (Values.I32 n @@ lit.at) @@ lit.at;
       Call (externref_idx @@ lit.at) @@ lit.at;
     ]
   | Values.Ref _ -> assert false
-*)
-
-let get t at =
-  [], GlobalImport t @@ at, [], [GlobalGet (subject_idx @@ at) @@ at]
-
-let set t at =
-  [], GlobalImport t @@ at, [], [GlobalSet (subject_idx @@ at) @@ at]
-
-let invoke ft at =
-  let FuncType (ts, _) = ft in
-  [ft @@ at], FuncImport (subject_type_idx @@ at) @@ at,
-  List.mapi (fun i t ->
-    { module_name = Utf8.decode "arg";
-      item_name = Utf8.decode (string_of_int i);
-      idesc = GlobalImport (GlobalType (t, Immutable)) @@ at;
-    } @@ at
-  ) ts,
-  List.concat
-    (Lib.List32.mapi (fun i _ -> [GlobalGet (i @@ at) @@ at]) ts) @
-  [Call (subject_idx @@ at) @@ at]
-
-let run ts at =
-  [], []
-
-let assert_return ress ts at =
-  let test res =
-    let nan_bitmask_of = function
-      | CanonicalNan -> abs_mask_of (* must only differ from the canonical NaN in its sign bit *)
-      | ArithmeticNan -> canonical_nan_of (* can be any NaN that's one everywhere the canonical NaN is one *)
+
+let rec wasm_action mods deps act : instr list * value_type list =
+  match act.it with
+  | Invoke (x_opt, name, args) ->
+    let FuncType (_, ts2) as ft = lookup_func mods x_opt name act.at in
+    let idx = dep_func deps (var_opt mods x_opt) name ft in
+    List.concat_map (wasm_argument mods deps) args @
+    [Call (idx @@ act.at) @@ act.at], ts2
+  | Get (x_opt, name) ->
+    let GlobalType (t, _) as gt = lookup_global mods x_opt name act.at in
+    let idx = dep_global deps (var_opt mods x_opt) name gt in
+    [GlobalGet (idx @@ act.at) @@ act.at], [t]
+  | Set (x_opt, name, arg) ->
+    let GlobalType (t, _) as gt = lookup_global mods x_opt name act.at in
+    let idx = dep_global deps (var_opt mods x_opt) name gt in
+    wasm_argument mods deps arg @
+    [GlobalSet (idx @@ act.at) @@ act.at], []
+
+and wasm_argument mods deps arg : instr list =
+  match arg.it with
+  | LiteralArg lit -> wasm_literal deps lit
+  | ActionArg act -> fst (wasm_action mods deps act)
+
+let wasm_result deps res : instr list =
+  let at = res.at in
+  match res.it with
+  | NumResult (NumPat {it = num; at = at'}) ->
+    let t', reinterpret = reinterpret_of (Values.type_of_num num) in
+    [ reinterpret @@ at;
+      Const (num @@ at')  @@ at;
+      reinterpret @@ at;
+      Compare (eq_of t') @@ at;
+      Test (Values.I32 I32Op.Eqz) @@ at;
+      BrIf (0l @@ at) @@ at;
+    ]
+  | NumResult (NanPat nanop) ->
+    let open Values in
+    let nan = match nanop.it with F32 n | F64 n -> n | I32 _ | I64 _ -> . in
+    let t = Values.type_of_num nanop.it in
+    let t', reinterpret = reinterpret_of t in
+    [ reinterpret @@ at;
+      Const (nan_bitmask_of nan t' @@ at) @@ at;
+      Binary (and_of t') @@ at;
+      Const (canonical_nan_of t' @@ at) @@ at;
+      Compare (eq_of t') @@ at;
+      Test (Values.I32 I32Op.Eqz) @@ at;
+      BrIf (0l @@ at) @@ at;
+    ]
+  | VecResult (VecPat (Values.V128 (shape, pats))) ->
+    let open Values in
+    (* VecResult is a list of NumPat or LitPat. For float shapes, we can have a mix of literals
+     * and NaNs. For NaNs, we need to mask it and compare with a canonical NaN. To simplify
+     * comparison, we build masks even for literals (will just be all set), collect them into
+     * a v128, then compare the entire 128 bits.
+     *)
+    let mask_and_canonical = function
+      | NumPat {it = I32 _ as i; _} -> I32 (Int32.minus_one), i
+      | NumPat {it = I64 _ as i; _} -> I64 (Int64.minus_one), i
+      | NumPat {it = F32 f; _} ->
+        I32 (Int32.minus_one), I32 (I32_convert.reinterpret_f32 f)
+      | NumPat {it = F64 f; _} ->
+        I64 (Int64.minus_one), I64 (I64_convert.reinterpret_f64 f)
+      | NanPat {it = F32 nan; _} ->
+        nan_bitmask_of nan I32Type, canonical_nan_of I32Type
+      | NanPat {it = F64 nan; _} ->
+        nan_bitmask_of nan I64Type, canonical_nan_of I64Type
+      | _ -> .
     in
-    match res.it with
-    | NumResult (NumPat {it = num; at = at'}) ->
-      let t', reinterpret = reinterpret_of (Values.type_of_num num) in
-      [ reinterpret @@ at;
-        Const (num @@ at')  @@ at;
-        reinterpret @@ at;
-        Compare (eq_of t') @@ at;
-        Test (Values.I32 I32Op.Eqz) @@ at;
-        BrIf (0l @@ at) @@ at ]
-    | NumResult (NanPat nanop) ->
-      let nan =
-        match nanop.it with
-        | Values.I32 _ | Values.I64 _ -> .
-        | Values.F32 n | Values.F64 n -> n
-      in
-      let t = Values.type_of_num nanop.it in
-      let t', reinterpret = reinterpret_of t in
-      [ reinterpret @@ at;
-        Const (nan_bitmask_of nan t' @@ at) @@ at;
-        Binary (and_of t') @@ at;
-        Const (canonical_nan_of t' @@ at) @@ at;
-        Compare (eq_of t') @@ at;
-        Test (Values.I32 I32Op.Eqz) @@ at;
-        BrIf (0l @@ at) @@ at ]
-    | VecResult (VecPat (Values.V128 (shape, pats))) ->
-      let open Values in
-      (* VecResult is a list of NumPat or LitPat. For float shapes, we can have a mix of literals
-       * and NaNs. For NaNs, we need to mask it and compare with a canonical NaN. To simplify
-       * comparison, we build masks even for literals (will just be all set), collect them into
-       * a v128, then compare the entire 128 bits.
-       *)
-      let mask_and_canonical = function
-        | NumPat {it = I32 _ as i; _} -> I32 (Int32.minus_one), i
-        | NumPat {it = I64 _ as i; _} -> I64 (Int64.minus_one), i
-        | NumPat {it = F32 f; _} ->
-          I32 (Int32.minus_one), I32 (I32_convert.reinterpret_f32 f)
-        | NumPat {it = F64 f; _} ->
-          I64 (Int64.minus_one), I64 (I64_convert.reinterpret_f64 f)
-        | NanPat {it = F32 nan; _} ->
-          nan_bitmask_of nan I32Type, canonical_nan_of I32Type
-        | NanPat {it = F64 nan; _} ->
-          nan_bitmask_of nan I64Type, canonical_nan_of I64Type
-        | _ -> .
-      in
-      let masks, canons = List.split (List.map (fun p -> mask_and_canonical p) pats) in
-      let all_ones = V128.I32x4.of_lanes (List.init 4 (fun _ -> Int32.minus_one)) in
-      let mask, expected = match shape with
-        | V128.I8x16 () ->
-          all_ones, V128.I8x16.of_lanes (List.map (I32Num.of_num 0) canons)
-        | V128.I16x8 () ->
-          all_ones, V128.I16x8.of_lanes (List.map (I32Num.of_num 0) canons)
-        | V128.I32x4 () ->
-          all_ones, V128.I32x4.of_lanes (List.map (I32Num.of_num 0) canons)
-        | V128.I64x2 () ->
-          all_ones, V128.I64x2.of_lanes (List.map (I64Num.of_num 0) canons)
-        | V128.F32x4 () ->
-          V128.I32x4.of_lanes (List.map (I32Num.of_num 0) masks),
-          V128.I32x4.of_lanes (List.map (I32Num.of_num 0) canons)
-        | V128.F64x2 () ->
-          V128.I64x2.of_lanes (List.map (I64Num.of_num 0) masks),
-          V128.I64x2.of_lanes (List.map (I64Num.of_num 0) canons)
-      in
-      [ VecConst (V128 mask @@ at) @@ at;
-        VecBinaryBits (V128 V128Op.And) @@ at;
-        VecConst (V128 expected @@ at) @@ at;
-        VecCompare (V128 (V128.I8x16 V128Op.Eq)) @@ at;
-        (* If all lanes are non-zero, then they are equal *)
-        VecTest (V128 (V128.I8x16 V128Op.AllTrue)) @@ at;
-        Test (I32 I32Op.Eqz) @@ at;
-        BrIf (0l @@ at) @@ at ]
-    | RefResult (RefPat {it = Values.NullRef t; _}) ->
-      [ RefIsNull @@ at;
-        Test (Values.I32 I32Op.Eqz) @@ at;
-        BrIf (0l @@ at) @@ at ]
-    | RefResult (RefPat {it = ExternRef n; _}) ->
-      [ Const (Values.I32 n @@ at) @@ at;
-        Call (externref_idx @@ at) @@ at;
-        Call (eq_externref_idx @@ at)  @@ at;
-        Test (Values.I32 I32Op.Eqz) @@ at;
-        BrIf (0l @@ at) @@ at ]
-    | RefResult (RefPat _) ->
-      assert false
-    | RefResult (RefTypePat t) ->
-      let is_ref_idx =
-        match t with
-        | FuncRefType -> is_funcref_idx
-        | ExternRefType -> is_externref_idx
-      in
-      [ Call (is_ref_idx @@ at) @@ at;
-        Test (Values.I32 I32Op.Eqz) @@ at;
-        BrIf (0l @@ at) @@ at ]
-  in [], List.flatten (List.rev_map test ress)
-
-let wrap item_name wrap_action wrap_assertion at =
-  let itypes, idesc, iargs, action = wrap_action at in
-  let locals, assertion = wrap_assertion at in
-  let types =
-    (FuncType ([], []) @@ at) ::
-    (FuncType ([NumType I32Type], [RefType ExternRefType]) @@ at) ::
-    (FuncType ([RefType ExternRefType], [NumType I32Type]) @@ at) ::
-    (FuncType ([RefType FuncRefType], [NumType I32Type]) @@ at) ::
-    (FuncType ([RefType ExternRefType; RefType ExternRefType], [NumType I32Type]) @@ at) ::
-    (FuncType ([RefType FuncRefType; RefType FuncRefType], [NumType I32Type]) @@ at) ::
-    itypes
-  in
+    let masks, canons = List.split (List.map (fun p -> mask_and_canonical p) pats) in
+    let all_ones = V128.I32x4.of_lanes (List.init 4 (fun _ -> Int32.minus_one)) in
+    let mask, expected =
+      match shape with
+      | V128.I8x16 () ->
+        all_ones, V128.I8x16.of_lanes (List.map (I32Num.of_num 0) canons)
+      | V128.I16x8 () ->
+        all_ones, V128.I16x8.of_lanes (List.map (I32Num.of_num 0) canons)
+      | V128.I32x4 () ->
+        all_ones, V128.I32x4.of_lanes (List.map (I32Num.of_num 0) canons)
+      | V128.I64x2 () ->
+        all_ones, V128.I64x2.of_lanes (List.map (I64Num.of_num 0) canons)
+      | V128.F32x4 () ->
+        V128.I32x4.of_lanes (List.map (I32Num.of_num 0) masks),
+        V128.I32x4.of_lanes (List.map (I32Num.of_num 0) canons)
+      | V128.F64x2 () ->
+        V128.I64x2.of_lanes (List.map (I64Num.of_num 0) masks),
+        V128.I64x2.of_lanes (List.map (I64Num.of_num 0) canons)
+    in
+    [ VecConst (V128 mask @@ at) @@ at;
+      VecBinaryBits (V128 V128Op.And) @@ at;
+      VecConst (V128 expected @@ at) @@ at;
+      VecCompare (V128 (V128.I8x16 V128Op.Eq)) @@ at;
+      (* If all lanes are non-zero, then they are equal *)
+      VecTest (V128 (V128.I8x16 V128Op.AllTrue)) @@ at;
+      Test (I32 I32Op.Eqz) @@ at;
+      BrIf (0l @@ at) @@ at;
+    ]
+  | RefResult (RefPat {it = Values.NullRef t; _}) ->
+    [ RefIsNull @@ at;
+      Test (Values.I32 I32Op.Eqz) @@ at;
+      BrIf (0l @@ at) @@ at;
+    ]
+  | RefResult (RefPat {it = ExternRef n; _}) ->
+    let externref_idx = dep_spectest_externref deps in
+    let eq_externref_idx = dep_spectest_eq_externref deps in
+    [ Const (Values.I32 n @@ at) @@ at;
+      Call (externref_idx @@ at) @@ at;
+      Call (eq_externref_idx @@ at)  @@ at;
+      Test (Values.I32 I32Op.Eqz) @@ at;
+      BrIf (0l @@ at) @@ at;
+    ]
+  | RefResult (RefPat _) ->
+    assert false
+  | RefResult (RefTypePat t) ->
+    let is_ref_idx =
+      match t with
+      | FuncRefType -> dep_spectest_is_funcref deps
+      | ExternRefType -> dep_spectest_is_externref deps
+    in
+    [ Call (is_ref_idx @@ at) @@ at;
+      Test (Values.I32 I32Op.Eqz) @@ at;
+      BrIf (0l @@ at) @@ at;
+    ]
+
+let wasm_assertion mods deps ass : instr list * value_type list =
+  match ass.it with
+  | AssertReturn (act, ress) ->
+    [ Block (ValBlockType None,
+        fst (wasm_action mods deps act) @
+        List.concat_map (wasm_result deps) (List.rev ress) @
+        [Return @@ ass.at]
+      ) @@ ass.at;
+      Unreachable @@ ass.at;
+    ], []
+  | _ -> assert false
+
+let wasm_module mk_code mods phrase : string =
+  let at = phrase.at in
+  let deps = new_deps () in
+  let body, ts = mk_code mods deps phrase in
+  let ftype = dep_type deps (FuncType ([], ts)) @@ at in
+  let types = List.map (fun ft -> ft @@ at) deps.dtypes in
   let imports =
-    [ {module_name = Utf8.decode "module"; item_name; idesc} @@ at;
-      {module_name = Utf8.decode "spectest"; item_name = Utf8.decode "externref";
-       idesc = FuncImport (1l @@ at) @@ at} @@ at;
-      {module_name = Utf8.decode "spectest"; item_name = Utf8.decode "is_externref";
-       idesc = FuncImport (2l @@ at) @@ at} @@ at;
-      {module_name = Utf8.decode "spectest"; item_name = Utf8.decode "is_funcref";
-       idesc = FuncImport (3l @@ at) @@ at} @@ at;
-      {module_name = Utf8.decode "spectest"; item_name = Utf8.decode "eq_externref";
-       idesc = FuncImport (4l @@ at) @@ at} @@ at;
-      {module_name = Utf8.decode "spectest"; item_name = Utf8.decode "eq_funcref";
-       idesc = FuncImport (5l @@ at) @@ at} @@ at;
-    ] @ iargs
-  in
-  let item =
-    List.fold_left
-      (fun i im ->
-        match im.it.idesc.it with FuncImport _ -> Int32.add i 1l | _ -> i
-      ) 0l imports @@ at
+    Map.bindings deps.descs |>
+    List.concat_map (fun (x, nmap) ->
+      NameMap.bindings nmap |>
+      List.map (fun (item_name, (idesc', idx)) ->
+        let idesc = idesc' @@ at in
+        idx, {module_name = Utf8.decode x; item_name; idesc} @@ at
+      )
+    ) |>
+    List.sort compare |> List.map snd |> List.sort compare
   in
-  let edesc = FuncExport item @@ at in
+  let edesc = FuncExport (!(deps.func_idx) @@ at) @@ at in
   let exports = [{name = Utf8.decode "run"; edesc} @@ at] in
-  let body =
-    [ Block (ValBlockType None, action @ assertion @ [Return @@ at]) @@ at;
-      Unreachable @@ at ]
-  in
-  let funcs = [{ftype = 0l @@ at; locals; body} @@ at] in
+  let funcs = [{ftype; locals = []; body} @@ at] in
   let m = {empty_module with types; funcs; imports; exports} @@ at in
   Encode.encode m
 
 
-let is_js_num_type = function
-  | I32Type -> true
-  | I64Type | F32Type | F64Type -> false
-
-let is_js_value_type = function
-  | NumType t -> is_js_num_type t
-  | VecType t -> false
-  | RefType t -> true
-
-let is_js_global_type = function
-  | GlobalType (t, mut) -> is_js_value_type t
-
-let is_js_func_type = function
-  | FuncType (ts1, ts2) -> List.for_all is_js_value_type (ts1 @ ts2)
+(* Script conversion to plain JS *)
 
-
-(* Script conversion *)
+exception UnsupportedByJs
 
 let add_hex_char buf c = Printf.bprintf buf "\\x%02x" (Char.code c)
 let add_char buf c =
@@ -489,17 +548,17 @@ let add_unicode_char buf uc =
   else
     add_char buf (Char.chr uc)
 
-let of_string_with iter add_char s =
+let js_string_with iter add_char s =
   let buf = Buffer.create 256 in
   Buffer.add_char buf '\"';
   iter (add_char buf) s;
   Buffer.add_char buf '\"';
   Buffer.contents buf
 
-let of_bytes = of_string_with String.iter add_hex_char
-let of_name = of_string_with List.iter add_unicode_char
+let js_bytes = js_string_with String.iter add_hex_char
+let js_name = js_string_with List.iter add_unicode_char
 
-let of_float z =
+let js_float z =
   match string_of_float z with
   | "nan" -> "NaN"
   | "-nan" -> "-NaN"
@@ -507,143 +566,107 @@ let of_float z =
   | "-inf" -> "-Infinity"
   | s -> s
 
-let of_num n =
+let js_num n =
   let open Values in
   match n with
   | I32 i -> I32.to_string_s i
   | I64 i -> I64.to_string_s i ^ "n"
-  | F32 z -> of_float (F32.to_float z)
-  | F64 z -> of_float (F64.to_float z)
-
-let of_vec v =
-  let at = Source.no_region in
-  let gtype = GlobalType (VecType (Values.type_of_vec v), Immutable) in
-  let ginit = [VecConst (v @@ at) @@ at] @@ at in
-  let globals = [{gtype; ginit} @@ at] in
-  let edesc = GlobalExport (0l @@ at) @@ at in
-  let exports = [{name = Utf8.decode "v128"; edesc} @@ at] in
-  let bs = Encode.encode ({empty_module with globals; exports} @@ at) in
-  "instance(" ^ of_bytes bs ^ ").exports.v128"
-
-let of_ref r =
+  | F32 z -> js_float (F32.to_float z)
+  | F64 z -> js_float (F64.to_float z)
+
+let js_vec v =
+  raise UnsupportedByJs
+
+let js_ref r =
   let open Values in
   match r with
   | NullRef _ -> "null"
   | ExternRef n -> "externref(" ^ Int32.to_string n ^ ")"
-  | _ -> assert false
+  | _ -> raise UnsupportedByJs
 
-let of_literal lit =
+let js_literal lit =
   let open Values in
   match lit.it with
-  | Num n -> of_num n
-  | Vec v -> of_vec v
-  | Ref r -> of_ref r
-
-let of_nan = function
-  | CanonicalNan -> "\"nan:canonical\""
-  | ArithmeticNan -> "\"nan:arithmetic\""
-
-let of_num_pat = function
-  | NumPat num -> of_num num.it
-  | NanPat nanop ->
-    match nanop.it with
-    | Values.I32 _ | Values.I64 _ -> .
-    | Values.F32 n | Values.F64 n -> of_nan n
-
-let of_vec_pat = function
-  | VecPat (Values.V128 (shape, pats)) ->
-    Printf.sprintf "v128(\"%s\")" (String.concat " " (List.map of_num_pat pats))
-
-let of_ref_pat = function
-  | RefPat r -> of_ref r.it
+  | Num n -> js_num n
+  | Vec v -> js_vec v
+  | Ref r -> js_ref r
+
+let js_num_pat = function
+  | NumPat num ->
+    if num = num then js_num num.it else raise UnsupportedByJs (* NaN *)
+  | NanPat nanop -> raise UnsupportedByJs
+
+let js_vec_pat = function
+  | VecPat _ -> raise UnsupportedByJs
+
+let js_ref_pat = function
+  | RefPat r -> js_ref r.it
   | RefTypePat t -> "\"ref." ^ string_of_refed_type t ^ "\""
 
-let of_result res =
+let js_result res =
   match res.it with
-  | NumResult np -> of_num_pat np
-  | VecResult vp -> of_vec_pat vp
-  | RefResult rp -> of_ref_pat rp
+  | NumResult np -> js_num_pat np
+  | VecResult vp -> js_vec_pat vp
+  | RefResult rp -> js_ref_pat rp
 
-let rec of_definition def =
+let rec js_definition def =
   match def.it with
-  | Textual m -> of_bytes (Encode.encode m)
-  | Encoded (_, bs) -> of_bytes bs
+  | Textual m -> js_bytes (Encode.encode m)
+  | Encoded (_, bs) -> js_bytes bs
   | Quoted (_, s) ->
-    try of_definition (Parse.string_to_module s) with Parse.Syntax _ ->
-      of_bytes "<malformed quote>"
+    try js_definition (Parse.string_to_module s) with Parse.Syntax _ ->
+      js_bytes "<malformed quote>"
 
-let of_arg_import i opd =
-  "arg" ^ string_of_int i ^ ": " ^ opd
-
-let of_wrapper mods x_opt name wrap_action opds wrap_assertion at =
-  let x = of_var_opt mods x_opt in
-  let bs = wrap name wrap_action wrap_assertion at in
-  let exs = if opds = [] then "exports(" ^ x ^ ")" else
-    "{...exports(" ^ x ^ "), " ^
-    "args: [" ^ String.concat ", " (List.mapi of_arg_import opds) ^ "]}"
-  in "call(instance(" ^ of_bytes bs ^ ", " ^ exs ^ "), \"run\", [])"
-
-let rec of_action mods act =
+let rec js_action mods act =
   match act.it with
   | Invoke (x_opt, name, args) ->
-    let opds = List.map (of_argument mods) args in
-    "call(" ^ of_var_opt mods x_opt ^ ", " ^ of_name name ^ ", " ^
-      "[" ^ String.concat ", " opds ^ "].flat())",
-    let FuncType (_, ts2) as ft = lookup_func mods x_opt name act.at in
-    if is_js_func_type ft then None else
-    Some (of_wrapper mods x_opt name (invoke ft) opds, ts2)
+    "call(" ^ var_opt mods x_opt ^ ", " ^ js_name name ^ ", " ^
+      "[" ^ String.concat ", " (List.map (js_argument mods) args) ^
+      "].flat())"
   | Get (x_opt, name) ->
-    "get(" ^ of_var_opt mods x_opt ^ ", " ^ of_name name ^ ")",
-    let GlobalType (t, _) as gt = lookup_global mods x_opt name act.at in
-    if is_js_global_type gt then None else
-    Some (of_wrapper mods x_opt name (get gt) [], [t])
+    "get(" ^ var_opt mods x_opt ^ ", " ^ js_name name ^ ")"
   | Set (x_opt, name, arg) ->
-    let opd = of_argument mods arg in
-    "set(" ^ of_var_opt mods x_opt ^ ", " ^ of_name name ^ ", " ^ opd ^ ")",
-    let GlobalType (t, _) as gt = lookup_global mods x_opt name act.at in
-    if is_js_global_type gt then None else
-    Some (of_wrapper mods x_opt name (set gt) [opd], [t])
+    "set(" ^ var_opt mods x_opt ^ ", " ^ js_name name ^ ", " ^
+      js_argument mods arg ^ ")"
 
-and of_argument mods arg =
+and js_argument mods arg =
   match arg.it with
-  | LiteralArg lit -> of_literal lit
-  | ActionArg act ->
-    let act_js, act_wrapper_opt = of_action mods act in
-    match act_wrapper_opt with
-    | None -> act_js
-    | Some (act_wrapper, ts) -> act_wrapper (run ts) act.at
-
-let of_assertion' mods act name args wrapper_opt =
-  let act_js, act_wrapper_opt = of_action mods act in
-  let js = name ^ "(() => " ^ act_js ^ String.concat ", " ("" :: args) ^ ")" in
-  match act_wrapper_opt with
-  | None -> js ^ ";"
-  | Some (act_wrapper, ts) ->
-    let run_name, wrapper =
-      match wrapper_opt with
-      | None -> name, run
-      | Some wrapper -> "run", wrapper
-    in run_name ^ "(() => " ^ act_wrapper (wrapper ts) act.at ^ ");  // " ^ js
-
-let of_assertion mods ass =
+  | LiteralArg lit -> js_literal lit
+  | ActionArg act -> js_action mods act
+
+let js_run_wasm bs =
+  "call(instance(" ^ js_bytes bs ^ ", registry), \"run\", [])"
+
+let js_or_wasm_action mods act =
+  try js_action mods act
+  with UnsupportedByJs -> js_run_wasm (wasm_module wasm_action mods act)
+^ "\n/*\n" ^ Sexpr.to_string 80 (Arrange.module_ (Decode.decode "wrapper" (wasm_module wasm_action mods act))) ^ "*/\n"
+
+let js_assertion mods ass =
   match ass.it with
   | AssertMalformed (def, _) ->
-    "assert_malformed(" ^ of_definition def ^ ");"
+    "assert_malformed(" ^ js_definition def ^ ")"
   | AssertInvalid (def, _) ->
-    "assert_invalid(" ^ of_definition def ^ ");"
+    "assert_invalid(" ^ js_definition def ^ ")"
   | AssertUnlinkable (def, _) ->
-    "assert_unlinkable(" ^ of_definition def ^ ");"
+    "assert_unlinkable(" ^ js_definition def ^ ")"
   | AssertUninstantiable (def, _) ->
-    "assert_uninstantiable(" ^ of_definition def ^ ");"
+    "assert_uninstantiable(" ^ js_definition def ^ ")"
   | AssertReturn (act, ress) ->
-    of_assertion' mods act "assert_return" (List.map of_result ress)
-      (Some (assert_return ress))
+    (try
+      let js_ress = List.map js_result ress in
+      "assert_return(() => " ^ js_or_wasm_action mods act ^
+        String.concat ", " ("" :: js_ress) ^ ")"
+    with UnsupportedByJs ->
+      js_run_wasm (wasm_module wasm_assertion mods ass)
+^ "\n/*\n" ^ Sexpr.to_string 80 (Arrange.module_ (Decode.decode "wrapper" (wasm_module wasm_assertion mods ass))) ^ "*/\n"
+    )
   | AssertTrap (act, _) ->
-    of_assertion' mods act "assert_trap" [] None
+    "assert_trap(() => " ^ js_or_wasm_action mods act ^ ")"
   | AssertExhaustion (act, _) ->
-    of_assertion' mods act "assert_exhaustion" [] None
+    "assert_exhaustion(() => " ^ js_or_wasm_action mods act ^ ")"
 
-let of_command mods cmd =
+let js_command mods cmd =
   "\n// " ^ Filename.basename cmd.at.left.file ^
     ":" ^ string_of_int cmd.at.left.line ^ "\n" ^
   match cmd.it with
@@ -653,18 +676,23 @@ let of_command mods cmd =
       | Textual m -> m
       | Encoded (_, bs) -> Decode.decode "binary" bs
       | Quoted (_, s) -> unquote (Parse.string_to_module s)
-    in bind mods x_opt (unquote def);
-    "let " ^ current_var mods ^ " = instance(" ^ of_definition def ^ ");\n" ^
-    (if x_opt = None then "" else
-    "let " ^ of_var_opt mods x_opt ^ " = " ^ current_var mods ^ ";\n")
+    in
+    bind mods x_opt (unquote def);
+    let xi = current_var mods in
+    "let " ^ current_var mods ^
+      " = register(\"" ^ xi ^ "\", instance(" ^ js_definition def ^ "));\n" ^
+    ( if x_opt = None then "" else
+      let x = var_opt mods x_opt in
+      "let " ^ x ^ " = register(\"" ^ x ^ "\", " ^ xi ^ ");\n"
+    )
   | Register (name, x_opt) ->
-    "register(" ^ of_name name ^ ", " ^ of_var_opt mods x_opt ^ ")\n"
+    "register(" ^ js_name name ^ ", " ^ var_opt mods x_opt ^ ");\n"
   | Action act ->
-    of_assertion' mods act "run" [] None ^ "\n"
+    js_or_wasm_action mods act ^ ";\n"
   | Assertion ass ->
-    of_assertion mods ass ^ "\n"
+    js_assertion mods ass ^ ";\n"
   | Meta _ -> assert false
 
 let of_script scr =
   (if !Flags.harness then harness else "") ^
-  String.concat "" (List.map (of_command (modules ())) scr)
+  String.concat "" (List.map (js_command (modules ())) scr)

From 23637b766501a4f5117c65724654b9915fd980ce Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Thu, 9 Feb 2023 18:39:21 +0100
Subject: [PATCH 5/8] Mask unsupported but unused result types

---
 interpreter/script/js.ml | 30 ++++++++++++++++++++++++++----
 1 file changed, 26 insertions(+), 4 deletions(-)

diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml
index 2b07bab2de..442fbf020d 100644
--- a/interpreter/script/js.ml
+++ b/interpreter/script/js.ml
@@ -123,6 +123,7 @@ function run(action) {
 function assert_malformed(bytes) {
   try { module(bytes, false) } catch (e) {
     if (e instanceof WebAssembly.CompileError) return;
+    throw new Error("Wasm decoding failure expected, got: " + e);
   }
   throw new Error("Wasm decoding failure expected");
 }
@@ -130,6 +131,7 @@ function assert_malformed(bytes) {
 function assert_invalid(bytes) {
   try { module(bytes, false) } catch (e) {
     if (e instanceof WebAssembly.CompileError) return;
+    throw new Error("Wasm validation failure expected, got: " + e);
   }
   throw new Error("Wasm validation failure expected");
 }
@@ -138,6 +140,7 @@ function assert_unlinkable(bytes) {
   let mod = module(bytes);
   try { new WebAssembly.Instance(mod, registry) } catch (e) {
     if (e instanceof WebAssembly.LinkError) return;
+    throw new Error("Wasm linking failure expected, got: " + e);
   }
   throw new Error("Wasm linking failure expected");
 }
@@ -146,6 +149,7 @@ function assert_uninstantiable(bytes) {
   let mod = module(bytes);
   try { new WebAssembly.Instance(mod, registry) } catch (e) {
     if (e instanceof WebAssembly.RuntimeError) return;
+    throw new Error("Wasm trap failure expected, got: " + e);
   }
   throw new Error("Wasm trap expected");
 }
@@ -153,6 +157,7 @@ function assert_uninstantiable(bytes) {
 function assert_trap(action) {
   try { action() } catch (e) {
     if (e instanceof WebAssembly.RuntimeError) return;
+    throw new Error("Wasm trap expected, got: " + e);
   }
   throw new Error("Wasm trap expected");
 }
@@ -163,6 +168,7 @@ try { (function f() { 1 + f() })() } catch (e) { StackOverflow = e.constructor }
 function assert_exhaustion(action) {
   try { action() } catch (e) {
     if (e instanceof StackOverflow) return;
+    throw new Error("Wasm resource exhaustion expected, got: " + e);
   }
   throw new Error("Wasm resource exhaustion expected");
 }
@@ -214,6 +220,19 @@ module Error = Error.Make ()
 
 exception Error = Error.Error
 
+exception UnsupportedByJs
+
+let js_val_type = function
+  | NumType _ -> ()
+  | VecType _ -> raise UnsupportedByJs
+  | RefType _ -> ()
+
+let js_global_type = function
+  | GlobalType (t, _mut) -> js_val_type t
+
+let js_func_type = function
+  | FuncType (ts1, ts2) -> List.iter js_val_type (ts1 @ ts2)
+
 
 (* Context *)
 
@@ -509,8 +528,9 @@ let wasm_assertion mods deps ass : instr list * value_type list =
 let wasm_module mk_code mods phrase : string =
   let at = phrase.at in
   let deps = new_deps () in
-  let body, ts = mk_code mods deps phrase in
-  let ftype = dep_type deps (FuncType ([], ts)) @@ at in
+  let code, ts = mk_code mods deps phrase in
+  let ts' = try List.iter js_val_type ts; ts with UnsupportedByJs -> [] in
+  let ftype = dep_type deps (FuncType ([], ts')) @@ at in
   let types = List.map (fun ft -> ft @@ at) deps.dtypes in
   let imports =
     Map.bindings deps.descs |>
@@ -525,6 +545,7 @@ let wasm_module mk_code mods phrase : string =
   in
   let edesc = FuncExport (!(deps.func_idx) @@ at) @@ at in
   let exports = [{name = Utf8.decode "run"; edesc} @@ at] in
+  let body = code @ (if ts = ts' then [] else [Return @@ at]) in
   let funcs = [{ftype; locals = []; body} @@ at] in
   let m = {empty_module with types; funcs; imports; exports} @@ at in
   Encode.encode m
@@ -532,8 +553,6 @@ let wasm_module mk_code mods phrase : string =
 
 (* Script conversion to plain JS *)
 
-exception UnsupportedByJs
-
 let add_hex_char buf c = Printf.bprintf buf "\\x%02x" (Char.code c)
 let add_char buf c =
   if c < '\x20' || c >= '\x7f' then
@@ -620,12 +639,15 @@ let rec js_definition def =
 let rec js_action mods act =
   match act.it with
   | Invoke (x_opt, name, args) ->
+    js_func_type (lookup_func mods x_opt name act.at);
     "call(" ^ var_opt mods x_opt ^ ", " ^ js_name name ^ ", " ^
       "[" ^ String.concat ", " (List.map (js_argument mods) args) ^
       "].flat())"
   | Get (x_opt, name) ->
+    js_global_type (lookup_global mods x_opt name act.at);
     "get(" ^ var_opt mods x_opt ^ ", " ^ js_name name ^ ")"
   | Set (x_opt, name, arg) ->
+    js_global_type (lookup_global mods x_opt name act.at);
     "set(" ^ var_opt mods x_opt ^ ", " ^ js_name name ^ ", " ^
       js_argument mods arg ^ ")"
 

From 72944ae97c64182c2d31cc5c2584623696445213 Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Thu, 9 Feb 2023 19:45:55 +0100
Subject: [PATCH 6/8] More fixes

---
 interpreter/script/js.ml | 11 +++++------
 test/core/script.wast    | 16 +++++++++++++---
 2 files changed, 18 insertions(+), 9 deletions(-)

diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml
index 442fbf020d..e4e491472d 100644
--- a/interpreter/script/js.ml
+++ b/interpreter/script/js.ml
@@ -102,15 +102,15 @@ function call(instance, name, args) {
 
 function get(instance, name) {
   let global = instance.exports[name];
-  if (v instanceof WebAssembly.Global) return v.value;
+  if (global instanceof WebAssembly.Global) return global.value;
   throw new Error("Wasm global expected");
 }
 
 function set(instance, name, arg) {
   let global = instance.exports[name];
-  if (v instanceof WebAssembly.Global) {
+  if (global instanceof WebAssembly.Global) {
     try {
-      v.value = arg; return;
+      global.value = arg; return;
     } catch (e) {}
   }
   throw new Error("Wasm mutable global expected");
@@ -578,9 +578,8 @@ let js_bytes = js_string_with String.iter add_hex_char
 let js_name = js_string_with List.iter add_unicode_char
 
 let js_float z =
-  match string_of_float z with
-  | "nan" -> "NaN"
-  | "-nan" -> "-NaN"
+  match Printf.sprintf "%.17g" z with
+  | "nan" | "-nan" -> raise UnsupportedByJs
   | "inf" -> "Infinity"
   | "-inf" -> "-Infinity"
   | s -> s
diff --git a/test/core/script.wast b/test/core/script.wast
index 59cb902ea6..6a7b9bd6df 100644
--- a/test/core/script.wast
+++ b/test/core/script.wast
@@ -15,7 +15,6 @@
   (func (export "swap") (param i32 i32) (result i32 i32)
     (local.get 1) (local.get 0)
   )
-  (func (export "nop"))
 )
 
 (assert_return (get "g") (i32.const 42))
@@ -29,6 +28,8 @@
 (assert_return (get "g") (i32.const 44))
 (set "g" (invoke $m1 "inc" (get "g")))
 (assert_return (get "g") (i32.const 45))
+(assert_return (get $m1 "g") (i32.const 41))
+(assert_return (get $m2 "g") (i32.const 45))
 
 (assert_return (invoke "f") (i32.const 42))
 (assert_return (invoke $m1 "f") (i32.const 41))
@@ -39,8 +40,17 @@
 (assert_return (invoke $m1 "inc" (get $m2 "g")) (i32.const 46))
 (assert_return (invoke $m1 "inc" (invoke $m1 "inc" (get "g"))) (i32.const 47))
 
-(assert_return (invoke "add3" (get $m1 "g") (invoke $m1 "inc" (get "g")) (get "g")) (i32.const 132))
-(assert_return (invoke "add3" (invoke "swap" (get $m1 "g") (invoke "nop") (invoke $m1 "inc" (get "g"))) (i32.const -20)) (i32.const 67))
+(assert_return
+  (invoke "add3" (get $m1 "g") (invoke $m1 "inc" (get "g")) (get "g"))
+  (i32.const 132)
+ )
+(assert_return
+  (invoke "add3"
+    (invoke "swap" (get $m1 "g") (invoke $m1 "inc" (get "g")))
+    (i32.const -20)
+  )
+  (i32.const 67)
+)
 
 
 (module

From fe26ca145bf2a06b30bb6106e049cf692e94921a Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Thu, 9 Feb 2023 20:35:54 +0100
Subject: [PATCH 7/8] Deactivate code node/V8 can't handle

---
 interpreter/script/js.ml | 2 --
 test/core/script.wast    | 4 +++-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml
index e4e491472d..2a3502a900 100644
--- a/interpreter/script/js.ml
+++ b/interpreter/script/js.ml
@@ -661,7 +661,6 @@ let js_run_wasm bs =
 let js_or_wasm_action mods act =
   try js_action mods act
   with UnsupportedByJs -> js_run_wasm (wasm_module wasm_action mods act)
-^ "\n/*\n" ^ Sexpr.to_string 80 (Arrange.module_ (Decode.decode "wrapper" (wasm_module wasm_action mods act))) ^ "*/\n"
 
 let js_assertion mods ass =
   match ass.it with
@@ -680,7 +679,6 @@ let js_assertion mods ass =
         String.concat ", " ("" :: js_ress) ^ ")"
     with UnsupportedByJs ->
       js_run_wasm (wasm_module wasm_assertion mods ass)
-^ "\n/*\n" ^ Sexpr.to_string 80 (Arrange.module_ (Decode.decode "wrapper" (wasm_module wasm_assertion mods ass))) ^ "*/\n"
     )
   | AssertTrap (act, _) ->
     "assert_trap(() => " ^ js_or_wasm_action mods act ^ ")"
diff --git a/test/core/script.wast b/test/core/script.wast
index 6a7b9bd6df..4c1776b0dd 100644
--- a/test/core/script.wast
+++ b/test/core/script.wast
@@ -75,7 +75,9 @@
 (assert_return (invoke "f-i64" (get "g-i64")) (i64.const 42))
 (assert_return (invoke "f-f32" (get "g-f32")) (f32.const 42))
 (assert_return (invoke "f-f64" (get "g-f64")) (f64.const 42))
-(assert_return (invoke "f-v128" (get "g-v128")) (v128.const i32x4 42 42 42 42))
+(assert_return (invoke "f-v128" (v128.const i32x4 42 42 42 42)) (v128.const i32x4 42 42 42 42))
+;; Importing v128 globals crashes V8 in node.js 18.14.0, so this fails in CI!
+;; (assert_return (invoke "f-v128" (get "g-v128")) (v128.const i32x4 42 42 42 42))
 (assert_return (invoke "f-funcref" (get "g-funcref")) (ref.null func))
 (assert_return (invoke "f-externref" (get "g-externref")) (ref.null extern))
 

From 04095ab77d576d10561660fd9913a64be7fe9107 Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Thu, 16 Feb 2023 11:41:33 +0100
Subject: [PATCH 8/8] Tweak comment

---
 test/core/script.wast | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/test/core/script.wast b/test/core/script.wast
index 4c1776b0dd..e5b562408d 100644
--- a/test/core/script.wast
+++ b/test/core/script.wast
@@ -76,7 +76,8 @@
 (assert_return (invoke "f-f32" (get "g-f32")) (f32.const 42))
 (assert_return (invoke "f-f64" (get "g-f64")) (f64.const 42))
 (assert_return (invoke "f-v128" (v128.const i32x4 42 42 42 42)) (v128.const i32x4 42 42 42 42))
-;; Importing v128 globals crashes V8 in node.js 18.14.0, so this fails in CI!
+;; TODO: Reactivate once the fix for https://bugs.chromium.org/p/v8/issues/detail?id=13732
+;; has made it to the downstream node.js version that we use on CI.
 ;; (assert_return (invoke "f-v128" (get "g-v128")) (v128.const i32x4 42 42 42 42))
 (assert_return (invoke "f-funcref" (get "g-funcref")) (ref.null func))
 (assert_return (invoke "f-externref" (get "g-externref")) (ref.null extern))