Drop id wrapper

CHANGES.md

@@ -1,6 +1,10 @@
 # Unreleased
 
 ### Added
+- Drop the cached `ikey`/`ihash` fields from identifiers (@jonludlam, #1479)
+- Remove the `'a Identifier.id` record wrapper (@jonludlam, #1479)
+- Hash-cons resolved module paths, so repeated paths are shared again in
+  `.odoc`/`.odocl` files (@jonludlam, #1479)
 - Support for OxCaml unboxed named types (@art-w, #1407)
 - Support for OxCaml zero alloc definitions (@Leonidas-from-XIV, #1422, #1444)
 - Support for OxCaml modalities (@art-w, #1420)

sherlodoc/index/load_doc.ml

@@ -144,21 +144,21 @@ let register_kind ~db elt =
 
 let rec categorize id =
   let open Odoc_model.Paths in
-  match id.Identifier.iv with
+  match id with
   | `Root _ | `Page _ | `LeafPage _ -> `definition
   | `ModuleType _ -> `declaration
   | `Parameter _ -> `ignore (* redundant with indexed signature *)
   | ( `InstanceVariable _ | `Method _ | `Field _ | `Result _ | `Label _ | `Type _
     | `Exception _ | `Class _ | `ClassType _ | `Value _ | `Constructor _ | `Extension _
     | `ExtensionDecl _ | `Module _ | `UnboxedField _ ) as x ->
-      let parent = Identifier.label_parent { id with iv = x } in
+      let parent = Identifier.label_parent x in
       categorize (parent :> Identifier.Any.t)
   | `AssetFile _ | `SourceLocationMod _ | `SourceLocation _ | `SourcePage _
   | `SourceLocationInternal _ ->
       `ignore (* unclear what to do with those *)
 
 let categorize Odoc_index.Entry.{ id; _ } =
-  match id.iv with
+  match id with
   | `ModuleType (parent, _) ->
       (* A module type itself is not *from* a module type, but it might be if one
        of its parents is a module type. *)

sherlodoc/index/typename.ml

@@ -3,13 +3,13 @@ module Identifier = Odoc_model.Paths.Identifier
 module TypeName = Odoc_model.Names.TypeName
 module ModuleName = Odoc_model.Names.ModuleName
 
-let rec show_ident_long h (r : Identifier.t_pv Identifier.id) =
-  match r.iv with
+let rec show_ident_long h (r : Identifier.t) =
+  match r with
   | `Type (md, n) -> Format.fprintf h "%a.%s" show_signature md (TypeName.to_string n)
   | _ -> Format.fprintf h "%S" (r |> Identifier.fullname |> String.concat ".")
 
 and show_signature h sig_ =
-  match sig_.iv with
+  match sig_ with
   | `Root (_, name) -> Format.fprintf h "%s" (ModuleName.to_string name)
   | `Module (pt, mdl) ->
       Format.fprintf h "%a.%s" show_signature pt (ModuleName.to_string mdl)

src/document/comment.ml

@@ -401,8 +401,7 @@ let heading_level_to_int = function
   | `Paragraph -> 4
   | `Subparagraph -> 5
 
-let heading
-    (attrs, { Odoc_model.Paths.Identifier.iv = `Label (_, label); _ }, text) =
+let heading (attrs, `Label (_, label), text) =
   let label = Odoc_model.Names.LabelName.to_string label in
   let title = inline_element_list text in
   let level = heading_level_to_int attrs.Comment.heading_level in

src/document/generator.ml

@@ -280,7 +280,7 @@ module Make (Syntax : SYNTAX) = struct
     let info_of_info : Lang.Source_info.annotation -> Source_page.info option =
       function
       | Definition id -> (
-          match id.iv with
+          match id with
           | `SourceLocation (_, def) -> Some (Anchor (DefName.to_string def))
           | `SourceLocationInternal (_, local) ->
               Some (Anchor (LocalName.to_string local))
@@ -549,7 +549,7 @@ module Make (Syntax : SYNTAX) = struct
             match lbl with None -> O.noop | Some lbl -> label lbl ++ O.txt ":"
           in
           let name =
-            match m_arg.id.iv with
+            match m_arg.id with
             | `Parameter (_, name) -> ModuleName.to_string name
           in
           let dst = type_expr dst in
@@ -1387,37 +1387,37 @@ module Make (Syntax : SYNTAX) = struct
   end = struct
     let internal_module m =
       let open Lang.Module in
-      match m.id.iv with
+      match m.id with
       | `Module (_, name) when ModuleName.is_hidden name -> true
       | _ -> false
 
     let internal_type t =
       let open Lang.TypeDecl in
-      match t.id.iv with
+      match t.id with
       | `Type (_, name) when TypeName.is_hidden name -> true
       | _ -> false
 
     let internal_value v =
       let open Lang.Value in
-      match v.id.iv with
+      match v.id with
       | `Value (_, name) when ValueName.is_hidden name -> true
       | _ -> false
 
     let internal_module_type t =
       let open Lang.ModuleType in
-      match t.id.iv with
+      match t.id with
       | `ModuleType (_, name) when ModuleTypeName.is_hidden name -> true
       | _ -> false
 
     let internal_module_substitution t =
       let open Lang.ModuleSubstitution in
-      match t.id.iv with
+      match t.id with
       | `Module (_, name) when ModuleName.is_hidden name -> true
       | _ -> false
 
     let internal_module_type_substitution t =
       let open Lang.ModuleTypeSubstitution in
-      match t.id.iv with
+      match t.id with
       | `ModuleType (_, name) when ModuleTypeName.is_hidden name -> true
       | _ -> false
 
@@ -1995,7 +1995,7 @@ module Make (Syntax : SYNTAX) = struct
 
     let page (t : Odoc_model.Lang.Page.t) =
       (*let name =
-          match t.name.iv with `Page (_, name) | `LeafPage (_, name) -> name
+          match t.name with `Page (_, name) | `LeafPage (_, name) -> name
         in*)
       (*let title = Odoc_model.Names.PageName.to_string name in*)
       let url = Url.Path.from_identifier t.name in

src/document/sidebar.ml

@@ -98,7 +98,7 @@ end = struct
                   | Some t -> t
                   | None ->
                       let name =
-                        match entry.id.iv with
+                        match entry.id with
                         | `LeafPage (Some parent, name)
                           when Astring.String.equal
                                  (Names.PageName.to_string name)

src/document/url.ml

@@ -69,15 +69,10 @@ let render_path : Path.t -> string =
   render_path
 
 module Path = struct
-  type nonsrc_pv =
-    [ Identifier.Page.t_pv
-    | Identifier.Signature.t_pv
-    | Identifier.ClassSignature.t_pv ]
+  type nonsrc =
+    [ Identifier.Page.t | Identifier.Signature.t | Identifier.ClassSignature.t ]
 
-  type any_pv =
-    [ nonsrc_pv | Identifier.SourcePage.t_pv | Identifier.AssetFile.t_pv ]
-
-  and any = any_pv Identifier.id
+  type any = [ nonsrc | Identifier.SourcePage.t | Identifier.AssetFile.t ]
 
   type kind =
     [ `Module
@@ -114,7 +109,7 @@ module Path = struct
   let rec from_identifier : any -> t =
    fun x ->
     match x with
-    | { iv = `Root (parent, unit_name); _ } ->
+    | `Root (parent, unit_name) ->
         let parent =
           match parent with
           | Some p -> Some (from_identifier (p :> any))
@@ -123,7 +118,7 @@ module Path = struct
         let kind = `Module in
         let name = ModuleName.to_string unit_name in
         mk ?parent kind name
-    | { iv = `Page (parent, page_name); _ } ->
+    | `Page (parent, page_name) ->
         let parent =
           match parent with
           | Some p -> Some (from_identifier (p :> any))
@@ -132,7 +127,7 @@ module Path = struct
         let kind = `Page in
         let name = PageName.to_string page_name in
         mk ?parent kind name
-    | { iv = `LeafPage (parent, page_name); _ } ->
+    | `LeafPage (parent, page_name) ->
         let parent =
           match parent with
           | Some p -> Some (from_identifier (p :> any))
@@ -141,44 +136,44 @@ module Path = struct
         let kind = `LeafPage in
         let name = PageName.to_string page_name in
         mk ?parent kind name
-    | { iv = `Module (parent, mod_name); _ } ->
+    | `Module (parent, mod_name) ->
         let parent = from_identifier (parent :> any) in
         let kind = `Module in
         let name = ModuleName.to_string mod_name in
         mk ~parent kind name
-    | { iv = `Parameter (functor_id, arg_name); _ } as p ->
+    | `Parameter (functor_id, arg_name) as p ->
         let parent = from_identifier (functor_id :> any) in
         let arg_num = Identifier.FunctorParameter.functor_arg_pos p in
         let kind = `Parameter arg_num in
         let name = ModuleName.to_string arg_name in
         mk ~parent kind name
-    | { iv = `ModuleType (parent, modt_name); _ } ->
+    | `ModuleType (parent, modt_name) ->
         let parent = from_identifier (parent :> any) in
         let kind = `ModuleType in
         let name = ModuleTypeName.to_string modt_name in
         mk ~parent kind name
-    | { iv = `Class (parent, name); _ } ->
+    | `Class (parent, name) ->
         let parent = from_identifier (parent :> any) in
         let kind = `Class in
         let name = TypeName.to_string name in
         mk ~parent kind name
-    | { iv = `ClassType (parent, name); _ } ->
+    | `ClassType (parent, name) ->
         let parent = from_identifier (parent :> any) in
         let kind = `ClassType in
         let name = TypeName.to_string name in
         mk ~parent kind name
-    | { iv = `Result p; _ } -> from_identifier (p :> any)
-    | { iv = `SourcePage (parent, name); _ } ->
+    | `Result p -> from_identifier (p :> any)
+    | `SourcePage (parent, name) ->
         let parent = from_identifier (parent :> any) in
         let kind = `SourcePage in
         mk ~parent kind name
-    | { iv = `AssetFile (parent, name); _ } ->
+    | `AssetFile (parent, name) ->
         let parent = from_identifier (parent :> any) in
         let kind = `File in
         let name = AssetName.to_string name in
         mk ~parent kind name
 
-  let from_identifier p = from_identifier (p : [< any_pv ] Identifier.id :> any)
+  let from_identifier p = from_identifier (p : [< any ] :> any)
 
   let to_list url =
     let rec loop acc { parent; name; kind } =
@@ -274,35 +269,33 @@ module Anchor = struct
   let suffix_for_constructor x = x
 
   let rec from_identifier : Identifier.t -> t = function
-    | { iv = `Module (parent, mod_name); _ } ->
+    | `Module (parent, mod_name) ->
         let parent = Path.from_identifier (parent :> Path.any) in
         let kind = `Module in
         let anchor =
           Printf.sprintf "%s-%s" (Path.string_of_kind kind)
             (ModuleName.to_string mod_name)
         in
         { page = parent; anchor; kind }
-    | { iv = `Root _; _ } as p ->
+    | `Root _ as p ->
         let page = Path.from_identifier (p :> Path.any) in
         { page; kind = `Module; anchor = "" }
-    | { iv = `Page _; _ } as p ->
+    | `Page _ as p ->
         let page = Path.from_identifier (p :> Path.any) in
         { page; kind = `Page; anchor = "" }
-    | { iv = `LeafPage _; _ } as p ->
+    | `LeafPage _ as p ->
         let page = Path.from_identifier (p :> Path.any) in
         { page; kind = `LeafPage; anchor = "" }
     (* For all these identifiers, page names and anchors are the same *)
-    | {
-        iv = `Parameter _ | `Result _ | `ModuleType _ | `Class _ | `ClassType _;
-        _;
-      } as p ->
+    | (`Parameter _ | `Result _ | `ModuleType _ | `Class _ | `ClassType _) as p
+      ->
         anchorify_path @@ Path.from_identifier p
-    | { iv = `Type (parent, type_name); _ } ->
+    | `Type (parent, type_name) ->
         let page = Path.from_identifier (parent :> Path.any) in
         let kind = `Type in
         let name = TypeName.to_string type_name in
         { page; anchor = Format.asprintf "%a-%s" pp_kind kind name; kind }
-    | { iv = `Extension (parent, name); _ } ->
+    | `Extension (parent, name) ->
         let page = Path.from_identifier (parent :> Path.any) in
         let kind = `Extension in
         {
@@ -311,7 +304,7 @@ module Anchor = struct
             Format.asprintf "%a-%s" pp_kind kind (ExtensionName.to_string name);
           kind;
         }
-    | { iv = `ExtensionDecl (parent, name, _); _ } ->
+    | `ExtensionDecl (parent, name, _) ->
         let page = Path.from_identifier (parent :> Path.any) in
         let kind = `ExtensionDecl in
         {
@@ -320,7 +313,7 @@ module Anchor = struct
             Format.asprintf "%a-%s" pp_kind kind (ExtensionName.to_string name);
           kind;
         }
-    | { iv = `Exception (parent, name); _ } ->
+    | `Exception (parent, name) ->
         let page = Path.from_identifier (parent :> Path.any) in
         let kind = `Exception in
         {
@@ -329,7 +322,7 @@ module Anchor = struct
             Format.asprintf "%a-%s" pp_kind kind (ExceptionName.to_string name);
           kind;
         }
-    | { iv = `Value (parent, name); _ } ->
+    | `Value (parent, name) ->
         let page = Path.from_identifier (parent :> Path.any) in
         let kind = `Val in
         {
@@ -338,53 +331,52 @@ module Anchor = struct
             Format.asprintf "%a-%s" pp_kind kind (ValueName.to_string name);
           kind;
         }
-    | { iv = `Method (parent, name); _ } ->
+    | `Method (parent, name) ->
         let str_name = MethodName.to_string name in
         let page = Path.from_identifier (parent :> Path.any) in
         let kind = `Method in
         { page; anchor = Format.asprintf "%a-%s" pp_kind kind str_name; kind }
-    | { iv = `InstanceVariable (parent, name); _ } ->
+    | `InstanceVariable (parent, name) ->
         let str_name = InstanceVariableName.to_string name in
         let page = Path.from_identifier (parent :> Path.any) in
         let kind = `Val in
         { page; anchor = Format.asprintf "%a-%s" pp_kind kind str_name; kind }
-    | { iv = `Constructor (parent, name); _ } ->
+    | `Constructor (parent, name) ->
         let page = from_identifier (parent :> Identifier.t) in
         let kind = `Constructor in
         let suffix = suffix_for_constructor (ConstructorName.to_string name) in
         add_suffix ~kind page suffix
-    | { iv = `Field (parent, name); _ } ->
+    | `Field (parent, name) ->
         let page = from_identifier (parent :> Identifier.t) in
         let kind = `Field in
         let suffix = FieldName.to_string name in
         add_suffix ~kind page suffix
-    | { iv = `UnboxedField (parent, name); _ } ->
+    | `UnboxedField (parent, name) ->
         let page = from_identifier (parent :> Identifier.t) in
         let kind = `UnboxedField in
         let suffix = UnboxedFieldName.to_string name in
         add_suffix ~kind page suffix
-    | { iv = `Label (parent, anchor); _ } -> (
+    | `Label (parent, anchor) -> (
         let str_name = LabelName.to_string anchor in
         (* [Identifier.LabelParent.t] contains datatypes. [`CoreType] can't
            happen, [`Type] may not happen either but just in case, use the
            grand-parent. *)
         match parent with
-        | { iv = `Type (gp, _); _ } -> mk ~kind:`Section gp str_name
-        | { iv = #Path.nonsrc_pv; _ } as p ->
-            mk ~kind:`Section (p :> Path.any) str_name)
-    | { iv = `SourceLocation (parent, loc); _ } ->
+        | `Type (gp, _) -> mk ~kind:`Section gp str_name
+        | #Path.nonsrc as p -> mk ~kind:`Section (p :> Path.any) str_name)
+    | `SourceLocation (parent, loc) ->
         let page = Path.from_identifier (parent :> Path.any) in
         { page; kind = `SourceAnchor; anchor = DefName.to_string loc }
-    | { iv = `SourceLocationInternal (parent, loc); _ } ->
+    | `SourceLocationInternal (parent, loc) ->
         let page = Path.from_identifier (parent :> Path.any) in
         { page; kind = `SourceAnchor; anchor = LocalName.to_string loc }
-    | { iv = `SourceLocationMod parent; _ } ->
+    | `SourceLocationMod parent ->
         let page = Path.from_identifier (parent :> Path.any) in
         { page; kind = `SourceAnchor; anchor = "" }
-    | { iv = `SourcePage _; _ } as p ->
+    | `SourcePage _ as p ->
         let page = Path.from_identifier (p :> Path.any) in
         { page; kind = `Page; anchor = "" }
-    | { iv = `AssetFile _; _ } as p ->
+    | `AssetFile _ as p ->
         let page = Path.from_identifier p in
         { page; kind = `File; anchor = "" }
 
@@ -429,8 +421,7 @@ let from_path page =
 
 let from_identifier ~stop_before x =
   match x with
-  | { Identifier.iv = #Path.any_pv; _ } as p when not stop_before ->
-      from_path @@ Path.from_identifier p
+  | #Path.any as p when not stop_before -> from_path @@ Path.from_identifier p
   | p -> Anchor.from_identifier p
 
 let from_asset_identifier p = from_path @@ Path.from_identifier p