[interpreter] Refactor parser to handle select & call_indirect correctly (#1567)

Author: rossberg

interpreter/text/parser.mly

@@ -366,12 +366,16 @@ align_opt :
 
 /* Instructions & Expressions */
 
-instr :
+instr_list :
+  | /* empty */ { fun c -> [] }
+  | instr1 instr_list { fun c -> $1 c @ $2 c }
+  | select_instr_instr_list { $1 }
+  | call_instr_instr_list { $1 }
+
+instr1 :
   | plain_instr { let at = at () in fun c -> [$1 c @@ at] }
-  | select_instr_instr { fun c -> let e, es = $1 c in e :: es }
-  | call_instr_instr { fun c -> let e, es = $1 c in e :: es }
   | block_instr { let at = at () in fun c -> [$1 c @@ at] }
-  | expr { $1 } /* Sugar */
+  | expr { $1 }  /* Sugar */
 
 plain_instr :
   | UNREACHABLE { fun c -> unreachable }
@@ -442,89 +446,51 @@ plain_instr :
   | VEC_REPLACE NAT { let at = at () in fun c -> $1 (vec_lane_index $2 at) }
 
 
-select_instr :
-  | SELECT select_instr_results
-    { let at = at () in fun c -> let b, ts = $2 in
-      select (if b then (Some ts) else None) @@ at }
-
-select_instr_results :
-  | LPAR RESULT value_type_list RPAR select_instr_results
-    { let _, ts = $5 in true, $3 @ ts }
-  | /* empty */
-    { false, [] }
-
-select_instr_instr :
-  | SELECT select_instr_results_instr
+select_instr_instr_list :
+  | SELECT select_instr_results_instr_list
     { let at1 = ati 1 in
       fun c -> let b, ts, es = $2 c in
-      select (if b then (Some ts) else None) @@ at1, es }
+      (select (if b then (Some ts) else None) @@ at1) :: es }
 
-select_instr_results_instr :
-  | LPAR RESULT value_type_list RPAR select_instr_results_instr
+select_instr_results_instr_list :
+  | LPAR RESULT value_type_list RPAR select_instr_results_instr_list
     { fun c -> let _, ts, es = $5 c in true, $3 @ ts, es }
-  | instr
+  | instr_list
     { fun c -> false, [], $1 c }
 
 
-call_instr :
-  | CALL_INDIRECT var call_instr_type
-    { let at = at () in fun c -> call_indirect ($2 c table) ($3 c) @@ at }
-  | CALL_INDIRECT call_instr_type  /* Sugar */
-    { let at = at () in fun c -> call_indirect (0l @@ at) ($2 c) @@ at }
-
-call_instr_type :
-  | type_use call_instr_params
-    { let at1 = ati 1 in
-      fun c ->
-      match $2 c with
-      | FuncType ([], []) -> $1 c type_
-      | ft -> inline_type_explicit c ($1 c type_) ft at1 }
-  | call_instr_params
-    { let at = at () in fun c -> inline_type c ($1 c) at }
-
-call_instr_params :
-  | LPAR PARAM value_type_list RPAR call_instr_params
-    { fun c -> let FuncType (ts1, ts2) = $5 c in FuncType ($3 @ ts1, ts2) }
-  | call_instr_results
-    { fun c -> FuncType ([], $1 c) }
-
-call_instr_results :
-  | LPAR RESULT value_type_list RPAR call_instr_results
-    { fun c -> $3 @ $5 c }
-  | /* empty */
-    { fun c -> [] }
-
-
-call_instr_instr :
-  | CALL_INDIRECT var call_instr_type_instr
+call_instr_instr_list :
+  | CALL_INDIRECT var call_instr_type_instr_list
     { let at1 = ati 1 in
-      fun c -> let x, es = $3 c in call_indirect ($2 c table) x @@ at1, es }
-  | CALL_INDIRECT call_instr_type_instr  /* Sugar */
+      fun c -> let x, es = $3 c in
+      (call_indirect ($2 c table) x @@ at1) :: es }
+  | CALL_INDIRECT call_instr_type_instr_list  /* Sugar */
     { let at1 = ati 1 in
-      fun c -> let x, es = $2 c in call_indirect (0l @@ at1) x @@ at1, es }
+      fun c -> let x, es = $2 c in
+      (call_indirect (0l @@ at1) x @@ at1) :: es }
 
-call_instr_type_instr :
-  | type_use call_instr_params_instr
+call_instr_type_instr_list :
+  | type_use call_instr_params_instr_list
     { let at1 = ati 1 in
       fun c ->
       match $2 c with
       | FuncType ([], []), es -> $1 c type_, es
       | ft, es -> inline_type_explicit c ($1 c type_) ft at1, es }
-  | call_instr_params_instr
+  | call_instr_params_instr_list
     { let at = at () in
       fun c -> let ft, es = $1 c in inline_type c ft at, es }
 
-call_instr_params_instr :
-  | LPAR PARAM value_type_list RPAR call_instr_params_instr
+call_instr_params_instr_list :
+  | LPAR PARAM value_type_list 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
+  | call_instr_results_instr_list
     { fun c -> let ts, es = $1 c in FuncType ([], ts), es }
 
-call_instr_results_instr :
-  | LPAR RESULT value_type_list RPAR call_instr_results_instr
+call_instr_results_instr_list :
+  | LPAR RESULT value_type_list RPAR call_instr_results_instr_list
     { fun c -> let ts, es = $5 c in $3 @ ts, es }
-  | instr
+  | instr_list
     { fun c -> [], $1 c }
 
 
@@ -657,12 +623,6 @@ if_ :
   | LPAR THEN instr_list RPAR  /* Sugar */
     { fun c c' -> [], $3 c', [] }
 
-instr_list :
-  | /* empty */ { fun c -> [] }
-  | select_instr { fun c -> [$1 c] }
-  | call_instr { fun c -> [$1 c] }
-  | instr instr_list { fun c -> $1 c @ $2 c }
-
 expr_list :
   | /* empty */ { fun c -> [] }
   | expr expr_list { fun c -> $1 c @ $2 c }

test/core/call_indirect.wast

@@ -1015,3 +1015,23 @@
   (module (table funcref (elem 0 0)))
   "unknown function"
 )
+
+
+
+
+;; Flat syntax
+
+(module
+  (table 1 funcref)
+  (func unreachable call_indirect)
+  (func unreachable call_indirect nop)
+  (func unreachable call_indirect call_indirect)
+  (func unreachable call_indirect (call_indirect))
+  (func unreachable call_indirect call_indirect call_indirect)
+  (func unreachable call_indirect (result))
+  (func unreachable call_indirect (result) (result))
+  (func unreachable call_indirect (result) (result) call_indirect)
+  (func unreachable call_indirect (result) (result) call_indirect (result))
+  (func (result i32) unreachable call_indirect select)
+  (func (result i32) unreachable call_indirect select call_indirect)
+)

test/core/select.wast

@@ -512,3 +512,20 @@
   "type mismatch"
 )
 
+
+;; Flat syntax
+
+(module
+  (table 1 funcref)
+  (func (result i32) unreachable select)
+  (func (result i32) unreachable select nop)
+  (func (result i32) unreachable select (select))
+  (func (result i32) unreachable select select)
+  (func (result i32) unreachable select select select)
+  (func (result i32) unreachable select (result i32))
+  (func (result i32) unreachable select (result i32) (result))
+  (func (result i32) unreachable select (result i32) (result) select)
+  (func (result i32) unreachable select (result) (result i32) select (result i32))
+  (func (result i32) unreachable select call_indirect)
+  (func (result i32) unreachable select call_indirect select)
+)