diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index c0b6d5f15e..c79b54fe6f 100644 --- a/ml-proto/host/parser.mly +++ b/ml-proto/host/parser.mly @@ -309,22 +309,32 @@ type_use : | LPAR TYPE var RPAR { $3 } ; func : - | LPAR FUNC type_use func_fields RPAR + | LPAR FUNC export_opt type_use func_fields RPAR { let at = at () in - fun c -> anon_func c; let t = explicit_decl c $3 (fst $4) at in - fun () -> {((snd $4) (enter_func c)) with ftype = t} @@ at } - | LPAR FUNC bind_var type_use func_fields RPAR /* Sugar */ + fun c -> anon_func c; let t = explicit_decl c $4 (fst $5) at in + let exs = $3 c in + fun () -> {(snd $5 (enter_func c)) with ftype = t} @@ at, exs } + | LPAR FUNC export_opt bind_var type_use func_fields RPAR /* Sugar */ { let at = at () in - fun c -> bind_func c $3; let t = explicit_decl c $4 (fst $5) at in - fun () -> {((snd $5) (enter_func c)) with ftype = t} @@ at } - | LPAR FUNC func_fields RPAR /* Sugar */ + fun c -> bind_func c $4; let t = explicit_decl c $5 (fst $6) at in + let exs = $3 c in + fun () -> {(snd $6 (enter_func c)) with ftype = t} @@ at, exs } + | LPAR FUNC export_opt func_fields RPAR /* Sugar */ { let at = at () in - fun c -> anon_func c; let t = implicit_decl c (fst $3) at in - fun () -> {((snd $3) (enter_func c)) with ftype = t} @@ at } - | LPAR FUNC bind_var func_fields RPAR /* Sugar */ + fun c -> anon_func c; let t = implicit_decl c (fst $4) at in + let exs = $3 c in + fun () -> {(snd $4 (enter_func c)) with ftype = t} @@ at, exs } + | LPAR FUNC export_opt bind_var func_fields RPAR /* Sugar */ { let at = at () in - fun c -> bind_func c $3; let t = implicit_decl c (fst $4) at in - fun () -> {((snd $4) (enter_func c)) with ftype = t} @@ at } + fun c -> bind_func c $4; let t = implicit_decl c (fst $5) at in + let exs = $3 c in + fun () -> {(snd $5 (enter_func c)) with ftype = t} @@ at, exs } +; +export_opt : + | /* empty */ { fun c -> [] } + | TEXT + { let at = at () in + fun c -> [{name = $1; kind = `Func (c.funcs.count - 1 @@ at)} @@ at] } ; @@ -396,8 +406,8 @@ module_fields : {memory = None; types = c.types.tlist; funcs = []; start = None; imports = []; exports = []; table = []} } | func module_fields - { fun c -> let f = $1 c in let m = $2 c in - {m with funcs = f () :: m.funcs} } + { fun c -> let f = $1 c in let m = $2 c in let func, exs = f () in + {m with funcs = func :: m.funcs; exports = exs @ m.exports} } | import module_fields { fun c -> let i = $1 c in let m = $2 c in {m with imports = i :: m.imports} } diff --git a/ml-proto/test/block.wast b/ml-proto/test/block.wast index c8033b9621..4eca40aa43 100644 --- a/ml-proto/test/block.wast +++ b/ml-proto/test/block.wast @@ -1,35 +1,165 @@ +;; Test `block` opcode + (module - (func $empty + (func "empty" (block) (block $l) ) - (func $singular (result i32) + (func "singular" (result i32) + (block (nop)) (block (i32.const 7)) ) - (func $multi (result i32) - (block (i32.const 5) (i32.const 6) (i32.const 7) (i32.const 8)) + (func $nop) + (func "multi" (result i32) + (block (call $nop) (call $nop) (call $nop) (call $nop)) + (block (call $nop) (call $nop) (call $nop) (i32.const 8)) + ) + + (func "nested" (result i32) + (block (block (call $nop) (block) (nop)) (block (call $nop) (i32.const 9))) + ) + + (func "deep" (result i32) + (block (block (block (block (block (block (block (block (block (block + (block (block (block (block (block (block (block (block (block (block + (block (block (block (block (block (block (block (block (block (block + (block (block (block (block (block (block (block (block (block (block + (block (block (block (block (block (call $nop) (i32.const 150)))))) + )))))))))) + )))))))))) + )))))))))) + )))))))))) + ) + + (func "unary-operand" (result i32) + (i32.ctz (block (call $nop) (i32.const 13))) + ) + (func "binary-operand" (result i32) + (i32.mul (block (call $nop) (i32.const 3)) (block (call $nop) (i32.const 4))) + ) + (func "test-operand" (result i32) + (i32.eqz (block (call $nop) (i32.const 13))) + ) + (func "compare-operand" (result i32) + (f32.gt (block (call $nop) (f32.const 3)) (block (call $nop) (f32.const 3))) + ) + + (func "br-bare" (result i32) + (block (br 0) (unreachable)) + (i32.const 19) + ) + (func "br-value" (result i32) + (block (br 0 (i32.const 18)) (i32.const 19)) + ) + (func "br-repeated" (result i32) + (block + (br 0 (i32.const 18)) + (br 0 (i32.const 19)) + (br 0 (i32.const 20)) + (i32.const 21) + ) + ) + (func "br-inner" (result i32) + (block + (block (br 1 (i32.const 22))) + (block (br 0)) + (i32.const 21) + ) + ) + + (func "drop-inner" (result i32) + (block (call $fx) (i32.const 7) (call $nop) (i32.const 8)) + ) + (func "drop-last" + (block (call $nop) (call $fx) (nop) (i32.const 8)) + ) + (func "drop-br-void" + (block (br 0 (nop))) + (block (br 0 (call $nop))) + ) + (func "drop-br-value" + (block (br 0 (i32.const 8))) + ) + (func "drop-br-value-heterogeneous" + (block (br 0 (i32.const 8)) (br 0 (f64.const 8)) (br 0 (f32.const 8))) + (block (br 0 (i32.const 8)) (br 0) (br 0 (f64.const 8))) + (block (br 0 (i32.const 8)) (br 0 (call $nop)) (br 0 (f64.const 8))) + (block (br 0 (i32.const 8)) (br 0) (br 0 (f32.const 8)) (i64.const 3)) + (block (br 0) (br 0 (i32.const 8)) (br 0 (f64.const 8)) (br 0 (nop))) + (block (br 0) (br 0 (i32.const 8)) (br 0 (f32.const 8)) (i64.const 3)) + (block (block (br 0) (br 1 (i32.const 8))) (br 0 (f32.const 8)) (i64.const 3)) ) - (func $effects (result i32) + (func "effects" $fx (result i32) (local i32) (block (set_local 0 (i32.const 1)) (set_local 0 (i32.mul (get_local 0) (i32.const 3))) (set_local 0 (i32.sub (get_local 0) (i32.const 5))) (set_local 0 (i32.mul (get_local 0) (i32.const 7))) + (br 0) + (set_local 0 (i32.mul (get_local 0) (i32.const 100))) ) - (get_local 0) + (i32.eq (get_local 0) (i32.const -14)) ) - - (export "empty" $empty) - (export "singular" $singular) - (export "multi" $multi) - (export "effects" $effects) ) -(invoke "empty") +(assert_return (invoke "empty")) (assert_return (invoke "singular") (i32.const 7)) (assert_return (invoke "multi") (i32.const 8)) -(assert_return (invoke "effects") (i32.const -14)) +(assert_return (invoke "nested") (i32.const 9)) +(assert_return (invoke "deep") (i32.const 150)) + +(assert_return (invoke "unary-operand") (i32.const 0)) +(assert_return (invoke "binary-operand") (i32.const 12)) +(assert_return (invoke "test-operand") (i32.const 0)) +(assert_return (invoke "compare-operand") (i32.const 0)) + +(assert_return (invoke "br-bare") (i32.const 19)) +(assert_return (invoke "br-value") (i32.const 18)) +(assert_return (invoke "br-repeated") (i32.const 18)) +(assert_return (invoke "br-inner") (i32.const 22)) + +(assert_return (invoke "drop-inner") (i32.const 8)) +(assert_return (invoke "drop-last")) +(assert_return (invoke "drop-br-void")) +(assert_return (invoke "drop-br-value")) +(assert_return (invoke "drop-br-value-heterogeneous")) + +(assert_return (invoke "effects") (i32.const 1)) + +(assert_invalid + (module (func (result i32) (block))) + "type mismatch" +) +(assert_invalid + (module (func (result i32) (block (nop)))) + "type mismatch" +) +(assert_invalid + (module (func (result i32) (block (f32.const 0)))) + "type mismatch" +) +(assert_invalid + (module (func (result i32) (block (br 0) (i32.const 1)))) + "type mismatch" +) +(assert_invalid + (module (func (result i32) (block (br 0 (i32.const 1)) (nop)))) + "type mismatch" +) +(assert_invalid + (module (func (result i32) (block (br 0 (i64.const 1)) (i32.const 1)))) + "type mismatch" +) +(assert_invalid + (module (func (result i32) (block (br 0 (i64.const 1)) (br 0 (i32.const 1))))) + "type mismatch" +) +(assert_invalid + (module (func (result i32) (block (block (br 1 (i64.const 1))) (br 0 (i32.const 1))))) + "type mismatch" +) + diff --git a/ml-proto/test/block_comments.wast b/ml-proto/test/block_comments.wast deleted file mode 100644 index 0a077cd6d3..0000000000 --- a/ml-proto/test/block_comments.wast +++ /dev/null @@ -1,15 +0,0 @@ -(;;) -(;(((((((((( ;) -(;)))))))))));) -(; (module $error) ;) - (; (module $error) ;) -(; (module $error) -;) -(; -(module $error);) -(; a (; b ;) c ;) -(; ;; bla ;) -(; ;; bla -;) - -(module) ;; dummy diff --git a/ml-proto/test/comments.wast b/ml-proto/test/comments.wast new file mode 100644 index 0000000000..07a6298c4f --- /dev/null +++ b/ml-proto/test/comments.wast @@ -0,0 +1,69 @@ +;; Test comment syntax + +;;comment + +;;;;;;;;;;; + + ;;comment + +( ;;comment +module;;comment +);;comment + +;;) +;;;) +;; ;) +;; (; + +(;;) + +(;comment;) + +(;;comment;) + +(;;;comment;) + +(;;;;;;;;;;;;;;) + +(;(((((((((( ;) + +(;)))))))))));) + +(;comment";) + +(;comment"";) + +(;comment""";) + +(;Heiße Würstchen;) + +(;í ½í¸ší¸Ží ½í²©;) + +(;comment +comment;) + + (;comment;) + +(;comment;)((;comment;) +(;comment;)module(;comment;) +(;comment;))(;comment;) + +(;comment(;nested;)comment;) + +(;comment +(;nested +;)comment +;) + +(module + (;comment(;nested(;further;)nested;)comment;) +) + +(;comment;;comment;) + +(;comment;;comment +;) + +(module + (;comment;;comment(;nested;)comment;) +) \ No newline at end of file diff --git a/ml-proto/test/nop.wast b/ml-proto/test/nop.wast new file mode 100644 index 0000000000..9dc86fcd18 --- /dev/null +++ b/ml-proto/test/nop.wast @@ -0,0 +1,20 @@ +;; Test `nop` operator. + +(module + (func "eval" + (nop) + ) + + (func "drop" (result i32) + (nop) + (i32.const 1) + ) +) + +(assert_return (invoke "eval")) +(assert_return (invoke "drop") (i32.const 1)) + +(assert_invalid + (module (func (result i32) (nop))) + "type mismatch" +) diff --git a/ml-proto/test/unreachable.wast b/ml-proto/test/unreachable.wast index 8423ee8a3c..73247a5494 100644 --- a/ml-proto/test/unreachable.wast +++ b/ml-proto/test/unreachable.wast @@ -1,41 +1,254 @@ +;; Test `unreachable` operator + (module - (func $return_i32 (result i32) - (unreachable)) - (func $return_f64 (result f64) - (unreachable)) + (func "type-i32" (result i32) (unreachable)) + (func "type-i64" (result i32) (unreachable)) + (func "type-f32" (result f64) (unreachable)) + (func "type-f64" (result f64) (unreachable)) + + (func "block-first" (result i32) + (block (unreachable) (i32.const 2)) + ) + (func "block-mid" (result i32) + (block (i32.const 1) (unreachable) (i32.const 2)) + ) + (func "block-last" + (block (nop) (i32.const 1) (unreachable)) + ) + (func "block-value" (result i32) + (block (nop) (i32.const 1) (unreachable)) + ) + (func "block-broke" (result i32) + (block (br 0 (i32.const 1)) (unreachable)) + ) + + (func "loop-first" (result i32) + (loop (unreachable) (i32.const 2)) + ) + (func "loop-mid" (result i32) + (loop (i32.const 1) (unreachable) (i32.const 2)) + ) + (func "loop-last" + (loop (nop) (i32.const 1) (unreachable)) + ) + (func "loop-broke" (result i32) + (loop (br 1 (i32.const 1)) (unreachable)) + ) + + (func "br-value" (result i32) + (block (br 0 (unreachable))) + ) + (func "br_if-cond" + (block (br_if 0 (unreachable))) + ) + (func "br_if-value" (result i32) + (block (br_if 0 (unreachable) (i32.const 1)) (i32.const 7)) + ) + (func "br_if-value-cond" (result i32) + (block (br_if 0 (i32.const 6) (unreachable)) (i32.const 7)) + ) + (func "br_table-index" + (block (br_table 0 0 0 (unreachable))) + ) + (func "br_table-value" (result i32) + (block (br_table 0 0 0 (unreachable) (i32.const 1)) (i32.const 7)) + ) + (func "br_table-value-index" (result i32) + (block (br_table 0 0 (i32.const 6) (unreachable)) (i32.const 7)) + ) + + (func "return-value" (result i64) + (return (unreachable)) + ) + + (func "if-cond" (result i32) + (if (unreachable) (i32.const 0) (i32.const 1)) + ) + (func "if-then" (param i32 i32) (result i32) + (if (get_local 0) (unreachable) (get_local 1)) + ) + (func "if-else" (param i32 i32) (result i32) + (if (get_local 0) (get_local 1) (unreachable)) + ) + + (func "select-first" (param i32 i32) (result i32) + (select (unreachable) (get_local 0) (get_local 1)) + ) + (func "select-second" (param i32 i32) (result i32) + (select (get_local 0) (unreachable) (get_local 1)) + ) + (func "select-cond" (result i32) + (select (i32.const 0) (i32.const 1) (unreachable)) + ) + + (func $nop (param i32 i32 i32)) + (func "call-first" + (call $nop (unreachable) (i32.const 2) (i32.const 3)) + ) + (func "call-mid" + (call $nop (i32.const 1) (unreachable) (i32.const 3)) + ) + (func "call-last" + (call $nop (i32.const 1) (i32.const 2) (unreachable)) + ) + + (import "spectest" "print" (param i32 i32 i32)) + (func "call_import-first" + (call_import 0 (unreachable) (i32.const 2) (i32.const 3)) + ) + (func "call_import-mid" + (call_import 0 (i32.const 1) (unreachable) (i32.const 3)) + ) + (func "call_import-last" + (call_import 0 (i32.const 1) (i32.const 2) (unreachable)) + ) + + (type $sig (func (param i32 i32 i32))) + (table $nop) + (func "call_indirect-func" + (call_indirect $sig (unreachable) (i32.const 1) (i32.const 2) (i32.const 3)) + ) + (func "call_indirect-first" + (call_indirect $sig (i32.const 0) (unreachable) (i32.const 2) (i32.const 3)) + ) + (func "call_indirect-mid" + (call_indirect $sig (i32.const 0) (i32.const 1) (unreachable) (i32.const 3)) + ) + (func "call_indirect-last" + (call_indirect $sig (i32.const 0) (i32.const 1) (i32.const 2) (unreachable)) + ) - (func $if (param i32) (result f32) - (if (get_local 0) (unreachable) (f32.const 0))) + (func "set_local-value" (local f32) + (set_local 0 (unreachable)) + ) - (func $block - (block (i32.const 1) (unreachable) (i32.const 2))) + (memory 1) + (func "load-address" (result f32) + (f32.load (unreachable)) + ) + (func "loadN-address" (result i64) + (i64.load8_s (unreachable)) + ) - (func $return_i64 (result i64) - (return (i64.const 1)) - (unreachable)) + (func "store-address" + (f64.store (unreachable) (f64.const 7)) + ) + (func "store-value" + (i64.store (i32.const 2) (unreachable)) + ) - (func $call (result f64) - (call $return_i32) - (unreachable)) + (func "storeN-address" + (i32.store8 (unreachable) (i32.const 7)) + ) + (func "storeN-value" + (i64.store16 (i32.const 2) (unreachable)) + ) - (func $misc1 (result i32) - (i32.xor (unreachable) (i32.const 10)) + (func "unary-operand" (result f32) + (f32.neg (unreachable)) ) - (export "return_i32" $return_i32) - (export "return_f64" $return_f64) - (export "if" $if) - (export "block" $block) - (export "return_i64" $return_i64) - (export "call" $call) - (export "misc1" $misc1) + (func "binary-left" (result i32) + (i32.add (unreachable) (i32.const 10)) + ) + (func "binary-right" (result i64) + (i64.sub (i64.const 10) (unreachable)) + ) + + (func "test-operand" (result i32) + (i32.eqz (unreachable)) + ) + + (func "compare-left" (result i32) + (f64.le (unreachable) (f64.const 10)) + ) + (func "compare-right" (result i32) + (f32.ne (f32.const 10) (unreachable)) + ) + + (func "convert-operand" (result i32) + (i32.wrap/i64 (unreachable)) + ) + + (func "grow_memory-size" (result i32) + (grow_memory (unreachable)) + ) ) -(assert_trap (invoke "return_i32") "unreachable executed") -(assert_trap (invoke "return_f64") "unreachable executed") -(assert_trap (invoke "if" (i32.const 1)) "unreachable executed") -(assert_return (invoke "if" (i32.const 0)) (f32.const 0)) -(assert_trap (invoke "block") "unreachable executed") -(assert_return (invoke "return_i64") (i64.const 1)) -(assert_trap (invoke "call") "unreachable executed") -(assert_trap (invoke "misc1") "unreachable executed") +(assert_trap (invoke "type-i32") "unreachable") +(assert_trap (invoke "type-i64") "unreachable") +(assert_trap (invoke "type-f32") "unreachable") +(assert_trap (invoke "type-f64") "unreachable") + +(assert_trap (invoke "block-first") "unreachable") +(assert_trap (invoke "block-mid") "unreachable") +(assert_trap (invoke "block-last") "unreachable") +(assert_trap (invoke "block-value") "unreachable") +(assert_return (invoke "block-broke") (i32.const 1)) + +(assert_trap (invoke "loop-first") "unreachable") +(assert_trap (invoke "loop-mid") "unreachable") +(assert_trap (invoke "loop-last") "unreachable") +(assert_return (invoke "loop-broke") (i32.const 1)) + +(assert_trap (invoke "br-value") "unreachable") + +(assert_trap (invoke "br_if-cond") "unreachable") +(assert_trap (invoke "br_if-value") "unreachable") +(assert_trap (invoke "br_if-value-cond") "unreachable") + +(assert_trap (invoke "br_table-index") "unreachable") +(assert_trap (invoke "br_table-value") "unreachable") +(assert_trap (invoke "br_table-value-index") "unreachable") + +(assert_trap (invoke "if-cond") "unreachable") +(assert_trap (invoke "if-then" (i32.const 1) (i32.const 6)) "unreachable") +(assert_return (invoke "if-then" (i32.const 0) (i32.const 6)) (i32.const 6)) +(assert_trap (invoke "if-else" (i32.const 0) (i32.const 6)) "unreachable") +(assert_return (invoke "if-else" (i32.const 1) (i32.const 6)) (i32.const 6)) + +(assert_trap (invoke "select-first" (i32.const 0) (i32.const 6)) "unreachable") +(assert_trap (invoke "select-first" (i32.const 1) (i32.const 6)) "unreachable") +(assert_trap (invoke "select-second" (i32.const 0) (i32.const 6)) "unreachable") +(assert_trap (invoke "select-second" (i32.const 1) (i32.const 6)) "unreachable") +(assert_trap (invoke "select-cond") "unreachable") + +(assert_trap (invoke "return-value") "unreachable") + +(assert_trap (invoke "call-first") "unreachable") +(assert_trap (invoke "call-mid") "unreachable") +(assert_trap (invoke "call-last") "unreachable") + +(assert_trap (invoke "call_import-first") "unreachable") +(assert_trap (invoke "call_import-mid") "unreachable") +(assert_trap (invoke "call_import-last") "unreachable") + +(assert_trap (invoke "call_indirect-func") "unreachable") +(assert_trap (invoke "call_indirect-first") "unreachable") +(assert_trap (invoke "call_indirect-mid") "unreachable") +(assert_trap (invoke "call_indirect-last") "unreachable") + +(assert_trap (invoke "set_local-value") "unreachable") + +(assert_trap (invoke "load-address") "unreachable") +(assert_trap (invoke "loadN-address") "unreachable") + +(assert_trap (invoke "store-address") "unreachable") +(assert_trap (invoke "store-value") "unreachable") +(assert_trap (invoke "storeN-address") "unreachable") +(assert_trap (invoke "storeN-value") "unreachable") + +(assert_trap (invoke "unary-operand") "unreachable") + +(assert_trap (invoke "binary-left") "unreachable") +(assert_trap (invoke "binary-right") "unreachable") + +(assert_trap (invoke "test-operand") "unreachable") + +(assert_trap (invoke "compare-left") "unreachable") +(assert_trap (invoke "compare-right") "unreachable") + +(assert_trap (invoke "convert-operand") "unreachable") + +(assert_trap (invoke "grow_memory-size") "unreachable") +