From 86cf829d9a29eb058cf8aafb9cd26a2ca5d03b11 Mon Sep 17 00:00:00 2001
From: zapashcanon <leo@ndrs.fr>
Date: Fri, 10 Nov 2023 19:39:58 +0100
Subject: [PATCH 1/9] switch to menhir

---
 interpreter/dune            |  5 ++-
 interpreter/dune-project    |  5 ++-
 interpreter/jslib/wast.ml   |  4 +-
 interpreter/script/js.ml    |  9 +++-
 interpreter/script/run.ml   | 35 +++++++++------
 interpreter/text/arrange.ml | 10 +++--
 interpreter/text/parse.ml   | 88 +++++++++++++++++++++++++------------
 interpreter/text/parse.mli  | 30 +++++++++----
 interpreter/text/parser.mly | 13 ++----
 interpreter/wasm.opam       |  1 +
 10 files changed, 131 insertions(+), 69 deletions(-)

diff --git a/interpreter/dune b/interpreter/dune
index 9a853921db..e221bea7a1 100644
--- a/interpreter/dune
+++ b/interpreter/dune
@@ -6,7 +6,8 @@
  ; Wasm REPL every time in all the dependencies.
  ; We exclude the 'wast' module as it is only used for the JS build.
  ; 'smallint' is a separate test module.
- (modules :standard \ main wasm smallint wast))
+ (modules :standard \ main wasm smallint wast)
+ (libraries menhirLib))
 
 (executable
  (public_name wasm)
@@ -43,7 +44,7 @@
    (chdir
     %{workspace_root}
     (run %{bin:ocamllex} -ml -q -o %{target} %{deps}))))
- (ocamlyacc
+ (menhir
   (modules parser)))
 
 (env
diff --git a/interpreter/dune-project b/interpreter/dune-project
index 0d15135d31..8392b339f5 100644
--- a/interpreter/dune-project
+++ b/interpreter/dune-project
@@ -3,6 +3,8 @@
 (name wasm)
 
 (generate_opam_files true)
+(using menhir 2.1)
+(implicit_transitive_deps false)
 
 (license Apache-2.0)
 
@@ -17,4 +19,5 @@
   (synopsis "Library to read and write WebAssembly (Wasm) files and manipulate their AST")
   (tags (wasm webassembly spec interpreter))
   (depends
-    (ocaml (>= 4.12))))
+    (ocaml (>= 4.12))
+    (menhir (>= 20220210))))
diff --git a/interpreter/jslib/wast.ml b/interpreter/jslib/wast.ml
index 0ab4bd8fdd..407de555e1 100644
--- a/interpreter/jslib/wast.ml
+++ b/interpreter/jslib/wast.ml
@@ -4,12 +4,12 @@
 open Wasm
 open Js_of_ocaml
 
-let _ =
+let () =
   Js.export "WebAssemblyText"
     (object%js (_self)
 
       method encode (s : Js.js_string Js.t) : (Typed_array.arrayBuffer Js.t) =
-        let def = Parse.string_to_module (Js.to_string s) in
+        let def = snd @@ Parse.Module.from_string (Js.to_string s) in
         let bs =
           match def.Source.it with
           | Script.Textual m -> (Encode.encode m)
diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml
index 2eb849a6c1..d172f58026 100644
--- a/interpreter/script/js.ml
+++ b/interpreter/script/js.ml
@@ -526,7 +526,10 @@ let rec of_definition def =
   | Textual m -> of_bytes (Encode.encode m)
   | Encoded (_, bs) -> of_bytes bs
   | Quoted (_, s) ->
-    try of_definition (Parse.string_to_module s) with Parse.Syntax _ ->
+    try
+      let _v, m = Parse.Module.from_string s in
+      of_definition m
+    with Script.Syntax _ ->
       of_bytes "<malformed quote>"
 
 let of_wrapper mods x_opt name wrap_action wrap_assertion at =
@@ -594,7 +597,9 @@ let of_command mods cmd =
       match def.it with
       | Textual m -> m
       | Encoded (_, bs) -> Decode.decode "binary" bs
-      | Quoted (_, s) -> unquote (Parse.string_to_module s)
+      | Quoted (_, s) ->
+          let _v, m = Parse.Module.from_string s in
+          unquote m
     in bind mods x_opt (unquote def);
     "let " ^ current_var mods ^ " = instance(" ^ of_definition def ^ ");\n" ^
     (if x_opt = None then "" else
diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml
index e0019d84a0..8797718ba9 100644
--- a/interpreter/script/run.ml
+++ b/interpreter/script/run.ml
@@ -105,7 +105,7 @@ let input_from get_script run =
     true
   with
   | Decode.Code (at, msg) -> error at "decoding error" msg
-  | Parse.Syntax (at, msg) -> error at "syntax error" msg
+  | Syntax (at, msg) -> error at "syntax error" msg
   | Valid.Invalid (at, msg) -> error at "invalid module" msg
   | Import.Unknown (at, msg) -> error at "link failure" msg
   | Eval.Link (at, msg) -> error at "link failure" msg
@@ -118,17 +118,26 @@ let input_from get_script run =
   | Assert (at, msg) -> error at "assertion failure" msg
   | Abort _ -> false
 
-let input_script start name lexbuf run =
-  input_from (fun _ -> Parse.parse name lexbuf start) run
+let input_script name lexbuf run =
+  input_from (fun () ->
+    Lexing.set_filename lexbuf name;
+    Parse.Script.from_lexbuf lexbuf)
+  run
+
+let input_script1 name lexbuf run =
+  input_from (fun () ->
+    Lexing.set_filename lexbuf name;
+    Parse.Script1.from_lexbuf lexbuf)
+  run
 
 let input_sexpr name lexbuf run =
-  input_from (fun _ ->
-    let var_opt, def = Parse.parse name lexbuf Parse.Module in
+  input_from (fun () ->
+    let var_opt, def = Parse.Module.from_lexbuf lexbuf in
     [Module (var_opt, def) @@ no_region]) run
 
 let input_binary name buf run =
   let open Source in
-  input_from (fun _ ->
+  input_from (fun () ->
     [Module (None, Encoded (name, buf) @@ no_region) @@ no_region]) run
 
 let input_sexpr_file input file run =
@@ -162,8 +171,8 @@ let input_file file run =
   dispatch_file_ext
     input_binary_file
     (input_sexpr_file input_sexpr)
-    (input_sexpr_file (input_script Parse.Script))
-    (input_sexpr_file (input_script Parse.Script))
+    (input_sexpr_file (input_script))
+    (input_sexpr_file (input_script))
     input_js_file
     file run
 
@@ -171,7 +180,7 @@ let input_string string run =
   trace ("Running (\"" ^ String.escaped string ^ "\")...");
   let lexbuf = Lexing.from_string string in
   trace "Parsing...";
-  input_script Parse.Script "string" lexbuf run
+  input_script "string" lexbuf run
 
 
 (* Interactive *)
@@ -195,7 +204,7 @@ let lexbuf_stdin buf len =
 let input_stdin run =
   let lexbuf = Lexing.from_function lexbuf_stdin in
   let rec loop () =
-    let success = input_script Parse.Script1 "stdin" lexbuf run in
+    let success = input_script1 "stdin" lexbuf run in
     if not success then Lexing.flush_input lexbuf;
     if Lexing.(lexbuf.lex_curr_pos >= lexbuf.lex_buffer_len - 1) then
       continuing := false;
@@ -337,8 +346,8 @@ let rec run_definition def : Ast.module_ =
     Decode.decode name bs
   | Quoted (_, s) ->
     trace "Parsing quote...";
-    let def' = Parse.string_to_module s in
-    run_definition def'
+    let def' = Parse.Module.from_string s in
+    run_definition (snd def')
 
 let run_action act : Values.value list =
   match act.it with
@@ -443,7 +452,7 @@ let run_assertion ass =
     trace "Asserting malformed...";
     (match ignore (run_definition def) with
     | exception Decode.Code (_, msg) -> assert_message ass.at "decoding" msg re
-    | exception Parse.Syntax (_, msg) -> assert_message ass.at "parsing" msg re
+    | exception Syntax (_, msg) -> assert_message ass.at "parsing" msg re
     | _ -> Assert.error ass.at "expected decoding/parsing error"
     )
 
diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml
index dc56743eb6..a11e50045d 100644
--- a/interpreter/text/arrange.ml
+++ b/interpreter/text/arrange.ml
@@ -679,21 +679,25 @@ let definition mode x_opt def =
         match def.it with
         | Textual m -> m
         | Encoded (_, bs) -> Decode.decode "" bs
-        | Quoted (_, s) -> unquote (Parse.string_to_module s)
+        | Quoted (_, s) ->
+            let _v, m = Parse.Module.from_string s in
+            unquote m
       in module_with_var_opt x_opt (unquote def)
     | `Binary ->
       let rec unquote def =
         match def.it with
         | Textual m -> Encode.encode m
         | Encoded (_, bs) -> Encode.encode (Decode.decode "" bs)
-        | Quoted (_, s) -> unquote (Parse.string_to_module s)
+        | Quoted (_, s) ->
+            let _v, m = Parse.Module.from_string s in
+            unquote m
       in binary_module_with_var_opt x_opt (unquote def)
     | `Original ->
       match def.it with
       | Textual m -> module_with_var_opt x_opt m
       | Encoded (_, bs) -> binary_module_with_var_opt x_opt bs
       | Quoted (_, s) -> quoted_module_with_var_opt x_opt s
-  with Parse.Syntax _ ->
+  with Script.Syntax _ ->
     quoted_module_with_var_opt x_opt "<invalid module>"
 
 let access x_opt n =
diff --git a/interpreter/text/parse.ml b/interpreter/text/parse.ml
index 71c4cc4a9c..039867d29a 100644
--- a/interpreter/text/parse.ml
+++ b/interpreter/text/parse.ml
@@ -1,28 +1,60 @@
-type 'a start =
-  | Module : (Script.var option * Script.definition) start
-  | Script : Script.script start
-  | Script1 : Script.script start
-
-exception Syntax = Script.Syntax
-
-let parse' name lexbuf start =
-  lexbuf.Lexing.lex_curr_p <-
-    {lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = name};
-  try start Lexer.token lexbuf
-  with Syntax (region, s) ->
-    let region' = if region <> Source.no_region then region else
-      {Source.left = Lexer.convert_pos lexbuf.Lexing.lex_start_p;
-       Source.right = Lexer.convert_pos lexbuf.Lexing.lex_curr_p} in
-    raise (Syntax (region', s))
-
-let parse (type a) name lexbuf : a start -> a = function
-  | Module -> parse' name lexbuf Parser.module1
-  | Script -> parse' name lexbuf Parser.script
-  | Script1 -> parse' name lexbuf Parser.script1
-
-let string_to start s =
-  let lexbuf = Lexing.from_string s in
-  parse "string" lexbuf start
-
-let string_to_script s = string_to Script s
-let string_to_module s = snd (string_to Module s)
+module Make (M : sig
+  type t
+
+  val rule : (Lexing.lexbuf -> Parser.token) -> Lexing.lexbuf -> t
+
+end) = struct
+
+  type nonrec t = M.t
+
+  let from_lexbuf =
+    let parser = MenhirLib.Convert.Simplified.traditional2revised M.rule in
+    fun buf ->
+      let provider () =
+        let tok = Lexer.token buf in
+        let start = Lexing.lexeme_start_p buf in
+        let stop = Lexing.lexeme_end_p buf in
+        tok, start, stop
+      in
+      try parser provider with
+      | Parser.Error ->
+          let left = Lexer.convert_pos buf.Lexing.lex_start_p in
+          let right = Lexer.convert_pos buf.Lexing.lex_curr_p in
+          let region = { Source.left; right } in
+          raise (Script.Syntax (region, "unexpected token"))
+      | Script.Syntax (region, s) as exn ->
+          if region <> Source.no_region then raise exn
+          else
+            let region' = {
+              Source.left = Lexer.convert_pos buf.Lexing.lex_start_p;
+              Source.right = Lexer.convert_pos buf.Lexing.lex_curr_p }
+            in
+            raise (Script.Syntax (region', s))
+
+  let from_file filename =
+    let chan = open_in filename in
+      Fun.protect ~finally:(fun () -> close_in chan)
+      (fun () ->
+        let lb = Lexing.from_channel ~with_positions:true chan in
+        Lexing.set_filename lb filename;
+      from_lexbuf lb)
+
+  let from_string s = from_lexbuf (Lexing.from_string ~with_positions:true s)
+
+  let from_channel c = from_lexbuf (Lexing.from_channel ~with_positions:true c)
+end
+
+module Module = Make (struct
+  type t = Script.var option * Script.definition
+  let rule = Parser.module1
+end)
+
+module Script1 = Make (struct
+  type t = Script.script
+  let rule = Parser.script1
+end)
+
+module Script = Make (struct
+  type t =  Script.script
+  let rule = Parser.script
+end)
diff --git a/interpreter/text/parse.mli b/interpreter/text/parse.mli
index 89f8e58024..4077329760 100644
--- a/interpreter/text/parse.mli
+++ b/interpreter/text/parse.mli
@@ -1,11 +1,23 @@
-type 'a start =
-  | Module : (Script.var option * Script.definition) start
-  | Script : Script.script start
-  | Script1 : Script.script start
+module Module : sig
+  type t = Script.var option * Script.definition
+  val from_lexbuf : Lexing.lexbuf -> t
+  val from_file : string -> t
+  val from_string : string -> t
+  val from_channel : in_channel -> t
+end
 
-exception Syntax of Source.region * string
+module Script1 : sig
+  type t = Script.script
+  val from_lexbuf : Lexing.lexbuf -> t
+  val from_file : string -> t
+  val from_string : string -> t
+  val from_channel : in_channel -> t
+end
 
-val parse : string -> Lexing.lexbuf -> 'a start -> 'a (* raises Syntax *)
-
-val string_to_script : string -> Script.script (* raises Syntax *)
-val string_to_module : string -> Script.definition (* raises Syntax *)
+module Script : sig
+  type t = Script.script
+  val from_lexbuf : Lexing.lexbuf -> t
+  val from_file : string -> t
+  val from_string : string -> t
+  val from_channel : in_channel -> t
+end
diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly
index e29be3ae3b..44ddd3651b 100644
--- a/interpreter/text/parser.mly
+++ b/interpreter/text/parser.mly
@@ -10,11 +10,6 @@ open Script
 
 let error at msg = raise (Script.Syntax (at, msg))
 
-let parse_error msg =
-  error Source.no_region
-    (if msg = "syntax error" then "unexpected token" else msg)
-
-
 (* Position handling *)
 
 let position_to_pos position =
@@ -700,10 +695,10 @@ func_body :
       {ftype = -1l @@ at(); locals = []; body = $1 c'} }
   | LPAR LOCAL value_type_list RPAR func_body
     { fun c -> anon_locals c (lazy $3); let f = $5 c in
-      {f with locals = $3 @ f.locals} }
+      {f with locals = $3 @ f.Ast.locals} }
   | LPAR LOCAL bind_var value_type RPAR func_body  /* Sugar */
     { fun c -> ignore (bind_local c $3); let f = $6 c in
-      {f with locals = $4 :: f.locals} }
+      {f with locals = $4 :: f.Ast.locals} }
 
 
 /* Tables, Memories & Globals */
@@ -966,11 +961,11 @@ module_fields1 :
   | elem module_fields
     { fun c -> let ef = $1 c in let mf = $2 c in
       fun () -> let elems = ef () in let m = mf () in
-      {m with elems = elems :: m.elems} }
+      {m with elems = elems :: m.Ast.elems} }
   | data module_fields
     { fun c -> let df = $1 c in let mf = $2 c in
       fun () -> let data = df () in let m = mf () in
-      {m with datas = data :: m.datas} }
+      {m with datas = data :: m.Ast.datas} }
   | start module_fields
     { fun c -> let mf = $2 c in
       fun () -> let m = mf () in let x = $1 c in
diff --git a/interpreter/wasm.opam b/interpreter/wasm.opam
index 5d5984106c..ad8b60af23 100644
--- a/interpreter/wasm.opam
+++ b/interpreter/wasm.opam
@@ -11,6 +11,7 @@ bug-reports: "https://github.com/WebAssembly/spec/issues"
 depends: [
   "dune" {>= "2.9"}
   "ocaml" {>= "4.12"}
+  "menhir" {>= "20220210"}
   "odoc" {with-doc}
 ]
 build: [

From cbf62679e466c7808557b94bed159294f0ce49bf Mon Sep 17 00:00:00 2001
From: zapashcanon <leo@ndrs.fr>
Date: Fri, 10 Nov 2023 19:54:11 +0100
Subject: [PATCH 2/9] use some menhir builtins

---
 interpreter/text/parser.mly | 100 +++++++++++++-----------------------
 1 file changed, 37 insertions(+), 63 deletions(-)

diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly
index 44ddd3651b..7e96285bc1 100644
--- a/interpreter/text/parser.mly
+++ b/interpreter/text/parser.mly
@@ -266,10 +266,6 @@ value_type :
   | VEC_TYPE { VecType $1 }
   | ref_type { RefType $1 }
 
-value_type_list :
-  | /* empty */ { [] }
-  | value_type value_type_list { $1 :: $2 }
-
 global_type :
   | value_type { GlobalType ($1, Immutable) }
   | LPAR MUT value_type RPAR { GlobalType ($3, Mutable) }
@@ -280,7 +276,7 @@ def_type :
 func_type :
   | func_type_result
     { FuncType ([], $1) }
-  | LPAR PARAM value_type_list RPAR func_type
+  | LPAR PARAM list(value_type) RPAR func_type
     { let FuncType (ins, out) = $5 in FuncType ($3 @ ins, out) }
   | LPAR PARAM bind_var value_type RPAR func_type  /* Sugar */
     { let FuncType (ins, out) = $6 in FuncType ($4 :: ins, out) }
@@ -288,7 +284,7 @@ func_type :
 func_type_result :
   | /* empty */
     { [] }
-  | LPAR RESULT value_type_list RPAR func_type_result
+  | LPAR RESULT list(value_type) RPAR func_type_result
     { $3 @ $5 }
 
 table_type :
@@ -312,10 +308,6 @@ num :
   | INT { $1 @@ at () }
   | FLOAT { $1 @@ at () }
 
-num_list:
-  | /* empty */ { [] }
-  | num num_list { $1 :: $2 }
-
 var :
   | NAT { let at = at () in fun c lookup -> nat32 $1 at @@ at }
   | VAR { let at = at () in fun c lookup -> lookup c ($1 @@ at) @@ at }
@@ -428,14 +420,14 @@ plain_instr :
   | UNARY { fun c -> $1 }
   | BINARY { fun c -> $1 }
   | CONVERT { fun c -> $1 }
-  | VEC_CONST VEC_SHAPE num_list { let at = at () in fun c -> fst (vec $1 $2 $3 at) }
+  | VEC_CONST VEC_SHAPE list(num) { let at = at () in fun c -> fst (vec $1 $2 $3 at) }
   | VEC_UNARY { fun c -> $1 }
   | VEC_BINARY { fun c -> $1 }
   | VEC_TERNARY { fun c -> $1 }
   | VEC_TEST { fun c -> $1 }
   | VEC_SHIFT { fun c -> $1 }
   | VEC_BITMASK { fun c -> $1 }
-  | VEC_SHUFFLE num_list { let at = at () in fun c -> i8x16_shuffle (shuffle_lit $2 at) }
+  | VEC_SHUFFLE list(num) { let at = at () in fun c -> i8x16_shuffle (shuffle_lit $2 at) }
   | VEC_SPLAT { fun c -> $1 }
   | VEC_EXTRACT NAT { let at = at () in fun c -> $1 (vec_lane_index $2 at) }
   | VEC_REPLACE NAT { let at = at () in fun c -> $1 (vec_lane_index $2 at) }
@@ -448,7 +440,7 @@ select_instr_instr_list :
       (select (if b then (Some ts) else None) @@ at1) :: es }
 
 select_instr_results_instr_list :
-  | LPAR RESULT value_type_list RPAR select_instr_results_instr_list
+  | LPAR RESULT list(value_type) RPAR select_instr_results_instr_list
     { fun c -> let _, ts, es = $5 c in true, $3 @ ts, es }
   | instr_list
     { fun c -> false, [], $1 c }
@@ -476,14 +468,14 @@ call_instr_type_instr_list :
       fun c -> let ft, es = $1 c in inline_type c ft at, es }
 
 call_instr_params_instr_list :
-  | LPAR PARAM value_type_list RPAR call_instr_params_instr_list
+  | LPAR PARAM list(value_type) RPAR call_instr_params_instr_list
     { fun c ->
       let FuncType (ts1, ts2), es = $5 c in FuncType ($3 @ ts1, ts2), es }
   | call_instr_results_instr_list
     { fun c -> let ts, es = $1 c in FuncType ([], ts), es }
 
 call_instr_results_instr_list :
-  | LPAR RESULT value_type_list RPAR call_instr_results_instr_list
+  | LPAR RESULT list(value_type) RPAR call_instr_results_instr_list
     { fun c -> let ts, es = $5 c in $3 @ ts, es }
   | instr_list
     { fun c -> [], $1 c }
@@ -518,13 +510,13 @@ block :
 
 block_param_body :
   | block_result_body { $1 }
-  | LPAR PARAM value_type_list RPAR block_param_body
+  | LPAR PARAM list(value_type) RPAR block_param_body
     { let FuncType (ins, out) = fst $5 in
       FuncType ($3 @ ins, out), snd $5 }
 
 block_result_body :
   | instr_list { FuncType ([], []), $1 }
-  | LPAR RESULT value_type_list RPAR block_result_body
+  | LPAR RESULT list(value_type) RPAR block_result_body
     { let FuncType (ins, out) = fst $5 in
       FuncType (ins, $3 @ out), snd $5 }
 
@@ -551,7 +543,7 @@ expr1 :  /* Sugar */
       let bt, (es, es1, es2) = $3 c c' in es, if_ bt es1 es2 }
 
 select_expr_results :
-  | LPAR RESULT value_type_list RPAR select_expr_results
+  | LPAR RESULT list(value_type) RPAR select_expr_results
     { fun c -> let _, ts, es = $5 c in true, $3 @ ts, es }
   | expr_list
     { fun c -> false, [], $1 c }
@@ -568,14 +560,14 @@ call_expr_type :
       fun c -> let ft, es = $1 c in inline_type c ft at1, es }
 
 call_expr_params :
-  | LPAR PARAM value_type_list RPAR call_expr_params
+  | LPAR PARAM list(value_type) RPAR call_expr_params
     { fun c ->
       let FuncType (ts1, ts2), es = $5 c in FuncType ($3 @ ts1, ts2), es }
   | call_expr_results
     { fun c -> let ts, es = $1 c in FuncType ([], ts), es }
 
 call_expr_results :
-  | LPAR RESULT value_type_list RPAR call_expr_results
+  | LPAR RESULT list(value_type) RPAR call_expr_results
     { fun c -> let ts, es = $5 c in $3 @ ts, es }
   | expr_list
     { fun c -> [], $1 c }
@@ -599,13 +591,13 @@ if_block :
 
 if_block_param_body :
   | if_block_result_body { $1 }
-  | LPAR PARAM value_type_list RPAR if_block_param_body
+  | LPAR PARAM list(value_type) RPAR if_block_param_body
     { let FuncType (ins, out) = fst $5 in
       FuncType ($3 @ ins, out), snd $5 }
 
 if_block_result_body :
   | if_ { FuncType ([], []), $1 }
-  | LPAR RESULT value_type_list RPAR if_block_result_body
+  | LPAR RESULT list(value_type) RPAR if_block_result_body
     { let FuncType (ins, out) = fst $5 in
       FuncType (ins, $3 @ out), snd $5 }
 
@@ -662,19 +654,19 @@ func_fields :
 
 func_fields_import :  /* Sugar */
   | func_fields_import_result { $1 }
-  | LPAR PARAM value_type_list RPAR func_fields_import
+  | LPAR PARAM list(value_type) RPAR func_fields_import
     { let FuncType (ins, out) = $5 in FuncType ($3 @ ins, out) }
   | LPAR PARAM bind_var value_type RPAR func_fields_import  /* Sugar */
     { let FuncType (ins, out) = $6 in FuncType ($4 :: ins, out) }
 
 func_fields_import_result :  /* Sugar */
   | /* empty */ { FuncType ([], []) }
-  | LPAR RESULT value_type_list RPAR func_fields_import_result
+  | LPAR RESULT list(value_type) RPAR func_fields_import_result
     { let FuncType (ins, out) = $5 in FuncType (ins, $3 @ out) }
 
 func_fields_body :
   | func_result_body { $1 }
-  | LPAR PARAM value_type_list RPAR func_fields_body
+  | LPAR PARAM list(value_type) RPAR func_fields_body
     { let FuncType (ins, out) = fst $5 in
       FuncType ($3 @ ins, out),
       fun c -> anon_locals c (lazy $3); snd $5 c }
@@ -685,7 +677,7 @@ func_fields_body :
 
 func_result_body :
   | func_body { FuncType ([], []), $1 }
-  | LPAR RESULT value_type_list RPAR func_result_body
+  | LPAR RESULT list(value_type) RPAR func_result_body
     { let FuncType (ins, out) = fst $5 in
       FuncType (ins, $3 @ out), snd $5 }
 
@@ -693,7 +685,7 @@ func_body :
   | instr_list
     { fun c -> let c' = anon_label c in
       {ftype = -1l @@ at(); locals = []; body = $1 c'} }
-  | LPAR LOCAL value_type_list RPAR func_body
+  | LPAR LOCAL list(value_type) RPAR func_body
     { fun c -> anon_locals c (lazy $3); let f = $5 c in
       {f with locals = $3 @ f.Ast.locals} }
   | LPAR LOCAL bind_var value_type RPAR func_body  /* Sugar */
@@ -981,12 +973,11 @@ module_fields1 :
       fun () -> let m = mf () in
       {m with exports = $1 c :: m.exports} }
 
-module_var_opt :
-  | /* empty */ { None }
-  | VAR { Some ($1 @@ at ()) }  /* Sugar */
+module_var :
+  | VAR { $1 @@ at () }  /* Sugar */
 
 module_ :
-  | LPAR MODULE module_var_opt module_fields RPAR
+  | LPAR MODULE option(module_var) module_fields RPAR
     { $3, Textual ($4 (empty_context ()) () @@ at ()) @@ at () }
 
 inline_module :  /* Sugar */
@@ -998,21 +989,20 @@ inline_module1 :  /* Sugar */
 
 /* Scripts */
 
-script_var_opt :
-  | /* empty */ { None }
-  | VAR { Some ($1 @@ at ()) }  /* Sugar */
+script_var :
+  | VAR { $1 @@ at () }  /* Sugar */
 
 script_module :
   | module_ { $1 }
-  | LPAR MODULE module_var_opt BIN string_list RPAR
+  | LPAR MODULE option(module_var) BIN string_list RPAR
     { $3, Encoded ("binary:" ^ string_of_pos (at()).left, $5) @@ at() }
-  | LPAR MODULE module_var_opt QUOTE string_list RPAR
+  | LPAR MODULE option(module_var) QUOTE string_list RPAR
     { $3, Quoted ("quote:" ^ string_of_pos (at()).left, $5) @@ at() }
 
 action :
-  | LPAR INVOKE module_var_opt name literal_list RPAR
+  | LPAR INVOKE option(module_var) name list(literal) RPAR
     { Invoke ($3, $4, $5) @@ at () }
-  | LPAR GET module_var_opt name RPAR
+  | LPAR GET option(module_var) name RPAR
     { Get ($3, $4) @@ at() }
 
 assertion :
@@ -1024,7 +1014,7 @@ assertion :
     { AssertUnlinkable (snd $3, $4) @@ at () }
   | LPAR ASSERT_TRAP script_module STRING RPAR
     { AssertUninstantiable (snd $3, $4) @@ at () }
-  | LPAR ASSERT_RETURN action result_list RPAR { AssertReturn ($3, $4) @@ at () }
+  | LPAR ASSERT_RETURN action list(result) RPAR { AssertReturn ($3, $4) @@ at () }
   | LPAR ASSERT_TRAP action STRING RPAR { AssertTrap ($3, $4) @@ at () }
   | LPAR ASSERT_EXHAUSTION action STRING RPAR { AssertExhaustion ($3, $4) @@ at () }
 
@@ -1032,24 +1022,20 @@ cmd :
   | action { Action $1 @@ at () }
   | assertion { Assertion $1 @@ at () }
   | script_module { Module (fst $1, snd $1) @@ at () }
-  | LPAR REGISTER name module_var_opt RPAR { Register ($3, $4) @@ at () }
+  | LPAR REGISTER name option(module_var) RPAR { Register ($3, $4) @@ at () }
   | meta { Meta $1 @@ at () }
 
-cmd_list :
-  | /* empty */ { [] }
-  | cmd cmd_list { $1 :: $2 }
-
 meta :
-  | LPAR SCRIPT script_var_opt cmd_list RPAR { Script ($3, $4) @@ at () }
-  | LPAR INPUT script_var_opt STRING RPAR { Input ($3, $4) @@ at () }
-  | LPAR OUTPUT script_var_opt STRING RPAR { Output ($3, Some $4) @@ at () }
-  | LPAR OUTPUT script_var_opt RPAR { Output ($3, None) @@ at () }
+  | LPAR SCRIPT option(script_var) list(cmd) RPAR { Script ($3, $4) @@ at () }
+  | LPAR INPUT option(script_var) STRING RPAR { Input ($3, $4) @@ at () }
+  | LPAR OUTPUT option(script_var) STRING RPAR { Output ($3, Some $4) @@ at () }
+  | LPAR OUTPUT option(script_var) RPAR { Output ($3, None) @@ at () }
 
 literal_num :
   | LPAR CONST num RPAR { snd (num $2 $3) }
 
 literal_vec :
-  | LPAR VEC_CONST VEC_SHAPE num_list RPAR { snd (vec $2 $3 $4 (at ())) }
+  | LPAR VEC_CONST VEC_SHAPE list(num) RPAR { snd (vec $2 $3 $4 (at ())) }
 
 literal_ref :
   | LPAR REF_NULL ref_kind RPAR { Values.NullRef $3 }
@@ -1060,36 +1046,24 @@ literal :
   | literal_vec { Values.Vec $1 @@ at () }
   | literal_ref { Values.Ref $1 @@ at () }
 
-literal_list :
-  | /* empty */ { [] }
-  | literal literal_list { $1 :: $2 }
-
 numpat :
   | num { fun sh -> vec_lane_lit sh $1.it $1.at }
   | NAN { fun sh -> vec_lane_nan sh $1 (ati 3) }
 
-numpat_list:
-  | /* empty */ { [] }
-  | numpat numpat_list { $1 :: $2 }
-
 result :
   | literal_num { NumResult (NumPat ($1 @@ at())) @@ at () }
   | LPAR CONST NAN RPAR { NumResult (NanPat (nanop $2 ($3 @@ ati 3))) @@ at () }
   | literal_ref { RefResult (RefPat ($1 @@ at ())) @@ at () }
   | LPAR REF_FUNC RPAR { RefResult (RefTypePat FuncRefType) @@ at () }
   | LPAR REF_EXTERN RPAR { RefResult (RefTypePat ExternRefType) @@ at () }
-  | LPAR VEC_CONST VEC_SHAPE numpat_list RPAR {
+  | LPAR VEC_CONST VEC_SHAPE list(numpat) RPAR {
     if V128.num_lanes $3 <> List.length $4 then
       error (at ()) "wrong number of lane literals";
     VecResult (VecPat (Values.V128 ($3, List.map (fun lit -> lit $3) $4))) @@ at ()
   }
 
-result_list :
-  | /* empty */ { [] }
-  | result result_list { $1 :: $2 }
-
 script :
-  | cmd_list EOF { $1 }
+  | list(cmd) EOF { $1 }
   | inline_module1 EOF { [Module (None, $1) @@ at ()] }  /* Sugar */
 
 script1 :

From 10ee3380c94c6f75cc36c171566de0a391d7b561 Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Tue, 14 Nov 2023 11:22:23 +0100
Subject: [PATCH 3/9] Update interpreter/script/run.ml

---
 interpreter/script/run.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml
index 8797718ba9..5219a97987 100644
--- a/interpreter/script/run.ml
+++ b/interpreter/script/run.ml
@@ -346,8 +346,8 @@ let rec run_definition def : Ast.module_ =
     Decode.decode name bs
   | Quoted (_, s) ->
     trace "Parsing quote...";
-    let def' = Parse.Module.from_string s in
-    run_definition (snd def')
+    let _, def' = Parse.Module.from_string s in
+    run_definition def'
 
 let run_action act : Values.value list =
   match act.it with

From 2db5785e93bfc85463ac75abd9a2cb2d5e90c4ac Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Tue, 14 Nov 2023 11:22:31 +0100
Subject: [PATCH 4/9] Update interpreter/script/run.ml

---
 interpreter/script/run.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml
index 5219a97987..05ef1b0167 100644
--- a/interpreter/script/run.ml
+++ b/interpreter/script/run.ml
@@ -171,8 +171,8 @@ let input_file file run =
   dispatch_file_ext
     input_binary_file
     (input_sexpr_file input_sexpr)
-    (input_sexpr_file (input_script))
-    (input_sexpr_file (input_script))
+    (input_sexpr_file input_script)
+    (input_sexpr_file input_script)
     input_js_file
     file run
 

From ebd1d7c39c3b65bb6f06af1891bf3cd5bb9740f5 Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Tue, 14 Nov 2023 11:22:38 +0100
Subject: [PATCH 5/9] Update interpreter/jslib/wast.ml

---
 interpreter/jslib/wast.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/interpreter/jslib/wast.ml b/interpreter/jslib/wast.ml
index 407de555e1..35c372bfb9 100644
--- a/interpreter/jslib/wast.ml
+++ b/interpreter/jslib/wast.ml
@@ -9,7 +9,7 @@ let () =
     (object%js (_self)
 
       method encode (s : Js.js_string Js.t) : (Typed_array.arrayBuffer Js.t) =
-        let def = snd @@ Parse.Module.from_string (Js.to_string s) in
+        let _, def = Parse.Module.from_string (Js.to_string s) in
         let bs =
           match def.Source.it with
           | Script.Textual m -> (Encode.encode m)

From c12873703e5c6011d7a14eb4a6c9d4293339b4e0 Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Tue, 14 Nov 2023 11:22:44 +0100
Subject: [PATCH 6/9] Update interpreter/script/js.ml

---
 interpreter/script/js.ml | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml
index d172f58026..d49ac6500b 100644
--- a/interpreter/script/js.ml
+++ b/interpreter/script/js.ml
@@ -597,9 +597,7 @@ let of_command mods cmd =
       match def.it with
       | Textual m -> m
       | Encoded (_, bs) -> Decode.decode "binary" bs
-      | Quoted (_, s) ->
-          let _v, m = Parse.Module.from_string s in
-          unquote m
+      | Quoted (_, s) -> unquote (snd (Parse.Module.from_string s))
     in bind mods x_opt (unquote def);
     "let " ^ current_var mods ^ " = instance(" ^ of_definition def ^ ");\n" ^
     (if x_opt = None then "" else

From 88ad9e85d53d4f7d53f4893790bf7efafb296d09 Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Tue, 14 Nov 2023 11:22:50 +0100
Subject: [PATCH 7/9] Update interpreter/text/parse.ml

---
 interpreter/text/parse.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/interpreter/text/parse.ml b/interpreter/text/parse.ml
index 039867d29a..073942cf77 100644
--- a/interpreter/text/parse.ml
+++ b/interpreter/text/parse.ml
@@ -33,7 +33,7 @@ end) = struct
 
   let from_file filename =
     let chan = open_in filename in
-      Fun.protect ~finally:(fun () -> close_in chan)
+    Fun.protect ~finally:(fun () -> close_in chan)
       (fun () ->
         let lb = Lexing.from_channel ~with_positions:true chan in
         Lexing.set_filename lb filename;

From 669ca9fdafa37b1b67a221bb287a10c1496d4ae3 Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Tue, 14 Nov 2023 11:22:55 +0100
Subject: [PATCH 8/9] Update interpreter/text/parse.ml

---
 interpreter/text/parse.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/interpreter/text/parse.ml b/interpreter/text/parse.ml
index 073942cf77..306025af17 100644
--- a/interpreter/text/parse.ml
+++ b/interpreter/text/parse.ml
@@ -37,7 +37,7 @@ end) = struct
       (fun () ->
         let lb = Lexing.from_channel ~with_positions:true chan in
         Lexing.set_filename lb filename;
-      from_lexbuf lb)
+        from_lexbuf lb)
 
   let from_string s = from_lexbuf (Lexing.from_string ~with_positions:true s)
 

From d0187eebb9220931e19b1229fa5663755ffe4369 Mon Sep 17 00:00:00 2001
From: Andreas Rossberg <rossberg@mpi-sws.org>
Date: Tue, 14 Nov 2023 11:23:01 +0100
Subject: [PATCH 9/9] Update interpreter/text/parser.mly

---
 interpreter/text/parser.mly | 1 +
 1 file changed, 1 insertion(+)

diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly
index 7e96285bc1..38297afc71 100644
--- a/interpreter/text/parser.mly
+++ b/interpreter/text/parser.mly
@@ -10,6 +10,7 @@ open Script
 
 let error at msg = raise (Script.Syntax (at, msg))
 
+
 (* Position handling *)
 
 let position_to_pos position =