Skip to content

Commit a686de9

Browse files
authored
flambda-backend: Properly handle regions around recursive definitions (#2601)
* Properly handle regions around recursive definitions * Update tests: add reference output and original minimal example
1 parent 3956aa4 commit a686de9

File tree

3 files changed

+29
-1
lines changed

3 files changed

+29
-1
lines changed

lambda/value_rec_compiler.ml

+9-1
Original file line numberDiff line numberDiff line change
@@ -662,6 +662,15 @@ let rec split_static_function lfun block_var local_idents lam :
662662
| Levent (lam, lev) ->
663663
let+ lam = split_static_function lfun block_var local_idents lam in
664664
Levent (lam, lev)
665+
| Lregion (lam, layout_fun) ->
666+
(* The type-checker forbids recursive values from being allocated on the
667+
stack, so this region is only here to collect temporary allocations.
668+
In particular the function itself does not capture any stack-allocated
669+
variables, so we can lift it out of the region. *)
670+
let+ lam = split_static_function lfun block_var local_idents lam in
671+
(* The new expression returns the closure block instead of the function *)
672+
ignore layout_fun;
673+
Lregion (lam, layout_block)
665674
| Lmutvar _
666675
| Lconst _
667676
| Lapply _
@@ -671,7 +680,6 @@ let rec split_static_function lfun block_var local_idents lam :
671680
| Lassign _
672681
| Lsend _
673682
| Lifused _
674-
| Lregion _
675683
| Lexclave _ ->
676684
Misc.fatal_errorf
677685
"letrec binding is not a static function:@ lfun=%a@ lam=%a"
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
(* TEST *)
2+
3+
(* Recursive values are not allowed to be stack-allocated, but their
4+
defining expressions are allowed to make allocations on the stack.
5+
This can introduce a region around the whole definition. *)
6+
7+
let rec f =
8+
let p = local_ (fun msg -> print_string msg) in
9+
p "hello, ";
10+
p "world!";
11+
print_newline ();
12+
fun x -> f x
13+
14+
(* Original bug report: unused function *)
15+
let rec foo =
16+
let _f x = x, foo in
17+
function
18+
| None -> foo None
19+
| Some x -> x
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
hello, world!

0 commit comments

Comments
 (0)