Fewer conversions between Names and strings

Author: jonludlam

src/model/names.ml

@@ -43,6 +43,8 @@ module type Name = sig
 
   val shadowed_of_ident : Ident.t -> t
 
+  val equal_modulo_shadowing : t -> t -> bool
+
   val equal : t -> t -> bool
 
   val compare : t -> t -> int
@@ -93,6 +95,15 @@ module Name : Name = struct
 
   let shadowed_of_ident id = shadowed_of_string (Ident.name id)
 
+  let equal_modulo_shadowing (x : t) (y : t) =
+    match (x, y) with
+    | Std x, Std y -> x = y
+    | Hidden x, Std y -> x = y
+    | Std x, Hidden y -> x = y
+    | Hidden x, Hidden y -> x = y
+    | Shadowed (x, i, s), Shadowed (y, j, t) -> x = y && i = j && s = t
+    | _, _ -> false
+
   let equal (x : t) (y : t) = x = y
 
   let compare = compare

src/model/names.mli

@@ -43,6 +43,8 @@ module type Name = sig
 
   val shadowed_of_ident : Ident.t -> t
 
+  val equal_modulo_shadowing : t -> t -> bool
+
   val equal : t -> t -> bool
 
   val compare : t -> t -> int

src/xref2/find.ml

@@ -93,23 +93,29 @@ let rec disambiguate = function
 
 let module_in_sig sg name =
   find_in_sig sg (function
-    | Signature.Module (id, _, m) when N.module_ id = name ->
+    | Signature.Module (id, _, m)
+      when ModuleName.equal_modulo_shadowing (N.typed_module id) name ->
         Some (`FModule (N.typed_module id, Delayed.get m))
     | _ -> None)
 
 let module_type_in_sig sg name =
   find_in_sig sg (function
-    | Signature.ModuleType (id, mt) when N.module_type id = name ->
+    | Signature.ModuleType (id, mt)
+      when ModuleTypeName.equal_modulo_shadowing (N.typed_module_type id) name
+      ->
         Some (`FModuleType (N.typed_module_type id, Delayed.get mt))
     | _ -> None)
 
 let type_in_sig sg name =
   find_in_sig sg (function
-    | Signature.Type (id, _, m) when N.type_ id = name ->
-        Some (`FType (N.type' id, Delayed.get m))
-    | Class (id, _, c) when N.class_ id = name ->
+    | Signature.Type (id, _, m)
+      when TypeName.equal_modulo_shadowing (N.typed_type id) name ->
+        Some (`FType (N.typed_type id, Delayed.get m))
+    | Class (id, _, c)
+      when TypeName.equal_modulo_shadowing (N.typed_class id) name ->
         Some (`FClass (N.class' id, c))
-    | ClassType (id, _, c) when N.class_type id = name ->
+    | ClassType (id, _, c)
+      when TypeName.equal_modulo_shadowing (N.typed_class_type id) name ->
         Some (`FClassType (N.class_type' id, c))
     | _ -> None)
 
@@ -127,7 +133,8 @@ type careful_class = [ class_ | removed_type ]
 
 let careful_module_in_sig sg name =
   let removed_module = function
-    | Signature.RModule (id, p) when ModuleName.to_string id = name ->
+    | Signature.RModule (id, p) when ModuleName.equal_modulo_shadowing id name
+      ->
         Some (`FModule_removed p)
     | _ -> None
   in
@@ -137,7 +144,8 @@ let careful_module_in_sig sg name =
 
 let careful_module_type_in_sig sg name =
   let removed_module_type = function
-    | Signature.RModuleType (id, p) when ModuleTypeName.to_string id = name ->
+    | Signature.RModuleType (id, p)
+      when ModuleTypeName.equal_modulo_shadowing id name ->
         Some (`FModuleType_removed p)
     | _ -> None
   in
@@ -147,7 +155,7 @@ let careful_module_type_in_sig sg name =
 
 let removed_type_in_sig sg name =
   let removed_type = function
-    | Signature.RType (id, p, eq) when TypeName.to_string id = name ->
+    | Signature.RType (id, p, eq) when id = name ->
         Some (`FType_removed (id, p, eq))
     | _ -> None
   in
@@ -160,15 +168,18 @@ let careful_type_in_sig sg name =
 
 let datatype_in_sig sg name =
   find_in_sig sg (function
-    | Signature.Type (id, _, t) when N.type_ id = name ->
+    | Signature.Type (id, _, t)
+      when TypeName.equal_modulo_shadowing (N.typed_type id) name ->
         Some (`FType (N.type' id, Component.Delayed.get t))
     | _ -> None)
 
 let class_in_sig sg name =
   filter_in_sig sg (function
-    | Signature.Class (id, _, c) when N.class_ id = name ->
+    | Signature.Class (id, _, c)
+      when TypeName.equal_modulo_shadowing (N.typed_class id) name ->
         Some (`FClass (N.class' id, c))
-    | Signature.ClassType (id, _, c) when N.class_type id = name ->
+    | Signature.ClassType (id, _, c)
+      when TypeName.equal_modulo_shadowing (N.typed_class_type id) name ->
         Some (`FClassType (N.class_type' id, c))
     | _ -> None)
 
@@ -226,7 +237,7 @@ let any_in_comment d name =
     match xs with
     | elt :: rest -> (
         match elt.Odoc_model.Location_.value with
-        | `Heading lbl when Ident.Name.label lbl.Label.label = name ->
+        | `Heading lbl when Ident.Name.typed_label lbl.Label.label = name ->
             Some (`FLabel lbl)
         | _ -> inner rest)
     | [] -> None
@@ -258,7 +269,7 @@ let any_in_sig sg name =
         | Some r -> Some (`In_type (N.type' id, typ, r))
         | None -> None)
     | TypExt typext -> any_in_typext typext name
-    | Comment (`Docs d) -> any_in_comment d name
+    | Comment (`Docs d) -> any_in_comment d (LabelName.make_std name)
     | _ -> None)
 
 let signature_in_sig sg name =
@@ -271,35 +282,39 @@ let signature_in_sig sg name =
 
 let module_type_in_sig sg name =
   find_in_sig sg (function
-    | Signature.ModuleType (id, m) when N.module_type id = name ->
+    | Signature.ModuleType (id, m)
+      when ModuleTypeName.equal_modulo_shadowing (N.typed_module_type id) name
+      ->
         Some (`FModuleType (N.typed_module_type id, Delayed.get m))
     | _ -> None)
 
 let value_in_sig sg name =
-  filter_in_sig sg (function
+  find_in_sig sg (function
     | Signature.Value (id, m)
-      when N.value id = name || N.value id = "(" ^ name ^ ")" ->
+      when ValueName.equal_modulo_shadowing (N.typed_value id) name
+           || ValueName.to_string (N.typed_value id)
+              = "(" ^ ValueName.to_string name ^ ")" ->
         (* For operator, the value will have name [(<op>)]. We match that even
            with name [<op>]. *)
         Some (`FValue (N.typed_value id, Delayed.get m))
     | _ -> None)
 
-let value_in_sig_unambiguous sg name = disambiguate (value_in_sig sg name)
-
 let label_in_sig sg name =
   filter_in_sig sg (function
     | Signature.Comment (`Docs d) -> any_in_comment d name
     | _ -> None)
 
 let exception_in_sig sg name =
   find_in_sig sg (function
-    | Signature.Exception (id, e) when N.exception_ id = name ->
+    | Signature.Exception (id, e) when N.typed_exception id = name ->
         Some (`FExn (N.typed_exception id, e))
     | _ -> None)
 
 let extension_in_sig sg name =
   let rec inner t = function
-    | ec :: _ when ec.Extension.Constructor.name = name -> Some (`FExt (t, ec))
+    | ec :: _ when ec.Extension.Constructor.name = ExtensionName.to_string name
+      ->
+        Some (`FExt (t, ec))
     | _ :: tl -> inner t tl
     | [] -> None
   in
@@ -355,13 +370,13 @@ let any_in_class_signature cs name =
 
 let method_in_class_signature cs name =
   find_in_class_signature cs (function
-    | ClassSignature.Method (id, m) when N.method_ id = name ->
-        Some (`FMethod (N.typed_method id, m))
+    | ClassSignature.Method (id, m) when N.typed_method id = name ->
+        Some (`FMethod (name, m))
     | _ -> None)
 
 let instance_variable_in_class_signature cs name =
   find_in_class_signature cs (function
     | ClassSignature.InstanceVariable (id, iv)
-      when N.instance_variable id = name ->
-        Some (`FInstance_variable (N.typed_instance_variable id, iv))
+      when N.typed_instance_variable id = name ->
+        Some (`FInstance_variable (name, iv))
     | _ -> None)

src/xref2/find.mli

@@ -59,36 +59,37 @@ type any_in_class_sig = [ instance_variable | method_ ]
 
 (** Lookup by name, unambiguous *)
 
-val module_in_sig : Signature.t -> string -> module_ option
+val module_in_sig : Signature.t -> ModuleName.t -> module_ option
 
-val type_in_sig : Signature.t -> string -> type_ option
+val type_in_sig : Signature.t -> TypeName.t -> type_ option
 
-val datatype_in_sig : Signature.t -> string -> datatype option
+val datatype_in_sig : Signature.t -> TypeName.t -> datatype option
 
-val module_type_in_sig : Signature.t -> string -> module_type option
+val module_type_in_sig : Signature.t -> ModuleTypeName.t -> module_type option
 
-val exception_in_sig : Signature.t -> string -> exception_ option
+val exception_in_sig : Signature.t -> ExceptionName.t -> exception_ option
 
-val extension_in_sig : Signature.t -> string -> extension option
+val extension_in_sig : Signature.t -> ExtensionName.t -> extension option
 
 val any_in_type : TypeDecl.t -> string -> any_in_type option
 
 val any_in_typext : Extension.t -> string -> extension option
 
-val method_in_class_signature : ClassSignature.t -> string -> method_ option
+val value_in_sig : Signature.t -> ValueName.t -> value option
+
+val method_in_class_signature :
+  ClassSignature.t -> MethodName.t -> method_ option
 
 val instance_variable_in_class_signature :
-  ClassSignature.t -> string -> instance_variable option
+  ClassSignature.t -> InstanceVariableName.t -> instance_variable option
 
 (** Maybe ambiguous *)
 
-val class_in_sig : Signature.t -> string -> class_ list
+val class_in_sig : Signature.t -> TypeName.t -> class_ list
 
 val signature_in_sig : Signature.t -> string -> signature list
 
-val value_in_sig : Signature.t -> string -> value list
-
-val label_in_sig : Signature.t -> string -> label list
+val label_in_sig : Signature.t -> LabelName.t -> label list
 
 val label_parent_in_sig : Signature.t -> string -> label_parent list
 
@@ -100,9 +101,7 @@ val any_in_class_signature : ClassSignature.t -> string -> any_in_class_sig list
 
 (** Disambiguated lookups, returns the last match. *)
 
-val class_in_sig_unambiguous : Signature.t -> string -> class_ option
-
-val value_in_sig_unambiguous : Signature.t -> string -> value option
+val class_in_sig_unambiguous : Signature.t -> TypeName.t -> class_ option
 
 (** Lookup removed items *)
 
@@ -118,11 +117,11 @@ type careful_type = [ type_ | removed_type ]
 
 type careful_class = [ class_ | removed_type ]
 
-val careful_module_in_sig : Signature.t -> string -> careful_module option
+val careful_module_in_sig : Signature.t -> ModuleName.t -> careful_module option
 
 val careful_module_type_in_sig :
-  Signature.t -> string -> careful_module_type option
+  Signature.t -> ModuleTypeName.t -> careful_module_type option
 
-val careful_type_in_sig : Signature.t -> string -> careful_type option
+val careful_type_in_sig : Signature.t -> TypeName.t -> careful_type option
 
-val careful_class_in_sig : Signature.t -> string -> careful_class option
+val careful_class_in_sig : Signature.t -> TypeName.t -> careful_class option