From 7439f3a16f47623b744f8e8aca0847b93655a826 Mon Sep 17 00:00:00 2001
From: zapashcanon <leo@ndrs.fr>
Date: Tue, 23 Jul 2024 15:59:19 +0200
Subject: [PATCH] actually parse inline binary module in scripts

---
 src/ast/text.ml             |  6 ++++--
 src/parser/text_parser.mly  | 15 ++++++++-------
 src/script/script.ml        | 16 ++++++++++++++--
 src/script/spectest.ml      |  2 +-
 test/script/reference.t     |  2 --
 test/script/reference_opt.t |  2 --
 6 files changed, 27 insertions(+), 16 deletions(-)

diff --git a/src/ast/text.ml b/src/ast/text.ml
index 7cbcad8f9..bc9baa8cb 100644
--- a/src/ast/text.ml
+++ b/src/ast/text.ml
@@ -178,13 +178,15 @@ type register = string * string option
 let pp_register fmt (s, _name) = pf fmt "(register %s)" s
 
 type cmd =
-  | Module of modul
+  | Binary_module of string option * string
+  | Text_module of modul
   | Assert of assertion
   | Register of string * string option
   | Action of action
 
 let pp_cmd fmt = function
-  | Module m -> pp_modul fmt m
+  | Binary_module (id, m) -> Fmt.pf fmt "(module %a %S)" Types.pp_id_opt id m
+  | Text_module m -> pp_modul fmt m
   | Assert a -> pp_assertion fmt a
   | Register (s, name) -> pp_register fmt (s, name)
   | Action _a -> pf fmt "<action>"
diff --git a/src/parser/text_parser.mly b/src/parser/text_parser.mly
index 741a797ce..be0567347 100644
--- a/src/parser/text_parser.mly
+++ b/src/parser/text_parser.mly
@@ -1008,10 +1008,8 @@ let modul :=
   }
 
 let module_binary :=
-  | MODULE; id = ioption(id); BINARY; ~ = inline_module_inner; _ = list(NAME); {
-    (* TODO: handle fields_bin
-    let fields_bin = String.concat "" l in *)
-    { inline_module_inner with id }
+  | MODULE; id = ioption(id); BINARY; lines = list(NAME); {
+    id, String.concat "" lines
   }
 
 let literal_const ==
@@ -1079,8 +1077,11 @@ let action ==
   | GET; ~ = ioption(id); ~ = utf8_name; <Get>
 
 let cmd ==
-  | ~ = modul; <Module>
-  | ~ = par(module_binary); <Module>
+  | ~ = modul; <Text_module>
+  | bm = par(module_binary); {
+    let id, m = bm in
+    Binary_module (id, m)
+  }
   | ~ = par(assert_); <Assert>
   | ~ = par(register); <>
   | ~ = par(action); <Action>
@@ -1088,5 +1089,5 @@ let cmd ==
 let script :=
   | ~ = nonempty_list(cmd); EOF; <>
   | ~ = inline_module_inner; EOF; {
-    [ Module inline_module_inner ]
+    [ Text_module inline_module_inner ]
   }
diff --git a/src/script/script.ml b/src/script/script.ml
index c36c46364..dc452b7e8 100644
--- a/src/script/script.ml
+++ b/src/script/script.ml
@@ -152,7 +152,7 @@ let run ~no_exhaustion ~optimize script =
   let curr_module = ref 0 in
   list_fold_left
     (fun (link_state : Concrete_value.Func.extern_func Link.state) -> function
-      | Text.Module m ->
+      | Text.Text_module m ->
         if !curr_module = 0 then Log.debug_on := false;
         Log.debug0 "*** module@\n";
         incr curr_module;
@@ -161,6 +161,18 @@ let run ~no_exhaustion ~optimize script =
         in
         Log.debug_on := debug_on;
         link_state
+      | Text.Binary_module (id, m) ->
+        if !curr_module = 0 then Log.debug_on := false;
+        Log.debug0 "*** binary module@\n";
+        incr curr_module;
+        let* m = Parse.Binary.Module.from_string m in
+        let m = { m with id } in
+        let+ link_state =
+          Compile.Binary.until_interpret link_state ~unsafe ~optimize ~name:None
+            m
+        in
+        Log.debug_on := debug_on;
+        link_state
       | Assert (Assert_trap_module (m, expected)) ->
         Log.debug0 "*** assert_trap@\n";
         incr curr_module;
@@ -182,7 +194,7 @@ let run ~no_exhaustion ~optimize script =
         let+ () =
           match got with
           | Error got -> check_error ~expected ~got
-          | Ok [ Module m ] ->
+          | Ok [ Text_module m ] ->
             let got = Compile.Text.until_binary ~unsafe m in
             check_error_result expected got
           | _ -> assert false
diff --git a/src/script/spectest.ml b/src/script/spectest.ml
index 77ef66a50..e7404e285 100644
--- a/src/script/spectest.ml
+++ b/src/script/spectest.ml
@@ -49,7 +49,7 @@ let extern_m =
 
 let m =
   let open Text in
-  Text.Module
+  Text.Text_module
     { id = Some "spectest"
     ; fields =
         [ MImport
diff --git a/test/script/reference.t b/test/script/reference.t
index 1b89e21d9..706600b2c 100644
--- a/test/script/reference.t
+++ b/test/script/reference.t
@@ -30,8 +30,6 @@
   $ owi script --no-exhaustion reference/fac.wast
   $ owi script --no-exhaustion reference/float_exprs.wast
   $ owi script --no-exhaustion reference/float_literals.wast
-  unbound name 4294967249
-  [38]
   $ owi script --no-exhaustion reference/float_memory.wast
   $ owi script --no-exhaustion reference/float_misc.wast
   $ owi script --no-exhaustion reference/forward.wast
diff --git a/test/script/reference_opt.t b/test/script/reference_opt.t
index a79fa4fb5..73be5f4fa 100644
--- a/test/script/reference_opt.t
+++ b/test/script/reference_opt.t
@@ -30,8 +30,6 @@
   $ owi script --no-exhaustion --optimize reference/fac.wast
   $ owi script --no-exhaustion --optimize reference/float_exprs.wast
   $ owi script --no-exhaustion --optimize reference/float_literals.wast
-  unbound name 4294967249
-  [38]
   $ owi script --no-exhaustion --optimize reference/float_memory.wast
   $ owi script --no-exhaustion --optimize reference/float_misc.wast
   $ owi script --no-exhaustion --optimize reference/forward.wast