Manually applied changes from PR #11782 (#1732)

chamelon/compat.jst.ml

@@ -147,12 +147,12 @@ let view_texp (e : expression_desc) =
 type tpat_var_identifier = Value.t
 
 let mkTpat_var ?id:(mode = dummy_value_mode) (ident, name) =
-  Tpat_var (ident, name, mode)
+  Tpat_var (ident, name, Uid.internal_not_actually_unique, mode)
 
 type tpat_alias_identifier = Value.t
 
 let mkTpat_alias ?id:(mode = dummy_value_mode) (p, ident, name) =
-  Tpat_alias (p, ident, name, mode)
+  Tpat_alias (p, ident, name, Uid.internal_not_actually_unique, mode)
 
 type tpat_array_identifier = Asttypes.mutable_flag
 
@@ -175,8 +175,8 @@ type 'a matched_pattern_desc =
 
 let view_tpat (type a) (p : a pattern_desc) : a matched_pattern_desc =
   match p with
-  | Tpat_var (ident, name, mode) -> Tpat_var (ident, name, mode)
-  | Tpat_alias (p, ident, name, mode) -> Tpat_alias (p, ident, name, mode)
+  | Tpat_var (ident, name, _uid, mode) -> Tpat_var (ident, name, mode)
+  | Tpat_alias (p, ident, name, _uid, mode) -> Tpat_alias (p, ident, name, mode)
   | Tpat_array (mut, l) -> Tpat_array (l, mut)
   | _ -> O p
 

native_toplevel/opttoploop.ml

@@ -378,7 +378,7 @@ let name_expression ~loc ~attrs sort exp =
   in
   let sg = [Sig_value(id, vd, Exported)] in
   let pat =
-    { pat_desc = Tpat_var(id, mknoloc name, Mode.Value.legacy);
+    { pat_desc = Tpat_var(id, mknoloc name, vd.val_uid, Mode.Value.legacy);
       pat_loc = loc;
       pat_extra = [];
       pat_type = exp.exp_type;

ocaml/lambda/matching.ml

@@ -234,8 +234,8 @@ end = struct
     | Tpat_any
     | Tpat_var _ ->
         p
-    | Tpat_alias (q, id, s, mode) ->
-        { p with pat_desc = Tpat_alias (simpl_under_orpat q, id, s, mode) }
+    | Tpat_alias (q, id, s, uid, mode) ->
+        { p with pat_desc = Tpat_alias (simpl_under_orpat q, id, s, uid, mode) }
     | Tpat_or (p1, p2, o) ->
         let p1, p2 = (simpl_under_orpat p1, simpl_under_orpat p2) in
         if le_pat p1 p2 then
@@ -258,8 +258,9 @@ end = struct
       in
       match p.pat_desc with
       | `Any -> stop p `Any
-      | `Var (id, s, mode) -> continue p (`Alias (Patterns.omega, id, s, mode))
-      | `Alias (p, id, _, _) ->
+      | `Var (id, s, uid, mode) ->
+        continue p (`Alias (Patterns.omega, id, s, uid, mode))
+      | `Alias (p, id, _, _, _) ->
           aux
             ( (General.view p, patl),
               bind_alias p id ~arg ~arg_sort ~action )
@@ -354,10 +355,10 @@ end = struct
       match p.pat_desc with
       | `Or (p1, p2, _) ->
           split_explode p1 aliases (split_explode p2 aliases rem)
-      | `Alias (p, id, _, _) -> split_explode p (id :: aliases) rem
-      | `Var (id, str, mode) ->
+      | `Alias (p, id, _, _, _) -> split_explode p (id :: aliases) rem
+      | `Var (id, str, uid, mode) ->
           explode
-            { p with pat_desc = `Alias (Patterns.omega, id, str, mode) }
+            { p with pat_desc = `Alias (Patterns.omega, id, str, uid, mode) }
             aliases rem
       | #view as view ->
           (* We are doing two things here:
@@ -595,7 +596,7 @@ end = struct
           match p.pat_desc with
           | `Or (p1, p2, _) ->
               filter_rec ((left, p1, right) :: (left, p2, right) :: rem)
-          | `Alias (p, _, _, _) -> filter_rec ((left, p, right) :: rem)
+          | `Alias (p, _, _, _, _) -> filter_rec ((left, p, right) :: rem)
           | `Var _ -> filter_rec ((left, Patterns.omega, right) :: rem)
           | #Simple.view as view -> (
               let p = { p with pat_desc = view } in
@@ -645,7 +646,7 @@ let rec flatten_pat_line size p k =
   | Tpat_tuple args -> args :: k
   | Tpat_or (p1, p2, _) ->
       flatten_pat_line size p1 (flatten_pat_line size p2 k)
-  | Tpat_alias (p, _, _, _) ->
+  | Tpat_alias (p, _, _, _, _) ->
       (* Note: we are only called from flatten_matrix,
          which is itself only ever used in places
          where variables do not matter (default environments,
@@ -722,7 +723,7 @@ end = struct
       | (p, ps) :: rem -> (
           let p = General.view p in
           match p.pat_desc with
-          | `Alias (p, _, _, _) -> filter_rec ((p, ps) :: rem)
+          | `Alias (p, _, _, _, _) -> filter_rec ((p, ps) :: rem)
           | `Var _ -> filter_rec ((Patterns.omega, ps) :: rem)
           | `Or (p1, p2, _) -> filter_rec_or p1 p2 ps rem
           | #Simple.view as view -> (
@@ -1208,7 +1209,7 @@ let rec omega_like p =
   | Tpat_any
   | Tpat_var _ ->
       true
-  | Tpat_alias (p, _, _, _) -> omega_like p
+  | Tpat_alias (p, _, _, _, _) -> omega_like p
   | Tpat_or (p1, p2, _) -> omega_like p1 || omega_like p2
   | _ -> false
 
@@ -3314,8 +3315,8 @@ let rec comp_match_handlers value_kind comp_fun partial ctx first_match next_mat
 let rec name_pattern default = function
   | ((pat, _), _) :: rem -> (
       match pat.pat_desc with
-      | Tpat_var (id, _, _) -> id
-      | Tpat_alias (_, id, _, _) -> id
+      | Tpat_var (id, _, _, _) -> id
+      | Tpat_alias (_, id, _, _, _) -> id
       | _ -> name_pattern default rem
     )
   | _ -> Ident.create_local default
@@ -3819,7 +3820,7 @@ let for_let ~scopes ~arg_sort ~return_layout loc param pat body =
       (* This eliminates a useless variable (and stack slot in bytecode)
          for "let _ = ...". See #6865. *)
       Lsequence (param, body)
-  | Tpat_var (id, _, _) ->
+  | Tpat_var (id, _, _, _) ->
       (* fast path, and keep track of simple bindings to unboxable numbers *)
       let k = Typeopt.layout pat.pat_env pat.pat_loc arg_sort pat.pat_type in
       Llet (Strict, k, id, param, body)

ocaml/lambda/translclass.ml

@@ -152,8 +152,8 @@ let create_object cl obj init =
 
 let name_pattern default p =
   match p.pat_desc with
-  | Tpat_var (id, _, _) -> id
-  | Tpat_alias(_, id, _, _) -> id
+  | Tpat_var (id, _, _, _) -> id
+  | Tpat_alias(_, id, _, _, _) -> id
   | _ -> Ident.create_local default
 
 let rec build_object_init ~scopes cl_table obj params inh_init obj_init cl =

ocaml/lambda/translcore.ml

@@ -222,7 +222,7 @@ let rec trivial_pat pat =
   match pat.pat_desc with
     Tpat_var _
   | Tpat_any -> true
-  | Tpat_alias (p, _, _, _) ->
+  | Tpat_alias (p, _, _, _, _) ->
       trivial_pat p
   | Tpat_construct (_, cd, [], _) ->
       not cd.cstr_generalized && cd.cstr_consts = 1 && cd.cstr_nonconsts = 0
@@ -283,7 +283,8 @@ let rec push_defaults loc bindings use_lhs arg_mode arg_sort cases
              arg_sort,
              cases, partial) }
       in
-      [{c_lhs = {pat with pat_desc = Tpat_var (param, mknoloc name, mode)};
+      [{c_lhs = {pat with
+          pat_desc = Tpat_var (param, mknoloc name, desc.val_uid, mode)};
         c_guard = None; c_rhs= wrap_bindings bindings exp}]
   | _ ->
       cases
@@ -335,8 +336,8 @@ let assert_failed ~scopes exp =
 
 let rec iter_exn_names f pat =
   match pat.pat_desc with
-  | Tpat_var (id, _, _) -> f id
-  | Tpat_alias (p, id, _, _) ->
+  | Tpat_var (id, _, _, _) -> f id
+  | Tpat_alias (p, id, _, _, _) ->
       f id;
       iter_exn_names f p
   | _ -> ()
@@ -1443,7 +1444,7 @@ and transl_let ~scopes ~return_layout ?(add_regions=false) ?(in_structure=false)
       let idlist =
         List.map
           (fun {vb_pat=pat} -> match pat.pat_desc with
-              Tpat_var (id,_,_) -> id
+              Tpat_var (id,_,_,_) -> id
             | _ -> assert false)
         pat_expr_list in
       let transl_case

ocaml/ocamldoc/odoc_ast.ml

@@ -50,7 +50,7 @@ module Typedtree_search =
 
     let iter_val_pattern = function
       | Typedtree.Tpat_any -> None
-      | Typedtree.Tpat_var (name, _, _) -> Some (Name.from_ident name)
+      | Typedtree.Tpat_var (name, _, _, _) -> Some (Name.from_ident name)
       | Typedtree.Tpat_tuple _ -> None (* FIXME when we will handle tuples *)
       | _ -> None
 
@@ -241,14 +241,14 @@ module Analyser =
     let tt_param_info_from_pattern env f_desc pat =
       let rec iter_pattern pat =
         match pat.pat_desc with
-          Typedtree.Tpat_var (ident, _, _) ->
+          Typedtree.Tpat_var (ident, _, _, _) ->
             let name = Name.from_ident ident in
             Simple_name { sn_name = name ;
                           sn_text = f_desc name ;
                           sn_type = Odoc_env.subst_type env pat.pat_type
                         }
 
-        | Typedtree.Tpat_alias (pat, _, _, _) ->
+        | Typedtree.Tpat_alias (pat, _, _, _, _) ->
             iter_pattern pat
 
         | Typedtree.Tpat_tuple patlist ->
@@ -307,7 +307,7 @@ module Analyser =
                 (
                  (
                   match func_body.exp_desc with
-                    Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _) };
+                    Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _, _) };
                                             vb_expr=exp} :: _, func_body2) ->
                       let name = Name.from_ident id in
                       let new_param = Simple_name
@@ -337,7 +337,7 @@ module Analyser =
      let tt_analyse_value env current_module_name comment_opt loc pat_exp rec_flag =
        let (pat, exp) = pat_exp in
        match (pat.pat_desc, exp.exp_desc) with
-         (Typedtree.Tpat_var (ident, _, _), Typedtree.Texp_function { cases = pat_exp_list2; _ }) ->
+         (Typedtree.Tpat_var (ident, _, _, _), Typedtree.Texp_function { cases = pat_exp_list2; _ }) ->
            (* a new function is defined *)
            let name_pre = Name.from_ident ident in
            let name = Name.parens_if_infix name_pre in
@@ -362,7 +362,7 @@ module Analyser =
            in
            [ new_value ]
 
-       | (Typedtree.Tpat_var (ident, _, _), _) ->
+       | (Typedtree.Tpat_var (ident, _, _, _), _) ->
            (* a new value is defined *)
            let name_pre = Name.from_ident ident in
            let name = Name.parens_if_infix name_pre in
@@ -467,7 +467,7 @@ module Analyser =
                             (
                              (
                               match body.exp_desc with
-                                Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _) };
+                                Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _, _) };
                                                         vb_expr=exp} :: _, body2) ->
                                   let name = Name.from_ident id in
                                   let new_param = Simple_name
@@ -728,11 +728,11 @@ module Analyser =
               a default value. In this case, we look for the good parameter pattern *)
            let (parameter, next_tt_class_exp) =
              match pat.Typedtree.pat_desc with
-               Typedtree.Tpat_var (ident, _, _) when String.starts_with (Name.from_ident ident) ~prefix:"*opt*" ->
+               Typedtree.Tpat_var (ident, _, _, _) when String.starts_with (Name.from_ident ident) ~prefix:"*opt*" ->
                  (
                   (* there must be a Tcl_let just after *)
                   match tt_class_expr2.Typedtree.cl_desc with
-                    Typedtree.Tcl_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id,_,_) };
+                    Typedtree.Tcl_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id,_,_,_) };
                                            vb_expr=exp} :: _, _, tt_class_expr3) ->
                       let name = Name.from_ident id in
                       let new_param = Simple_name

ocaml/testsuite/tests/shapes/simple.ml

@@ -126,9 +126,9 @@ class c : object  end
 class type c = object end
 [%%expect{|
 {
- "#c"[type] -> <.34>;
- "c"[type] -> <.34>;
- "c"[class type] -> <.34>;
+ "#c"[type] -> <.35>;
+ "c"[type] -> <.35>;
+ "c"[class type] -> <.35>;
  }
 class type c = object  end
 |}]

ocaml/toplevel/native/topeval.ml

@@ -134,7 +134,7 @@ let name_expression ~loc ~attrs sort exp =
    in
    let sg = [Sig_value(id, vd, Exported)] in
    let pat =
-     { pat_desc = Tpat_var(id, mknoloc name, Mode.Value.legacy);
+     { pat_desc = Tpat_var(id, mknoloc name, vd.val_uid, Mode.Value.legacy);
        pat_loc = loc;
        pat_extra = [];
        pat_type = exp.exp_type;

ocaml/typing/cmt2annot.ml

@@ -23,7 +23,7 @@ let variables_iterator scope =
   let super = default_iterator in
   let pat sub (type k) (p : k general_pattern) =
     begin match p.pat_desc with
-    | Tpat_var (id, _, _) | Tpat_alias (_, id, _, _) ->
+    | Tpat_var (id, _, _, _) | Tpat_alias (_, id, _, _, _) ->
         Stypes.record (Stypes.An_ident (p.pat_loc,
                                         Ident.name id,
                                         Annot.Idef scope))