Skip to content

Commit fca94c4

Browse files
authored
Register allocations for Omitted parameter closures (#47)
1 parent 103b139 commit fca94c4

File tree

3 files changed

+5
-4
lines changed

3 files changed

+5
-4
lines changed

lambda/printlambda.ml

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -525,7 +525,7 @@ let rec lam ppf = function
525525
apply_tailcall_attribute ap.ap_tailcall
526526
apply_inlined_attribute ap.ap_inlined
527527
apply_specialised_attribute ap.ap_specialised
528-
| Lfunction{kind; params; return; body; attr; ret_mode} ->
528+
| Lfunction{kind; params; return; body; attr; mode; ret_mode} ->
529529
let pr_params ppf params =
530530
match kind with
531531
| Curried {nlocal} ->
@@ -543,7 +543,8 @@ let rec lam ppf = function
543543
value_kind ppf k)
544544
params;
545545
fprintf ppf ")" in
546-
fprintf ppf "@[<2>(function%a@ %a%a%a)@]" pr_params params
546+
fprintf ppf "@[<2>(function%s%a@ %a%a%a)@]"
547+
(alloc_kind mode) pr_params params
547548
function_attribute attr return_kind (ret_mode, return) lam body
548549
| (Llet _ | Lregion(Llet _)) as expr ->
549550
let kind = function

testsuite/tests/typing-local/alloc.ml

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -181,8 +181,7 @@ let currylocal1 n =
181181
let currylocal2 n =
182182
ignore_local (Sys.opaque_identity local_arg_fn ~a:n); ()
183183
let currylocal3 n =
184-
(* FIXME broken, see Translcore.build_apply
185-
ignore_local (local_arg_fn ~b:n); *)
184+
ignore_local (local_arg_fn ~b:n);
186185
()
187186

188187
let partprim1 n =

typing/typecore.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2601,6 +2601,7 @@ let type_omitted_parameters expected_mode env ty_ret mode_ret args =
26012601
let closed_args = new_closed_args @ closed_args in
26022602
let open_args = [] in
26032603
let mode_closure = Alloc_mode.join (mode_fun :: closed_args) in
2604+
register_allocation_mode mode_closure;
26042605
let arg = Omitted { mode_closure; mode_arg; mode_ret } in
26052606
let args = (lbl, arg) :: args in
26062607
(ty_ret, mode_closure, open_args, closed_args, args))

0 commit comments

Comments
 (0)