Skip to content

Commit 6739d76

Browse files
authored
Flambda2 layouts: Fix partial application wrapper result arity (#1551)
* Fix partial application wrapper result arity * fmt
1 parent 8f66a0b commit 6739d76

File tree

1 file changed

+17
-13
lines changed

1 file changed

+17
-13
lines changed

middle_end/flambda2/from_lambda/closure_conversion.ml

Lines changed: 17 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -2017,7 +2017,7 @@ let close_let_rec acc env ~function_declarations
20172017
named ~body
20182018

20192019
let wrap_partial_application acc env apply_continuation (apply : IR.apply)
2020-
approx ~provided ~missing_arity ~first_complex_local_param
2020+
approx ~provided ~missing_arity ~result_arity ~first_complex_local_param
20212021
~contains_no_escaping_local_allocs =
20222022
(* In case of partial application, creates a wrapping function from scratch to
20232023
allow inlining and lifting *)
@@ -2053,7 +2053,8 @@ let wrap_partial_application acc env apply_continuation (apply : IR.apply)
20532053
continuation = return_continuation;
20542054
exn_continuation;
20552055
inlined = Lambda.Default_inlined;
2056-
mode = result_mode
2056+
mode = result_mode;
2057+
return_arity = result_arity
20572058
}
20582059
(Some approx) ~replace_region:None
20592060
in
@@ -2096,11 +2097,10 @@ let wrap_partial_application acc env apply_continuation (apply : IR.apply)
20962097
Flambda_arity.cardinal missing_arity
20972098
- first_complex_local_param
20982099
})
2099-
~params ~return:apply.return_arity ~return_continuation
2100-
~exn_continuation ~my_region:apply.region ~body:fbody ~attr
2101-
~loc:apply.loc ~free_idents_of_body ~closure_alloc_mode
2102-
~first_complex_local_param ~contains_no_escaping_local_allocs
2103-
Recursive.Non_recursive ]
2100+
~params ~return:result_arity ~return_continuation ~exn_continuation
2101+
~my_region:apply.region ~body:fbody ~attr ~loc:apply.loc
2102+
~free_idents_of_body ~closure_alloc_mode ~first_complex_local_param
2103+
~contains_no_escaping_local_allocs Recursive.Non_recursive ]
21042104
in
21052105
let body acc env =
21062106
let arg = find_simple_from_id env wrapper_id in
@@ -2217,7 +2217,8 @@ type call_args_split =
22172217
| Exact of IR.simple list
22182218
| Partial_app of
22192219
{ provided : IR.simple list;
2220-
missing_arity : Flambda_arity.t
2220+
missing_arity : Flambda_arity.t;
2221+
result_arity : Flambda_arity.t
22212222
}
22222223
| Over_app of
22232224
{ full : IR.simple list;
@@ -2234,6 +2235,7 @@ let close_apply acc env (apply : IR.apply) : Expr_with_acc.t =
22342235
let metadata = Code_or_metadata.code_metadata code in
22352236
Some
22362237
( Code_metadata.params_arity metadata,
2238+
Code_metadata.result_arity metadata,
22372239
Code_metadata.is_tupled metadata,
22382240
Code_metadata.first_complex_local_param metadata,
22392241
Code_metadata.contains_no_escaping_local_allocs metadata )
@@ -2250,14 +2252,15 @@ let close_apply acc env (apply : IR.apply) : Expr_with_acc.t =
22502252
match code_info with
22512253
| None -> close_exact_or_unknown_apply acc env apply None ~replace_region:None
22522254
| Some
2253-
( arity,
2255+
( params_arity,
2256+
result_arity,
22542257
is_tupled,
22552258
first_complex_local_param,
22562259
contains_no_escaping_local_allocs ) -> (
22572260
let acc, args_with_arities = find_simples_and_arity acc env apply.args in
22582261
let args_arity = List.map snd args_with_arities in
22592262
let split_args =
2260-
let arity = Flambda_arity.to_list arity in
2263+
let arity = Flambda_arity.to_list params_arity in
22612264
let split args arity =
22622265
let rec cut n l =
22632266
if n <= 0
@@ -2278,7 +2281,8 @@ let close_apply acc env (apply : IR.apply) : Expr_with_acc.t =
22782281
let _provided_arity, missing_arity = cut args_l arity in
22792282
Partial_app
22802283
{ provided = args;
2281-
missing_arity = Flambda_arity.create missing_arity
2284+
missing_arity = Flambda_arity.create missing_arity;
2285+
result_arity
22822286
}
22832287
else
22842288
let full, remaining = cut arity_l args in
@@ -2301,7 +2305,7 @@ let close_apply acc env (apply : IR.apply) : Expr_with_acc.t =
23012305
close_exact_or_unknown_apply acc env
23022306
{ apply with args; continuation = apply.continuation }
23032307
(Some approx) ~replace_region:None
2304-
| Partial_app { provided; missing_arity } ->
2308+
| Partial_app { provided; missing_arity; result_arity } ->
23052309
(match apply.inlined with
23062310
| Always_inlined | Unroll _ ->
23072311
Location.prerr_warning
@@ -2311,7 +2315,7 @@ let close_apply acc env (apply : IR.apply) : Expr_with_acc.t =
23112315
inlined_attribute_on_partial_application_msg Inlined))
23122316
| Never_inlined | Hint_inlined | Default_inlined -> ());
23132317
wrap_partial_application acc env apply.continuation apply approx ~provided
2314-
~missing_arity ~first_complex_local_param
2318+
~missing_arity ~result_arity ~first_complex_local_param
23152319
~contains_no_escaping_local_allocs
23162320
| Over_app { full; remaining; remaining_arity } ->
23172321
let full_args_call apply_continuation ~region acc =

0 commit comments

Comments
 (0)