Skip to content

Commit df798c1

Browse files
authored
flambda-backend: Propagates layouts through Flambda1 (#1115)
1 parent 9bce50b commit df798c1

30 files changed

+404
-207
lines changed

lambda/lambda.ml

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -291,6 +291,8 @@ let rec equal_value_kind x y =
291291

292292
let equal_layout (Pvalue x) (Pvalue y) = equal_value_kind x y
293293

294+
let compatible_layout (Pvalue _) (Pvalue _) = true
295+
294296
let must_be_value layout =
295297
match layout with
296298
| Pvalue v -> v
@@ -555,6 +557,7 @@ let layout_block = Pvalue Pgenval
555557
let layout_list =
556558
Pvalue (Pvariant { consts = [0] ; non_consts = [0, [Pgenval; Pgenval]] })
557559
let layout_field = Pvalue Pgenval
560+
let layout_exception = Pvalue Pgenval
558561
let layout_function = Pvalue Pgenval
559562
let layout_object = Pvalue Pgenval
560563
let layout_class = Pvalue Pgenval
@@ -567,8 +570,12 @@ let layout_boxedint bi = Pvalue (Pboxedintval bi)
567570
let layout_lazy = Pvalue Pgenval
568571
let layout_lazy_contents = Pvalue Pgenval
569572
let layout_any_value = Pvalue Pgenval
573+
let layout_letrec = layout_any_value
570574

571575
let layout_top = Pvalue Pgenval
576+
let layout_bottom =
577+
(* CR pchambart: this should be an actual bottom *)
578+
Pvalue Pgenval
572579

573580
let default_function_attribute = {
574581
inline = Default_inline;

lambda/lambda.mli

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -237,6 +237,8 @@ val equal_value_kind : value_kind -> value_kind -> bool
237237

238238
val equal_layout : layout -> layout -> bool
239239

240+
val compatible_layout : layout -> layout -> bool
241+
240242
val equal_boxed_integer : boxed_integer -> boxed_integer -> bool
241243

242244
val must_be_value : layout -> value_kind
@@ -470,6 +472,7 @@ val layout_int : layout
470472
val layout_array : array_kind -> layout
471473
val layout_block : layout
472474
val layout_list : layout
475+
val layout_exception : layout
473476
val layout_function : layout
474477
val layout_object : layout
475478
val layout_class : layout
@@ -485,8 +488,10 @@ val layout_lazy : layout
485488
val layout_lazy_contents : layout
486489
(* A layout that is Pgenval because we are missing layout polymorphism *)
487490
val layout_any_value : layout
491+
val layout_letrec : layout
488492

489493
val layout_top : layout
494+
val layout_bottom : layout
490495

491496
val name_lambda: let_kind -> lambda -> layout -> (Ident.t -> lambda) -> lambda
492497
val name_lambda_list: (lambda * layout) list -> (lambda list -> lambda) -> lambda

lambda/translclass.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -214,7 +214,7 @@ let rec build_object_init ~scopes cl_table obj params inh_init obj_init cl =
214214
let (inh_init, obj_init) =
215215
build_object_init ~scopes cl_table obj params inh_init obj_init cl
216216
in
217-
(inh_init, transl_apply ~scopes obj_init oexprs Loc_unknown)
217+
(inh_init, transl_apply ~result_layout:Lambda.layout_top ~scopes obj_init oexprs Loc_unknown)
218218
| Tcl_let (rec_flag, defs, vals, cl) ->
219219
let (inh_init, obj_init) =
220220
build_object_init ~scopes cl_table obj (vals @ params)
@@ -485,7 +485,7 @@ let rec transl_class_rebind ~scopes obj_init cl vf =
485485
| Tcl_apply (cl, oexprs) ->
486486
let path, path_lam, obj_init =
487487
transl_class_rebind ~scopes obj_init cl vf in
488-
(path, path_lam, transl_apply ~scopes obj_init oexprs Loc_unknown)
488+
(path, path_lam, transl_apply ~result_layout:Lambda.layout_top ~scopes obj_init oexprs Loc_unknown)
489489
| Tcl_let (rec_flag, defs, _vals, cl) ->
490490
let path, path_lam, obj_init =
491491
transl_class_rebind ~scopes obj_init cl vf in

lambda/translcore.ml

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -402,19 +402,21 @@ and transl_exp0 ~in_new_scope ~scopes e =
402402
let e = { e with exp_desc = Texp_apply(funct, oargs, pos) } in
403403
let position = transl_apply_position pos in
404404
let mode = transl_exp_mode e in
405+
let result_layout = Typeopt.layout e.exp_env e.exp_type in
405406
event_after ~scopes e
406407
(transl_apply ~scopes ~tailcall ~inlined ~specialised ~position ~mode
407-
lam extra_args (of_location ~scopes e.exp_loc))
408+
~result_layout lam extra_args (of_location ~scopes e.exp_loc))
408409
end
409410
| Texp_apply(funct, oargs, position) ->
410411
let tailcall = Translattribute.get_tailcall_attribute funct in
411412
let inlined = Translattribute.get_inlined_attribute funct in
412413
let specialised = Translattribute.get_specialised_attribute funct in
414+
let result_layout = Typeopt.layout e.exp_env e.exp_type in
413415
let e = { e with exp_desc = Texp_apply(funct, oargs, position) } in
414416
let position = transl_apply_position position in
415417
let mode = transl_exp_mode e in
416418
event_after ~scopes e
417-
(transl_apply ~scopes ~tailcall ~inlined ~specialised
419+
(transl_apply ~scopes ~tailcall ~inlined ~specialised ~result_layout
418420
~position ~mode (transl_exp ~scopes funct)
419421
oargs (of_location ~scopes e.exp_loc))
420422
| Texp_match(arg, pat_expr_list, partial) ->
@@ -957,10 +959,10 @@ and transl_apply ~scopes
957959
?(specialised = Default_specialise)
958960
?(position=Rc_normal)
959961
?(mode=alloc_heap)
962+
~result_layout
960963
lam sargs loc
961964
=
962965
let lapply funct args loc pos mode =
963-
let result_layout = Lambda.layout_top in
964966
match funct, pos with
965967
| Lsend((Self | Public) as k, lmet, lobj, [], _, _, _, _), _ ->
966968
Lsend(k, lmet, lobj, args, pos, mode, loc, result_layout)
@@ -1584,9 +1586,9 @@ let transl_scoped_exp ~scopes exp =
15841586
maybe_region_exp exp (transl_scoped_exp ~scopes exp)
15851587

15861588
let transl_apply
1587-
~scopes ?tailcall ?inlined ?specialised ?position ?mode fn args loc =
1588-
maybe_region_layout Lambda.layout_top (transl_apply
1589-
~scopes ?tailcall ?inlined ?specialised ?position ?mode fn args loc)
1589+
~scopes ?tailcall ?inlined ?specialised ?position ?mode ~result_layout fn args loc =
1590+
maybe_region_layout result_layout (transl_apply
1591+
~scopes ?tailcall ?inlined ?specialised ?position ?mode ~result_layout fn args loc)
15901592

15911593
(* Error report *)
15921594

lambda/translcore.mli

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ val transl_apply: scopes:scopes
3131
-> ?specialised:specialise_attribute
3232
-> ?position:region_close
3333
-> ?mode:alloc_mode
34+
-> result_layout:Lambda.layout
3435
-> lambda
3536
-> (arg_label * apply_arg) list
3637
-> scoped_location -> lambda

middle_end/clambda_primitives.ml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -168,3 +168,5 @@ and raise_kind = Lambda.raise_kind =
168168
| Raise_notrace
169169

170170
let equal (x: primitive) (y: primitive) = x = y
171+
172+
let result_layout _p = Lambda.layout_any_value

middle_end/clambda_primitives.mli

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -171,3 +171,5 @@ and raise_kind = Lambda.raise_kind =
171171
| Raise_notrace
172172

173173
val equal : primitive -> primitive -> bool
174+
175+
val result_layout : primitive -> Lambda.layout

middle_end/flambda/augment_specialised_args.ml

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -470,6 +470,7 @@ module Make (T : S) = struct
470470
args =
471471
(Parameter.List.vars wrapper_params) @
472472
spec_args_bound_in_the_wrapper;
473+
result_layout = function_decl.return_layout;
473474
kind = Direct (Closure_id.wrap new_fun_var);
474475
dbg = Debuginfo.none;
475476
reg_close = Rc_normal;
@@ -544,6 +545,7 @@ module Make (T : S) = struct
544545
let new_function_decl =
545546
Flambda.create_function_declaration
546547
~params:wrapper_params
548+
~return_layout:function_decl.return_layout
547549
~alloc_mode
548550
~region:function_decl.region
549551
~body:wrapper_body
@@ -651,6 +653,7 @@ module Make (T : S) = struct
651653
let rewritten_function_decl =
652654
Flambda.create_function_declaration
653655
~params:all_params
656+
~return_layout:function_decl.return_layout
654657
~alloc_mode:function_decl.alloc_mode
655658
~region:function_decl.region
656659
~body:function_decl.body

middle_end/flambda/closure_conversion.ml

Lines changed: 23 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -40,10 +40,10 @@ let add_default_argument_wrappers lam =
4040
match lam with
4141
| Llet (( Strict | Alias | StrictOpt), _k, id,
4242
Lfunction {kind; params; body = fbody; attr; loc;
43-
mode; region}, body) ->
43+
mode; region; return }, body) ->
4444
begin match
4545
Simplif.split_default_wrapper ~id ~kind ~params
46-
~body:fbody ~return:Lambda.layout_top ~attr ~loc ~mode ~region
46+
~body:fbody ~return ~attr ~loc ~mode ~region
4747
with
4848
| [fun_id, def] -> Llet (Alias, Lambda.layout_function, fun_id, def, body)
4949
| [fun_id, def; inner_fun_id, def_inner] ->
@@ -58,9 +58,9 @@ let add_default_argument_wrappers lam =
5858
(List.map
5959
(function
6060
| (id, Lambda.Lfunction {kind; params; body; attr; loc;
61-
mode; region}) ->
61+
mode; region; return }) ->
6262
Simplif.split_default_wrapper ~id ~kind ~params ~body
63-
~return:Lambda.layout_top ~attr ~loc ~mode ~region
63+
~return ~attr ~loc ~mode ~region
6464
| _ -> assert false)
6565
defs)
6666
in
@@ -73,14 +73,15 @@ let add_default_argument_wrappers lam =
7373
(** Generate a wrapper ("stub") function that accepts a tuple argument and
7474
calls another function with arguments extracted in the obvious
7575
manner from the tuple. *)
76-
let tupled_function_call_stub original_params unboxed_version ~closure_bound_var ~region
76+
let tupled_function_call_stub original_params unboxed_version ~closure_bound_var ~region ~return_layout
7777
: Flambda.function_declaration =
7878
let tuple_param_var = Variable.rename unboxed_version in
7979
let params = List.map (fun p -> Variable.rename p) original_params in
8080
let call : Flambda.t =
8181
Apply ({
8282
func = unboxed_version;
8383
args = params;
84+
result_layout = return_layout;
8485
(* CR-someday mshinwell for mshinwell: investigate if there is some
8586
redundancy here (func is also unboxed_version) *)
8687
kind = Direct (Closure_id.wrap unboxed_version);
@@ -104,7 +105,7 @@ let tupled_function_call_stub original_params unboxed_version ~closure_bound_var
104105
let alloc_mode = Lambda.alloc_heap in
105106
let tuple_param = Parameter.wrap tuple_param_var alloc_mode Lambda.layout_block in
106107
Flambda.create_function_declaration ~params:[tuple_param] ~alloc_mode ~region
107-
~body ~stub:true ~dbg:Debuginfo.none ~inline:Default_inline
108+
~body ~stub:true ~dbg:Debuginfo.none ~inline:Default_inline ~return_layout
108109
~specialise:Default_specialise ~is_a_functor:false
109110
~closure_origin:(Closure_origin.create (Closure_id.wrap closure_bound_var))
110111
~poll:Default_poll (* don't propogate attribute to wrappers *)
@@ -215,7 +216,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
215216
initial_value = var;
216217
body;
217218
contents_kind = block_kind })
218-
| Lfunction { kind; params; body; attr; loc; mode; region } ->
219+
| Lfunction { kind; params; body; attr; loc; mode; region; return } ->
219220
let name = Names.anon_fn_with_loc loc in
220221
let closure_bound_var = Variable.create name in
221222
(* CR-soon mshinwell: some of this is now very similar to the let rec case
@@ -224,7 +225,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
224225
let set_of_closures =
225226
let decl =
226227
Function_decl.create ~let_rec_ident:None ~closure_bound_var ~kind ~mode
227-
~region ~params ~body ~attr ~loc
228+
~region ~params ~body ~attr ~loc ~return_layout:return
228229
in
229230
close_functions t env (Function_decls.create [decl])
230231
in
@@ -235,7 +236,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
235236
in
236237
Flambda.create_let set_of_closures_var set_of_closures
237238
(name_expr (Project_closure (project_closure)) ~name)
238-
| Lapply { ap_func; ap_args; ap_loc; ap_region_close; ap_mode;
239+
| Lapply { ap_func; ap_args; ap_loc; ap_region_close; ap_mode; ap_result_layout;
239240
ap_tailcall = _; ap_inlined; ap_specialised; ap_probe; } ->
240241
Lift_code.lifting_helper (close_list t env ap_args)
241242
~evaluation_order:`Right_to_left
@@ -247,6 +248,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
247248
(Apply ({
248249
func = func_var;
249250
args;
251+
result_layout = ap_result_layout;
250252
kind = Indirect;
251253
dbg = Debuginfo.from_location ap_loc;
252254
reg_close = ap_region_close;
@@ -259,22 +261,23 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
259261
| Lletrec (defs, body) ->
260262
let env =
261263
List.fold_right (fun (id, _) env ->
262-
Env.add_var env id (Variable.create_with_same_name_as_ident id) Lambda.layout_top)
264+
Env.add_var env id (Variable.create_with_same_name_as_ident id)
265+
Lambda.layout_letrec)
263266
defs env
264267
in
265268
let function_declarations =
266269
(* Identify any bindings in the [let rec] that are functions. These
267270
will be named after the corresponding identifier in the [let rec]. *)
268271
List.map (function
269272
| (let_rec_ident,
270-
Lambda.Lfunction { kind; params; body; attr; loc; mode; region }) ->
273+
Lambda.Lfunction { kind; params; return; body; attr; loc; mode; region }) ->
271274
let closure_bound_var =
272275
Variable.create_with_same_name_as_ident let_rec_ident
273276
in
274277
let function_declaration =
275278
Function_decl.create ~let_rec_ident:(Some let_rec_ident)
276279
~closure_bound_var ~kind ~mode ~region
277-
~params ~body ~attr ~loc
280+
~params ~body ~attr ~loc ~return_layout:return
278281
in
279282
Some function_declaration
280283
| _ -> None)
@@ -324,7 +327,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
324327
in
325328
Let_rec (defs, close t env body)
326329
end
327-
| Lsend (kind, meth, obj, args, reg_close, mode, loc, _layout) ->
330+
| Lsend (kind, meth, obj, args, reg_close, mode, loc, result_layout) ->
328331
let meth_var = Variable.create Names.meth in
329332
let obj_var = Variable.create Names.obj in
330333
let dbg = Debuginfo.from_location loc in
@@ -335,7 +338,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
335338
~name:Names.send_arg
336339
~create_body:(fun args ->
337340
Send { kind; meth = meth_var; obj = obj_var; args;
338-
dbg; reg_close; mode })))
341+
dbg; reg_close; mode; result_layout })))
339342
| Lprim ((Pdivint Safe | Pmodint Safe
340343
| Pdivbint { is_safe = Safe } | Pmodbint { is_safe = Safe }) as prim,
341344
[arg1; arg2], loc)
@@ -524,7 +527,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
524527
List.map (fun (ident, kind) ->
525528
(Variable.create_with_same_name_as_ident ident, kind)) ids
526529
in
527-
Static_catch (st_exn, List.map fst vars, close t env body,
530+
Static_catch (st_exn, vars, close t env body,
528531
close t (Env.add_vars env (List.map fst ids) vars) handler, kind)
529532
| Ltrywith (body, id, handler, kind) ->
530533
let var = Variable.create_with_same_name_as_ident id in
@@ -589,6 +592,7 @@ and close_functions t external_env function_declarations : Flambda.named =
589592
let dbg = Debuginfo.from_location loc in
590593
let region = Function_decl.region decl in
591594
let params = Function_decl.params decl in
595+
let return_layout = Function_decl.return_layout decl in
592596
(* Create fresh variables for the elements of the closure (cf.
593597
the comment on [Function_decl.closure_env_without_parameters], above).
594598
This induces a renaming on [Function_decl.free_idents]; the results of
@@ -625,7 +629,7 @@ and close_functions t external_env function_declarations : Flambda.named =
625629
let fun_decl =
626630
Flambda.create_function_declaration
627631
~params ~alloc_mode:(Function_decl.mode decl) ~region
628-
~body ~stub ~dbg
632+
~body ~stub ~dbg ~return_layout
629633
~inline:(Function_decl.inline decl)
630634
~specialise:(Function_decl.specialise decl)
631635
~is_a_functor:(Function_decl.is_a_functor decl)
@@ -639,7 +643,7 @@ and close_functions t external_env function_declarations : Flambda.named =
639643
let unboxed_version = Variable.rename closure_bound_var in
640644
let generic_function_stub =
641645
tupled_function_call_stub (List.map fst param_vars) unboxed_version
642-
~closure_bound_var ~region
646+
~closure_bound_var ~region ~return_layout
643647
in
644648
Variable.Map.add unboxed_version fun_decl
645649
(Variable.Map.add closure_bound_var generic_function_stub map)
@@ -679,13 +683,13 @@ and close_list t sb l = List.map (close t sb) l
679683
and close_let_bound_expression t ?let_rec_ident let_bound_var env
680684
(lam : Lambda.lambda) : Flambda.named =
681685
match lam with
682-
| Lfunction { kind; params; body; attr; loc; mode; region } ->
686+
| Lfunction { kind; params; return; body; attr; loc; mode; region } ->
683687
(* Ensure that [let] and [let rec]-bound functions have appropriate
684688
names. *)
685689
let closure_bound_var = Variable.rename let_bound_var in
686690
let decl =
687691
Function_decl.create ~let_rec_ident ~closure_bound_var ~kind ~mode ~region
688-
~params ~body ~attr ~loc
692+
~params ~body ~attr ~loc ~return_layout:return
689693
in
690694
let set_of_closures_var = Variable.rename let_bound_var in
691695
let set_of_closures =

middle_end/flambda/closure_conversion_aux.ml

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -93,14 +93,15 @@ module Function_decls = struct
9393
mode : Lambda.alloc_mode;
9494
region : bool;
9595
params : (Ident.t * Lambda.layout) list;
96+
return_layout : Lambda.layout;
9697
body : Lambda.lambda;
9798
free_idents_of_body : Ident.Set.t;
9899
attr : Lambda.function_attribute;
99100
loc : Lambda.scoped_location
100101
}
101102

102103
let create ~let_rec_ident ~closure_bound_var ~kind ~mode ~region
103-
~params ~body ~attr ~loc =
104+
~params ~return_layout ~body ~attr ~loc =
104105
let let_rec_ident =
105106
match let_rec_ident with
106107
| None -> Ident.create_local "unnamed_function"
@@ -112,6 +113,7 @@ module Function_decls = struct
112113
mode;
113114
region;
114115
params;
116+
return_layout;
115117
body;
116118
free_idents_of_body = Lambda.free_variables body;
117119
attr;
@@ -124,6 +126,7 @@ module Function_decls = struct
124126
let mode t = t.mode
125127
let region t = t.region
126128
let params t = t.params
129+
let return_layout t = t.return_layout
127130
let body t = t.body
128131
let free_idents t = t.free_idents_of_body
129132
let inline t = t.attr.inline

middle_end/flambda/closure_conversion_aux.mli

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -61,6 +61,7 @@ module Function_decls : sig
6161
-> mode:Lambda.alloc_mode
6262
-> region:bool
6363
-> params:(Ident.t * Lambda.layout) list
64+
-> return_layout:Lambda.layout
6465
-> body:Lambda.lambda
6566
-> attr:Lambda.function_attribute
6667
-> loc:Lambda.scoped_location
@@ -72,6 +73,7 @@ module Function_decls : sig
7273
val mode : t -> Lambda.alloc_mode
7374
val region : t -> bool
7475
val params : t -> (Ident.t * Lambda.layout) list
76+
val return_layout : t -> Lambda.layout
7577
val body : t -> Lambda.lambda
7678
val inline : t -> Lambda.inline_attribute
7779
val specialise : t -> Lambda.specialise_attribute

0 commit comments

Comments
 (0)