Misc more optimisations

src/document/comment.ml

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

src/document/url.ml

@@ -4,12 +4,13 @@ open Odoc_model.Names
 module Root = Odoc_model.Root
 
 let functor_arg_pos : Odoc_model.Paths.Identifier.FunctorParameter.t -> int =
- fun { Odoc_model.Paths.iv = `Parameter (p, _); _ } ->
-  let rec inner_sig = function
-    | `Result { Odoc_model.Paths.iv = p; _ } -> 1 + inner_sig p
-    | `Module _ | `ModuleType _ | `Root _ | `Parameter _ -> 1
-  in
-  inner_sig p.Odoc_model.Paths.iv
+  let open Odoc_model.Paths.Identifier in
+  fun { iv = `Parameter (p, _); _ } ->
+    let rec inner_sig = function
+      | `Result { iv = p; _ } -> 1 + inner_sig p
+      | `Module _ | `ModuleType _ | `Root _ | `Parameter _ -> 1
+    in
+    inner_sig p.iv
 
 let render_path : Odoc_model.Paths.Path.t -> string =
   let open Odoc_model.Paths.Path in
@@ -90,7 +91,7 @@ module Path = struct
     | Identifier.Signature.t_pv
     | Identifier.ClassSignature.t_pv ]
 
-  and source = source_pv Odoc_model.Paths.id
+  and source = source_pv Odoc_model.Paths.Identifier.id
 
   type kind =
     [ `Module
@@ -158,7 +159,7 @@ module Path = struct
         let kind = `Argument in
         let arg_num = functor_arg_pos p in
         let page =
-          Printf.sprintf "%d-%s" arg_num (ParameterName.to_string arg_name)
+          Printf.sprintf "%d-%s" arg_num (ModuleName.to_string arg_name)
         in
         mk ~parent kind page
     | { iv = `ModuleType (parent, modt_name); _ } ->
@@ -179,7 +180,8 @@ module Path = struct
     | { iv = `Result p; _ } -> from_identifier (p :> source)
 
   let from_identifier p =
-    from_identifier (p : [< source_pv ] Odoc_model.Paths.id :> source)
+    from_identifier
+      (p : [< source_pv ] Odoc_model.Paths.Identifier.id :> source)
 
   let to_list url =
     let rec loop acc { parent; name; kind } =
@@ -401,7 +403,8 @@ let from_path page =
   { Anchor.page; anchor = ""; kind = (page.kind :> Anchor.kind) }
 
 let from_identifier ~stop_before = function
-  | { Odoc_model.Paths.iv = #Path.source_pv; _ } as p when not stop_before ->
+  | { Odoc_model.Paths.Identifier.iv = #Path.source_pv; _ } as p
+    when not stop_before ->
       Ok (from_path @@ Path.from_identifier p)
   | p -> Anchor.from_identifier p
 

src/document/url.mli

@@ -33,9 +33,9 @@ module Path : sig
     | Identifier.Signature.t_pv
     | Identifier.ClassSignature.t_pv ]
 
-  and source = source_pv Odoc_model.Paths.id
+  and source = source_pv Odoc_model.Paths.Identifier.id
 
-  val from_identifier : [< source_pv ] Odoc_model.Paths.id -> t
+  val from_identifier : [< source_pv ] Odoc_model.Paths.Identifier.id -> t
 
   val to_list : t -> (kind * string) list
 

src/document/utils.mli

@@ -0,0 +1,6 @@
+val option_of_result : ('a, 'b) Result.result -> 'a option
+val flatmap : ?sep:'a list -> f:('b -> 'a list) -> 'b list -> 'a list
+val skip_until : p:('a -> bool) -> 'a list -> 'a list
+val split_at : f:('a -> bool) -> 'a list -> 'a list * 'a list
+val compute_length_source : Types.Source.t -> int
+val compute_length_inline : Types.Inline.t -> int

src/loader/cmi.ml

@@ -921,10 +921,10 @@ let rec read_module_type env parent (mty : Odoc_model.Compat.module_type) =
           | Unit -> Odoc_model.Lang.FunctorParameter.Unit, env
           | Named (id_opt, arg) ->
               let name, env = match id_opt with
-                | Some id -> Ident.name id,  Env.add_parameter parent id (ParameterName.of_ident id) env
+                | Some id -> Ident.name id,  Env.add_parameter parent id (ModuleName.of_ident id) env
                 | None -> "_", env
               in
-              let id = Identifier.Mk.parameter(parent, Odoc_model.Names.ParameterName.make_std name) in
+              let id = Identifier.Mk.parameter(parent, Odoc_model.Names.ModuleName.make_std name) in
               let arg = read_module_type env id arg in
               Odoc_model.Lang.FunctorParameter.Named ({ FunctorParameter. id; expr = arg }), env
         in

src/loader/cmt.ml

@@ -366,10 +366,10 @@ let rec read_module_expr env parent label_parent mexpr =
           | Named (id_opt, _, arg) ->
               let name, env =
                 match id_opt with
-                | Some id -> Ident.name id, Env.add_parameter parent id (ParameterName.of_ident id) env
+                | Some id -> Ident.name id, Env.add_parameter parent id (ModuleName.of_ident id) env
                 | None -> "_", env
               in
-              let id = Identifier.Mk.parameter (parent, Odoc_model.Names.ParameterName.make_std name) in
+              let id = Identifier.Mk.parameter (parent, Odoc_model.Names.ModuleName.make_std name) in
               let arg = Cmti.read_module_type env id label_parent arg in
 
               Named { id; expr=arg }, env
@@ -383,11 +383,11 @@ let rec read_module_expr env parent label_parent mexpr =
           | None -> FunctorParameter.Unit
           | Some arg ->
               let name = Ident.name id in
-              let id = Identifier.Mk.parameter (parent, ParameterName.make_std name) in
+              let id = Identifier.Mk.parameter (parent, ModuleName.make_std name) in
           let arg = Cmti.read_module_type env id label_parent arg in
           Named { FunctorParameter. id; expr = arg; }
         in
-        let env = Env.add_parameter parent id (ParameterName.of_ident id) env in
+        let env = Env.add_parameter parent id (ModuleName.of_ident id) env in
         let res = read_module_expr env (Identifier.Mk.result parent) label_parent res in
         Functor(f_parameter, res)
 #endif

src/loader/cmti.ml

@@ -520,10 +520,10 @@ and read_module_type env parent label_parent mty =
             let name, env =
               match id_opt with
               | Some id ->
-                 Ident.name id, Env.add_parameter parent id (ParameterName.of_ident id) env
+                 Ident.name id, Env.add_parameter parent id (ModuleName.of_ident id) env
               | None -> "_", env
             in
-            let id = Identifier.Mk.parameter (parent, ParameterName.make_std name) in
+            let id = Identifier.Mk.parameter (parent, ModuleName.make_std name) in
             let arg = read_module_type env id label_parent arg in
             Named { id; expr = arg; }, env
         in
@@ -536,11 +536,11 @@ and read_module_type env parent label_parent mty =
           | None -> Odoc_model.Lang.FunctorParameter.Unit
           | Some arg ->
               let name = Ident.name id in
-              let id = Identifier.Mk.parameter (parent, Odoc_model.Names.ParameterName.make_std name) in
+              let id = Identifier.Mk.parameter (parent, Odoc_model.Names.ModuleName.make_std name) in
               let arg = read_module_type env id label_parent arg in
               Named { FunctorParameter. id; expr = arg }
         in
-        let env = Env.add_parameter parent id (ParameterName.of_ident id) env in
+        let env = Env.add_parameter parent id (ModuleName.of_ident id) env in
         let res = read_module_type env (Identifier.Mk.result parent) label_parent res in
         Functor( f_parameter, res)
 #endif

src/loader/ident_env.cppo.ml

@@ -478,8 +478,7 @@ let handle_signature_type_items : Paths.Identifier.Signature.t -> Compat.signatu
     env_of_items parent items env
 
 let add_parameter parent id name env =
-
-  let hidden = ParameterName.is_hidden name in
+  let hidden = ModuleName.is_hidden name in
   let path = `Identifier (Odoc_model.Paths.Identifier.Mk.parameter(parent, name), hidden) in
   let module_paths = Ident.add id path env.module_paths in
   { env with module_paths }

src/loader/ident_env.cppo.mli

@@ -21,7 +21,7 @@ type t
 val empty : t
 
 val add_parameter :
-  Paths.Identifier.Signature.t -> Ident.t -> Names.ParameterName.t -> t -> t
+  Paths.Identifier.Signature.t -> Ident.t -> Names.ModuleName.t -> t -> t
 
 val handle_signature_type_items :
   Paths.Identifier.Signature.t -> Compat.signature -> t -> t

src/model/names.ml

@@ -128,7 +128,6 @@ module SimpleName : SimpleName = struct
 end
 
 module ModuleName = Name
-module ParameterName = Name
 module ModuleTypeName = Name
 module TypeName = Name
 module ConstructorName = SimpleName

src/model/names.mli

@@ -70,8 +70,6 @@ end
 
 module ModuleName : Name
 
-module ParameterName : Name
-
 module ModuleTypeName : Name
 
 module TypeName : Name

src/model/paths.ml

@@ -16,9 +16,9 @@
 
 open Names
 
-type 'a id = 'a Paths_types.id = { iv : 'a; ihash : int; ikey : string }
-
 module Identifier = struct
+  type 'a id = 'a Paths_types.id = { iv : 'a; ihash : int; ikey : string }
+
   type t = Paths_types.Identifier.any
 
   type t_pv = Paths_types.Identifier.any_pv
@@ -30,7 +30,7 @@ module Identifier = struct
     | `Page (_, name) -> PageName.to_string name
     | `LeafPage (_, name) -> PageName.to_string name
     | `Module (_, name) -> ModuleName.to_string name
-    | `Parameter (_, name) -> ParameterName.to_string name
+    | `Parameter (_, name) -> ModuleName.to_string name
     | `Result x -> name_aux (x :> t)
     | `ModuleType (_, name) -> ModuleTypeName.to_string name
     | `Type (_, name) -> TypeName.to_string name
@@ -157,6 +157,8 @@ module Identifier = struct
   module RootModule = struct
     type t = Paths_types.Identifier.root_module
 
+    type t_pv = Paths_types.Identifier.root_module_pv
+
     let equal = equal
 
     let hash = hash
@@ -191,6 +193,8 @@ module Identifier = struct
   module FunctorResult = struct
     type t = Paths_types.Identifier.functor_result
 
+    type t_pv = Paths_types.Identifier.functor_result_pv
+
     let equal = equal
 
     let hash = hash
@@ -225,6 +229,8 @@ module Identifier = struct
   module Constructor = struct
     type t = Paths_types.Identifier.constructor
 
+    type t_pv = Paths_types.Identifier.constructor_pv
+
     let equal = equal
 
     let hash = hash
@@ -235,6 +241,8 @@ module Identifier = struct
   module Field = struct
     type t = Paths_types.Identifier.field
 
+    type t_pv = Paths_types.Identifier.field_pv
+
     let equal = equal
 
     let hash = hash
@@ -245,6 +253,8 @@ module Identifier = struct
   module Extension = struct
     type t = Paths_types.Identifier.extension
 
+    type t_pv = Paths_types.Identifier.extension_pv
+
     let equal = equal
 
     let hash = hash
@@ -255,6 +265,8 @@ module Identifier = struct
   module Exception = struct
     type t = Paths_types.Identifier.exception_
 
+    type t_pv = Paths_types.Identifier.exception_pv
+
     let equal = equal
 
     let hash = hash
@@ -265,6 +277,8 @@ module Identifier = struct
   module Value = struct
     type t = Paths_types.Identifier.value
 
+    type t_pv = Paths_types.Identifier.value_pv
+
     let equal = equal
 
     let hash = hash
@@ -275,6 +289,8 @@ module Identifier = struct
   module Class = struct
     type t = Paths_types.Identifier.class_
 
+    type t_pv = Paths_types.Identifier.class_pv
+
     let equal = equal
 
     let hash = hash
@@ -285,6 +301,8 @@ module Identifier = struct
   module ClassType = struct
     type t = Paths_types.Identifier.class_type
 
+    type t_pv = Paths_types.Identifier.class_type_pv
+
     let equal = equal
 
     let hash = hash
@@ -295,6 +313,8 @@ module Identifier = struct
   module Method = struct
     type t = Paths_types.Identifier.method_
 
+    type t_pv = Paths_types.Identifier.method_pv
+
     let equal = equal
 
     let hash = hash
@@ -305,6 +325,8 @@ module Identifier = struct
   module InstanceVariable = struct
     type t = Paths_types.Identifier.instance_variable
 
+    type t_pv = Paths_types.Identifier.instance_variable_pv
+
     let equal = equal
 
     let hash = hash
@@ -339,6 +361,8 @@ module Identifier = struct
   module ContainerPage = struct
     type t = Paths_types.Identifier.container_page
 
+    type t_pv = Paths_types.Identifier.container_page_pv
+
     let equal = equal
 
     let hash = hash
@@ -349,6 +373,8 @@ module Identifier = struct
   module OdocId = struct
     type t = Paths_types.Identifier.odoc_id
 
+    type t_pv = Paths_types.Identifier.odoc_id_pv
+
     let equal = equal
 
     let hash = hash
@@ -466,9 +492,9 @@ module Identifier = struct
       mk_parent ModuleName.to_string "m" (fun (p, n) -> `Module (p, n))
 
     let parameter :
-        Signature.t * ParameterName.t ->
-        [> `Parameter of Signature.t * ParameterName.t ] id =
-      mk_parent ParameterName.to_string "p" (fun (p, n) -> `Parameter (p, n))
+        Signature.t * ModuleName.t ->
+        [> `Parameter of Signature.t * ModuleName.t ] id =
+      mk_parent ModuleName.to_string "p" (fun (p, n) -> `Parameter (p, n))
 
     let result : Signature.t -> [> `Result of Signature.t ] id =
      fun s ->