diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index 5bbda9c55d..feb34a5ccb 100644 --- a/ml-proto/host/parser.mly +++ b/ml-proto/host/parser.mly @@ -251,7 +251,7 @@ expr1 : { fun c -> let c', l = $2 c in Block (l, $3 c' :: $4 c') } | IF_ELSE expr expr expr { fun c -> If_else ($2 c, $3 c, $4 c) } | IF expr expr { fun c -> If ($2 c, $3 c) } - | BR_IF expr var { fun c -> Br_if ($2 c, $3 c label) } + | BR_IF expr var expr_opt { fun c -> Br_if ($2 c, $3 c label, $4 c) } | LOOP labeling labeling expr_list { fun c -> let c', l1 = $2 c in let c'', l2 = $3 c' in let c''' = if l1.it = Unlabelled then anon_label c'' else c'' in diff --git a/ml-proto/spec/ast.ml b/ml-proto/spec/ast.ml index 36f5ac63d1..c18244b69a 100644 --- a/ml-proto/spec/ast.ml +++ b/ml-proto/spec/ast.ml @@ -14,7 +14,7 @@ and expr' = | Block of labeling * expr list | If of expr * expr | If_else of expr * expr * expr - | Br_if of expr * var + | Br_if of expr * var * expr option | Loop of labeling * labeling * expr list | Label of expr | Br of var * expr option diff --git a/ml-proto/spec/check.ml b/ml-proto/spec/check.ml index e9de483ef0..cbca8d94ea 100644 --- a/ml-proto/spec/check.ml +++ b/ml-proto/spec/check.ml @@ -228,9 +228,10 @@ and check_exprs c ts es = with Invalid_argument _ -> error (Source.ats es) "arity mismatch" and check_expr_opt c et eo at = - match eo with - | Some e -> check_expr c et e - | None -> check_type None et 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 diff --git a/ml-proto/spec/desugar.ml b/ml-proto/spec/desugar.ml index 35789d4803..554b31ba1c 100644 --- a/ml-proto/spec/desugar.ml +++ b/ml-proto/spec/desugar.ml @@ -18,7 +18,8 @@ and expr' = function | A.Block (l, es) -> labeling l (K.Block (List.map expr es)) | A.If (e1, e2) -> K.If (expr e1, expr e2, K.Nop @@ Source.after e2.at) | A.If_else (e1, e2, e3) -> K.If (expr e1, expr e2, expr e3) - | A.Br_if (e, x) -> expr' (A.If (e, A.Br (x, None) @@ x.at)) + | A.Br_if (e, x, eo) -> + K.If (expr e, K.Break (x, Lib.Option.map expr eo) @@ x.at, opt eo) | A.Loop (l1, l2, es) when l2.it = A.Unlabelled -> K.Loop (seq es) | A.Loop (l1, l2, es) -> labeling l1 (K.Loop (seq es)) | A.Label e -> K.Label (expr e) @@ -60,6 +61,10 @@ and seq = function | [e] -> expr e | es -> K.Block (List.map expr es) @@@ List.map Source.at es +and opt = function + | None -> K.Nop @@ Source.no_region + | Some e -> K.Block [expr e; K.Nop @@ e.at] @@ e.at + (* Functions and Modules *) diff --git a/ml-proto/test/labels.wast b/ml-proto/test/labels.wast index bdfde276a7..0041323f66 100644 --- a/ml-proto/test/labels.wast +++ b/ml-proto/test/labels.wast @@ -24,7 +24,7 @@ (loop $exit $cont (set_local $i (i32.add (get_local $i) (i32.const 1))) (if (i32.eq (get_local $i) (i32.const 5)) - (br $cont (i32.const -1)) + (br $cont) ) (if (i32.eq (get_local $i) (i32.const 8)) (br $exit (get_local $i)) @@ -34,6 +34,19 @@ ) ) + (func $loop3 (param $max i32) (result i32) + (local $i i32) + (set_local $i (i32.const 1)) + (loop $exit $cont + (set_local $i (i32.add (get_local $i) (get_local $i))) + (if (i32.gt_u (get_local $i) (get_local $max)) + (br $exit (get_local $i)) + ) + (br $cont) + ) + ) + + (func $switch (param i32) (result i32) (label $ret (i32.mul (i32.const 10) @@ -58,16 +71,36 @@ ) ) + (func $br_if (result i32) + (local $i i32) + (set_local $i (i32.const 0)) + (block $outer + (block $inner + (br_if (i32.const 0) $inner) + (set_local $i (i32.or (get_local $i) (i32.const 0x1))) + (br_if (i32.const 1) $inner) + (set_local $i (i32.or (get_local $i) (i32.const 0x2))) + ) + (br_if (i32.const 0) $outer (set_local $i (i32.or (get_local $i) (i32.const 0x4)))) + (set_local $i (i32.or (get_local $i) (i32.const 0x8))) + (br_if (i32.const 1) $outer (set_local $i (i32.or (get_local $i) (i32.const 0x10)))) + (set_local $i (i32.or (get_local $i) (i32.const 0x20))) + ) + ) + (export "block" $block) (export "loop1" $loop1) (export "loop2" $loop2) + (export "loop3" $loop3) (export "switch" $switch) (export "return" $return) + (export "br_if" $br_if) ) (assert_return (invoke "block") (i32.const 1)) (assert_return (invoke "loop1") (i32.const 5)) (assert_return (invoke "loop2") (i32.const 8)) +(assert_return (invoke "loop3" (i32.const 8)) (i32.const 16)) (assert_return (invoke "switch" (i32.const 0)) (i32.const 50)) (assert_return (invoke "switch" (i32.const 1)) (i32.const 20)) (assert_return (invoke "switch" (i32.const 2)) (i32.const 20)) @@ -77,4 +110,9 @@ (assert_return (invoke "return" (i32.const 0)) (i32.const 0)) (assert_return (invoke "return" (i32.const 1)) (i32.const 2)) (assert_return (invoke "return" (i32.const 2)) (i32.const 2)) +(assert_return (invoke "br_if") (i32.const 0x1d)) + +(assert_invalid (module (func (loop $l (br $l (i32.const 0))))) "arity mismatch") +(assert_invalid (module (func (block $l (f32.neg (br_if (i32.const 1) $l)) (nop)))) "type mismatch") +(assert_invalid (module (func (result f32) (block $l (br_if (i32.const 1) $l (f32.const 0))))) "type mismatch") diff --git a/ml-proto/test/switch.wast b/ml-proto/test/switch.wast index d357ca3d83..a731731b79 100644 --- a/ml-proto/test/switch.wast +++ b/ml-proto/test/switch.wast @@ -12,7 +12,7 @@ (case $2) ;; fallthrough (case $3 (set_local $j (i32.sub (i32.const 0) (get_local $i))) (br 0)) (case $4 (br 0)) - (case $5 (br 0 (set_local $j (i32.const 101)))) + (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)