Skip to content

Commit afb4642

Browse files
committed
More precise environment type
Casting to the exact type should be slightly faster since we avoid the test for i31.
1 parent ca0a953 commit afb4642

File tree

8 files changed

+135
-72
lines changed

8 files changed

+135
-72
lines changed

compiler/lib-wasm/code_generation.ml

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -511,6 +511,31 @@ let tee ?typ x e =
511511

512512
let should_make_global x st = Var.Set.mem x st.context.globalized_variables, st
513513

514+
let get_constant x st = Hashtbl.find_opt st.context.constants x, st
515+
516+
let placeholder_value typ f =
517+
let* c = get_constant typ in
518+
match c with
519+
| None ->
520+
let x = Var.fresh () in
521+
let* () = register_constant typ (W.GlobalGet x) in
522+
let* () =
523+
register_global
524+
~constant:true
525+
x
526+
{ mut = false; typ = Ref { nullable = false; typ = Type typ } }
527+
(f typ)
528+
in
529+
return (W.GlobalGet x)
530+
| Some c -> return c
531+
532+
let empty_struct =
533+
let* typ =
534+
register_type "empty_struct" (fun () ->
535+
return { supertype = None; final = true; typ = W.Struct [] })
536+
in
537+
placeholder_value typ (fun typ -> W.StructNew (typ, []))
538+
514539
let value_type st = st.context.value_type, st
515540

516541
let rec store ?(always = false) ?typ x e =

compiler/lib-wasm/code_generation.mli

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -203,3 +203,5 @@ val function_body :
203203
-> param_names:Code.Var.t list
204204
-> body:unit t
205205
-> (Wasm_ast.var * Wasm_ast.value_type) list * Wasm_ast.instruction list
206+
207+
val empty_struct : expression

compiler/lib-wasm/curry.ml

Lines changed: 11 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,12 @@ module Make (Target : Target_sig.S) = struct
3535

3636
let call ?typ ~cps ~arity closure args =
3737
let funct = Var.fresh () in
38-
let* closure = tee ?typ funct closure in
38+
let closure = tee ?typ funct closure in
39+
let* closure =
40+
match typ with
41+
| None -> Memory.cast_closure ~cps ~arity closure
42+
| Some _ -> closure
43+
in
3944
let args = args @ [ closure ] in
4045
let* ty, funct =
4146
Memory.load_function_pointer
@@ -68,7 +73,7 @@ module Make (Target : Target_sig.S) = struct
6873
let body =
6974
let* () = no_event in
7075
let* () = bind_parameters args in
71-
let* _ = add_var f in
76+
let* _ = add_var ~typ:Type.closure f in
7277
let* args' = expression_list load args in
7378
let* _f = load f in
7479
let rec loop m args closure closure_typ =
@@ -126,7 +131,7 @@ module Make (Target : Target_sig.S) = struct
126131
let body =
127132
let* () = no_event in
128133
let* _ = add_var x in
129-
let* _ = add_var f in
134+
let* _ = add_var ~typ:Type.closure f in
130135
push (Closure.curry_allocate ~cps:false ~arity m ~f:name' ~closure:f ~arg:x)
131136
in
132137
let param_names = [ x; f ] in
@@ -154,7 +159,7 @@ module Make (Target : Target_sig.S) = struct
154159
let body =
155160
let* () = no_event in
156161
let* () = bind_parameters args in
157-
let* _ = add_var f in
162+
let* _ = add_var ~typ:Type.closure f in
158163
let* args' = expression_list load args in
159164
let* _f = load f in
160165
let rec loop m args closure closure_typ =
@@ -214,7 +219,7 @@ module Make (Target : Target_sig.S) = struct
214219
let* () = no_event in
215220
let* _ = add_var x in
216221
let* _ = add_var cont in
217-
let* _ = add_var f in
222+
let* _ = add_var ~typ:Type.closure f in
218223
let* e = Closure.curry_allocate ~cps:true ~arity m ~f:name' ~closure:f ~arg:x in
219224
let* c = call ~cps:false ~arity:1 (load cont) [ e ] in
220225
instr (W.Return (Some c))
@@ -332,7 +337,7 @@ module Make (Target : Target_sig.S) = struct
332337
let body =
333338
let* () = no_event in
334339
let* () = bind_parameters l in
335-
let* _ = add_var f in
340+
let* _ = add_var ~typ:Type.closure f in
336341
let* typ, closure = Memory.load_real_closure ~cps ~arity (load f) in
337342
let* l = expression_list load l in
338343
let* e =

compiler/lib-wasm/gc_target.ml

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,8 @@ let include_closure_arity = false
2727
module Type = struct
2828
let value = W.Ref { nullable = false; typ = Eq }
2929

30+
let closure = W.Ref { nullable = false; typ = Struct }
31+
3032
let block_type =
3133
register_type "block" (fun () ->
3234
return
@@ -205,7 +207,8 @@ module Type = struct
205207
let primitive_type n =
206208
{ W.params = List.init ~len:n ~f:(fun _ -> value); result = [ value ] }
207209

208-
let func_type n = primitive_type (n + 1)
210+
let func_type n =
211+
{ W.params = List.init ~len:n ~f:(fun _ -> value) @ [ closure ]; result = [ value ] }
209212

210213
let function_type ~cps n =
211214
let n = if cps then n + 1 else n in
@@ -433,6 +436,8 @@ module Value = struct
433436
let* t = Type.block_type in
434437
return (W.ArrayNewFixed (t, []))
435438

439+
let dummy_closure = empty_struct
440+
436441
let as_block e =
437442
let* t = Type.block_type in
438443
let* e = e in
@@ -817,6 +822,11 @@ module Memory = struct
817822
then 1
818823
else (if include_closure_arity then 1 else 0) + if arity = 1 then 1 else 2
819824

825+
let cast_closure ~cps ~arity closure =
826+
let arity = if cps then arity - 1 else arity in
827+
let* ty = Type.closure_type ~usage:`Access ~cps arity in
828+
wasm_cast ty closure
829+
820830
let load_function_pointer ~cps ~arity ?(skip_cast = false) closure =
821831
let arity = if cps then arity - 1 else arity in
822832
let* ty = Type.closure_type ~usage:`Access ~cps arity in
@@ -1196,7 +1206,7 @@ module Closure = struct
11961206
if free_variable_count = 0
11971207
then
11981208
(* The closures are all constants and the environment is empty. *)
1199-
let* _ = add_var (Code.Var.fresh ()) in
1209+
let* _ = add_var ~typ:Type.closure (Code.Var.fresh ()) in
12001210
return ()
12011211
else
12021212
let arity = List.assoc f info.functions in
@@ -1205,7 +1215,7 @@ module Closure = struct
12051215
match info.Closure_conversion.functions with
12061216
| [ _ ] ->
12071217
let* typ = Type.env_type ~cps ~arity free_variable_count in
1208-
let* _ = add_var f in
1218+
let* _ = add_var ~typ:Type.closure f in
12091219
let env = Code.Var.fresh_n "env" in
12101220
let* () =
12111221
store
@@ -1226,7 +1236,7 @@ module Closure = struct
12261236
let* typ =
12271237
Type.rec_closure_type ~cps ~arity ~function_count ~free_variable_count
12281238
in
1229-
let* _ = add_var f in
1239+
let* _ = add_var ~typ:Type.closure f in
12301240
let env = Code.Var.fresh_n "env" in
12311241
let* env_typ = Type.rec_env_type ~function_count ~free_variable_count in
12321242
let* () =

compiler/lib-wasm/generate.ml

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -613,7 +613,12 @@ module Generate (Target : Target_sig.S) = struct
613613
| [] -> (
614614
let arity = List.length args in
615615
let funct = Var.fresh () in
616-
let* closure = tee funct (load f) in
616+
let* closure =
617+
Memory.cast_closure
618+
~cps:(Var.Set.mem x ctx.in_cps)
619+
~arity
620+
(tee funct (load f))
621+
in
617622
let* ty, funct =
618623
Memory.load_function_pointer
619624
~cps:(Var.Set.mem x ctx.in_cps)
@@ -629,7 +634,7 @@ module Generate (Target : Target_sig.S) = struct
629634
(* Functions with constant closures ignore their
630635
environment. In case of partial application, we
631636
still need the closure. *)
632-
let* cl = if exact then Value.unit else return closure in
637+
let* cl = if exact then Value.dummy_closure else return closure in
633638
return (W.Call (g, List.rev (cl :: acc)))
634639
| _ -> return (W.Call_ref (ty, funct, List.rev (closure :: acc))))
635640
| x :: r ->

compiler/lib-wasm/target_sig.ml

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,8 @@ module type S = sig
2626
-> [ `Expr of Wasm_ast.expression | `Var of Wasm_ast.var ] list
2727
-> expression
2828

29+
val cast_closure : cps:bool -> arity:int -> expression -> expression
30+
2931
val load_function_pointer :
3032
cps:bool
3133
-> arity:int
@@ -99,6 +101,8 @@ module type S = sig
99101
module Type : sig
100102
val value : Wasm_ast.value_type
101103

104+
val closure : Wasm_ast.value_type
105+
102106
val func_type : int -> Wasm_ast.func_type
103107

104108
val primitive_type : int -> Wasm_ast.func_type
@@ -159,6 +163,8 @@ module type S = sig
159163

160164
val dummy_block : expression
161165

166+
val dummy_closure : expression
167+
162168
val as_block : expression -> expression
163169
end
164170

0 commit comments

Comments
 (0)