diff --git a/ml-proto/README.md b/ml-proto/README.md index e942606086..1e91f598ca 100644 --- a/ml-proto/README.md +++ b/ml-proto/README.md @@ -113,7 +113,7 @@ expr: ( tableswitch ? ( table * ) * ) ( call * ) ( call_import * ) - ( call_indirect * ) + ( call_indirect * ) ( get_local ) ( set_local ) ( .load((8|16|32)_)? ? ? ) @@ -135,15 +135,14 @@ target: case: ( case ? * ) ;; = (case ? (block *)) -func: ( func ? ? * ? * * ) -type: ( type ) +func: ( func ? * ? * * ) param: ( param * ) | ( param ) result: ( result ) local: ( local * ) | ( local ) module: ( module * * * * * ? ) -type: ( type ? ( func * ? ) ) -import: ( import ? "" "" (param * ) (result )* ) +func_type: ( func_type * ? ) +import: ( import ? "" "" ) export: ( export "*" ) table: ( table * ) memory: ( memory ? * ) diff --git a/ml-proto/host/lexer.mll b/ml-proto/host/lexer.mll index ec83a6e25e..c7bdb1cda5 100644 --- a/ml-proto/host/lexer.mll +++ b/ml-proto/host/lexer.mll @@ -335,8 +335,8 @@ rule token = parse | "grow_memory" { GROW_MEMORY } | "has_feature" { HAS_FEATURE } - | "type" { TYPE } | "func" { FUNC } + | "func_type" { FUNC_TYPE } | "param" { PARAM } | "result" { RESULT } | "local" { LOCAL } diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index 9d92550205..cd65f6a45a 100644 --- a/ml-proto/host/parser.mly +++ b/ml-proto/host/parser.mly @@ -81,12 +81,6 @@ let label c x = try VarMap.find x.it c.labels with Not_found -> error x.at ("unknown label " ^ x.it) -let bind_type c x ty = - if VarMap.mem x.it c.types.tmap then - error x.at ("duplicate type " ^ x.it); - c.types.tmap <- VarMap.add x.it (List.length c.types.tlist) c.types.tmap; - c.types.tlist <- c.types.tlist @ [ty] - let bind category space x = if VarMap.mem x.it space.map then error x.at ("duplicate " ^ category ^ " " ^ x.it); @@ -100,9 +94,6 @@ 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)} -let anon_type c ty = - c.types.tlist <- c.types.tlist @ [ty] - let anon space n = space.count <- space.count + n let anon_func c = anon c.funcs 1 @@ -113,19 +104,9 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels} let empty_type = {ins = []; out = None} -let explicit_decl c name t at = - let x = name c type_ in - if - x.it < List.length c.types.tlist && - t <> empty_type && - t <> List.nth c.types.tlist x.it - then - error at "signature mismatch"; - x - -let implicit_decl c t at = +let lookup_type c t at = match Lib.List.index_of t c.types.tlist with - | None -> let i = List.length c.types.tlist in anon_type c t; i @@ at + | None -> let i = List.length c.types.tlist in c.types.tlist <- c.types.tlist @ [t]; i @@ at | Some i -> i @@ at %} @@ -135,7 +116,7 @@ let implicit_decl c t at = %token CALL CALL_IMPORT CALL_INDIRECT RETURN %token GET_LOCAL SET_LOCAL LOAD STORE OFFSET ALIGN %token CONST UNARY BINARY COMPARE CONVERT -%token FUNC TYPE PARAM RESULT LOCAL +%token FUNC FUNC_TYPE PARAM RESULT LOCAL %token MODULE MEMORY SEGMENT IMPORT EXPORT TABLE %token UNREACHABLE MEMORY_SIZE GROW_MEMORY HAS_FEATURE %token ASSERT_INVALID ASSERT_RETURN ASSERT_RETURN_NAN ASSERT_TRAP INVOKE @@ -172,7 +153,7 @@ value_type_list : | /* empty */ { [] } | VALUE_TYPE value_type_list { $1 :: $2 } ; -func_type : +signature : | /* empty */ { {ins = []; out = None} } | LPAR PARAM value_type_list RPAR @@ -182,7 +163,9 @@ func_type : | LPAR RESULT VALUE_TYPE RPAR { {ins = []; out = Some $3} } ; - +func_type : + | LPAR FUNC_TYPE signature RPAR { $3 } +; /* Expressions */ @@ -245,8 +228,9 @@ expr1 : 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 - { fun c -> Call_indirect ($2 c type_, $3 c, $4 c) } + | CALL_INDIRECT func_type expr expr_list + { let at = at () in + fun c -> Call_indirect (lookup_type c $2 at, $3 c, $4 c) } | GET_LOCAL var { fun c -> Get_local ($2 c local) } | SET_LOCAL var expr { fun c -> Set_local ($2 c local, $3 c) } | LOAD offset align expr { fun c -> $1 ($2, $3, $4 c) } @@ -313,25 +297,14 @@ func_fields : fun c -> bind_local c $3; let f = (snd $6) c in {f with locals = $4 :: f.locals} } ; -type_use : - | LPAR TYPE var RPAR { $3 } -; func : - | LPAR FUNC 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 */ - { 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 */ { let at = at () in - fun c -> anon_func c; let t = implicit_decl c (fst $3) at in + fun c -> anon_func c; let t = lookup_type c (fst $3) at in fun () -> {((snd $3) (enter_func c)) with ftype = t} @@ at } | LPAR FUNC 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 c -> bind_func c $3; let t = lookup_type c (fst $4) at in fun () -> {((snd $4) (enter_func c)) with ftype = t} @@ at } ; @@ -356,34 +329,19 @@ memory : @@ at () } ; -type_def : - | LPAR TYPE LPAR FUNC func_type RPAR RPAR - { fun c -> anon_type c $5 } - | LPAR TYPE bind_var LPAR FUNC func_type RPAR RPAR - { fun c -> bind_type c $3 $6 } -; - table : | LPAR TABLE var_list RPAR { fun c -> $3 c func } ; import : - | LPAR IMPORT TEXT TEXT type_use RPAR - { let at = at () in - fun c -> anon_import c; let itype = explicit_decl c $5 empty_type at in - {itype; module_name = $3; func_name = $4} @@ at } - | LPAR IMPORT bind_var TEXT TEXT type_use RPAR /* Sugar */ - { let at = at () in - fun c -> bind_import c $3; let itype = explicit_decl c $6 empty_type at in - {itype; module_name = $4; func_name = $5} @@ at } | LPAR IMPORT TEXT TEXT func_type RPAR /* Sugar */ { let at = at () in - fun c -> anon_import c; let itype = implicit_decl c $5 at in + fun c -> anon_import c; let itype = lookup_type c $5 at in {itype; module_name = $3; func_name = $4} @@ at } | LPAR IMPORT bind_var TEXT TEXT func_type RPAR /* Sugar */ { let at = at () in - fun c -> bind_import c $3; let itype = implicit_decl c $6 at in + fun c -> bind_import c $3; let itype = lookup_type c $6 at in {itype; module_name = $4; func_name = $5} @@ at } ; @@ -409,8 +367,6 @@ module_fields : | table module_fields { fun c -> let m = $2 c in {m with table = ($1 c) @ m.table} } - | type_def module_fields - { fun c -> $1 c; $2 c } | memory module_fields { fun c -> let m = $2 c in match m.memory with diff --git a/ml-proto/test/address.wast b/ml-proto/test/address.wast index 984ad85ca1..c0607ab1cc 100644 --- a/ml-proto/test/address.wast +++ b/ml-proto/test/address.wast @@ -1,6 +1,6 @@ (module (memory 1024 (segment 0 "abcdefghijklmnopqrstuvwxyz")) - (import $print "spectest" "print" (param i32)) + (import $print "spectest" "print" (func_type (param i32))) (func $good (param $i i32) (call_import $print (i32.load8_u offset=0 (get_local $i))) ;; 97 'a' diff --git a/ml-proto/test/func_ptrs.wast b/ml-proto/test/func_ptrs.wast index 25d6a817dc..b86bf35be8 100644 --- a/ml-proto/test/func_ptrs.wast +++ b/ml-proto/test/func_ptrs.wast @@ -1,28 +1,15 @@ (module - (type (func)) ;; 0: void -> void - (type $S (func)) ;; 1: void -> void - (type (func (param))) ;; 2: void -> void - (type (func (result i32))) ;; 3: void -> i32 - (type (func (param) (result i32))) ;; 4: void -> i32 - (type $T (func (param i32) (result i32))) ;; 5: i32 -> i32 - (type $U (func (param i32))) ;; 6: i32 -> void - - (func (type 0)) - (func (type $S)) - - (func $one (type 4) (i32.const 13)) + (func $one (result i32) (i32.const 13)) (export "one" $one) - (func $two (type $T) (i32.add (get_local 0) (i32.const 1))) + (func $two (param i32) (result i32) (i32.add (get_local 0) (i32.const 1))) (export "two" $two) - ;; Both signature and parameters are allowed (and required to match) - ;; since this allows the naming of parameters. - (func $three (type $T) (param $a i32) (result i32) (i32.sub (get_local 0) (i32.const 2))) + (func $three (param $a i32) (result i32) (i32.sub (get_local 0) (i32.const 2))) (export "three" $three) - (import $print "spectest" "print" (type 6)) - (func $four (type $U) (call_import $print (get_local 0))) + (import $print "spectest" "print" (func_type (param i32))) + (func $four (param i32) (call_import $print (get_local 0))) (export "four" $four) ) (assert_return (invoke "one") (i32.const 13)) @@ -30,27 +17,22 @@ (assert_return (invoke "three" (i32.const 13)) (i32.const 11)) (invoke "four" (i32.const 83)) -(assert_invalid (module (func (type 42))) "unknown function type 42") -(assert_invalid (module (import "spectest" "print" (type 43))) "unknown function type 43") - (module - (type $T (func (param) (result i32))) - (type $U (func (param) (result i32))) (table $t1 $t2 $t3 $u1 $u2 $t1 $t3) - (func $t1 (type $T) (i32.const 1)) - (func $t2 (type $T) (i32.const 2)) - (func $t3 (type $T) (i32.const 3)) - (func $u1 (type $U) (i32.const 4)) - (func $u2 (type $U) (i32.const 5)) + (func $t1 (result i32) (i32.const 1)) + (func $t2 (result i32) (i32.const 2)) + (func $t3 (result i32) (i32.const 3)) + (func $u1 (result i64) (i64.const 4)) + (func $u2 (result i64) (i64.const 5)) (func $callt (param $i i32) (result i32) - (call_indirect $T (get_local $i)) + (call_indirect (func_type (param) (result i32)) (get_local $i)) ) (export "callt" $callt) - (func $callu (param $i i32) (result i32) - (call_indirect $U (get_local $i)) + (func $callu (param $i i32) (result i64) + (call_indirect (func_type (param) (result i64)) (get_local $i)) ) (export "callu" $callu) ) @@ -69,8 +51,8 @@ (assert_trap (invoke "callu" (i32.const 0)) "indirect call signature mismatch") (assert_trap (invoke "callu" (i32.const 1)) "indirect call signature mismatch") (assert_trap (invoke "callu" (i32.const 2)) "indirect call signature mismatch") -(assert_return (invoke "callu" (i32.const 3)) (i32.const 4)) -(assert_return (invoke "callu" (i32.const 4)) (i32.const 5)) +(assert_return (invoke "callu" (i32.const 3)) (i64.const 4)) +(assert_return (invoke "callu" (i32.const 4)) (i64.const 5)) (assert_trap (invoke "callu" (i32.const 5)) "indirect call signature mismatch") (assert_trap (invoke "callu" (i32.const 6)) "indirect call signature mismatch") (assert_trap (invoke "callu" (i32.const 7)) "undefined table index 7") diff --git a/ml-proto/test/imports.wast b/ml-proto/test/imports.wast index bfbad05137..b7e495d5f6 100644 --- a/ml-proto/test/imports.wast +++ b/ml-proto/test/imports.wast @@ -1,8 +1,8 @@ (module - (import $print_i32 "spectest" "print" (param i32)) - (import $print_i64 "spectest" "print" (param i64)) - (import $print_i32_f32 "spectest" "print" (param i32 f32)) - (import $print_i64_f64 "spectest" "print" (param i64 f64)) + (import $print_i32 "spectest" "print" (func_type (param i32))) + (import $print_i64 "spectest" "print" (func_type (param i64))) + (import $print_i32_f32 "spectest" "print" (func_type (param i32 f32))) + (import $print_i64_f64 "spectest" "print" (func_type (param i64 f64))) (func $print32 (param $i i32) (call_import $print_i32 (get_local $i)) (call_import $print_i32_f32 diff --git a/ml-proto/test/store_retval.wast b/ml-proto/test/store_retval.wast index 2dc32efb4e..b1ea88b822 100644 --- a/ml-proto/test/store_retval.wast +++ b/ml-proto/test/store_retval.wast @@ -1,10 +1,10 @@ (module (memory 100) - (import $print_i32 "spectest" "print" (param i32)) - (import $print_i64 "spectest" "print" (param i64)) - (import $print_f32 "spectest" "print" (param f32)) - (import $print_f64 "spectest" "print" (param f64)) + (import $print_i32 "spectest" "print" (func_type (param i32))) + (import $print_i64 "spectest" "print" (func_type (param i64))) + (import $print_f32 "spectest" "print" (func_type (param f32))) + (import $print_f64 "spectest" "print" (func_type (param f64))) (func $run (local $i32 i32) (local $i64 i64) (local $f32 f32) (local $f64 f64)