Skip to content

Commit 5e840e0

Browse files
vouillonvouillon
authored
More extensive Wasm AST (#1916)
* Wasm AST: add extern.convert_any * Wasm AST: add unreachable * Wasm AST: add heap types 'struct', 'array' and 'none' * Wasm AST: possibility to provide an explicit function type * Wasm linker: fix parsing of recursive groups of types
1 parent dcf9970 commit 5e840e0

File tree

10 files changed

+154
-33
lines changed

10 files changed

+154
-33
lines changed

‎compiler/lib-wasm/code_generation.ml‎

Lines changed: 28 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -161,19 +161,40 @@ let heap_type_sub (ty : W.heap_type) (ty' : W.heap_type) st =
161161
match ty, ty' with
162162
| Func, Func
163163
| Extern, Extern
164-
| (Any | Eq | I31 | Type _), Any
165-
| (Eq | I31 | Type _), Eq
166-
| I31, I31 -> true, st
164+
| (Any | Eq | Struct | Array | I31 | None_ | Type _), Any
165+
| (Eq | Struct | Array | I31 | None_ | Type _), Eq
166+
| (None_ | Struct), Struct -> true, st
167+
| (None_ | Array), Array -> true, st
168+
| (None_ | I31), I31 -> true, st
169+
| None_, None_ -> true, st
170+
| Type t, Struct ->
171+
( (let type_field = Hashtbl.find st.context.types t in
172+
match type_field.typ with
173+
| Struct _ -> true
174+
| Array _ | Func _ -> false)
175+
, st )
176+
| Type t, Array ->
177+
( (let type_field = Hashtbl.find st.context.types t in
178+
match type_field.typ with
179+
| Array _ -> true
180+
| Struct _ | Func _ -> false)
181+
, st )
167182
| Type t, Type t' -> type_index_sub t t' st
183+
| None_, Type t ->
184+
( (let type_field = Hashtbl.find st.context.types t in
185+
match type_field.typ with
186+
| Struct _ | Array _ -> true
187+
| Func _ -> false)
188+
, st )
168189
(* Func and Extern are only in suptyping relation with themselves *)
169190
| Func, _
170191
| _, Func
171192
| Extern, _
172193
| _, Extern
173194
(* Any has no supertype *)
174195
| Any, _
175-
(* I31, struct and arrays have no subtype (of a different kind) *)
176-
| _, (I31 | Type _) -> false, st
196+
(* I31, struct, array and none have no other subtype *)
197+
| _, (I31 | Type _ | Struct | Array | None_) -> false, st
177198

178199
let register_global name ?exported_name ?(constant = false) typ init st =
179200
st.context.other_fields <-
@@ -453,7 +474,8 @@ let rec is_smi e =
453474
| RefNull _
454475
| Br_on_cast _
455476
| Br_on_cast_fail _
456-
| Try _ -> false
477+
| Try _
478+
| ExternConvertAny _ -> false
457479
| BinOp ((F32 _ | F64 _), _, _) | RefTest _ | RefEq _ -> true
458480
| IfExpr (_, _, ift, iff) -> is_smi ift && is_smi iff
459481

‎compiler/lib-wasm/curry.ml‎

Lines changed: 56 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -102,7 +102,14 @@ module Make (Target : Target_sig.S) = struct
102102
let param_names = args @ [ f ] in
103103
let locals, body = function_body ~context ~param_names ~body in
104104
W.Function
105-
{ name; exported_name = None; typ = func_type 1; param_names; locals; body }
105+
{ name
106+
; exported_name = None
107+
; typ = None
108+
; signature = func_type 1
109+
; param_names
110+
; locals
111+
; body
112+
}
106113

107114
let curry_name n m = Printf.sprintf "curry_%d_%d" n m
108115

@@ -130,7 +137,14 @@ module Make (Target : Target_sig.S) = struct
130137
let param_names = [ x; f ] in
131138
let locals, body = function_body ~context ~param_names ~body in
132139
W.Function
133-
{ name; exported_name = None; typ = func_type 1; param_names; locals; body }
140+
{ name
141+
; exported_name = None
142+
; typ = None
143+
; signature = func_type 1
144+
; param_names
145+
; locals
146+
; body
147+
}
134148
:: functions
135149

136150
let curry ~arity ~name = curry ~arity arity ~name
@@ -174,7 +188,14 @@ module Make (Target : Target_sig.S) = struct
174188
let param_names = args @ [ f ] in
175189
let locals, body = function_body ~context ~param_names ~body in
176190
W.Function
177-
{ name; exported_name = None; typ = func_type 2; param_names; locals; body }
191+
{ name
192+
; exported_name = None
193+
; typ = None
194+
; signature = func_type 2
195+
; param_names
196+
; locals
197+
; body
198+
}
178199

179200
let cps_curry_name n m = Printf.sprintf "cps_curry_%d_%d" n m
180201

@@ -206,7 +227,14 @@ module Make (Target : Target_sig.S) = struct
206227
let param_names = [ x; cont; f ] in
207228
let locals, body = function_body ~context ~param_names ~body in
208229
W.Function
209-
{ name; exported_name = None; typ = func_type 2; param_names; locals; body }
230+
{ name
231+
; exported_name = None
232+
; typ = None
233+
; signature = func_type 2
234+
; param_names
235+
; locals
236+
; body
237+
}
210238
:: functions
211239

212240
let cps_curry ~arity ~name = cps_curry ~arity arity ~name
@@ -243,7 +271,14 @@ module Make (Target : Target_sig.S) = struct
243271
let param_names = l @ [ f ] in
244272
let locals, body = function_body ~context ~param_names ~body in
245273
W.Function
246-
{ name; exported_name = None; typ = func_type arity; param_names; locals; body }
274+
{ name
275+
; exported_name = None
276+
; typ = None
277+
; signature = func_type arity
278+
; param_names
279+
; locals
280+
; body
281+
}
247282

248283
let cps_apply ~context ~arity ~name =
249284
assert (arity > 2);
@@ -283,7 +318,14 @@ module Make (Target : Target_sig.S) = struct
283318
let param_names = l @ [ f ] in
284319
let locals, body = function_body ~context ~param_names ~body in
285320
W.Function
286-
{ name; exported_name = None; typ = func_type arity; param_names; locals; body }
321+
{ name
322+
; exported_name = None
323+
; typ = None
324+
; signature = func_type arity
325+
; param_names
326+
; locals
327+
; body
328+
}
287329

288330
let dummy ~context ~cps ~arity ~name =
289331
let arity = if cps then arity + 1 else arity in
@@ -311,7 +353,14 @@ module Make (Target : Target_sig.S) = struct
311353
let param_names = l @ [ f ] in
312354
let locals, body = function_body ~context ~param_names ~body in
313355
W.Function
314-
{ name; exported_name = None; typ = func_type arity; param_names; locals; body }
356+
{ name
357+
; exported_name = None
358+
; typ = None
359+
; signature = func_type arity
360+
; param_names
361+
; locals
362+
; body
363+
}
315364

316365
let f ~context =
317366
IntMap.iter

‎compiler/lib-wasm/gc_target.ml‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -479,7 +479,7 @@ module Value = struct
479479
| W.RefI31 _ -> (
480480
match typ.typ with
481481
| W.I31 | Eq | Any -> return (W.Const (I32 1l))
482-
| Type _ | Func | Extern -> return (W.Const (I32 0l)))
482+
| Struct | Array | Type _ | None_ | Func | Extern -> return (W.Const (I32 0l)))
483483
| GlobalGet nm -> (
484484
let* init = get_global nm in
485485
match init with
@@ -513,7 +513,8 @@ module Value = struct
513513
| ArrayLen e'
514514
| StructGet (_, _, _, e')
515515
| RefCast (_, e')
516-
| RefTest (_, e') -> effect_free e'
516+
| RefTest (_, e')
517+
| ExternConvertAny e' -> effect_free e'
517518
| BinOp (_, e1, e2)
518519
| ArrayNew (_, e1, e2)
519520
| ArrayNewData (_, _, e1, e2)

‎compiler/lib-wasm/generate.ml‎

Lines changed: 19 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1057,16 +1057,17 @@ module Generate (Target : Target_sig.S) = struct
10571057
(match name_opt with
10581058
| None -> Option.map ~f:(fun name -> name ^ ".init") unit_name
10591059
| Some _ -> None)
1060+
; typ = None
1061+
; signature = func_type param_count
10601062
; param_names
1061-
; typ = func_type param_count
10621063
; locals
10631064
; body
10641065
}
10651066
:: acc
10661067

10671068
let init_function ~context ~to_link =
10681069
let name = Code.Var.fresh_n "initialize" in
1069-
let typ = { W.params = []; result = [ Value.value ] } in
1070+
let signature = { W.params = []; result = [ Value.value ] } in
10701071
let locals, body =
10711072
function_body
10721073
~context
@@ -1075,25 +1076,37 @@ module Generate (Target : Target_sig.S) = struct
10751076
(List.fold_right
10761077
~f:(fun name cont ->
10771078
let* f =
1078-
register_import ~import_module:"OCaml" ~name:(name ^ ".init") (Fun typ)
1079+
register_import
1080+
~import_module:"OCaml"
1081+
~name:(name ^ ".init")
1082+
(Fun signature)
10791083
in
10801084
let* () = instr (Drop (Call (f, []))) in
10811085
cont)
10821086
~init:(instr (Push (RefI31 (Const (I32 0l)))))
10831087
to_link)
10841088
in
10851089
context.other_fields <-
1086-
W.Function { name; exported_name = None; typ; param_names = []; locals; body }
1090+
W.Function
1091+
{ name
1092+
; exported_name = None
1093+
; typ = None
1094+
; signature
1095+
; param_names = []
1096+
; locals
1097+
; body
1098+
}
10871099
:: context.other_fields;
10881100
name
10891101

10901102
let entry_point context toplevel_fun entry_name =
1091-
let typ, param_names, body = entry_point ~toplevel_fun in
1103+
let signature, param_names, body = entry_point ~toplevel_fun in
10921104
let locals, body = function_body ~context ~param_names ~body in
10931105
W.Function
10941106
{ name = Var.fresh_n "entry_point"
10951107
; exported_name = Some entry_name
1096-
; typ
1108+
; typ = None
1109+
; signature
10971110
; param_names
10981111
; locals
10991112
; body

‎compiler/lib-wasm/initialize_locals.ml‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,8 @@ let rec scan_expression ctx e =
4646
| RefCast (_, e')
4747
| RefTest (_, e')
4848
| Br_on_cast (_, _, _, e')
49-
| Br_on_cast_fail (_, _, _, e') -> scan_expression ctx e'
49+
| Br_on_cast_fail (_, _, _, e')
50+
| ExternConvertAny e' -> scan_expression ctx e'
5051
| BinOp (_, e', e'')
5152
| ArrayNew (_, e', e'')
5253
| ArrayNewData (_, _, e', e'')
@@ -94,7 +95,7 @@ and scan_instruction ctx i =
9495
scan_instructions ctx l;
9596
scan_instructions ctx l'
9697
| CallInstr (_, l) | Return_call (_, l) -> scan_expressions ctx l
97-
| Br (_, None) | Return None | Rethrow _ | Nop | Event _ -> ()
98+
| Br (_, None) | Return None | Rethrow _ | Nop | Unreachable | Event _ -> ()
9899
| ArraySet (_, e, e', e'') ->
99100
scan_expression ctx e;
100101
scan_expression ctx e';

‎compiler/lib-wasm/tail_call.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,7 @@ let rec instruction ~tail i =
5959
| StructSet _
6060
| Return_call _
6161
| Return_call_ref _
62+
| Unreachable
6263
| Event _ -> i
6364

6465
and instructions ~tail l =

‎compiler/lib-wasm/wasm_ast.ml‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,10 @@ type heap_type =
2727
| Extern
2828
| Any
2929
| Eq
30+
| Struct
31+
| Array
3032
| I31
33+
| None_
3134
| Type of var
3235

3336
type ref_type =
@@ -166,6 +169,7 @@ type expression =
166169
| Br_on_cast_fail of int * ref_type * ref_type * expression
167170
| IfExpr of value_type * expression * expression * expression
168171
| Try of func_type * instruction list * (var * int * value_type) list
172+
| ExternConvertAny of expression
169173

170174
and instruction =
171175
| Drop of expression
@@ -187,6 +191,7 @@ and instruction =
187191
| StructSet of var * int * expression * expression
188192
| Return_call of var * expression list
189193
| Return_call_ref of var * expression * expression list
194+
| Unreachable
190195
| Event of Parse_info.t (** Location information *)
191196

192197
type import_desc =
@@ -205,7 +210,8 @@ type module_field =
205210
| Function of
206211
{ name : var
207212
; exported_name : string option
208-
; typ : func_type
213+
; typ : var option
214+
; signature : func_type
209215
; param_names : var list
210216
; locals : (var * value_type) list
211217
; body : instruction list

‎compiler/lib-wasm/wasm_link.ml‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -697,6 +697,12 @@ module Read = struct
697697
let pos = st.type_index_count in
698698
let pos' = add_rectype types ty in
699699
let count = Array.length ty in
700+
let len = Array.length st.type_mapping in
701+
if pos + count > len
702+
then (
703+
let m = Array.make (len + (len / 5) + count) 0 in
704+
Array.blit ~src:st.type_mapping ~src_pos:0 ~dst:m ~dst_pos:0 ~len;
705+
st.type_mapping <- m);
700706
for i = 0 to count - 1 do
701707
st.type_mapping.(pos + i) <- pos' + i
702708
done;

0 commit comments

Comments
 (0)