remove @no_mutable_implied_modalities

Author: riaqn

parsing/builtin_attributes.ml

@@ -113,7 +113,6 @@ let builtin_attrs =
   ; "only_generative_effects"
   ; "error_message"
   ; "layout_poly"
-  ; "no_mutable_implied_modalities"
   ; "or_null_reexport"
   ; "no_recursive_modalities"
   ; "jane.non_erasable.instances"
@@ -650,9 +649,6 @@ let parse_standard_implementation_attributes attr =
   zero_alloc_attribute ~in_signature:false attr;
   unsafe_allow_any_mode_crossing_attribute attr
 
-let has_no_mutable_implied_modalities attrs =
-  has_attribute "no_mutable_implied_modalities" attrs
-
 let has_local_opt attrs =
   has_attribute "local_opt" attrs
 

parsing/builtin_attributes.mli

@@ -212,7 +212,6 @@ val parse_standard_implementation_attributes : Parsetree.attribute -> unit
 val curry_attr_name : string
 val curry_attr : Location.t -> Parsetree.attribute
 
-val has_no_mutable_implied_modalities: Parsetree.attributes -> bool
 val has_local_opt: Parsetree.attributes -> bool
 val has_layout_poly: Parsetree.attributes -> bool
 val has_curry: Parsetree.attributes -> bool

testsuite/tests/parsetree/source_jane_street.ml

@@ -601,8 +601,8 @@ type t = { x : string @@ global
 type t1 = { mutable x : float
           ; mutable f : float -> float }
 
-type t2 = { mutable x : float [@no_mutable_implied_modalities]
-          ; mutable f : float -> float [@no_mutable_implied_modalities] }
+type t2 = { mutable x : float @@ local once
+          ; mutable f : float -> float @@ local once }
 
 [%%expect{|
 type t =
@@ -614,7 +614,10 @@ type t = {
   z : string @@ global many;
 }
 type t1 = { mutable x : float; mutable f : float -> float; }
-type t2 = { mutable x : float; mutable f : float -> float; }
+type t2 = {
+  mutable x : float @@ local once;
+  mutable f : float -> float @@ local once;
+}
 |}]
 
 let f1 (x @ local) (f @ once) : t1 = exclave_ { x; f }

testsuite/tests/typing-modes/mutable.ml

@@ -64,14 +64,9 @@ type r = {mutable s : string @@ unyielding local}
 type r = { mutable s : string @@ local; }
 |}]
 
-(* [@no_mutable_implied_modalities] disables those implied modalities on the
-   comonadic axes, and allows us to test [mutable] alone *)
-
-(* Note the attribute is not printed back, which might be confusing.
-   Considering this is a short-term workaround, let's not worry too much. *)
-type 'a r = {mutable s : 'a [@no_mutable_implied_modalities]}
+type 'a r = {mutable s : 'a @@ local}
 [%%expect{|
-type 'a r = { mutable s : 'a; }
+type 'a r = { mutable s : 'a @@ local; }
 |}]
 
 (* We can now construct a local record using a local field. *)
@@ -104,11 +99,11 @@ let foo (local_ r) =
 val foo : local_ string r -> unit = <fun>
 |}]
 
-(* We can still add modalities explicitly. Of course, the print-back is
-   confusing. *)
-type r' = {mutable s' : string @@ global [@no_mutable_implied_modalities]}
+(* We can still add modalities explicitly. But they might be omitted if they are
+  the same as the mutable-implied ones. *)
+type r' = {mutable s' : string @@ global}
 [%%expect{|
-type r' = { mutable global_ s' : string; }
+type r' = { mutable s' : string; }
 |}]
 
 let foo (local_ s') = exclave_ {s'}
@@ -152,7 +147,7 @@ Error: This value is "aliased" but expected to be "unique".
 |}]
 
 module M : sig
-  type t = { mutable s : string [@no_mutable_implied_modalities] }
+  type t = { mutable s : string @@ local }
 end = struct
   type t = { mutable s : string }
 end
@@ -165,39 +160,39 @@ Error: Signature mismatch:
        Modules do not match:
          sig type t = { mutable s : string; } end
        is not included in
-         sig type t = { mutable s : string; } end
+         sig type t = { mutable s : string @@ local; } end
        Type declarations do not match:
          type t = { mutable s : string; }
        is not included in
-         type t = { mutable s : string; }
+         type t = { mutable s : string @@ local; }
        Fields do not match:
          "mutable s : string;"
        is not the same as:
-         "mutable s : string;"
+         "mutable s : string @@ local;"
        The first is global and the second is not.
 |}]
 
 module M : sig
   type t = { mutable s : string }
 end = struct
-  type t = { mutable s : string [@no_mutable_implied_modalities] }
+  type t = { mutable s : string @@ local}
 end
 [%%expect{|
 Lines 3-5, characters 6-3:
 3 | ......struct
-4 |   type t = { mutable s : string [@no_mutable_implied_modalities] }
+4 |   type t = { mutable s : string @@ local}
 5 | end
 Error: Signature mismatch:
        Modules do not match:
-         sig type t = { mutable s : string; } end
+         sig type t = { mutable s : string @@ local; } end
        is not included in
          sig type t = { mutable s : string; } end
        Type declarations do not match:
-         type t = { mutable s : string; }
+         type t = { mutable s : string @@ local; }
        is not included in
          type t = { mutable s : string; }
        Fields do not match:
-         "mutable s : string;"
+         "mutable s : string @@ local;"
        is not the same as:
          "mutable s : string;"
        The second is global and the first is not.

testsuite/tests/warnings/w53.compilers.reference

@@ -1,8 +1,3 @@
-File "w53.ml", line 9, characters 24-53:
-9 | type r0 = {s : string [@no_mutable_implied_modalities]} (* rejected *)
-                            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 53 [misplaced-attribute]: the "no_mutable_implied_modalities" attribute cannot appear in this context
-
 File "w53.ml", line 15, characters 16-21:
 15 |   val x : int [@alert foo "foo"] (* rejected *)
                      ^^^^^

testsuite/tests/warnings/w53.ml

@@ -6,8 +6,8 @@
  check-ocamlc.byte-output;
 *)
 
-type r0 = {s : string [@no_mutable_implied_modalities]} (* rejected *)
-type r1 = {mutable s : string [@no_mutable_implied_modalities]} (* accepted *)
+
+
 
 module type TestAlertSig = sig
   type t1 = Foo1 [@alert foo "foo"] (* accepted *)

typing/jkind.ml

@@ -1209,7 +1209,7 @@ let outcometree_of_type = ref (fun _ -> assert false)
 
 let set_outcometree_of_type p = outcometree_of_type := p
 
-let outcometree_of_modalities_new = ref (fun _ _ _ -> assert false)
+let outcometree_of_modalities_new = ref (fun _ _ -> assert false)
 
 let set_outcometree_of_modalities_new p = outcometree_of_modalities_new := p
 
@@ -1638,7 +1638,7 @@ module Const = struct
             in
             ( !outcometree_of_type type_expr,
               !outcometree_of_modalities_new
-                Types.Immutable []
+                Types.Immutable
                 (modality_to_ignore_axes axes_ignored_by_modalities) ))
           (With_bounds.to_list actual.with_bounds)
       in
@@ -1819,7 +1819,7 @@ module Const = struct
       | Left_jkind (transl_type, _) ->
         let type_ = transl_type type_ in
         let modality =
-          Typemode.transl_modalities ~maturity:Stable Immutable [] modalities
+          Typemode.transl_modalities ~maturity:Stable Immutable modalities
         in
         { layout = base.layout;
           mod_bounds = base.mod_bounds;

typing/jkind.mli

@@ -637,7 +637,6 @@ val set_outcometree_of_type : (Types.type_expr -> Outcometree.out_type) -> unit
 
 val set_outcometree_of_modalities_new :
   (Types.mutability ->
-  Parsetree.attributes ->
   Mode.Modality.Value.Const.t ->
   Outcometree.out_mode_new list) ->
   unit

typing/printtyp.ml

@@ -1419,14 +1419,14 @@ let tree_of_modality_old (t: Parsetree.modality loc) =
   | Modality "global" -> Some (Ogf_legacy Ogf_global)
   | _ -> None
 
-let tree_of_modalities mut attrs t =
-  let t = Typemode.untransl_modalities mut attrs t in
+let tree_of_modalities mut t =
+  let t = Typemode.untransl_modalities mut t in
   match all_or_none tree_of_modality_old t with
   | Some l -> l
   | None -> List.map tree_of_modality_new t
 
-let tree_of_modalities_new mut attrs t =
-  let l = Typemode.untransl_modalities mut attrs t in
+let tree_of_modalities_new mut t =
+  let l = Typemode.untransl_modalities mut t in
   List.map (fun ({txt = Parsetree.Modality s; _}) -> s) l
 
 (** [tree_of_mode m l] finds the outcome node in [l] that corresponds to [m].
@@ -1643,7 +1643,7 @@ and tree_of_labeled_typlist mode tyl =
 
 and tree_of_typ_gf {ca_type=ty; ca_modalities=gf; _} =
   (tree_of_typexp Type Alloc.Const.legacy ty,
-   tree_of_modalities Immutable [] gf)
+   tree_of_modalities Immutable gf)
 
 (** We are on the RHS of an arrow type, where [ty] is the return type, and [m]
     is the return mode. This function decides the printed modes on [ty].
@@ -1842,9 +1842,7 @@ let tree_of_label l =
         mut
     | Immutable -> Om_immutable
   in
-  let ld_modalities =
-    tree_of_modalities l.ld_mutable l.ld_attributes l.ld_modalities
-  in
+  let ld_modalities = tree_of_modalities l.ld_mutable l.ld_modalities in
   (Ident.name l.ld_id, mut, tree_of_typexp Type l.ld_type, ld_modalities)
 
 let tree_of_constructor_arguments = function
@@ -2266,7 +2264,7 @@ let tree_of_value_description id decl =
     { oval_name = id;
       oval_type = Otyp_poly(qtvs, ty);
       oval_modalities =
-        tree_of_modalities_new Immutable decl.val_attributes moda;
+        tree_of_modalities_new Immutable moda;
       oval_prims = [];
       oval_attributes = attrs
     }

typing/typecore.ml

@@ -2647,7 +2647,7 @@ and type_pat_aux
       solve_Ppat_array ~refine:false loc penv mutability expected_ty
     in
     let modalities =
-      Typemode.transl_modalities ~maturity:Stable mutability [] []
+      Typemode.transl_modalities ~maturity:Stable mutability []
     in
     check_project_mutability ~loc ~env:!!penv mutability alloc_mode.mode;
     let alloc_mode = Modality.Value.Const.apply modalities alloc_mode.mode in
@@ -9515,9 +9515,7 @@ and type_generic_array
     if Types.is_mutable mutability then Predef.type_array
     else Predef.type_iarray
   in
-  let modalities =
-    Typemode.transl_modalities ~maturity:Stable mutability [] []
-  in
+  let modalities = Typemode.transl_modalities ~maturity:Stable mutability [] in
   let argument_mode = mode_modality modalities array_mode in
   let jkind, elt_sort = Jkind.of_new_legacy_sort_var ~why:Array_element in
   let ty = newgenvar jkind in

typing/typedecl.ml

@@ -490,7 +490,7 @@ let transl_labels (type rep) ~(record_form : rep record_form) ~new_var_jkind
               | Unboxed_product -> raise(Error(loc, Unboxed_mutable_label))
          in
          let modalities =
-          Typemode.transl_modalities ~maturity:Stable mut attrs modalities
+          Typemode.transl_modalities ~maturity:Stable mut modalities
          in
          let arg = Ast_helper.Typ.force_poly arg in
          let cty = transl_simple_type ~new_var_jkind env ?univars ~closed Mode.Alloc.Const.legacy arg in
@@ -531,8 +531,7 @@ let transl_types_gf ~new_var_jkind env loc univars closed cal kloc =
         Mode.Alloc.Const.legacy arg.pca_type
     in
     let gf =
-      Typemode.transl_modalities ~maturity:Stable Immutable []
-        arg.pca_modalities
+      Typemode.transl_modalities ~maturity:Stable Immutable arg.pca_modalities
     in
     {ca_modalities = gf; ca_type = cty; ca_loc = arg.pca_loc}
   in
@@ -3656,8 +3655,7 @@ let transl_value_decl env loc ~sig_modalities valdecl =
   let modalities =
     match valdecl.pval_modalities with
     | [] -> sig_modalities
-    | l -> Typemode.transl_modalities ~maturity:Stable Immutable
-        valdecl.pval_attributes l
+    | l -> Typemode.transl_modalities ~maturity:Stable Immutable l
   in
   let modalities = Mode.Modality.Value.of_const modalities in
   (* CR layouts v5: relax this to check for representability. *)

typing/typemod.ml

@@ -1062,7 +1062,7 @@ let apply_pmd_modalities env sig_modalities pmd_modalities mty =
     match pmd_modalities with
     | [] -> sig_modalities
     | _ :: _ ->
-      Typemode.transl_modalities ~maturity:Stable Immutable [] pmd_modalities
+      Typemode.transl_modalities ~maturity:Stable Immutable pmd_modalities
   in
   (*
   Workaround for pmd_modalities
@@ -1268,7 +1268,7 @@ and approx_sig_items env ssg=
                 | [] -> sg
                 | _ ->
                   let modalities =
-                    Typemode.transl_modalities ~maturity:Stable Immutable [] moda
+                    Typemode.transl_modalities ~maturity:Stable Immutable moda
                   in
                   let recursive =
                     not @@ Builtin_attributes.has_attribute "no_recursive_modalities" attrs
@@ -1770,7 +1770,7 @@ and transl_signature env {psg_items; psg_modalities; psg_loc} =
   let names = Signature_names.create () in
 
   let sig_modalities =
-      Typemode.transl_modalities ~maturity:Stable Immutable [] psg_modalities
+      Typemode.transl_modalities ~maturity:Stable Immutable psg_modalities
   in
 
   let transl_include ~loc env sig_acc sincl modalities =
@@ -1796,7 +1796,7 @@ and transl_signature env {psg_items; psg_modalities; psg_loc} =
       match modalities with
       | [] -> sig_modalities
       | _ ->
-        Typemode.transl_modalities ~maturity:Stable Immutable [] modalities
+        Typemode.transl_modalities ~maturity:Stable Immutable modalities
     in
     let sg =
       if not @@ Mode.Modality.Value.Const.is_id modalities then

typing/typemode.ml

@@ -407,11 +407,10 @@ let untransl_modality (a : Modality.t) : Parsetree.modality loc =
 
 (* For now, mutable implies legacy modalities for both comonadic axes and
    monadic axes. In the future, implications on the comonadic axes will be
-   removed (and can be experimented currently with using
-   @no_mutable_implied_modalities). The implications on the monadic axes will
-   stay. *)
+   removed. The implications on the monadic axes will stay. Implied modalities
+   can be overriden. *)
 (* CR zqian: decouple mutable and comonadic modalities *)
-let mutable_implied_modalities (mut : Types.mutability) attrs =
+let mutable_implied_modalities (mut : Types.mutability) =
   let comonadic : Modality.t list =
     [ Atom (Comonadic Areality, Meet_with Regionality.Const.legacy);
       Atom (Comonadic Linearity, Meet_with Linearity.Const.legacy);
@@ -424,15 +423,10 @@ let mutable_implied_modalities (mut : Types.mutability) attrs =
       Atom (Monadic Contention, Join_with Contention.Const.legacy);
       Atom (Monadic Visibility, Join_with Visibility.Const.legacy) ]
   in
-  match mut with
-  | Immutable -> []
-  | Mutable _ ->
-    if Builtin_attributes.has_no_mutable_implied_modalities attrs
-    then monadic
-    else monadic @ comonadic
+  match mut with Immutable -> [] | Mutable _ -> monadic @ comonadic
 
-let mutable_implied_modalities (mut : Types.mutability) attrs =
-  let l = mutable_implied_modalities mut attrs in
+let mutable_implied_modalities (mut : Types.mutability) =
+  let l = mutable_implied_modalities mut in
   List.fold_left
     (fun t (Modality.Atom (ax, a)) -> Modality.Value.Const.set ax a t)
     Modality.Value.Const.id l
@@ -466,8 +460,8 @@ let implied_modalities (Atom (ax, a) : Modality.t) : Modality.t list =
     [Atom (Comonadic Portability, Meet_with b)]
   | _ -> []
 
-let transl_modalities ~maturity mut attrs modalities =
-  let mut_modalities = mutable_implied_modalities mut attrs in
+let transl_modalities ~maturity mut modalities =
+  let mut_modalities = mutable_implied_modalities mut in
   let modalities = List.map (transl_modality ~maturity) modalities in
   (* axes listed in the order of implication. *)
   let modalities =
@@ -489,8 +483,8 @@ let transl_modalities ~maturity mut attrs modalities =
         m (implied_modalities t))
     mut_modalities modalities
 
-let untransl_modalities mut attrs t =
-  let mut_modalities = mutable_implied_modalities mut attrs in
+let untransl_modalities mut t =
+  let mut_modalities = mutable_implied_modalities mut in
   let l = Modality.Value.Const.diff mut_modalities t in
   let implied = List.concat_map implied_modalities l in
   l