PR#8934: used as a base for other PRspr8934

23 files changed, 591 insertions, 382 deletions

diff --git a/Changes b/Changes
index 6b65274498..6c1ebb4ece 100644
--- a/Changes
+++ b/Changes
@@ -74,6 +74,9 @@ Working version
   "*").
   (Thomas Refis, review by ...)
 
+- #8934: Stop relying on location to track usage
+  (Thomas Refis, review by ...)
+
 ### Code generation and optimizations:
 
 - #8672: Optimise Switch code generation on booleans.
diff --git a/lambda/translcore.ml b/lambda/translcore.ml
index fc88d05559..5bd2f0680f 100644
--- a/lambda/translcore.ml
+++ b/lambda/translcore.ml
@@ -126,7 +126,8 @@ let rec push_defaults loc bindings cases partial =
       let param = Typecore.name_cases "param" cases in
       let desc =
         {val_type = pat.pat_type; val_kind = Val_reg;
-         val_attributes = []; Types.val_loc = Location.none; }
+         val_attributes = []; Types.val_loc = Location.none;
+         val_uid = Types.Uid.internal_not_actually_unique; }
       in
       let env = Env.add_value param desc exp.exp_env in
       let name = Ident.name param in
diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml
index b695338e2a..e7cb90ab21 100644
--- a/ocamldoc/odoc_sig.ml
+++ b/ocamldoc/odoc_sig.ml
@@ -413,7 +413,7 @@ module Analyser =
           { Typedtree.ld_id; ld_mutable; ld_type; ld_loc; ld_attributes } =
         get_field env comments @@
         {Types.ld_id; ld_mutable; ld_type=ld_type.Typedtree.ctyp_type;
-         ld_loc; ld_attributes } in
+         ld_loc; ld_attributes; ld_uid=Types.Uid.internal_not_actually_unique} in
       let open Typedtree in
       function
       | Cstr_tuple l ->
diff --git a/testsuite/tests/typing-sigsubst/test_locations.compilers.reference b/testsuite/tests/typing-sigsubst/test_locations.compilers.reference
index 86afba6715..c315538122 100644
--- a/testsuite/tests/typing-sigsubst/test_locations.compilers.reference
+++ b/testsuite/tests/typing-sigsubst/test_locations.compilers.reference
@@ -2,14 +2,7 @@ File "test_loc_type_eq.ml", line 1, characters 49-76:
 1 | module M : Test_functor.S with type elt = unit = Test_functor.Apply (String)
                                                      ^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Signature mismatch:
-       Modules do not match:
-         sig
-           type elt = String.t
-           type t = Test_functor.Apply(String).t
-           val create : elt -> t
-         end
-       is not included in
-         sig type elt = unit type t val create : elt -> t end
+       ...
        Type declarations do not match:
          type elt = String.t
        is not included in
diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
index f4526692b6..6b1abe29f0 100644
--- a/toplevel/topdirs.ml
+++ b/toplevel/topdirs.ml
@@ -565,8 +565,10 @@ let () =
            ext_args = Cstr_tuple desc.cstr_args;
            ext_ret_type = ret_type;
            ext_private = Asttypes.Public;
-           Types.ext_loc = desc.cstr_loc;
-           Types.ext_attributes = desc.cstr_attributes; }
+           ext_loc = desc.cstr_loc;
+           ext_attributes = desc.cstr_attributes;
+           ext_uid = desc.cstr_uid;
+         }
        in
          [Sig_typext (id, ext, Text_exception, Exported)]
     )
diff --git a/typing/ctype.ml b/typing/ctype.ml
index e4d385db3f..4dfa7501df 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -1232,6 +1232,7 @@ let new_declaration expansion_scope manifest =
     type_attributes = [];
     type_immediate = false;
     type_unboxed = unboxed_false_default_false;
+    type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
   }
 
 let existential_name cstr ty = match repr ty with
@@ -4640,6 +4641,7 @@ let nondep_type_decl env mid is_covariant decl =
       type_attributes = decl.type_attributes;
       type_immediate = decl.type_immediate;
       type_unboxed = decl.type_unboxed;
+      type_uid = decl.type_uid;
     }
   with Nondep_cannot_erase _ as exn ->
     clear_hash ();
@@ -4676,6 +4678,7 @@ let nondep_extension_constructor env ids ext =
         ext_private = ext.ext_private;
         ext_attributes = ext.ext_attributes;
         ext_loc = ext.ext_loc;
+        ext_uid = ext.ext_uid;
       }
   with Nondep_cannot_erase _ as exn ->
     clear_hash ();
@@ -4719,6 +4722,7 @@ let nondep_class_declaration env ids decl =
         end;
       cty_loc = decl.cty_loc;
       cty_attributes = decl.cty_attributes;
+      cty_uid = decl.cty_uid;
     }
   in
   clear_hash ();
@@ -4733,6 +4737,7 @@ let nondep_cltype_declaration env ids decl =
       clty_path = decl.clty_path;
       clty_loc = decl.clty_loc;
       clty_attributes = decl.clty_attributes;
+      clty_uid = decl.clty_uid;
     }
   in
   clear_hash ();
diff --git a/typing/datarepr.ml b/typing/datarepr.ml
index 9c997a78cd..374e538510 100644
--- a/typing/datarepr.ml
+++ b/typing/datarepr.ml
@@ -65,7 +65,7 @@ let constructor_existentials cd_args cd_res =
   in
   (tyl, existentials)
 
-let constructor_args priv cd_args cd_res path rep =
+let constructor_args ~current_unit priv cd_args cd_res path rep =
   let tyl, existentials = constructor_existentials cd_args cd_res in
   match cd_args with
   | Cstr_tuple l -> existentials, l, None
@@ -91,13 +91,14 @@ let constructor_args priv cd_args cd_res path rep =
           type_attributes = [];
           type_immediate = false;
           type_unboxed;
+          type_uid = Uid.mk ~current_unit;
         }
       in
       existentials,
       [ newgenconstr path type_params ],
       Some tdecl
 
-let constructor_descrs ty_path decl cstrs =
+let constructor_descrs ~current_unit ty_path decl cstrs =
   let ty_res = newgenconstr ty_path decl.type_params in
   let num_consts = ref 0 and num_nonconsts = ref 0  and num_normal = ref 0 in
   List.iter
@@ -107,7 +108,7 @@ let constructor_descrs ty_path decl cstrs =
     cstrs;
   let rec describe_constructors idx_const idx_nonconst = function
       [] -> []
-    | {cd_id; cd_args; cd_res; cd_loc; cd_attributes} :: rem ->
+    | {cd_id; cd_args; cd_res; cd_loc; cd_attributes; cd_uid} :: rem ->
         let ty_res =
           match cd_res with
           | Some ty_res' -> ty_res'
@@ -129,7 +130,7 @@ let constructor_descrs ty_path decl cstrs =
             then Record_unboxed true
             else Record_inlined idx_nonconst
           in
-          constructor_args decl.type_private cd_args cd_res
+          constructor_args ~current_unit decl.type_private cd_args cd_res
             (Path.Pdot (ty_path, cstr_name)) representation
         in
         let cstr =
@@ -147,18 +148,19 @@ let constructor_descrs ty_path decl cstrs =
             cstr_loc = cd_loc;
             cstr_attributes = cd_attributes;
             cstr_inlined;
+            cstr_uid = cd_uid;
           } in
         (cd_id, cstr) :: descr_rem in
   describe_constructors 0 0 cstrs
 
-let extension_descr path_ext ext =
+let extension_descr ~current_unit path_ext ext =
   let ty_res =
     match ext.ext_ret_type with
         Some type_ret -> type_ret
       | None -> newgenconstr ext.ext_type_path ext.ext_type_params
   in
   let existentials, cstr_args, cstr_inlined =
-    constructor_args ext.ext_private ext.ext_args ext.ext_ret_type
+    constructor_args ~current_unit ext.ext_private ext.ext_args ext.ext_ret_type
       path_ext (Record_extension path_ext)
   in
     { cstr_name = Path.last path_ext;
@@ -175,6 +177,7 @@ let extension_descr path_ext ext =
       cstr_loc = ext.ext_loc;
       cstr_attributes = ext.ext_attributes;
       cstr_inlined;
+      cstr_uid = ext.ext_uid;
     }
 
 let none = {desc = Ttuple []; level = -1; scope = Btype.generic_level; id = -1}
@@ -185,6 +188,7 @@ let dummy_label =
     lbl_private = Public;
     lbl_loc = Location.none;
     lbl_attributes = [];
+    lbl_uid = Uid.internal_not_actually_unique;
   }
 
 let label_descrs ty_res lbls repres priv =
@@ -203,6 +207,7 @@ let label_descrs ty_res lbls repres priv =
             lbl_private = priv;
             lbl_loc = l.ld_loc;
             lbl_attributes = l.ld_attributes;
+            lbl_uid = l.ld_uid;
           } in
         all_labels.(num) <- lbl;
         (l.ld_id, lbl) :: describe_labels (num+1) rest in
@@ -225,9 +230,9 @@ let rec find_constr tag num_const num_nonconst = function
 let find_constr_by_tag tag cstrlist =
   find_constr tag 0 0 cstrlist
 
-let constructors_of_type ty_path decl =
+let constructors_of_type ~current_unit ty_path decl =
   match decl.type_kind with
-  | Type_variant cstrs -> constructor_descrs ty_path decl cstrs
+  | Type_variant cstrs -> constructor_descrs ~current_unit ty_path decl cstrs
   | Type_record _ | Type_abstract | Type_open -> []
 
 let labels_of_type ty_path decl =
diff --git a/typing/datarepr.mli b/typing/datarepr.mli
index 30dc1f1f6c..e3962e3a07 100644
--- a/typing/datarepr.mli
+++ b/typing/datarepr.mli
@@ -19,13 +19,14 @@
 open Types
 
 val extension_descr:
-  Path.t -> extension_constructor -> constructor_description
+  current_unit:string -> Path.t -> extension_constructor ->
+  constructor_description
 
 val labels_of_type:
   Path.t -> type_declaration ->
   (Ident.t * label_description) list
 val constructors_of_type:
-  Path.t -> type_declaration ->
+  current_unit:string -> Path.t -> type_declaration ->
   (Ident.t * constructor_description) list
 
 
diff --git a/typing/env.ml b/typing/env.ml
index 203d3c8911..03b45eaaff 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -27,16 +27,17 @@ module String = Misc.Stdlib.String
 
 let add_delayed_check_forward = ref (fun _ -> assert false)
 
-let value_declarations : ((string * Location.t), (unit -> unit)) Hashtbl.t =
-  Hashtbl.create 16
-    (* This table is used to usage of value declarations.  A declaration is
-       identified with its name and location.  The callback attached to a
-       declaration is called whenever the value is used explicitly
-       (lookup_value) or implicitly (inclusion test between signatures,
-       cf Includemod.value_descriptions). *)
-
-let type_declarations = Hashtbl.create 16
-let module_declarations = Hashtbl.create 16
+type 'a usage_tbl = (Types.Uid.t, 'a -> unit) Hashtbl.t
+(** This table is used to usage of value declarations.
+    A declaration is identified by its uid.
+    The callback attached to a declaration is called whenever the value (or
+    type, or ...) is used explicitly (lookup_value, ...) or implicitly
+    (inclusion test between signatures, cf Includemod.value_descriptions, ...).
+*)
+
+let value_declarations  : unit usage_tbl = Hashtbl.create 16
+let type_declarations   : unit usage_tbl = Hashtbl.create 16
+let module_declarations : unit usage_tbl = Hashtbl.create 16
 
 type constructor_usage = Positive | Pattern | Privatize
 type constructor_usages =
@@ -58,9 +59,7 @@ let add_constructor_usage priv cu usage =
 let constructor_usages () =
   {cu_positive = false; cu_pattern = false; cu_privatize = false}
 
-let used_constructors :
-    (string * Location.t * string, (constructor_usage -> unit)) Hashtbl.t
-  = Hashtbl.create 16
+let used_constructors : constructor_usage usage_tbl = Hashtbl.create 16
 
 (** Map indexed by the name of module components. *)
 module NameMap = String.Map
@@ -407,7 +406,7 @@ and module_declaration_lazy =
 and module_components =
   {
     alerts: alerts;
-    loc: Location.t;
+    uid: Uid.t;
     comps:
       (components_maker,
        (module_components_repr, module_components_failure) result)
@@ -648,7 +647,8 @@ let strengthen =
          aliasable:bool -> t -> module_type -> Path.t -> module_type)
 
 let md md_type =
-  {md_type; md_attributes=[]; md_loc=Location.none}
+  {md_type; md_attributes=[]; md_loc=Location.none
+  ;md_uid = Uid.internal_not_actually_unique}
 
 (* Print addresses *)
 
@@ -703,10 +703,10 @@ let add_persistent_structure id env =
   else
     env
 
-let components_of_module ~alerts ~loc env fs ps path addr mty =
+let components_of_module ~alerts ~uid env fs ps path addr mty =
   {
     alerts;
-    loc;
+    uid;
     comps = EnvLazy.create {
       cm_env = env;
       cm_freshening_subst = fs;
@@ -728,8 +728,13 @@ let sign_of_cmi ~freshen { Persistent_env.Persistent_signature.cmi; _ } =
       Misc.Stdlib.String.Map.empty
       flags
   in
-  let loc = Location.none in
-  let md = md (Mty_signature sign) in
+  let md =
+    { md_type =  Mty_signature sign;
+      md_loc = Location.none;
+      md_attributes = [];
+      md_uid = Uid.of_compilation_unit_id id;
+    }
+  in
   let mda_address = EnvLazy.create_forced (Aident id) in
   let mda_declaration =
     EnvLazy.create (Subst.identity, Subst.Make_local, md)
@@ -738,7 +743,7 @@ let sign_of_cmi ~freshen { Persistent_env.Persistent_signature.cmi; _ } =
     let freshening_subst =
       if freshen then (Some Subst.identity) else None
     in
-    components_of_module ~alerts ~loc
+    components_of_module ~alerts ~uid:md.md_uid
       empty freshening_subst Subst.identity
       path mda_address (Mty_signature sign)
   in
@@ -1495,7 +1500,10 @@ let rec components_of_module_maker
             Datarepr.set_row_name final_decl
               (Subst.type_path prefixing_sub (Path.Pident id));
             let constructors =
-              List.map snd (Datarepr.constructors_of_type path final_decl) in
+              List.map snd
+                (Datarepr.constructors_of_type ~current_unit:(get_unit_name ())
+                   path final_decl)
+            in
             let labels =
               List.map snd (Datarepr.labels_of_type path final_decl) in
             let tda =
@@ -1517,7 +1525,10 @@ let rec components_of_module_maker
             env := store_type_infos id fresh_decl !env
         | Sig_typext(id, ext, _, _) ->
             let ext' = Subst.extension_constructor sub ext in
-            let descr = Datarepr.extension_descr path ext' in
+            let descr =
+              Datarepr.extension_descr ~current_unit:(get_unit_name ()) path
+                ext'
+            in
             let addr = next_address () in
             let cda = { cda_description = descr; cda_address = Some addr } in
             c.comp_constrs <- add_to_tbl (Ident.name id) cda c.comp_constrs
@@ -1542,7 +1553,7 @@ let rec components_of_module_maker
               Builtin_attributes.alerts_of_attrs md.md_attributes
             in
             let comps =
-              components_of_module ~alerts ~loc:md.md_loc !env freshening_sub
+              components_of_module ~alerts ~uid:md.md_uid !env freshening_sub
                 prefixing_sub path addr md.md_type
             in
             let mda =
@@ -1602,13 +1613,15 @@ let rec components_of_module_maker
 
 (* Insertion of bindings by identifier + path *)
 
-and check_usage loc id warn tbl =
-  if not loc.Location.loc_ghost && Warnings.is_active (warn "") then begin
+and check_usage loc id uid warn tbl =
+  if not loc.Location.loc_ghost &&
+     Uid.for_actual_declaration uid &&
+     Warnings.is_active (warn "")
+  then begin
     let name = Ident.name id in
-    let key = (name, loc) in
-    if Hashtbl.mem tbl key then ()
+    if Hashtbl.mem tbl uid then ()
     else let used = ref false in
-    Hashtbl.add tbl key (fun () -> used := true);
+    Hashtbl.add tbl uid (fun () -> used := true);
     if not (name = "" || name.[0] = '_' || name.[0] = '#')
     then
       !add_delayed_check_forward
@@ -1627,7 +1640,9 @@ and check_value_name name loc =
 
 and store_value ?check id addr decl env =
   check_value_name (Ident.name id) decl.val_loc;
-  Option.iter (fun f -> check_usage decl.val_loc id f value_declarations) check;
+  Option.iter
+    (fun f -> check_usage decl.val_loc id decl.val_uid f value_declarations)
+    check;
   let vda = { vda_description = decl; vda_address = addr } in
   { env with
     values = IdTbl.add id (Val_bound vda) env.values;
@@ -1636,10 +1651,14 @@ and store_value ?check id addr decl env =
 and store_type ~check id info env =
   let loc = info.type_loc in
   if check then
-    check_usage loc id (fun s -> Warnings.Unused_type_declaration s)
+    check_usage loc id info.type_uid
+      (fun s -> Warnings.Unused_type_declaration s)
       type_declarations;
   let path = Pident id in
-  let constructors = Datarepr.constructors_of_type path info in
+  let constructors =
+    Datarepr.constructors_of_type path info
+      ~current_unit:(get_unit_name ())
+  in
   let labels = Datarepr.labels_of_type path info in
   let descrs = (List.map snd constructors, List.map snd labels) in
   let tda = { tda_declaration = info; tda_descriptions = descrs } in
@@ -1652,7 +1671,7 @@ and store_type ~check id info env =
       begin fun (_, cstr) ->
         let name = cstr.cstr_name in
         let loc = cstr.cstr_loc in
-        let k = (ty_name, loc, name) in
+        let k = cstr.cstr_uid in
         if not (Hashtbl.mem used_constructors k) then
           let used = constructor_usages () in
           Hashtbl.add used_constructors k (add_constructor_usage priv used);
@@ -1693,16 +1712,17 @@ and store_type_infos id info env =
 
 and store_extension ~check id addr ext env =
   let loc = ext.ext_loc in
-  let cstr = Datarepr.extension_descr (Pident id) ext in
+  let cstr =
+    Datarepr.extension_descr ~current_unit:(get_unit_name ()) (Pident id) ext
+  in
   let cda = { cda_description = cstr; cda_address = Some addr } in
   if check && not loc.Location.loc_ghost &&
     Warnings.is_active (Warnings.Unused_extension ("", false, false, false))
   then begin
     let priv = ext.ext_private in
     let is_exception = Path.same ext.ext_type_path Predef.path_exn in
-    let ty_name = Path.last ext.ext_type_path in
     let name = cstr.cstr_name in
-    let k = (ty_name, loc, name) in
+    let k = cstr.cstr_uid in
     if not (Hashtbl.mem used_constructors k) then begin
       let used = constructor_usages () in
       Hashtbl.add used_constructors k (add_constructor_usage priv used);
@@ -1722,7 +1742,8 @@ and store_extension ~check id addr ext env =
 
 and store_module ~check ~freshening_sub id addr presence md env =
   let loc = md.md_loc in
-  Option.iter (fun f -> check_usage loc id f module_declarations) check;
+  Option.iter
+    (fun f -> check_usage loc id md.md_uid f module_declarations) check;
   let alerts = Builtin_attributes.alerts_of_attrs md.md_attributes in
   let module_decl_lazy =
     match freshening_sub with
@@ -1730,7 +1751,7 @@ and store_module ~check ~freshening_sub id addr presence md env =
     | Some s -> EnvLazy.create (s, Subst.Rescope (Ident.scope id), md)
   in
   let comps =
-    components_of_module ~alerts ~loc:md.md_loc
+    components_of_module ~alerts ~uid:md.md_uid
       env freshening_sub Subst.identity (Pident id) addr md.md_type
   in
   let mda =
@@ -1781,7 +1802,7 @@ let components_of_functor_appl ~loc f env p1 p2 =
       ("the signature of " ^ Path.name p) mty;
     let comps =
       components_of_module ~alerts:Misc.Stdlib.String.Map.empty
-        ~loc:Location.none
+        ~uid:Uid.internal_not_actually_unique
         (*???*)
         env None Subst.identity p addr mty
     in
@@ -2091,41 +2112,35 @@ let (initial_safe_string, initial_unsafe_string) =
 
 (* Tracking usage *)
 
-let mark_module_used name loc =
-  match Hashtbl.find module_declarations (name, loc) with
+let mark_module_used uid =
+  match Hashtbl.find module_declarations uid with
   | mark -> mark ()
   | exception Not_found -> ()
 
-let mark_modtype_used _name _mtd = ()
+let mark_modtype_used _uid = ()
 
-let mark_value_used name vd =
-  match Hashtbl.find value_declarations (name, vd.val_loc) with
+let mark_value_used uid =
+  match Hashtbl.find value_declarations uid with
   | mark -> mark ()
   | exception Not_found -> ()
 
-let mark_type_used name td =
-  match Hashtbl.find type_declarations (name, td.type_loc) with
+let mark_type_used uid =
+  match Hashtbl.find type_declarations uid with
   | mark -> mark ()
   | exception Not_found -> ()
 
 let mark_type_path_used env path =
   match find_type path env with
-  | decl -> mark_type_used (Path.last path) decl
+  | decl -> mark_type_used decl.type_uid
   | exception Not_found -> ()
 
-let mark_constructor_used usage ty_name cd =
-  let name = Ident.name cd.cd_id in
-  let loc = cd.cd_loc in
-  let k = (ty_name, loc, name) in
-  match Hashtbl.find used_constructors k with
+let mark_constructor_used usage cd =
+  match Hashtbl.find used_constructors cd.cd_uid with
   | mark -> mark usage
   | exception Not_found -> ()
 
-let mark_extension_used usage name ext =
-  let ty_name = Path.last ext.ext_type_path in
-  let loc = ext.ext_loc in
-  let k = (ty_name, loc, name) in
-  match Hashtbl.find used_constructors k with
+let mark_extension_used usage ext =
+  match Hashtbl.find used_constructors ext.ext_uid with
   | mark -> mark usage
   | exception Not_found -> ()
 
@@ -2136,9 +2151,7 @@ let mark_constructor_description_used usage env cstr =
     | _ -> assert false
   in
   mark_type_path_used env ty_path;
-  let ty_name = Path.last ty_path in
-  let k = (ty_name, cstr.cstr_loc, cstr.cstr_name) in
-  match Hashtbl.find used_constructors k with
+  match Hashtbl.find used_constructors cstr.cstr_uid with
   | mark -> mark usage
   | exception Not_found -> ()
 
@@ -2150,37 +2163,26 @@ let mark_label_description_used () env lbl =
   in
   mark_type_path_used env ty_path
 
-let mark_class_used name cty =
-  match Hashtbl.find type_declarations (name, cty.cty_loc) with
+let mark_class_used uid =
+  match Hashtbl.find type_declarations uid with
   | mark -> mark ()
   | exception Not_found -> ()
 
-let mark_cltype_used name clty =
-  match Hashtbl.find type_declarations (name, clty.clty_loc) with
+let mark_cltype_used uid =
+  match Hashtbl.find type_declarations uid with
   | mark -> mark ()
   | exception Not_found -> ()
 
-let set_value_used_callback name vd callback =
-  let key = (name, vd.val_loc) in
-  try
-    let old = Hashtbl.find value_declarations key in
-    Hashtbl.replace value_declarations key (fun () -> old (); callback ())
-      (* this is to support cases like:
-               let x = let x = 1 in x in x
-         where the two declarations have the same location
-         (e.g. resulting from Camlp4 expansion of grammar entries) *)
-  with Not_found ->
-    Hashtbl.add value_declarations key callback
-
-let set_type_used_callback name td callback =
-  let loc = td.type_loc in
-  if loc.Location.loc_ghost then ()
-  else let key = (name, loc) in
-  let old =
-    try Hashtbl.find type_declarations key
-    with Not_found -> ignore
-  in
-  Hashtbl.replace type_declarations key (fun () -> callback old)
+let set_value_used_callback vd callback =
+  Hashtbl.add value_declarations vd.val_uid callback
+
+let set_type_used_callback td callback =
+  if Uid.for_actual_declaration td.type_uid then
+    let old =
+      try Hashtbl.find type_declarations td.type_uid
+      with Not_found -> ignore
+    in
+    Hashtbl.replace type_declarations td.type_uid (fun () -> callback old)
 
 (* Lookup by name *)
 
@@ -2213,10 +2215,10 @@ let report_value_unbound ~errors ~loc env reason lid =
       in
       may_lookup_error errors loc env (Unbound_value(lid, hint))
 
-let use_module ~use ~loc name path mda =
+let use_module ~use ~loc path mda =
   if use then begin
     let comps = mda.mda_components in
-    mark_module_used name comps.loc;
+    mark_module_used comps.uid;
     Misc.Stdlib.String.Map.iter
       (fun kind message ->
          let message = if message = "" then "" else "\n" ^ message in
@@ -2226,40 +2228,40 @@ let use_module ~use ~loc name path mda =
       comps.alerts
   end
 
-let use_value ~use ~loc name path vda =
+let use_value ~use ~loc path vda =
   if use then begin
     let desc = vda.vda_description in
-    mark_value_used name desc;
+    mark_value_used desc.val_uid;
     Builtin_attributes.check_alerts loc desc.val_attributes
       (Path.name path)
   end
 
-let use_type ~use ~loc name path tda =
+let use_type ~use ~loc path tda =
   if use then begin
     let decl = tda.tda_declaration in
-    mark_type_used name decl;
+    mark_type_used decl.type_uid;
     Builtin_attributes.check_alerts loc decl.type_attributes
       (Path.name path)
   end
 
-let use_modtype ~use ~loc name path desc =
+let use_modtype ~use ~loc path desc =
   if use then begin
-    mark_modtype_used name desc;
+    mark_modtype_used desc.mtd_uid;
     Builtin_attributes.check_alerts loc desc.mtd_attributes
       (Path.name path)
   end
 
-let use_class ~use ~loc name path clda =
+let use_class ~use ~loc path clda =
   if use then begin
     let desc = clda.clda_declaration in
-    mark_class_used name desc;
+    mark_class_used desc.cty_uid;
     Builtin_attributes.check_alerts loc desc.cty_attributes
       (Path.name path)
   end
 
-let use_cltype ~use ~loc name path desc =
+let use_cltype ~use ~loc path desc =
   if use then begin
-    mark_cltype_used name desc;
+    mark_cltype_used desc.clty_uid;
     Builtin_attributes.check_alerts loc desc.clty_attributes
       (Path.name path)
   end
@@ -2292,7 +2294,7 @@ let lookup_ident_module (type a) (load : a load) ~errors ~use ~loc s env =
   in
   match data with
   | Mod_local mda -> begin
-      use_module ~use ~loc s path mda;
+      use_module ~use ~loc path mda;
       match load with
       | Load -> path, (mda : a)
       | Don't_load -> path, (() : a)
@@ -2307,7 +2309,7 @@ let lookup_ident_module (type a) (load : a load) ~errors ~use ~loc s env =
       | Load -> begin
           match find_pers_mod s with
           | mda ->
-              use_module ~use ~loc s path mda;
+              use_module ~use ~loc path mda;
               path, (mda : a)
           | exception Not_found ->
               may_lookup_error errors loc env (Unbound_module (Lident s))
@@ -2317,7 +2319,7 @@ let lookup_ident_module (type a) (load : a load) ~errors ~use ~loc s env =
 let lookup_ident_value ~errors ~use ~loc name env =
   match IdTbl.find_name wrap_value ~mark:use name env.values with
   | (path, Val_bound vda) ->
-      use_value ~use ~loc name path vda;
+      use_value ~use ~loc path vda;
       path, vda.vda_description
   | (_, Val_unbound reason) ->
       report_value_unbound ~errors ~loc env reason (Lident name)
@@ -2327,7 +2329,7 @@ let lookup_ident_value ~errors ~use ~loc name env =
 let lookup_ident_type ~errors ~use ~loc s env =
   match IdTbl.find_name wrap_identity ~mark:use s env.types with
   | (path, data) as res ->
-      use_type ~use ~loc s path data;
+      use_type ~use ~loc path data;
       res
   | exception Not_found ->
       may_lookup_error errors loc env (Unbound_type (Lident s))
@@ -2335,7 +2337,7 @@ let lookup_ident_type ~errors ~use ~loc s env =
 let lookup_ident_modtype ~errors ~use ~loc s env =
   match IdTbl.find_name wrap_identity ~mark:use s env.modtypes with
   | (path, data) as res ->
-      use_modtype ~use ~loc s path data;
+      use_modtype ~use ~loc path data;
       res
   | exception Not_found ->
       may_lookup_error errors loc env (Unbound_modtype (Lident s))
@@ -2343,7 +2345,7 @@ let lookup_ident_modtype ~errors ~use ~loc s env =
 let lookup_ident_class ~errors ~use ~loc s env =
   match IdTbl.find_name wrap_identity ~mark:use s env.classes with
   | (path, clda) ->
-      use_class ~use ~loc s path clda;
+      use_class ~use ~loc path clda;
       path, clda.clda_declaration
   | exception Not_found ->
       may_lookup_error errors loc env (Unbound_class (Lident s))
@@ -2351,7 +2353,7 @@ let lookup_ident_class ~errors ~use ~loc s env =
 let lookup_ident_cltype ~errors ~use ~loc s env =
   match IdTbl.find_name wrap_identity ~mark:use s env.cltypes with
   | (path, data) as res ->
-      use_cltype ~use ~loc s path data;
+      use_cltype ~use ~loc path data;
       res
   | exception Not_found ->
       may_lookup_error errors loc env (Unbound_cltype (Lident s))
@@ -2460,7 +2462,7 @@ and lookup_dot_module ~errors ~use ~loc l s env =
   match NameMap.find s comps.comp_modules with
   | mda ->
       let path = Pdot(p, s) in
-      use_module ~use ~loc s path mda;
+      use_module ~use ~loc path mda;
       (path, mda)
   | exception Not_found ->
       may_lookup_error errors loc env (Unbound_module (Ldot(l, s)))
@@ -2472,7 +2474,7 @@ let lookup_dot_value ~errors ~use ~loc l s env =
   match NameMap.find s comps.comp_values with
   | vda ->
       let path = Pdot(path, s) in
-      use_value ~use ~loc s path vda;
+      use_value ~use ~loc path vda;
       (path, vda.vda_description)
   | exception Not_found ->
       may_lookup_error errors loc env (Unbound_value (Ldot(l, s), No_hint))
@@ -2482,7 +2484,7 @@ let lookup_dot_type ~errors ~use ~loc l s env =
   match NameMap.find s comps.comp_types with
   | tda ->
       let path = Pdot(p, s) in
-      use_type ~use ~loc s path tda;
+      use_type ~use ~loc path tda;
       (path, tda)
   | exception Not_found ->
       may_lookup_error errors loc env (Unbound_type (Ldot(l, s)))
@@ -2492,7 +2494,7 @@ let lookup_dot_modtype ~errors ~use ~loc l s env =
   match NameMap.find s comps.comp_modtypes with
   | desc ->
       let path = Pdot(p, s) in
-      use_modtype ~use ~loc s path desc;
+      use_modtype ~use ~loc path desc;
       (path, desc)
   | exception Not_found ->
       may_lookup_error errors loc env (Unbound_modtype (Ldot(l, s)))
@@ -2502,7 +2504,7 @@ let lookup_dot_class ~errors ~use ~loc l s env =
   match NameMap.find s comps.comp_classes with
   | clda ->
       let path = Pdot(p, s) in
-      use_class ~use ~loc s path clda;
+      use_class ~use ~loc path clda;
       (path, clda.clda_declaration)
   | exception Not_found ->
       may_lookup_error errors loc env (Unbound_class (Ldot(l, s)))
@@ -2512,7 +2514,7 @@ let lookup_dot_cltype ~errors ~use ~loc l s env =
   match NameMap.find s comps.comp_cltypes with
   | desc ->
       let path = Pdot(p, s) in
-      use_cltype ~use ~loc s path desc;
+      use_cltype ~use ~loc path desc;
       (path, desc)
   | exception Not_found ->
       may_lookup_error errors loc env (Unbound_cltype (Ldot(l, s)))
@@ -2731,7 +2733,7 @@ let lookup_instance_variable ?(use=true) ~loc name env =
       let desc = vda.vda_description in
       match desc.val_kind with
       | Val_ivar(mut, cl_num) ->
-          use_value ~use ~loc name path vda;
+          use_value ~use ~loc path vda;
           path, mut, cl_num, desc.val_type
       | _ ->
           lookup_error loc env (Not_an_instance_variable name)
diff --git a/typing/env.mli b/typing/env.mli
index 214ed233ea..7355758f7f 100644
--- a/typing/env.mli
+++ b/typing/env.mli
@@ -127,15 +127,15 @@ val add_required_global: Ident.t -> unit
 val has_local_constraints: t -> bool
 
 (* Mark definitions as used *)
-val mark_value_used: string -> value_description -> unit
-val mark_module_used: string -> Location.t -> unit
-val mark_type_used: string -> type_declaration -> unit
+val mark_value_used: Uid.t -> unit
+val mark_module_used: Uid.t -> unit
+val mark_type_used: Uid.t -> unit
 
 type constructor_usage = Positive | Pattern | Privatize
 val mark_constructor_used:
-    constructor_usage -> string -> constructor_declaration -> unit
+    constructor_usage -> constructor_declaration -> unit
 val mark_extension_used:
-    constructor_usage -> string -> extension_constructor -> unit
+    constructor_usage -> extension_constructor -> unit
 
 (* Lookup by long identifiers *)
 
@@ -403,9 +403,9 @@ val in_signature: bool -> t -> t
 val is_in_signature: t -> bool
 
 val set_value_used_callback:
-    string -> value_description -> (unit -> unit) -> unit
+    value_description -> (unit -> unit) -> unit
 val set_type_used_callback:
-    string -> type_declaration -> ((unit -> unit) -> unit) -> unit
+    type_declaration -> ((unit -> unit) -> unit) -> unit
 
 (* Forward declaration to break mutual recursion with Includemod. *)
 val check_functor_application:
diff --git a/typing/includecore.ml b/typing/includecore.ml
index e4615354c3..cd1a3200b5 100644
--- a/typing/includecore.ml
+++ b/typing/includecore.ml
@@ -413,18 +413,15 @@ let type_declarations ?(equality = false) ~loc env ~mark name
       (_, Type_abstract) -> None
     | (Type_variant cstrs1, Type_variant cstrs2) ->
         if mark then begin
-          let mark usage name cstrs =
-            List.iter
-              (fun cstr ->
-                 Env.mark_constructor_used usage name cstr)
-              cstrs
+          let mark usage cstrs =
+            List.iter (Env.mark_constructor_used usage) cstrs
           in
           let usage =
             if decl2.type_private = Public then Env.Positive
             else Env.Privatize
           in
-          mark usage name cstrs1;
-          if equality then mark Env.Positive (Path.name path) cstrs2
+          mark usage cstrs1;
+          if equality then mark Env.Positive cstrs2
         end;
         Option.map
           (fun var_err -> Variant_mismatch var_err)
@@ -478,7 +475,7 @@ let extension_constructors ~loc env ~mark id ext1 ext2 =
       if ext2.ext_private = Public then Env.Positive
       else Env.Privatize
     in
-    Env.mark_extension_used usage (Ident.name id) ext1
+    Env.mark_extension_used usage ext1
   end;
   let ty1 =
     Btype.newgenty (Tconstr(ext1.ext_type_path, ext1.ext_type_params, ref Mnil))
diff --git a/typing/includemod.ml b/typing/includemod.ml
index d92b0fe090..9c4b94f628 100644
--- a/typing/includemod.ml
+++ b/typing/includemod.ml
@@ -75,7 +75,7 @@ let mark_positive = function
 let value_descriptions ~loc env ~mark cxt subst id vd1 vd2 =
   Cmt_format.record_value_dependency vd1 vd2;
   if mark_positive mark then
-    Env.mark_value_used (Ident.name id) vd1;
+    Env.mark_value_used vd1.val_uid;
   let vd2 = Subst.value_description subst vd2 in
   try
     Includecore.value_descriptions ~loc env (Ident.name id) vd1 vd2
@@ -87,7 +87,7 @@ let value_descriptions ~loc env ~mark cxt subst id vd1 vd2 =
 let type_declarations ~loc env ~mark ?old_env:_ cxt subst id decl1 decl2 =
   let mark = mark_positive mark in
   if mark then
-    Env.mark_type_used (Ident.name id) decl1;
+    Env.mark_type_used decl1.type_uid;
   let decl2 = Subst.type_declaration subst decl2 in
   match
     Includecore.type_declarations ~loc env ~mark
@@ -501,7 +501,7 @@ and module_declarations ~loc env ~mark cxt subst id1 md1 md2 =
     (Ident.name id1);
   let p1 = Path.Pident id1 in
   if mark_positive mark then
-    Env.mark_module_used (Ident.name id1) md1.md_loc;
+    Env.mark_module_used md1.md_uid;
   modtypes ~loc env ~mark (Module id1::cxt) subst
     (Mtype.strengthen ~aliasable:true env md1.md_type p1) md2.md_type
 
diff --git a/typing/mtype.ml b/typing/mtype.ml
index 38894e13ce..e36fd4f9e6 100644
--- a/typing/mtype.ml
+++ b/typing/mtype.ml
@@ -213,7 +213,7 @@ and nondep_sig_item env va ids = function
       with Ctype.Nondep_cannot_erase _ as exn ->
         match va with
           Co -> Sig_modtype(id, {mtd_type=None; mtd_loc=Location.none;
-                                 mtd_attributes=[]}, vis)
+                                 mtd_attributes=[]; mtd_uid = d.mtd_uid}, vis)
         | _  -> raise exn
       end
   | Sig_class(id, d, rs, vis) ->
diff --git a/typing/predef.ml b/typing/predef.ml
index 5399656d54..9cbd889e06 100644
--- a/typing/predef.ml
+++ b/typing/predef.ml
@@ -116,23 +116,6 @@ let path_match_failure = Pident ident_match_failure
 and path_assert_failure = Pident ident_assert_failure
 and path_undefined_recursive_module = Pident ident_undefined_recursive_module
 
-let decl_abstr =
-  {type_params = [];
-   type_arity = 0;
-   type_kind = Type_abstract;
-   type_loc = Location.none;
-   type_private = Asttypes.Public;
-   type_manifest = None;
-   type_variance = [];
-   type_is_newtype = false;
-   type_expansion_scope = lowest_level;
-   type_attributes = [];
-   type_immediate = false;
-   type_unboxed = unboxed_false_default_false;
-  }
-
-let decl_abstr_imm = {decl_abstr with type_immediate = true}
-
 let cstr id args =
   {
     cd_id = id;
@@ -140,6 +123,7 @@ let cstr id args =
     cd_res = None;
     cd_loc = Location.none;
     cd_attributes = [];
+    cd_uid = Uid.of_predef_id id;
   }
 
 let ident_false = ident_create "false"
@@ -149,47 +133,49 @@ and ident_nil = ident_create "[]"
 and ident_cons = ident_create "::"
 and ident_none = ident_create "None"
 and ident_some = ident_create "Some"
-let common_initial_env add_type add_extension empty_env =
-  let decl_bool =
-    {decl_abstr with
-     type_kind = Type_variant([cstr ident_false []; cstr ident_true []]);
-     type_immediate = true}
-  and decl_unit =
-    {decl_abstr with
-     type_kind = Type_variant([cstr ident_void []]);
-     type_immediate = true}
-  and decl_exn =
-    {decl_abstr with
-     type_kind = Type_open}
-  and decl_array =
-    let tvar = newgenvar() in
-    {decl_abstr with
-     type_params = [tvar];
-     type_arity = 1;
-     type_variance = [Variance.full]}
-  and decl_list =
-    let tvar = newgenvar() in
-    {decl_abstr with
-     type_params = [tvar];
-     type_arity = 1;
-     type_kind =
-     Type_variant([cstr ident_nil []; cstr ident_cons [tvar; type_list tvar]]);
-     type_variance = [Variance.covariant]}
-  and decl_option =
-    let tvar = newgenvar() in
-    {decl_abstr with
-     type_params = [tvar];
-     type_arity = 1;
-     type_kind = Type_variant([cstr ident_none []; cstr ident_some [tvar]]);
-     type_variance = [Variance.covariant]}
-  and decl_lazy_t =
-    let tvar = newgenvar() in
-    {decl_abstr with
-     type_params = [tvar];
-     type_arity = 1;
-     type_variance = [Variance.covariant]}
+
+let mk_add_type add_type type_ident
+      ?manifest ?(immediate=false) ?(kind=Type_abstract) env =
+  let decl =
+    {type_params = [];
+     type_arity = 0;
+     type_kind = kind;
+     type_loc = Location.none;
+     type_private = Asttypes.Public;
+     type_manifest = manifest;
+     type_variance = [];
+     type_is_newtype = false;
+     type_expansion_scope = lowest_level;
+     type_attributes = [];
+     type_immediate = immediate;
+     type_unboxed = unboxed_false_default_false;
+     type_uid = Uid.of_predef_id type_ident;
+    }
   in
+  add_type type_ident decl env
 
+let common_initial_env add_type add_extension empty_env =
+  let add_type = mk_add_type add_type
+  and add_type1 type_ident ~variance ?(kind=fun _ -> Type_abstract) env =
+    let param = newgenvar () in
+    let decl =
+      {type_params = [param];
+       type_arity = 1;
+       type_kind = kind param;
+       type_loc = Location.none;
+       type_private = Asttypes.Public;
+       type_manifest = None;
+       type_variance = [variance];
+       type_is_newtype = false;
+       type_expansion_scope = lowest_level;
+       type_attributes = [];
+       type_immediate = false;
+       type_unboxed = unboxed_false_default_false;
+       type_uid = Uid.of_predef_id type_ident;
+      }
+    in
+    add_type type_ident decl env
+  in
   let add_extension id l =
     add_extension id
       { ext_type_path = path_exn;
@@ -200,7 +186,9 @@ let common_initial_env add_type add_extension empty_env =
         ext_loc = Location.none;
         ext_attributes = [Ast_helper.Attr.mk
                             (Location.mknoloc "ocaml.warn_on_literal_pattern")
-                            (Parsetree.PStr [])] }
+                            (Parsetree.PStr [])];
+        ext_uid = Uid.of_predef_id id;
+      }
   in
   add_extension ident_match_failure
                          [newgenty (Ttuple[type_string; type_int; type_int])] (
@@ -217,29 +205,37 @@ let common_initial_env add_type add_extension empty_env =
                          [newgenty (Ttuple[type_string; type_int; type_int])] (
   add_extension ident_undefined_recursive_module
                          [newgenty (Ttuple[type_string; type_int; type_int])] (
-  add_type ident_int64 decl_abstr (
-  add_type ident_int32 decl_abstr (
-  add_type ident_nativeint decl_abstr (
-  add_type ident_lazy_t decl_lazy_t (
-  add_type ident_option decl_option (
-  add_type ident_list decl_list (
-  add_type ident_array decl_array (
-  add_type ident_exn decl_exn (
-  add_type ident_unit decl_unit (
-  add_type ident_bool decl_bool (
-  add_type ident_float decl_abstr (
-  add_type ident_string decl_abstr (
-  add_type ident_char decl_abstr_imm (
-  add_type ident_int decl_abstr_imm (
-  add_type ident_extension_constructor decl_abstr (
-  add_type ident_floatarray decl_abstr (
+  add_type ident_int64 (
+  add_type ident_int32 (
+  add_type ident_nativeint (
+  add_type1 ident_lazy_t ~variance:Variance.covariant (
+  add_type1 ident_option ~variance:Variance.covariant
+    ~kind:(fun tvar ->
+      Type_variant([cstr ident_none []; cstr ident_some [tvar]])
+    ) (
+  add_type1 ident_list ~variance:Variance.covariant
+    ~kind:(fun tvar ->
+      Type_variant([cstr ident_nil []; cstr ident_cons [tvar; type_list tvar]])
+    ) (
+  add_type1 ident_array ~variance:Variance.full (
+  add_type ident_exn ~kind:Type_open (
+  add_type ident_unit ~immediate:true
+    ~kind:(Type_variant([cstr ident_void []])) (
+  add_type ident_bool ~immediate:true
+    ~kind:(Type_variant([cstr ident_false []; cstr ident_true []])) (
+  add_type ident_float (
+  add_type ident_string (
+  add_type ident_char ~immediate:true (
+  add_type ident_int ~immediate:true (
+  add_type ident_extension_constructor (
+  add_type ident_floatarray (
     empty_env))))))))))))))))))))))))))))
 
 let build_initial_env add_type add_exception empty_env =
   let common = common_initial_env add_type add_exception empty_env in
-  let safe_string = add_type ident_bytes decl_abstr common in
-  let decl_bytes_unsafe = {decl_abstr with type_manifest = Some type_string} in
-  let unsafe_string = add_type ident_bytes decl_bytes_unsafe common in
+  let add_type = mk_add_type add_type in
+  let safe_string = add_type ident_bytes common in
+  let unsafe_string = add_type ident_bytes ~manifest:type_string common in
   (safe_string, unsafe_string)
 
 let builtin_values =
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index c39f04d3ce..941e78f62d 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -1572,6 +1572,7 @@ let dummy =
     type_attributes = [];
     type_immediate = false;
     type_unboxed = unboxed_false_default_false;
+    type_uid = Uid.internal_not_actually_unique;
   }
 
 let hide ids env = List.fold_right
diff --git a/typing/subst.ml b/typing/subst.ml
index 5ae3d1b4b6..576dd7cce3 100644
--- a/typing/subst.ml
+++ b/typing/subst.ml
@@ -263,6 +263,7 @@ let label_declaration copy_scope s l =
     ld_type = typexp copy_scope s l.ld_type;
     ld_loc = loc s l.ld_loc;
     ld_attributes = attrs s l.ld_attributes;
+    ld_uid = l.ld_uid;
   }
 
 let constructor_arguments copy_scope s = function
@@ -278,6 +279,7 @@ let constructor_declaration copy_scope s c =
     cd_res = Option.map (typexp copy_scope s) c.cd_res;
     cd_loc = loc s c.cd_loc;
     cd_attributes = attrs s c.cd_attributes;
+    cd_uid = c.cd_uid;
   }
 
 let type_declaration' copy_scope s decl =
@@ -306,6 +308,7 @@ let type_declaration' copy_scope s decl =
     type_attributes = attrs s decl.type_attributes;
     type_immediate = decl.type_immediate;
     type_unboxed = decl.type_unboxed;
+    type_uid = decl.type_uid;
   }
 
 let type_declaration s decl =
@@ -346,6 +349,7 @@ let class_declaration' copy_scope s decl =
       end;
     cty_loc = loc s decl.cty_loc;
     cty_attributes = attrs s decl.cty_attributes;
+    cty_uid = decl.cty_uid;
   }
 
 let class_declaration s decl =
@@ -358,6 +362,7 @@ let cltype_declaration' copy_scope s decl =
     clty_path = type_path s decl.clty_path;
     clty_loc = loc s decl.clty_loc;
     clty_attributes = attrs s decl.clty_attributes;
+    clty_uid = decl.clty_uid;
   }
 
 let cltype_declaration s decl =
@@ -371,6 +376,7 @@ let value_description' copy_scope s descr =
     val_kind = descr.val_kind;
     val_loc = loc s descr.val_loc;
     val_attributes = attrs s descr.val_attributes;
+    val_uid = descr.val_uid;
    }
 
 let value_description s descr =
@@ -383,7 +389,9 @@ let extension_constructor' copy_scope s ext =
     ext_ret_type = Option.map (typexp copy_scope s) ext.ext_ret_type;
     ext_private = ext.ext_private;
     ext_attributes = attrs s ext.ext_attributes;
-    ext_loc = if s.for_saving then Location.none else ext.ext_loc; }
+    ext_loc = if s.for_saving then Location.none else ext.ext_loc;
+    ext_uid = ext.ext_uid;
+  }
 
 let extension_constructor s ext =
   For_copy.with_scope
@@ -505,6 +513,7 @@ and module_declaration scoping s decl =
     md_type = modtype scoping s decl.md_type;
     md_attributes = attrs s decl.md_attributes;
     md_loc = loc s decl.md_loc;
+    md_uid = decl.md_uid;
   }
 
 and modtype_declaration scoping s decl  =
@@ -512,6 +521,7 @@ and modtype_declaration scoping s decl  =
     mtd_type = Option.map (modtype scoping s) decl.mtd_type;
     mtd_attributes = attrs s decl.mtd_attributes;
     mtd_loc = loc s decl.mtd_loc;
+    mtd_uid = decl.mtd_uid;
   }
 
 
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 3e39991ce7..0c1038b390 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -263,7 +263,8 @@ let enter_met_env ?check loc lab kind unbound_kind ty val_env met_env par_env =
   let (id, met_env) =
     Env.enter_value ?check lab
       {val_type = ty; val_kind = kind;
-       val_attributes = []; Types.val_loc = loc} met_env
+       val_attributes = []; Types.val_loc = loc;
+       val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()); } met_env
   in
   (id, val_env, met_env, par_env)
 
@@ -1194,6 +1195,7 @@ and class_expr_aux cl_num val_env met_env scl =
                                                                cl_num);
                 val_attributes = [];
                 Types.val_loc = vd.Types.val_loc;
+                val_uid = vd.val_uid;
                }
              in
              let id' = Ident.create_local (Ident.name id) in
@@ -1286,7 +1288,7 @@ let rec approx_description ct =
 
 (*******************************)
 
-let temp_abbrev loc env id arity =
+let temp_abbrev loc env id arity uid =
   let params = ref [] in
   for _i = 1 to arity do
     params := Ctype.newvar () :: !params
@@ -1306,17 +1308,18 @@ let temp_abbrev loc env id arity =
        type_attributes = []; (* or keep attrs from the class decl? *)
        type_immediate = false;
        type_unboxed = unboxed_false_default_false;
+       type_uid = uid;
       }
       env
   in
   (!params, ty, env)
 
 let initial_env define_class approx
-    (res, env) (cl, id, ty_id, obj_id, cl_id) =
+    (res, env) (cl, id, ty_id, obj_id, cl_id, uid) =
   (* Temporary abbreviations *)
   let arity = List.length cl.pci_params in
-  let (obj_params, obj_ty, env) = temp_abbrev cl.pci_loc env obj_id arity in
-  let (cl_params, cl_ty, env) = temp_abbrev cl.pci_loc env cl_id arity in
+  let (obj_params, obj_ty, env) = temp_abbrev cl.pci_loc env obj_id arity uid in
+  let (cl_params, cl_ty, env) = temp_abbrev cl.pci_loc env cl_id arity uid in
 
   (* Temporary type for the class constructor *)
   let constr_type = approx cl.pci_expr in
@@ -1340,6 +1343,7 @@ let initial_env define_class approx
        end;
      cty_loc = Location.none;
      cty_attributes = [];
+     cty_uid = uid;
     }
   in
   let env =
@@ -1350,6 +1354,7 @@ let initial_env define_class approx
        clty_path = unbound_class;
        clty_loc = Location.none;
        clty_attributes = [];
+       clty_uid = uid;
       }
       (
         if define_class then
@@ -1480,6 +1485,7 @@ let class_infos define_class kind
      clty_path = Path.Pident obj_id;
      clty_loc = cl.pci_loc;
      clty_attributes = cl.pci_attributes;
+     clty_uid = dummy_class.cty_uid;
     }
   and clty =
     {cty_params = params; cty_type = typ;
@@ -1492,6 +1498,7 @@ let class_infos define_class kind
        end;
      cty_loc = cl.pci_loc;
      cty_attributes = cl.pci_attributes;
+     cty_uid = dummy_class.cty_uid;
     }
   in
   dummy_class.cty_type <- typ;
@@ -1529,6 +1536,7 @@ let class_infos define_class kind
      clty_path = Path.Pident obj_id;
      clty_loc = cl.pci_loc;
      clty_attributes = cl.pci_attributes;
+     clty_uid = dummy_class.cty_uid;
     }
   and clty =
     {cty_params = params'; cty_type = typ';
@@ -1541,6 +1549,7 @@ let class_infos define_class kind
        end;
      cty_loc = cl.pci_loc;
      cty_attributes = cl.pci_attributes;
+     cty_uid = dummy_class.cty_uid;
     }
   in
   let obj_abbr =
@@ -1556,6 +1565,7 @@ let class_infos define_class kind
      type_attributes = []; (* or keep attrs from cl? *)
      type_immediate = false;
      type_unboxed = unboxed_false_default_false;
+     type_uid = dummy_class.cty_uid;
     }
   in
   let (cl_params, cl_ty) =
@@ -1576,6 +1586,7 @@ let class_infos define_class kind
      type_attributes = []; (* or keep attrs from cl? *)
      type_immediate = false;
      type_unboxed = unboxed_false_default_false;
+     type_uid = dummy_class.cty_uid;
     }
   in
   ((cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr, ci_params,
@@ -1732,7 +1743,9 @@ let type_classes define_class approx kind env cls =
           Ident.create_scoped ~scope cl.pci_name.txt,
           Ident.create_scoped ~scope cl.pci_name.txt,
           Ident.create_scoped ~scope cl.pci_name.txt,
-          Ident.create_scoped ~scope ("#" ^ cl.pci_name.txt)))
+          Ident.create_scoped ~scope ("#" ^ cl.pci_name.txt),
+          Uid.mk ~current_unit:(Env.get_unit_name ())
+         ))
       cls
   in
   Ctype.begin_class_def ();
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 6106db8b2f..b1780491de 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -1547,6 +1547,7 @@ let add_pattern_variables ?check ?check_as env pv =
        Env.add_value ?check pv_id
          {val_type = pv_type; val_kind = Val_reg; Types.val_loc = pv_loc;
           val_attributes = pv_attributes;
+          val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
          } env
     )
     pv env
@@ -1570,7 +1571,11 @@ let type_pattern_list no_existentials env spatl scope expected_tys allow =
   in
   let patl = List.map2 type_pat spatl expected_tys in
   let pvs = get_ref pattern_variables in
-  let unpacks = get_ref module_variables in
+  let unpacks =
+    List.map (fun (name, loc) ->
+      name, loc, Uid.mk ~current_unit:(Env.get_unit_name ())
+    ) (get_ref module_variables)
+  in
   let new_env = add_pattern_variables !new_env pvs in
   (patl, new_env, get_ref pattern_force, pvs, unpacks)
 
@@ -1584,23 +1589,38 @@ let type_class_arg_pattern cl_num val_env met_env l spat =
   end;
   List.iter (fun f -> f()) (get_ref pattern_force);
   if is_optional l then unify_pat val_env pat (type_option (newvar ()));
-  let (pv, met_env) =
+  let (pv, val_env, met_env) =
     List.fold_right
-      (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes} (pv, env) ->
+      (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes}
+        (pv, val_env, met_env) ->
          let check s =
            if pv_as_var then Warnings.Unused_var s
            else Warnings.Unused_var_strict s in
-         let id' = Ident.create_local (Ident.name pv_id) in
-         ((id', pv_id, pv_type)::pv,
-          Env.add_value id' {val_type = pv_type;
-                             val_kind = Val_ivar (Immutable, cl_num);
-                             val_attributes = pv_attributes;
-                             Types.val_loc = pv_loc;
-                            } ~check
-            env))
-      !pattern_variables ([], met_env)
+         let id' = Ident.rename pv_id in
+         let val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
+         let val_env =
+          Env.add_value pv_id
+            { val_type = pv_type
+            ; val_kind = Val_reg
+            ; val_attributes = pv_attributes
+            ; val_loc = pv_loc
+            ; val_uid
+            }
+            val_env
+         in
+         let met_env =
+          Env.add_value id' ~check
+            { val_type = pv_type
+            ; val_kind = Val_ivar (Immutable, cl_num)
+            ; val_attributes = pv_attributes
+            ; val_loc = pv_loc
+            ; val_uid
+            }
+            met_env
+         in
+         ((id', pv_id, pv_type)::pv, val_env, met_env))
+      !pattern_variables ([], val_env, met_env)
   in
-  let val_env = add_pattern_variables val_env (get_ref pattern_variables) in
   (pat, pv, val_env, met_env)
 
 let type_self_pattern cl_num privty val_env met_env par_env spat =
@@ -1623,12 +1643,13 @@ let type_self_pattern cl_num privty val_env met_env par_env spat =
            (val_env, met_env, par_env) ->
          let name = Ident.name pv_id in
          (Env.enter_unbound_value name Val_unbound_self val_env,
-          Env.add_value pv_id {val_type = pv_type;
-                               val_kind =
-                                 Val_self (meths, vars, cl_num, privty);
-                               val_attributes = pv_attributes;
-                               Types.val_loc = pv_loc;
-                              }
+          Env.add_value pv_id
+            {val_type = pv_type;
+             val_kind = Val_self (meths, vars, cl_num, privty);
+             val_attributes = pv_attributes;
+             val_loc = pv_loc;
+             val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+            }
             ~check:(fun s -> if pv_as_var then Warnings.Unused_var s
                              else Warnings.Unused_var_strict s)
             met_env,
@@ -2008,20 +2029,6 @@ let create_package_type loc env (p, l) =
   in
    (s, fields, ty)
 
- let wrap_unpacks sexp unpacks =
-   let open Ast_helper in
-   List.fold_left
-     (fun sexp (name, loc) ->
-        Exp.letmodule ~loc:{ sexp.pexp_loc with loc_ghost = true }
-         ~attrs:[Attr.mk (mknoloc "#modulepat") (PStr [])]
-         { name with txt = Some name.txt }
-         (Mod.unpack ~loc
-            (Exp.ident ~loc:name.loc (mkloc (Longident.Lident name.txt)
-                                            name.loc)))
-         sexp
-     )
-    sexp unpacks
-
 (* Helpers for type_cases *)
 
 let contains_variant_either ty =
@@ -2278,9 +2285,7 @@ and type_expect_
       in
       let (pat_exp_list, new_env, unpacks) =
         type_let existential_context env rec_flag spat_sexp_list scp true in
-      let body =
-        type_expect new_env (wrap_unpacks sbody unpacks)
-          ty_expected_explained in
+      let body = type_unpacks new_env unpacks sbody ty_expected_explained in
       let () =
         if rec_flag = Recursive then
           check_recursive_bindings env pat_exp_list
@@ -2675,9 +2680,13 @@ and type_expect_
         match param.ppat_desc with
         | Ppat_any -> Ident.create_local "_for", env
         | Ppat_var {txt} ->
-            Env.enter_value txt {val_type = instance Predef.type_int;
-                                 val_attributes = [];
-                                 val_kind = Val_reg; Types.val_loc = loc; } env
+            Env.enter_value txt
+              {val_type = instance Predef.type_int;
+               val_attributes = [];
+               val_kind = Val_reg;
+               val_loc = loc;
+               val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+              } env
               ~check:(fun s -> Warnings.Unused_for_index s)
         | _ ->
             raise (Error (param.ppat_loc, env, Invalid_for_loop_index))
@@ -2832,7 +2841,9 @@ and type_expect_
                     {val_type = method_type;
                      val_kind = Val_reg;
                      val_attributes = [];
-                     Types.val_loc = Location.none}
+                     val_loc = Location.none;
+                     val_uid = Uid.internal_not_actually_unique;
+                    }
                   in
                   let exp_env = Env.add_value method_id method_desc env in
                   let exp =
@@ -2997,7 +3008,8 @@ and type_expect_
       in
       let scope = create_scope () in
       let md =
-        { md_type = modl.mod_type; md_attributes = []; md_loc = name.loc }
+        { md_type = modl.mod_type; md_attributes = []; md_loc = name.loc;
+          md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()); }
       in
       let (id, new_env) =
         match name.txt with
@@ -3136,6 +3148,7 @@ and type_expect_
         type_attributes = [];
         type_immediate = false;
         type_unboxed = unboxed_false_default_false;
+        type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
       }
       in
       let scope = create_scope () in
@@ -3765,7 +3778,9 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
         let desc =
           { val_type = ty; val_kind = Val_reg;
             val_attributes = [];
-            Types.val_loc = Location.none}
+            val_loc = Location.none;
+            val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+          }
         in
         let exp_env = Env.add_value id desc env in
         {pat_desc = Tpat_var (id, mknoloc name); pat_type = ty;pat_extra=[];
@@ -4113,6 +4128,59 @@ and type_statement ?explanation env sexp =
     exp
   end
 
+and type_unpacks ?in_function env unpacks sbody expected_ty =
+  let ty = newvar() in
+  (* remember original level *)
+  let extended_env, tunpacks =
+    List.fold_left (fun (env, unpacks) (name, loc, uid) ->
+      begin_def ();
+      let context = Typetexp.narrow () in
+      let modl =
+        !type_module env
+          Ast_helper.(
+            Mod.unpack ~loc
+              (Exp.ident ~loc:name.loc (mkloc (Longident.Lident name.txt)
+                                          name.loc)))
+      in
+      Mtype.lower_nongen ty.level modl.mod_type;
+      let pres =
+        match modl.mod_type with
+        | Mty_alias _ -> Mp_absent
+        | _ -> Mp_present
+      in
+      let scope = create_scope () in
+      let md =
+        { md_type = modl.mod_type; md_attributes = []; md_loc = name.loc;
+          md_uid = uid; }
+      in
+      let (id, env) =
+        Env.enter_module_declaration ~scope name.txt pres md env
+      in
+      Typetexp.widen context;
+      env, (id, name, pres, modl) :: unpacks
+    ) (env, []) unpacks
+  in
+  (* ideally, we should catch Expr_type_clash errors
+     in type_expect triggered by escaping identifiers from the local module
+     and refine them into Scoping_let_module errors
+  *)
+  let body = type_expect ?in_function extended_env sbody expected_ty in
+  let exp_loc = { body.exp_loc with loc_ghost = true } in
+  let exp_attributes = [Ast_helper.Attr.mk (mknoloc "#modulepat") (PStr [])] in
+  List.fold_left (fun body (id, name, pres, modl) ->
+    (* go back to parent level *)
+    end_def ();
+    Ctype.unify_var extended_env ty body.exp_type;
+    re {
+      exp_desc = Texp_letmodule(Some id, { name with txt = Some name.txt },
+                                pres, modl, body);
+      exp_loc;
+      exp_attributes;
+      exp_extra = [];
+      exp_type = ty;
+      exp_env = env }
+  ) body tunpacks
+
 (* Typing of match cases *)
 and type_cases ?exception_allowed ?in_function env ty_arg ty_res partial_flag
       loc caselist =
@@ -4238,7 +4306,11 @@ and type_cases ?exception_allowed ?in_function env ty_arg ty_res partial_flag
             ~check:(fun s -> Warnings.Unused_var_strict s)
             ~check_as:(fun s -> Warnings.Unused_var s)
         in
-        let sexp = wrap_unpacks pc_rhs unpacks in
+        let unpacks =
+          List.map (fun (name, loc) ->
+            name, loc, Uid.mk ~current_unit:(Env.get_unit_name ())
+          ) unpacks
+        in
         let ty_res' =
           if !Clflags.principal then begin
             begin_def ();
@@ -4260,11 +4332,12 @@ and type_cases ?exception_allowed ?in_function env ty_arg ty_res partial_flag
           | None -> None
           | Some scond ->
               Some
-                (type_expect ext_env (wrap_unpacks scond unpacks)
+                (type_unpacks ext_env unpacks scond
                    (mk_expected ~explanation:When_guard Predef.type_bool))
         in
         let exp =
-          type_expect ?in_function ext_env sexp (mk_expected ty_res') in
+          type_unpacks ?in_function ext_env unpacks pc_rhs (mk_expected ty_res')
+        in
         {
          c_lhs = pat;
          c_guard = guard;
@@ -4467,15 +4540,13 @@ and type_let
                              ((if !some_used then check_strict else check) name)
                       );
                   Env.set_value_used_callback
-                    name vd
+                    vd
                     (fun () ->
                        match !current_slot with
                        | Some slot ->
-                         slot := (name, vd) :: !slot; rec_needed := true
+                         slot := vd.val_uid :: !slot; rec_needed := true
                        | None ->
-                         List.iter
-                           (fun (name, vd) -> Env.mark_value_used name vd)
-                           (get_ref slot);
+                         List.iter Env.mark_value_used (get_ref slot);
                          used := true;
                          some_used := true
                     )
@@ -4489,8 +4560,6 @@ and type_let
   let exp_list =
     List.map2
       (fun {pvb_expr=sexp; pvb_attributes; _} (pat, slot) ->
-        let sexp =
-          if rec_flag = Recursive then wrap_unpacks sexp unpacks else sexp in
         if is_recursive then current_slot := slot;
         match pat.pat_type.desc with
         | Tpoly (ty, tl) ->
@@ -4502,15 +4571,22 @@ and type_let
               generalize_structure ty'
             end;
             let exp =
-              Builtin_attributes.warning_scope pvb_attributes
-                  (fun () -> type_expect exp_env sexp (mk_expected ty'))
+              Builtin_attributes.warning_scope pvb_attributes (fun () ->
+                if rec_flag = Recursive then
+                  type_unpacks exp_env unpacks sexp (mk_expected ty')
+                else
+                  type_expect exp_env sexp (mk_expected ty')
+              )
             in
             end_def ();
             check_univars env true "definition" exp pat.pat_type vars;
             {exp with exp_type = instance exp.exp_type}
         | _ ->
             Builtin_attributes.warning_scope pvb_attributes (fun () ->
-              type_expect exp_env sexp (mk_expected pat.pat_type)))
+                if rec_flag = Recursive then
+                  type_unpacks exp_env unpacks sexp (mk_expected pat.pat_type)
+                else
+                  type_expect exp_env sexp (mk_expected pat.pat_type)))
       spat_sexp_list pat_slot_list in
   current_slot := None;
   if is_recursive && not !rec_needed then begin
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index 4ad1fb6e84..50fa078b84 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -84,7 +84,7 @@ let add_type ~check id decl env =
   Builtin_attributes.warning_scope ~ppwarning:false decl.type_attributes
     (fun () -> Env.add_type ~check id decl env)
 
-let enter_type rec_flag env sdecl id =
+let enter_type rec_flag env sdecl (id, uid) =
   let needed =
     match rec_flag with
     | Asttypes.Nonrecursive ->
@@ -115,6 +115,7 @@ let enter_type rec_flag env sdecl id =
       type_attributes = sdecl.ptype_attributes;
       type_immediate = false;
       type_unboxed = unboxed_false_default_false;
+      type_uid = uid;
     }
   in
   add_type ~check:true id decl env
@@ -220,7 +221,8 @@ let transl_labels env closed lbls =
           ld_mutable = ld.ld_mutable;
           ld_type = ty;
           ld_loc = ld.ld_loc;
-          ld_attributes = ld.ld_attributes
+          ld_attributes = ld.ld_attributes;
+          ld_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
          }
       )
       lbls in
@@ -339,7 +341,7 @@ let rec check_unboxed_gadt_arg loc univ env ty =
          in the same recursive definition. In this case we don't have to
          check because we will also check that other type for correctness. *)
 
-let transl_declaration env sdecl id =
+let transl_declaration env sdecl (id, uid) =
   (* Bind type parameters *)
   reset_type_variables();
   Ctype.begin_def ();
@@ -454,7 +456,8 @@ let transl_declaration env sdecl id =
               cd_args = args;
               cd_res = ret_type;
               cd_loc = scstr.pcd_loc;
-              cd_attributes = scstr.pcd_attributes }
+              cd_attributes = scstr.pcd_attributes;
+              cd_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) }
           in
             tcstr, cstr
         in
@@ -495,6 +498,7 @@ let transl_declaration env sdecl id =
         type_attributes = sdecl.ptype_attributes;
         type_immediate = false;
         type_unboxed = unboxed_status;
+        type_uid = uid;
       } in
 
   (* Check constraints *)
@@ -905,38 +909,38 @@ let transl_type_decl env rec_flag sdecl_list =
 
   (* Create identifiers. *)
   let scope = Ctype.create_scope () in
-  let id_list =
-    List.map (fun sdecl -> Ident.create_scoped ~scope sdecl.ptype_name.txt)
-      sdecl_list
+  let ids_list =
+    List.map (fun sdecl ->
+      Ident.create_scoped ~scope sdecl.ptype_name.txt,
+      Uid.mk ~current_unit:(Env.get_unit_name ())
+    ) sdecl_list
   in
   Ctype.begin_def();
   (* Enter types. *)
   let temp_env =
-    List.fold_left2 (enter_type rec_flag) env sdecl_list id_list in
+    List.fold_left2 (enter_type rec_flag) env sdecl_list ids_list in
   (* Translate each declaration. *)
   let current_slot = ref None in
   let warn_unused = Warnings.is_active (Warnings.Unused_type_declaration "") in
-  let id_slots id =
+  let ids_slots (id, _uid as ids) =
     match rec_flag with
     | Asttypes.Recursive when warn_unused ->
         (* See typecore.ml for a description of the algorithm used
              to detect unused declarations in a set of recursive definitions. *)
         let slot = ref [] in
         let td = Env.find_type (Path.Pident id) temp_env in
-        let name = Ident.name id in
         Env.set_type_used_callback
-          name td
+          td
           (fun old_callback ->
              match !current_slot with
-             | Some slot -> slot := (name, td) :: !slot
+             | Some slot -> slot := td.type_uid :: !slot
              | None ->
-                 List.iter (fun (name, d) -> Env.mark_type_used name d)
-                   (get_ref slot);
+                 List.iter Env.mark_type_used (get_ref slot);
                  old_callback ()
           );
-        id, Some slot
+        ids, Some slot
     | Asttypes.Recursive | Asttypes.Nonrecursive ->
-        id, None
+        ids, None
   in
   let transl_declaration name_sdecl (id, slot) =
     current_slot := slot;
@@ -945,7 +949,7 @@ let transl_type_decl env rec_flag sdecl_list =
       (fun () -> transl_declaration temp_env name_sdecl id)
   in
   let tdecls =
-    List.map2 transl_declaration sdecl_list (List.map id_slots id_list) in
+    List.map2 transl_declaration sdecl_list (List.map ids_slots ids_list) in
   let decls =
     List.map (fun tdecl -> (tdecl.typ_id, tdecl.typ_type)) tdecls in
   current_slot := None;
@@ -958,16 +962,16 @@ let transl_type_decl env rec_flag sdecl_list =
     | Asttypes.Nonrecursive -> ()
     | Asttypes.Recursive ->
       List.iter2
-        (fun id sdecl -> update_type temp_env new_env id sdecl.ptype_loc)
-        id_list sdecl_list
+        (fun (id, _) sdecl -> update_type temp_env new_env id sdecl.ptype_loc)
+        ids_list sdecl_list
   end;
   (* Generalize type declarations. *)
   Ctype.end_def();
   List.iter (fun (_, decl) -> generalize_decl decl) decls;
   (* Check for ill-formed abbrevs *)
   let id_loc_list =
-    List.map2 (fun id sdecl -> (id, sdecl.ptype_loc))
-      id_list sdecl_list
+    List.map2 (fun (id, _) sdecl -> (id, sdecl.ptype_loc))
+      ids_list sdecl_list
   in
   List.iter (fun (id, decl) ->
     check_well_founded_manifest new_env (List.assoc id id_loc_list)
@@ -1121,7 +1125,9 @@ let transl_extension_constructor env type_path type_params
       ext_ret_type = ret_type;
       ext_private = priv;
       Types.ext_loc = sext.pext_loc;
-      Types.ext_attributes = sext.pext_attributes; }
+      Types.ext_attributes = sext.pext_attributes;
+      ext_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+    }
   in
     { ext_id = id;
       ext_name = sext.pext_name;
@@ -1385,7 +1391,9 @@ let transl_value_decl env loc valdecl =
   match valdecl.pval_prim with
     [] when Env.is_in_signature env ->
       { val_type = ty; val_kind = Val_reg; Types.val_loc = loc;
-        val_attributes = valdecl.pval_attributes }
+        val_attributes = valdecl.pval_attributes;
+        val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+      }
   | [] ->
       raise (Error(valdecl.pval_loc, Val_in_structure))
   | _ ->
@@ -1413,7 +1421,9 @@ let transl_value_decl env loc valdecl =
       then raise(Error(valdecl.pval_type.ptyp_loc, Missing_native_external));
       check_unboxable env loc ty;
       { val_type = ty; val_kind = Val_prim prim; Types.val_loc = loc;
-        val_attributes = valdecl.pval_attributes }
+        val_attributes = valdecl.pval_attributes;
+        val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+      }
   in
   let (id, newenv) =
     Env.enter_value valdecl.pval_name.txt v env
@@ -1438,7 +1448,7 @@ let transl_value_decl env loc valdecl =
 (* Translate a "with" constraint -- much simplified version of
     transl_type_decl. *)
 let transl_with_constraint env id row_path orig_decl sdecl =
-  Env.mark_type_used (Ident.name id) orig_decl;
+  Env.mark_type_used orig_decl.type_uid;
   reset_type_variables();
   Ctype.begin_def();
   let tparams = make_params env sdecl.ptype_params in
@@ -1494,6 +1504,7 @@ let transl_with_constraint env id row_path orig_decl sdecl =
       type_attributes = sdecl.ptype_attributes;
       type_immediate = false;
       type_unboxed;
+      type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
     }
   in
   begin match row_path with None -> ()
@@ -1546,6 +1557,7 @@ let abstract_type_decl arity =
       type_attributes = [];
       type_immediate = false;
       type_unboxed = unboxed_false_default_false;
+      type_uid = Uid.internal_not_actually_unique;
      } in
   Ctype.end_def();
   generalize_decl decl;
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index 674512210a..af9b324fdf 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -22,7 +22,6 @@
 *)
 
 open Asttypes
-open Types
 
 (* Value expressions for the core language *)
 
@@ -39,7 +38,7 @@ type pattern =
   { pat_desc: pattern_desc;
     pat_loc: Location.t;
     pat_extra : (pat_extra * Location.t * attributes) list;
-    pat_type: type_expr;
+    pat_type: Types.type_expr;
     mutable pat_env: Env.t;
     pat_attributes: attributes;
    }
@@ -77,19 +76,19 @@ and pattern_desc =
             Invariant: n >= 2
          *)
   | Tpat_construct of
-      Longident.t loc * constructor_description * pattern list
+      Longident.t loc * Types.constructor_description * pattern list
         (** C                []
             C P              [P]
             C (P1, ..., Pn)  [P1; ...; Pn]
           *)
-  | Tpat_variant of label * pattern option * row_desc ref
+  | Tpat_variant of label * pattern option * Types.row_desc ref
         (** `A             (None)
             `A P           (Some P)
 
             See {!Types.row_desc} for an explanation of the last parameter.
          *)
   | Tpat_record of
-      (Longident.t loc * label_description * pattern) list *
+      (Longident.t loc * Types.label_description * pattern) list *
         closed_flag
         (** { l1=P1; ...; ln=Pn }     (flag = Closed)
             { l1=P1; ...; ln=Pn; _}   (flag = Open)
@@ -98,7 +97,7 @@ and pattern_desc =
          *)
   | Tpat_array of pattern list
         (** [| P1; ...; Pn |] *)
-  | Tpat_or of pattern * pattern * row_desc option
+  | Tpat_or of pattern * pattern * Types.row_desc option
         (** P1 | P2
 
             [row_desc] = [Some _] when translating [Ppat_type _],
@@ -113,7 +112,7 @@ and expression =
   { exp_desc: expression_desc;
     exp_loc: Location.t;
     exp_extra: (exp_extra * Location.t * attributes) list;
-    exp_type: type_expr;
+    exp_type: Types.type_expr;
     exp_env: Env.t;
     exp_attributes: attributes;
    }
@@ -183,7 +182,7 @@ and expression_desc =
   | Texp_tuple of expression list
         (** (E1, ..., EN) *)
   | Texp_construct of
-      Longident.t loc * constructor_description * expression list
+      Longident.t loc * Types.constructor_description * expression list
         (** C                []
             C E              [E]
             C (E1, ..., En)  [E1;...;En]
@@ -205,9 +204,9 @@ and expression_desc =
               { fields = [| l1, Kept t1; l2 Override P2 |]; representation;
                 extended_expression = Some E0 }
         *)
-  | Texp_field of expression * Longident.t loc * label_description
+  | Texp_field of expression * Longident.t loc * Types.label_description
   | Texp_setfield of
-      expression * Longident.t loc * label_description * expression
+      expression * Longident.t loc * Types.label_description * expression
   | Texp_array of expression list
   | Texp_ifthenelse of expression * expression * expression option
   | Texp_sequence of expression * expression
@@ -288,7 +287,7 @@ and class_expr_desc =
   | Tcl_let of rec_flag * value_binding list *
                   (Ident.t * expression) list * class_expr
   | Tcl_constraint of
-      class_expr * class_type option * string list * string list * Concr.t
+      class_expr * class_type option * string list * string list * Types.Concr.t
   (* Visible instance variables, methods and concrete methods *)
   | Tcl_open of open_description * class_expr
 
@@ -297,7 +296,7 @@ and class_structure =
    cstr_self: pattern;
    cstr_fields: class_field list;
    cstr_type: Types.class_signature;
-   cstr_meths: Ident.t Meths.t;
+   cstr_meths: Ident.t Types.Meths.t;
   }
 
 and class_field =
@@ -387,7 +386,7 @@ and module_binding =
     {
      mb_id: Ident.t option;
      mb_name: string option loc;
-     mb_presence: module_presence;
+     mb_presence: Types.module_presence;
      mb_expr: module_expr;
      mb_attributes: attributes;
      mb_loc: Location.t;
@@ -428,7 +427,7 @@ and module_type_desc =
 and primitive_coercion =
   {
     pc_desc: Primitive.description;
-    pc_type: type_expr;
+    pc_type: Types.type_expr;
     pc_env: Env.t;
     pc_loc : Location.t;
   }
@@ -464,7 +463,7 @@ and module_declaration =
     {
      md_id: Ident.t option;
      md_name: string option loc;
-     md_presence: module_presence;
+     md_presence: Types.module_presence;
      md_type: module_type;
      md_attributes: attributes;
      md_loc: Location.t;
@@ -525,7 +524,7 @@ and with_constraint =
 and core_type =
   { mutable ctyp_desc : core_type_desc;
       (** mutable because of [Typeclass.declare_method] *)
-    mutable ctyp_type : type_expr;
+    mutable ctyp_type : Types.type_expr;
       (** mutable because of [Typeclass.declare_method] *)
     ctyp_env : Env.t; (* BINANNOT ADDED *)
     ctyp_loc : Location.t;
@@ -725,7 +724,7 @@ val let_bound_idents: value_binding list -> Ident.t list
 val rev_let_bound_idents: value_binding list -> Ident.t list
 
 val let_bound_idents_with_loc:
-    value_binding list -> (Ident.t * string loc * type_expr) list
+    value_binding list -> (Ident.t * string loc * Types.type_expr) list
 
 (** Alpha conversion of patterns *)
 val alpha_pat: (Ident.t * Ident.t) list -> pattern -> pattern
@@ -735,7 +734,7 @@ val mkloc: 'a -> Location.t -> 'a Asttypes.loc
 
 val pat_bound_idents: pattern -> Ident.t list
 val pat_bound_idents_full:
-  pattern -> (Ident.t * string loc * type_expr) list
+  pattern -> (Ident.t * string loc * Types.type_expr) list
 
 (** Splits an or pattern into its value (left) and exception (right) parts. *)
 val split_pattern : pattern -> pattern option * pattern option
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 90fd6a5d96..2790bdbcc2 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -493,6 +493,7 @@ let merge_constraint initial_env remove_aliases loc sg constr =
             type_attributes = [];
             type_immediate = false;
             type_unboxed = unboxed_false_default_false;
+            type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
           }
         and id_row = Ident.create_local (s^"#row") in
         let initial_env =
@@ -736,6 +737,7 @@ and approx_module_declaration env pmd =
     Types.md_type = approx_modtype env pmd.pmd_type;
     md_attributes = pmd.pmd_attributes;
     md_loc = pmd.pmd_loc;
+    md_uid = Uid.internal_not_actually_unique;
   }
 
 and approx_sig env ssg =
@@ -838,6 +840,7 @@ and approx_modtype_info env sinfo =
    mtd_type = Option.map (approx_modtype env) sinfo.pmtd_type;
    mtd_attributes = sinfo.pmtd_attributes;
    mtd_loc = sinfo.pmtd_loc;
+   mtd_uid = Uid.internal_not_actually_unique;
   }
 
 let approx_modtype env smty =
@@ -1151,6 +1154,7 @@ and transl_modtype_aux env smty =
                   { md_type = arg.mty_type;
                     md_attributes = [];
                     md_loc = param.loc;
+                    md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
                   }
                 in
                 Env.enter_module_declaration ~scope ~arg:true name Mp_present
@@ -1288,6 +1292,7 @@ and transl_signature env sg =
               md_type=tmty.mty_type;
               md_attributes=pmd.pmd_attributes;
               md_loc=pmd.pmd_loc;
+              md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
             }
             in
             let id, newenv =
@@ -1323,7 +1328,9 @@ and transl_signature env sg =
               else
                 { md_type = Mty_alias path;
                   md_attributes = pms.pms_attributes;
-                  md_loc = pms.pms_loc }
+                  md_loc = pms.pms_loc;
+                  md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+                }
             in
             let pres =
               match md.md_type with
@@ -1349,21 +1356,22 @@ and transl_signature env sg =
             let (tdecls, newenv) =
               transl_recmodule_modtypes env sdecls in
             let decls =
-              List.filter_map (fun md ->
+              List.filter_map (fun (md, uid) ->
                 match md.md_id with
                 | None -> None
-                | Some id -> Some (id, md)
+                | Some id -> Some (id, md, uid)
               ) tdecls
             in
-            List.iter
-              (fun (id, md) -> Signature_names.check_module names md.md_loc id)
-              decls;
+            List.iter (fun (id, md, _) ->
+              Signature_names.check_module names md.md_loc id
+            ) decls;
             let (trem, rem, final_env) = transl_sig newenv srem in
-            mksig (Tsig_recmodule tdecls) env loc :: trem,
-            map_rec (fun rs (id, md) ->
+            mksig (Tsig_recmodule (List.map fst tdecls)) env loc :: trem,
+            map_rec (fun rs (id, md, uid) ->
                 let d = {Types.md_type = md.md_type.mty_type;
                          md_attributes = md.md_attributes;
                          md_loc = md.md_loc;
+                         md_uid = uid;
                         } in
                 Sig_module(id, Mp_present, d, rs, Exported))
               decls rem,
@@ -1493,6 +1501,7 @@ and transl_modtype_decl_aux names env
      Types.mtd_type=Option.map (fun t -> t.mty_type) tmty;
      mtd_attributes=pmtd_attributes;
      mtd_loc=pmtd_loc;
+     mtd_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
     }
   in
   let scope = Ctype.create_scope () in
@@ -1539,7 +1548,8 @@ and transl_recmodule_modtypes env sdecls =
         Option.map (fun id ->
            (id, Types.{md_type = mty.mty_type;
                        md_loc = mty.mty_loc;
-                       md_attributes = mty.mty_attributes})
+                       md_attributes = mty.mty_attributes;
+                       md_uid = Uid.internal_not_actually_unique; })
          ) id)
   in
   let scope = Ctype.create_scope () in
@@ -1579,13 +1589,15 @@ and transl_recmodule_modtypes env sdecls =
   let env2 = make_env2 dcl2 in
   check_recmod_typedecls env2 (map_mtys dcl2);
   let dcl2 =
-    List.map2
-      (fun pmd (id, id_loc, mty) ->
+    List.map2 (fun pmd (id, id_loc, mty) ->
+      let md =
         {md_id=id; md_name=id_loc; md_type=mty;
          md_presence=Mp_present;
          md_loc=pmd.pmd_loc;
-         md_attributes=pmd.pmd_attributes})
-      sdecls dcl2
+         md_attributes=pmd.pmd_attributes}
+      in
+      md, Uid.mk ~current_unit:(Env.get_unit_name ())
+    ) sdecls dcl2
   in
   (dcl2, env2)
 
@@ -1711,7 +1723,7 @@ let check_recmodule_inclusion env bindings =
       (* Generate fresh names Y_i for the rec. bound module idents X_i *)
       let bindings1 =
         List.map
-          (fun (id, _name, _mty_decl, _modl, mty_actual, _attrs, _loc) ->
+          (fun (id, _name, _mty_decl, _modl, mty_actual, _attrs, _loc, _uid) ->
              let ids =
                Option.map
                  (fun id -> (id, Ident.create_scoped ~scope (Ident.name id))) id
@@ -1746,7 +1758,8 @@ let check_recmodule_inclusion env bindings =
     end else begin
       (* Base case: check inclusion of s(mty_actual) in s(mty_decl)
          and insert coercion if needed *)
-      let check_inclusion (id, name, mty_decl, modl, mty_actual, attrs, loc) =
+      let check_inclusion
+            (id, name, mty_decl, modl, mty_actual, attrs, loc, uid) =
         let mty_decl' = Subst.modtype (Rescope scope) s mty_decl.mty_type
         and mty_actual' = subst_and_strengthen env scope s id mty_actual in
         let coercion =
@@ -1762,14 +1775,17 @@ let check_recmodule_inclusion env bindings =
               mod_loc = modl.mod_loc;
               mod_attributes = [];
              } in
-        {
-         mb_id = id;
-         mb_name = name;
-         mb_presence = Mp_present;
-         mb_expr = modl';
-         mb_attributes = attrs;
-         mb_loc = loc;
-        }
+        let mb =
+          {
+            mb_id = id;
+            mb_name = name;
+            mb_presence = Mp_present;
+            mb_expr = modl';
+            mb_attributes = attrs;
+            mb_loc = loc;
+          }
+        in
+        mb, uid
       in
       List.map check_inclusion bindings
     end
@@ -1912,6 +1928,7 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
                 { md_type = mty.mty_type;
                   md_attributes = [];
                   md_loc = param.loc;
+                  md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
                 }
               in
               let id, newenv =
@@ -2206,10 +2223,12 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
           | Mty_alias _ -> Mp_absent
           | _ -> Mp_present
         in
+        let md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
         let md =
           { md_type = enrich_module_type anchor name.txt modl.mod_type env;
             md_attributes = attrs;
             md_loc = pmb_loc;
+            md_uid;
           }
         in
         (*prerr_endline (Ident.unique_toplevel_name id);*)
@@ -2225,6 +2244,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
                         {md_type = modl.mod_type;
                          md_attributes = attrs;
                          md_loc = pmb_loc;
+                         md_uid;
                         }, Trec_not, Exported)]
         in
         Tstr_module {mb_id=id; mb_name=name; mb_expr=modl;
@@ -2254,12 +2274,12 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
                   pmd_attributes=attrs; pmd_loc=loc}) sbind
             ) in
         List.iter
-          (fun md ->
+          (fun (md, _) ->
             Option.iter Signature_names.(check_module names md.md_loc) md.md_id)
           decls;
         let bindings1 =
           List.map2
-            (fun {md_id=id; md_type=mty} (name, _, smodl, attrs, loc) ->
+            (fun ({md_id=id; md_type=mty}, uid) (name, _, smodl, attrs, loc) ->
                let modl =
                  Builtin_attributes.warning_scope attrs
                    (fun () ->
@@ -2270,11 +2290,11 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
                let mty' =
                  enrich_module_type anchor name.txt modl.mod_type newenv
                in
-               (id, name, mty, modl, mty', attrs, loc))
+               (id, name, mty, modl, mty', attrs, loc, uid))
             decls sbind in
         let newenv = (* allow aliasing recursive modules from outside *)
           List.fold_left
-            (fun env md ->
+            (fun env (md, uid) ->
                match md.md_id with
                | None -> env
                | Some id ->
@@ -2283,6 +2303,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
                        md_type = md.md_type.mty_type;
                        md_attributes = md.md_attributes;
                        md_loc = md.md_loc;
+                       md_uid = uid;
                      }
                    in
                    Env.add_module_declaration ~check:true
@@ -2293,15 +2314,17 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
         let bindings2 =
           check_recmodule_inclusion newenv bindings1 in
         let mbs =
-          List.filter_map (fun mb -> Option.map (fun id -> id, mb)  mb.mb_id)
-            bindings2
+          List.filter_map (fun (mb, uid) ->
+            Option.map (fun id -> id, mb, uid)  mb.mb_id
+          ) bindings2
         in
-        Tstr_recmodule bindings2,
-        map_rec (fun rs (id, mb) ->
+        Tstr_recmodule (List.map fst bindings2),
+        map_rec (fun rs (id, mb, uid) ->
             Sig_module(id, Mp_present, {
                 md_type=mb.mb_expr.mod_type;
                 md_attributes=mb.mb_attributes;
                 md_loc=mb.mb_loc;
+                md_uid = uid;
               }, rs, Exported))
            mbs [],
         newenv
@@ -2645,7 +2668,9 @@ let package_signatures units =
       let md =
         { md_type=Mty_signature sg;
           md_attributes=[];
-          md_loc=Location.none; }
+          md_loc=Location.none;
+          md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+        }
       in
       Sig_module(newid, Mp_present, md, Trec_not, Exported))
     units_with_ids
diff --git a/typing/types.ml b/typing/types.ml
index 51c404bf8e..85b48eee9b 100644
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -79,6 +79,38 @@ module TypeOps = struct
   let equal t1 t2 = t1 == t2
 end
 
+(* *)
+
+module Uid = struct
+  type t =
+    | Compilation_unit of string
+    | Item of { comp_unit: string; id: int }
+    | Internal
+    | Predef of string
+
+  let mk =
+    let id = ref (-1) in
+    fun ~current_unit ->
+      incr id;
+      Item { comp_unit = current_unit; id = !id }
+
+  let of_compilation_unit_id id =
+    if not (Ident.persistent id) then
+      Misc.fatal_errorf "Types.Uid.of_compilation_unit_id %S" (Ident.name id);
+    Compilation_unit (Ident.name id)
+
+  let of_predef_id id =
+    if not (Ident.is_predef id) then
+      Misc.fatal_errorf "Types.Uid.of_predef_id %S" (Ident.name id);
+    Predef (Ident.name id)
+
+  let internal_not_actually_unique = Internal
+
+  let for_actual_declaration = function
+    | Item _ -> true
+    | _ -> false
+end
+
 (* Maps of methods and instance variables *)
 
 module Meths = Misc.Stdlib.String.Map
@@ -91,7 +123,8 @@ type value_description =
     val_kind: value_kind;
     val_loc: Location.t;
     val_attributes: Parsetree.attributes;
- }
+    val_uid: Uid.t;
+  }
 
 and value_kind =
     Val_reg                             (* Regular value *)
@@ -151,6 +184,7 @@ type type_declaration =
     type_attributes: Parsetree.attributes;
     type_immediate: bool;
     type_unboxed: unboxed_status;
+    type_uid: Uid.t;
  }
 
 and type_kind =
@@ -173,6 +207,7 @@ and label_declaration =
     ld_type: type_expr;
     ld_loc: Location.t;
     ld_attributes: Parsetree.attributes;
+    ld_uid: Uid.t;
   }
 
 and constructor_declaration =
@@ -182,6 +217,7 @@ and constructor_declaration =
     cd_res: type_expr option;
     cd_loc: Location.t;
     cd_attributes: Parsetree.attributes;
+    cd_uid: Uid.t;
   }
 
 and constructor_arguments =
@@ -200,13 +236,15 @@ let unboxed_true_default_false = {unboxed = true; default = false}
 let unboxed_true_default_true = {unboxed = true; default = true}
 
 type extension_constructor =
-    { ext_type_path: Path.t;
-      ext_type_params: type_expr list;
-      ext_args: constructor_arguments;
-      ext_ret_type: type_expr option;
-      ext_private: private_flag;
-      ext_loc: Location.t;
-      ext_attributes: Parsetree.attributes; }
+  { ext_type_path: Path.t;
+    ext_type_params: type_expr list;
+    ext_args: constructor_arguments;
+    ext_ret_type: type_expr option;
+    ext_private: private_flag;
+    ext_loc: Location.t;
+    ext_attributes: Parsetree.attributes;
+    ext_uid: Uid.t;
+  }
 
 and type_transparence =
     Type_public      (* unrestricted expansion *)
@@ -237,6 +275,7 @@ type class_declaration =
     cty_variance: Variance.t list;
     cty_loc: Location.t;
     cty_attributes: Parsetree.attributes;
+    cty_uid: Uid.t;
  }
 
 type class_type_declaration =
@@ -246,6 +285,7 @@ type class_type_declaration =
     clty_variance: Variance.t list;
     clty_loc: Location.t;
     clty_attributes: Parsetree.attributes;
+    clty_uid: Uid.t;
   }
 
 (* Type expressions for the module language *)
@@ -285,6 +325,7 @@ and module_declaration =
     md_type: module_type;
     md_attributes: Parsetree.attributes;
     md_loc: Location.t;
+    md_uid: Uid.t;
   }
 
 and modtype_declaration =
@@ -292,6 +333,7 @@ and modtype_declaration =
     mtd_type: module_type option;  (* Note: abstract *)
     mtd_attributes: Parsetree.attributes;
     mtd_loc: Location.t;
+    mtd_uid: Uid.t;
   }
 
 and rec_status =
@@ -323,6 +365,7 @@ type constructor_description =
     cstr_loc: Location.t;
     cstr_attributes: Parsetree.attributes;
     cstr_inlined: type_declaration option;
+    cstr_uid: Uid.t;
    }
 
 and constructor_tag =
@@ -356,6 +399,7 @@ type label_description =
     lbl_private: private_flag;          (* Read-only field? *)
     lbl_loc: Location.t;
     lbl_attributes: Parsetree.attributes;
+    lbl_uid: Uid.t;
    }
 
 let rec bound_value_identifiers = function
diff --git a/typing/types.mli b/typing/types.mli
index f5e75a9a44..38263e743f 100644
--- a/typing/types.mli
+++ b/typing/types.mli
@@ -240,6 +240,19 @@ module TypeOps : sig
   val hash : t -> int
 end
 
+(* *)
+
+module Uid : sig
+  type t
+
+  val mk : current_unit:string -> t
+  val of_compilation_unit_id : Ident.t -> t
+  val of_predef_id : Ident.t -> t
+  val internal_not_actually_unique : t
+
+  val for_actual_declaration : t -> bool
+end
+
 (* Maps of methods and instance variables *)
 
 module Meths : Map.S with type key = string
@@ -252,7 +265,8 @@ type value_description =
     val_kind: value_kind;
     val_loc: Location.t;
     val_attributes: Parsetree.attributes;
-   }
+    val_uid: Uid.t;
+  }
 
 and value_kind =
     Val_reg                             (* Regular value *)
@@ -301,6 +315,7 @@ type type_declaration =
     type_attributes: Parsetree.attributes;
     type_immediate: bool; (* true iff type should not be a pointer *)
     type_unboxed: unboxed_status;
+    type_uid: Uid.t;
   }
 
 and type_kind =
@@ -323,6 +338,7 @@ and label_declaration =
     ld_type: type_expr;
     ld_loc: Location.t;
     ld_attributes: Parsetree.attributes;
+    ld_uid: Uid.t;
   }
 
 and constructor_declaration =
@@ -332,6 +348,7 @@ and constructor_declaration =
     cd_res: type_expr option;
     cd_loc: Location.t;
     cd_attributes: Parsetree.attributes;
+    cd_uid: Uid.t;
   }
 
 and constructor_arguments =
@@ -353,15 +370,16 @@ val unboxed_true_default_false : unboxed_status
 val unboxed_true_default_true : unboxed_status
 
 type extension_constructor =
-    {
-      ext_type_path: Path.t;
-      ext_type_params: type_expr list;
-      ext_args: constructor_arguments;
-      ext_ret_type: type_expr option;
-      ext_private: private_flag;
-      ext_loc: Location.t;
-      ext_attributes: Parsetree.attributes;
-    }
+  {
+    ext_type_path: Path.t;
+    ext_type_params: type_expr list;
+    ext_args: constructor_arguments;
+    ext_ret_type: type_expr option;
+    ext_private: private_flag;
+    ext_loc: Location.t;
+    ext_attributes: Parsetree.attributes;
+    ext_uid: Uid.t;
+  }
 
 and type_transparence =
     Type_public      (* unrestricted expansion *)
@@ -392,6 +410,7 @@ type class_declaration =
     cty_variance: Variance.t list;
     cty_loc: Location.t;
     cty_attributes: Parsetree.attributes;
+    cty_uid: Uid.t;
   }
 
 type class_type_declaration =
@@ -401,6 +420,7 @@ type class_type_declaration =
     clty_variance: Variance.t list;
     clty_loc: Location.t;
     clty_attributes: Parsetree.attributes;
+    clty_uid: Uid.t;
   }
 
 (* Type expressions for the module language *)
@@ -440,6 +460,7 @@ and module_declaration =
     md_type: module_type;
     md_attributes: Parsetree.attributes;
     md_loc: Location.t;
+    md_uid: Uid.t;
   }
 
 and modtype_declaration =
@@ -447,6 +468,7 @@ and modtype_declaration =
     mtd_type: module_type option;  (* None: abstract *)
     mtd_attributes: Parsetree.attributes;
     mtd_loc: Location.t;
+    mtd_uid: Uid.t;
   }
 
 and rec_status =
@@ -478,6 +500,7 @@ type constructor_description =
     cstr_loc: Location.t;
     cstr_attributes: Parsetree.attributes;
     cstr_inlined: type_declaration option;
+    cstr_uid: Uid.t;
    }
 
 and constructor_tag =
@@ -505,6 +528,7 @@ type label_description =
     lbl_private: private_flag;          (* Read-only field? *)
     lbl_loc: Location.t;
     lbl_attributes: Parsetree.attributes;
+    lbl_uid: Uid.t;
   }
 
 (** Extracts the list of "value" identifiers bound by a signature.