Skip to content

Commit 25ea12c

Browse files
authored
Implement block signatures (#336)
Implements WebAssembly/design#765; specifically: - Adds block signatures (syntax: (block i32 ...) etc) - Removes arities from branches - Also simplifies if syntax: the label is on if now instead of the children, in order to be consistent -with the signature - Adjusts typing - Adapts all tests (phew...)
1 parent da6101f commit 25ea12c

37 files changed

+799
-850
lines changed

ml-proto/README.md

Lines changed: 15 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -140,22 +140,28 @@ offset: offset=<nat>
140140
align: align=(1|2|4|8|...)
141141
cvtop: trunc_s | trunc_u | extend_s | extend_u | ...
142142
143+
block_sig : <type>*
144+
func_sig: ( type <var> ) | <param>* <result>*
145+
global_sig: <type> | ( mut <type> )
146+
table_sig: <nat> <nat>? <elem_type>
147+
memory_sig: <nat> <nat>?
148+
143149
expr:
144150
( <op> )
145151
( <op> <expr>+ ) ;; = <expr>+ (<op>)
146-
( block <name>? <instr>* )
147-
( loop <name>? <instr>* )
148-
( if ( then <name>? <instr>* ) ( else <name>? <instr>* )? )
149-
( if <expr> ( then <name>? <instr>* ) ( else <name>? <instr>* )? ) ;; = (if <expr> (then <name>? <instr>*) (else <name>? <instr>*)?)
150-
( if <expr> <expr> <expr>? ) ;; = (if <expr> (then <expr>) (else <expr>?))
152+
( block <name>? <block_sig>? <instr>* )
153+
( loop <name>? <block_sig>? <instr>* )
154+
( if <name>? <block_sig>? ( then <instr>* ) ( else <instr>* )? )
155+
( if <name>? <block_sig>? <expr> ( then <instr>* ) ( else <instr>* )? ) ;; = (if <name>? <block_sig>? <expr> (then <instr>*) (else <instr>*)?)
156+
( if <name>? <block_sig>? <expr> <expr> <expr>? ) ;; = (if <name>? <block_sig>? <expr> (then <expr>) (else <expr>?))
151157
152158
instr:
153159
<expr>
154160
<op> ;; = (<op>)
155-
block <name>? <instr>* end ;; = (block <name>? <instr>*)
156-
loop <name>? <instr>* end ;; = (loop <name>? <instr>*)
157-
if <name>? <instr>* end ;; = (if (then <name>? <instr>*))
158-
if <name>? <instr>* else <name>? <instr>* end ;; = (if (then <name>? instr>*) (else <name>? <instr>*))
161+
block <name>? <block_sig>? <instr>* end ;; = (block <name>? <block_sig>? <instr>*)
162+
loop <name>? <block_sig>? <instr>* end ;; = (loop <name>? <block_sig>? <instr>*)
163+
if <name>? <block_sig>? <instr>* end ;; = (if <name>? <block_sig>? (then <instr>*))
164+
if <name>? <block_sig>? <instr>* else <instr>* end ;; = (if <name>? <block_sig>? (then <instr>*) (else <instr>*))
159165
160166
op:
161167
unreachable
@@ -189,11 +195,6 @@ param: ( param <type>* ) | ( param <name> <type> )
189195
result: ( result <type> )
190196
local: ( local <type>* ) | ( local <name> <type> )
191197
192-
func_sig: ( type <var> ) | <param>* <result>?
193-
global_sig: <type> | ( mut <type> )
194-
table_sig: <nat> <nat>? <elem_type>
195-
memory_sig: <nat> <nat>?
196-
197198
global: ( global <name>? <global_sig> )
198199
( global <name>? ( export <string> ) <global_sig> ) ;; = (export <string> (global <N>)) (global <name>? <global_sig>)
199200
( global <name>? ( import <string> <string> ) <global_sig> ) ;; = (import <name>? <string> <string> (global <global_sig>))

ml-proto/host/arrange.ml

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,8 @@ let elem_type t = string_of_elem_type t
5353

5454
let decls kind ts = tab kind (atom value_type) ts
5555

56+
let stack_type ts = list (atom value_type) ts
57+
5658
let func_type (FuncType (ins, out)) =
5759
Node ("func", decls "param" ins @ decls "result" out)
5860

@@ -214,15 +216,16 @@ let rec instr e =
214216
| Unreachable -> "unreachable", []
215217
| Nop -> "nop", []
216218
| Drop -> "drop", []
217-
| Block es -> "block", list instr es
218-
| Loop es -> "loop", list instr es
219-
| Br (n, x) -> "br " ^ int n ^ " " ^ var x, []
220-
| BrIf (n, x) -> "br_if " ^ int n ^ " " ^ var x, []
221-
| BrTable (n, xs, x) ->
222-
"br_table " ^ int n ^ " " ^ String.concat " " (list var (xs @ [x])), []
219+
| Block (ts, es) -> "block", stack_type ts @ list instr es
220+
| Loop (ts, es) -> "loop", stack_type ts @ list instr es
221+
| Br x -> "br " ^ var x, []
222+
| BrIf x -> "br_if " ^ var x, []
223+
| BrTable (xs, x) ->
224+
"br_table " ^ String.concat " " (list var (xs @ [x])), []
223225
| Return -> "return", []
224-
| If (es1, es2) ->
225-
"if", [Node ("then", list instr es1); Node ("else", list instr es2)]
226+
| If (ts, es1, es2) ->
227+
"if", stack_type ts @
228+
[Node ("then", list instr es1); Node ("else", list instr es2)]
226229
| Select -> "select", []
227230
| Call x -> "call " ^ var x, []
228231
| CallIndirect x -> "call_indirect " ^ var x, []

ml-proto/host/encode.ml

Lines changed: 29 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,12 @@
33
let version = 0x0cl
44

55

6+
(* Errors *)
7+
8+
module Code = Error.Make ()
9+
exception Code = Code.Error
10+
11+
612
(* Encoding stream *)
713

814
type stream =
@@ -52,15 +58,20 @@ let encode m =
5258

5359
let vu32 i = vu64 (Int64.of_int32 i)
5460
let vs32 i = vs64 (Int64.of_int32 i)
55-
let vu i = vu64 (Int64.of_int i)
5661
let f32 x = u32 (F32.to_bits x)
5762
let f64 x = u64 (F64.to_bits x)
5863

64+
let len i =
65+
if Int32.to_int (Int32.of_int i) <> i then
66+
Code.error Source.no_region
67+
"cannot encode length with more than 32 bit";
68+
vu32 (Int32.of_int i)
69+
5970
let bool b = u8 (if b then 1 else 0)
60-
let string bs = vu (String.length bs); put_string s bs
71+
let string bs = len (String.length bs); put_string s bs
6172
let list f xs = List.iter f xs
6273
let opt f xo = Lib.Option.app f xo
63-
let vec f xs = vu (List.length xs); list f xs
74+
let vec f xs = len (List.length xs); list f xs
6475
let vec1 f xo = bool (xo <> None); opt f xo
6576

6677
let gap32 () = let p = pos s in u32 0l; u8 0; p
@@ -86,6 +97,13 @@ let encode m =
8697
let elem_type = function
8798
| AnyFuncType -> u8 0x20
8899

100+
let stack_type = function
101+
| [] -> u8 0x00
102+
| [t] -> value_type t
103+
| _ ->
104+
Code.error Source.no_region
105+
"cannot encode stack type with arity > 1 (yet)"
106+
89107
let func_type = function
90108
| FuncType (ins, out) -> u8 0x40; vec value_type ins; vec value_type out
91109

@@ -105,32 +123,13 @@ let encode m =
105123
let global_type = function
106124
| GlobalType (t, mut) -> value_type t; mutability mut
107125

108-
let limits vu {min; max} =
109-
bool (max <> None); vu min; opt vu max
110-
111-
let table_type = function
112-
| TableType (lim, t) -> elem_type t; limits vu32 lim
113-
114-
let memory_type = function
115-
| MemoryType lim -> limits vu32 lim
116-
117-
let mutability = function
118-
| Immutable -> u8 0
119-
| Mutable -> u8 1
120-
121-
let global_type = function
122-
| GlobalType (t, mut) -> value_type t; mutability mut
123-
124126
(* Expressions *)
125127

126128
open Source
127129
open Ast
128130
open Values
129131
open Memory
130132

131-
let arity xs = vu (List.length xs)
132-
let arity1 xo = bool (xo <> None)
133-
134133
let op n = u8 n
135134
let memop {align; offset; _} =
136135
vu32 (I32.ctz (Int32.of_int align));
@@ -141,16 +140,16 @@ let encode m =
141140
let rec instr e =
142141
match e.it with
143142
| Unreachable -> op 0x00
144-
| Block es -> op 0x01; list instr es; op 0x0f
145-
| Loop es -> op 0x02; list instr es; op 0x0f
146-
| If (es1, es2) ->
147-
op 0x03; list instr es1;
143+
| Block (ts, es) -> op 0x01; stack_type ts; list instr es; op 0x0f
144+
| Loop (ts, es) -> op 0x02; stack_type ts; list instr es; op 0x0f
145+
| If (ts, es1, es2) ->
146+
op 0x03; stack_type ts; list instr es1;
148147
if es2 <> [] then op 0x04;
149148
list instr es2; op 0x0f
150149
| Select -> op 0x05
151-
| Br (n, x) -> op 0x06; vu n; var x
152-
| BrIf (n, x) -> op 0x07; vu n; var x
153-
| BrTable (n, xs, x) -> op 0x08; vu n; vec var xs; var x
150+
| Br x -> op 0x06; var x
151+
| BrIf x -> op 0x07; var x
152+
| BrTable (xs, x) -> op 0x08; vec var xs; var x
154153
| Return -> op 0x09
155154
| Nop -> op 0x0a
156155
| Drop -> op 0x0b
@@ -449,7 +448,7 @@ let encode m =
449448
| ts -> (t, 1) :: ts
450449
in List.fold_right combine ts []
451450

452-
let local (t, n) = vu n; value_type t
451+
let local (t, n) = len n; value_type t
453452

454453
let code f =
455454
let {locals; body; _} = f.it in

ml-proto/host/encode.mli

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
exception Code of Source.region * string
2+
13
val version : int32
24
val encode : Ast.module_ -> string
35

ml-proto/host/js.ml

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -126,7 +126,7 @@ let assert_return lits ts at =
126126
[ Const lit @@ at;
127127
Compare (eq_of (Values.type_of lit.it)) @@ at;
128128
Test (Values.I32 I32Op.Eqz) @@ at;
129-
BrIf (0, 0l @@ at) @@ at ]
129+
BrIf (0l @@ at) @@ at ]
130130
in [], List.flatten (List.rev_map test lits)
131131

132132
let assert_return_nan ts at =
@@ -136,7 +136,7 @@ let assert_return_nan ts at =
136136
[ GetLocal (var i) @@ at;
137137
GetLocal (var i) @@ at;
138138
Compare (eq_of t) @@ at;
139-
BrIf (0, 0l @@ at) @@ at ]
139+
BrIf (0l @@ at) @@ at ]
140140
in ts, List.flatten (List.mapi init ts @ List.mapi test ts)
141141

142142
let wrap module_name item_name wrap_action wrap_assertion at =
@@ -148,7 +148,9 @@ let wrap module_name item_name wrap_action wrap_assertion at =
148148
let ekind = FuncExport @@ at in
149149
let exports = [{name = "run"; ekind; item} @@ at] in
150150
let body =
151-
[Block (action @ assertion @ [Return @@ at]) @@ at; Unreachable @@ at] in
151+
[ Block ([], action @ assertion @ [Return @@ at]) @@ at;
152+
Unreachable @@ at ]
153+
in
152154
let funcs = [{ftype = 0l @@ at; locals; body} @@ at] in
153155
let m = {empty_module with types; funcs; imports; exports} @@ at in
154156
Encode.encode m

ml-proto/host/parser.mly

Lines changed: 39 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -254,10 +254,6 @@ type_use :
254254

255255
/* Expressions */
256256

257-
nat :
258-
| NAT { int_of_string $1 }
259-
;
260-
261257
literal :
262258
| NAT { $1 @@ at () }
263259
| INT { $1 @@ at () }
@@ -297,21 +293,19 @@ align_opt :
297293
298294
instr :
299295
| plain_instr { let at = at () in fun c -> [$1 c @@ at] }
300-
| ctrl_instr { let at = at () in fun c -> [$1 c @@ at] }
296+
| block_instr { let at = at () in fun c -> [$1 c @@ at] }
301297
| expr { $1 } /* Sugar */
302298
;
303299
plain_instr :
304300
| UNREACHABLE { fun c -> unreachable }
305301
| NOP { fun c -> nop }
306302
| DROP { fun c -> drop }
307303
| SELECT { fun c -> select }
308-
| BR nat var { fun c -> br $2 ($3 c label) }
309-
| BR_IF nat var { fun c -> br_if $2 ($3 c label) }
310-
| BR_TABLE var /*nat*/ var var_list
311-
{ fun c -> let xs, x = Lib.List.split_last ($3 c label :: $4 c label) in
312-
(* TODO: remove hack once arities are gone *)
313-
let n = $2 c (fun _ -> error x.at "syntax error") in
314-
br_table (Int32.to_int n.it) xs x }
304+
| BR var { fun c -> br ($2 c label) }
305+
| BR_IF var { fun c -> br_if ($2 c label) }
306+
| BR_TABLE var var_list
307+
{ fun c -> let xs, x = Lib.List.split_last ($2 c label :: $3 c label) in
308+
br_table xs x }
315309
| RETURN { fun c -> return }
316310
| CALL var { fun c -> call ($2 c func) }
317311
| CALL_INDIRECT var { fun c -> call_indirect ($2 c type_) }
@@ -331,15 +325,18 @@ plain_instr :
331325
| CURRENT_MEMORY { fun c -> current_memory }
332326
| GROW_MEMORY { fun c -> grow_memory }
333327
;
334-
ctrl_instr :
335-
| BLOCK labeling_opt instr_list END
336-
{ fun c -> let c' = $2 c in block ($3 c') }
337-
| LOOP labeling_opt instr_list END
338-
{ fun c -> let c' = $2 c in loop ($3 c') }
339-
| IF labeling_opt instr_list END
340-
{ fun c -> let c' = $2 c in if_ ($3 c') [] }
341-
| IF labeling_opt instr_list ELSE labeling_opt instr_list END
342-
{ fun c -> let c1 = $2 c in let c2 = $5 c in if_ ($3 c1) ($6 c2) }
328+
block_instr :
329+
| BLOCK labeling_opt block END
330+
{ fun c -> let c' = $2 c in let ts, es = $3 c' in block ts es }
331+
| LOOP labeling_opt block END
332+
{ fun c -> let c' = $2 c in let ts, es = $3 c' in loop ts es }
333+
| IF labeling_opt block END
334+
{ fun c -> let c' = $2 c in let ts, es = $3 c' in if_ ts es [] }
335+
| IF labeling_opt block ELSE instr_list END
336+
{ fun c -> let c' = $2 c in let ts, es1 = $3 c' in if_ ts es1 ($5 c') }
337+
;
338+
block :
339+
| value_type_list instr_list { fun c -> $1, $2 c }
343340
;
344341
345342
expr : /* Sugar */
@@ -348,31 +345,27 @@ expr : /* Sugar */
348345
;
349346
expr1 : /* Sugar */
350347
| plain_instr expr_list { fun c -> snd ($2 c), $1 c }
351-
/* TODO: remove special-casing of branches here once arities are gone */
352-
| BR var expr_list { fun c -> let n, es = $3 c in es, br n ($2 c label) }
353-
| BR_IF var expr expr_list
354-
{ fun c ->
355-
let es1 = $3 c and n, es2 = $4 c in es1 @ es2, br_if n ($2 c label) }
356-
| BR_TABLE var var_list expr expr_list
357-
{ fun c -> let xs, x = Lib.List.split_last ($2 c label :: $3 c label) in
358-
let es1 = $4 c and n, es2 = $5 c in es1 @ es2, br_table n xs x }
359-
| BLOCK labeling_opt instr_list
360-
{ fun c -> let c' = $2 c in [], block ($3 c') }
361-
| LOOP labeling_opt instr_list
362-
{ fun c -> let c' = $2 c in [], loop ($3 c') }
363-
| IF expr expr { fun c -> let c' = anon_label c in $2 c, if_ ($3 c') [] }
364-
| IF expr expr expr
365-
{ fun c -> let c' = anon_label c in $2 c, if_ ($3 c') ($4 c') }
366-
| IF expr LPAR THEN labeling_opt instr_list RPAR
367-
{ fun c -> let c' = $5 c in $2 c, if_ ($6 c') [] }
368-
| IF expr LPAR THEN labeling_opt instr_list RPAR LPAR
369-
ELSE labeling_opt instr_list RPAR
370-
{ fun c -> let c1 = $5 c in let c2 = $10 c in $2 c, if_ ($6 c1) ($11 c2) }
371-
| IF LPAR THEN labeling_opt instr_list RPAR
372-
{ fun c -> let c' = $4 c in [], if_ ($5 c') [] }
373-
| IF LPAR THEN labeling_opt instr_list RPAR
374-
LPAR ELSE labeling_opt instr_list RPAR
375-
{ fun c -> let c1 = $4 c in let c2 = $9 c in [], if_ ($5 c1) ($10 c2) }
348+
| BLOCK labeling_opt block
349+
{ fun c -> let c' = $2 c in let ts, es = $3 c' in [], block ts es }
350+
| LOOP labeling_opt block
351+
{ fun c -> let c' = $2 c in let ts, es = $3 c' in [], loop ts es }
352+
| IF labeling_opt value_type_list if_
353+
{ fun c -> let c' = $2 c in
354+
let es, es1, es2 = $4 c c' in es, if_ $3 es1 es2 }
355+
;
356+
if_ :
357+
| LPAR THEN instr_list RPAR LPAR ELSE instr_list RPAR
358+
{ fun c c' -> [], $3 c', $7 c' }
359+
| LPAR THEN instr_list RPAR /* Sugar */
360+
{ fun c c' -> [], $3 c', [] }
361+
| expr LPAR THEN instr_list RPAR LPAR ELSE instr_list RPAR /* Sugar */
362+
{ fun c c' -> $1 c, $4 c', $8 c' }
363+
| expr LPAR THEN instr_list RPAR /* Sugar */
364+
{ fun c c' -> $1 c, $4 c', [] }
365+
| expr expr expr /* Sugar */
366+
{ fun c c' -> $1 c, $2 c', $3 c' }
367+
| expr expr /* Sugar */
368+
{ fun c c' -> $1 c, $2 c', [] }
376369
;
377370
378371
instr_list :

ml-proto/host/run.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -104,6 +104,7 @@ let input_from get_script run =
104104
| Eval.Link (at, msg) -> error at "link failure" msg
105105
| Eval.Trap (at, msg) -> error at "runtime trap" msg
106106
| Eval.Crash (at, msg) -> error at "runtime crash" msg
107+
| Encode.Code (at, msg) -> error at "encoding error" msg
107108
| IO (at, msg) -> error at "i/o error" msg
108109
| Assert (at, msg) -> error at "assertion failure" msg
109110
| Abort _ -> false

ml-proto/spec/ast.ml

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -72,13 +72,13 @@ and instr' =
7272
| Nop (* do nothing *)
7373
| Drop (* forget a value *)
7474
| Select (* branchless conditional *)
75-
| Block of instr list (* execute in sequence *)
76-
| Loop of instr list (* loop header *)
77-
| Br of int * var (* break to n-th surrounding label *)
78-
| BrIf of int * var (* conditional break *)
79-
| BrTable of int * var list * var (* indexed break *)
75+
| Block of stack_type * instr list (* execute in sequence *)
76+
| Loop of stack_type * instr list (* loop header *)
77+
| Br of var (* break to n-th surrounding label *)
78+
| BrIf of var (* conditional break *)
79+
| BrTable of var list * var (* indexed break *)
8080
| Return (* break from function body *)
81-
| If of instr list * instr list (* conditional *)
81+
| If of stack_type * instr list * instr list (* conditional *)
8282
| Call of var (* call function *)
8383
| CallIndirect of var (* call function through table *)
8484
| GetLocal of var (* read local variable *)

0 commit comments

Comments
 (0)