@@ -2017,7 +2017,7 @@ let close_let_rec acc env ~function_declarations
2017
2017
named ~body
2018
2018
2019
2019
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
2021
2021
~contains_no_escaping_local_allocs =
2022
2022
(* In case of partial application, creates a wrapping function from scratch to
2023
2023
allow inlining and lifting *)
@@ -2053,7 +2053,8 @@ let wrap_partial_application acc env apply_continuation (apply : IR.apply)
2053
2053
continuation = return_continuation;
2054
2054
exn_continuation;
2055
2055
inlined = Lambda. Default_inlined ;
2056
- mode = result_mode
2056
+ mode = result_mode;
2057
+ return_arity = result_arity
2057
2058
}
2058
2059
(Some approx) ~replace_region: None
2059
2060
in
@@ -2096,11 +2097,10 @@ let wrap_partial_application acc env apply_continuation (apply : IR.apply)
2096
2097
Flambda_arity. cardinal missing_arity
2097
2098
- first_complex_local_param
2098
2099
})
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 ]
2104
2104
in
2105
2105
let body acc env =
2106
2106
let arg = find_simple_from_id env wrapper_id in
@@ -2217,7 +2217,8 @@ type call_args_split =
2217
2217
| Exact of IR .simple list
2218
2218
| Partial_app of
2219
2219
{ provided : IR .simple list ;
2220
- missing_arity : Flambda_arity .t
2220
+ missing_arity : Flambda_arity .t ;
2221
+ result_arity : Flambda_arity .t
2221
2222
}
2222
2223
| Over_app of
2223
2224
{ full : IR .simple list ;
@@ -2234,6 +2235,7 @@ let close_apply acc env (apply : IR.apply) : Expr_with_acc.t =
2234
2235
let metadata = Code_or_metadata. code_metadata code in
2235
2236
Some
2236
2237
( Code_metadata. params_arity metadata,
2238
+ Code_metadata. result_arity metadata,
2237
2239
Code_metadata. is_tupled metadata,
2238
2240
Code_metadata. first_complex_local_param metadata,
2239
2241
Code_metadata. contains_no_escaping_local_allocs metadata )
@@ -2250,14 +2252,15 @@ let close_apply acc env (apply : IR.apply) : Expr_with_acc.t =
2250
2252
match code_info with
2251
2253
| None -> close_exact_or_unknown_apply acc env apply None ~replace_region: None
2252
2254
| Some
2253
- ( arity,
2255
+ ( params_arity,
2256
+ result_arity,
2254
2257
is_tupled,
2255
2258
first_complex_local_param,
2256
2259
contains_no_escaping_local_allocs ) -> (
2257
2260
let acc, args_with_arities = find_simples_and_arity acc env apply.args in
2258
2261
let args_arity = List. map snd args_with_arities in
2259
2262
let split_args =
2260
- let arity = Flambda_arity. to_list arity in
2263
+ let arity = Flambda_arity. to_list params_arity in
2261
2264
let split args arity =
2262
2265
let rec cut n l =
2263
2266
if n < = 0
@@ -2278,7 +2281,8 @@ let close_apply acc env (apply : IR.apply) : Expr_with_acc.t =
2278
2281
let _provided_arity, missing_arity = cut args_l arity in
2279
2282
Partial_app
2280
2283
{ provided = args;
2281
- missing_arity = Flambda_arity. create missing_arity
2284
+ missing_arity = Flambda_arity. create missing_arity;
2285
+ result_arity
2282
2286
}
2283
2287
else
2284
2288
let full, remaining = cut arity_l args in
@@ -2301,7 +2305,7 @@ let close_apply acc env (apply : IR.apply) : Expr_with_acc.t =
2301
2305
close_exact_or_unknown_apply acc env
2302
2306
{ apply with args; continuation = apply.continuation }
2303
2307
(Some approx) ~replace_region: None
2304
- | Partial_app { provided; missing_arity } ->
2308
+ | Partial_app { provided; missing_arity; result_arity } ->
2305
2309
(match apply.inlined with
2306
2310
| Always_inlined | Unroll _ ->
2307
2311
Location. prerr_warning
@@ -2311,7 +2315,7 @@ let close_apply acc env (apply : IR.apply) : Expr_with_acc.t =
2311
2315
inlined_attribute_on_partial_application_msg Inlined ))
2312
2316
| Never_inlined | Hint_inlined | Default_inlined -> () );
2313
2317
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
2315
2319
~contains_no_escaping_local_allocs
2316
2320
| Over_app { full; remaining; remaining_arity } ->
2317
2321
let full_args_call apply_continuation ~region acc =
0 commit comments