Fewer conversions between Names and strings

src/document/generator.ml

@@ -110,11 +110,20 @@ module Make (Syntax : SYNTAX) = struct
       | `SubstitutedMT m -> from_path (m :> Path.t)
       | `SubstitutedT m -> from_path (m :> Path.t)
       | `SubstitutedCT m -> from_path (m :> Path.t)
-      | `Root root -> unresolved [ inline @@ Text root ]
+      | `Root root -> unresolved [ inline @@ Text (ModuleName.to_string root) ]
       | `Forward root -> unresolved [ inline @@ Text root ] (* FIXME *)
       | `Dot (prefix, suffix) ->
           let link = from_path (prefix :> Path.t) in
-          link ++ O.txt ("." ^ suffix)
+          link ++ O.txt ("." ^ ModuleName.to_string suffix)
+      | `DotT (prefix, suffix) ->
+          let link = from_path (prefix :> Path.t) in
+          link ++ O.txt ("." ^ TypeName.to_string suffix)
+      | `DotMT (prefix, suffix) ->
+          let link = from_path (prefix :> Path.t) in
+          link ++ O.txt ("." ^ ModuleTypeName.to_string suffix)
+      | `DotV (prefix, suffix) ->
+          let link = from_path (prefix :> Path.t) in
+          link ++ O.txt ("." ^ ValueName.to_string suffix)
       | `Apply (p1, p2) ->
           let link1 = from_path (p1 :> Path.t) in
           let link2 = from_path (p2 :> Path.t) in

src/document/url.ml

@@ -47,13 +47,19 @@ let render_path : Odoc_model.Paths.Path.t -> string =
     | `Value (p, s) -> render_resolved (p :> t) ^ "." ^ ValueName.to_string s
     | `Class (p, s) -> render_resolved (p :> t) ^ "." ^ TypeName.to_string s
     | `ClassType (p, s) -> render_resolved (p :> t) ^ "." ^ TypeName.to_string s
+  and dot p s =
+    render_path (p : Odoc_model.Paths.Path.Module.t :> Odoc_model.Paths.Path.t)
+    ^ "." ^ s
   and render_path : Odoc_model.Paths.Path.t -> string =
    fun x ->
     match x with
     | `Identifier (id, _) -> Identifier.name id
-    | `Root root -> root
+    | `Root root -> ModuleName.to_string root
     | `Forward root -> root
-    | `Dot (prefix, suffix) -> render_path (prefix :> t) ^ "." ^ suffix
+    | `Dot (p, s) -> dot p (ModuleName.to_string s)
+    | `DotT (p, s) -> dot p (TypeName.to_string s)
+    | `DotMT (p, s) -> dot p (ModuleTypeName.to_string s)
+    | `DotV (p, s) -> dot p (ValueName.to_string s)
     | `Apply (p1, p2) ->
         render_path (p1 :> t) ^ "(" ^ render_path (p2 :> t) ^ ")"
     | `Resolved rp -> render_resolved rp

src/loader/cmi.ml

@@ -741,7 +741,7 @@ let read_type_declaration env parent id decl =
   let doc, canonical =
     Doc_attr.attached Odoc_model.Semantics.Expect_canonical container decl.type_attributes
   in
-  let canonical = (canonical :> Path.Type.t option) in
+  let canonical = match canonical with | None -> None | Some s -> Doc_attr.conv_canonical_type s in
   let params = mark_type_declaration decl in
   let manifest = opt_map (read_type_expr env) decl.type_manifest in
   let constraints = read_type_constraints env params in
@@ -985,7 +985,7 @@ and read_module_type_declaration env parent id (mtd : Odoc_model.Compat.modtype_
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
   let doc, canonical = Doc_attr.attached Odoc_model.Semantics.Expect_canonical container mtd.mtd_attributes in
-  let canonical = (canonical :> Path.ModuleType.t option) in
+  let canonical = match canonical with | None -> None | Some s -> Doc_attr.conv_canonical_module_type s in
   let expr = opt_map (read_module_type env (id :> Identifier.Signature.t)) mtd.mtd_type in
   {id; source_loc; doc; canonical; expr }
 
@@ -995,7 +995,7 @@ and read_module_declaration env parent ident (md : Odoc_model.Compat.module_decl
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
   let doc, canonical = Doc_attr.attached Odoc_model.Semantics.Expect_canonical container md.md_attributes in
-  let canonical = (canonical :> Path.Module.t option) in
+  let canonical = match canonical with | None -> None | Some s -> Some (Doc_attr.conv_canonical_module s) in
   let type_ =
     match md.md_type with
     | Mty_alias p -> Alias (Env.Path.read_module env p, None)

src/loader/cmt.ml

@@ -453,7 +453,7 @@ and read_module_binding env parent mb =
         in
         (ModuleType expr, canonical)
   in
-  let canonical = (canonical :> Path.Module.t option) in
+  let canonical = match canonical with | None -> None | Some s -> Some (Doc_attr.conv_canonical_module s) in
   let hidden =
 #if OCAML_VERSION >= (4,10,0)
     match canonical, mid.iv with
@@ -613,6 +613,7 @@ let read_implementation root name impl =
   let sg, canonical =
     read_structure Odoc_model.Semantics.Expect_canonical (Env.empty ()) id impl
   in
-  (id, sg, (canonical :> Odoc_model.Paths.Path.Module.t option))
+  let canonical = match canonical with | None -> None | Some s -> Some (Doc_attr.conv_canonical_module s) in
+  (id, sg, canonical)
 
 let _ = Cmti.read_module_expr := read_module_expr

src/loader/cmti.ml

@@ -267,7 +267,7 @@ let read_type_declaration env parent decl =
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
   let doc, canonical = Doc_attr.attached Odoc_model.Semantics.Expect_canonical container decl.typ_attributes in
-  let canonical = (canonical :> Path.Type.t option) in
+  let canonical = match canonical with | None -> None | Some s -> Doc_attr.conv_canonical_type s in
   let equation = read_type_equation env container decl in
   let representation = read_type_kind env id decl.typ_kind in
   {id; source_loc; doc; canonical; equation; representation}
@@ -608,7 +608,7 @@ and read_module_type_declaration env parent mtd =
         (Some expr, canonical)
     | None -> (None, canonical)
   in
-  let canonical = (canonical :> Path.ModuleType.t option) in
+  let canonical = match canonical with | None -> None | Some s -> Doc_attr.conv_canonical_module_type s in
   { id; source_loc; doc; canonical; expr }
 
 and read_module_declaration env parent md =
@@ -636,7 +636,7 @@ and read_module_declaration env parent md =
         in
         (ModuleType expr, canonical)
   in
-  let canonical = (canonical :> Path.Module.t option) in
+  let canonical = match canonical with | None -> None | Some s -> Some (Doc_attr.conv_canonical_module s) in
   let hidden =
 #if OCAML_VERSION >= (4,10,0)
     match canonical, mid.iv with
@@ -812,4 +812,5 @@ let read_interface root name intf =
   let sg, canonical =
     read_signature Odoc_model.Semantics.Expect_canonical (Env.empty ()) id intf
   in
-  (id, sg, (canonical :> Odoc_model.Paths.Path.Module.t option))
+  let canonical = match canonical with | None -> None | Some s -> Some (Doc_attr.conv_canonical_module s) in
+  (id, sg, canonical)

src/loader/doc_attr.ml

@@ -259,3 +259,15 @@ let extract_top_comment_class items =
   match items with
   | Lang.ClassSignature.Comment (`Docs doc) :: tl -> (tl, split_docs doc)
   | _ -> items, (empty,empty)
+
+let rec conv_canonical_module : Odoc_model.Reference.path -> Paths.Path.Module.t = function
+  | `Dot (parent, name) -> `Dot (conv_canonical_module parent, Names.ModuleName.make_std name)
+  | `Root name -> `Root (Names.ModuleName.make_std name)
+
+let conv_canonical_type : Odoc_model.Reference.path -> Paths.Path.Type.t option = function
+  | `Dot (parent, name) -> Some (`DotT (conv_canonical_module parent, Names.TypeName.make_std name))
+  | _ -> None
+
+let conv_canonical_module_type : Odoc_model.Reference.path -> Paths.Path.ModuleType.t option = function
+  | `Dot (parent, name) -> Some (`DotMT (conv_canonical_module parent, Names.ModuleTypeName.make_std name))
+  | _ -> None

src/loader/doc_attr.mli

@@ -70,3 +70,8 @@ val extract_top_comment_class :
 (** Extract the first comment of a class signature. Returns the remaining items. *)
 
 val read_location : Location.t -> Odoc_model.Location_.span
+
+val conv_canonical_module : Odoc_model.Reference.path -> Paths.Path.Module.t
+val conv_canonical_type : Odoc_model.Reference.path -> Paths.Path.Type.t option
+val conv_canonical_module_type :
+  Odoc_model.Reference.path -> Paths.Path.ModuleType.t option

src/loader/ident_env.cppo.ml

@@ -673,7 +673,7 @@ let is_shadowed
 module Path = struct
 
   let read_module_ident env id =
-    if Ident.persistent id then `Root (Ident.name id)
+    if Ident.persistent id then `Root (ModuleName.of_ident id)
     else
       try find_module env id
       with Not_found -> assert false
@@ -693,7 +693,7 @@ module Path = struct
     try
       `Identifier (find_class_type env id, false)
     with Not_found ->
-      `Dot(`Root "*", (Ident.name id))
+      `DotT (`Root (ModuleName.make_std "*"), (TypeName.of_ident id))
       (* TODO remove this hack once the fix for PR#6650
          is in the OCaml release *)
 
@@ -718,9 +718,9 @@ module Path = struct
   let rec read_module : t -> Path.t -> Paths.Path.Module.t = fun env -> function
     | Path.Pident id -> read_module_ident env id
 #if OCAML_VERSION >= (4,8,0)
-    | Path.Pdot(p, s) -> `Dot(read_module env p, s)
+    | Path.Pdot(p, s) -> `Dot(read_module env p, ModuleName.make_std s)
 #else
-    | Path.Pdot(p, s, _) -> `Dot(read_module env p, s)
+    | Path.Pdot(p, s, _) -> `Dot(read_module env p, ModuleName.make_std s)
 #endif
     | Path.Papply(p, arg) -> `Apply(read_module env p, read_module env arg)
 #if OCAML_VERSION >= (5,1,0)
@@ -730,9 +730,9 @@ module Path = struct
   let read_module_type env = function
     | Path.Pident id -> read_module_type_ident env id
 #if OCAML_VERSION >= (4,8,0)
-    | Path.Pdot(p, s) -> `Dot(read_module env p, s)
+    | Path.Pdot(p, s) -> `DotMT(read_module env p, ModuleTypeName.make_std s)
 #else
-    | Path.Pdot(p, s, _) -> `Dot(read_module env p, s)
+    | Path.Pdot(p, s, _) -> `DotMT(read_module env p, ModuleTypeName.make_std s)
 #endif
     | Path.Papply(_, _)-> assert false
 #if OCAML_VERSION >= (5,1,0)
@@ -742,9 +742,9 @@ module Path = struct
   let read_class_type env = function
     | Path.Pident id -> read_class_type_ident env id
 #if OCAML_VERSION >= (4,8,0)
-    | Path.Pdot(p, s) -> `Dot(read_module env p, strip_hash s)
+    | Path.Pdot(p, s) -> `DotT(read_module env p, TypeName.make_std (strip_hash s))
 #else
-    | Path.Pdot(p, s, _) -> `Dot(read_module env p, strip_hash s)
+    | Path.Pdot(p, s, _) -> `DotT(read_module env p, TypeName.make_std (strip_hash s))
 #endif
     | Path.Papply(_, _)-> assert false
 #if OCAML_VERSION >= (5,1,0)
@@ -758,9 +758,9 @@ module Path = struct
 #endif
     | Path.Pident id -> read_type_ident env id
 #if OCAML_VERSION >= (4,8,0)
-    | Path.Pdot(p, s) -> `Dot(read_module env p, strip_hash s)
+    | Path.Pdot(p, s) -> `DotT(read_module env p, TypeName.make_std (strip_hash s))
 #else
-    | Path.Pdot(p, s, _) -> `Dot(read_module env p, strip_hash s)
+    | Path.Pdot(p, s, _) -> `DotT(read_module env p, TypeName.make_std (strip_hash s))
 #endif
     | Path.Papply(_, _)-> assert false
 #if OCAML_VERSION >= (5,1,0)
@@ -770,9 +770,9 @@ module Path = struct
   let read_value env = function
     | Path.Pident id -> read_value_ident env id
 #if OCAML_VERSION >= (4,8,0)
-    | Path.Pdot(p, s) -> `Dot(read_module env p, s)
+    | Path.Pdot(p, s) -> `DotV(read_module env p, ValueName.make_std s)
 #else
-    | Path.Pdot(p, s, _) -> `Dot(read_module env p, s)
+    | Path.Pdot(p, s, _) -> `DotV(read_module env p, ValueName.make_std s)
 #endif
     | Path.Papply(_, _) -> assert false
 #if OCAML_VERSION >= (5,1,0)

src/loader/odoc_loader.ml

@@ -167,7 +167,7 @@ let read_cmt ~make_root ~parent ~filename () =
                   Odoc_model.Paths.Identifier.Mk.module_
                     (id, Odoc_model.Names.ModuleName.make_std name)
                 in
-                let path = `Root name in
+                let path = `Root (Odoc_model.Names.ModuleName.make_std name) in
                 { Odoc_model.Lang.Compilation_unit.Packed.id; path })
               items
           in

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/model/odoc_model.ml

@@ -9,3 +9,4 @@ module Error = Error
 module Location_ = Location_
 module Compat = Compat
 module Semantics = Semantics
+module Reference = Reference

src/model/paths.ml

@@ -715,9 +715,16 @@ module Path = struct
     | `SubstitutedMT r -> is_path_hidden (r :> any)
     | `SubstitutedT r -> is_path_hidden (r :> any)
     | `SubstitutedCT r -> is_path_hidden (r :> any)
-    | `Root s -> contains_double_underscore s
+    | `Root s -> ModuleName.is_hidden s
     | `Forward _ -> false
-    | `Dot (p, n) -> n.[0] = '{' || is_path_hidden (p : module_ :> any)
+    | `Dot (p, n) ->
+        ModuleName.is_hidden n || is_path_hidden (p : module_ :> any)
+    | `DotMT (p, n) ->
+        ModuleTypeName.is_hidden n || is_path_hidden (p : module_ :> any)
+    | `DotT (p, n) ->
+        TypeName.is_hidden n || is_path_hidden (p : module_ :> any)
+    | `DotV (p, n) ->
+        ValueName.is_hidden n || is_path_hidden (p : module_ :> any)
     | `Apply (p1, p2) ->
         is_path_hidden (p1 : module_ :> any)
         || is_path_hidden (p2 : module_ :> any)

src/model/paths_types.ml

@@ -321,37 +321,37 @@ module rec Path : sig
     [ `Resolved of Resolved_path.module_
     | `Identifier of Identifier.path_module * bool
     | `Substituted of module_
-    | `Root of string
+    | `Root of ModuleName.t
     | `Forward of string
-    | `Dot of module_ * string
+    | `Dot of module_ * ModuleName.t
     | `Apply of module_ * module_ ]
   (** @canonical Odoc_model.Paths.Path.Module.t *)
 
   type module_type =
     [ `Resolved of Resolved_path.module_type
     | `SubstitutedMT of module_type
     | `Identifier of Identifier.path_module_type * bool
-    | `Dot of module_ * string ]
+    | `DotMT of module_ * ModuleTypeName.t ]
   (** @canonical Odoc_model.Paths.Path.ModuleType.t *)
 
   type type_ =
     [ `Resolved of Resolved_path.type_
     | `SubstitutedT of type_
     | `Identifier of Identifier.path_type * bool
-    | `Dot of module_ * string ]
+    | `DotT of module_ * TypeName.t ]
   (** @canonical Odoc_model.Paths.Path.Type.t *)
 
   type value =
     [ `Resolved of Resolved_path.value
     | `Identifier of Identifier.path_value * bool
-    | `Dot of module_ * string ]
+    | `DotV of module_ * ValueName.t ]
   (** @canonical Odoc_model.Paths.Path.Value.t *)
 
   type class_type =
     [ `Resolved of Resolved_path.class_type
     | `SubstitutedCT of class_type
     | `Identifier of Identifier.path_class_type * bool
-    | `Dot of module_ * string ]
+    | `DotT of module_ * TypeName.t ]
   (** @canonical Odoc_model.Paths.Path.ClassType.t *)
 
   type any =
@@ -361,9 +361,12 @@ module rec Path : sig
     | `Substituted of module_
     | `SubstitutedCT of class_type
     | `Identifier of Identifier.path_any * bool
-    | `Root of string
+    | `Root of ModuleName.t
     | `Forward of string
-    | `Dot of module_ * string
+    | `Dot of module_ * ModuleName.t
+    | `DotT of module_ * TypeName.t
+    | `DotMT of module_ * ModuleTypeName.t
+    | `DotV of module_ * ValueName.t
     | `Apply of module_ * module_ ]
   (** @canonical Odoc_model.Paths.Path.t *)
 end =

src/model/reference.ml

@@ -1,3 +1,5 @@
+type path = [ `Root of string | `Dot of path * string ]
+
 let expected_err :
     (Format.formatter -> 'a -> unit) -> 'a -> Location_.span -> Error.t =
  fun pp_a a -> Error.make "Expected %a." pp_a a
@@ -536,10 +538,7 @@ let parse whole_reference_location s :
           should_not_be_empty ~what:"Reference target" whole_reference_location
           |> Error.raise_exception)
 
-type path = [ `Root of string | `Dot of Paths.Path.Module.t * string ]
-
 let read_path_longident location s =
-  let open Paths.Path in
   let rec loop : string -> int -> path option =
    fun s pos ->
     try
@@ -549,7 +548,7 @@ let read_path_longident location s =
       else
         match loop s (idx - 1) with
         | None -> None
-        | Some parent -> Some (`Dot ((parent :> Module.t), name))
+        | Some parent -> Some (`Dot (parent, name))
     with Not_found ->
       let name = String.sub s 0 (pos + 1) in
       if String.length name = 0 then None else Some (`Root name)

src/model/reference.mli

@@ -1,4 +1,4 @@
-type path = [ `Root of string | `Dot of Paths.Path.Module.t * string ]
+type path = [ `Root of string | `Dot of path * string ]
 
 val parse :
   Location_.span -> string -> Paths.Reference.t Error.with_errors_and_warnings

src/model/semantics.ml

@@ -10,8 +10,7 @@ type internal_tags_removed =
 type _ handle_internal_tags =
   | Expect_status
       : [ `Default | `Inline | `Open | `Closed ] handle_internal_tags
-  | Expect_canonical
-      : [ `Dot of Paths.Path.Module.t * string ] option handle_internal_tags
+  | Expect_canonical : Reference.path option handle_internal_tags
   | Expect_none : unit handle_internal_tags
 
 let describe_internal_tag = function