Implement br_table; drop tableswitch

ml-proto/README.md

@@ -97,14 +97,14 @@ cvtop: trunc_s | trunc_u | extend_s | extend_u | ...
 expr:
   ( nop )
   ( block <name>? <expr>* )
+  ( loop <name1>? <name2>? <expr>* )          ;; = (block <name1>? (loop <name2>? (block <expr>*)))
   ( select <expr> <expr> <expr> )
   ( if <expr> ( then <name>? <expr>* ) ( else <name>? <expr>* )? )
-  ( if <expr1> <expr2> <expr3>? )                ;; = (if <expr1> (then <expr2>) (else <expr3>?))
-  ( br_if <expr> <var> <expr>? )
-  ( loop <name1>? <name2>? <expr>* )             ;; = (block <name1>? (loop <name2>? (block <expr>*)))
+  ( if <expr1> <expr2> <expr3>? )             ;; = (if <expr1> (then <expr2>) (else <expr3>?))
   ( br <var> <expr>? )
-  ( return <expr>? )                             ;; = (br <current_depth> <expr>?)
-  ( tableswitch <name>? <expr> ( table <target>* ) <target> <case>* )
+  ( br_if <var> <expr>? <expr> )
+  ( br_table <var> <var> <expr>? <expr> )
+  ( return <expr>? )                          ;; = (br <current_depth> <expr>?)
   ( call <var> <expr>* )
   ( call_import <var> <expr>* )
   ( call_indirect <var> <expr> <expr>* )
@@ -121,13 +121,6 @@ expr:
   ( memory_size )
   ( grow_memory <expr> )
 
-target:
-  ( case <var> )
-  ( br <var> )                                   ;; = (case <name>) with (case <name> (br <var>))
-
-case:
-  ( case <name>? <expr>* )                       ;; = (case <var>? (block <expr>*))
-
 func:   ( func <name>? <type>? <param>* <result>? <local>* <expr>* )
 type:   ( type <var> )
 param:  ( param <type>* ) | ( param <name> <type> )

ml-proto/host/lexer.mll

@@ -143,13 +143,12 @@ rule token = parse
   | "loop" { LOOP }
   | "br" { BR }
   | "br_if" { BR_IF }
+  | "br_table" { BR_TABLE }
   | "return" { RETURN }
   | "if" { IF }
   | "then" { THEN }
   | "else" { ELSE }
   | "select" { SELECT }
-  | "tableswitch" { TABLESWITCH }
-  | "case" { CASE }
   | "call" { CALL }
   | "call_import" { CALL_IMPORT }
   | "call_indirect" { CALL_INDIRECT }

ml-proto/host/parser.mly

@@ -51,20 +51,17 @@ type types = {mutable tmap : int VarMap.t; mutable tlist : Types.func_type list}
 let empty_types () = {tmap = VarMap.empty; tlist = []}
 
 type context =
-  {types : types; funcs : space; imports : space; locals : space;
-   labels : int VarMap.t; cases : space}
+  {types : types; funcs : space; imports : space;
+   locals : space; labels : int VarMap.t}
 
 let empty_context () =
   {types = empty_types (); funcs = empty (); imports = empty ();
-   locals = empty (); labels = VarMap.empty; cases = empty ()}
+   locals = empty (); labels = VarMap.empty}
 
 let enter_func c =
   assert (VarMap.is_empty c.labels);
   {c with labels = VarMap.empty; locals = empty ()}
 
-let enter_switch c =
-  {c with cases = empty ()}
-
 let type_ c x =
   try VarMap.find x.it c.types.tmap
   with Not_found -> error x.at ("unknown type " ^ x.it)
@@ -76,7 +73,6 @@ let lookup category space x =
 let func c x = lookup "function" c.funcs x
 let import c x = lookup "import" c.imports x
 let local c x = lookup "local" c.locals x
-let case c x = lookup "case" c.cases x
 let label c x =
   try VarMap.find x.it c.labels
   with Not_found -> error x.at ("unknown label " ^ x.it)
@@ -96,7 +92,6 @@ let bind category space x =
 let bind_func c x = bind "function" c.funcs x
 let bind_import c x = bind "import" c.imports x
 let bind_local c x = bind "local" c.locals x
-let bind_case c x = bind "case" c.cases x
 let bind_label c x =
   {c with labels = VarMap.add x.it 0 (VarMap.map ((+) 1) c.labels)}
 
@@ -108,7 +103,6 @@ let anon space n = space.count <- space.count + n
 let anon_func c = anon c.funcs 1
 let anon_import c = anon c.imports 1
 let anon_locals c ts = anon c.locals (List.length ts)
-let anon_case c = anon c.cases 1
 let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels}
 
 let empty_type = {ins = []; out = None}
@@ -131,7 +125,7 @@ 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 TABLESWITCH CASE
+%token NOP BLOCK IF THEN ELSE SELECT LOOP BR BR_IF BR_TABLE
 %token CALL CALL_IMPORT CALL_INDIRECT RETURN
 %token GET_LOCAL SET_LOCAL LOAD STORE OFFSET ALIGN
 %token CONST UNARY BINARY COMPARE CONVERT
@@ -233,6 +227,12 @@ expr1 :
   | 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
+    { fun c -> let xs, x = Lib.List.split_last ($2 c label :: $3 c label) in
+      Br_table (xs, x, None, $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) }
   | IF expr expr { fun c -> let c' = anon_label c in If ($2 c, [$3 c'], []) }
   | IF expr expr expr
@@ -242,10 +242,6 @@ expr1 :
   | IF expr LPAR THEN labeling expr_list RPAR LPAR ELSE labeling expr_list RPAR
     { fun c -> let c1 = $5 c in let c2 = $10 c in If ($2 c, $6 c1, $11 c2) }
   | SELECT expr expr expr { fun c -> Select ($2 c, $3 c, $4 c) }
-  | TABLESWITCH labeling expr LPAR TABLE target_list RPAR target case_list
-    { fun c -> let c' = $2 c in let e = $3 c' in
-      let c'' = enter_switch c' in let es = $9 c'' in
-      Tableswitch (e, $6 c'', $8 c'', es) }
   | CALL var expr_list { fun c -> Call ($2 c func, $3 c) }
   | CALL_IMPORT var expr_list { fun c -> Call_import ($2 c import, $3 c) }
   | CALL_INDIRECT var expr expr_list
@@ -271,23 +267,6 @@ expr_list :
   | expr expr_list { fun c -> $1 c :: $2 c }
 ;
 
-target :
-  | LPAR CASE var RPAR { let at = at () in fun c -> Case ($3 c case) @@ at }
-  | LPAR BR var RPAR { let at = at () in fun c -> Case_br ($3 c label) @@ at }
-;
-target_list :
-  | /* empty */ { fun c -> [] }
-  | target target_list { fun c -> $1 c :: $2 c }
-;
-case :
-  | LPAR CASE expr_list RPAR { fun c -> anon_case c; $3 c }
-  | LPAR CASE bind_var expr_list RPAR { fun c -> bind_case c $3; $4 c }
-;
-case_list :
-  | /* empty */ { fun c -> [] }
-  | case case_list { fun c -> let e = $1 c in let es = $2 c in e :: es }
-;
-
 
 /* Functions */
 

ml-proto/spec/ast.ml

@@ -2,9 +2,6 @@
 
 type var = int Source.phrase
 
-type target = target' Source.phrase
-and target' = Case of var | Case_br of var
-
 type expr = expr' Source.phrase
 and expr' =
   (* Constants *)
@@ -20,10 +17,10 @@ and expr' =
   | 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
   | If of expr * expr list * expr list
   | Select of expr * expr * expr
-  | Tableswitch of expr * target list * target * expr list list
   | Call of var * expr list
   | Call_import of var * expr list
   | Call_indirect of var * expr * expr list

ml-proto/spec/check.ml

@@ -129,11 +129,16 @@ let rec check_expr c et e =
   | Break (x, eo) ->
     check_expr_opt c (label c x) eo e.at
 
-  | Br_if (x, eo, e) ->
+  | BreakIf (x, eo, e1) ->
     check_expr_opt c (label c x) eo e.at;
-    check_expr c (Some Int32Type) e;
+    check_expr c (Some Int32Type) e1;
     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
+
   | If (e1, e2, e3) ->
     check_expr c (Some Int32Type) e1;
     check_expr c et e2;
@@ -144,12 +149,6 @@ let rec check_expr c et e =
     check_expr c et e2;
     check_expr c (Some Int32Type) e3
 
-  | Switch (e1, xs, x, es) ->
-    List.iter (fun x -> require (x.it < List.length es) x.at "invalid target")
-      (x :: xs);
-    check_expr c (Some Int32Type) e1;
-    ignore (List.fold_right (fun e et -> check_expr c et e; None) es et)
-
   | Call (x, es) ->
     let {ins; out} = func c x in
     check_exprs c ins es e.at;

ml-proto/spec/desugar.ml

@@ -15,14 +15,16 @@ and relabel' f n = function
     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 (f n x.it @@ x.at, Lib.Option.map (relabel f n) eo)
-  | Br_if (x, eo, e) ->
-    Br_if (f n x.it @@ x.at, Lib.Option.map (relabel f n) eo, relabel f n e)
+    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) ->
+    BreakTable
+      (List.map (relabel_var f n) xs, relabel_var f n x,
+       Lib.Option.map (relabel f n) eo, relabel f n e)
   | 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)
-  | Switch (e, xs, x, es) ->
-    Switch (relabel f n e, xs, x, List.map (relabel f n) es)
   | Call (x, es) -> Call (x, List.map (relabel f n) es)
   | CallImport (x, es) -> CallImport (x, List.map (relabel f n) es)
   | CallIndirect (x, e, es) ->
@@ -41,6 +43,8 @@ and relabel' f n = function
   | Convert (cvtop, e) -> Convert (cvtop, relabel f n e)
   | Host (hostop, es) -> Host (hostop, List.map (relabel f n) es)
 
+and relabel_var f n x = f n x.it @@ x.at
+
 let label e = relabel (fun n i -> if i < n then i else i + 1) 0 e
 let return e = relabel (fun n i -> if i = -1 then n else i) (-1) e
 
@@ -61,30 +65,17 @@ and expr' at = function
     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) -> Br_if (x, Lib.Option.map expr eo, expr e)
-  | Ast.Return eo -> Break (-1 @@ Source.no_region, 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.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)
 
-  | Ast.Tableswitch (e, ts, t, es) ->
-    let target t (xs, es') =
-      match t.it with
-      | Ast.Case x -> x :: xs, es'
-      | Ast.Case_br x ->
-        (List.length es' @@ t.at) :: xs, (Break (x, None) @@ t.at) :: es'
-    in
-    let xs, es' = List.fold_right target (t :: ts) ([], []) in
-    let es'' = List.map block es in
-    let n = List.length es' in
-    let sh x = (if x.it >= n then x.it + n else x.it) @@ x.at in
-    Block ([], Switch
-      (expr e, List.map sh (List.tl xs), sh (List.hd xs), List.rev es' @ es'')
-      @@ at)
-
   | Ast.Get_local x -> GetLocal x
   | Ast.Set_local (x, e) -> SetLocal (x, expr e)
 

ml-proto/spec/eval.ml

@@ -149,11 +149,18 @@ let rec eval_expr (c : config) (e : expr) =
   | Break (x, eo) ->
     raise (label c x (eval_expr_opt c eo))
 
-  | Br_if (x, eo, e) ->
+  | BreakIf (x, eo, e) ->
     let v = eval_expr_opt c eo in
     let i = int32 (eval_expr c e) 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
+    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)
+
   | If (e1, e2, e3) ->
     let i = int32 (eval_expr c e1) e1.at in
     eval_expr c (if i <> 0l then e2 else e3)
@@ -164,15 +171,6 @@ let rec eval_expr (c : config) (e : expr) =
     let cond = int32 (eval_expr c e3) e3.at in
     Some (if cond <> 0l then v1 else v2)
 
-  | Switch (e1, xs, x, es) ->
-    let i = int32 (eval_expr c e1) e1.at in
-    let x' =
-      if I32.ge_u i (Int32.of_int (List.length xs)) then x
-      else List.nth xs (Int32.to_int i)
-    in
-    if x'.it >= List.length es then Crash.error e.at "invalid switch target";
-    List.fold_left (fun vo e -> eval_expr c e) None (Lib.List.drop x'.it es)
-
   | Call (x, es) ->
     let vs = List.map (fun vo -> some (eval_expr c vo) vo.at) es in
     eval_func c.instance (func c x) vs

ml-proto/spec/kernel.ml

@@ -78,10 +78,10 @@ and expr' =
   | Block of expr list * expr               (* execute in sequence *)
   | Loop of expr                            (* loop header *)
   | Break of var * expr option              (* break to n-th surrounding label *)
-  | Br_if of var * expr option * expr       (* conditional break *)
+  | BreakIf of var * expr option * expr     (* conditional break *)
+  | BreakTable of var list * var * expr option * expr  (* indexed break *)
   | If of expr * expr * expr                (* conditional *)
   | Select of expr * expr * expr            (* branchless conditional *)
-  | Switch of expr * var list * var * expr list   (* table switch *)
   | Call of var * expr list                 (* call function *)
   | CallImport of var * expr list           (* call imported function *)
   | CallIndirect of var * expr * expr list  (* call function through table *)

ml-proto/test/labels.wast

@@ -106,25 +106,40 @@
   (func $switch (param i32) (result i32)
     (block $ret
       (i32.mul (i32.const 10)
-        (tableswitch $exit (get_local 0)
-          (table (case $0) (case $1) (case $2) (case $3)) (case $default)
-          (case $1 (i32.const 1))
-          (case $2 (br $exit (i32.const 2)))
-          (case $3 (br $ret (i32.const 3)))
-          (case $default (i32.const 4))
-          (case $0 (i32.const 5))
+        (block $exit
+          (block $0
+            (block $default
+              (block $3
+                (block $2
+                  (block $1
+                    (br_table $0 $1 $2 $3 $default (get_local 0))
+                  ) ;; 1
+                  (i32.const 1)
+                ) ;; 2
+                (br $exit (i32.const 2))
+              ) ;; 3
+              (br $ret (i32.const 3))
+            ) ;; default
+            (i32.const 4)
+          ) ;; 0
+          (i32.const 5)
         )
       )
     )
   )
 
   (func $return (param i32) (result i32)
-    (tableswitch (get_local 0)
-      (table (case $0) (case $1)) (case $default)
-      (case $0 (return (i32.const 0)))
-      (case $1 (i32.const 1))
-      (case $default (i32.const 2))
-    )
+    (block $default
+      (block $1
+        (block $0
+          (br_table $0 $1 (get_local 0))
+          (br $default)
+        ) ;; 0
+        (return (i32.const 0))
+      ) ;; 1
+      (i32.const 1)
+    ) ;; default
+    (i32.const 2)
   )
 
   (func $br_if0 (result i32)