From 6ec64dc6259a5b90a7e4d96adddfe77525e5ff9a Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Wed, 24 Feb 2016 14:01:42 +0100 Subject: [PATCH 1/3] Implement br_table; drop tableswitch --- ml-proto/README.md | 17 +--- ml-proto/host/lexer.mll | 3 +- ml-proto/host/parser.mly | 38 ++------ ml-proto/spec/ast.ml | 5 +- ml-proto/spec/check.ml | 16 ++-- ml-proto/spec/desugar.ml | 34 +++---- ml-proto/spec/eval.ml | 18 ++-- ml-proto/spec/kernel.ml | 4 +- ml-proto/test/labels.wast | 42 ++++++--- ml-proto/test/switch.wast | 188 ++++++++++++++++++++------------------ ml-proto/winmake.bat | 72 --------------- 11 files changed, 173 insertions(+), 264 deletions(-) delete mode 100644 ml-proto/winmake.bat diff --git a/ml-proto/README.md b/ml-proto/README.md index b9672073a3..f5855372ca 100644 --- a/ml-proto/README.md +++ b/ml-proto/README.md @@ -92,13 +92,13 @@ cvtop: trunc_s | trunc_u | extend_s | extend_u | ... expr: ( nop ) ( block ? + ) + ( loop ? ? * ) ;; = (block ? (loop ? (block *))) ( if_else ) - ( if ) ;; = (if_else (nop)) - ( br_if ?) ;; = (if_else (br ?) (block ? (nop))) - ( loop ? ? * ) ;; = (block ? (loop ? (block *))) + ( if ) ;; = (if_else (nop)) ( br ? ) - ( return ? ) ;; = (br ?) - ( tableswitch ? ( table * ) * ) + ( br_if ? ) + ( br_table * ? ) + ( return ? ) ;; = (br ?) ( call * ) ( call_import * ) ( call_indirect * ) @@ -116,13 +116,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 d2f0be8b43..e9e1013be9 100644 --- a/ml-proto/host/lexer.mll +++ b/ml-proto/host/lexer.mll @@ -143,11 +143,10 @@ rule token = parse | "loop" { LOOP } | "br" { BR } | "br_if" { BR_IF } + | "br_table" { BR_TABLE } | "return" { RETURN } | "if" { IF } | "if_else" { IF_ELSE } - | "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 10af448d6a..06e9a20811 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.add "return" 0 c.labels; 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 IF_ELSE LOOP BR BR_IF TABLESWITCH CASE +%token NOP BLOCK IF IF_ELSE 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 @@ -235,15 +229,14 @@ 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_list expr { fun c -> Br_table ($2 c label, None, $3 c) } + | BR_TABLE var_list expr expr + { fun c -> Br_table ($2 c label, Some ($3 c), $4 c) } | RETURN expr_opt { let at1 = ati 1 in fun c -> Return (label c ("return" @@ at1) @@ at1, $2 c) } | IF expr expr { fun c -> If ($2 c, $3 c) } | IF_ELSE expr expr expr { fun c -> If_else ($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 +264,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 7bb3e28cf7..0e97615e0a 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 * expr option * expr | Return of var * expr option | If of expr * expr | If_else 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 d6c3a191da..eee28f62eb 100644 --- a/ml-proto/spec/check.ml +++ b/ml-proto/spec/check.ml @@ -133,9 +133,15 @@ 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) -> + | Break_if (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 + + | Break_table (xs, eo, e1) -> + if xs = [] then check_expr_opt c None eo e.at + else List.iter (fun x -> check_expr_opt c (label c x) eo e.at) xs; + check_expr c (Some Int32Type) e1; check_type None et e.at | If (e1, e2, e3) -> @@ -143,12 +149,6 @@ let rec check_expr c et e = check_expr c et e2; check_expr c et 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 9e278a14b8..78226e43f9 100644 --- a/ml-proto/spec/desugar.ml +++ b/ml-proto/spec/desugar.ml @@ -8,20 +8,20 @@ open Kernel (* Labels *) let rec label e = shift 0 e + and shift n e = shift' n e.it @@ e.at and shift' n = function | Nop -> Nop | Unreachable -> Unreachable | Block es -> Block (List.map (shift (n + 1)) es) | Loop e -> Loop (shift (n + 1) e) - | Break (x, eo) -> - let x' = if x.it < n then x else (x.it + 1) @@ x.at in - Break (x', Lib.Option.map (shift n) eo) - | Br_if (x, eo, e) -> - let x' = if x.it < n then x else (x.it + 1) @@ x.at in - Br_if (x', Lib.Option.map (shift n) eo, shift n e) + | Break (x, eo) -> Break (shift_var n x, Lib.Option.map (shift n) eo) + | Break_if (x, eo, e) -> + Break_if (shift_var n x, Lib.Option.map (shift n) eo, shift n e) + | Break_table (xs, eo, e) -> + Break_table + (List.map (shift_var n) xs, Lib.Option.map (shift n) eo, shift n e) | If (e1, e2, e3) -> If (shift n e1, shift n e2, shift n e3) - | Switch (e, xs, x, es) -> Switch (shift n e, xs, x, List.map (shift n) es) | Call (x, es) -> Call (x, List.map (shift n) es) | CallImport (x, es) -> CallImport (x, List.map (shift n) es) | CallIndirect (x, e, es) -> @@ -41,6 +41,8 @@ and shift' n = function | Convert (cvtop, e) -> Convert (cvtop, shift n e) | Host (hostop, es) -> Host (hostop, List.map (shift n) es) +and shift_var n x = if x.it < n then x else (x.it + 1) @@ x.at + (* Expressions *) @@ -56,7 +58,8 @@ and expr' at = function | Ast.Block es -> Block (List.map expr es) | Ast.Loop es -> Block [Loop (seq 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.Br_if (x, eo, e) -> Break_if (x, Lib.Option.map expr eo, expr e) + | Ast.Br_table (xs, eo, e) -> Break_table (xs, Lib.Option.map expr eo, expr e) | Ast.Return (x, eo) -> Break (x, Lib.Option.map expr eo) | Ast.If (e1, e2) -> If (expr e1, expr e2, Nop @@ Source.after e2.at) | Ast.If_else (e1, e2, e3) -> If (expr e1, expr e2, expr e3) @@ -64,21 +67,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 seq 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 fadbbcb513..d74e0b3316 100644 --- a/ml-proto/spec/eval.ml +++ b/ml-proto/spec/eval.ml @@ -154,24 +154,22 @@ 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) -> + | Break_if (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 + | Break_table (xs, 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 None + | If (e1, e2, e3) -> let i = int32 (eval_expr c e1) e1.at in eval_expr c (if i <> 0l then e2 else e3) - | 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 c90675a79a..83c4335eff 100644 --- a/ml-proto/spec/kernel.ml +++ b/ml-proto/spec/kernel.ml @@ -82,9 +82,9 @@ and expr' = | Block of expr list (* 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 *) + | Break_if of var * expr option * expr (* conditional break *) + | Break_table of var list * expr option * expr (* indexed break *) | If of expr * expr * expr (* 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 8c51f054c6..b6adf8d8d2 100644 --- a/ml-proto/test/labels.wast +++ b/ml-proto/test/labels.wast @@ -69,25 +69,41 @@ (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 (get_local 0)) + (br $default) + ) ;; 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..6fc2cb9f3a 100644 --- a/ml-proto/test/switch.wast +++ b/ml-proto/test/switch.wast @@ -3,20 +3,40 @@ (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 (get_local $i)) + (br $default) + ) ;; 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 +46,75 @@ (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 + (i32.wrap/i64 (get_local $i)) + ) + (br $default) + ) ;; 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)))) - ) - (get_local $x) - ) - - ;; Nested break - (func $nested (param i32) (result i32) - (block - (block - (block - (tableswitch (get_local 0) - (table (br 0) (br 1) (br 2)) - (br 3) + ;; 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 + (br_table $0 $1 $2 + (i32.mul (i32.const 2) (get_local $i)) + (i32.and (i32.const 3) (get_local $i)) + ) + (i32.add (i32.const 1000) (get_local $i)) + ) + ) ) - (return (i32.const 1)) ) - (return (i32.const 2)) ) - (return (i32.const 3)) ) - (return (i32.const 4)) + ) + + ;; Corner cases + (func $corner (result i32) + (br_table (i32.const 0)) + (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 +135,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 1113)) +(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 1117)) +(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") diff --git a/ml-proto/winmake.bat b/ml-proto/winmake.bat deleted file mode 100644 index 18fb5d6b2e..0000000000 --- a/ml-proto/winmake.bat +++ /dev/null @@ -1,72 +0,0 @@ -rem Auto-generated from Makefile! -set NAME=wasm -if '%1' neq '' set NAME=%1 -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/float.cmo spec/float.ml -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/numerics.cmi spec/numerics.mli -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/int.cmo spec/int.ml -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/types.cmo spec/types.ml -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/f32.cmo spec/f32.ml -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/f64.cmo spec/f64.ml -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/i32.cmo spec/i32.ml -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/i64.cmo spec/i64.ml -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/values.cmo spec/values.ml -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/memory.cmi spec/memory.mli -ocamlc.opt -c -bin-annot -I given -I spec -I host -I host/import -o given/source.cmi given/source.mli -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/kernel.cmo spec/kernel.ml -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/eval.cmi spec/eval.mli -ocamlyacc host/parser.mly -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/ast.cmo spec/ast.ml -ocamlc.opt -c -bin-annot -I host -I spec -I given -I host/import -o host/script.cmi host/script.mli -ocamlc.opt -c -bin-annot -I host -I spec -I given -I host/import -o host/parser.cmi host/parser.mli -ocamlc.opt -c -bin-annot -I host -I spec -I given -I host/import -o host/print.cmi host/print.mli -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/check.cmi spec/check.mli -ocamlc.opt -c -bin-annot -I host/import -I spec -I given -I host -o host/import/env.cmo host/import/env.ml -ocamlc.opt -c -bin-annot -I host -I spec -I given -I host/import -o host/flags.cmo host/flags.ml -ocamlc.opt -c -bin-annot -I host -I spec -I given -I host/import -o host/import.cmi host/import.mli -ocamlc.opt -c -bin-annot -I host -I spec -I given -I host/import -o host/lexer.cmi host/lexer.mli -ocamlc.opt -c -bin-annot -I host/import -I spec -I given -I host -o host/import/spectest.cmo host/import/spectest.ml -ocamlc.opt -c -bin-annot -I host -I spec -I given -I host/import -o host/main.cmo host/main.ml -ocamlc.opt -c -g -bin-annot -I host -I spec -I given -I host/import -o host/main.d.cmo host/main.ml -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/error.cmi spec/error.mli -ocamlc.opt -c -bin-annot -I given -I spec -I host -I host/import -o given/lib.cmi given/lib.mli -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/arithmetic.cmi spec/arithmetic.mli -ocamllex.opt -q host/lexer.mll -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/desugar.cmi spec/desugar.mli -ocamlc.opt -c -bin-annot -I host -I spec -I given -I host/import -o host/params.cmo host/params.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/check.d.cmo spec/check.ml -ocamlc.opt -c -g -bin-annot -I host/import -I spec -I given -I host -o host/import/env.d.cmo host/import/env.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/eval.d.cmo spec/eval.ml -ocamlc.opt -c -g -bin-annot -I host -I spec -I given -I host/import -o host/flags.d.cmo host/flags.ml -ocamlc.opt -c -g -bin-annot -I host -I spec -I given -I host/import -o host/import.d.cmo host/import.ml -ocamlc.opt -c -g -bin-annot -I host -I spec -I given -I host/import -o host/lexer.d.cmo host/lexer.ml -ocamlc.opt -c -g -bin-annot -I host -I spec -I given -I host/import -o host/parser.d.cmo host/parser.ml -ocamlc.opt -c -g -bin-annot -I host -I spec -I given -I host/import -o host/script.d.cmo host/script.ml -ocamlc.opt -c -g -bin-annot -I given -I spec -I host -I host/import -o given/source.d.cmo given/source.ml -ocamlc.opt -c -g -bin-annot -I host/import -I spec -I given -I host -o host/import/spectest.d.cmo host/import/spectest.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/error.d.cmo spec/error.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/kernel.d.cmo spec/kernel.ml -ocamlc.opt -c -g -bin-annot -I given -I spec -I host -I host/import -o given/lib.d.cmo given/lib.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/memory.d.cmo spec/memory.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/types.d.cmo spec/types.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/values.d.cmo spec/values.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/f32.d.cmo spec/f32.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/f64.d.cmo spec/f64.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/i64.d.cmo spec/i64.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/float.d.cmo spec/float.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/int.d.cmo spec/int.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/numerics.d.cmo spec/numerics.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/i32.d.cmo spec/i32.ml -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/f32_convert.cmi spec/f32_convert.mli -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/f64_convert.cmi spec/f64_convert.mli -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/i32_convert.cmi spec/i32_convert.mli -ocamlc.opt -c -bin-annot -I spec -I given -I host -I host/import -o spec/i64_convert.cmi spec/i64_convert.mli -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/arithmetic.d.cmo spec/arithmetic.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/f32_convert.d.cmo spec/f32_convert.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/f64_convert.d.cmo spec/f64_convert.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/i32_convert.d.cmo spec/i32_convert.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/i64_convert.d.cmo spec/i64_convert.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/ast.d.cmo spec/ast.ml -ocamlc.opt -c -g -bin-annot -I spec -I given -I host -I host/import -o spec/desugar.d.cmo spec/desugar.ml -ocamlc.opt -c -g -bin-annot -I host -I spec -I given -I host/import -o host/params.d.cmo host/params.ml -ocamlc.opt -c -g -bin-annot -I host -I spec -I given -I host/import -o host/print.d.cmo host/print.ml -ocamlc.opt str.cma bigarray.cma -g given/source.d.cmo host/flags.d.cmo spec/error.d.cmo given/lib.d.cmo spec/float.d.cmo spec/f32.d.cmo spec/f64.d.cmo spec/numerics.d.cmo spec/int.d.cmo spec/i32.d.cmo spec/i64.d.cmo spec/i32_convert.d.cmo spec/f32_convert.d.cmo spec/i64_convert.d.cmo spec/f64_convert.d.cmo spec/types.d.cmo spec/values.d.cmo spec/memory.d.cmo spec/kernel.d.cmo spec/arithmetic.d.cmo spec/eval.d.cmo host/import.d.cmo host/import/env.d.cmo host/print.d.cmo host/import/spectest.d.cmo host/params.d.cmo spec/ast.d.cmo spec/check.d.cmo spec/desugar.d.cmo host/script.d.cmo host/parser.d.cmo host/lexer.d.cmo host/main.d.cmo -o %NAME% From 85d05455e887f5ad750f5bbf0b85bd71111bbf23 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Fri, 26 Feb 2016 09:51:51 +0100 Subject: [PATCH 2/3] Have a default target --- ml-proto/README.md | 2 +- ml-proto/host/parser.mly | 9 ++++++--- ml-proto/spec/ast.ml | 2 +- ml-proto/spec/check.ml | 9 ++++----- ml-proto/spec/desugar.ml | 8 +++++--- ml-proto/spec/eval.ml | 4 ++-- ml-proto/spec/kernel.ml | 2 +- ml-proto/test/labels.wast | 3 +-- ml-proto/test/switch.wast | 27 ++++++++++++++++----------- 9 files changed, 37 insertions(+), 29 deletions(-) diff --git a/ml-proto/README.md b/ml-proto/README.md index f5855372ca..183aa5d667 100644 --- a/ml-proto/README.md +++ b/ml-proto/README.md @@ -97,7 +97,7 @@ expr: ( if ) ;; = (if_else (nop)) ( br ? ) ( br_if ? ) - ( br_table * ? ) + ( br_table + ? ) ( return ? ) ;; = (br ?) ( call * ) ( call_import * ) diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index 06e9a20811..dc461fdd19 100644 --- a/ml-proto/host/parser.mly +++ b/ml-proto/host/parser.mly @@ -229,9 +229,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_list expr { fun c -> Br_table ($2 c label, None, $3 c) } - | BR_TABLE var_list expr expr - { fun c -> Br_table ($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 { let at1 = ati 1 in fun c -> Return (label c ("return" @@ at1) @@ at1, $2 c) } diff --git a/ml-proto/spec/ast.ml b/ml-proto/spec/ast.ml index 0e97615e0a..dc3d4efff4 100644 --- a/ml-proto/spec/ast.ml +++ b/ml-proto/spec/ast.ml @@ -17,7 +17,7 @@ and expr' = | Loop of expr list | Br of var * expr option | Br_if of var * expr option * expr - | Br_table of var list * expr option * expr + | Br_table of var list * var * expr option * expr | Return of var * expr option | If of expr * expr | If_else of expr * expr * expr diff --git a/ml-proto/spec/check.ml b/ml-proto/spec/check.ml index eee28f62eb..a0ac63b876 100644 --- a/ml-proto/spec/check.ml +++ b/ml-proto/spec/check.ml @@ -138,11 +138,10 @@ let rec check_expr c et e = check_expr c (Some Int32Type) e1; check_type None et e.at - | Break_table (xs, eo, e1) -> - if xs = [] then check_expr_opt c None eo e.at - else List.iter (fun x -> check_expr_opt c (label c x) eo e.at) xs; - check_expr c (Some Int32Type) e1; - check_type None et e.at + | Break_table (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; diff --git a/ml-proto/spec/desugar.ml b/ml-proto/spec/desugar.ml index 78226e43f9..1a67896f46 100644 --- a/ml-proto/spec/desugar.ml +++ b/ml-proto/spec/desugar.ml @@ -18,9 +18,10 @@ and shift' n = function | Break (x, eo) -> Break (shift_var n x, Lib.Option.map (shift n) eo) | Break_if (x, eo, e) -> Break_if (shift_var n x, Lib.Option.map (shift n) eo, shift n e) - | Break_table (xs, eo, e) -> + | Break_table (xs, x, eo, e) -> Break_table - (List.map (shift_var n) xs, Lib.Option.map (shift n) eo, shift n e) + (List.map (shift_var n) xs, shift_var n x, + Lib.Option.map (shift n) eo, shift n e) | If (e1, e2, e3) -> If (shift n e1, shift n e2, shift n e3) | Call (x, es) -> Call (x, List.map (shift n) es) | CallImport (x, es) -> CallImport (x, List.map (shift n) es) @@ -59,7 +60,8 @@ and expr' at = function | Ast.Loop es -> Block [Loop (seq es) @@ at] | Ast.Br (x, eo) -> Break (x, Lib.Option.map expr eo) | Ast.Br_if (x, eo, e) -> Break_if (x, Lib.Option.map expr eo, expr e) - | Ast.Br_table (xs, eo, e) -> Break_table (xs, Lib.Option.map expr eo, expr e) + | Ast.Br_table (xs, x, eo, e) -> + Break_table (xs, x, Lib.Option.map expr eo, expr e) | Ast.Return (x, eo) -> Break (x, Lib.Option.map expr eo) | Ast.If (e1, e2) -> If (expr e1, expr e2, Nop @@ Source.after e2.at) | Ast.If_else (e1, e2, e3) -> If (expr e1, expr e2, expr e3) diff --git a/ml-proto/spec/eval.ml b/ml-proto/spec/eval.ml index d74e0b3316..4975ec45d3 100644 --- a/ml-proto/spec/eval.ml +++ b/ml-proto/spec/eval.ml @@ -159,12 +159,12 @@ let rec eval_expr (c : config) (e : expr) = let i = int32 (eval_expr c e) e.at in if i <> 0l then raise (label c x v) else None - | Break_table (xs, eo, e) -> + | Break_table (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 None + else raise (label c x v) | If (e1, e2, e3) -> let i = int32 (eval_expr c e1) e1.at in diff --git a/ml-proto/spec/kernel.ml b/ml-proto/spec/kernel.ml index 83c4335eff..c947af5d01 100644 --- a/ml-proto/spec/kernel.ml +++ b/ml-proto/spec/kernel.ml @@ -83,7 +83,7 @@ and expr' = | Loop of expr (* loop header *) | Break of var * expr option (* break to n-th surrounding label *) | Break_if of var * expr option * expr (* conditional break *) - | Break_table of var list * expr option * expr (* indexed break *) + | Break_table of var list * var * expr option * expr (* indexed break *) | If of expr * expr * expr (* conditional *) | Call of var * expr list (* call function *) | CallImport of var * expr list (* call imported function *) diff --git a/ml-proto/test/labels.wast b/ml-proto/test/labels.wast index b6adf8d8d2..1822622aee 100644 --- a/ml-proto/test/labels.wast +++ b/ml-proto/test/labels.wast @@ -75,8 +75,7 @@ (block $3 (block $2 (block $1 - (br_table $0 $1 $2 $3 (get_local 0)) - (br $default) + (br_table $0 $1 $2 $3 $default (get_local 0)) ) ;; 1 (i32.const 1) ) ;; 2 diff --git a/ml-proto/test/switch.wast b/ml-proto/test/switch.wast index 6fc2cb9f3a..9c1b0e29f9 100644 --- a/ml-proto/test/switch.wast +++ b/ml-proto/test/switch.wast @@ -13,8 +13,9 @@ (block $2 (block $1 (block $0 - (br_table $0 $1 $2 $3 $4 $5 $6 $7 (get_local $i)) - (br $default) + (br_table $0 $1 $2 $3 $4 $5 $6 $7 $default + (get_local $i) + ) ) ;; 0 (return (get_local $i)) ) ;; 1 @@ -56,10 +57,9 @@ (block $2 (block $1 (block $0 - (br_table $0 $1 $2 $3 $4 $5 $6 $7 + (br_table $0 $1 $2 $3 $4 $5 $6 $7 $default (i32.wrap/i64 (get_local $i)) ) - (br $default) ) ;; 0 (return (get_local $i)) ) ;; 1 @@ -92,11 +92,14 @@ (block $1 (i32.add (i32.const 100) (block $0 - (br_table $0 $1 $2 - (i32.mul (i32.const 2) (get_local $i)) - (i32.and (i32.const 3) (get_local $i)) + (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)) + ) + ) ) - (i32.add (i32.const 1000) (get_local $i)) ) ) ) @@ -107,7 +110,9 @@ ;; Corner cases (func $corner (result i32) - (br_table (i32.const 0)) + (block + (br_table 0 (i32.const 0)) + ) (i32.const 1) ) @@ -138,11 +143,11 @@ (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 1113)) +(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 1117)) +(assert_return (invoke "arg" (i32.const 7)) (i32.const 1124)) (assert_return (invoke "arg" (i32.const 8)) (i32.const 126)) (assert_return (invoke "corner") (i32.const 1)) From ae6cfd16be3d4a3753fdd83623776c181705cf3c Mon Sep 17 00:00:00 2001 From: rossberg-chromium Date: Wed, 2 Mar 2016 19:25:30 +0100 Subject: [PATCH 3/3] Consistent camel casing for kernel --- ml-proto/spec/check.ml | 4 ++-- ml-proto/spec/desugar.ml | 12 ++++++------ ml-proto/spec/eval.ml | 4 ++-- ml-proto/spec/kernel.ml | 4 ++-- 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/ml-proto/spec/check.ml b/ml-proto/spec/check.ml index a0ac63b876..fe581dbb1d 100644 --- a/ml-proto/spec/check.ml +++ b/ml-proto/spec/check.ml @@ -133,12 +133,12 @@ let rec check_expr c et e = | Break (x, eo) -> check_expr_opt c (label c x) eo e.at - | Break_if (x, eo, e1) -> + | BreakIf (x, eo, e1) -> check_expr_opt c (label c x) eo e.at; check_expr c (Some Int32Type) e1; check_type None et e.at - | Break_table (xs, x, eo, e1) -> + | 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 diff --git a/ml-proto/spec/desugar.ml b/ml-proto/spec/desugar.ml index 1a67896f46..d48113f184 100644 --- a/ml-proto/spec/desugar.ml +++ b/ml-proto/spec/desugar.ml @@ -16,10 +16,10 @@ and shift' n = function | Block es -> Block (List.map (shift (n + 1)) es) | Loop e -> Loop (shift (n + 1) e) | Break (x, eo) -> Break (shift_var n x, Lib.Option.map (shift n) eo) - | Break_if (x, eo, e) -> - Break_if (shift_var n x, Lib.Option.map (shift n) eo, shift n e) - | Break_table (xs, x, eo, e) -> - Break_table + | BreakIf (x, eo, e) -> + BreakIf (shift_var n x, Lib.Option.map (shift n) eo, shift n e) + | BreakTable (xs, x, eo, e) -> + BreakTable (List.map (shift_var n) xs, shift_var n x, Lib.Option.map (shift n) eo, shift n e) | If (e1, e2, e3) -> If (shift n e1, shift n e2, shift n e3) @@ -59,9 +59,9 @@ and expr' at = function | Ast.Block es -> Block (List.map expr es) | Ast.Loop es -> Block [Loop (seq es) @@ at] | Ast.Br (x, eo) -> Break (x, Lib.Option.map expr eo) - | Ast.Br_if (x, eo, e) -> Break_if (x, Lib.Option.map expr eo, expr e) + | Ast.Br_if (x, eo, e) -> BreakIf (x, Lib.Option.map expr eo, expr e) | Ast.Br_table (xs, x, eo, e) -> - Break_table (xs, x, Lib.Option.map expr eo, expr e) + BreakTable (xs, x, Lib.Option.map expr eo, expr e) | Ast.Return (x, eo) -> Break (x, Lib.Option.map expr eo) | Ast.If (e1, e2) -> If (expr e1, expr e2, Nop @@ Source.after e2.at) | Ast.If_else (e1, e2, e3) -> If (expr e1, expr e2, expr e3) diff --git a/ml-proto/spec/eval.ml b/ml-proto/spec/eval.ml index 4975ec45d3..ec1227a159 100644 --- a/ml-proto/spec/eval.ml +++ b/ml-proto/spec/eval.ml @@ -154,12 +154,12 @@ let rec eval_expr (c : config) (e : expr) = | Break (x, eo) -> raise (label c x (eval_expr_opt c eo)) - | Break_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 - | Break_table (xs, x, eo, e) -> + | 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)) diff --git a/ml-proto/spec/kernel.ml b/ml-proto/spec/kernel.ml index c947af5d01..8c72f365c6 100644 --- a/ml-proto/spec/kernel.ml +++ b/ml-proto/spec/kernel.ml @@ -82,8 +82,8 @@ and expr' = | Block of expr list (* execute in sequence *) | Loop of expr (* loop header *) | Break of var * expr option (* break to n-th surrounding label *) - | Break_if of var * expr option * expr (* conditional break *) - | Break_table of var list * var * expr option * expr (* indexed 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 *) | Call of var * expr list (* call function *) | CallImport of var * expr list (* call imported function *)