diff --git a/backend/cmmgen.ml b/backend/cmmgen.ml index a2ac24dbc0f..ed79cadd298 100644 --- a/backend/cmmgen.ml +++ b/backend/cmmgen.ml @@ -133,14 +133,14 @@ let invert_then_else = function let mut_from_env env ptr = match env.environment_param with - | None -> Mutable + | None -> Asttypes.Mutable | Some environment_param -> match ptr with | Cvar ptr -> (* Loads from the current function's closure are immutable. *) - if V.same environment_param ptr then Immutable - else Mutable - | _ -> Mutable + if V.same environment_param ptr then Asttypes.Immutable + else Asttypes.Mutable + | _ -> Asttypes.Mutable let get_field env ptr n dbg = let mut = mut_from_env env ptr in @@ -1192,7 +1192,7 @@ and transl_let env str kind id exp body = (* N.B. [body] must still be traversed even if [exp] will never return: there may be constant closures inside that need lifting out. *) begin match str, kind with - | Immutable, _ -> Clet(id, cexp, transl env body) + | (Immutable | Immutable_unique), _ -> Clet(id, cexp, transl env body) | Mutable, Pintval -> Clet_mut(id, typ_int, cexp, transl env body) | Mutable, _ -> Clet_mut(id, typ_val, cexp, transl env body) end @@ -1203,7 +1203,7 @@ and transl_let env str kind id exp body = let body = transl (add_unboxed_id (VP.var id) unboxed_id boxed_number env) body in begin match str, boxed_number with - | Immutable, _ -> Clet (v, cexp, body) + | (Immutable | Immutable_unique), _ -> Clet (v, cexp, body) | Mutable, bn -> Clet_mut (v, typ_of_boxed_number bn, cexp, body) end diff --git a/middle_end/clambda_primitives.ml b/middle_end/clambda_primitives.ml index c37cbbe3385..71ac6bc498e 100644 --- a/middle_end/clambda_primitives.ml +++ b/middle_end/clambda_primitives.ml @@ -13,7 +13,7 @@ (* *) (**************************************************************************) -type mutable_flag = Asttypes.mutable_flag +type mutable_flag = Lambda.mutable_flag type immediate_or_pointer = Lambda.immediate_or_pointer diff --git a/middle_end/clambda_primitives.mli b/middle_end/clambda_primitives.mli index 305112968c0..84ca642414a 100644 --- a/middle_end/clambda_primitives.mli +++ b/middle_end/clambda_primitives.mli @@ -13,7 +13,7 @@ (* *) (**************************************************************************) -type mutable_flag = Asttypes.mutable_flag +type mutable_flag = Lambda.mutable_flag type immediate_or_pointer = Lambda.immediate_or_pointer diff --git a/middle_end/closure/closure.ml b/middle_end/closure/closure.ml index ea718af57ea..c4331304362 100644 --- a/middle_end/closure/closure.ml +++ b/middle_end/closure/closure.ml @@ -1108,12 +1108,13 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam = let dbg = Debuginfo.from_location loc in check_constant_result (getglobal dbg id) (Compilenv.global_approx id) - | Lprim(Pfield n, [lam], loc) -> + | Lprim(Pfield (n, _), [lam], loc) -> let (ulam, approx) = close env lam in let dbg = Debuginfo.from_location loc in check_constant_result (Uprim(P.Pfield n, [ulam], dbg)) (field_approx n approx) - | Lprim(Psetfield(n, is_ptr, init), [Lprim(Pgetglobal id, [], _); lam], loc)-> + | Lprim(Psetfield(n, is_ptr, init), + [Lprim(Pgetglobal id, [], _); lam], loc)-> let (ulam, approx) = close env lam in if approx <> Value_unknown then (!global_approx).(n) <- approx; diff --git a/middle_end/convert_primitives.ml b/middle_end/convert_primitives.ml index 135eb1f27a9..2d95bc7fb63 100644 --- a/middle_end/convert_primitives.ml +++ b/middle_end/convert_primitives.ml @@ -28,13 +28,13 @@ let convert (prim : Lambda.primitive) : Clambda_primitives.primitive = Pmakeblock (tag, mutability, shape) | Pmakefloatblock mutability -> Pmakearray (Pfloatarray, mutability) - | Pfield field -> Pfield field - | Pfield_computed -> Pfield_computed + | Pfield (field, _sem) -> Pfield field + | Pfield_computed _sem -> Pfield_computed | Psetfield (field, imm_or_pointer, init_or_assign) -> Psetfield (field, imm_or_pointer, init_or_assign) | Psetfield_computed (imm_or_pointer, init_or_assign) -> Psetfield_computed (imm_or_pointer, init_or_assign) - | Pfloatfield field -> Pfloatfield field + | Pfloatfield (field, _sem) -> Pfloatfield field | Psetfloatfield (field, init_or_assign) -> Psetfloatfield (field, init_or_assign) | Pduprecord (repr, size) -> Pduprecord (repr, size) diff --git a/middle_end/flambda/alias_analysis.ml b/middle_end/flambda/alias_analysis.ml index fe97a36f517..3ea66ab6482 100644 --- a/middle_end/flambda/alias_analysis.ml +++ b/middle_end/flambda/alias_analysis.ml @@ -23,8 +23,8 @@ type allocation_point = type allocated_const = | Normal of Allocated_const.t - | Array of Lambda.array_kind * Asttypes.mutable_flag * Variable.t list - | Duplicate_array of Lambda.array_kind * Asttypes.mutable_flag * Variable.t + | Array of Lambda.array_kind * Lambda.mutable_flag * Variable.t list + | Duplicate_array of Lambda.array_kind * Lambda.mutable_flag * Variable.t type constant_defining_value = | Allocated_const of allocated_const diff --git a/middle_end/flambda/alias_analysis.mli b/middle_end/flambda/alias_analysis.mli index 515daeffa34..27b2282d942 100644 --- a/middle_end/flambda/alias_analysis.mli +++ b/middle_end/flambda/alias_analysis.mli @@ -22,8 +22,8 @@ type allocation_point = type allocated_const = | Normal of Allocated_const.t - | Array of Lambda.array_kind * Asttypes.mutable_flag * Variable.t list - | Duplicate_array of Lambda.array_kind * Asttypes.mutable_flag * Variable.t + | Array of Lambda.array_kind * Lambda.mutable_flag * Variable.t list + | Duplicate_array of Lambda.array_kind * Lambda.mutable_flag * Variable.t type constant_defining_value = | Allocated_const of allocated_const diff --git a/middle_end/flambda/inconstant_idents.ml b/middle_end/flambda/inconstant_idents.ml index 28efb3e94aa..18e9d3b89ad 100644 --- a/middle_end/flambda/inconstant_idents.ml +++ b/middle_end/flambda/inconstant_idents.ml @@ -335,15 +335,16 @@ module Inconstants (P:Param) (Backend:Backend_intf.S) = struct makeblock(Mutable) can be a 'constant' if it is allocated at toplevel: if this expression is evaluated only once. *) - | Prim (Pmakeblock (_tag, Asttypes.Immutable, _value_kind), args, - _dbg) -> + | Prim (Pmakeblock (_tag, (Immutable | Immutable_unique), _value_kind), + args, _dbg) -> mark_vars args curr (* (* CR-someday pchambart: If global mutables are allowed: *) | Prim(Lambda.Pmakeblock(_tag, Asttypes.Mutable), args, _dbg, _) when toplevel -> List.iter (mark_loop ~toplevel curr) args *) - | Prim (Pmakearray (Pfloatarray, Immutable), args, _) -> + | Prim (Pmakearray (Pfloatarray, (Immutable | Immutable_unique)), + args, _) -> mark_vars args curr | Prim (Pmakearray (Pfloatarray, Mutable), args, _) -> (* CR-someday pchambart: Toplevel float arrays could always be @@ -356,7 +357,8 @@ module Inconstants (P:Param) (Backend:Backend_intf.S) = struct *) if toplevel then mark_vars args curr else mark_curr curr - | Prim (Pduparray (Pfloatarray, Immutable), [arg], _) -> + | Prim (Pduparray (Pfloatarray, (Immutable | Immutable_unique)), + [arg], _) -> mark_var arg curr | Prim (Pduparray (Pfloatarray, Mutable), [arg], _) -> if toplevel then mark_var arg curr diff --git a/middle_end/flambda/lift_constants.ml b/middle_end/flambda/lift_constants.ml index dd60de9ce2f..5718939c539 100644 --- a/middle_end/flambda/lift_constants.ml +++ b/middle_end/flambda/lift_constants.ml @@ -293,7 +293,7 @@ let translate_definition_and_resolve_alias inconstants ~(backend : (module Backend_intf.S)) : Flambda.constant_defining_value option = let resolve_float_array_involving_variables - ~(mutability : Asttypes.mutable_flag) ~vars = + ~(mutability : Lambda.mutable_flag) ~vars = (* Resolve an [Allocated_const] of the form: [Array (Pfloatarray, _, _)] (which references its contents via variables; it does not contain @@ -326,7 +326,7 @@ let translate_definition_and_resolve_alias inconstants in let const : Allocated_const.t = match mutability with - | Immutable -> Immutable_float_array floats + | Immutable | Immutable_unique -> Immutable_float_array floats | Mutable -> Float_array floats in Some (Flambda.Allocated_const const) @@ -432,7 +432,7 @@ let translate_definition_and_resolve_alias inconstants | Allocated_const (Normal (Immutable_float_array floats)) -> let const : Allocated_const.t = match mutability with - | Immutable -> Immutable_float_array floats + | Immutable | Immutable_unique -> Immutable_float_array floats | Mutable -> Float_array floats in Some (Flambda.Allocated_const const) diff --git a/middle_end/flambda/lift_let_to_initialize_symbol.ml b/middle_end/flambda/lift_let_to_initialize_symbol.ml index ccef0d8a1f3..c2632c0adbd 100644 --- a/middle_end/flambda/lift_let_to_initialize_symbol.ml +++ b/middle_end/flambda/lift_let_to_initialize_symbol.ml @@ -81,7 +81,8 @@ let rec accumulate ~substitution ~copied_lets ~extracted_lets let extracted = let renamed = Variable.rename var in match named with - | Prim (Pmakeblock (tag, Asttypes.Immutable, _value_kind), args, _dbg) -> + | Prim (Pmakeblock (tag, (Immutable | Immutable_unique), _value_kind), + args, _dbg) -> let tag = Tag.create_exn tag in let args = List.map (fun v -> diff --git a/middle_end/flambda/ref_to_variables.ml b/middle_end/flambda/ref_to_variables.ml index aa2a73c6305..eb6c333b40e 100644 --- a/middle_end/flambda/ref_to_variables.ml +++ b/middle_end/flambda/ref_to_variables.ml @@ -91,7 +91,7 @@ let variables_containing_ref (flam:Flambda.t) = let aux (flam : Flambda.t) = match flam with | Let { var; - defining_expr = Prim(Pmakeblock(0, Asttypes.Mutable, _), l, _); + defining_expr = Prim(Pmakeblock(0, Mutable, _), l, _); } -> map := Variable.Map.add var (List.length l) !map | _ -> () @@ -127,7 +127,7 @@ let eliminate_ref_of_expr flam = let aux (flam : Flambda.t) : Flambda.t = match flam with | Let { var; - defining_expr = Prim(Pmakeblock(0, Asttypes.Mutable, shape), l,_); + defining_expr = Prim(Pmakeblock(0, Mutable, shape), l,_); body } when convertible_variable var -> let shape = match shape with diff --git a/middle_end/flambda/simplify_primitives.ml b/middle_end/flambda/simplify_primitives.ml index c7344db23c4..c2dee7a3b83 100644 --- a/middle_end/flambda/simplify_primitives.ml +++ b/middle_end/flambda/simplify_primitives.ml @@ -108,7 +108,7 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs) : Flambda.named * A.t * Inlining_cost.Benefit.t = let fpc = !Clflags.float_const_prop in match p with - | Pmakeblock(tag_int, Asttypes.Immutable, shape) -> + | Pmakeblock(tag_int, (Immutable | Immutable_unique), shape) -> let tag = Tag.create_exn tag_int in let shape = match shape with | None -> List.map (fun _ -> Lambda.Pgenval) args @@ -116,19 +116,19 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs) in let approxs = List.map2 A.augment_with_kind approxs shape in let shape = List.map2 A.augment_kind_with_approx approxs shape in - Prim (Pmakeblock(tag_int, Asttypes.Immutable, Some shape), args, dbg), + Prim (Pmakeblock(tag_int, Lambda.Immutable, Some shape), args, dbg), A.value_block tag (Array.of_list approxs), C.Benefit.zero | Praise _ -> expr, A.value_bottom, C.Benefit.zero | Pmakearray(_, _) when is_empty approxs -> - Prim (Pmakeblock(0, Asttypes.Immutable, Some []), [], dbg), + Prim (Pmakeblock(0, Lambda.Immutable, Some []), [], dbg), A.value_block (Tag.create_exn 0) [||], C.Benefit.zero | Pmakearray (Pfloatarray, Mutable) -> let approx = A.value_mutable_float_array ~size:(List.length args) in expr, approx, C.Benefit.zero - | Pmakearray (Pfloatarray, Immutable) -> + | Pmakearray (Pfloatarray, (Immutable | Immutable_unique)) -> let approx = A.value_immutable_float_array (Array.of_list approxs) in diff --git a/middle_end/internal_variable_names.ml b/middle_end/internal_variable_names.ml index 674d6625219..a27f98f3baf 100644 --- a/middle_end/internal_variable_names.ml +++ b/middle_end/internal_variable_names.ml @@ -326,7 +326,7 @@ let of_primitive : Lambda.primitive -> string = function | Pmakeblock _ -> pmakeblock | Pmakefloatblock _ -> pmakefloatblock | Pfield _ -> pfield - | Pfield_computed -> pfield_computed + | Pfield_computed _ -> pfield_computed | Psetfield _ -> psetfield | Psetfield_computed _ -> psetfield_computed | Pfloatfield _ -> pfloatfield @@ -434,7 +434,7 @@ let of_primitive_arg : Lambda.primitive -> string = function | Pmakeblock _ -> pmakeblock_arg | Pmakefloatblock _ -> pmakefloatblock_arg | Pfield _ -> pfield_arg - | Pfield_computed -> pfield_computed_arg + | Pfield_computed _ -> pfield_computed_arg | Psetfield _ -> psetfield_arg | Psetfield_computed _ -> psetfield_computed_arg | Pfloatfield _ -> pfloatfield_arg diff --git a/middle_end/printclambda.ml b/middle_end/printclambda.ml index 4ee88818411..f6a0b10cf58 100644 --- a/middle_end/printclambda.ml +++ b/middle_end/printclambda.ml @@ -15,15 +15,14 @@ open Format -open Asttypes open Clambda module V = Backend_var module VP = Backend_var.With_provenance let mutable_flag = function - | Mutable-> "[mut]" - | Immutable -> "" + | Lambda.Mutable-> "[mut]" + | Lambda.Immutable | Lambda.Immutable_unique -> "" let value_kind = let open Lambda in diff --git a/middle_end/printclambda_primitives.ml b/middle_end/printclambda_primitives.ml index e9c7b22b9cf..6e0b126e05e 100644 --- a/middle_end/printclambda_primitives.ml +++ b/middle_end/printclambda_primitives.ml @@ -15,7 +15,6 @@ open Format -open Asttypes let boxed_integer_name = function | Lambda.Pnativeint -> "nativeint" @@ -59,6 +58,8 @@ let primitive ppf (prim:Clambda_primitives.primitive) = fprintf ppf "read_symbol %s" sym | Pmakeblock(tag, Immutable, shape) -> fprintf ppf "makeblock %i%a" tag Printlambda.block_shape shape + | Pmakeblock(tag, Immutable_unique, shape) -> + fprintf ppf "makeblock_unique %i%a" tag Printlambda.block_shape shape | Pmakeblock(tag, Mutable, shape) -> fprintf ppf "makemutable %i%a" tag Printlambda.block_shape shape | Pfield n -> fprintf ppf "field %i" n @@ -146,8 +147,12 @@ let primitive ppf (prim:Clambda_primitives.primitive) = | Parraylength k -> fprintf ppf "array.length[%s]" (array_kind k) | Pmakearray (k, Mutable) -> fprintf ppf "makearray[%s]" (array_kind k) | Pmakearray (k, Immutable) -> fprintf ppf "makearray_imm[%s]" (array_kind k) + | Pmakearray (k, Immutable_unique) -> + fprintf ppf "makearray_unique[%s]" (array_kind k) | Pduparray (k, Mutable) -> fprintf ppf "duparray[%s]" (array_kind k) | Pduparray (k, Immutable) -> fprintf ppf "duparray_imm[%s]" (array_kind k) + | Pduparray (k, Immutable_unique) -> + fprintf ppf "duparray_unique[%s]" (array_kind k) | Parrayrefu k -> fprintf ppf "array.unsafe_get[%s]" (array_kind k) | Parraysetu k -> fprintf ppf "array.unsafe_set[%s]" (array_kind k) | Parrayrefs k -> fprintf ppf "array.get[%s]" (array_kind k) diff --git a/middle_end/semantics_of_primitives.ml b/middle_end/semantics_of_primitives.ml index 8109ad457d0..c22b74de438 100644 --- a/middle_end/semantics_of_primitives.ml +++ b/middle_end/semantics_of_primitives.ml @@ -23,8 +23,8 @@ let for_primitive (prim : Clambda_primitives.primitive) = match prim with | Pmakeblock _ | Pmakearray (_, Mutable) -> Only_generative_effects, No_coeffects - | Pmakearray (_, Immutable) -> No_effects, No_coeffects - | Pduparray (_, Immutable) -> + | Pmakearray (_, (Immutable | Immutable_unique)) -> No_effects, No_coeffects + | Pduparray (_, (Immutable | Immutable_unique)) -> No_effects, No_coeffects (* Pduparray (_, Immutable) is allowed only on immutable arrays. *) | Pduparray (_, Mutable) | Pduprecord _ -> diff --git a/native_toplevel/opttoploop.ml b/native_toplevel/opttoploop.ml index ef8088653fb..03b9e11da1a 100644 --- a/native_toplevel/opttoploop.ml +++ b/native_toplevel/opttoploop.ml @@ -84,7 +84,7 @@ let close_phrase lam = Ident.Set.fold (fun id l -> let glb, pos = toplevel_value id in let glob = - Lprim (Pfield pos, + Lprim (mod_field pos, [Lprim (Pgetglobal glb, [], Loc_unknown)], Loc_unknown) in diff --git a/ocaml/asmcomp/cmmgen.ml b/ocaml/asmcomp/cmmgen.ml index d127436fc14..0532b69737d 100644 --- a/ocaml/asmcomp/cmmgen.ml +++ b/ocaml/asmcomp/cmmgen.ml @@ -108,14 +108,14 @@ let invert_then_else = function let mut_from_env env ptr = match env.environment_param with - | None -> Mutable + | None -> Asttypes.Mutable | Some environment_param -> match ptr with | Cvar ptr -> (* Loads from the current function's closure are immutable. *) - if V.same environment_param ptr then Immutable - else Mutable - | _ -> Mutable + if V.same environment_param ptr then Asttypes.Immutable + else Asttypes.Mutable + | _ -> Asttypes.Mutable let get_field env ptr n dbg = let mut = mut_from_env env ptr in @@ -1160,7 +1160,7 @@ and transl_let env str kind id exp body = (* N.B. [body] must still be traversed even if [exp] will never return: there may be constant closures inside that need lifting out. *) begin match str, kind with - | Immutable, _ -> Clet(id, cexp, transl env body) + | (Immutable | Immutable_unique), _ -> Clet(id, cexp, transl env body) | Mutable, Pintval -> Clet_mut(id, typ_int, cexp, transl env body) | Mutable, _ -> Clet_mut(id, typ_val, cexp, transl env body) end @@ -1171,7 +1171,7 @@ and transl_let env str kind id exp body = let body = transl (add_unboxed_id (VP.var id) unboxed_id boxed_number env) body in begin match str, boxed_number with - | Immutable, _ -> Clet (v, cexp, body) + | (Immutable | Immutable_unique), _ -> Clet (v, cexp, body) | Mutable, bn -> Clet_mut (v, typ_of_boxed_number bn, cexp, body) end diff --git a/ocaml/boot/ocamlc b/ocaml/boot/ocamlc index b480100daa4..af08df72c7a 100755 Binary files a/ocaml/boot/ocamlc and b/ocaml/boot/ocamlc differ diff --git a/ocaml/boot/ocamllex b/ocaml/boot/ocamllex index 84f92d84de3..6dc9d5a657c 100755 Binary files a/ocaml/boot/ocamllex and b/ocaml/boot/ocamllex differ diff --git a/ocaml/bytecomp/bytegen.ml b/ocaml/bytecomp/bytegen.ml index b2e56fc9ab8..55b0b25450d 100644 --- a/ocaml/bytecomp/bytegen.ml +++ b/ocaml/bytecomp/bytegen.ml @@ -113,7 +113,7 @@ let preserve_tailcall_for_prim = function true | Pbytes_to_string | Pbytes_of_string | Pignore | Pgetglobal _ | Psetglobal _ | Pmakeblock _ | Pmakefloatblock _ - | Pfield _ | Pfield_computed | Psetfield _ + | Pfield _ | Pfield_computed _ | Psetfield _ | Psetfield_computed _ | Pfloatfield _ | Psetfloatfield _ | Pduprecord _ | Pccall _ | Praise _ | Pnot | Pnegint | Paddint | Psubint | Pmulint | Pdivint _ | Pmodint _ | Pandint | Porint | Pxorint | Plslint | Plsrint @@ -394,10 +394,11 @@ let comp_primitive p args = | Pcompare_ints -> Kccall("caml_int_compare", 2) | Pcompare_floats -> Kccall("caml_float_compare", 2) | Pcompare_bints bi -> comp_bint_primitive bi "compare" args - | Pfield n -> Kgetfield n - | Pfield_computed -> Kgetvectitem + | Pfield (n, _sem) -> Kgetfield n + | Pfield_computed _sem -> Kgetvectitem | Psetfield(n, _ptr, _init) -> Ksetfield n | Psetfield_computed(_ptr, _init) -> Ksetvectitem + | Pfloatfield (n, _sem) -> Kgetfloatfield n | Psetfloatfield (n, _init) -> Ksetfloatfield n | Pduprecord _ -> Kccall("caml_obj_dup", 1) | Pccall p -> Kccall(p.prim_name, p.prim_arity) @@ -789,7 +790,7 @@ let rec comp_expr env exp sz cont = | Lprim(Pmakeblock(tag, _mut, _), args, loc) -> let cont = add_pseudo_event loc !compunit_name cont in comp_args env args sz (Kmakeblock(List.length args, tag) :: cont) - | Lprim(Pfloatfield n, args, loc) -> + | Lprim(Pfloatfield (n, _sem), args, loc) -> let cont = add_pseudo_event loc !compunit_name cont in comp_args env args sz (Kgetfloatfield n :: cont) | Lprim(p, args, _) -> diff --git a/ocaml/lambda/lambda.ml b/ocaml/lambda/lambda.ml index cef4c3d8107..1548de4a4d2 100644 --- a/ocaml/lambda/lambda.ml +++ b/ocaml/lambda/lambda.ml @@ -16,6 +16,8 @@ open Misc open Asttypes +type mutable_flag = Immutable | Immutable_unique | Mutable + type compile_time_constant = | Big_endian | Word_size @@ -39,6 +41,10 @@ type is_safe = | Safe | Unsafe +type field_read_semantics = + | Reads_agree + | Reads_vary + type primitive = | Pidentity | Pbytes_to_string @@ -52,11 +58,11 @@ type primitive = (* Operations on heap blocks *) | Pmakeblock of int * mutable_flag * block_shape | Pmakefloatblock of mutable_flag - | Pfield of int - | Pfield_computed + | Pfield of int * field_read_semantics + | Pfield_computed of field_read_semantics | Psetfield of int * immediate_or_pointer * initialization_or_assignment | Psetfield_computed of immediate_or_pointer * initialization_or_assignment - | Pfloatfield of int + | Pfloatfield of int * field_read_semantics | Psetfloatfield of int * initialization_or_assignment | Pduprecord of Types.record_representation * int (* Force lazy values *) @@ -657,7 +663,7 @@ let rec transl_address loc = function then Lprim(Pgetglobal id, [], loc) else Lvar id | Env.Adot(addr, pos) -> - Lprim(Pfield pos, [transl_address loc addr], loc) + Lprim(Pfield (pos, Reads_agree), [transl_address loc addr], loc) let transl_path find loc env path = match find path env with @@ -969,3 +975,9 @@ let max_arity () = let reset () = raise_count := 0 + +let mod_field ?(read_semantics=Reads_agree) pos = + Pfield (pos, read_semantics) + +let mod_setfield pos = + Psetfield (pos, Pointer, Root_initialization) diff --git a/ocaml/lambda/lambda.mli b/ocaml/lambda/lambda.mli index 0b6d9356d4a..b0c92d73948 100644 --- a/ocaml/lambda/lambda.mli +++ b/ocaml/lambda/lambda.mli @@ -17,6 +17,9 @@ open Asttypes +(* Overriding Asttypes.mutable_flag *) +type mutable_flag = Immutable | Immutable_unique | Mutable + type compile_time_constant = | Big_endian | Word_size @@ -45,6 +48,10 @@ type is_safe = | Safe | Unsafe +type field_read_semantics = + | Reads_agree + | Reads_vary + type primitive = | Pidentity | Pbytes_to_string @@ -58,11 +65,11 @@ type primitive = (* Operations on heap blocks *) | Pmakeblock of int * mutable_flag * block_shape | Pmakefloatblock of mutable_flag - | Pfield of int - | Pfield_computed + | Pfield of int * field_read_semantics + | Pfield_computed of field_read_semantics | Psetfield of int * immediate_or_pointer * initialization_or_assignment | Psetfield_computed of immediate_or_pointer * initialization_or_assignment - | Pfloatfield of int + | Pfloatfield of int * field_read_semantics | Psetfloatfield of int * initialization_or_assignment | Pduprecord of Types.record_representation * int (* External call *) @@ -464,3 +471,10 @@ val merge_inline_attributes -> inline_attribute option val reset: unit -> unit + +(** Helpers for module block accesses. + Module accesses are always immutable, except in translobj where the + method cache is stored in a mutable module field. +*) +val mod_field: ?read_semantics: field_read_semantics -> int -> primitive +val mod_setfield: int -> primitive diff --git a/ocaml/lambda/matching.ml b/ocaml/lambda/matching.ml index 4824ab9a6f0..e9ed6f245c0 100644 --- a/ocaml/lambda/matching.ml +++ b/ocaml/lambda/matching.ml @@ -1679,7 +1679,8 @@ let get_expr_args_constr ~scopes head (arg, _mut) rem = if pos > last_pos then argl else - (Lprim (Pfield pos, [ arg ], loc), binding_kind) :: make_args (pos + 1) + (Lprim (Pfield (pos, Reads_agree), [ arg ], loc), binding_kind) + :: make_args (pos + 1) in make_args first_pos in @@ -1705,9 +1706,13 @@ let divide_constructor ~scopes ctx pm = let get_expr_args_variant_constant = drop_expr_arg +let nonconstant_variant_field index = + Lambda.Pfield(index, Reads_agree) + let get_expr_args_variant_nonconst ~scopes head (arg, _mut) rem = let loc = head_loc ~scopes head in - (Lprim (Pfield 1, [ arg ], loc), Alias) :: rem + let field_prim = nonconstant_variant_field 1 in + (Lprim (field_prim, [ arg ], loc), Alias) :: rem let divide_variant ~scopes row ctx { cases = cl; args; default = def } = let row = Btype.row_repr row in @@ -1805,6 +1810,8 @@ let code_force_lazy = get_mod_field "CamlinternalLazy" "force" Forward(val_out_of_heap). *) +let lazy_forward_field = Lambda.Pfield (0, Reads_vary) + let inline_lazy_force_cond arg loc = let idarg = Ident.create_local "lzarg" in let varg = Lvar idarg in @@ -1827,7 +1834,7 @@ let inline_lazy_force_cond arg loc = ( Pintcomp Ceq, [ tag_var; Lconst (Const_base (Const_int Obj.forward_tag)) ], loc ), - Lprim (Pfield 0, [ varg ], loc), + Lprim (lazy_forward_field, [ varg ], loc), Lifthenelse (* if (tag == Obj.lazy_tag) then Lazy.force varg else ... *) ( Lprim @@ -1865,7 +1872,8 @@ let inline_lazy_force_switch arg loc = sw_numblocks = 256; (* PR#6033 - tag ranges from 0 to 255 *) sw_blocks = - [ (Obj.forward_tag, Lprim (Pfield 0, [ varg ], loc)); + [ ( Obj.forward_tag, + Lprim (lazy_forward_field, [ varg ], loc) ); ( Obj.lazy_tag, Lapply { ap_tailcall = Default_tailcall; @@ -1929,7 +1937,8 @@ let get_expr_args_tuple ~scopes head (arg, _mut) rem = if pos >= arity then rem else - (Lprim (Pfield pos, [ arg ], loc), Alias) :: make_args (pos + 1) + (Lprim (Pfield (pos, Reads_agree), [ arg ], loc), Alias) + :: make_args (pos + 1) in make_args 0 @@ -1969,14 +1978,20 @@ let get_expr_args_record ~scopes head (arg, _mut) rem = rem else let lbl = all_labels.(pos) in + let sem = + match lbl.lbl_mut with + | Immutable -> Reads_agree + | Mutable -> Reads_vary + in let access = match lbl.lbl_repres with | Record_regular | Record_inlined _ -> - Lprim (Pfield lbl.lbl_pos, [ arg ], loc) + Lprim (Pfield (lbl.lbl_pos, sem), [ arg ], loc) | Record_unboxed _ -> arg - | Record_float -> Lprim (Pfloatfield lbl.lbl_pos, [ arg ], loc) - | Record_extension _ -> Lprim (Pfield (lbl.lbl_pos + 1), [ arg ], loc) + | Record_float -> Lprim (Pfloatfield (lbl.lbl_pos, sem), [ arg ], loc) + | Record_extension _ -> + Lprim (Pfield (lbl.lbl_pos + 1, sem), [ arg ], loc) in let str = match lbl.lbl_mut with @@ -2711,7 +2726,9 @@ let combine_constructor loc arg pat_env cstr partial ctx def (Lprim (Pintcomp Ceq, [ Lvar tag; ext ], loc), act, rem)) nonconsts default in - Llet (Alias, Pgenval, tag, Lprim (Pfield 0, [ arg ], loc), tests) + Llet (Alias, Pgenval, tag, + Lprim (Pfield (0, Reads_agree), [ arg ], loc), + tests) in List.fold_right (fun (path, act) rem -> @@ -2802,7 +2819,7 @@ let call_switcher_variant_constr loc fail arg int_lambda_list = ( Alias, Pgenval, v, - Lprim (Pfield 0, [ arg ], loc), + Lprim (nonconstant_variant_field 0, [ arg ], loc), call_switcher loc fail (Lvar v) min_int max_int int_lambda_list ) let combine_variant loc row arg partial ctx def (tag_lambda_list, total1, _pats) diff --git a/ocaml/lambda/printlambda.ml b/ocaml/lambda/printlambda.ml index e40111c4195..784c4c983e3 100644 --- a/ocaml/lambda/printlambda.ml +++ b/ocaml/lambda/printlambda.ml @@ -174,6 +174,11 @@ let float_comparison ppf = function | CFge -> fprintf ppf ">=." | CFnge -> fprintf ppf "!>=." +let field_read_semantics ppf sem = + match sem with + | Reads_agree -> () + | Reads_vary -> fprintf ppf "_mut" + let primitive ppf = function | Pidentity -> fprintf ppf "id" | Pbytes_to_string -> fprintf ppf "bytes_to_string" @@ -185,12 +190,18 @@ let primitive ppf = function | Psetglobal id -> fprintf ppf "setglobal %a" Ident.print id | Pmakeblock(tag, Immutable, shape) -> fprintf ppf "makeblock %i%a" tag block_shape shape + | Pmakeblock(tag, Immutable_unique, shape) -> + fprintf ppf "makeblock_unique %i%a" tag block_shape shape | Pmakeblock(tag, Mutable, shape) -> fprintf ppf "makemutable %i%a" tag block_shape shape | Pmakefloatblock Immutable -> fprintf ppf "makefloatblock Immutable" + | Pmakefloatblock Immutable_unique -> + fprintf ppf "makefloatblock Immutable_unique" | Pmakefloatblock Mutable -> fprintf ppf "makefloatblock Mutable" - | Pfield n -> fprintf ppf "field %i" n - | Pfield_computed -> fprintf ppf "field_computed" + | Pfield (n, sem) -> + fprintf ppf "field%a %i" field_read_semantics sem n + | Pfield_computed sem -> + fprintf ppf "field_computed%a" field_read_semantics sem | Psetfield(n, ptr, init) -> let instr = match ptr with @@ -217,7 +228,8 @@ let primitive ppf = function | Assignment -> "" in fprintf ppf "setfield_%s%s_computed" instr init - | Pfloatfield n -> fprintf ppf "floatfield %i" n + | Pfloatfield (n, sem) -> + fprintf ppf "floatfield%a %i" field_read_semantics sem n | Psetfloatfield (n, init) -> let init = match init with @@ -273,8 +285,12 @@ let primitive ppf = function | Parraylength k -> fprintf ppf "array.length[%s]" (array_kind k) | Pmakearray (k, Mutable) -> fprintf ppf "makearray[%s]" (array_kind k) | Pmakearray (k, Immutable) -> fprintf ppf "makearray_imm[%s]" (array_kind k) + | Pmakearray (k, Immutable_unique) -> + fprintf ppf "makearray_unique[%s]" (array_kind k) | Pduparray (k, Mutable) -> fprintf ppf "duparray[%s]" (array_kind k) | Pduparray (k, Immutable) -> fprintf ppf "duparray_imm[%s]" (array_kind k) + | Pduparray (k, Immutable_unique) -> + fprintf ppf "duparray_unique[%s]" (array_kind k) | Parrayrefu k -> fprintf ppf "array.unsafe_get[%s]" (array_kind k) | Parraysetu k -> fprintf ppf "array.unsafe_set[%s]" (array_kind k) | Parrayrefs k -> fprintf ppf "array.get[%s]" (array_kind k) @@ -387,7 +403,7 @@ let name_of_primitive = function | Pmakeblock _ -> "Pmakeblock" | Pmakefloatblock _ -> "Pmakefloatblock" | Pfield _ -> "Pfield" - | Pfield_computed -> "Pfield_computed" + | Pfield_computed _ -> "Pfield_computed" | Psetfield _ -> "Psetfield" | Psetfield_computed _ -> "Psetfield_computed" | Pfloatfield _ -> "Pfloatfield" diff --git a/ocaml/lambda/simplif.ml b/ocaml/lambda/simplif.ml index 26ef126049a..a72afa4e2d3 100644 --- a/ocaml/lambda/simplif.ml +++ b/ocaml/lambda/simplif.ml @@ -40,9 +40,10 @@ let rec eliminate_ref id = function | Lletrec(idel, e2) -> Lletrec(List.map (fun (v, e) -> (v, eliminate_ref id e)) idel, eliminate_ref id e2) - | Lprim(Pfield 0, [Lvar v], _) when Ident.same v id -> + | Lprim(Pfield (0, _sem), [Lvar v], _) when Ident.same v id -> Lvar id - | Lprim(Psetfield(0, _, _), [Lvar v; e], _) when Ident.same v id -> + | Lprim(Psetfield(0, _, _), [Lvar v; e], _) + when Ident.same v id -> Lassign(id, eliminate_ref id e) | Lprim(Poffsetref delta, [Lvar v], loc) when Ident.same v id -> Lassign(id, Lprim(Poffsetint delta, [Lvar id], loc)) diff --git a/ocaml/lambda/translclass.ml b/ocaml/lambda/translclass.ml index 892439fb36c..153eb18be5c 100644 --- a/ocaml/lambda/translclass.ml +++ b/ocaml/lambda/translclass.ml @@ -63,7 +63,8 @@ let mkappl (func, args) = let lsequence l1 l2 = if l2 = lambda_unit then l1 else Lsequence(l1, l2) -let lfield v i = Lprim(Pfield i, [Lvar v], Loc_unknown) +let lfield v i = + Lprim(Pfield (i, Reads_vary), [Lvar v], Loc_unknown) let transl_label l = share (Const_immstring l) @@ -134,7 +135,7 @@ let rec build_object_init ~scopes cl_table obj params inh_init obj_init cl = let env = match envs with None -> [] | Some envs -> - [Lprim(Pfield (List.length inh_init + 1), + [Lprim(Pfield (List.length inh_init + 1, Reads_vary), [Lvar envs], Loc_unknown)] in @@ -272,6 +273,8 @@ let rec index a = function let bind_id_as_val (id, _) = ("", id) +let class_field i = Pfield (i, Reads_vary) + let rec build_class_init ~scopes cla cstr super inh_init cl_init msubst top cl = match cl.cl_desc with | Tcl_ident _ -> @@ -279,8 +282,8 @@ let rec build_class_init ~scopes cla cstr super inh_init cl_init msubst top cl = | (_, path_lam, obj_init)::inh_init -> (inh_init, Llet (Strict, Pgenval, obj_init, - mkappl(Lprim(Pfield 1, [path_lam], Loc_unknown), Lvar cla :: - if top then [Lprim(Pfield 3, [path_lam], Loc_unknown)] + mkappl(Lprim(class_field 1, [path_lam], Loc_unknown), Lvar cla :: + if top then [Lprim(class_field 3, [path_lam], Loc_unknown)] else []), bind_super cla super cl_init)) | _ -> @@ -553,7 +556,7 @@ let rec builtin_meths self env env2 body = | p when const_path p -> "const", [p] | Lprim(Parrayrefu _, [Lvar s; Lvar n], _) when List.mem s self -> "var", [Lvar n] - | Lprim(Pfield n, [Lvar e], _) when Ident.same e env -> + | Lprim(Pfield (n, _), [Lvar e], _) when Ident.same e env -> "env", [Lvar env2; Lconst(const_int n)] | Lsend(Self, met, Lvar s, [], _) when List.mem s self -> "meth", [met] @@ -735,7 +738,7 @@ let transl_class ~scopes ids cl_id pub_meths cl vflag = [lfunction ((self, Pgenval) :: args) (if not (Ident.Set.mem env (free_variables body')) then body' else Llet(Alias, Pgenval, env, - Lprim(Pfield_computed, + Lprim(Pfield_computed Reads_vary, [Lvar self; Lvar env2], Loc_unknown), body'))] @@ -849,7 +852,7 @@ let transl_class ~scopes ids cl_id pub_meths cl vflag = Loc_unknown) and linh_envs = List.map - (fun (_, path_lam, _) -> Lprim(Pfield 3, [path_lam], Loc_unknown)) + (fun (_, path_lam, _) -> Lprim(class_field 3, [path_lam], Loc_unknown)) (List.rev inh_init) in let make_envs lam = @@ -869,7 +872,8 @@ let transl_class ~scopes ids cl_id pub_meths cl vflag = in let inh_keys = List.map - (fun (_, path_lam, _) -> Lprim(Pfield 1, [path_lam], Loc_unknown)) + (fun (_, path_lam, _) -> + Lprim(class_field 1, [path_lam], Loc_unknown)) inh_paths in let lclass lam = diff --git a/ocaml/lambda/translcore.ml b/ocaml/lambda/translcore.ml index d19345fffa9..e0174e321c2 100644 --- a/ocaml/lambda/translcore.ml +++ b/ocaml/lambda/translcore.ml @@ -72,7 +72,7 @@ let transl_extension_constructor ~scopes env path ext = let loc = of_location ~scopes ext.ext_loc in match ext.ext_kind with Text_decl _ -> - Lprim (Pmakeblock (Obj.object_tag, Immutable, None), + Lprim (Pmakeblock (Obj.object_tag, Immutable_unique, None), [Lconst (Const_base (Const_string (name, ext.ext_loc, None))); Lprim (prim_fresh_oo_id, [Lconst (const_int 0)], loc)], loc) @@ -369,16 +369,21 @@ and transl_exp0 ~in_new_scope ~scopes e = fields representation extended_expression | Texp_field(arg, _, lbl) -> let targ = transl_exp ~scopes arg in + let sem = + match lbl.lbl_mut with + | Immutable -> Reads_agree + | Mutable -> Reads_vary + in begin match lbl.lbl_repres with Record_regular | Record_inlined _ -> - Lprim (Pfield lbl.lbl_pos, [targ], + Lprim (Pfield (lbl.lbl_pos, sem), [targ], of_location ~scopes e.exp_loc) | Record_unboxed _ -> targ | Record_float -> - Lprim (Pfloatfield lbl.lbl_pos, [targ], + Lprim (Pfloatfield (lbl.lbl_pos, sem), [targ], of_location ~scopes e.exp_loc) | Record_extension _ -> - Lprim (Pfield (lbl.lbl_pos + 1), [targ], + Lprim (Pfield (lbl.lbl_pos + 1, sem), [targ], of_location ~scopes e.exp_loc) end | Texp_setfield(arg, _, lbl, newval) -> @@ -390,7 +395,7 @@ and transl_exp0 ~in_new_scope ~scopes e = | Record_unboxed _ -> assert false | Record_float -> Psetfloatfield (lbl.lbl_pos, Assignment) | Record_extension _ -> - Psetfield (lbl.lbl_pos + 1, maybe_pointer newval, Assignment) + Psetfield (lbl.lbl_pos, maybe_pointer newval, Assignment) in Lprim(access, [transl_exp ~scopes arg; transl_exp ~scopes newval], of_location ~scopes e.exp_loc) @@ -478,7 +483,8 @@ and transl_exp0 ~in_new_scope ~scopes e = Lapply{ ap_loc=loc; ap_func= - Lprim(Pfield 0, [transl_class_path loc e.exp_env cl], loc); + Lprim(Pfield (0, Reads_vary), + [transl_class_path loc e.exp_env cl], loc); ap_args=[lambda_unit]; ap_tailcall=Default_tailcall; ap_inlined=Default_inline; @@ -489,7 +495,7 @@ and transl_exp0 ~in_new_scope ~scopes e = let loc = of_location ~scopes e.exp_loc in let self = transl_value_path loc e.exp_env path_self in let var = transl_value_path loc e.exp_env path in - Lprim(Pfield_computed, [self; var], loc) + Lprim(Pfield_computed Reads_vary, [self; var], loc) | Texp_setinstvar(path_self, path, _, expr) -> let loc = of_location ~scopes e.exp_loc in let self = transl_value_path loc e.exp_env path_self in @@ -614,7 +620,7 @@ and transl_exp0 ~in_new_scope ~scopes e = let body, _ = List.fold_left (fun (body, pos) id -> Llet(Alias, Pgenval, id, - Lprim(Pfield pos, [Lvar oid], + Lprim(mod_field pos, [Lvar oid], of_location ~scopes od.open_loc), body), pos + 1 ) (transl_exp ~scopes e, 0) @@ -1000,16 +1006,21 @@ and transl_record ~scopes loc env fields repres opt_init_expr = let init_id = Ident.create_local "init" in let lv = Array.mapi - (fun i (_, definition) -> + (fun i (lbl, definition) -> match definition with | Kept typ -> let field_kind = value_kind env typ in + let sem = + match lbl.lbl_mut with + | Immutable -> Reads_agree + | Mutable -> Reads_vary + in let access = match repres with - Record_regular | Record_inlined _ -> Pfield i + Record_regular | Record_inlined _ -> Pfield (i, sem) | Record_unboxed _ -> assert false - | Record_extension _ -> Pfield (i + 1) - | Record_float -> Pfloatfield i in + | Record_extension _ -> Pfield (i + 1, sem) + | Record_float -> Pfloatfield (i, sem) in Lprim(access, [Lvar init_id], of_location ~scopes loc), field_kind @@ -1019,8 +1030,8 @@ and transl_record ~scopes loc env fields repres opt_init_expr = fields in let ll, shape = List.split (Array.to_list lv) in - let mut = - if Array.exists (fun (lbl, _) -> lbl.lbl_mut = Mutable) fields + let mut : Lambda.mutable_flag = + if Array.exists (fun (lbl, _) -> lbl.lbl_mut = Asttypes.Mutable) fields then Mutable else Immutable in let lam = diff --git a/ocaml/lambda/translmod.ml b/ocaml/lambda/translmod.ml index efdbdadda32..85b2974b1b0 100644 --- a/ocaml/lambda/translmod.ml +++ b/ocaml/lambda/translmod.ml @@ -83,7 +83,8 @@ let rec apply_coercion loc strict restr arg = name_lambda strict arg (fun id -> let get_field pos = if pos < 0 then lambda_unit - else Lprim(Pfield pos,[Lvar id], loc) + else + Lprim(mod_field pos,[Lvar id], loc) in let lam = Lprim(Pmakeblock(0, Immutable, None), @@ -758,7 +759,7 @@ and transl_structure ~scopes loc fields cc rootpath final_env = function rebind_idents (pos + 1) (id :: newfields) ids in Llet(Alias, Pgenval, id, - Lprim(Pfield pos, [Lvar mid], + Lprim(mod_field pos, [Lvar mid], of_location ~scopes incl.incl_loc), body), size in @@ -787,7 +788,7 @@ and transl_structure ~scopes loc fields cc rootpath final_env = function rebind_idents (pos + 1) (id :: newfields) ids in Llet(Alias, Pgenval, id, - Lprim(Pfield pos, [Lvar mid], + Lprim(mod_field pos, [Lvar mid], of_location ~scopes od.open_loc), body), size in @@ -1009,7 +1010,8 @@ let transl_store_subst = ref Ident.Map.empty let nat_toplevel_name id = try match Ident.Map.find id !transl_store_subst with - | Lprim(Pfield pos, [Lprim(Pgetglobal glob, [], _)], _) -> (glob,pos) + | Lprim(Pfield (pos, _), + [Lprim(Pgetglobal glob, [], _)], _) -> (glob,pos) | _ -> raise Not_found with Not_found -> fatal_error("Translmod.nat_toplevel_name: " ^ Ident.unique_name id) @@ -1254,7 +1256,7 @@ let transl_store_structure ~scopes glob map prims aliases str = | [] -> transl_store ~scopes rootpath (add_idents true ids subst) cont rem | id :: idl -> - Llet(Alias, Pgenval, id, Lprim(Pfield pos, [Lvar mid], + Llet(Alias, Pgenval, id, Lprim(mod_field pos, [Lvar mid], of_location ~scopes loc), Lsequence(store_ident (of_location ~scopes loc) id, store_idents (pos + 1) idl)) @@ -1300,8 +1302,9 @@ let transl_store_structure ~scopes glob map prims aliases str = [] -> transl_store ~scopes rootpath (add_idents true ids subst) cont rem | id :: idl -> - Llet(Alias, Pgenval, id, Lprim(Pfield pos, [Lvar mid], - loc), + Llet(Alias, Pgenval, id, + Lprim(mod_field pos, + [Lvar mid], loc), Lsequence(store_ident loc id, store_idents (pos + 1) idl)) in @@ -1320,7 +1323,7 @@ let transl_store_structure ~scopes glob map prims aliases str = try let (pos, cc) = Ident.find_same id map in let init_val = apply_coercion loc Alias cc (Lvar id) in - Lprim(Psetfield(pos, Pointer, Root_initialization), + Lprim(mod_setfield pos, [Lprim(Pgetglobal glob, [], loc); init_val], loc) with Not_found -> @@ -1335,7 +1338,7 @@ let transl_store_structure ~scopes glob map prims aliases str = match cc with Tcoerce_none -> Ident.Map.add id - (Lprim(Pfield pos, + (Lprim(mod_field pos, [Lprim(Pgetglobal glob, [], Loc_unknown)], Loc_unknown)) subst @@ -1348,7 +1351,7 @@ let transl_store_structure ~scopes glob map prims aliases str = List.fold_right (add_ident may_coerce) idlist subst and store_primitive (pos, prim) cont = - Lsequence(Lprim(Psetfield(pos, Pointer, Root_initialization), + Lsequence(Lprim(mod_setfield pos, [Lprim(Pgetglobal glob, [], Loc_unknown); Translprim.transl_primitive Loc_unknown prim.pc_desc prim.pc_env prim.pc_type None], @@ -1358,7 +1361,7 @@ let transl_store_structure ~scopes glob map prims aliases str = and store_alias (pos, env, path, cc) = let path_lam = transl_module_path Loc_unknown env path in let init_val = apply_coercion Loc_unknown Strict cc path_lam in - Lprim(Psetfield(pos, Pointer, Root_initialization), + Lprim(mod_setfield pos, [Lprim(Pgetglobal glob, [], Loc_unknown); init_val], Loc_unknown) @@ -1479,7 +1482,7 @@ let toplevel_name id = let toploop_getvalue id = Lapply{ ap_loc=Loc_unknown; - ap_func=Lprim(Pfield toploop_getvalue_pos, + ap_func=Lprim(mod_field toploop_getvalue_pos, [Lprim(Pgetglobal toploop_ident, [], Loc_unknown)], Loc_unknown); ap_args=[Lconst(Const_base( @@ -1493,7 +1496,7 @@ let toploop_getvalue id = let toploop_setvalue id lam = Lapply{ ap_loc=Loc_unknown; - ap_func=Lprim(Pfield toploop_setvalue_pos, + ap_func=Lprim(mod_field toploop_setvalue_pos, [Lprim(Pgetglobal toploop_ident, [], Loc_unknown)], Loc_unknown); ap_args= @@ -1586,7 +1589,7 @@ let transl_toplevel_item ~scopes item = lambda_unit | id :: ids -> Lsequence(toploop_setvalue id - (Lprim(Pfield pos, [Lvar mid], Loc_unknown)), + (Lprim(mod_field pos, [Lvar mid], Loc_unknown)), set_idents (pos + 1) ids) in Llet(Strict, Pgenval, mid, transl_module ~scopes Tcoerce_none None modl, set_idents 0 ids) @@ -1609,7 +1612,7 @@ let transl_toplevel_item ~scopes item = lambda_unit | id :: ids -> Lsequence(toploop_setvalue id - (Lprim(Pfield pos, [Lvar mid], Loc_unknown)), + (Lprim(mod_field pos, [Lvar mid], Loc_unknown)), set_idents (pos + 1) ids) in Llet(pure, Pgenval, mid, @@ -1697,7 +1700,7 @@ let transl_store_package component_names target_name coercion = (List.length component_names, make_sequence (fun pos id -> - Lprim(Psetfield(pos, Pointer, Root_initialization), + Lprim(mod_setfield pos, [Lprim(Pgetglobal target_name, [], Loc_unknown); get_component id], Loc_unknown)) @@ -1714,9 +1717,9 @@ let transl_store_package component_names target_name coercion = apply_coercion Loc_unknown Strict coercion components, make_sequence (fun pos _id -> - Lprim(Psetfield(pos, Pointer, Root_initialization), + Lprim(mod_setfield pos, [Lprim(Pgetglobal target_name, [], Loc_unknown); - Lprim(Pfield pos, [Lvar blk], Loc_unknown)], + Lprim(mod_field pos, [Lvar blk], Loc_unknown)], Loc_unknown)) 0 pos_cc_list)) (* diff --git a/ocaml/lambda/translobj.ml b/ocaml/lambda/translobj.ml index d7f11beaca4..a1be8920f3c 100644 --- a/ocaml/lambda/translobj.ml +++ b/ocaml/lambda/translobj.ml @@ -125,7 +125,7 @@ let transl_label_init_flambda f = let transl_store_label_init glob size f arg = assert(not Config.flambda); assert(!Clflags.native_code); - method_cache := Lprim(Pfield size, + method_cache := Lprim(mod_field ~read_semantics:Reads_vary size, [Lprim(Pgetglobal glob, [], Loc_unknown)], Loc_unknown); let expr = f arg in @@ -133,7 +133,7 @@ let transl_store_label_init glob size f arg = if !method_count = 0 then (size, expr) else (size+1, Lsequence( - Lprim(Psetfield(size, Pointer, Root_initialization), + Lprim(mod_setfield size, [Lprim(Pgetglobal glob, [], Loc_unknown); Lprim (Pccall prim_makearray, [int !method_count; int 0], diff --git a/ocaml/lambda/translprim.ml b/ocaml/lambda/translprim.ml index f7741018ced..e5193cbf274 100644 --- a/ocaml/lambda/translprim.ml +++ b/ocaml/lambda/translprim.ml @@ -123,8 +123,10 @@ let primitives_table = "%loc_POS", Loc Loc_POS; "%loc_MODULE", Loc Loc_MODULE; "%loc_FUNCTION", Loc Loc_FUNCTION; - "%field0", Primitive ((Pfield 0), 1); - "%field1", Primitive ((Pfield 1), 1); + "%field0", Primitive ((Pfield (0, Reads_vary)), 1); + "%field1", Primitive ((Pfield (1, Reads_vary)), 1); + "%field0_immut", Primitive ((Pfield (0, Reads_agree)), 1); + "%field1_immut", Primitive ((Pfield (1, Reads_agree)), 1); "%setfield0", Primitive ((Psetfield(0, Pointer, Assignment)), 2); "%makeblock", Primitive ((Pmakeblock(0, Immutable, None)), 1); "%makemutable", Primitive ((Pmakeblock(0, Mutable, None)), 1); @@ -761,7 +763,7 @@ let lambda_primitive_needs_event_after = function | Pidentity | Pbytes_to_string | Pbytes_of_string | Pignore | Psetglobal _ | Pgetglobal _ | Pmakeblock _ | Pmakefloatblock _ - | Pfield _ | Pfield_computed | Psetfield _ + | Pfield _ | Pfield_computed _ | Psetfield _ | Psetfield_computed _ | Pfloatfield _ | Psetfloatfield _ | Praise _ | Psequor | Psequand | Pnot | Pnegint | Paddint | Psubint | Pmulint | Pdivint _ | Pmodint _ | Pandint | Porint | Pxorint | Plslint | Plsrint diff --git a/ocaml/middle_end/clambda_primitives.ml b/ocaml/middle_end/clambda_primitives.ml index c37cbbe3385..71ac6bc498e 100644 --- a/ocaml/middle_end/clambda_primitives.ml +++ b/ocaml/middle_end/clambda_primitives.ml @@ -13,7 +13,7 @@ (* *) (**************************************************************************) -type mutable_flag = Asttypes.mutable_flag +type mutable_flag = Lambda.mutable_flag type immediate_or_pointer = Lambda.immediate_or_pointer diff --git a/ocaml/middle_end/clambda_primitives.mli b/ocaml/middle_end/clambda_primitives.mli index 305112968c0..84ca642414a 100644 --- a/ocaml/middle_end/clambda_primitives.mli +++ b/ocaml/middle_end/clambda_primitives.mli @@ -13,7 +13,7 @@ (* *) (**************************************************************************) -type mutable_flag = Asttypes.mutable_flag +type mutable_flag = Lambda.mutable_flag type immediate_or_pointer = Lambda.immediate_or_pointer diff --git a/ocaml/middle_end/closure/closure.ml b/ocaml/middle_end/closure/closure.ml index d156aa7c29a..48f1e376172 100644 --- a/ocaml/middle_end/closure/closure.ml +++ b/ocaml/middle_end/closure/closure.ml @@ -1109,12 +1109,13 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam = let dbg = Debuginfo.from_location loc in check_constant_result (getglobal dbg id) (Compilenv.global_approx id) - | Lprim(Pfield n, [lam], loc) -> + | Lprim(Pfield (n, _), [lam], loc) -> let (ulam, approx) = close env lam in let dbg = Debuginfo.from_location loc in check_constant_result (Uprim(P.Pfield n, [ulam], dbg)) (field_approx n approx) - | Lprim(Psetfield(n, is_ptr, init), [Lprim(Pgetglobal id, [], _); lam], loc)-> + | Lprim(Psetfield(n, is_ptr, init), + [Lprim(Pgetglobal id, [], _); lam], loc) -> let (ulam, approx) = close env lam in if approx <> Value_unknown then (!global_approx).(n) <- approx; diff --git a/ocaml/middle_end/convert_primitives.ml b/ocaml/middle_end/convert_primitives.ml index 135eb1f27a9..86e5eceb568 100644 --- a/ocaml/middle_end/convert_primitives.ml +++ b/ocaml/middle_end/convert_primitives.ml @@ -28,13 +28,13 @@ let convert (prim : Lambda.primitive) : Clambda_primitives.primitive = Pmakeblock (tag, mutability, shape) | Pmakefloatblock mutability -> Pmakearray (Pfloatarray, mutability) - | Pfield field -> Pfield field - | Pfield_computed -> Pfield_computed + | Pfield (field, _) -> Pfield field + | Pfield_computed _sem -> Pfield_computed | Psetfield (field, imm_or_pointer, init_or_assign) -> Psetfield (field, imm_or_pointer, init_or_assign) | Psetfield_computed (imm_or_pointer, init_or_assign) -> Psetfield_computed (imm_or_pointer, init_or_assign) - | Pfloatfield field -> Pfloatfield field + | Pfloatfield (field, _sem) -> Pfloatfield field | Psetfloatfield (field, init_or_assign) -> Psetfloatfield (field, init_or_assign) | Pduprecord (repr, size) -> Pduprecord (repr, size) diff --git a/ocaml/middle_end/flambda/alias_analysis.ml b/ocaml/middle_end/flambda/alias_analysis.ml index fe97a36f517..3ea66ab6482 100644 --- a/ocaml/middle_end/flambda/alias_analysis.ml +++ b/ocaml/middle_end/flambda/alias_analysis.ml @@ -23,8 +23,8 @@ type allocation_point = type allocated_const = | Normal of Allocated_const.t - | Array of Lambda.array_kind * Asttypes.mutable_flag * Variable.t list - | Duplicate_array of Lambda.array_kind * Asttypes.mutable_flag * Variable.t + | Array of Lambda.array_kind * Lambda.mutable_flag * Variable.t list + | Duplicate_array of Lambda.array_kind * Lambda.mutable_flag * Variable.t type constant_defining_value = | Allocated_const of allocated_const diff --git a/ocaml/middle_end/flambda/alias_analysis.mli b/ocaml/middle_end/flambda/alias_analysis.mli index 515daeffa34..27b2282d942 100644 --- a/ocaml/middle_end/flambda/alias_analysis.mli +++ b/ocaml/middle_end/flambda/alias_analysis.mli @@ -22,8 +22,8 @@ type allocation_point = type allocated_const = | Normal of Allocated_const.t - | Array of Lambda.array_kind * Asttypes.mutable_flag * Variable.t list - | Duplicate_array of Lambda.array_kind * Asttypes.mutable_flag * Variable.t + | Array of Lambda.array_kind * Lambda.mutable_flag * Variable.t list + | Duplicate_array of Lambda.array_kind * Lambda.mutable_flag * Variable.t type constant_defining_value = | Allocated_const of allocated_const diff --git a/ocaml/middle_end/flambda/inconstant_idents.ml b/ocaml/middle_end/flambda/inconstant_idents.ml index 28efb3e94aa..18e9d3b89ad 100644 --- a/ocaml/middle_end/flambda/inconstant_idents.ml +++ b/ocaml/middle_end/flambda/inconstant_idents.ml @@ -335,15 +335,16 @@ module Inconstants (P:Param) (Backend:Backend_intf.S) = struct makeblock(Mutable) can be a 'constant' if it is allocated at toplevel: if this expression is evaluated only once. *) - | Prim (Pmakeblock (_tag, Asttypes.Immutable, _value_kind), args, - _dbg) -> + | Prim (Pmakeblock (_tag, (Immutable | Immutable_unique), _value_kind), + args, _dbg) -> mark_vars args curr (* (* CR-someday pchambart: If global mutables are allowed: *) | Prim(Lambda.Pmakeblock(_tag, Asttypes.Mutable), args, _dbg, _) when toplevel -> List.iter (mark_loop ~toplevel curr) args *) - | Prim (Pmakearray (Pfloatarray, Immutable), args, _) -> + | Prim (Pmakearray (Pfloatarray, (Immutable | Immutable_unique)), + args, _) -> mark_vars args curr | Prim (Pmakearray (Pfloatarray, Mutable), args, _) -> (* CR-someday pchambart: Toplevel float arrays could always be @@ -356,7 +357,8 @@ module Inconstants (P:Param) (Backend:Backend_intf.S) = struct *) if toplevel then mark_vars args curr else mark_curr curr - | Prim (Pduparray (Pfloatarray, Immutable), [arg], _) -> + | Prim (Pduparray (Pfloatarray, (Immutable | Immutable_unique)), + [arg], _) -> mark_var arg curr | Prim (Pduparray (Pfloatarray, Mutable), [arg], _) -> if toplevel then mark_var arg curr diff --git a/ocaml/middle_end/flambda/lift_constants.ml b/ocaml/middle_end/flambda/lift_constants.ml index dd60de9ce2f..5718939c539 100644 --- a/ocaml/middle_end/flambda/lift_constants.ml +++ b/ocaml/middle_end/flambda/lift_constants.ml @@ -293,7 +293,7 @@ let translate_definition_and_resolve_alias inconstants ~(backend : (module Backend_intf.S)) : Flambda.constant_defining_value option = let resolve_float_array_involving_variables - ~(mutability : Asttypes.mutable_flag) ~vars = + ~(mutability : Lambda.mutable_flag) ~vars = (* Resolve an [Allocated_const] of the form: [Array (Pfloatarray, _, _)] (which references its contents via variables; it does not contain @@ -326,7 +326,7 @@ let translate_definition_and_resolve_alias inconstants in let const : Allocated_const.t = match mutability with - | Immutable -> Immutable_float_array floats + | Immutable | Immutable_unique -> Immutable_float_array floats | Mutable -> Float_array floats in Some (Flambda.Allocated_const const) @@ -432,7 +432,7 @@ let translate_definition_and_resolve_alias inconstants | Allocated_const (Normal (Immutable_float_array floats)) -> let const : Allocated_const.t = match mutability with - | Immutable -> Immutable_float_array floats + | Immutable | Immutable_unique -> Immutable_float_array floats | Mutable -> Float_array floats in Some (Flambda.Allocated_const const) diff --git a/ocaml/middle_end/flambda/lift_let_to_initialize_symbol.ml b/ocaml/middle_end/flambda/lift_let_to_initialize_symbol.ml index ccef0d8a1f3..c2632c0adbd 100644 --- a/ocaml/middle_end/flambda/lift_let_to_initialize_symbol.ml +++ b/ocaml/middle_end/flambda/lift_let_to_initialize_symbol.ml @@ -81,7 +81,8 @@ let rec accumulate ~substitution ~copied_lets ~extracted_lets let extracted = let renamed = Variable.rename var in match named with - | Prim (Pmakeblock (tag, Asttypes.Immutable, _value_kind), args, _dbg) -> + | Prim (Pmakeblock (tag, (Immutable | Immutable_unique), _value_kind), + args, _dbg) -> let tag = Tag.create_exn tag in let args = List.map (fun v -> diff --git a/ocaml/middle_end/flambda/ref_to_variables.ml b/ocaml/middle_end/flambda/ref_to_variables.ml index aa2a73c6305..eb6c333b40e 100644 --- a/ocaml/middle_end/flambda/ref_to_variables.ml +++ b/ocaml/middle_end/flambda/ref_to_variables.ml @@ -91,7 +91,7 @@ let variables_containing_ref (flam:Flambda.t) = let aux (flam : Flambda.t) = match flam with | Let { var; - defining_expr = Prim(Pmakeblock(0, Asttypes.Mutable, _), l, _); + defining_expr = Prim(Pmakeblock(0, Mutable, _), l, _); } -> map := Variable.Map.add var (List.length l) !map | _ -> () @@ -127,7 +127,7 @@ let eliminate_ref_of_expr flam = let aux (flam : Flambda.t) : Flambda.t = match flam with | Let { var; - defining_expr = Prim(Pmakeblock(0, Asttypes.Mutable, shape), l,_); + defining_expr = Prim(Pmakeblock(0, Mutable, shape), l,_); body } when convertible_variable var -> let shape = match shape with diff --git a/ocaml/middle_end/flambda/simplify_primitives.ml b/ocaml/middle_end/flambda/simplify_primitives.ml index 1452e6543c8..59bef435696 100644 --- a/ocaml/middle_end/flambda/simplify_primitives.ml +++ b/ocaml/middle_end/flambda/simplify_primitives.ml @@ -108,7 +108,7 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs) : Flambda.named * A.t * Inlining_cost.Benefit.t = let fpc = !Clflags.float_const_prop in match p with - | Pmakeblock(tag_int, Asttypes.Immutable, shape) -> + | Pmakeblock(tag_int, (Immutable | Immutable_unique), shape) -> let tag = Tag.create_exn tag_int in let shape = match shape with | None -> List.map (fun _ -> Lambda.Pgenval) args @@ -116,12 +116,12 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs) in let approxs = List.map2 A.augment_with_kind approxs shape in let shape = List.map2 A.augment_kind_with_approx approxs shape in - Prim (Pmakeblock(tag_int, Asttypes.Immutable, Some shape), args, dbg), + Prim (Pmakeblock(tag_int, Lambda.Immutable, Some shape), args, dbg), A.value_block tag (Array.of_list approxs), C.Benefit.zero | Praise _ -> expr, A.value_bottom, C.Benefit.zero | Pmakearray(_, _) when is_empty approxs -> - Prim (Pmakeblock(0, Asttypes.Immutable, Some []), [], dbg), + Prim (Pmakeblock(0, Lambda.Immutable, Some []), [], dbg), A.value_block (Tag.create_exn 0) [||], C.Benefit.zero (* CR mshinwell: Work out what to do here with [Pmakefloatblock] *) | Pmakearray (Pfloatarray, Mutable) -> @@ -129,7 +129,7 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs) A.value_mutable_float_array ~size:(List.length args) in expr, approx, C.Benefit.zero - | Pmakearray (Pfloatarray, Immutable) -> + | Pmakearray (Pfloatarray, (Immutable | Immutable_unique)) -> let approx = A.value_immutable_float_array (Array.of_list approxs) in diff --git a/ocaml/middle_end/internal_variable_names.ml b/ocaml/middle_end/internal_variable_names.ml index 674d6625219..a27f98f3baf 100644 --- a/ocaml/middle_end/internal_variable_names.ml +++ b/ocaml/middle_end/internal_variable_names.ml @@ -326,7 +326,7 @@ let of_primitive : Lambda.primitive -> string = function | Pmakeblock _ -> pmakeblock | Pmakefloatblock _ -> pmakefloatblock | Pfield _ -> pfield - | Pfield_computed -> pfield_computed + | Pfield_computed _ -> pfield_computed | Psetfield _ -> psetfield | Psetfield_computed _ -> psetfield_computed | Pfloatfield _ -> pfloatfield @@ -434,7 +434,7 @@ let of_primitive_arg : Lambda.primitive -> string = function | Pmakeblock _ -> pmakeblock_arg | Pmakefloatblock _ -> pmakefloatblock_arg | Pfield _ -> pfield_arg - | Pfield_computed -> pfield_computed_arg + | Pfield_computed _ -> pfield_computed_arg | Psetfield _ -> psetfield_arg | Psetfield_computed _ -> psetfield_computed_arg | Pfloatfield _ -> pfloatfield_arg diff --git a/ocaml/middle_end/printclambda.ml b/ocaml/middle_end/printclambda.ml index 4ee88818411..f6a0b10cf58 100644 --- a/ocaml/middle_end/printclambda.ml +++ b/ocaml/middle_end/printclambda.ml @@ -15,15 +15,14 @@ open Format -open Asttypes open Clambda module V = Backend_var module VP = Backend_var.With_provenance let mutable_flag = function - | Mutable-> "[mut]" - | Immutable -> "" + | Lambda.Mutable-> "[mut]" + | Lambda.Immutable | Lambda.Immutable_unique -> "" let value_kind = let open Lambda in diff --git a/ocaml/middle_end/printclambda_primitives.ml b/ocaml/middle_end/printclambda_primitives.ml index e9c7b22b9cf..6e0b126e05e 100644 --- a/ocaml/middle_end/printclambda_primitives.ml +++ b/ocaml/middle_end/printclambda_primitives.ml @@ -15,7 +15,6 @@ open Format -open Asttypes let boxed_integer_name = function | Lambda.Pnativeint -> "nativeint" @@ -59,6 +58,8 @@ let primitive ppf (prim:Clambda_primitives.primitive) = fprintf ppf "read_symbol %s" sym | Pmakeblock(tag, Immutable, shape) -> fprintf ppf "makeblock %i%a" tag Printlambda.block_shape shape + | Pmakeblock(tag, Immutable_unique, shape) -> + fprintf ppf "makeblock_unique %i%a" tag Printlambda.block_shape shape | Pmakeblock(tag, Mutable, shape) -> fprintf ppf "makemutable %i%a" tag Printlambda.block_shape shape | Pfield n -> fprintf ppf "field %i" n @@ -146,8 +147,12 @@ let primitive ppf (prim:Clambda_primitives.primitive) = | Parraylength k -> fprintf ppf "array.length[%s]" (array_kind k) | Pmakearray (k, Mutable) -> fprintf ppf "makearray[%s]" (array_kind k) | Pmakearray (k, Immutable) -> fprintf ppf "makearray_imm[%s]" (array_kind k) + | Pmakearray (k, Immutable_unique) -> + fprintf ppf "makearray_unique[%s]" (array_kind k) | Pduparray (k, Mutable) -> fprintf ppf "duparray[%s]" (array_kind k) | Pduparray (k, Immutable) -> fprintf ppf "duparray_imm[%s]" (array_kind k) + | Pduparray (k, Immutable_unique) -> + fprintf ppf "duparray_unique[%s]" (array_kind k) | Parrayrefu k -> fprintf ppf "array.unsafe_get[%s]" (array_kind k) | Parraysetu k -> fprintf ppf "array.unsafe_set[%s]" (array_kind k) | Parrayrefs k -> fprintf ppf "array.get[%s]" (array_kind k) diff --git a/ocaml/middle_end/semantics_of_primitives.ml b/ocaml/middle_end/semantics_of_primitives.ml index 8109ad457d0..c22b74de438 100644 --- a/ocaml/middle_end/semantics_of_primitives.ml +++ b/ocaml/middle_end/semantics_of_primitives.ml @@ -23,8 +23,8 @@ let for_primitive (prim : Clambda_primitives.primitive) = match prim with | Pmakeblock _ | Pmakearray (_, Mutable) -> Only_generative_effects, No_coeffects - | Pmakearray (_, Immutable) -> No_effects, No_coeffects - | Pduparray (_, Immutable) -> + | Pmakearray (_, (Immutable | Immutable_unique)) -> No_effects, No_coeffects + | Pduparray (_, (Immutable | Immutable_unique)) -> No_effects, No_coeffects (* Pduparray (_, Immutable) is allowed only on immutable arrays. *) | Pduparray (_, Mutable) | Pduprecord _ -> diff --git a/ocaml/stdlib/pervasives.ml b/ocaml/stdlib/pervasives.ml index b0bf3c14bee..9c99c0eedad 100644 --- a/ocaml/stdlib/pervasives.ml +++ b/ocaml/stdlib/pervasives.ml @@ -153,8 +153,8 @@ let int_of_string_opt = int_of_string_opt let string_of_float = string_of_float external float_of_string : string -> float = "caml_float_of_string" let float_of_string_opt = float_of_string_opt -external fst : 'a * 'b -> 'a = "%field0" -external snd : 'a * 'b -> 'b = "%field1" +external fst : 'a * 'b -> 'a = "%field0_immut" +external snd : 'a * 'b -> 'b = "%field1_immut" let ( @ ) = ( @ ) type nonrec in_channel = in_channel type nonrec out_channel = out_channel diff --git a/ocaml/stdlib/stdlib.ml b/ocaml/stdlib/stdlib.ml index ae489780bd3..c6de7f4d26d 100644 --- a/ocaml/stdlib/stdlib.ml +++ b/ocaml/stdlib/stdlib.ml @@ -228,8 +228,8 @@ external ignore : 'a -> unit = "%ignore" (* Pair operations *) -external fst : 'a * 'b -> 'a = "%field0" -external snd : 'a * 'b -> 'b = "%field1" +external fst : 'a * 'b -> 'a = "%field0_immut" +external snd : 'a * 'b -> 'b = "%field1_immut" (* References *) diff --git a/ocaml/stdlib/stdlib.mli b/ocaml/stdlib/stdlib.mli index df54e749c4f..c4cb5153c18 100644 --- a/ocaml/stdlib/stdlib.mli +++ b/ocaml/stdlib/stdlib.mli @@ -781,10 +781,10 @@ external float_of_string : string -> float = "caml_float_of_string" (** {1 Pair operations} *) -external fst : 'a * 'b -> 'a = "%field0" +external fst : 'a * 'b -> 'a = "%field0_immut" (** Return the first component of a pair. *) -external snd : 'a * 'b -> 'b = "%field1" +external snd : 'a * 'b -> 'b = "%field1_immut" (** Return the second component of a pair. *) diff --git a/ocaml/testsuite/tests/basic-modules/anonymous.ocamlc.reference b/ocaml/testsuite/tests/basic-modules/anonymous.ocamlc.reference index 1a699635fb0..c0ea4b5fed4 100644 --- a/ocaml/testsuite/tests/basic-modules/anonymous.ocamlc.reference +++ b/ocaml/testsuite/tests/basic-modules/anonymous.ocamlc.reference @@ -20,5 +20,5 @@ (makeblock 0))) (let (drop = (function param : int 0) - *match* = (apply drop (field 0 s))) + *match* = (apply drop (field_mut 0 s))) (makeblock 0 A B f s drop)))))))) diff --git a/ocaml/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference b/ocaml/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference index e0f5dfa8629..3a2f79750aa 100644 --- a/ocaml/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference +++ b/ocaml/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference @@ -18,5 +18,5 @@ (let (*match* = (setfield_ptr 0 s "Hello World!")) (makeblock 0))) (let (drop = (function param : int 0) - *match* = (apply drop (field 0 s))) + *match* = (apply drop (field_mut 0 s))) (makeblock 0 A B f s drop))))))) diff --git a/ocaml/testsuite/tests/basic-modules/anonymous.ocamlopt.reference b/ocaml/testsuite/tests/basic-modules/anonymous.ocamlopt.reference index aa6c9949974..cb1a0a11049 100644 --- a/ocaml/testsuite/tests/basic-modules/anonymous.ocamlopt.reference +++ b/ocaml/testsuite/tests/basic-modules/anonymous.ocamlopt.reference @@ -26,6 +26,6 @@ (let (*match* = (apply (field 4 (global Anonymous!)) - (field 0 (field 3 (global Anonymous!))))) + (field_mut 0 (field 3 (global Anonymous!))))) 0) 0))) diff --git a/ocaml/testsuite/tests/basic/patmatch_split_no_or.ml b/ocaml/testsuite/tests/basic/patmatch_split_no_or.ml index b8d06637095..816738f3ce0 100644 --- a/ocaml/testsuite/tests/basic/patmatch_split_no_or.ml +++ b/ocaml/testsuite/tests/basic/patmatch_split_no_or.ml @@ -52,9 +52,9 @@ type t += A | B of unit | C of bool * int;; 0 type t = .. (let - (A/25 = (makeblock 248 "A" (caml_fresh_oo_id 0)) - B/26 = (makeblock 248 "B" (caml_fresh_oo_id 0)) - C/27 = (makeblock 248 "C" (caml_fresh_oo_id 0))) + (A/25 = (makeblock_unique 248 "A" (caml_fresh_oo_id 0)) + B/26 = (makeblock_unique 248 "B" (caml_fresh_oo_id 0)) + C/27 = (makeblock_unique 248 "C" (caml_fresh_oo_id 0))) (seq (apply (field 1 (global Toploop!)) "A/25" A/25) (apply (field 1 (global Toploop!)) "B/26" B/26) (apply (field 1 (global Toploop!)) "C/27" C/27))) diff --git a/ocaml/toplevel/opttoploop.ml b/ocaml/toplevel/opttoploop.ml index bafc673fe24..5570c4ff93e 100644 --- a/ocaml/toplevel/opttoploop.ml +++ b/ocaml/toplevel/opttoploop.ml @@ -82,7 +82,7 @@ let close_phrase lam = Ident.Set.fold (fun id l -> let glb, pos = toplevel_value id in let glob = - Lprim (Pfield pos, + Lprim (mod_field pos, [Lprim (Pgetglobal glb, [], Loc_unknown)], Loc_unknown) in