Add a unique id to every signature item

1 files changed, 48 insertions, 8 deletions

diff --git a/typing/types.ml b/typing/types.ml
index e2e1feb53c..66665cfdaa 100644
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -79,6 +79,34 @@ 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
+end
+
 (* Maps of methods and instance variables *)
 
 module Meths = Misc.Stdlib.String.Map
@@ -91,7 +119,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 *)
@@ -178,6 +207,7 @@ type type_declaration =
     type_attributes: Parsetree.attributes;
     type_immediate: Type_immediacy.t;
     type_unboxed: unboxed_status;
+    type_uid: Uid.t;
  }
 
 and type_kind =
@@ -200,6 +230,7 @@ and label_declaration =
     ld_type: type_expr;
     ld_loc: Location.t;
     ld_attributes: Parsetree.attributes;
+    ld_uid: Uid.t;
   }
 
 and constructor_declaration =
@@ -209,6 +240,7 @@ and constructor_declaration =
     cd_res: type_expr option;
     cd_loc: Location.t;
     cd_attributes: Parsetree.attributes;
+    cd_uid: Uid.t;
   }
 
 and constructor_arguments =
@@ -227,13 +259,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 *)
@@ -264,6 +298,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 =
@@ -273,6 +308,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 *)
@@ -312,6 +348,7 @@ and module_declaration =
     md_type: module_type;
     md_attributes: Parsetree.attributes;
     md_loc: Location.t;
+    md_uid: Uid.t;
   }
 
 and modtype_declaration =
@@ -319,6 +356,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 =
@@ -350,6 +388,7 @@ type constructor_description =
     cstr_loc: Location.t;
     cstr_attributes: Parsetree.attributes;
     cstr_inlined: type_declaration option;
+    cstr_uid: Uid.t;
    }
 
 and constructor_tag =
@@ -383,6 +422,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