Change parsing to unify indirect call signatures with the same structure

This is meant to implement the changes discussed in WebAssembly/design#452.

This eliminates the need to declare an explicit type reference for indirectly-called functions, so I also tried to eliminate the redundancy and potential mismatch between a function's type reference and its directly declared parameters and result, so I made any function declaration implicitly introduce a type matching its directly declared parameters and result. But this approach makes an explicitly indexed type table much less useful, since you no longer have complete control over its contents. To resolve that, I removed the declarations, and references to, type table entries. The type table is created implicitly from the set of unique types used by func and call_indirect.

I also made the syntax slightly more uniform by defining a func_type production in the form (func_type ...), and using it in both call_indirect and import. I did not change func to use it, but I will submit another PR if people like this change.

ml-proto/README.md

@@ -131,7 +131,7 @@ expr:
   ( tableswitch <var> <expr> <switch> <target> <case>* )  ;; = (label <var> (tableswitch <expr> <switch> <target> <case>*))
   ( call <var> <expr>* )
   ( call_import <var> <expr>* )
-  ( call_indirect <var> <expr> <expr>* )
+  ( call_indirect <func_type> <expr> <expr>* )
   ( get_local <var> )
   ( set_local <var> <expr> )
   ( <type>.load((8|16)_<sign>)? <offset>? <align>? <expr> )
@@ -154,15 +154,14 @@ target:
 case:
   ( case <var>? <expr>* )                        ;; = (case <var>? (block <expr>*))
 
-func:   ( func <name>? <type>? <param>* <result>? <local>* <expr>* )
-type:   ( type <var> )
+func:   ( func <name>? <param>* <result>? <local>* <expr>* )
 param:  ( param <type>* ) | ( param <name> <type> )
 result: ( result <type> )
 local:  ( local <type>* ) | ( local <name> <type> )
 
 module:  ( module <type>* <func>* <global>* <import>* <export>* <table>* <memory>? )
-type:    ( type <name>? ( func <param>* <result>? ) )
-import:  ( import <name>? "<module_name>" "<func_name>" (param <type>* ) (result <type>)* )
+func_type: ( func_type <param>* <result>? )
+import:  ( import <name>? "<module_name>" "<func_name>" <func_type> )
 export:  ( export "<char>*" <var> )
 global:  ( global <type>* ) | ( global <name> <type> )
 table:   ( table <var>* )

ml-proto/host/lexer.mll

@@ -243,8 +243,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 }

ml-proto/host/parser.mly

@@ -105,12 +105,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);
@@ -124,9 +118,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
@@ -137,19 +128,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
 
 %}
@@ -159,7 +140,7 @@ let implicit_decl c t at =
 %token CALL CALL_IMPORT CALL_INDIRECT RETURN
 %token GET_LOCAL SET_LOCAL LOAD STORE LOAD_EXTEND STORE_WRAP 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
@@ -197,7 +178,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
@@ -207,7 +188,9 @@ func_type :
   | LPAR RESULT VALUE_TYPE RPAR
     { {ins = []; out = Some $3} }
 ;
-
+func_type :
+  | LPAR FUNC_TYPE signature RPAR { $3 }
+;
 
 /* Expressions */
 
@@ -270,8 +253,9 @@ expr1 :
       Tableswitch (l, 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
@@ -345,25 +329,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 }
 ;
 
@@ -388,34 +361,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 }
 ;
 
@@ -441,8 +399,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

ml-proto/test/address.wast

@@ -1,6 +1,6 @@
 (module
     (memory 1024 (segment 0 "abcdefghijklmnopqrstuvwxyz"))
-    (import $print "stdio" "print" (param i32))
+    (import $print "stdio" "print" (func_type (param i32)))
 
     (func $good (param $i i32)
         (call_import $print (i32.load8_u offset=0 (get_local $i)))  ;; 97 'a'

ml-proto/test/func_ptrs.wast

@@ -1,56 +1,38 @@
 (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 "stdio" "print" (type 6))
-    (func $four (type $U) (call_import $print (get_local 0)))
+    (import $print "stdio" "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))
 (assert_return (invoke "two" (i32.const 13)) (i32.const 14))
 (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 "stdio" "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")

ml-proto/test/imports.wast

@@ -1,8 +1,8 @@
 (module 
-    (import $print_i32 "stdio" "print" (param i32))
-    (import $print_i64 "stdio" "print" (param i64))
-    (import $print_i32_f32 "stdio" "print" (param i32 f32))
-    (import $print_i64_f64 "stdio" "print" (param i64 f64))
+    (import $print_i32 "stdio" "print" (func_type (param i32)))
+    (import $print_i64 "stdio" "print" (func_type (param i64)))
+    (import $print_i32_f32 "stdio" "print" (func_type (param i32 f32)))
+    (import $print_i64_f64 "stdio" "print" (func_type (param i64 f64)))
     (func $print32 (param $i i32)
         (call_import $print_i32 (get_local $i))
         (call_import $print_i32_f32

ml-proto/test/store_retval.wast

@@ -1,10 +1,10 @@
 (module
     (memory 100)
 
-    (import $print_i32 "stdio" "print" (param i32))
-    (import $print_i64 "stdio" "print" (param i64))
-    (import $print_f32 "stdio" "print" (param f32))
-    (import $print_f64 "stdio" "print" (param f64))
+    (import $print_i32 "stdio" "print" (func_type (param i32)))
+    (import $print_i64 "stdio" "print" (func_type (param i64)))
+    (import $print_f32 "stdio" "print" (func_type (param f32)))
+    (import $print_f64 "stdio" "print" (func_type (param f64)))
 
     (func $run
         (local $i32 i32) (local $i64 i64) (local $f32 f32) (local $f64 f64)