Skip to content

Commit 713bfba

Browse files
vouillonvouillon
authored
Wasm_of_ocaml: small changes (#1964)
* Improve placement of Wasm block statements Place Wasm block statements around control instructions rather than around whole blocks of instructions. This results in less variable being uninitialized (variables initialized within a Wasm block are no longer considered as initialized after the block). * Clean-up regarding function and primitive types * Wasm AST: add br_on_null
1 parent ea26692 commit 713bfba

File tree

12 files changed

+56
-48
lines changed

12 files changed

+56
-48
lines changed

‎compiler/lib-wasm/code_generation.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -474,6 +474,7 @@ let rec is_smi e =
474474
| RefNull _
475475
| Br_on_cast _
476476
| Br_on_cast_fail _
477+
| Br_on_null _
477478
| Try _
478479
| ExternConvertAny _ -> false
479480
| BinOp ((F32 _ | F64 _), _, _) | RefTest _ | RefEq _ -> true

‎compiler/lib-wasm/curry.ml

Lines changed: 8 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -24,11 +24,6 @@ open Code_generation
2424
module Make (Target : Target_sig.S) = struct
2525
open Target
2626

27-
let func_type n =
28-
{ W.params = List.init ~len:(n + 1) ~f:(fun _ -> Value.value)
29-
; result = [ Value.value ]
30-
}
31-
3227
let bind_parameters l =
3328
List.fold_left
3429
~f:(fun l x ->
@@ -105,7 +100,7 @@ module Make (Target : Target_sig.S) = struct
105100
{ name
106101
; exported_name = None
107102
; typ = None
108-
; signature = func_type 1
103+
; signature = Type.func_type 1
109104
; param_names
110105
; locals
111106
; body
@@ -140,7 +135,7 @@ module Make (Target : Target_sig.S) = struct
140135
{ name
141136
; exported_name = None
142137
; typ = None
143-
; signature = func_type 1
138+
; signature = Type.func_type 1
144139
; param_names
145140
; locals
146141
; body
@@ -191,7 +186,7 @@ module Make (Target : Target_sig.S) = struct
191186
{ name
192187
; exported_name = None
193188
; typ = None
194-
; signature = func_type 2
189+
; signature = Type.func_type 2
195190
; param_names
196191
; locals
197192
; body
@@ -230,7 +225,7 @@ module Make (Target : Target_sig.S) = struct
230225
{ name
231226
; exported_name = None
232227
; typ = None
233-
; signature = func_type 2
228+
; signature = Type.func_type 2
234229
; param_names
235230
; locals
236231
; body
@@ -274,7 +269,7 @@ module Make (Target : Target_sig.S) = struct
274269
{ name
275270
; exported_name = None
276271
; typ = None
277-
; signature = func_type arity
272+
; signature = Type.primitive_type (arity + 1)
278273
; param_names
279274
; locals
280275
; body
@@ -306,7 +301,7 @@ module Make (Target : Target_sig.S) = struct
306301
(List.map ~f:(fun x -> `Var x) (List.tl l))
307302
in
308303
let* make_iterator =
309-
register_import ~name:"caml_apply_continuation" (Fun (func_type 0))
304+
register_import ~name:"caml_apply_continuation" (Fun (Type.primitive_type 1))
310305
in
311306
let iterate = Var.fresh_n "iterate" in
312307
let* () = store iterate (return (W.Call (make_iterator, [ args ]))) in
@@ -321,7 +316,7 @@ module Make (Target : Target_sig.S) = struct
321316
{ name
322317
; exported_name = None
323318
; typ = None
324-
; signature = func_type arity
319+
; signature = Type.primitive_type (arity + 1)
325320
; param_names
326321
; locals
327322
; body
@@ -356,7 +351,7 @@ module Make (Target : Target_sig.S) = struct
356351
{ name
357352
; exported_name = None
358353
; typ = None
359-
; signature = func_type arity
354+
; signature = Type.func_type arity
360355
; param_names
361356
; locals
362357
; body

‎compiler/lib-wasm/gc_target.ml

Lines changed: 14 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -202,8 +202,10 @@ module Type = struct
202202
]
203203
})
204204

205-
let func_type n =
206-
{ W.params = List.init ~len:(n + 1) ~f:(fun _ -> value); result = [ value ] }
205+
let primitive_type n =
206+
{ W.params = List.init ~len:n ~f:(fun _ -> value); result = [ value ] }
207+
208+
let func_type n = primitive_type (n + 1)
207209

208210
let function_type ~cps n =
209211
let n = if cps then n + 1 else n in
@@ -423,8 +425,6 @@ module Type = struct
423425
end
424426

425427
module Value = struct
426-
let value = Type.value
427-
428428
let block_type =
429429
let* t = Type.block_type in
430430
return (W.Ref { nullable = false; typ = Type t })
@@ -528,6 +528,7 @@ module Value = struct
528528
| Call_ref _
529529
| Br_on_cast _
530530
| Br_on_cast_fail _
531+
| Br_on_null _
531532
| Try _ -> false
532533
| IfExpr (_, e1, e2, e3) -> effect_free e1 && effect_free e2 && effect_free e3
533534
| ArrayNewFixed (_, l) | StructNew (_, l) -> List.for_all ~f:effect_free l
@@ -743,13 +744,13 @@ module Memory = struct
743744
let a = Code.Var.fresh_n "a" in
744745
let i = Code.Var.fresh_n "i" in
745746
block_expr
746-
{ params = []; result = [ Value.value ] }
747+
{ params = []; result = [ Type.value ] }
747748
(let* () = store a e in
748749
let* () = store ~typ:I32 i (Value.int_val e') in
749750
let* () =
750751
drop
751752
(block_expr
752-
{ params = []; result = [ Value.value ] }
753+
{ params = []; result = [ Type.value ] }
753754
(let* block = Type.block_type in
754755
let* a = load a in
755756
let* e =
@@ -779,7 +780,7 @@ module Memory = struct
779780
(let* () =
780781
drop
781782
(block_expr
782-
{ params = []; result = [ Value.value ] }
783+
{ params = []; result = [ Type.value ] }
783784
(let* block = Type.block_type in
784785
let* a = load a in
785786
let* () =
@@ -840,7 +841,7 @@ module Memory = struct
840841
let* () =
841842
drop
842843
(block_expr
843-
{ params = []; result = [ Value.value ] }
844+
{ params = []; result = [ Type.value ] }
844845
(let* e =
845846
if_match
846847
~typ:(Some (W.Ref { nullable = false; typ = Type fun_ty }))
@@ -1406,7 +1407,7 @@ let internal_primitives =
14061407
let arity = List.length args in
14071408
(* [Type.func_type] counts one additional argument for the closure environment (absent
14081409
here) *)
1409-
let* f = register_import ~name (Fun (Type.func_type (arity - 1))) in
1410+
let* f = register_import ~name (Fun (Type.primitive_type arity)) in
14101411
let args = List.map ~f:transl_prim_arg args in
14111412
let* args = expression_list Fun.id args in
14121413
return (W.Call (f, args))
@@ -1675,19 +1676,19 @@ let externref = W.Ref { nullable = true; typ = Extern }
16751676

16761677
let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
16771678
let* js_tag = register_import ~name:"javascript_exception" (Tag externref) in
1678-
let* ocaml_tag = register_import ~name:"ocaml_exception" (Tag Value.value) in
1679+
let* ocaml_tag = register_import ~name:"ocaml_exception" (Tag Type.value) in
16791680
let* f =
16801681
register_import
16811682
~name:"caml_wrap_exception"
1682-
(Fun { params = [ externref ]; result = [ Value.value ] })
1683+
(Fun { params = [ externref ]; result = [ Type.value ] })
16831684
in
16841685
block
16851686
{ params = []; result = result_typ }
16861687
(let* () =
16871688
store
16881689
x
16891690
(block_expr
1690-
{ params = []; result = [ Value.value ] }
1691+
{ params = []; result = [ Type.value ] }
16911692
(let* exn =
16921693
block_expr
16931694
{ params = []; result = [ externref ] }
@@ -1698,7 +1699,7 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
16981699
~result_typ:[ externref ]
16991700
~fall_through:`Skip
17001701
~context:(`Skip :: `Skip :: `Catch :: context))
1701-
[ ocaml_tag, 1, Value.value; js_tag, 0, externref ]
1702+
[ ocaml_tag, 1, Type.value; js_tag, 0, externref ]
17021703
in
17031704
instr (W.Push e))
17041705
in

‎compiler/lib-wasm/generate.ml

Lines changed: 16 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -72,13 +72,13 @@ module Generate (Target : Target_sig.S) = struct
7272

7373
let repr_type r =
7474
match r with
75-
| Value -> Value.value
75+
| Value -> Type.value
7676
| Float -> F64
7777
| Int32 -> I32
7878
| Nativeint -> I32
7979
| Int64 -> I64
8080

81-
let specialized_func_type (_, params, result) =
81+
let specialized_primitive_type (_, params, result) =
8282
{ W.params = List.map ~f:repr_type params; result = [ repr_type result ] }
8383

8484
let box_value r e =
@@ -127,9 +127,6 @@ module Generate (Target : Target_sig.S) = struct
127127
];
128128
h
129129

130-
let func_type n =
131-
{ W.params = List.init ~len:n ~f:(fun _ -> Value.value); result = [ Value.value ] }
132-
133130
let float_bin_op' op f g =
134131
Memory.box_float (op (Memory.unbox_float f) (Memory.unbox_float g))
135132

@@ -711,7 +708,7 @@ module Generate (Target : Target_sig.S) = struct
711708
let ((_, arg_typ, res_typ) as typ) =
712709
Hashtbl.find specialized_primitives name
713710
in
714-
let* f = register_import ~name (Fun (specialized_func_type typ)) in
711+
let* f = register_import ~name (Fun (specialized_primitive_type typ)) in
715712
let rec loop acc arg_typ l =
716713
match arg_typ, l with
717714
| [], [] -> box_value res_typ (return (W.Call (f, List.rev acc)))
@@ -722,7 +719,9 @@ module Generate (Target : Target_sig.S) = struct
722719
in
723720
loop [] arg_typ l
724721
with Not_found ->
725-
let* f = register_import ~name (Fun (func_type (List.length l))) in
722+
let* f =
723+
register_import ~name (Fun (Type.primitive_type (List.length l)))
724+
in
726725
let rec loop acc l =
727726
match l with
728727
| [] -> return (W.Call (f, List.rev acc))
@@ -921,6 +920,8 @@ module Generate (Target : Target_sig.S) = struct
921920
| _ -> Structure.is_merge_node g pc'
922921
in
923922
let code ~context =
923+
let block = Addr.Map.find pc ctx.blocks in
924+
let* () = translate_instrs ctx context block.body in
924925
translate_node_within
925926
~result_typ
926927
~fall_through
@@ -965,7 +966,6 @@ module Generate (Target : Target_sig.S) = struct
965966
translate_tree result_typ fall_through pc' context
966967
| [] -> (
967968
let block = Addr.Map.find pc ctx.blocks in
968-
let* () = translate_instrs ctx context block.body in
969969
let branch = block.branch in
970970
match branch with
971971
| Branch cont -> translate_branch result_typ fall_through pc cont context
@@ -997,7 +997,7 @@ module Generate (Target : Target_sig.S) = struct
997997
instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
998998
| Raise (x, _) -> (
999999
let* e = load x in
1000-
let* tag = register_import ~name:exception_name (Tag Value.value) in
1000+
let* tag = register_import ~name:exception_name (Tag Type.value) in
10011001
match fall_through with
10021002
| `Catch -> instr (Push e)
10031003
| `Block _ | `Return | `Skip -> (
@@ -1082,7 +1082,7 @@ module Generate (Target : Target_sig.S) = struct
10821082
wrap_with_handlers
10831083
p
10841084
pc
1085-
~result_typ:[ Value.value ]
1085+
~result_typ:[ Type.value ]
10861086
~fall_through:`Return
10871087
~context:[]
10881088
(fun ~result_typ ~fall_through ~context ->
@@ -1103,7 +1103,10 @@ module Generate (Target : Target_sig.S) = struct
11031103
| None -> Option.map ~f:(fun name -> name ^ ".init") unit_name
11041104
| Some _ -> None)
11051105
; typ = None
1106-
; signature = func_type param_count
1106+
; signature =
1107+
(match name_opt with
1108+
| None -> Type.primitive_type param_count
1109+
| Some _ -> Type.func_type (param_count - 1))
11071110
; param_names
11081111
; locals
11091112
; body
@@ -1112,7 +1115,7 @@ module Generate (Target : Target_sig.S) = struct
11121115

11131116
let init_function ~context ~to_link =
11141117
let name = Code.Var.fresh_n "initialize" in
1115-
let signature = { W.params = []; result = [ Value.value ] } in
1118+
let signature = { W.params = []; result = [ Type.value ] } in
11161119
let locals, body =
11171120
function_body
11181121
~context
@@ -1288,7 +1291,7 @@ module G = Generate (Gc_target)
12881291

12891292
let init = G.init
12901293

1291-
let start () = make_context ~value_type:Gc_target.Value.value
1294+
let start () = make_context ~value_type:Gc_target.Type.value
12921295

12931296
let f ~context ~unit_name p ~live_vars ~in_cps ~deadcode_sentinal =
12941297
let t = Timer.make () in

‎compiler/lib-wasm/initialize_locals.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,7 @@ let rec scan_expression ctx e =
4747
| RefTest (_, e')
4848
| Br_on_cast (_, _, _, e')
4949
| Br_on_cast_fail (_, _, _, e')
50+
| Br_on_null (_, e') -> scan_expression ctx e'
5051
| ExternConvertAny e' -> scan_expression ctx e'
5152
| BinOp (_, e', e'')
5253
| ArrayNew (_, e', e'')

‎compiler/lib-wasm/target_sig.ml

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -96,9 +96,15 @@ module type S = sig
9696
val unbox_nativeint : expression -> expression
9797
end
9898

99-
module Value : sig
99+
module Type : sig
100100
val value : Wasm_ast.value_type
101101

102+
val func_type : int -> Wasm_ast.func_type
103+
104+
val primitive_type : int -> Wasm_ast.func_type
105+
end
106+
107+
module Value : sig
102108
val unit : expression
103109

104110
val val_int : expression -> expression

‎compiler/lib-wasm/wasm_ast.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -167,6 +167,7 @@ type expression =
167167
| RefNull of heap_type
168168
| Br_on_cast of int * ref_type * ref_type * expression
169169
| Br_on_cast_fail of int * ref_type * ref_type * expression
170+
| Br_on_null of int * expression
170171
| IfExpr of value_type * expression * expression * expression
171172
| Try of func_type * instruction list * (var * int * value_type) list
172173
| ExternConvertAny of expression

‎compiler/lib-wasm/wasm_output.ml

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -645,6 +645,11 @@ end = struct
645645
output_uint ch i;
646646
output_heaptype st.type_names ch typ1.typ;
647647
output_heaptype st.type_names ch typ2.typ
648+
| Br_on_null (i, e') ->
649+
Feature.require gc;
650+
output_expression st ch e';
651+
output_byte ch 0xD5;
652+
output_uint ch i
648653
| IfExpr (typ, e1, e2, e3) ->
649654
output_expression st ch e1;
650655
output_byte ch 0x04;
@@ -885,6 +890,7 @@ end = struct
885890
| RefTest (_, e')
886891
| Br_on_cast (_, _, _, e')
887892
| Br_on_cast_fail (_, _, _, e')
893+
| Br_on_null (_, e') -> expr_function_references e' set
888894
| ExternConvertAny e' -> expr_function_references e' set
889895
| BinOp (_, e', e'')
890896
| ArrayNew (_, e', e'')

‎compiler/lib-wasm/wat_output.ml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -452,6 +452,8 @@ let expression_or_instructions ctx st in_function =
452452
:: ref_type st ty'
453453
:: expression e)
454454
]
455+
| Br_on_null (i, e) ->
456+
[ List (Atom "br_on_null" :: Atom (string_of_int i) :: expression e) ]
455457
| IfExpr (ty, cond, ift, iff) ->
456458
[ List
457459
((Atom "if" :: block_type st { params = []; result = [ ty ] })

‎runtime/wasm/domain.wat

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,6 @@
2323
(func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq))))
2424

2525
(type $block (array (mut (ref eq))))
26-
(type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
27-
(type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
2826

2927
(func (export "caml_atomic_cas")
3028
(param $ref (ref eq)) (param $o (ref eq)) (param $n (ref eq))

‎runtime/wasm/jslib.wat

Lines changed: 0 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -106,11 +106,6 @@
106106
(type $float_array (array (mut f64)))
107107
(type $bytes (array (mut i8)))
108108
(type $js (struct (field anyref)))
109-
(type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
110-
(type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
111-
(type $function_2
112-
(func (param (ref eq) (ref eq) (ref eq)) (result (ref eq))))
113-
(type $cps_closure (sub (struct (field (ref $function_2)))))
114109

115110
(func $wrap (export "wrap") (param anyref) (result (ref eq))
116111
(block $is_eq (result (ref eq))

‎runtime/wasm/obj.wat

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,6 @@
2929
(func $caml_cps_trampoline (param (ref eq) (ref eq)) (result (ref eq))))
3030
))
3131

32-
3332
(type $block (array (mut (ref eq))))
3433
(type $bytes (array (mut i8)))
3534
(type $float (struct (field f64)))

0 commit comments

Comments
 (0)