Make the branch type checking consistent with the type system.

ml-proto/host/lexer.mll

@@ -142,9 +142,13 @@ rule token = parse
   | "block" { BLOCK }
   | "loop" { LOOP }
   | "br" { BR }
+  | "br0" { BR0 }
   | "br_if" { BR_IF }
+  | "br0_if" { BR0_IF }
   | "br_table" { BR_TABLE }
+  | "br0_table" { BR0_TABLE }
   | "return" { RETURN }
+  | "return0" { RETURN0 }
   | "if" { IF }
   | "then" { THEN }
   | "else" { ELSE }

ml-proto/host/parser.mly

@@ -125,8 +125,8 @@ let implicit_decl c t at =
 %}
 
 %token INT FLOAT TEXT VAR VALUE_TYPE LPAR RPAR
-%token NOP BLOCK IF THEN ELSE SELECT LOOP BR BR_IF BR_TABLE
-%token CALL CALL_IMPORT CALL_INDIRECT RETURN
+%token NOP BLOCK IF THEN ELSE SELECT LOOP BR BR0 BR_IF BR0_IF BR_TABLE BR0_TABLE
+%token CALL CALL_IMPORT CALL_INDIRECT RETURN RETURN0
 %token GET_LOCAL SET_LOCAL LOAD STORE OFFSET ALIGN
 %token CONST UNARY BINARY COMPARE CONVERT
 %token FUNC START TYPE PARAM RESULT LOCAL
@@ -225,16 +225,18 @@ expr1 :
     { fun c -> let c' = anon_label c in let c'' = $2 c' in Loop ($3 c'') }
   | LOOP labeling1 labeling1 expr_list
     { fun c -> let c' = $2 c in let c'' = $3 c' in Loop ($4 c'') }
-  | BR var expr_opt { fun c -> Br ($2 c label, $3 c) }
-  | BR_IF var expr { fun c -> Br_if ($2 c label, None, $3 c) }
-  | BR_IF var expr expr { fun c -> Br_if ($2 c label, Some ($3 c), $4 c) }
-  | BR_TABLE var var_list expr
+  | BR var expr { fun c -> Br ($2 c label, $3 c) }
+  | BR0 var { fun c -> Br0 ($2 c label) }
+  | BR_IF var expr expr { fun c -> Br_if ($2 c label, $3 c, $4 c) }
+  | BR0_IF var expr { fun c -> Br0_if ($2 c label, $3 c) }
+  | BR0_TABLE var var_list expr
     { fun c -> let xs, x = Lib.List.split_last ($2 c label :: $3 c label) in
-      Br_table (xs, x, None, $4 c) }
+      Br0_table (xs, x, $4 c) }
   | BR_TABLE var var_list expr expr
     { fun c -> let xs, x = Lib.List.split_last ($2 c label :: $3 c label) in
-      Br_table (xs, x, Some ($4 c), $5 c) }
-  | RETURN expr_opt { fun c -> Return ($2 c) }
+      Br_table (xs, x, $4 c, $5 c) }
+  | RETURN expr { fun c -> Return ($2 c) }
+  | RETURN0 { fun c -> Return0 }
   | IF expr expr { fun c -> let c' = anon_label c in If ($2 c, [$3 c'], []) }
   | IF expr expr expr
     { fun c -> let c' = anon_label c in If ($2 c, [$3 c'], [$4 c']) }

ml-proto/spec/ast.ml

@@ -15,10 +15,14 @@ and expr' =
   | Unreachable
   | Block of expr list
   | Loop of expr list
-  | Br of var * expr option
-  | Br_if of var * expr option * expr
-  | Br_table of var list * var * expr option * expr
-  | Return of expr option
+  | Br of var * expr
+  | Br0 of var
+  | Br_if of var * expr * expr
+  | Br0_if of var * expr
+  | Br_table of var list * var * expr * expr
+  | Br0_table of var list * var * expr
+  | Return of expr
+  | Return0
   | If of expr * expr list * expr list
   | Select of expr * expr * expr
   | Call of var * expr list

ml-proto/spec/check.ml

@@ -104,7 +104,6 @@ let type_hostop = function
  * Conventions:
  *   c  : context
  *   e  : expr
- *   eo : expr option
  *   v  : value
  *   t  : value_type
  *   et : expr_type
@@ -127,18 +126,18 @@ let rec check_expr c et e =
     let c' = {c with labels = None :: c.labels} in
     check_expr c' et e1
 
-  | Break (x, eo) ->
-    check_expr_opt c (label c x) eo e.at
+  | Break (x, e) ->
+    check_expr c (label c x) e
 
-  | BreakIf (x, eo, e1) ->
-    check_expr_opt c (label c x) eo e.at;
-    check_expr c (Some Int32Type) e1;
+  | BreakIf (x, e1, e2) ->
+    check_expr c (label c x) e1;
+    check_expr c (Some Int32Type) e2;
     check_type None et e.at
 
-  | BreakTable (xs, x, eo, e1) ->
-    List.iter (fun x -> check_expr_opt c (label c x) eo e.at) xs;
-    check_expr_opt c (label c x) eo e.at;
-    check_expr c (Some Int32Type) e1
+  | BreakTable (xs, x, e1, e2) ->
+    List.iter (fun x -> check_expr c (label c x) e1) xs;
+    check_expr c (label c x) e2;
+    check_expr c (Some Int32Type) e2
 
   | If (e1, e2, e3) ->
     check_expr c (Some Int32Type) e1;
@@ -229,12 +228,6 @@ and check_exprs c ts es at =
   try List.iter2 (check_expr c) ets es
   with Invalid_argument _ -> error at "arity mismatch"
 
-and check_expr_opt c et eo at =
-  match et, eo with
-  | Some t, Some e -> check_expr c et e
-  | None, None -> ()
-  | _ -> error at "arity mismatch"
-
 and check_literal c et l =
   check_type (Some (type_value l.it)) et l.at
 

ml-proto/spec/desugar.ml

@@ -14,14 +14,14 @@ and relabel' f n = function
   | Block (es, e) ->
     Block (List.map (relabel f (n + 1)) es, relabel f (n + 1) e)
   | Loop e -> Loop (relabel f (n + 1) e)
-  | Break (x, eo) ->
-    Break (relabel_var f n x, Lib.Option.map (relabel f n) eo)
-  | BreakIf (x, eo, e) ->
-    BreakIf (relabel_var f n x, Lib.Option.map (relabel f n) eo, relabel f n e)
-  | BreakTable (xs, x, eo, e) ->
+  | Break (x, e) ->
+    Break (relabel_var f n x, relabel f n e)
+  | BreakIf (x, e1, e2) ->
+    BreakIf (relabel_var f n x, relabel f n e1, relabel f n e2)
+  | BreakTable (xs, x, e1, e2) ->
     BreakTable
       (List.map (relabel_var f n) xs, relabel_var f n x,
-       Lib.Option.map (relabel f n) eo, relabel f n e)
+       relabel f n e1, relabel f n e2)
   | If (e1, e2, e3) -> If (relabel f n e1, relabel f n e2, relabel f n e3)
   | Select (e1, e2, e3) ->
     Select (relabel f n e1, relabel f n e2, relabel f n e3)
@@ -65,14 +65,18 @@ and expr' at = function
   | Ast.Block es ->
     let es', e = Lib.List.split_last es in Block (List.map expr es', expr e)
   | Ast.Loop es -> Block ([], Loop (block es) @@ at)
-  | Ast.Br (x, eo) -> Break (x, Lib.Option.map expr eo)
-  | Ast.Br_if (x, eo, e) -> BreakIf (x, Lib.Option.map expr eo, expr e)
-  | Ast.Br_table (xs, x, eo, e) ->
-    BreakTable (xs, x, Lib.Option.map expr eo, expr e)
-  | Ast.Return eo -> Break (-1 @@ at, Lib.Option.map expr eo)
+  | Ast.Br (x, e) -> Break (x, expr e)
+  | Ast.Br0 (x) -> Break (x, Nop @@ Source.no_region)
+  | Ast.Br_if (x, e1, e2) -> BreakIf (x, expr e1, expr e2)
+  | Ast.Br0_if (x, e) -> BreakIf (x, Nop @@ Source.no_region, expr e)
+  | Ast.Br_table (xs, x, e1, e2) ->
+    BreakTable (xs, x, expr e1, expr e2)
+  | Ast.Br0_table (xs, x, e) ->
+    BreakTable (xs, x, Nop @@ Source.no_region, expr e)
+  | Ast.Return e -> Break (-1 @@ at, expr e)
+  | Ast.Return0 -> Break (-1 @@ at, Nop @@ Source.no_region)
   | Ast.If (e, es1, es2) -> If (expr e, seq es1, seq es2)
   | Ast.Select (e1, e2, e3) -> Select (expr e1, expr e2, expr e3)
-
   | Ast.Call (x, es) -> Call (x, List.map expr es)
   | Ast.Call_import (x, es) -> CallImport (x, List.map expr es)
   | Ast.Call_indirect (x, e, es) -> CallIndirect (x, expr e, List.map expr es)

ml-proto/spec/eval.ml

@@ -146,17 +146,17 @@ let rec eval_expr (c : config) (e : expr) =
     let c' = {c with labels = L.label :: c.labels} in
     (try eval_expr c' e1 with L.Label _ -> eval_expr c e)
 
-  | Break (x, eo) ->
-    raise (label c x (eval_expr_opt c eo))
+  | Break (x, e) ->
+    raise (label c x (eval_expr c e))
 
-  | BreakIf (x, eo, e) ->
-    let v = eval_expr_opt c eo in
-    let i = int32 (eval_expr c e) e.at in
+  | BreakIf (x, e1, e2) ->
+    let v = eval_expr c e1 in
+    let i = int32 (eval_expr c e2) e.at in
     if i <> 0l then raise (label c x v) else None
 
-  | BreakTable (xs, x, eo, e) ->
-    let v = eval_expr_opt c eo in
-    let i = int32 (eval_expr c e) e.at in
+  | BreakTable (xs, x, e1, e2) ->
+    let v = eval_expr c e1 in
+    let i = int32 (eval_expr c e2) e.at in
     if I32.lt_u i (Int32.of_int (List.length xs))
     then raise (label c (List.nth xs (Int32.to_int i)) v)
     else raise (label c x v)
@@ -257,10 +257,6 @@ let rec eval_expr (c : config) (e : expr) =
     let vs = List.map (eval_expr c) es in
     eval_hostop c hostop vs e.at
 
-and eval_expr_opt c = function
-  | Some e -> eval_expr c e
-  | None -> None
-
 and eval_func instance f vs =
   let args = List.map ref vs in
   let vars = List.map (fun t -> ref (default_value t)) f.it.locals in

ml-proto/spec/kernel.ml

@@ -80,9 +80,9 @@ and expr' =
   | Unreachable                             (* trap *)
   | Block of expr list * expr               (* execute in sequence *)
   | Loop of expr                            (* loop header *)
-  | Break of var * expr option              (* break to n-th surrounding label *)
-  | BreakIf of var * expr option * expr     (* conditional break *)
-  | BreakTable of var list * var * expr option * expr  (* indexed break *)
+  | Break of var * expr                     (* break to n-th surrounding label *)
+  | BreakIf of var * expr * expr            (* conditional break *)
+  | BreakTable of var list * var * expr * expr  (* indexed break *)
   | If of expr * expr * expr                (* conditional *)
   | Select of expr * expr * expr            (* branchless conditional *)
   | Call of var * expr list                 (* call function *)

ml-proto/test/fac.wast

@@ -26,13 +26,13 @@
     (loop
       (if
         (i64.eq (get_local 1) (i64.const 0))
-        (br 2)
+        (br0 2)
         (block
           (set_local 2 (i64.mul (get_local 1) (get_local 2)))
           (set_local 1 (i64.sub (get_local 1) (i64.const 1)))
         )
       )
-      (br 0)
+      (br0 0)
     )
     (get_local 2)
   )
@@ -46,13 +46,13 @@
     (loop $done $loop
       (if
         (i64.eq (get_local $i) (i64.const 0))
-        (br $done)
+        (br0 $done)
         (block
           (set_local $res (i64.mul (get_local $i) (get_local $res)))
           (set_local $i (i64.sub (get_local $i) (i64.const 1)))
         )
       )
-      (br $loop)
+      (br0 $loop)
     )
     (get_local $res)
   )
@@ -62,11 +62,11 @@
     (local i64)
     (set_local 1 (i64.const 1))
     (block
-      (br_if 0 (i64.lt_s (get_local 0) (i64.const 2)))
+      (br0_if 0 (i64.lt_s (get_local 0) (i64.const 2)))
       (loop
         (set_local 1 (i64.mul (get_local 1) (get_local 0)))
         (set_local 0 (i64.add (get_local 0) (i64.const -1)))
-        (br_if 0 (i64.gt_s (get_local 0) (i64.const 1)))
+        (br0_if 0 (i64.gt_s (get_local 0) (i64.const 1)))
       )
     )
     (get_local 1)