Skip to content

Commit ca0a953

Browse files
vouillonvouillon
committed
Clean-up regarding function and primitive types
1 parent 4bafb2e commit ca0a953

File tree

8 files changed

+44
-47
lines changed

8 files changed

+44
-47
lines changed

‎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: 13 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 })
@@ -743,13 +743,13 @@ module Memory = struct
743743
let a = Code.Var.fresh_n "a" in
744744
let i = Code.Var.fresh_n "i" in
745745
block_expr
746-
{ params = []; result = [ Value.value ] }
746+
{ params = []; result = [ Type.value ] }
747747
(let* () = store a e in
748748
let* () = store ~typ:I32 i (Value.int_val e') in
749749
let* () =
750750
drop
751751
(block_expr
752-
{ params = []; result = [ Value.value ] }
752+
{ params = []; result = [ Type.value ] }
753753
(let* block = Type.block_type in
754754
let* a = load a in
755755
let* e =
@@ -779,7 +779,7 @@ module Memory = struct
779779
(let* () =
780780
drop
781781
(block_expr
782-
{ params = []; result = [ Value.value ] }
782+
{ params = []; result = [ Type.value ] }
783783
(let* block = Type.block_type in
784784
let* a = load a in
785785
let* () =
@@ -840,7 +840,7 @@ module Memory = struct
840840
let* () =
841841
drop
842842
(block_expr
843-
{ params = []; result = [ Value.value ] }
843+
{ params = []; result = [ Type.value ] }
844844
(let* e =
845845
if_match
846846
~typ:(Some (W.Ref { nullable = false; typ = Type fun_ty }))
@@ -1406,7 +1406,7 @@ let internal_primitives =
14061406
let arity = List.length args in
14071407
(* [Type.func_type] counts one additional argument for the closure environment (absent
14081408
here) *)
1409-
let* f = register_import ~name (Fun (Type.func_type (arity - 1))) in
1409+
let* f = register_import ~name (Fun (Type.primitive_type arity)) in
14101410
let args = List.map ~f:transl_prim_arg args in
14111411
let* args = expression_list Fun.id args in
14121412
return (W.Call (f, args))
@@ -1675,19 +1675,19 @@ let externref = W.Ref { nullable = true; typ = Extern }
16751675

16761676
let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
16771677
let* js_tag = register_import ~name:"javascript_exception" (Tag externref) in
1678-
let* ocaml_tag = register_import ~name:"ocaml_exception" (Tag Value.value) in
1678+
let* ocaml_tag = register_import ~name:"ocaml_exception" (Tag Type.value) in
16791679
let* f =
16801680
register_import
16811681
~name:"caml_wrap_exception"
1682-
(Fun { params = [ externref ]; result = [ Value.value ] })
1682+
(Fun { params = [ externref ]; result = [ Type.value ] })
16831683
in
16841684
block
16851685
{ params = []; result = result_typ }
16861686
(let* () =
16871687
store
16881688
x
16891689
(block_expr
1690-
{ params = []; result = [ Value.value ] }
1690+
{ params = []; result = [ Type.value ] }
16911691
(let* exn =
16921692
block_expr
16931693
{ params = []; result = [ externref ] }
@@ -1698,7 +1698,7 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
16981698
~result_typ:[ externref ]
16991699
~fall_through:`Skip
17001700
~context:(`Skip :: `Skip :: `Catch :: context))
1701-
[ ocaml_tag, 1, Value.value; js_tag, 0, externref ]
1701+
[ ocaml_tag, 1, Type.value; js_tag, 0, externref ]
17021702
in
17031703
instr (W.Push e))
17041704
in

‎compiler/lib-wasm/generate.ml

Lines changed: 14 additions & 12 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))
@@ -997,7 +996,7 @@ module Generate (Target : Target_sig.S) = struct
997996
instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
998997
| Raise (x, _) -> (
999998
let* e = load x in
1000-
let* tag = register_import ~name:exception_name (Tag Value.value) in
999+
let* tag = register_import ~name:exception_name (Tag Type.value) in
10011000
match fall_through with
10021001
| `Catch -> instr (Push e)
10031002
| `Block _ | `Return | `Skip -> (
@@ -1082,7 +1081,7 @@ module Generate (Target : Target_sig.S) = struct
10821081
wrap_with_handlers
10831082
p
10841083
pc
1085-
~result_typ:[ Value.value ]
1084+
~result_typ:[ Type.value ]
10861085
~fall_through:`Return
10871086
~context:[]
10881087
(fun ~result_typ ~fall_through ~context ->
@@ -1103,7 +1102,10 @@ module Generate (Target : Target_sig.S) = struct
11031102
| None -> Option.map ~f:(fun name -> name ^ ".init") unit_name
11041103
| Some _ -> None)
11051104
; typ = None
1106-
; signature = func_type param_count
1105+
; signature =
1106+
(match name_opt with
1107+
| None -> Type.primitive_type param_count
1108+
| Some _ -> Type.func_type (param_count - 1))
11071109
; param_names
11081110
; locals
11091111
; body
@@ -1112,7 +1114,7 @@ module Generate (Target : Target_sig.S) = struct
11121114

11131115
let init_function ~context ~to_link =
11141116
let name = Code.Var.fresh_n "initialize" in
1115-
let signature = { W.params = []; result = [ Value.value ] } in
1117+
let signature = { W.params = []; result = [ Type.value ] } in
11161118
let locals, body =
11171119
function_body
11181120
~context
@@ -1288,7 +1290,7 @@ module G = Generate (Gc_target)
12881290

12891291
let init = G.init
12901292

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

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

‎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

‎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/effect.wat

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,7 @@
4545
(type $block (array (mut (ref eq))))
4646
(type $bytes (array (mut i8)))
4747
(type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
48+
(type $primitive_2 (func (param (ref eq) (ref eq)) (result (ref eq))))
4849
(type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
4950
(type $function_3
5051
(func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (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: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,12 +29,12 @@
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)))
3635
(type $float_array (array (mut f64)))
3736
(type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
37+
(type $primitive_2 (func (param (ref eq) (ref eq)) (result (ref eq))))
3838
(type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
3939
(type $closure_last_arg
4040
(sub $closure (struct (;(field i32);) (field (ref $function_1)))))

0 commit comments

Comments
 (0)