diff --git a/ml-proto/README.md b/ml-proto/README.md index 98e94f8e2e..26eb17d73b 100644 --- a/ml-proto/README.md +++ b/ml-proto/README.md @@ -97,14 +97,14 @@ cvtop: trunc_s | trunc_u | extend_s | extend_u | ... expr: ( nop ) ( block ? * ) + ( loop ? ? * ) ;; = (block ? (loop ? (block *))) ( select ) ( if ( then ? * ) ( else ? * )? ) - ( if ? ) ;; = (if (then ) (else ?)) - ( br_if ? ) - ( loop ? ? * ) ;; = (block ? (loop ? (block *))) + ( if ? ) ;; = (if (then ) (else ?)) ( br ? ) - ( return ? ) ;; = (br ?) - ( tableswitch ? ( table * ) * ) + ( br_if ? ) + ( br_table ? ) + ( return ? ) ;; = (br ?) ( call * ) ( call_import * ) ( call_indirect * ) @@ -121,13 +121,6 @@ expr: ( memory_size ) ( grow_memory ) -target: - ( case ) - ( br ) ;; = (case ) with (case (br )) - -case: - ( case ? * ) ;; = (case ? (block *)) - func: ( func ? ? * ? * * ) type: ( type ) param: ( param * ) | ( param ) diff --git a/ml-proto/host/lexer.mll b/ml-proto/host/lexer.mll index d94840fab9..62e09b5b46 100644 --- a/ml-proto/host/lexer.mll +++ b/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 } diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index d7dfe08485..5145aa8cbf 100644 --- a/ml-proto/host/parser.mly +++ b/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 */ diff --git a/ml-proto/spec/ast.ml b/ml-proto/spec/ast.ml index 47033c2ceb..79676c37eb 100644 --- a/ml-proto/spec/ast.ml +++ b/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 diff --git a/ml-proto/spec/check.ml b/ml-proto/spec/check.ml index d981d59092..764107b508 100644 --- a/ml-proto/spec/check.ml +++ b/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; diff --git a/ml-proto/spec/desugar.ml b/ml-proto/spec/desugar.ml index e95142cc3d..44df7f9edb 100644 --- a/ml-proto/spec/desugar.ml +++ b/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,8 +65,10 @@ 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) @@ -70,21 +76,6 @@ and expr' at = function | 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) diff --git a/ml-proto/spec/eval.ml b/ml-proto/spec/eval.ml index 1f27bc1775..712e571b13 100644 --- a/ml-proto/spec/eval.ml +++ b/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 diff --git a/ml-proto/spec/kernel.ml b/ml-proto/spec/kernel.ml index a4d16b8312..25756b3a48 100644 --- a/ml-proto/spec/kernel.ml +++ b/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 *) diff --git a/ml-proto/test/labels.wast b/ml-proto/test/labels.wast index 3a9eed66fb..a44e412335 100644 --- a/ml-proto/test/labels.wast +++ b/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) diff --git a/ml-proto/test/switch.wast b/ml-proto/test/switch.wast index 60a13d1205..9c1b0e29f9 100644 --- a/ml-proto/test/switch.wast +++ b/ml-proto/test/switch.wast @@ -3,20 +3,41 @@ (func $stmt (param $i i32) (result i32) (local $j i32) (set_local $j (i32.const 100)) - (block - (tableswitch (get_local $i) - (table (case $0) (case $1) (case $2) (case $3) (case $4) - (case $5) (case $6) (case $7)) (case $default) - (case $0 (return (get_local $i))) - (case $1 (nop)) ;; fallthrough - (case $2) ;; fallthrough - (case $3 (set_local $j (i32.sub (i32.const 0) (get_local $i))) (br 0)) - (case $4 (br 0)) - (case $5 (set_local $j (i32.const 101)) (br 0)) - (case $6 (set_local $j (i32.const 101))) ;; fallthrough - (case $default (set_local $j (i32.const 102))) - (case $7) - ) + (block $switch + (block $7 + (block $default + (block $6 + (block $5 + (block $4 + (block $3 + (block $2 + (block $1 + (block $0 + (br_table $0 $1 $2 $3 $4 $5 $6 $7 $default + (get_local $i) + ) + ) ;; 0 + (return (get_local $i)) + ) ;; 1 + (nop) + ;; fallthrough + ) ;; 2 + ;; fallthrough + ) ;; 3 + (set_local $j (i32.sub (i32.const 0) (get_local $i))) + (br $switch) + ) ;; 4 + (br $switch) + ) ;; 5 + (set_local $j (i32.const 101)) + (br $switch) + ) ;; 6 + (set_local $j (i32.const 101)) + ;; fallthrough + ) ;; default + (set_local $j (i32.const 102)) + ) ;; 7 + ;; fallthrough ) (return (get_local $j)) ) @@ -26,83 +47,79 @@ (local $j i64) (set_local $j (i64.const 100)) (return - (block $l - (tableswitch (i32.wrap/i64 (get_local $i)) - (table (case $0) (case $1) (case $2) (case $3) (case $4) - (case $5) (case $6) (case $7)) (case $default) - (case $0 (return (get_local $i))) - (case $1 (nop)) ;; fallthrough - (case $2) ;; fallthrough - (case $3 (br $l (i64.sub (i64.const 0) (get_local $i)))) - (case $6 (set_local $j (i64.const 101))) ;; fallthrough - (case $4) ;; fallthrough - (case $5) ;; fallthrough - (case $default (br $l (get_local $j))) - (case $7 (i64.const -5)) - ) + (block $switch + (block $7 + (block $default + (block $4 + (block $5 + (block $6 + (block $3 + (block $2 + (block $1 + (block $0 + (br_table $0 $1 $2 $3 $4 $5 $6 $7 $default + (i32.wrap/i64 (get_local $i)) + ) + ) ;; 0 + (return (get_local $i)) + ) ;; 1 + (nop) + ;; fallthrough + ) ;; 2 + ;; fallthrough + ) ;; 3 + (br $switch (i64.sub (i64.const 0) (get_local $i))) + ) ;; 6 + (set_local $j (i64.const 101)) + ;; fallthrough + ) ;; 4 + ;; fallthrough + ) ;; 5 + ;; fallthrough + ) ;; default + (br $switch (get_local $j)) + ) ;; 7 + (i64.const -5) ) ) ) - ;; Corner cases - (func $corner (result i32) - (local $x i32) - (tableswitch (i32.const 0) - (table) (case $default) - (case $default) - ) - (tableswitch (i32.const 0) - (table) (case $default) - (case $default (set_local $x (i32.add (get_local $x) (i32.const 1)))) - ) - (tableswitch (i32.const 1) - (table (case $0)) (case $default) - (case $default (set_local $x (i32.add (get_local $x) (i32.const 2)))) - (case $0 (set_local $x (i32.add (get_local $x) (i32.const 4)))) - ) - (get_local $x) - ) - - ;; Break - (func $break (result i32) - (local $x i32) - (tableswitch $l (i32.const 0) - (table) (br $l) - ) - (tableswitch $l (i32.const 0) - (table (br $l)) (case $default) - (case $default (set_local $x (i32.add (get_local $x) (i32.const 1)))) - ) - (tableswitch $l (i32.const 1) - (table (case $0)) (br $l) - (case $0 (set_local $x (i32.add (get_local $x) (i32.const 2)))) + ;; Argument switch + (func $arg (param $i i32) (result i32) + (return + (block $2 + (i32.add (i32.const 10) + (block $1 + (i32.add (i32.const 100) + (block $0 + (i32.add (i32.const 1000) + (block $default + (br_table $0 $1 $2 $default + (i32.mul (i32.const 2) (get_local $i)) + (i32.and (i32.const 3) (get_local $i)) + ) + ) + ) + ) + ) + ) + ) + ) ) - (get_local $x) ) - ;; Nested break - (func $nested (param i32) (result i32) + ;; Corner cases + (func $corner (result i32) (block - (block - (block - (tableswitch (get_local 0) - (table (br 0) (br 1) (br 2)) - (br 3) - ) - (return (i32.const 1)) - ) - (return (i32.const 2)) - ) - (return (i32.const 3)) + (br_table 0 (i32.const 0)) ) - (return (i32.const 4)) + (i32.const 1) ) (export "stmt" $stmt) (export "expr" $expr) + (export "arg" $arg) (export "corner" $corner) - (export "break" $break) - (export "nested" $nested) ) (assert_return (invoke "stmt" (i32.const 0)) (i32.const 0)) @@ -123,14 +140,16 @@ (assert_return (invoke "expr" (i64.const 7)) (i64.const -5)) (assert_return (invoke "expr" (i64.const -10)) (i64.const 100)) -(assert_return (invoke "corner") (i32.const 7)) -(assert_return (invoke "break") (i32.const 0)) +(assert_return (invoke "arg" (i32.const 0)) (i32.const 110)) +(assert_return (invoke "arg" (i32.const 1)) (i32.const 12)) +(assert_return (invoke "arg" (i32.const 2)) (i32.const 4)) +(assert_return (invoke "arg" (i32.const 3)) (i32.const 1116)) +(assert_return (invoke "arg" (i32.const 4)) (i32.const 118)) +(assert_return (invoke "arg" (i32.const 5)) (i32.const 20)) +(assert_return (invoke "arg" (i32.const 6)) (i32.const 12)) +(assert_return (invoke "arg" (i32.const 7)) (i32.const 1124)) +(assert_return (invoke "arg" (i32.const 8)) (i32.const 126)) -(assert_return (invoke "nested" (i32.const 0)) (i32.const 1)) -(assert_return (invoke "nested" (i32.const 1)) (i32.const 2)) -(assert_return (invoke "nested" (i32.const 2)) (i32.const 3)) -(assert_return (invoke "nested" (i32.const 3)) (i32.const 4)) -(assert_return (invoke "nested" (i32.const 4)) (i32.const 4)) +(assert_return (invoke "corner") (i32.const 1)) -(assert_invalid (module (func (tableswitch (i32.const 0) (table) (case 0)))) "invalid target") -(assert_invalid (module (func (tableswitch (i32.const 0) (table) (case 1) (case)))) "invalid target") +(assert_invalid (module (func (br_table 3 (i32.const 0)))) "unknown label")