diff --git a/chamelon/compat.jst.ml b/chamelon/compat.jst.ml index 621b9649f6c..a3647d267b5 100644 --- a/chamelon/compat.jst.ml +++ b/chamelon/compat.jst.ml @@ -88,7 +88,6 @@ type texp_function = { type texp_function_identifier = { alloc_mode : Alloc.r; ret_sort : Jkind.sort; - region : bool; ret_mode : Alloc.l; zero_alloc : Zero_alloc.t; } @@ -116,7 +115,6 @@ let texp_function_defaults = alloc_mode = Alloc.disallow_left Alloc.legacy; ret_sort = Jkind.Sort.value; ret_mode = Alloc.disallow_right Alloc.legacy; - region = false; zero_alloc = Zero_alloc.default; } @@ -170,7 +168,6 @@ let mkTexp_function ?(id = texp_function_defaults) fc_loc = Location.none; }); alloc_mode = id.alloc_mode; - region = id.region; ret_sort = id.ret_sort; ret_mode = id.ret_mode; zero_alloc = id.zero_alloc; @@ -225,8 +222,8 @@ let view_texp (e : expression_desc) = | Texp_tuple (args, mode) -> let labels, args = List.split args in Texp_tuple (args, (labels, mode)) - | Texp_function - { params; body; alloc_mode; region; ret_sort; ret_mode; zero_alloc } -> + | Texp_function { params; body; alloc_mode; ret_sort; ret_mode; zero_alloc } + -> let params = List.map (fun param -> @@ -273,8 +270,7 @@ let view_texp (e : expression_desc) = } in Texp_function - ( { params; body }, - { alloc_mode; region; ret_sort; ret_mode; zero_alloc } ) + ({ params; body }, { alloc_mode; ret_sort; ret_mode; zero_alloc }) | Texp_sequence (e1, sort, e2) -> Texp_sequence (e1, e2, sort) | Texp_match (e, sort, cases, partial) -> Texp_match (e, cases, partial, sort) | _ -> O e diff --git a/ocaml/lambda/tmc.ml b/ocaml/lambda/tmc.ml index d70afafa6d0..f66729faf7b 100644 --- a/ocaml/lambda/tmc.ml +++ b/ocaml/lambda/tmc.ml @@ -36,7 +36,7 @@ type ambiguous_arguments = { type error = | Ambiguous_constructor_arguments of ambiguous_arguments - | Tmc_without_region + | Tmc_local_returning exception Error of Location.t * error @@ -564,10 +564,12 @@ let llets lk vk bindings body = let find_candidate = function | Lfunction lfun when lfun.attr.tmc_candidate -> (* TMC does not make sense for local-returning functions *) - if not lfun.region then + begin match lfun.ret_mode with + | Alloc_local -> raise (Error (Debuginfo.Scoped_location.to_location lfun.loc, - Tmc_without_region)); - Some lfun + Tmc_local_returning)) + | Alloc_heap -> Some lfun + end | _ -> None let declare_binding ctx (var, def) = @@ -718,7 +720,7 @@ let rec choice ctx t = else Default_tailcall in (* This application is in tail position of a region=true function - (or Tmc_without_region would have occurred), so it must be Heap *) + (or Tmc_local_returning would have occurred), so it must be Heap *) assert (Lambda.is_heap_mode apply.ap_mode); { Choice.dps = Dps.make (fun ~tail ~dst -> @@ -1133,7 +1135,7 @@ let () = |> List.map sub in Some (Location.errorf ~loc ~sub:submgs "%t" print_msg) - | Error (loc, Tmc_without_region) -> + | Error (loc, Tmc_local_returning) -> Some (Location.errorf ~loc "[@tail_mod_cons]: Functions cannot be both local-returning \ and [@tail_mod_cons]") diff --git a/ocaml/lambda/translcore.ml b/ocaml/lambda/translcore.ml index 0a3b7dfd8be..526a9b494dc 100644 --- a/ocaml/lambda/translcore.ml +++ b/ocaml/lambda/translcore.ml @@ -309,7 +309,7 @@ let fuse_method_arity (parent : fusable_function) : fusable_function = body = method_.body; return_mode = transl_alloc_mode_l method_.ret_mode; return_sort = method_.ret_sort; - region = method_.region; + region = true; } | _ -> parent @@ -412,10 +412,10 @@ and transl_exp0 ~in_new_scope ~scopes sort e = let return_layout = layout_exp sort body in transl_let ~scopes ~return_layout rec_flag pat_expr_list (event_before ~scopes body (transl_exp ~scopes sort body)) - | Texp_function { params; body; region; ret_sort; ret_mode; alloc_mode; + | Texp_function { params; body; ret_sort; ret_mode; alloc_mode; zero_alloc } -> transl_function ~in_new_scope ~scopes e params body - ~alloc_mode ~ret_mode ~ret_sort ~region ~zero_alloc + ~alloc_mode ~ret_mode ~ret_sort ~region:true ~zero_alloc | Texp_apply({ exp_desc = Texp_ident(path, _, {val_kind = Val_prim p}, Id_prim (pmode, psort), _); exp_type = prim_type; } as funct, diff --git a/ocaml/otherlibs/stdlib_stable/iarray.ml b/ocaml/otherlibs/stdlib_stable/iarray.ml index 0bd65c50e71..c10a1680d68 100644 --- a/ocaml/otherlibs/stdlib_stable/iarray.ml +++ b/ocaml/otherlibs/stdlib_stable/iarray.ml @@ -120,7 +120,7 @@ let[@inline always] unsafe_init_local l (local_ f : int -> local_ 'a) = function, and why it's not tail-recursive; if it were tail-recursive, then we wouldn't have anywhere to put the array elements during the whole process. *) - let rec go ~l ~f i = local_ begin + let rec go ~l ~f i = exclave_ begin let x = f i in if i = l - 1 then make_mutable_local l x @@ -145,7 +145,7 @@ let init l (local_ f) = done; unsafe_of_array res -let init_local l f = local_ +let init_local l f = exclave_ if l < 0 then invalid_arg "Iarray.init_local" (* See #6575. We could also check for maximum array size, but this depends on whether we create a float array or a regular one... *) @@ -156,7 +156,7 @@ let append a1 a2 = else if length a2 = 0 then a1 else append_prim a1 a2 -let append_local a1 a2 = local_ +let append_local a1 a2 = exclave_ if length a1 = 0 then a2 (* Safe because they're immutable *) else if length a2 = 0 then a1 else append_prim_local a1 a2 @@ -166,7 +166,7 @@ let sub a ofs len = then invalid_arg "Iarray.sub" else unsafe_sub a ofs len -let sub_local a ofs len = local_ +let sub_local a ofs len = exclave_ if ofs < 0 || len < 0 || ofs > length a - len then invalid_arg "Iarray.sub" else unsafe_sub_local a ofs len @@ -211,8 +211,8 @@ let map f a = unsafe_of_array r end -let map_local f a = local_ - unsafe_init_local (length a) (fun i -> local_ f (unsafe_get a i)) +let map_local f a = exclave_ + unsafe_init_local (length a) (fun i -> exclave_ f (unsafe_get a i)) let map_local_input f a = let l = length a in @@ -224,8 +224,8 @@ let map_local_input f a = unsafe_of_array r end -let map_local_output f a = local_ - unsafe_init_local (length a) (fun i -> local_ f (unsafe_get a i)) +let map_local_output f a = exclave_ + unsafe_init_local (length a) (fun i -> exclave_ f (unsafe_get a i)) let map2 f a b = let la = length a in @@ -242,13 +242,13 @@ let map2 f a b = end end -let map2_local f a b = local_ +let map2_local f a b = exclave_ let la = length a in let lb = length b in if la <> lb then invalid_arg "Iarray.map2_local: arrays must have the same length" else - unsafe_init_local la (fun i -> local_ f (unsafe_get a i) (unsafe_get b i)) + unsafe_init_local la (fun i -> exclave_ f (unsafe_get a i) (unsafe_get b i)) let map2_local_inputs f a b = let la = length a in @@ -265,13 +265,13 @@ let map2_local_inputs f a b = end end -let map2_local_output f a b = local_ +let map2_local_output f a b = exclave_ let la = length a in let lb = length b in if la <> lb then invalid_arg "Iarray.map2_local: arrays must have the same length" else - unsafe_init_local la (fun i -> local_ f (unsafe_get a i) (unsafe_get b i)) + unsafe_init_local la (fun i -> exclave_ f (unsafe_get a i) (unsafe_get b i)) let map2_local_first_input f a b = let la = length a in @@ -303,21 +303,21 @@ let map2_local_second_input f a b = end end -let map2_local_first_input_and_output f a b = local_ +let map2_local_first_input_and_output f a b = exclave_ let la = length a in let lb = length b in if la <> lb then invalid_arg "Iarray.map2_local: arrays must have the same length" else - unsafe_init_local la (fun i -> local_ f (unsafe_get a i) (unsafe_get b i)) + unsafe_init_local la (fun i -> exclave_ f (unsafe_get a i) (unsafe_get b i)) -let map2_local_second_input_and_output f a b = local_ +let map2_local_second_input_and_output f a b = exclave_ let la = length a in let lb = length b in if la <> lb then invalid_arg "Iarray.map2_local: arrays must have the same length" else - unsafe_init_local la (fun i -> local_ f (unsafe_get a i) (unsafe_get b i)) + unsafe_init_local la (fun i -> exclave_ f (unsafe_get a i) (unsafe_get b i)) let iteri f a = for i = 0 to length a - 1 do f i (unsafe_get a i) done @@ -335,8 +335,8 @@ let mapi f a = unsafe_of_array r end -let mapi_local f a = local_ - unsafe_init_local (length a) (fun i -> local_ f i (unsafe_get a i)) +let mapi_local f a = exclave_ + unsafe_init_local (length a) (fun i -> exclave_ f i (unsafe_get a i)) let mapi_local_input f a = let l = length a in @@ -348,16 +348,16 @@ let mapi_local_input f a = unsafe_of_array r end -let mapi_local_output f a = local_ - unsafe_init_local (length a) (fun i -> local_ f i (unsafe_get a i)) +let mapi_local_output f a = exclave_ + unsafe_init_local (length a) (fun i -> exclave_ f i (unsafe_get a i)) let to_list a = let rec tolist i res = if i < 0 then res else tolist (i - 1) (unsafe_get a i :: res) in tolist (length a - 1) [] -let to_list_local a = local_ - let rec tolist i res = local_ +let to_list_local a = exclave_ + let rec tolist i res = exclave_ if i < 0 then res else tolist (i - 1) (unsafe_get a i :: res) in tolist (length a - 1) [] @@ -371,12 +371,12 @@ let rec list_length accu = function (* This shouldn't violate the forward-pointers restriction because the list elements already exist *) let of_list_local = function - | [] -> local_ unsafe_of_array [||] - | hd::tl as l -> local_ + | [] -> exclave_ unsafe_of_array [||] + | hd::tl as l -> exclave_ let a = make_mutable_local (list_length 0 l) hd in let rec fill i = function - | [] -> local_ a - | hd::tl -> local_ unsafe_set_local a i hd; fill (i+1) tl in + | [] -> exclave_ a + | hd::tl -> exclave_ unsafe_set_local a i hd; fill (i+1) tl in unsafe_of_local_array (fill 1 tl) let to_array ia = Array.copy (unsafe_to_array ia) @@ -390,9 +390,9 @@ let fold_left f x a = done; !r -let fold_left_local f x a = local_ +let fold_left_local f x a = exclave_ let len = length a in - let rec go r i = local_ + let rec go r i = exclave_ if i = len then r else go (f r (unsafe_get a i)) (i+1) @@ -406,9 +406,9 @@ let fold_left_local_input f x a = done; !r -let fold_left_local_output f x a = local_ +let fold_left_local_output f x a = exclave_ let len = length a in - let rec go r i = local_ + let rec go r i = exclave_ if i = len then r else go (f r (unsafe_get a i)) (i+1) @@ -429,10 +429,10 @@ let fold_left_map f acc input_array = !acc, unsafe_of_array output_array end -let fold_left_map_local f acc input_array = local_ +let fold_left_map_local f acc input_array = exclave_ let len = length input_array in if len = 0 then (acc, unsafe_of_local_array [||]) else begin - let rec go acc i = local_ + let rec go acc i = exclave_ let acc', elt = f acc (unsafe_get input_array i) in if i = len - 1 then acc', make_mutable_local len elt @@ -460,10 +460,10 @@ let fold_left_map_local_input f acc input_array = !acc, unsafe_of_array output_array end -let fold_left_map_local_output f acc input_array = local_ +let fold_left_map_local_output f acc input_array = exclave_ let len = length input_array in if len = 0 then (acc, unsafe_of_local_array [||]) else begin - let rec go acc i = local_ + let rec go acc i = exclave_ let acc', elt = f acc (unsafe_get input_array i) in if i = len - 1 then acc', make_mutable_local len elt @@ -484,8 +484,8 @@ let fold_right f a x = done; !r -let fold_right_local f a x = local_ - let rec go r i = local_ +let fold_right_local f a x = exclave_ + let rec go r i = exclave_ if i = -1 then r else go (f (unsafe_get a i) r) (i-1) @@ -499,8 +499,8 @@ let fold_right_local_input f a x = done; !r -let fold_right_local_output f a x = local_ - let rec go r i = local_ +let fold_right_local_output f a x = exclave_ + let rec go r i = exclave_ if i = -1 then r else go (f (unsafe_get a i) r) (i-1) @@ -513,7 +513,7 @@ let[@inline always] globalize_bool : local_ bool -> bool = fun b -> b let exists p a = let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then false else if p (unsafe_get a i) then true else loop (succ i) in @@ -521,7 +521,7 @@ let exists p a = let exists_local p a = let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then false else if p (unsafe_get a i) then true else loop (succ i) in @@ -529,7 +529,7 @@ let exists_local p a = let for_all p a = let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then true else if p (unsafe_get a i) then loop (succ i) else false in @@ -537,7 +537,7 @@ let for_all p a = let for_all_local p a = let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then true else if p (unsafe_get a i) then loop (succ i) else false in @@ -547,7 +547,7 @@ let for_all2 p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.for_all2" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then true else if p (unsafe_get l1 i) (unsafe_get l2 i) then loop (succ i) else false in @@ -557,7 +557,7 @@ let for_all2_local p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.for_all2_local" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then true else if p (unsafe_get l1 i) (unsafe_get l2 i) then loop (succ i) else false in @@ -567,7 +567,7 @@ let for_all2_local_first p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.for_all2_local_first" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then true else if p (unsafe_get l1 i) (unsafe_get l2 i) then loop (succ i) else false in @@ -577,7 +577,7 @@ let for_all2_local_second p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.for_all2_local_second" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then true else if p (unsafe_get l1 i) (unsafe_get l2 i) then loop (succ i) else false in @@ -587,7 +587,7 @@ let exists2 p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.exists2" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then false else if p (unsafe_get l1 i) (unsafe_get l2 i) then true else loop (succ i) in @@ -597,7 +597,7 @@ let exists2_local p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.exists2_local" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then false else if p (unsafe_get l1 i) (unsafe_get l2 i) then true else loop (succ i) in @@ -607,7 +607,7 @@ let exists2_local_first p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.exists2_local_first" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then false else if p (unsafe_get l1 i) (unsafe_get l2 i) then true else loop (succ i) in @@ -617,7 +617,7 @@ let exists2_local_second p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.exists2_local_second" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then false else if p (unsafe_get l1 i) (unsafe_get l2 i) then true else loop (succ i) in @@ -625,7 +625,7 @@ let exists2_local_second p l1 l2 = let mem x a = let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then false else if compare (unsafe_get a i) x = 0 then true else loop (succ i) in @@ -633,7 +633,7 @@ let mem x a = let memq x a = let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then false else if x == (unsafe_get a i) then true else loop (succ i) in @@ -650,9 +650,9 @@ let find_opt p a = in loop 0 [@nontail] -let find_opt_local p a = local_ +let find_opt_local p a = exclave_ let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then None else let x = unsafe_get a i in @@ -672,9 +672,9 @@ let find_map f a = in loop 0 [@nontail] -let find_map_local f a = local_ +let find_map_local f a = exclave_ let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then None else match f (unsafe_get a i) with @@ -694,9 +694,9 @@ let find_map_local_input f a = in loop 0 [@nontail] -let find_map_local_output f a = local_ +let find_map_local_output f a = exclave_ let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then None else match f (unsafe_get a i) with @@ -724,7 +724,7 @@ let split x = (* This shouldn't violate the forward-pointers restriction because the array elements already exist. (This doesn't work for [combine], where we need to create the tuples.) *) -let split_local x = local_ +let split_local x = exclave_ if x = unsafe_of_array [||] then unsafe_of_array [||], unsafe_of_array [||] else begin @@ -754,11 +754,11 @@ let combine a b = end in unsafe_of_array r -let combine_local a b = local_ +let combine_local a b = exclave_ let na = length a in let nb = length b in if na <> nb then invalid_arg "Iarray.combine_local"; - unsafe_init_local na (fun i -> local_ unsafe_get a i, unsafe_get b i) + unsafe_init_local na (fun i -> exclave_ unsafe_get a i, unsafe_get b i) (* Must be fully applied due to the value restriction *) let lift_sort sorter cmp iarr = diff --git a/ocaml/otherlibs/stdlib_stable/iarrayLabels.ml b/ocaml/otherlibs/stdlib_stable/iarrayLabels.ml index 3983b085f6d..a2db3e1a5f0 100644 --- a/ocaml/otherlibs/stdlib_stable/iarrayLabels.ml +++ b/ocaml/otherlibs/stdlib_stable/iarrayLabels.ml @@ -80,7 +80,7 @@ external unsafe_set_local : local_ 'a array -> int -> local_ 'a -> unit = (* Really trusting the inliner here; to get maximum performance, it has to inline both [unsafe_init_local] *and* [f]. *) (** Precondition: [l >= 0]. *) -let[@inline always] unsafe_init_local l (local_ f : int -> local_ 'a) = local_ +let[@inline always] unsafe_init_local l (local_ f : int -> local_ 'a) = exclave_ if l = 0 then unsafe_of_local_array [||] else @@ -95,7 +95,7 @@ let[@inline always] unsafe_init_local l (local_ f : int -> local_ 'a) = local_ function, and why it's not tail-recursive; if it were tail-recursive, then we wouldn't have anywhere to put the array elements during the whole process. *) - let rec go i = local_ begin + let rec go i = exclave_ begin let x = f i in if i = l - 1 then make_mutable_local l x @@ -120,7 +120,7 @@ let init l (local_ f) = done; unsafe_of_array res -let init_local l f = local_ +let init_local l f = exclave_ if l < 0 then invalid_arg "Iarray.init_local" (* See #6575. We could also check for maximum array size, but this depends on whether we create a float array or a regular one... *) @@ -131,7 +131,7 @@ let append a1 a2 = else if length a2 = 0 then a1 else append_prim a1 a2 -let append_local a1 a2 = local_ +let append_local a1 a2 = exclave_ if length a1 = 0 then a2 (* Safe because they're immutable *) else if length a2 = 0 then a1 else append_prim_local a1 a2 @@ -141,7 +141,7 @@ let sub a ofs len = then invalid_arg "Iarray.sub" else unsafe_sub a ofs len -let sub_local a ofs len = local_ +let sub_local a ofs len = exclave_ if ofs < 0 || len < 0 || ofs > length a - len then invalid_arg "Iarray.sub" else unsafe_sub_local a ofs len @@ -186,8 +186,8 @@ let map f a = unsafe_of_array r end -let map_local f a = local_ - unsafe_init_local (length a) (fun i -> local_ f (unsafe_get a i)) +let map_local f a = exclave_ + unsafe_init_local (length a) (fun i -> exclave_ f (unsafe_get a i)) let map_local_input f a = let l = length a in @@ -199,8 +199,8 @@ let map_local_input f a = unsafe_of_array r end -let map_local_output f a = local_ - unsafe_init_local (length a) (fun i -> local_ f (unsafe_get a i)) +let map_local_output f a = exclave_ + unsafe_init_local (length a) (fun i -> exclave_ f (unsafe_get a i)) let map2 f a b = let la = length a in @@ -217,13 +217,13 @@ let map2 f a b = end end -let map2_local f a b = local_ +let map2_local f a b = exclave_ let la = length a in let lb = length b in if la <> lb then invalid_arg "Iarray.map2_local: arrays must have the same length" else - unsafe_init_local la (fun i -> local_ f (unsafe_get a i) (unsafe_get b i)) + unsafe_init_local la (fun i -> exclave_ f (unsafe_get a i) (unsafe_get b i)) let map2_local_inputs f a b = let la = length a in @@ -240,13 +240,13 @@ let map2_local_inputs f a b = end end -let map2_local_output f a b = local_ +let map2_local_output f a b = exclave_ let la = length a in let lb = length b in if la <> lb then invalid_arg "Iarray.map2_local: arrays must have the same length" else - unsafe_init_local la (fun i -> local_ f (unsafe_get a i) (unsafe_get b i)) + unsafe_init_local la (fun i -> exclave_ f (unsafe_get a i) (unsafe_get b i)) let map2_local_first_input f a b = let la = length a in @@ -278,21 +278,21 @@ let map2_local_second_input f a b = end end -let map2_local_first_input_and_output f a b = local_ +let map2_local_first_input_and_output f a b = exclave_ let la = length a in let lb = length b in if la <> lb then invalid_arg "Iarray.map2_local: arrays must have the same length" else - unsafe_init_local la (fun i -> local_ f (unsafe_get a i) (unsafe_get b i)) + unsafe_init_local la (fun i -> exclave_ f (unsafe_get a i) (unsafe_get b i)) -let map2_local_second_input_and_output f a b = local_ +let map2_local_second_input_and_output f a b = exclave_ let la = length a in let lb = length b in if la <> lb then invalid_arg "Iarray.map2_local: arrays must have the same length" else - unsafe_init_local la (fun i -> local_ f (unsafe_get a i) (unsafe_get b i)) + unsafe_init_local la (fun i -> exclave_ f (unsafe_get a i) (unsafe_get b i)) let iteri f a = for i = 0 to length a - 1 do f i (unsafe_get a i) done @@ -310,8 +310,8 @@ let mapi f a = unsafe_of_array r end -let mapi_local f a = local_ - unsafe_init_local (length a) (fun i -> local_ f i (unsafe_get a i)) +let mapi_local f a = exclave_ + unsafe_init_local (length a) (fun i -> exclave_ f i (unsafe_get a i)) let mapi_local_input f a = let l = length a in @@ -323,16 +323,16 @@ let mapi_local_input f a = unsafe_of_array r end -let mapi_local_output f a = local_ - unsafe_init_local (length a) (fun i -> local_ f i (unsafe_get a i)) +let mapi_local_output f a = exclave_ + unsafe_init_local (length a) (fun i -> exclave_ f i (unsafe_get a i)) let to_list a = let rec tolist i res = if i < 0 then res else tolist (i - 1) (unsafe_get a i :: res) in tolist (length a - 1) [] -let to_list_local a = local_ - let rec tolist i res = local_ +let to_list_local a = exclave_ + let rec tolist i res = exclave_ if i < 0 then res else tolist (i - 1) (unsafe_get a i :: res) in tolist (length a - 1) [] @@ -346,12 +346,12 @@ let rec list_length accu = function (* This shouldn't violate the forward-pointers restriction because the list elements already exist *) let of_list_local = function - | [] -> local_ unsafe_of_array [||] - | hd::tl as l -> local_ + | [] -> exclave_ unsafe_of_array [||] + | hd::tl as l -> exclave_ let a = make_mutable_local (list_length 0 l) hd in let rec fill i = function - | [] -> local_ a - | hd::tl -> local_ unsafe_set_local a i hd; fill (i+1) tl in + | [] -> exclave_ a + | hd::tl -> exclave_ unsafe_set_local a i hd; fill (i+1) tl in unsafe_of_local_array (fill 1 tl) let to_array ia = Array.copy (unsafe_to_array ia) @@ -365,9 +365,9 @@ let fold_left f x a = done; !r -let fold_left_local f x a = local_ +let fold_left_local f x a = exclave_ let len = length a in - let rec go r i = local_ + let rec go r i = exclave_ if i = len then r else go (f r (unsafe_get a i)) (i+1) @@ -381,9 +381,9 @@ let fold_left_local_input f x a = done; !r -let fold_left_local_output f x a = local_ +let fold_left_local_output f x a = exclave_ let len = length a in - let rec go r i = local_ + let rec go r i = exclave_ if i = len then r else go (f r (unsafe_get a i)) (i+1) @@ -404,10 +404,10 @@ let fold_left_map f acc input_array = !acc, unsafe_of_array output_array end -let fold_left_map_local f acc input_array = local_ +let fold_left_map_local f acc input_array = exclave_ let len = length input_array in if len = 0 then (acc, unsafe_of_local_array [||]) else begin - let rec go acc i = local_ + let rec go acc i = exclave_ let acc', elt = f acc (unsafe_get input_array i) in if i = len - 1 then acc', make_mutable_local len elt @@ -435,10 +435,10 @@ let fold_left_map_local_input f acc input_array = !acc, unsafe_of_array output_array end -let fold_left_map_local_output f acc input_array = local_ +let fold_left_map_local_output f acc input_array = exclave_ let len = length input_array in if len = 0 then (acc, unsafe_of_local_array [||]) else begin - let rec go acc i = local_ + let rec go acc i = exclave_ let acc', elt = f acc (unsafe_get input_array i) in if i = len - 1 then acc', make_mutable_local len elt @@ -459,8 +459,8 @@ let fold_right f a x = done; !r -let fold_right_local f a x = local_ - let rec go r i = local_ +let fold_right_local f a x = exclave_ + let rec go r i = exclave_ if i = -1 then r else go (f (unsafe_get a i) r) (i-1) @@ -474,8 +474,8 @@ let fold_right_local_input f a x = done; !r -let fold_right_local_output f a x = local_ - let rec go r i = local_ +let fold_right_local_output f a x = exclave_ + let rec go r i = exclave_ if i = -1 then r else go (f (unsafe_get a i) r) (i-1) @@ -488,7 +488,7 @@ let[@inline always] globalize_bool : local_ bool -> bool = fun b -> b let exists p a = let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then false else if p (unsafe_get a i) then true else loop (succ i) in @@ -496,7 +496,7 @@ let exists p a = let exists_local p a = let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then false else if p (unsafe_get a i) then true else loop (succ i) in @@ -504,7 +504,7 @@ let exists_local p a = let for_all p a = let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then true else if p (unsafe_get a i) then loop (succ i) else false in @@ -512,7 +512,7 @@ let for_all p a = let for_all_local p a = let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then true else if p (unsafe_get a i) then loop (succ i) else false in @@ -522,7 +522,7 @@ let for_all2 p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.for_all2" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then true else if p (unsafe_get l1 i) (unsafe_get l2 i) then loop (succ i) else false in @@ -532,7 +532,7 @@ let for_all2_local p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.for_all2_local" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then true else if p (unsafe_get l1 i) (unsafe_get l2 i) then loop (succ i) else false in @@ -542,7 +542,7 @@ let for_all2_local_first p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.for_all2_local_first" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then true else if p (unsafe_get l1 i) (unsafe_get l2 i) then loop (succ i) else false in @@ -552,7 +552,7 @@ let for_all2_local_second p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.for_all2_local_second" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then true else if p (unsafe_get l1 i) (unsafe_get l2 i) then loop (succ i) else false in @@ -562,7 +562,7 @@ let exists2 p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.exists2" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then false else if p (unsafe_get l1 i) (unsafe_get l2 i) then true else loop (succ i) in @@ -572,7 +572,7 @@ let exists2_local p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.exists2_local" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then false else if p (unsafe_get l1 i) (unsafe_get l2 i) then true else loop (succ i) in @@ -582,7 +582,7 @@ let exists2_local_first p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.exists2_local_first" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then false else if p (unsafe_get l1 i) (unsafe_get l2 i) then true else loop (succ i) in @@ -592,7 +592,7 @@ let exists2_local_second p l1 l2 = let n1 = length l1 and n2 = length l2 in if n1 <> n2 then invalid_arg "Iarray.exists2_local_second" - else let rec loop i = local_ + else let rec loop i = exclave_ if i = n1 then false else if p (unsafe_get l1 i) (unsafe_get l2 i) then true else loop (succ i) in @@ -600,7 +600,7 @@ let exists2_local_second p l1 l2 = let mem x a = let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then false else if compare (unsafe_get a i) x = 0 then true else loop (succ i) in @@ -608,7 +608,7 @@ let mem x a = let memq x a = let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then false else if x == (unsafe_get a i) then true else loop (succ i) in @@ -625,9 +625,9 @@ let find_opt p a = in loop 0 [@nontail] -let find_opt_local p a = local_ +let find_opt_local p a = exclave_ let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then None else let x = unsafe_get a i in @@ -647,9 +647,9 @@ let find_map f a = in loop 0 [@nontail] -let find_map_local f a = local_ +let find_map_local f a = exclave_ let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then None else match f (unsafe_get a i) with @@ -669,9 +669,9 @@ let find_map_local_input f a = in loop 0 [@nontail] -let find_map_local_output f a = local_ +let find_map_local_output f a = exclave_ let n = length a in - let rec loop i = local_ + let rec loop i = exclave_ if i = n then None else match f (unsafe_get a i) with @@ -699,7 +699,7 @@ let split x = (* This shouldn't violate the forward-pointers restriction because the array elements already exist. (This doesn't work for [combine], where we need to create the tuples.) *) -let split_local x = local_ +let split_local x = exclave_ if x = unsafe_of_array [||] then unsafe_of_array [||], unsafe_of_array [||] else begin @@ -729,11 +729,11 @@ let combine a b = end in unsafe_of_array r -let combine_local a b = local_ +let combine_local a b = exclave_ let na = length a in let nb = length b in if na <> nb then invalid_arg "Iarray.combine_local"; - unsafe_init_local na (fun i -> local_ unsafe_get a i, unsafe_get b i) + unsafe_init_local na (fun i -> exclave_ unsafe_get a i, unsafe_get b i) (* Must be fully applied due to the value restriction *) let lift_sort sorter cmp iarr = diff --git a/ocaml/stdlib/camlinternalComprehension.ml b/ocaml/stdlib/camlinternalComprehension.ml index 398f7a2f64c..e99fd10a7d5 100644 --- a/ocaml/stdlib/camlinternalComprehension.ml +++ b/ocaml/stdlib/camlinternalComprehension.ml @@ -14,20 +14,20 @@ let rec rev_list_to_list' acc = function let rev_list_to_list rl = rev_list_to_list' [] rl (* Can be thought of as the combination of [map] and composition *) -let rec rev_dlist_concat_map l f acc = local_ +let rec rev_dlist_concat_map l f acc = exclave_ (* [List.fold_left (fun acc el -> f el acc) acc l], but more [local_] *) match l with | [] -> acc | el :: l -> rev_dlist_concat_map l f (f el acc) ;; -let rec rev_dlist_concat_iterate_up from to_ f acc = local_ +let rec rev_dlist_concat_iterate_up from to_ f acc = exclave_ if to_ < from then acc else rev_dlist_concat_iterate_up (from + 1) to_ f (f from acc) ;; -let rec rev_dlist_concat_iterate_down from to_ f acc = local_ +let rec rev_dlist_concat_iterate_down from to_ f acc = exclave_ if to_ > from then acc else rev_dlist_concat_iterate_down (from - 1) to_ f (f from acc) diff --git a/ocaml/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference b/ocaml/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference index c913c00b11b..0ad6e52249e 100644 --- a/ocaml/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference +++ b/ocaml/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference @@ -91,7 +91,6 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2)) value_mode global,many,nonportable;join(shared,contended)(modevar#1[shared,uncontended .. unique,uncontended]) expression (test_locations.ml[17,534+14]..test_locations.ml[19,572+34]) Texp_function - region true alloc_mode global,many,nonportable;id(modevar#7[shared,contended .. unique,uncontended]) [] Tfunction_cases (test_locations.ml[17,534+14]..test_locations.ml[19,572+34]) diff --git a/ocaml/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference b/ocaml/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference index 41ebb6653bf..8300b3ab2ab 100644 --- a/ocaml/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference +++ b/ocaml/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference @@ -91,7 +91,6 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2)) value_mode global,many,nonportable;join(shared,contended)(modevar#1[shared,uncontended .. unique,uncontended]) expression Texp_function - region true alloc_mode global,many,nonportable;id(modevar#7[shared,contended .. unique,uncontended]) [] Tfunction_cases diff --git a/ocaml/testsuite/tests/parsetree/source_jane_street.ml b/ocaml/testsuite/tests/parsetree/source_jane_street.ml index 94e79d1d04b..442fbfbefa8 100644 --- a/ocaml/testsuite/tests/parsetree/source_jane_street.ml +++ b/ocaml/testsuite/tests/parsetree/source_jane_street.ml @@ -93,16 +93,11 @@ let g () = ();; (* expressions *) -let g () = local_ unique_ +let g () = exclave_ unique_ let f = unique_ once_ () in - let f x y = once_ local_ (x + y) in + let f x y = exclave_ once_ (x + y) in local_ unique_ once_ ();; -(* exclaves *) -let f () = exclave_ - let f x y = exclave_ (x + y) in - () - (* types *) type record = { global_ field : int diff --git a/ocaml/testsuite/tests/syntactic-arity/max_arity_locals.ml b/ocaml/testsuite/tests/syntactic-arity/max_arity_locals.ml index 2a6b5e71ca3..a50b03545c8 100644 --- a/ocaml/testsuite/tests/syntactic-arity/max_arity_locals.ml +++ b/ocaml/testsuite/tests/syntactic-arity/max_arity_locals.ml @@ -48,7 +48,7 @@ let no_local_params__local_returning ~x93 ~x94 ~x95 ~x96 ~x97 ~x98 ~x99 ~x100 ~x101 ~x102 ~x103 ~x104 ~x105 ~x106 ~x107 ~x108 ~x109 ~x110 ~x111 ~x112 ~x113 ~x114 ~x115 ~x116 ~x117 ~x118 ~x119 ~x120 ~x121 ~x122 ~x123 ~x124 ~x125 ~x126 - ~x127 ~x128 ~x129 ~x130 ~x131 = local_ (x1, x2) + ~x127 ~x128 ~x129 ~x130 ~x131 = exclave_ (x1, x2) (* first local argument comes after the split point *) let local_param_after_split @@ -76,7 +76,7 @@ let local_param_after_split__local_returning ~x93 ~x94 ~x95 ~x96 ~x97 ~x98 ~x99 ~x100 ~x101 ~x102 ~x103 ~x104 ~x105 ~x106 ~x107 ~x108 ~x109 ~x110 ~x111 ~x112 ~x113 ~x114 ~x115 ~x116 ~x117 ~x118 ~x119 ~x120 ~x121 ~x122 ~x123 ~x124 ~x125 ~x126 - ~x127 ~x128 ~x129 ~(local_ x130) ~x131 = local_ (x1, x130) + ~x127 ~x128 ~x129 ~(local_ x130) ~x131 = exclave_ (x1, x130) (* first local argument comes immediately after the split point *) let local_param_just_after_split @@ -106,7 +106,7 @@ let local_param_just_after_split__local_returning ~x93 ~x94 ~x95 ~x96 ~x97 ~x98 ~x99 ~x100 ~x101 ~x102 ~x103 ~x104 ~x105 ~x106 ~x107 ~x108 ~x109 ~x110 ~x111 ~x112 ~x113 ~x114 ~x115 ~x116 ~x117 ~x118 ~x119 ~x120 ~x121 ~x122 ~x123 ~x124 ~x125 ~x126 - ~(local_ x127) ~x128 ~x129 ~x130 ~x131 = local_ (x1, x127);; + ~(local_ x127) ~x128 ~x129 ~x130 ~x131 = exclave_ (x1, x127);; (* first local argument comes immediately before the split point *) let local_param_just_before_split @@ -136,7 +136,7 @@ let local_param_just_before_split__local_returning ~x93 ~x94 ~x95 ~x96 ~x97 ~x98 ~x99 ~x100 ~x101 ~x102 ~x103 ~x104 ~x105 ~x106 ~x107 ~x108 ~x109 ~x110 ~x111 ~x112 ~x113 ~x114 ~x115 ~x116 ~x117 ~x118 ~x119 ~x120 ~x121 ~x122 ~x123 ~x124 ~x125 ~(local_ x126) - ~x127 ~x128 ~x129 ~x130 ~x131 = local_ (x1, x126);; + ~x127 ~x128 ~x129 ~x130 ~x131 = exclave_ (x1, x126);; (* first local argument comes well before the split point *) let local_param_before_split @@ -164,7 +164,7 @@ let local_param_before_split__local_returning ~x93 ~x94 ~x95 ~x96 ~x97 ~x98 ~x99 ~x100 ~x101 ~x102 ~x103 ~x104 ~x105 ~x106 ~x107 ~x108 ~x109 ~x110 ~x111 ~x112 ~x113 ~x114 ~x115 ~x116 ~x117 ~x118 ~x119 ~x120 ~x121 ~x122 ~x123 ~x124 ~x125 ~x126 - ~x127 ~x128 ~x129 ~x130 ~x131 = local_ (x1, x8);; + ~x127 ~x128 ~x129 ~x130 ~x131 = exclave_ (x1, x8);; (* two split points *) let two_splits @@ -216,7 +216,7 @@ let two_splits__local_returning ~x226 ~x227 ~x228 ~x229 ~x230 ~x231 ~x232 ~x233 ~x234 ~x235 ~x236 ~x237 ~x238 ~x239 ~x240 ~x241 ~x242 ~x243 ~x244 ~x245 ~x246 ~x247 ~x248 ~x249 ~x250 ~x251 ~x252 ~x253 ~x254 ~x255 ~x256 ~x257 ~x258 = - local_ (x1, x258) + exclave_ (x1, x258) (* two split points with a local argument *) let two_splits_local_param @@ -268,10 +268,10 @@ let two_splits_local_param__local_returning ~x226 ~x227 ~x228 ~x229 ~x230 ~x231 ~x232 ~x233 ~x234 ~x235 ~x236 ~x237 ~x238 ~x239 ~x240 ~x241 ~x242 ~x243 ~x244 ~x245 ~x246 ~x247 ~x248 ~x249 ~x250 ~x251 ~x252 ~x253 ~x254 ~x255 ~x256 ~x257 ~x258 = - local_ (x1, x152) + exclave_ (x1, x152) (* The functions themselves are locally allocated *) -let create_local () = local_ +let create_local () = exclave_ (* No local arguments *) let local_ no_local_params @@ -300,7 +300,7 @@ let create_local () = local_ ~x93 ~x94 ~x95 ~x96 ~x97 ~x98 ~x99 ~x100 ~x101 ~x102 ~x103 ~x104 ~x105 ~x106 ~x107 ~x108 ~x109 ~x110 ~x111 ~x112 ~x113 ~x114 ~x115 ~x116 ~x117 ~x118 ~x119 ~x120 ~x121 ~x122 ~x123 ~x124 ~x125 ~x126 - ~x127 ~x128 ~x129 ~x130 ~x131 = local_ (x1, x2) + ~x127 ~x128 ~x129 ~x130 ~x131 = exclave_ (x1, x2) in (* first local argument comes after the split point *) @@ -331,7 +331,7 @@ let create_local () = local_ ~x93 ~x94 ~x95 ~x96 ~x97 ~x98 ~x99 ~x100 ~x101 ~x102 ~x103 ~x104 ~x105 ~x106 ~x107 ~x108 ~x109 ~x110 ~x111 ~x112 ~x113 ~x114 ~x115 ~x116 ~x117 ~x118 ~x119 ~x120 ~x121 ~x122 ~x123 ~x124 ~x125 ~x126 - ~x127 ~x128 ~x129 ~(local_ x130) ~x131 = local_ (x1, x130) + ~x127 ~x128 ~x129 ~(local_ x130) ~x131 = exclave_ (x1, x130) in (* first local argument comes immediately after the split point *) @@ -363,7 +363,7 @@ let create_local () = local_ ~x93 ~x94 ~x95 ~x96 ~x97 ~x98 ~x99 ~x100 ~x101 ~x102 ~x103 ~x104 ~x105 ~x106 ~x107 ~x108 ~x109 ~x110 ~x111 ~x112 ~x113 ~x114 ~x115 ~x116 ~x117 ~x118 ~x119 ~x120 ~x121 ~x122 ~x123 ~x124 ~x125 ~x126 - ~(local_ x127) ~x128 ~x129 ~x130 ~x131 = local_ (x1, x127) + ~(local_ x127) ~x128 ~x129 ~x130 ~x131 = exclave_ (x1, x127) in (* first local argument comes immediately before the split point *) @@ -395,7 +395,7 @@ let create_local () = local_ ~x93 ~x94 ~x95 ~x96 ~x97 ~x98 ~x99 ~x100 ~x101 ~x102 ~x103 ~x104 ~x105 ~x106 ~x107 ~x108 ~x109 ~x110 ~x111 ~x112 ~x113 ~x114 ~x115 ~x116 ~x117 ~x118 ~x119 ~x120 ~x121 ~x122 ~x123 ~x124 ~x125 ~(local_ x126) - ~x127 ~x128 ~x129 ~x130 ~x131 = local_ (x1, x126) + ~x127 ~x128 ~x129 ~x130 ~x131 = exclave_ (x1, x126) in (* first local argument comes well before the split point *) @@ -425,7 +425,7 @@ let create_local () = local_ ~x93 ~x94 ~x95 ~x96 ~x97 ~x98 ~x99 ~x100 ~x101 ~x102 ~x103 ~x104 ~x105 ~x106 ~x107 ~x108 ~x109 ~x110 ~x111 ~x112 ~x113 ~x114 ~x115 ~x116 ~x117 ~x118 ~x119 ~x120 ~x121 ~x122 ~x123 ~x124 ~x125 ~x126 - ~x127 ~x128 ~x129 ~x130 ~x131 = local_ (x1, x8) + ~x127 ~x128 ~x129 ~x130 ~x131 = exclave_ (x1, x8) in (* two split points *) @@ -479,7 +479,7 @@ let create_local () = local_ ~x226 ~x227 ~x228 ~x229 ~x230 ~x231 ~x232 ~x233 ~x234 ~x235 ~x236 ~x237 ~x238 ~x239 ~x240 ~x241 ~x242 ~x243 ~x244 ~x245 ~x246 ~x247 ~x248 ~x249 ~x250 ~x251 ~x252 ~x253 ~x254 ~x255 ~x256 ~x257 ~x258 = - local_ (x1, x258) + exclave_ (x1, x258) in (* two split points with a local argument *) @@ -533,7 +533,7 @@ let create_local () = local_ ~x226 ~x227 ~x228 ~x229 ~x230 ~x231 ~x232 ~x233 ~x234 ~x235 ~x236 ~x237 ~x238 ~x239 ~x240 ~x241 ~x242 ~x243 ~x244 ~x245 ~x246 ~x247 ~x248 ~x249 ~x250 ~x251 ~x252 ~x253 ~x254 ~x255 ~x256 ~x257 ~x258 = - local_ (x1, x152) + exclave_ (x1, x152) in ( no_local_params , no_local_params__local_returning diff --git a/ocaml/testsuite/tests/typing-local/alloc.ml b/ocaml/testsuite/tests/typing-local/alloc.ml index 4506ddeca03..9581b8ccf50 100644 --- a/ocaml/testsuite/tests/typing-local/alloc.ml +++ b/ocaml/testsuite/tests/typing-local/alloc.ml @@ -342,10 +342,10 @@ external get_int64_ne : bytes -> int -> (int64[@local_opt]) = "%caml_bytes_get64 external swap32 : (int32[@local_opt]) -> (int32[@local_opt]) = "%bswap_int32" external swap64 : (int64[@local_opt]) -> (int64[@local_opt]) = "%bswap_int64" -let get_int32_be b i = local_ +let get_int32_be b i = exclave_ if Sys.big_endian then get_int32_ne b i else swap32 (opaque_local (get_int32_ne b i)) -let get_int64_be b i = local_ +let get_int64_be b i = exclave_ if Sys.big_endian then get_int64_ne b i else swap64 (opaque_local (get_int64_ne b i)) let data = Bytes.of_string "\x00\x11\x22\x33\x44\x55\x66\x77" @@ -367,10 +367,10 @@ external bigstring_get_int32_ne : bigstring -> int -> (int32[@local_opt]) = "%caml_bigstring_get32" external bigstring_get_int64_ne : bigstring -> int -> (int64[@local_opt]) = "%caml_bigstring_get64" -let bigstring_get_int32_be b i = local_ +let bigstring_get_int32_be b i = exclave_ if Sys.big_endian then bigstring_get_int32_ne b i else swap32 (opaque_local (bigstring_get_int32_ne b i)) -let bigstring_get_int64_be b i = local_ +let bigstring_get_int64_be b i = exclave_ if Sys.big_endian then bigstring_get_int64_ne b i else swap64 (opaque_local (bigstring_get_int64_ne b i)) let bigstring_of_string s = diff --git a/ocaml/testsuite/tests/typing-local/crossing.ml b/ocaml/testsuite/tests/typing-local/crossing.ml index 58b6a76a6f4..06360d0f453 100644 --- a/ocaml/testsuite/tests/typing-local/crossing.ml +++ b/ocaml/testsuite/tests/typing-local/crossing.ml @@ -223,7 +223,7 @@ Error: This value escapes its region. (* the result of function application crosses mode *) let f : _ -> local_ _ = - fun () -> local_ 42 + fun () -> exclave_ 42 [%%expect{| val f : unit -> local_ int = |}] @@ -235,7 +235,7 @@ val g : unit -> int = |}] let f : _ -> local_ _ = - fun () -> local_ "hello" + fun () -> exclave_ "hello" [%%expect{| val f : unit -> local_ string = |}] @@ -370,7 +370,7 @@ let foo : int -> int = fun x -> x val foo : int -> int = |}] -let foo' : int -> local_ int = fun x -> local_ x +let foo' : int -> local_ int = fun x -> exclave_ x [%%expect{| val foo' : int -> local_ int = |}] diff --git a/ocaml/testsuite/tests/typing-local/curry.ml b/ocaml/testsuite/tests/typing-local/curry.ml index a7725d8c5a9..1a776c5d985 100644 --- a/ocaml/testsuite/tests/typing-local/curry.ml +++ b/ocaml/testsuite/tests/typing-local/curry.ml @@ -88,7 +88,7 @@ let[@inline never] f z = let () = f 42 let[@inline never] tupled : (string*string) -> local_ string = - fun (a,b) -> local_ (a^b) + fun (a,b) -> exclave_ (a^b) let () = match tupled ("a","b") with | "ab" -> Printf.printf "%20s: ok\n" "tupled" diff --git a/ocaml/testsuite/tests/typing-local/exclave.ml b/ocaml/testsuite/tests/typing-local/exclave.ml index 900a1e5f342..fb8a5a2ff5f 100644 --- a/ocaml/testsuite/tests/typing-local/exclave.ml +++ b/ocaml/testsuite/tests/typing-local/exclave.ml @@ -185,7 +185,7 @@ val bar : 'a -> string = (* Ensure that Alias bindings are not substituted by Simplif (PR1448) *) type 'a glob = Glob of global_ 'a -let[@inline never] return_local a = local_ (Glob a) +let[@inline never] return_local a = exclave_ (Glob a) let f () = let (Glob x) = return_local 1 in @@ -242,6 +242,6 @@ let f : local_ string -> string = Line 2, characters 11-21: 2 | fun x -> exclave_ s ^^^^^^^^^^ -Error: This expression was expected to be not local, but is an exclave expression, - which must be local. +Error: This expression is local because it is an exclave, + but was expected otherwise. |}] diff --git a/ocaml/testsuite/tests/typing-local/float_iarray.ml b/ocaml/testsuite/tests/typing-local/float_iarray.ml index ae8ef935941..de98580331a 100644 --- a/ocaml/testsuite/tests/typing-local/float_iarray.ml +++ b/ocaml/testsuite/tests/typing-local/float_iarray.ml @@ -27,7 +27,7 @@ let ignore_local : local_ 'a -> unit = fun x -> let _ = local_ opaque_local x in () -let run name f x = local_ +let run name f x = exclave_ let prebefore = Gc.allocated_bytes () in let before = Gc.allocated_bytes () in let r = Sys.opaque_identity f x in @@ -47,7 +47,7 @@ let run name f x = local_ (* Testing functions *) let test_access : local_ float iarray -> local_ float = - fun iarr -> local_ iarr.:(0) + fun iarr -> exclave_ iarr.:(0) let test_match : local_ float iarray -> local_ float = fun iarr -> diff --git a/ocaml/testsuite/tests/typing-local/local-layouts.ml b/ocaml/testsuite/tests/typing-local/local-layouts.ml index 7ef308a0a5a..8e07c32e880 100644 --- a/ocaml/testsuite/tests/typing-local/local-layouts.ml +++ b/ocaml/testsuite/tests/typing-local/local-layouts.ml @@ -3,8 +3,8 @@ expect; *) -let foo _t (type a) = local_ 1 -let bar _t (type a : value) = local_ 2 +let foo _t (type a) = exclave_ 1 +let bar _t (type a : value) = exclave_ 2 [%%expect{| val foo : 'a -> local_ int = diff --git a/ocaml/testsuite/tests/typing-local/local.ml b/ocaml/testsuite/tests/typing-local/local.ml index 7ee32043f4c..6f772845f3d 100644 --- a/ocaml/testsuite/tests/typing-local/local.ml +++ b/ocaml/testsuite/tests/typing-local/local.ml @@ -410,13 +410,14 @@ val result : int = 3 |}] let baduse (f : _ -> _ -> _) x y = lazy (f x y) -let result = baduse (fun a b -> local_ (a,b)) 1 2 +let result = baduse (fun a b -> exclave_ (a,b)) 1 2 [%%expect{| val baduse : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c lazy_t = -Line 2, characters 20-45: -2 | let result = baduse (fun a b -> local_ (a,b)) 1 2 - ^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This function is local-returning, but was expected otherwise. +Line 2, characters 32-46: +2 | let result = baduse (fun a b -> exclave_ (a,b)) 1 2 + ^^^^^^^^^^^^^^ +Error: This expression is local because it is an exclave, + but was expected otherwise. |}] (* @@ -955,9 +956,9 @@ let foo x = val foo : string -> unit = |}] -let foo x = +let foo x = exclave_ let r = local_ { contents = x } in - local_ print r + print r [%%expect{| val foo : string -> local_ unit = |}] @@ -1001,10 +1002,10 @@ let foo x = val foo : 'a -> 'a = |}] -let foo x = +let foo x = exclave_ let r = local_ { contents = x } in let local_ foo () = r.contents in - local_ foo () + foo () [%%expect{| val foo : 'a -> local_ 'a = |}] @@ -1022,34 +1023,14 @@ Error: This value escapes its region. Hint: Cannot return a local value without an "exclave_" annotation. |}] -let foo x = +let foo x = exclave_ let r = local_ { contents = x } in - local_ r + r [%%expect{| val foo : 'a -> local_ 'a ref = |}] -let foo p x = - let r = local_ { contents = x } in - if p then local_ r - else r -[%%expect{| -Line 4, characters 7-8: -4 | else r - ^ -Error: This function return is not annotated with "local_" - whilst other returns were. -|}] - -let foo p x = - let r = local_ { contents = x } in - if p then local_ r - else local_ r -[%%expect{| -val foo : bool -> 'a -> local_ 'a ref = -|}] - -let foo p x = local_ +let foo p x = exclave_ let r = local_ { contents = x } in if p then r else r @@ -1082,7 +1063,7 @@ val foo : unit -> int = local-returning as well; mode-crossing is irrelavent here. Whether or not the function actually allocates in parent-region is also irrelavent here, but we allocate just to demonstrate the potential leaking. *) -let foo () = local_ +let foo () = exclave_ let _ = local_ (52, 24) in 42 [%%expect{| @@ -1129,12 +1110,13 @@ let foo : unit -> local_ string = fun () -> "hello" val foo : unit -> local_ string = |}] -let foo : unit -> string = fun () -> local_ "hello" +let foo : unit -> string = fun () -> exclave_ "hello" [%%expect{| -Line 1, characters 27-51: -1 | let foo : unit -> string = fun () -> local_ "hello" - ^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This function is local-returning, but was expected otherwise. +Line 1, characters 37-53: +1 | let foo : unit -> string = fun () -> exclave_ "hello" + ^^^^^^^^^^^^^^^^ +Error: This expression is local because it is an exclave, + but was expected otherwise. |}] (* Unboxed type constructors do not affect regionality *) @@ -1665,13 +1647,13 @@ Error: This expression has type local_ 'a ref -> 'a -> unit but an expression was expected of type local_ int ref -> (int -> unit) |}] -let int32 (local_ x) (local_ y) = local_ +let int32 (local_ x) (local_ y) = exclave_ Int32.(div (logxor (mul x y) (sub x y)) (shift_right y 10)) -let int64 (local_ x) (local_ y) = local_ +let int64 (local_ x) (local_ y) = exclave_ Int64.(div (logxor (mul x y) (sub x y)) (shift_right y 10)) -let nativeint (local_ x) (local_ y) = local_ +let nativeint (local_ x) (local_ y) = exclave_ Nativeint.(div (logxor (mul x y) (sub x y)) (shift_right y 10)) -let float (local_ x) (local_ y) = local_ +let float (local_ x) (local_ y) = exclave_ (x +. y *. x -. 42.) [%%expect{| val int32 : local_ int32 -> local_ int32 -> local_ int32 = @@ -1681,7 +1663,7 @@ val nativeint : local_ nativeint -> local_ nativeint -> local_ nativeint = val float : local_ float -> local_ float -> local_ float = |}] -let etapair (local_ x) = local_ (fst x, snd x) +let etapair (local_ x) = exclave_ (fst x, snd x) [%%expect{| val etapair : local_ 'a * 'b -> local_ 'a * 'b = |}] @@ -2287,7 +2269,7 @@ Error: This value escapes its region. |}] (* constructing local iarray from local elements is fine *) -let f (local_ x : string) = local_ [:x; "foo":] +let f (local_ x : string) = exclave_ [:x; "foo":] [%%expect{| val f : local_ string -> local_ string iarray = |}] @@ -2344,16 +2326,16 @@ val f : string iarray -> string ref = elements regardless of the array's mode. *) (* constructing local array from local elements is rejected *) -let f (local_ x : string) = local_ [| x |] +let f (local_ x : string) = exclave_ [| x |] [%%expect{| -Line 1, characters 38-39: -1 | let f (local_ x : string) = local_ [| x |] - ^ +Line 1, characters 40-41: +1 | let f (local_ x : string) = exclave_ [| x |] + ^ Error: This value escapes its region. |}] (* constructing local array from global elements is allowed *) -let f (x : string) = local_ [| x |] +let f (x : string) = exclave_ [| x |] [%%expect{| val f : string -> local_ string array = |}] @@ -2397,14 +2379,14 @@ Error: This value escapes its region. module M : sig val f : string -> string -> local_ string end = struct - let g x y = local_ "foo" - let f x = local_ g x + let g x y = exclave_ "foo" + let f x = exclave_ g x end;; [%%expect{| Lines 3-6, characters 6-3: 3 | ......struct -4 | let g x y = local_ "foo" -5 | let f x = local_ g x +4 | let g x y = exclave_ "foo" +5 | let f x = exclave_ g x 6 | end.. Error: Signature mismatch: Modules do not match: @@ -2464,20 +2446,20 @@ val f : unit -> local_ int -> (int -> int) = |}];; (* Illegal: the expected mode is global *) -let f () = local_ ((fun x y -> x + y) : (_ -> _));; +let f () = exclave_ ((fun x y -> x + y) : (_ -> _));; [%%expect{| -Line 1, characters 19-37: -1 | let f () = local_ ((fun x y -> x + y) : (_ -> _));; - ^^^^^^^^^^^^^^^^^^ +Line 1, characters 21-39: +1 | let f () = exclave_ ((fun x y -> x + y) : (_ -> _));; + ^^^^^^^^^^^^^^^^^^ Error: This function or one of its parameters escape their region when it is partially applied. |}];; -let f () = local_ ((fun x -> function | 0 -> x | y -> x + y) : (_ -> _));; +let f () = exclave_ ((fun x -> function | 0 -> x | y -> x + y) : (_ -> _));; [%%expect{| -Line 1, characters 19-60: -1 | let f () = local_ ((fun x -> function | 0 -> x | y -> x + y) : (_ -> _));; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Line 1, characters 21-62: +1 | let f () = exclave_ ((fun x -> function | 0 -> x | y -> x + y) : (_ -> _));; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This function or one of its parameters escape their region when it is partially applied. |}];; @@ -2488,13 +2470,13 @@ let f () = ((fun x -> fun y -> "") : (local_ string -> (string -> string)));; val f : unit -> local_ string -> (string -> string) = |}];; -let f () = local_ ((fun x -> fun y -> x + y) : (_ -> _));; +let f () = exclave_ ((fun x -> fun y -> x + y) : (_ -> _));; [%%expect{| val f : unit -> local_ (int -> (int -> int)) = |}];; (* ok if curried *) -let f () = local_ ((fun x -> (fun y -> x + y) [@extension.curry]) : (_ -> _));; +let f () = exclave_ ((fun x -> (fun y -> x + y) [@extension.curry]) : (_ -> _));; [%%expect{| val f : unit -> local_ (int -> (int -> int)) = |}];; @@ -2505,7 +2487,7 @@ val f : unit -> local_ (int -> (int -> int)) = *) let foo () = let local_ _bar1 : int -> int -> int = local_ (fun x y -> x + y) in - let local_ _bar2 z : int -> int -> int = local_ (fun x y -> x + y + z) in + let local_ _bar2 z : int -> int -> int = exclave_ (fun x y -> x + y + z) in () [%%expect{| val foo : unit -> unit = @@ -2522,29 +2504,6 @@ Error: This function or one of its parameters escape their region when it is partially applied. |}];; -(* test that [function] checks all its branches either for local_ or the - absence thereof *) -let foo = function - | false -> local_ 5 - | true -> 6 - -[%%expect{| -Line 3, characters 12-13: -3 | | true -> 6 - ^ -Error: This function return is not annotated with "local_" - whilst other returns were. -|}] - -(* test that [assert false] can mix with other returns being [local_] *) -let foo b = - if b - then assert false - else local_ Some 6 - -[%%expect{| -val foo : bool -> local_ int option = -|}] type f = local_ local_ string -> string [%%expect{| @@ -2607,7 +2566,7 @@ let _ret () : M.t -> unit = (fun M_constructor -> ()) val _ret : unit -> M.t -> unit = |}] -let _ret () : M.t -> unit = local_ (fun M_constructor -> ()) +let _ret () : M.t -> unit = exclave_ (fun M_constructor -> ()) [%%expect{| val _ret : unit -> local_ (M.t -> unit) = |}] diff --git a/ocaml/testsuite/tests/typing-local/localgcbug.ml b/ocaml/testsuite/tests/typing-local/localgcbug.ml index 19efbc9e811..7bc30fe78e0 100644 --- a/ocaml/testsuite/tests/typing-local/localgcbug.ml +++ b/ocaml/testsuite/tests/typing-local/localgcbug.ml @@ -4,7 +4,7 @@ type n = Z | S of n -let rec gen_locals (local_ n) depth _ = local_ +let rec gen_locals (local_ n) depth _ = exclave_ if depth = 0 then S n diff --git a/ocaml/testsuite/tests/typing-local/match_with_exception.ml b/ocaml/testsuite/tests/typing-local/match_with_exception.ml index 1cb8b08a6ee..b6e17b6fe68 100644 --- a/ocaml/testsuite/tests/typing-local/match_with_exception.ml +++ b/ocaml/testsuite/tests/typing-local/match_with_exception.ml @@ -3,10 +3,10 @@ *) let[@inline never] f x = - local_ (x, (0, 0)) + exclave_ (x, (0, 0)) let[@inline never] g x = - local_ (x, 0) + exclave_ (x, 0) let[@inline never] h x = match f x with diff --git a/ocaml/testsuite/tests/typing-local/pr902.ml b/ocaml/testsuite/tests/typing-local/pr902.ml index 6903923c418..cf501bcbb9c 100644 --- a/ocaml/testsuite/tests/typing-local/pr902.ml +++ b/ocaml/testsuite/tests/typing-local/pr902.ml @@ -12,14 +12,14 @@ external is_stack : local_ 'a -> bool = "caml_obj_is_stack" let f2 p () = p -let f1 () x : (unit -> local_ (int * int)) = +let f1 () x : (unit -> local_ (int * int)) = exclave_ (* This local allocation should end up in the caller's region, because we should have got here via one of the caml_applyL functions. If the return mode of the second application in the expansion of the overapplication below is wrongly Heap, then caml_apply will be used instead, which will open its own region for this allocation. *) let p = local_ (x, x) in - local_ ((opaque_identity f2) p) [@nontail] + ((opaque_identity f2) p) [@nontail] let[@inline never] to_be_overapplied () () = Sys.opaque_identity f1 diff --git a/ocaml/testsuite/tests/typing-local/regions.ml b/ocaml/testsuite/tests/typing-local/regions.ml index 8e707711da3..5aa060cc9dc 100644 --- a/ocaml/testsuite/tests/typing-local/regions.ml +++ b/ocaml/testsuite/tests/typing-local/regions.ml @@ -30,7 +30,7 @@ let check_not_empty name = let () = check_empty "startup" -let allocate_in_current_region x = local_ +let allocate_in_current_region x = exclave_ ignore_local (Some x); () @@ -150,7 +150,7 @@ let () = check_empty "after inlined tailcall" -let[@inline never] local_ret a b = local_ ref (a + b) +let[@inline never] local_ret a b = exclave_ ref (a + b) let[@inline never] calls_local_ret () = let local_ r = (local_ret 1) 2 in let () = ignore_local r in @@ -253,7 +253,7 @@ let () = check_empty "class instantiation" let glob = ref 0 -let[@inline never] local_fn_ret () s = local_ +let[@inline never] local_fn_ret () s = exclave_ incr glob; fun x -> Gc.minor (); string_of_int x ^ s @@ -261,7 +261,7 @@ let globstr = ref "" let unknown_fn = ref local_fn_ret let gpart_fn = ref (local_fn_ret ()) let obj = ref (object - method local_ret s = local_ + method local_ret s = exclave_ incr glob; fun x -> Gc.minor (); string_of_int x ^ s end) @@ -283,8 +283,8 @@ let () = type t = { x : int } [@@unboxed] let[@inline never] create_local () = - let local_ _extra = opaque_identity (Some (opaque_identity ())) in - local_ { x = opaque_identity 0 } + exclave_ let local_ _extra = opaque_identity (Some (opaque_identity ())) in + { x = opaque_identity 0 } let create_and_ignore () = let x = create_local () in ignore (Sys.opaque_identity x : t) diff --git a/ocaml/testsuite/tests/typing-local/tailcalls.ml b/ocaml/testsuite/tests/typing-local/tailcalls.ml index ffe22740375..a6ba026f737 100644 --- a/ocaml/testsuite/tests/typing-local/tailcalls.ml +++ b/ocaml/testsuite/tests/typing-local/tailcalls.ml @@ -113,7 +113,7 @@ let () = foo3 10 true 1 2 None external local_stack_offset : unit -> int = "caml_local_stack_offset" let[@inline never][@specialise never][@local never] allocate () = - local_ ref 0 + exclave_ ref 0 let[@inline never][@specialise never][@local never] use (local_ r) = r := 10 @@ -222,5 +222,5 @@ let[@inline never][@specialise never][@local never] rec foo previous = let () = foo None let[@inline always] inl a b = let local_ z = (a, b) in let r = fst z + snd z in r -let[@inline never] lret a b = local_ let local_ _z = [|a;b|] in inl a b +let[@inline never] lret a b = exclave_ let local_ _z = [|a;b|] in inl a b let () = assert ((lret 1 2)+1 = 4) diff --git a/ocaml/testsuite/tests/typing-local/test_iarray.ml b/ocaml/testsuite/tests/typing-local/test_iarray.ml index e0a4b1085ea..740c504a80b 100644 --- a/ocaml/testsuite/tests/typing-local/test_iarray.ml +++ b/ocaml/testsuite/tests/typing-local/test_iarray.ml @@ -30,9 +30,9 @@ let ignore_local : local_ 'a -> unit = fun x -> let _ = local_ opaque_local x in () -let local_some : 'a -> local_ 'a option = fun x -> local_ Some x +let local_some : 'a -> local_ 'a option = fun x -> exclave_ Some x -let run name f x = local_ +let run name f x = exclave_ let prebefore = Gc.allocated_bytes () in let before = Gc.allocated_bytes () in let r = Sys.opaque_identity f x in @@ -51,39 +51,39 @@ let run name f x = local_ (* Testing functions *) -let test_init n = local_ Iarray.init_local n local_some +let test_init n = exclave_ Iarray.init_local n local_some -let test_append (a1, a2) = local_ Iarray.append_local a1 a2 +let test_append (a1, a2) = exclave_ Iarray.append_local a1 a2 let test_concat = Iarray.concat_local -let test_sub a = local_ Iarray.sub_local a 0 3 +let test_sub a = exclave_ Iarray.sub_local a 0 3 let test_to_list = Iarray.to_list_local let test_of_list = Iarray.of_list_local -let test_map a = local_ +let test_map a = exclave_ Iarray.map_local - (function Some x -> local_ Some (-x) | None -> local_ Some 0) + (function Some x -> exclave_ Some (-x) | None -> exclave_ Some 0) a -let test_mapi a = local_ Iarray.mapi_local (fun i x -> local_ i, x) a +let test_mapi a = exclave_ Iarray.mapi_local (fun i x -> exclave_ i, x) a -let test_fold_left a = local_ - Iarray.fold_left_local (fun l x -> local_ x :: l) [] a +let test_fold_left a = exclave_ + Iarray.fold_left_local (fun l x -> exclave_ x :: l) [] a -let test_fold_left_map a = local_ - Iarray.fold_left_map_local (fun l x -> local_ x :: l, Some x) [] a +let test_fold_left_map a = exclave_ + Iarray.fold_left_map_local (fun l x -> exclave_ x :: l, Some x) [] a -let test_fold_right a = local_ - Iarray.fold_right_local (fun x l -> local_ x :: l) a [] +let test_fold_right a = exclave_ + Iarray.fold_right_local (fun x l -> exclave_ x :: l) a [] -let test_map2 (a1, a2) = local_ Iarray.map2_local (fun x y -> local_ x, y) a1 a2 +let test_map2 (a1, a2) = exclave_ Iarray.map2_local (fun x y -> exclave_ x, y) a1 a2 let test_split = Iarray.split_local -let test_combine (a1, a2) = local_ Iarray.combine_local a1 a2 +let test_combine (a1, a2) = exclave_ Iarray.combine_local a1 a2 (* Run the test, keeping the values alive *) let () = @@ -135,7 +135,7 @@ let () = in let local_ rC = run "split_local" test_split - (Iarray.init_local 42 (fun i -> local_ Some i, Some (-i))) + (Iarray.init_local 42 (fun i -> exclave_ Some i, Some (-i))) in let local_ rD = run "combine_local" test_combine diff --git a/ocaml/testsuite/tests/typing-local/tmc.compilers.reference b/ocaml/testsuite/tests/typing-local/tmc.compilers.reference index 3fa90699db1..f4b840c9903 100644 --- a/ocaml/testsuite/tests/typing-local/tmc.compilers.reference +++ b/ocaml/testsuite/tests/typing-local/tmc.compilers.reference @@ -1,5 +1,5 @@ File "tmc.ml", lines 10-13, characters 34-32: -10 | ..................................(local_ li) = local_ +10 | ..................................(local_ li) = exclave_ 11 | match li with 12 | | [] -> [] 13 | | x :: xs -> x :: copy_list xs diff --git a/ocaml/testsuite/tests/typing-local/tmc.ml b/ocaml/testsuite/tests/typing-local/tmc.ml index 945ff9ec0f7..58dec02c7e3 100644 --- a/ocaml/testsuite/tests/typing-local/tmc.ml +++ b/ocaml/testsuite/tests/typing-local/tmc.ml @@ -7,8 +7,7 @@ *) (* Cannot use TMC on local-returning functions *) -let[@tail_mod_cons] rec copy_list (local_ li) = local_ +let[@tail_mod_cons] rec copy_list (local_ li) = exclave_ match li with | [] -> [] | x :: xs -> x :: copy_list xs - diff --git a/ocaml/testsuite/tests/typing-modes/currying.ml b/ocaml/testsuite/tests/typing-modes/currying.ml index 1bd19a99532..e38d109862d 100644 --- a/ocaml/testsuite/tests/typing-modes/currying.ml +++ b/ocaml/testsuite/tests/typing-modes/currying.ml @@ -340,7 +340,7 @@ Error: This value escapes its region. (* The fixed version. Note that in the printed type, local returning is implicit *) let bug4_fixed : local_ (string -> foo:string -> unit) -> local_ (string -> unit) = - fun f -> local_ f ~foo:"hello" + fun f -> exclave_ f ~foo:"hello" [%%expect{| val bug4_fixed : local_ (string -> foo:string -> unit) -> string -> unit = diff --git a/ocaml/testsuite/tests/typing-modes/mutable.ml b/ocaml/testsuite/tests/typing-modes/mutable.ml index 3028efc7a34..22021d9ac59 100644 --- a/ocaml/testsuite/tests/typing-modes/mutable.ml +++ b/ocaml/testsuite/tests/typing-modes/mutable.ml @@ -7,12 +7,12 @@ (* By default, mutable implies [global many shared] modalities *) type r = {mutable s : string} -let foo (local_ s) = local_ {s} +let foo (local_ s) = exclave_ {s} [%%expect{| type r = { mutable s : string; } -Line 2, characters 29-30: -2 | let foo (local_ s) = local_ {s} - ^ +Line 2, characters 31-32: +2 | let foo (local_ s) = exclave_ {s} + ^ Error: This value escapes its region. |}] @@ -27,7 +27,7 @@ type 'a r = { mutable s : 'a; } |}] (* We can now construct a local record using a local field. *) -let foo (local_ s) = local_ {s} +let foo (local_ s) = exclave_ {s} [%%expect{| val foo : local_ 'a -> local_ 'a r = |}] @@ -63,11 +63,11 @@ type r' = {mutable s' : string @@ global [@no_mutable_implied_modalities]} type r' = { mutable global_ s' : string; } |}] -let foo (local_ s') = local_ {s'} +let foo (local_ s') = exclave_ {s'} [%%expect{| -Line 1, characters 30-32: -1 | let foo (local_ s') = local_ {s'} - ^^ +Line 1, characters 32-34: +1 | let foo (local_ s') = exclave_ {s'} + ^^ Error: This value escapes its region. |}] diff --git a/ocaml/testsuite/tests/typing-unique/unique.ml b/ocaml/testsuite/tests/typing-unique/unique.ml index 1864e569ab1..f24e805d74f 100644 --- a/ocaml/testsuite/tests/typing-unique/unique.ml +++ b/ocaml/testsuite/tests/typing-unique/unique.ml @@ -396,7 +396,7 @@ let ul (unique_ local_ x) = x val ul : local_ unique_ 'a -> local_ 'a = |}] -let ul_ret x = unique_ local_ x +let ul_ret x = exclave_ unique_ x [%%expect{| val ul_ret : unique_ 'a -> local_ 'a = |}] @@ -413,7 +413,7 @@ val overwrite_point : unique_ point -> point * point = |}] let gc_soundness_nobug (local_ unique_ p) (local_ f) = - local_ { p with x = f } + exclave_ { p with x = f } [%%expect{| val gc_soundness_nobug : local_ unique_ point -> local_ float -> local_ point = diff --git a/ocaml/typing/printtyped.ml b/ocaml/typing/printtyped.ml index 3af9532091b..aa8bc3ab238 100644 --- a/ocaml/typing/printtyped.ml +++ b/ocaml/typing/printtyped.ml @@ -446,9 +446,8 @@ and expression i ppf x = line i ppf "Texp_let %a\n" fmt_rec_flag rf; list i (value_binding rf) ppf l; expression i ppf e; - | Texp_function { params; body; region; alloc_mode = am } -> + | Texp_function { params; body; alloc_mode = am } -> line i ppf "Texp_function\n"; - line i ppf "region %b\n" region; alloc_mode i ppf am; list i function_param ppf params; function_body i ppf body; diff --git a/ocaml/typing/tast_mapper.ml b/ocaml/typing/tast_mapper.ml index 481f01b5e28..3c9c520ef74 100644 --- a/ocaml/typing/tast_mapper.ml +++ b/ocaml/typing/tast_mapper.ml @@ -437,11 +437,11 @@ let expr sub x = | Texp_let (rec_flag, list, exp) -> let (rec_flag, list) = sub.value_bindings sub (rec_flag, list) in Texp_let (rec_flag, list, sub.expr sub exp) - | Texp_function { params; body; alloc_mode; region; ret_mode; ret_sort; + | Texp_function { params; body; alloc_mode; ret_mode; ret_sort; zero_alloc } -> let params = List.map (function_param sub) params in let body = function_body sub body in - Texp_function { params; body; alloc_mode; region; ret_mode; ret_sort; + Texp_function { params; body; alloc_mode; ret_mode; ret_sort; zero_alloc } | Texp_apply (exp, list, pos, am, za) -> Texp_apply ( diff --git a/ocaml/typing/typecore.ml b/ocaml/typing/typecore.ml index 6c33a239296..169b7287cab 100644 --- a/ocaml/typing/typecore.ml +++ b/ocaml/typing/typecore.ml @@ -242,13 +242,6 @@ type error = exception Error of Location.t * Env.t * error exception Error_forward of Location.error -type in_function = - { ty_fun: type_expected; - loc_fun: Location.t; - (** [region_locked] is whether the function has its own region. *) - region_locked: bool; - } - let error_of_filter_arrow_failure ~explanation ~first ty_fun : filter_arrow_failure -> _ = function | Unification_error unif_err -> @@ -3930,116 +3923,6 @@ let check_recursive_class_bindings env ids exprs = raise(Error(expr.cl_loc, env, Illegal_class_expr))) exprs -module Is_local_returning : sig - val function_body : Jane_syntax.N_ary_functions.function_body -> bool -end = struct - - (* Is the return value annotated with "local_"? - [assert false] can work either way *) - - type local_returning_flag = - | Local of Location.t (* location of a local return *) - | Not of Location.t (* location of a non-local return *) - | Either - - let combine flag1 flag2 = - match flag1, flag2 with - | (Local _ as flag), Local _ - | (Local _ as flag), Either - | (Not _ as flag), Not _ - | (Not _ as flag), Either - | Either, (Local _ as flag) - | Either, (Not _ as flag) - | (Either as flag), Either -> - flag - - | Local local_loc, Not not_local_loc - | Not not_local_loc, Local local_loc -> - raise(Error(not_local_loc, Env.empty, - Local_return_annotation_mismatch local_loc)) - - let expr e = - let rec loop e = - match Jane_syntax.Expression.of_ast e with - | Some (jexp, _attrs) -> begin - match jexp with - | Jexp_comprehension _ -> Not e.pexp_loc - | Jexp_immutable_array _ -> Not e.pexp_loc - | Jexp_layout (Lexp_constant _) -> Not e.pexp_loc - | Jexp_layout (Lexp_newtype (_, _, e)) -> loop e - | Jexp_n_ary_function _ -> Not e.pexp_loc - | Jexp_tuple _ -> Not e.pexp_loc - | Jexp_modes (Coerce (modes, exp)) -> - if List.exists - (fun m -> - let {txt; _} = - (m : Jane_syntax.Mode_expr.Const.t :> _ Location.loc) - in - txt = "local") - modes.txt - then Local e.pexp_loc - else loop exp - end - | None -> - match e.pexp_desc with - | Pexp_assert { pexp_desc = Pexp_construct ({ txt = Lident "false" }, - None) } -> - Either - | Pexp_ident _ | Pexp_constant _ | Pexp_apply _ | Pexp_tuple _ - | Pexp_construct _ | Pexp_variant _ | Pexp_record _ | Pexp_field _ - | Pexp_setfield _ | Pexp_array _ | Pexp_while _ | Pexp_for _ | Pexp_send _ - | Pexp_new _ | Pexp_setinstvar _ | Pexp_override _ | Pexp_assert _ - | Pexp_lazy _ | Pexp_object _ | Pexp_pack _ | Pexp_function _ | Pexp_fun _ - | Pexp_letop _ | Pexp_extension _ | Pexp_unreachable -> - Not e.pexp_loc - | Pexp_let(_, _, e) | Pexp_sequence(_, e) | Pexp_constraint(e, _) - | Pexp_coerce(e, _, _) | Pexp_letmodule(_, _, e) | Pexp_letexception(_, e) - | Pexp_poly(e, _) | Pexp_newtype(_, e) | Pexp_open(_, e) - | Pexp_ifthenelse(_, e, None)-> - loop e - | Pexp_ifthenelse(_, e1, Some e2)-> combine (loop e1) (loop e2) - | Pexp_match(_, cases) -> begin - match cases with - | [] -> Not e.pexp_loc - | first :: rest -> - List.fold_left - (fun acc pc -> combine acc (loop pc.pc_rhs)) - (loop first.pc_rhs) rest - end - | Pexp_try(e, cases) -> - List.fold_left - (fun acc pc -> combine acc (loop pc.pc_rhs)) - (loop e) cases - in - loop e - - let cases cs = - match cs with - | [] -> Either - | case :: cases -> - let is_local_returning_case case = - expr case.pc_rhs - in - List.fold_left - (fun acc case -> combine acc (is_local_returning_case case)) - (is_local_returning_case case) cases - - let function_body (body : Jane_syntax.N_ary_functions.function_body) = - match body with - | Pfunction_body body -> expr body - | Pfunction_cases (cs, _, _) -> cases cs - - let is_strictly_local = function - | Local _ -> true - | Either | Not _ -> false - (* [fun _ -> assert false] must not be local-returning for - backward compatibility *) - - (* for exporting from this module *) - - let function_body body = is_strictly_local (function_body body) -end - (* The "rest of the function" extends from the start of the first parameter to the end of the overall function. The parser does not construct such a location so we forge one for type errors. @@ -4859,9 +4742,7 @@ let split_function_ty in if expected_mode.strictly_local then Locality.submode_exn Locality.local (Alloc.proj (Comonadic Areality) alloc_mode); - let { ty_fun = { ty = ty_fun; explanation }; loc_fun; region_locked } = - in_function - in + let { ty = ty_fun; explanation }, loc_fun = in_function in let separate = !Clflags.principal || Env.has_local_constraints env in let { ty_arg; ty_ret; arg_mode; ret_mode } as filtered_arrow = with_local_level_if separate begin fun () -> @@ -4908,8 +4789,7 @@ let split_function_ty (alloc_as_value alloc_mode).comonadic env in - if region_locked then Env.add_region_lock env - else env + Env.add_region_lock env in let ret_value_mode = alloc_as_value ret_mode in let expected_inner_mode = @@ -4918,17 +4798,7 @@ let split_function_ty function *) mode_default ret_value_mode else - let ret_value_mode = - if region_locked then mode_return ret_value_mode - else begin - (* if the function has no region, we force the ret_mode to be local *) - match - Locality.submode Locality.local (Alloc.proj (Comonadic Areality) ret_mode) - with - | Ok () -> mode_default ret_value_mode - | Error _ -> raise (Error (loc_fun, env, Function_returns_local)) - end - in + let ret_value_mode = mode_return ret_value_mode in let ret_value_mode = expect_mode_cross env ty_ret ret_value_mode in ret_value_mode in @@ -4943,10 +4813,7 @@ let split_function_ty end end in - let arg_value_mode = - if region_locked then alloc_to_value_l2r arg_mode - else Value.disallow_right (alloc_as_value arg_mode) - in + let arg_value_mode = alloc_to_value_l2r arg_mode in let expected_pat_mode = simple_pat_mode arg_value_mode in let type_sort ~why ty = match Ctype.type_sort ~why env ty with @@ -6657,7 +6524,7 @@ and type_function : type_function_result = let open Jane_syntax.N_ary_functions in - let { ty_fun; loc_fun; _ } = in_function in + let ty_fun, (loc_fun : Location.t) = in_function in (* The "rest of the function" extends from the start of the first parameter to the end of the overall function. The parser does not construct such a location so we forge one for type errors. @@ -7498,6 +7365,7 @@ and type_argument ?explanation ?recarg env (mode : expected_mode) sarg |> Locality.disallow_right, None)} in + let e = {texp with exp_type = ty_res; exp_desc = Texp_exclave e} in let cases = [ case eta_pat e ] in let cases_loc = { texp.exp_loc with loc_ghost = true } in let param = name_cases "param" cases in @@ -7515,7 +7383,6 @@ and type_argument ?explanation ?recarg env (mode : expected_mode) sarg ret_mode = Alloc.disallow_right mret; ret_sort; alloc_mode; - region = false; zero_alloc = Zero_alloc.default } } @@ -8820,13 +8687,7 @@ and type_n_ary_function ~explanation ~attributes ((params, constraint_, body) : Jane_syntax.N_ary_functions.expression) = - let region_locked = not (Is_local_returning.function_body body) in - let in_function = - { ty_fun = mk_expected (instance ty_expected) ?explanation; - loc_fun = loc; - region_locked; - } - in + let in_function = mk_expected (instance ty_expected) ?explanation, loc in let { function_ = exp_type, result_params, body; newtypes; params_contain_gadt = contains_gadt; ret_info; fun_alloc_mode; @@ -8929,7 +8790,7 @@ and type_n_ary_function re { exp_desc = Texp_function - { params; body; region = region_locked; ret_sort; + { params; body; ret_sort; alloc_mode = Mode.Alloc.disallow_left fun_alloc_mode; ret_mode; zero_alloc }; @@ -10224,8 +10085,8 @@ let report_error ~loc env = function "Exclave expression should only be in tail position of the current region." | Exclave_returns_not_local -> Location.errorf ~loc - "This expression was expected to be not local, but is an exclave expression,@ \ - which must be local." + "@[This expression is local because it is an exclave,@ \ + but was expected otherwise.@]" | Optional_poly_param -> Location.errorf ~loc "Optional parameters cannot be polymorphic" diff --git a/ocaml/typing/typedtree.ml b/ocaml/typing/typedtree.ml index 9810efdf1e3..ea1f2f08611 100644 --- a/ocaml/typing/typedtree.ml +++ b/ocaml/typing/typedtree.ml @@ -142,7 +142,6 @@ and expression_desc = | Texp_function of { params : function_param list; body : function_body; - region : bool; ret_mode : Mode.Alloc.l; ret_sort : Jkind.sort; alloc_mode : Mode.Alloc.r; diff --git a/ocaml/typing/typedtree.mli b/ocaml/typing/typedtree.mli index 5f2fe4ef1f1..6c88be54b4f 100644 --- a/ocaml/typing/typedtree.mli +++ b/ocaml/typing/typedtree.mli @@ -259,7 +259,6 @@ and expression_desc = | Texp_function of { params : function_param list; body : function_body; - region : bool; ret_mode : Mode.Alloc.l; (* Mode where the function allocates, ie local for a function of type 'a -> local_ 'b, and heap for a function of type 'a -> 'b *) diff --git a/tests/backend/caml_apply_split_max_arity/stack.ml b/tests/backend/caml_apply_split_max_arity/stack.ml index 32055fed3bc..db741cea8a8 100644 --- a/tests/backend/caml_apply_split_max_arity/stack.ml +++ b/tests/backend/caml_apply_split_max_arity/stack.ml @@ -5,15 +5,15 @@ external opaque : ('a[@local_opt]) -> ('a[@local_opt]) = "%opaque" external local_stack_offset : unit -> int = "caml_local_stack_offset" -let rec grow_local_stack n (local_ acc) = +let rec grow_local_stack n (local_ acc) = exclave_ let local_ acc = acc +. 1. in let local_ acc = if n = 0 then acc else grow_local_stack (n - 1) acc in let local_ acc = acc +. 1. in - local_ acc + acc -let[@inline never] foo (local_ a0) (local_ a1) = +let[@inline never] foo (local_ a0) (local_ a1) = exclave_ let local_ r = a0 +. a1 in - local_ fun (local_ a2) (local_ a3) a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 a51 a52 a53 a54 a55 a56 a57 a58 a59 a60 a61 a62 a63 a64 a65 a66 a67 a68 a69 a70 a71 a72 a73 a74 a75 a76 a77 a78 a79 a80 a81 a82 a83 a84 a85 a86 a87 a88 a89 a90 a91 a92 a93 a94 a95 a96 a97 a98 a99 a100 a101 a102 a103 a104 a105 a106 a107 a108 a109 a110 a111 a112 a113 a114 a115 a116 a117 a118 a119 a120 a121 a122 a123 a124 a125 a126 a127 a128 a129 a130 a131 a132 a133 a134 a135 a136 a137 a138 a139 a140 a141 a142 a143 a144 a145 a146 a147 a148 a149 a150 a151 a152 a153 a154 a155 a156 a157 a158 a159 a160 a161 a162 a163 a164 a165 a166 a167 a168 a169 a170 a171 a172 a173 a174 a175 a176 a177 a178 a179 a180 a181 a182 a183 a184 a185 a186 a187 a188 a189 a190 a191 a192 a193 a194 a195 a196 a197 a198 a199 a200 a201 a202 a203 a204 a205 a206 a207 a208 a209 a210 a211 a212 a213 a214 a215 a216 a217 a218 a219 a220 a221 a222 a223 a224 a225 a226 a227 a228 a229 a230 a231 a232 a233 a234 a235 a236 a237 a238 a239 a240 a241 a242 a243 a244 a245 a246 a247 a248 a249 a250 a251 a252 a253 a254 a255 a256 -> + fun (local_ a2) (local_ a3) a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 a51 a52 a53 a54 a55 a56 a57 a58 a59 a60 a61 a62 a63 a64 a65 a66 a67 a68 a69 a70 a71 a72 a73 a74 a75 a76 a77 a78 a79 a80 a81 a82 a83 a84 a85 a86 a87 a88 a89 a90 a91 a92 a93 a94 a95 a96 a97 a98 a99 a100 a101 a102 a103 a104 a105 a106 a107 a108 a109 a110 a111 a112 a113 a114 a115 a116 a117 a118 a119 a120 a121 a122 a123 a124 a125 a126 a127 a128 a129 a130 a131 a132 a133 a134 a135 a136 a137 a138 a139 a140 a141 a142 a143 a144 a145 a146 a147 a148 a149 a150 a151 a152 a153 a154 a155 a156 a157 a158 a159 a160 a161 a162 a163 a164 a165 a166 a167 a168 a169 a170 a171 a172 a173 a174 a175 a176 a177 a178 a179 a180 a181 a182 a183 a184 a185 a186 a187 a188 a189 a190 a191 a192 a193 a194 a195 a196 a197 a198 a199 a200 a201 a202 a203 a204 a205 a206 a207 a208 a209 a210 a211 a212 a213 a214 a215 a216 a217 a218 a219 a220 a221 a222 a223 a224 a225 a226 a227 a228 a229 a230 a231 a232 a233 a234 a235 a236 a237 a238 a239 a240 a241 a242 a243 a244 a245 a246 a247 a248 a249 a250 a251 a252 a253 a254 a255 a256 -> let local_ z = opaque (a2 +. a3) in let z = globalize z in globalize r +. z +.a4+.a5+.a6+.a7+.a8+.a9+.a10+.a11+.a12+.a13+.a14+.a15+.a16+.a17+.a18+.a19+.a20+.a21+.a22+.a23+.a24+.a25+.a26+.a27+.a28+.a29+.a30+.a31+.a32+.a33+.a34+.a35+.a36+.a37+.a38+.a39+.a40+.a41+.a42+.a43+.a44+.a45+.a46+.a47+.a48+.a49+.a50+.a51+.a52+.a53+.a54+.a55+.a56+.a57+.a58+.a59+.a60+.a61+.a62+.a63+.a64+.a65+.a66+.a67+.a68+.a69+.a70+.a71+.a72+.a73+.a74+.a75+.a76+.a77+.a78+.a79+.a80+.a81+.a82+.a83+.a84+.a85+.a86+.a87+.a88+.a89+.a90+.a91+.a92+.a93+.a94+.a95+.a96+.a97+.a98+.a99+.a100+.a101+.a102+.a103+.a104+.a105+.a106+.a107+.a108+.a109+.a110+.a111+.a112+.a113+.a114+.a115+.a116+.a117+.a118+.a119+.a120+.a121+.a122+.a123+.a124+.a125+.a126+.a127+.a128+.a129+.a130+.a131+.a132+.a133+.a134+.a135+.a136+.a137+.a138+.a139+.a140+.a141+.a142+.a143+.a144+.a145+.a146+.a147+.a148+.a149+.a150+.a151+.a152+.a153+.a154+.a155+.a156+.a157+.a158+.a159+.a160+.a161+.a162+.a163+.a164+.a165+.a166+.a167+.a168+.a169+.a170+.a171+.a172+.a173+.a174+.a175+.a176+.a177+.a178+.a179+.a180+.a181+.a182+.a183+.a184+.a185+.a186+.a187+.a188+.a189+.a190+.a191+.a192+.a193+.a194+.a195+.a196+.a197+.a198+.a199+.a200+.a201+.a202+.a203+.a204+.a205+.a206+.a207+.a208+.a209+.a210+.a211+.a212+.a213+.a214+.a215+.a216+.a217+.a218+.a219+.a220+.a221+.a222+.a223+.a224+.a225+.a226+.a227+.a228+.a229+.a230+.a231+.a232+.a233+.a234+.a235+.a236+.a237+.a238+.a239+.a240+.a241+.a242+.a243+.a244+.a245+.a246+.a247+.a248+.a249+.a250+.a251+.a252+.a253+.a254+.a255+.a256