Skip to content

Commit c936b19

Browse files
committed
Disallow local recursive non-functions (#30)
1 parent c7a193a commit c936b19

File tree

3 files changed

+48
-7
lines changed

3 files changed

+48
-7
lines changed

lambda/translcore.ml

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -957,6 +957,11 @@ and transl_let ~scopes ?(in_structure=false) ?(mode=Alloc_heap) rec_flag
957957
let lam =
958958
Translattribute.add_function_attributes lam vb_loc vb_attributes
959959
in
960+
begin match transl_alloc_mode expr.exp_mode, lam with
961+
| Alloc_heap, _ -> ()
962+
| Alloc_local, Lfunction _ -> ()
963+
| _ -> Misc.fatal_error "transl_let: local recursive non-function"
964+
end;
960965
(id, lam) in
961966
let lam_bds = List.map2 transl_case pat_expr_list idlist in
962967
fun body -> maybe_region mode bound_modes (Lletrec(lam_bds, body))

testsuite/tests/typing-local/local.ml

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -721,6 +721,34 @@ Line 3, characters 31-32:
721721
Error: The value x is local, so cannot be used inside a closure that might escape
722722
|}]
723723

724+
(* Don't escape in non-function 'let rec' bindings *)
725+
let foo (local_ x) =
726+
(* fine, local recursive function *)
727+
let rec g () = let _ = x in h (); () and h () = g (); () in
728+
g (); ()
729+
[%%expect {|
730+
val foo : local_ 'a -> unit = <fun>
731+
|}]
732+
733+
let foo (local_ x) =
734+
(* fine, local non-recursive binding *)
735+
let _ = (x, 1) in
736+
1
737+
[%%expect {|
738+
val foo : local_ 'a -> int = <fun>
739+
|}]
740+
741+
let foo (local_ x) =
742+
(* not fine, local recursive non-function (needs caml_alloc_dummy) *)
743+
let rec g = x :: g in
744+
let _ = g in ()
745+
[%%expect {|
746+
Line 3, characters 14-15:
747+
3 | let rec g = x :: g in
748+
^
749+
Error: The value x is local, so cannot be used here as it might escape
750+
|}]
751+
724752
(* Cannot pass local values to tail calls *)
725753

726754
let print (local_ x) = print_string !x

typing/typecore.ml

Lines changed: 15 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -5072,10 +5072,23 @@ and type_let
50725072
| _ ->
50735073
false
50745074
in
5075+
let rec sexp_is_fun e =
5076+
match e.pexp_desc with
5077+
| Pexp_fun _ | Pexp_function _ -> true
5078+
| Pexp_constraint (e, _)
5079+
| Pexp_newtype (_, e)
5080+
| Pexp_apply
5081+
({ pexp_desc = Pexp_extension({txt = "stack"}, PStr []) },
5082+
[Nolabel, e]) -> sexp_is_fun e
5083+
| _ -> false
5084+
in
5085+
let vb_is_fun { pvb_expr = sexp; _ } = sexp_is_fun sexp in
5086+
let entirely_functions = List.for_all vb_is_fun spat_sexp_list in
50755087
let check = if is_fake_let then check_strict else check in
50765088
let rec_mode_var =
50775089
match rec_flag with
5078-
| Recursive -> Some (Alloc_mode.newvar ())
5090+
| Recursive when entirely_functions -> Some (Alloc_mode.newvar ())
5091+
| Recursive -> Some alloc_heap
50795092
| Nonrecursive -> None
50805093
in
50815094
let spatl =
@@ -5140,14 +5153,9 @@ and type_let
51405153
in
51415154
(* Only bind pattern variables after generalizing *)
51425155
List.iter (fun f -> f()) force;
5143-
let sexp_is_fun { pvb_expr = sexp; _ } =
5144-
match sexp.pexp_desc with
5145-
| Pexp_fun _ | Pexp_function _ -> true
5146-
| _ -> false
5147-
in
51485156
let exp_env =
51495157
if is_recursive then new_env
5150-
else if List.for_all sexp_is_fun spat_sexp_list
5158+
else if entirely_functions
51515159
then begin
51525160
(* Add ghost bindings to help detecting missing "rec" keywords.
51535161

0 commit comments

Comments
 (0)