mutable no longer implies global

ocaml/lambda/matching.ml

@@ -2145,9 +2145,7 @@ let get_expr_args_record ~scopes head (arg, _mut, sort, layout) rem =
       let lbl_sort = Jkind.sort_of_jkind lbl.lbl_jkind in
       let lbl_layout = Typeopt.layout_of_sort lbl.lbl_loc lbl_sort in
       let sem =
-        match lbl.lbl_mut with
-        | Immutable -> Reads_agree
-        | Mutable -> Reads_vary
+        if Types.is_mutable lbl.lbl_mut then Reads_vary else Reads_agree
       in
       let access, sort, layout =
         match lbl.lbl_repres with
@@ -2170,11 +2168,7 @@ let get_expr_args_record ~scopes head (arg, _mut, sort, layout) rem =
             Lprim (Pfield (lbl.lbl_pos + 1, ptr, sem), [ arg ], loc),
             lbl_sort, lbl_layout
       in
-      let str =
-        match lbl.lbl_mut with
-        | Immutable -> Alias
-        | Mutable -> StrictOpt
-      in
+      let str = if Types.is_mutable lbl.lbl_mut then StrictOpt else Alias in
       (access, str, sort, layout) :: make_args (pos + 1)
   in
   make_args 0
@@ -2222,9 +2216,7 @@ let get_expr_args_array ~scopes kind head (arg, _mut, _sort, _layout) rem =
           (Parrayrefu (ref_kind, Ptagged_int_index),
            [ arg; Lconst (Const_base (Const_int pos)) ],
            loc),
-        (match am with
-        | Mutable   -> StrictOpt
-        | Immutable -> Alias),
+        (if Types.is_mutable am then StrictOpt else Alias),
         arg_sort,
         result_layout)
       :: make_args (pos + 1)
@@ -3640,10 +3632,7 @@ let is_record_with_mutable_field p =
   match p.pat_desc with
   | Tpat_record (lps, _) ->
       List.exists
-        (fun (_, lbl, _) ->
-          match lbl.Types.lbl_mut with
-          | Mutable -> true
-          | Immutable -> false)
+        (fun (_, lbl, _) -> Types.is_mutable lbl.lbl_mut)
         lps
   | Tpat_alias _
   | Tpat_variant _

ocaml/lambda/translcore.ml

@@ -542,9 +542,7 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
   | Texp_field(arg, id, lbl, float) ->
       let targ = transl_exp ~scopes Jkind.Sort.for_record arg in
       let sem =
-        match lbl.lbl_mut with
-        | Immutable -> Reads_agree
-        | Mutable -> Reads_vary
+        if Types.is_mutable lbl.lbl_mut then Reads_vary else Reads_agree
       in
       let lbl_sort = Jkind.sort_of_jkind lbl.lbl_jkind in
       check_record_field_sort id.loc lbl_sort lbl.lbl_repres;
@@ -610,16 +608,14 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
       in
       let imm_array = makearray Immutable in
       let lambda_arr_mut : Lambda.mutable_flag =
-        match (amut : Asttypes.mutable_flag) with
-        | Mutable   -> Mutable
-        | Immutable -> Immutable
+        if Types.is_mutable amut then Mutable else Immutable
       in
       begin try
         (* For native code the decision as to which compilation strategy to
            use is made later.  This enables the Flambda passes to lift certain
            kinds of array definitions to symbols. *)
         (* Deactivate constant optimization if array is small enough *)
-        if amut = Asttypes.Mutable &&
+        if Types.is_mutable amut &&
            List.length ll <= use_dup_for_constant_mutable_arrays_bigger_than
         then begin
           raise Not_constant
@@ -628,7 +624,7 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
         if is_local_mode mode then raise Not_constant;
         begin match List.map extract_constant ll with
         | exception Not_constant
-          when kind = Pfloatarray && amut = Asttypes.Mutable ->
+          when kind = Pfloatarray && Types.is_mutable amut ->
             (* We cannot currently lift mutable [Pintarray] arrays safely in
                Flambda because [caml_modify] might be called upon them
                (e.g. from code operating on polymorphic arrays, or functions
@@ -657,9 +653,7 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
                 | Punboxedfloatarray _ | Punboxedintarray _ ->
                   Misc.fatal_error "Use flambda2 for unboxed arrays"
             in
-            match amut with
-            | Mutable   -> duparray_to_mutable const
-            | Immutable -> const
+            if Types.is_mutable amut then duparray_to_mutable const else const
         end
       with Not_constant ->
         makearray lambda_arr_mut
@@ -1627,9 +1621,7 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
                  record_field_kind (layout env lbl.lbl_loc lbl_sort typ)
                in
                let sem =
-                 match mut with
-                 | Immutable -> Reads_agree
-                 | Mutable -> Reads_vary
+                 if Types.is_mutable mut then Reads_vary else Reads_agree
                in
                let access =
                  match repres with
@@ -1655,7 +1647,7 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
     in
     let ll, shape = List.split (Array.to_list lv) in
     let mut : Lambda.mutable_flag =
-      if Array.exists (fun (lbl, _) -> lbl.lbl_mut = Asttypes.Mutable) fields
+      if Array.exists (fun (lbl, _) -> Types.is_mutable lbl.lbl_mut) fields
       then Mutable
       else Immutable in
     let lam =

ocaml/ocamldoc/odoc_sig.ml

@@ -440,7 +440,7 @@ module Analyser =
       let comment_opt = analyze_alerts comment_opt ld_attributes in
       {
         rf_name = field_name ;
-        rf_mutable = mutable_flag = Mutable ;
+        rf_mutable = Types.is_mutable mutable_flag;
         rf_type = Odoc_env.subst_type env type_expr ;
         rf_text = comment_opt
       }

ocaml/stdlib/array.mli

@@ -33,6 +33,8 @@ open! Stdlib
 type 'a t = 'a array
 (** An alias for the type of arrays. *)
 
+(* CR zqian: fix the following primitive wrt mutable() logic. *)
+
 external length : 'a array -> int = "%array_length"
 (** Return the length (number of elements) of the given array. *)
 

ocaml/stdlib/stdlib.ml

@@ -241,8 +241,8 @@ external snd : ('a * 'b[@local_opt]) -> ('b[@local_opt]) = "%field1_immut"
 (* References *)
 
 type 'a ref = { mutable contents : 'a }
-external ref : 'a -> ('a ref[@local_opt]) = "%makemutable"
-external ( ! ) : ('a ref[@local_opt]) -> 'a = "%field0"
+external ref : ('a [@local_opt]) -> ('a ref[@local_opt]) = "%makemutable"
+external ( ! ) : ('a ref[@local_opt]) -> ('a [@local_opt]) = "%field0"
 external ( := ) : ('a ref[@local_opt]) -> 'a -> unit = "%setfield0"
 external incr : (int ref[@local_opt]) -> unit = "%incr"
 external decr : (int ref[@local_opt]) -> unit = "%decr"

ocaml/stdlib/stdlib.mli

@@ -1220,10 +1220,10 @@ type 'a ref = { mutable contents : 'a }
 (** The type of references (mutable indirection cells) containing
    a value of type ['a]. *)
 
-external ref : 'a -> ('a ref[@local_opt]) = "%makemutable"
+external ref : ('a [@local_opt]) -> ('a ref[@local_opt]) = "%makemutable"
 (** Return a fresh reference containing the given value. *)
 
-external ( ! ) : ('a ref[@local_opt]) -> 'a = "%field0"
+external ( ! ) : ('a ref[@local_opt]) -> ('a [@local_opt]) = "%field0"
 (** [!r] returns the current contents of reference [r].
    Equivalent to [fun r -> r.contents].
    Unary operator, see {!Ocaml_operators} for more information.

ocaml/testsuite/tests/typing-core-bugs/const_int_hint.ml

@@ -187,12 +187,12 @@ Error: This pattern matches values of type int
        but a pattern was expected which matches values of type int32
   Hint: Did you mean `0b1000_1101l'?
 |}]
-type t1 = {f1: int32};; let _ = fun x -> x.f1 <- 1_000n;;
+type t1 = {mutable f1: int32};; let _ = fun x -> x.f1 <- 1_000n;;
 [%%expect{|
-type t1 = { f1 : int32; }
-Line 1, characters 49-55:
-1 | type t1 = {f1: int32};; let _ = fun x -> x.f1 <- 1_000n;;
-                                                     ^^^^^^
+type t1 = { mutable f1 : int32; }
+Line 1, characters 57-63:
+1 | type t1 = {mutable f1: int32};; let _ = fun x -> x.f1 <- 1_000n;;
+                                                             ^^^^^^
 Error: This expression has type nativeint
        but an expression was expected of type int32
   Hint: Did you mean `1_000l'?

ocaml/testsuite/tests/typing-local/exclave.ml

@@ -3,9 +3,7 @@
 
 (* typing tests *)
 
-let escape x =
-  let _ = ref x in
-  ()
+let escape : 'a -> unit = fun _ -> ()
 [%%expect{|
 val escape : 'a -> unit = <fun>
 |}]
@@ -56,11 +54,11 @@ let foo x =
   exclave_
     let local_ y = None in
     (* y is not global *)
-    ref y
+    escape y
 [%%expect{|
-Line 5, characters 8-9:
-5 |     ref y
-            ^
+Line 5, characters 11-12:
+5 |     escape y
+               ^
 Error: This value escapes its region
 |}]
 

ocaml/testsuite/tests/typing-local/local.ml

@@ -1,6 +1,20 @@
 (* TEST
    * expect *)
 
+(* CR zqian: This files uses [ref]'s old behaviour that mutable implies global
+  modality. We Should use the [ref] from stdlib instead and update the tests. *)
+type 'a ref = {mutable contents : 'a @@ global}
+
+external ref : 'a -> ('a ref[@local_opt]) = "%makemutable"
+external ( ! ) : ('a ref[@local_opt]) -> 'a = "%field0"
+external ( := ) : ('a ref[@local_opt]) -> 'a -> unit = "%setfield0"
+[%%expect{|
+type 'a ref = { mutable global_ contents : 'a; }
+external ref : 'a -> ('a ref [@local_opt]) = "%makemutable"
+external ( ! ) : ('a ref [@local_opt]) -> 'a = "%field0"
+external ( := ) : ('a ref [@local_opt]) -> 'a -> unit = "%setfield0"
+|}]
+
 let leak n =
   let r = local_ ref n in
   r
@@ -1513,11 +1527,9 @@ val f : local_ 'a -> local_ 'a unb1 unb2 unb3 = <fun>
 (* Fields have the same mode unless they are global or mutable *)
 
 type 'a imm = { imm : 'a }
-type 'a mut = { mutable mut : 'a }
 type 'a gbl = { global_ gbl : 'a }
 [%%expect{|
 type 'a imm = { imm : 'a; }
-type 'a mut = { mutable mut : 'a; }
 type 'a gbl = { global_ gbl : 'a; }
 |}]
 
@@ -1535,16 +1547,6 @@ Line 3, characters 2-7:
 Error: This value escapes its region
   Hint: Cannot return a local value without an "exclave_" annotation
 |}]
-let foo (local_ x) = x.mut
-[%%expect{|
-val foo : local_ 'a mut -> 'a = <fun>
-|}]
-let foo y =
-  let x = local_ { mut = y } in
-  x.mut
-[%%expect{|
-val foo : 'a -> 'a = <fun>
-|}]
 let foo (local_ x) = x.gbl
 [%%expect{|
 val foo : local_ 'a gbl -> 'a = <fun>
@@ -1570,16 +1572,6 @@ Line 3, characters 2-5:
 Error: This value escapes its region
   Hint: Cannot return a local value without an "exclave_" annotation
 |}]
-let foo (local_ { mut }) = mut
-[%%expect{|
-val foo : local_ 'a mut -> 'a = <fun>
-|}]
-let foo y =
-  let { mut } = local_ { mut = y } in
-  mut
-[%%expect{|
-val foo : 'a -> 'a = <fun>
-|}]
 let foo (local_ { gbl }) = gbl
 [%%expect{|
 val foo : local_ 'a gbl -> 'a = <fun>
@@ -1604,25 +1596,6 @@ let foo () =
 [%%expect{|
 val foo : unit -> unit = <fun>
 |}]
-let foo (local_ mut) =
-  let _ = { mut } in
-  ()
-[%%expect{|
-Line 2, characters 12-15:
-2 |   let _ = { mut } in
-                ^^^
-Error: This value escapes its region
-|}]
-let foo () =
-  let mut = local_ ref 5 in
-  let _ = { mut } in
-  ()
-[%%expect{|
-Line 3, characters 12-15:
-3 |   let _ = { mut } in
-                ^^^
-Error: This value escapes its region
-|}]
 let foo (local_ gbl) =
   let _ = { gbl } in
   ()
@@ -2504,7 +2477,7 @@ Error: Signature mismatch:
          Bar of int * string
        is not the same as:
          Bar of int * global_ string
-       Locality mismatch at argument position 2 : The second is global and the first is not.
+       Modalities mismatch at argument position 2 : The second is global and the first is not.
 |}]
 
 
@@ -2531,7 +2504,7 @@ Error: Signature mismatch:
          Bar of int * global_ string
        is not the same as:
          Bar of int * string
-       Locality mismatch at argument position 2 : The first is global and the second is not.
+       Modalities mismatch at argument position 2 : The first is global and the second is not.
 |}]
 
 (* global_ binds closer than star *)
@@ -2684,33 +2657,6 @@ let f (a : string iarray) =
 val f : string iarray -> string ref = <fun>
 |}]
 
-(* Mutable array, like references, is dangerous. They must contain global
-    elements regardless of the array's mode. *)
-
-(* constructing local array from local elements is rejected *)
-let f (local_ x : string) = local_ [| x |]
-[%%expect{|
-Line 1, characters 38-39:
-1 | let f (local_ x : string) = local_ [| x |]
-                                          ^
-Error: This value escapes its region
-|}]
-
-(* constructing local array from global elements is allowed *)
-let f (x : string) = local_ [| x |]
-[%%expect{|
-val f : string -> local_ string array = <fun>
-|}]
-
-(* projecting out of local array gives global elements *)
-let f (local_ a : string array) =
-  match a with
-  | [| x |] -> ref x
-  | _ -> ref "foo"
-[%%expect{|
-val f : local_ string array -> string ref = <fun>
-|}]
-
 (* reported internal to Jane Street as TANDC-1742 *)
 
 module M = struct
@@ -2957,3 +2903,15 @@ let foo () =
 type r = { global_ x : string; y : string; }
 val foo : unit -> r = <fun>
 |}]
+
+
+type r = {x : float; y : float}
+
+let foo () =
+  let local_ r = {x = 3.0; y = 4.0} in
+  (* [r.x] is allocated global and can escape. *)
+  r.x
+[%%expect{|
+type r = { x : float; y : float; }
+val foo : unit -> float = <fun>
+|}]