File tree Expand file tree Collapse file tree 3 files changed +48
-7
lines changed
testsuite/tests/typing-local Expand file tree Collapse file tree 3 files changed +48
-7
lines changed Original file line number Diff line number Diff line change @@ -957,6 +957,11 @@ and transl_let ~scopes ?(in_structure=false) ?(mode=Alloc_heap) rec_flag
957
957
let lam =
958
958
Translattribute. add_function_attributes lam vb_loc vb_attributes
959
959
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 ;
960
965
(id, lam) in
961
966
let lam_bds = List. map2 transl_case pat_expr_list idlist in
962
967
fun body -> maybe_region mode bound_modes (Lletrec (lam_bds, body))
Original file line number Diff line number Diff line change @@ -721,6 +721,34 @@ Line 3, characters 31-32:
721
721
Error : The value x is local, so cannot be used inside a closure that might escape
722
722
| }]
723
723
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
+
724
752
(* Cannot pass local values to tail calls *)
725
753
726
754
let print (local_ x ) = print_string ! x
Original file line number Diff line number Diff line change @@ -5072,10 +5072,23 @@ and type_let
5072
5072
| _ ->
5073
5073
false
5074
5074
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
5075
5087
let check = if is_fake_let then check_strict else check in
5076
5088
let rec_mode_var =
5077
5089
match rec_flag with
5078
- | Recursive -> Some (Alloc_mode. newvar () )
5090
+ | Recursive when entirely_functions -> Some (Alloc_mode. newvar () )
5091
+ | Recursive -> Some alloc_heap
5079
5092
| Nonrecursive -> None
5080
5093
in
5081
5094
let spatl =
@@ -5140,14 +5153,9 @@ and type_let
5140
5153
in
5141
5154
(* Only bind pattern variables after generalizing *)
5142
5155
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
5148
5156
let exp_env =
5149
5157
if is_recursive then new_env
5150
- else if List. for_all sexp_is_fun spat_sexp_list
5158
+ else if entirely_functions
5151
5159
then begin
5152
5160
(* Add ghost bindings to help detecting missing "rec" keywords.
5153
5161
You can’t perform that action at this time.
0 commit comments