@@ -40,10 +40,10 @@ let add_default_argument_wrappers lam =
40
40
match lam with
41
41
| Llet (( Strict | Alias | StrictOpt ), _k, id,
42
42
Lfunction {kind; params; body = fbody; attr; loc;
43
- mode; region}, body) ->
43
+ mode; region; return }, body) ->
44
44
begin match
45
45
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
47
47
with
48
48
| [fun_id, def] -> Llet (Alias , Lambda. layout_function, fun_id, def, body)
49
49
| [fun_id, def; inner_fun_id, def_inner] ->
@@ -58,9 +58,9 @@ let add_default_argument_wrappers lam =
58
58
(List. map
59
59
(function
60
60
| (id, Lambda. Lfunction {kind; params; body; attr; loc;
61
- mode; region}) ->
61
+ mode; region; return }) ->
62
62
Simplif. split_default_wrapper ~id ~kind ~params ~body
63
- ~return: Lambda. layout_top ~attr ~loc ~mode ~region
63
+ ~return ~attr ~loc ~mode ~region
64
64
| _ -> assert false )
65
65
defs)
66
66
in
@@ -73,14 +73,15 @@ let add_default_argument_wrappers lam =
73
73
(* * Generate a wrapper ("stub") function that accepts a tuple argument and
74
74
calls another function with arguments extracted in the obvious
75
75
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
77
77
: Flambda.function_declaration =
78
78
let tuple_param_var = Variable. rename unboxed_version in
79
79
let params = List. map (fun p -> Variable. rename p) original_params in
80
80
let call : Flambda.t =
81
81
Apply ({
82
82
func = unboxed_version;
83
83
args = params;
84
+ result_layout = return_layout;
84
85
(* CR-someday mshinwell for mshinwell: investigate if there is some
85
86
redundancy here (func is also unboxed_version) *)
86
87
kind = Direct (Closure_id. wrap unboxed_version);
@@ -104,7 +105,7 @@ let tupled_function_call_stub original_params unboxed_version ~closure_bound_var
104
105
let alloc_mode = Lambda. alloc_heap in
105
106
let tuple_param = Parameter. wrap tuple_param_var alloc_mode Lambda. layout_block in
106
107
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
108
109
~specialise: Default_specialise ~is_a_functor: false
109
110
~closure_origin: (Closure_origin. create (Closure_id. wrap closure_bound_var))
110
111
~poll: Default_poll (* don't propogate attribute to wrappers *)
@@ -215,7 +216,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
215
216
initial_value = var;
216
217
body;
217
218
contents_kind = block_kind })
218
- | Lfunction { kind; params; body; attr; loc; mode; region } ->
219
+ | Lfunction { kind; params; body; attr; loc; mode; region; return } ->
219
220
let name = Names. anon_fn_with_loc loc in
220
221
let closure_bound_var = Variable. create name in
221
222
(* 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 =
224
225
let set_of_closures =
225
226
let decl =
226
227
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
228
229
in
229
230
close_functions t env (Function_decls. create [decl])
230
231
in
@@ -235,7 +236,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
235
236
in
236
237
Flambda. create_let set_of_closures_var set_of_closures
237
238
(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;
239
240
ap_tailcall = _; ap_inlined; ap_specialised; ap_probe; } ->
240
241
Lift_code. lifting_helper (close_list t env ap_args)
241
242
~evaluation_order: `Right_to_left
@@ -247,6 +248,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
247
248
(Apply ({
248
249
func = func_var;
249
250
args;
251
+ result_layout = ap_result_layout;
250
252
kind = Indirect ;
251
253
dbg = Debuginfo. from_location ap_loc;
252
254
reg_close = ap_region_close;
@@ -259,22 +261,23 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
259
261
| Lletrec (defs , body ) ->
260
262
let env =
261
263
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)
263
266
defs env
264
267
in
265
268
let function_declarations =
266
269
(* Identify any bindings in the [let rec] that are functions. These
267
270
will be named after the corresponding identifier in the [let rec]. *)
268
271
List. map (function
269
272
| (let_rec_ident,
270
- Lambda. Lfunction { kind; params; body; attr; loc; mode; region }) ->
273
+ Lambda. Lfunction { kind; params; return; body; attr; loc; mode; region }) ->
271
274
let closure_bound_var =
272
275
Variable. create_with_same_name_as_ident let_rec_ident
273
276
in
274
277
let function_declaration =
275
278
Function_decl. create ~let_rec_ident: (Some let_rec_ident)
276
279
~closure_bound_var ~kind ~mode ~region
277
- ~params ~body ~attr ~loc
280
+ ~params ~body ~attr ~loc ~return_layout: return
278
281
in
279
282
Some function_declaration
280
283
| _ -> None )
@@ -324,7 +327,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
324
327
in
325
328
Let_rec (defs, close t env body)
326
329
end
327
- | Lsend (kind , meth , obj , args , reg_close , mode , loc , _layout ) ->
330
+ | Lsend (kind , meth , obj , args , reg_close , mode , loc , result_layout ) ->
328
331
let meth_var = Variable. create Names. meth in
329
332
let obj_var = Variable. create Names. obj in
330
333
let dbg = Debuginfo. from_location loc in
@@ -335,7 +338,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
335
338
~name: Names. send_arg
336
339
~create_body: (fun args ->
337
340
Send { kind; meth = meth_var; obj = obj_var; args;
338
- dbg; reg_close; mode })))
341
+ dbg; reg_close; mode; result_layout })))
339
342
| Lprim ((Pdivint Safe | Pmodint Safe
340
343
| Pdivbint { is_safe = Safe } | Pmodbint { is_safe = Safe }) as prim,
341
344
[arg1; arg2], loc)
@@ -524,7 +527,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
524
527
List. map (fun (ident , kind ) ->
525
528
(Variable. create_with_same_name_as_ident ident, kind)) ids
526
529
in
527
- Static_catch (st_exn, List. map fst vars, close t env body,
530
+ Static_catch (st_exn, vars, close t env body,
528
531
close t (Env. add_vars env (List. map fst ids) vars) handler, kind)
529
532
| Ltrywith (body , id , handler , kind ) ->
530
533
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 =
589
592
let dbg = Debuginfo. from_location loc in
590
593
let region = Function_decl. region decl in
591
594
let params = Function_decl. params decl in
595
+ let return_layout = Function_decl. return_layout decl in
592
596
(* Create fresh variables for the elements of the closure (cf.
593
597
the comment on [Function_decl.closure_env_without_parameters], above).
594
598
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 =
625
629
let fun_decl =
626
630
Flambda. create_function_declaration
627
631
~params ~alloc_mode: (Function_decl. mode decl) ~region
628
- ~body ~stub ~dbg
632
+ ~body ~stub ~dbg ~return_layout
629
633
~inline: (Function_decl. inline decl)
630
634
~specialise: (Function_decl. specialise decl)
631
635
~is_a_functor: (Function_decl. is_a_functor decl)
@@ -639,7 +643,7 @@ and close_functions t external_env function_declarations : Flambda.named =
639
643
let unboxed_version = Variable. rename closure_bound_var in
640
644
let generic_function_stub =
641
645
tupled_function_call_stub (List. map fst param_vars) unboxed_version
642
- ~closure_bound_var ~region
646
+ ~closure_bound_var ~region ~return_layout
643
647
in
644
648
Variable.Map. add unboxed_version fun_decl
645
649
(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
679
683
and close_let_bound_expression t ?let_rec_ident let_bound_var env
680
684
(lam : Lambda.lambda ) : Flambda.named =
681
685
match lam with
682
- | Lfunction { kind; params; body; attr; loc; mode; region } ->
686
+ | Lfunction { kind; params; return; body; attr; loc; mode; region } ->
683
687
(* Ensure that [let] and [let rec]-bound functions have appropriate
684
688
names. *)
685
689
let closure_bound_var = Variable. rename let_bound_var in
686
690
let decl =
687
691
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
689
693
in
690
694
let set_of_closures_var = Variable. rename let_bound_var in
691
695
let set_of_closures =
0 commit comments