Distinguish structural and inferred object rows

Signed-off-by: Cristiano Calcagno <cristianoc@users.noreply.github.com>

Author: cristianoc

CHANGELOG.md

@@ -18,7 +18,7 @@
 - Remove the deprecated `Js` namespace and its runtime modules. https://github.com/rescript-lang/rescript/pull/8531
 - Move Belt into the separately installed `@rescript/belt` package. Projects using Belt must install the package and list it in their `rescript.json` dependencies. https://github.com/rescript-lang/rescript/pull/8554
 - Correct the structured function details produced by `rescript-tools doc` and exposed by `RescriptTools.Docgen`: parameters now retain labels and optionality, nested functions, tuples, variables, and generic arguments retain their type structure, return types are identified correctly, and non-function values no longer receive fake function details. This changes the published docgen detail schema. https://github.com/rescript-lang/rescript/pull/8576
-- Make object-field mutability part of the type. A property has one type for reading and writing, `obj["x"] = v` requires the field to be settable (`@set`, or an inferred open row, which the write makes settable), and a coercion never grants or widens write capability. Previously the getter type and a hidden mangled `"x#="` setter member were tracked independently, so a property could be written at a different type than it was read, and a value coerced to a type without `@set` could still be written through. https://github.com/rescript-lang/rescript/pull/8597
+- Make object-field mutability part of the type. A property has one type for reading and writing. Assignment requires `@set`, except on an inferred open row, where assignment makes the field settable. Private rows are not inferred open rows, so a field in `type t = private {.."x": int}` is writable only when annotated with `@set`. Coercions never grant or widen write capability. Previously, getter and setter types were tracked independently, allowing a property to be written at a different type than it was read and allowing writes through a value coerced to a type without `@set`. https://github.com/rescript-lang/rescript/pull/8597
 - Remove the undocumented object-field attribute forms `@get` (bare or with a `null`/`undefined`/`nullable` payload) and `@set({no_get: ...})` on object types. Only bare `@set` marks a field settable; nullable getter types are written directly (`null<t>`, `undefined<t>`, `nullable<t>`). https://github.com/rescript-lang/rescript/pull/8597
 
 #### :eyeglasses: Spec Compliance

compiler/ml/ctype.ml

@@ -316,7 +316,7 @@ let rec object_row ty =
   | Tfield {rest = t} -> object_row t
   | _ -> ty
 
-let opened_object ty =
+let object_row_is_structurally_open ty =
   match (object_row ty).desc with
   | Tvar _ | Tunivar _ | Tconstr _ -> true
   | _ -> false
@@ -2648,13 +2648,17 @@ type object_field_write_error = Owrite_missing | Owrite_not_mutable
 
 (* Look up [name] for assignment in the object type [ty].
    - A [Mutable] field yields its type.
-   - An [Immutable] field is promoted iff the object row is open; on a
-     closed row the write is rejected.
-   - An absent field is added as [Mutable] through an open row; on a closed
-     row the write is rejected as missing. *)
+   - An [Immutable] field is promoted iff the row ends in a [Tvar], the
+     same predicate [unify_mutability] uses.
+     [object_row_is_structurally_open] also holds for rigid [Tunivar] and
+     private-row [Tconstr] terminators. It cannot therefore gate promotion;
+     in particular, ordinary copies of a private row share the declaration's
+     mutability cell, so a write would later be saved as [@set] in the .cmi.
+   - An absent field is added as [Mutable] through a [Tvar] rest; on a
+     closed or private row the write is rejected as missing. *)
 let filter_object_field_for_write env name ty :
     (type_expr, object_field_write_error) Result.t =
-  let rec write_field ~opened ty =
+  let rec write_field ~can_promote ty =
     let ty = expand_head_trace env ty in
     match ty.desc with
     | Tvar _ ->
@@ -2677,13 +2681,13 @@ let filter_object_field_for_write env name ty :
         match mutability_repr mutability with
         | Asttypes.Mutable -> Ok typ
         | Immutable ->
-          if opened then (
+          if can_promote then (
             set_mutability
               (mutability_ref_repr mutability)
               (Mutability_value Asttypes.Mutable);
             Ok typ)
           else Error Owrite_not_mutable
-      else write_field ~opened f.rest
+      else write_field ~can_promote f.rest
     | _ -> Error Owrite_missing
   in
   let ty = expand_head_trace env ty in
@@ -2693,8 +2697,8 @@ let filter_object_field_for_write env name ty :
     let ty' = newobj ty1 in
     update_level env ty.level ty';
     link_type ty ty';
-    write_field ~opened:true ty1
-  | Tobject f -> write_field ~opened:(opened_object ty) f
+    write_field ~can_promote:true ty1
+  | Tobject f -> write_field ~can_promote:(is_Tvar (object_row ty)) f
   | _ -> Error Owrite_missing
 
 (* Unify [ty] and [{.. name: 'a}]. Return ['a]. *)
@@ -3347,7 +3351,8 @@ let rec build_subtype env visited loops posi level t =
       in
       (newty (Tvariant row), Changed)
   | Tobject t1 ->
-    if memq_warn t visited || opened_object t1 then (t, Unchanged)
+    if memq_warn t visited || object_row_is_structurally_open t1 then
+      (t, Unchanged)
     else
       let level' = pred_enlarge level in
       let visited =

compiler/ml/ctype.mli

@@ -117,7 +117,13 @@ val flatten_fields : type_expr -> fields * type_expr
 (* Transform a field type into a sorted list of field infos *)
 val associate_fields :
   fields -> fields -> (field_info * field_info) list * fields * fields
-val opened_object : type_expr -> bool
+
+val object_row_is_structurally_open : type_expr -> bool
+(** Whether an object row is structurally open: its terminator is a [Tvar],
+    [Tunivar], or [Tconstr], rather than [Tnil]. This does not imply that the
+    row can be strengthened. Row-strengthening operations that add a field or
+    promote field mutability require a [Tvar] terminator. *)
+
 val lid_of_path : ?hash:string -> Path.t -> Longident.t
 
 val sort_row_fields : (label * row_field) list -> (label * row_field) list

compiler/ml/printtyp.ml

@@ -501,7 +501,8 @@ let rec mark_loops_rec visited ty =
     | Tobject fi ->
       if List.memq px !visited_objects then add_alias px
       else (
-        if opened_object ty then visited_objects := px :: !visited_objects;
+        if object_row_is_structurally_open ty then
+          visited_objects := px :: !visited_objects;
         let fields, _ = flatten_fields fi in
         List.iter (fun {Ctype.f_typ} -> mark_loops_rec visited f_typ) fields)
     | Tfield {typ = ty1; rest = ty2} ->

compiler/ml/typetexp.ml

@@ -610,7 +610,7 @@ and transl_fields env policy o fields =
       let t = expand_head env cty.ctyp_type in
       match (t, nm) with
       | {desc = Tobject {desc = (Tfield _ | Tnil) as tf}}, _ ->
-        if opened_object t then
+        if object_row_is_structurally_open t then
           raise (Error (sty.ptyp_loc, env, Opened_object nm));
         let rec iter_add = function
           | Tfield {name = s; mutability; typ = ty1; rest = ty2} ->

tests/ERROR_VARIANTS.md

@@ -216,7 +216,7 @@ Source: [typecore.ml:27](../compiler/ml/typecore.ml).
 | `Wrong_name` | ✓ | `wrong_name_record_field.res`, `Cross_record_extra_field` (multi) | |
 | `Name_type_mismatch` | ✓ | `super_errors_multi/Cross_qualified_constructor_mismatch` | Cross-module constructor disambiguation. |
 | `Undefined_method` | ✓ | `super_errors_multi/Cross_module_alias_dot_access`, `undefined_method` | |
-| `Object_field_not_mutable` | ✓ | `object_write_closed_row`, `object_write_alias`, `object_write_after_forgetting` | Assignment to a field without `@set`; the latter two pin that promotion is per equivalence class (an alias write strengthens the shared constraint) and that a coercion never grants write capability. |
+| `Object_field_not_mutable` | ✓ | `object_write_closed_row`, `object_write_alias`, `object_write_after_forgetting`, `object_private_row_write`, `object_private_row_write_through_signature` | Assignment to a field without `@set`. `object_write_alias` pins that promotion is per equivalence class, and `object_write_after_forgetting` pins that a coercion never grants write capability. The private-row fixtures pin that a `Tconstr` row terminator is structurally open but cannot be strengthened: writing through `type t = private {.."x": int}` (directly or via a signature) is rejected, matching `unify_mutability`. |
 | `Private_type` | ✓ | `private_type_construction.res` | |
 | `Private_label` | ✓ | `private_label.res` | |
 | `Not_subtype` | ✓ | `subtype_*.res`, `coercion_arity_mismatch.res`, `dict_show_no_coercion.res`, etc. | |

tests/build_tests/super_errors/expected/object_private_row_write.res.expected

@@ -0,0 +1,11 @@
+
+  We've found a bug for you!
+  /.../fixtures/object_private_row_write.res:7:23-32
+
+  5 │    pinned in tests/tests/src/object_mutability_pin.res. */
+  6 │ type t = private {.."x": int}
+  7 │ let write = (o: t) => o["x"] = 1
+  8 │ 
+
+  This expression has type t
+  The field x is not settable. Only fields annotated with @set, e.g. {@set "x": int}, can be assigned.

tests/build_tests/super_errors/expected/object_private_row_write_through_signature.res.expected

@@ -0,0 +1,11 @@
+
+  We've found a bug for you!
+  /.../fixtures/object_private_row_write_through_signature.res:8:26-35
+
+  6 │   type t = private {.."x": int}
+  7 │ }
+  8 │ let mutate = (o: M.t) => o["x"] = 1
+  9 │ 
+
+  This expression has type M.t
+  The field x is not settable. Only fields annotated with @set, e.g. {@set "x": int}, can be assigned.

tests/build_tests/super_errors/fixtures/object_private_row_write.res

@@ -0,0 +1,7 @@
+/* A private row is not an inferred open row: writing a field that is
+   not @set must be rejected. The Tconstr terminator shares the
+   declaration's mutability cell, so a successful write would persist
+   @set into the .cmi. The compiling counterpart (private {..@set}) is
+   pinned in tests/tests/src/object_mutability_pin.res. */
+type t = private {.."x": int}
+let write = (o: t) => o["x"] = 1

tests/build_tests/super_errors/fixtures/object_private_row_write_through_signature.res

@@ -0,0 +1,8 @@
+/* Dual of object_private_row_grants_set.res: a signature that does not
+ grant @set cannot be written through from outside the module. */
+module M: {
+  type t = private {.."x": int}
+} = {
+  type t = private {.."x": int}
+}
+let mutate = (o: M.t) => o["x"] = 1