Disallow local recursive non-functions (#30)

Author: stedolan

lambda/translcore.ml

@@ -957,6 +957,11 @@ and transl_let ~scopes ?(in_structure=false) ?(mode=Alloc_heap) rec_flag
         let lam =
           Translattribute.add_function_attributes lam vb_loc vb_attributes
         in
+        begin match transl_alloc_mode expr.exp_mode, lam with
+        | Alloc_heap, _ -> ()
+        | Alloc_local, Lfunction _ -> ()
+        | _ -> Misc.fatal_error "transl_let: local recursive non-function"
+        end;
         (id, lam) in
       let lam_bds = List.map2 transl_case pat_expr_list idlist in
       fun body -> maybe_region mode bound_modes (Lletrec(lam_bds, body))

testsuite/tests/typing-local/local.ml

@@ -721,6 +721,34 @@ Line 3, characters 31-32:
 Error: The value x is local, so cannot be used inside a closure that might escape
 |}]
 
+(* Don't escape in non-function 'let rec' bindings *)
+let foo (local_ x) =
+  (* fine, local recursive function *)
+  let rec g () = let _ = x in h (); () and h () = g (); () in
+  g (); ()
+[%%expect {|
+val foo : local_ 'a -> unit = <fun>
+|}]
+
+let foo (local_ x) =
+  (* fine, local non-recursive binding *)
+  let _ = (x, 1) in
+  1
+[%%expect {|
+val foo : local_ 'a -> int = <fun>
+|}]
+
+let foo (local_ x) =
+  (* not fine, local recursive non-function (needs caml_alloc_dummy) *)
+  let rec g = x :: g in
+  let _ = g in ()
+[%%expect {|
+Line 3, characters 14-15:
+3 |   let rec g = x :: g in
+                  ^
+Error: The value x is local, so cannot be used here as it might escape
+|}]
+
 (* Cannot pass local values to tail calls *)
 
 let print (local_ x) = print_string !x

typing/typecore.ml

@@ -5072,10 +5072,23 @@ and type_let
     | _ ->
         false
   in
+  let rec sexp_is_fun e =
+    match e.pexp_desc with
+    | Pexp_fun _ | Pexp_function _ -> true
+    | Pexp_constraint (e, _)
+    | Pexp_newtype (_, e)
+    | Pexp_apply
+      ({ pexp_desc = Pexp_extension({txt = "stack"}, PStr []) },
+       [Nolabel, e]) -> sexp_is_fun e
+    | _ -> false
+  in
+  let vb_is_fun { pvb_expr = sexp; _ } = sexp_is_fun sexp in
+  let entirely_functions = List.for_all vb_is_fun spat_sexp_list in
   let check = if is_fake_let then check_strict else check in
   let rec_mode_var =
     match rec_flag with
-    | Recursive -> Some (Alloc_mode.newvar ())
+    | Recursive when entirely_functions -> Some (Alloc_mode.newvar ())
+    | Recursive -> Some alloc_heap
     | Nonrecursive -> None
   in
   let spatl =
@@ -5140,14 +5153,9 @@ and type_let
   in
   (* Only bind pattern variables after generalizing *)
   List.iter (fun f -> f()) force;
-  let sexp_is_fun { pvb_expr = sexp; _ } =
-    match sexp.pexp_desc with
-    | Pexp_fun _ | Pexp_function _ -> true
-    | _ -> false
-  in
   let exp_env =
     if is_recursive then new_env
-    else if List.for_all sexp_is_fun spat_sexp_list
+    else if entirely_functions
     then begin
       (* Add ghost bindings to help detecting missing "rec" keywords.