Paths to core types are resolved instead of unresolved

src/document/generator.ml

@@ -103,8 +103,6 @@ module Make (Syntax : SYNTAX) = struct
       match path with
       | `Identifier (id, _) ->
           unresolved [ inline @@ Text (Identifier.name id) ]
-      | `CoreType n ->
-          O.elt [ inline @@ Text (Odoc_model.Names.TypeName.to_string n) ]
       | `Substituted m -> from_path (m :> Path.t)
       | `SubstitutedMT m -> from_path (m :> Path.t)
       | `SubstitutedT m -> from_path (m :> Path.t)
@@ -130,7 +128,7 @@ module Make (Syntax : SYNTAX) = struct
       | `Resolved _ when Paths.Path.is_hidden path ->
           let txt = Url.render_path path in
           unresolved [ inline @@ Text txt ]
-      | `Resolved rp ->
+      | `Resolved rp -> (
           (* If the path is pointing to an opaque module or module type
              there won't be a page generated - so we stop before; at
              the parent page, and link instead to the anchor representing
@@ -140,10 +138,12 @@ module Make (Syntax : SYNTAX) = struct
             | `OpaqueModule _ | `OpaqueModuleType _ -> true
             | _ -> false
           in
-          let id = Paths.Path.Resolved.identifier rp in
-          let txt = Url.render_path path in
-          let href = Url.from_identifier ~stop_before id in
-          resolved href [ inline @@ Text txt ]
+          let txt = [ inline @@ Text (Url.render_path path) ] in
+          match Paths.Path.Resolved.identifier rp with
+          | Some id ->
+              let href = Url.from_identifier ~stop_before id in
+              resolved href txt
+          | None -> O.elt txt)
 
     let dot prefix suffix = prefix ^ "." ^ suffix
 

src/document/url.ml

@@ -7,6 +7,7 @@ let render_path : Path.t -> string =
     let open Path.Resolved in
     function
     | `Identifier id -> Identifier.name id
+    | `CoreType n -> TypeName.to_string n
     | `OpaqueModule p -> render_resolved (p :> t)
     | `OpaqueModuleType p -> render_resolved (p :> t)
     | `Subst (_, p) -> render_resolved (p :> t)
@@ -61,7 +62,6 @@ let render_path : Path.t -> string =
     | `SubstitutedMT m -> render_path (m :> Path.t)
     | `SubstitutedT m -> render_path (m :> Path.t)
     | `SubstitutedCT m -> render_path (m :> Path.t)
-    | `CoreType n -> TypeName.to_string n
   in
 
   render_path
@@ -375,13 +375,8 @@ module Anchor = struct
   let polymorphic_variant ~type_ident elt =
     let name_of_type_constr te =
       match te with
-      | Odoc_model.Lang.TypeExpr.Constr
-          ((#Odoc_model.Paths.Path.NonCoreType.t as path), _) ->
-          render_path
-            (path
-              : Odoc_model.Paths.Path.NonCoreType.t
-              :> Odoc_model.Paths.Path.t)
-      | Odoc_model.Lang.TypeExpr.Constr (`CoreType n, _) -> TypeName.to_string n
+      | Odoc_model.Lang.TypeExpr.Constr (path, _) ->
+          render_path (path :> Odoc_model.Paths.Path.t)
       | _ ->
           invalid_arg
             "DocOckHtml.Url.Polymorphic_variant_decl.name_of_type_constr"

src/index/entry.ml

@@ -2,7 +2,7 @@ open Odoc_model.Lang
 open Odoc_model.Paths
 
 type type_decl_entry = {
-  canonical : Path.NonCoreType.t option;
+  canonical : Path.Type.t option;
   equation : TypeDecl.Equation.t;
   representation : TypeDecl.Representation.t option;
 }
@@ -174,7 +174,8 @@ let entries_of_item (x : Fold.item) =
         match exc.res with
         | None ->
             TypeExpr.Constr
-              (`CoreType (Odoc_model.Names.TypeName.make_std "exn"), [])
+              ( `Resolved (`CoreType (Odoc_model.Names.TypeName.make_std "exn")),
+                [] )
         | Some x -> x
       in
       let kind = Exception { args = exc.args; res } in

src/index/entry.mli

@@ -2,7 +2,7 @@ open Odoc_model.Lang
 open Odoc_model.Paths
 
 type type_decl_entry = {
-  canonical : Path.NonCoreType.t option;
+  canonical : Path.Type.t option;
   equation : TypeDecl.Equation.t;
   representation : TypeDecl.Representation.t option;
 }

src/loader/doc_attr.ml

@@ -266,7 +266,7 @@ let rec conv_canonical_module : Odoc_model.Reference.path -> Paths.Path.Module.t
   | `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.NonCoreType.t option = function
+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
 

src/loader/doc_attr.mli

@@ -72,7 +72,6 @@ val extract_top_comment_class :
 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.NonCoreType.t option
+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

@@ -681,7 +681,9 @@ module Path = struct
     with Not_found -> assert false
 
   let read_type_ident env id =
-    match find_type env id with Some id -> `Identifier (id , false) | None -> `CoreType (TypeName.of_ident id)
+    match find_type env id with
+    | Some id -> `Identifier (id , false)
+    | None -> `Resolved (`CoreType (TypeName.of_ident id))
 
   let read_value_ident env id : Paths.Path.Value.t =
     `Identifier (find_value_identifier env id, false)

src/model/lang.ml

@@ -253,7 +253,7 @@ and TypeDecl : sig
     id : Identifier.Type.t;
     source_loc : Identifier.SourceLocation.t option;
     doc : Comment.docs;
-    canonical : Path.NonCoreType.t option;
+    canonical : Path.Type.t option;
     equation : Equation.t;
     representation : Representation.t option;
   }

src/model/paths.ml

@@ -656,6 +656,7 @@ module Path = struct
       | `ModuleType (_, m) when Names.ModuleTypeName.is_hidden m -> true
       | `ModuleType (p, _) -> inner (p : module_ :> any)
       | `Type (_, t) when Names.TypeName.is_hidden t -> true
+      | `CoreType t -> Names.TypeName.is_hidden t
       | `Type (p, _) -> inner (p : module_ :> any)
       | `Value (_, t) when Names.ValueName.is_hidden t -> true
       | `Value (p, _) -> inner (p : module_ :> any)
@@ -685,7 +686,6 @@ module Path = struct
   and is_path_hidden : Paths_types.Path.any -> bool =
     let open Paths_types.Path in
     function
-    | `CoreType _ -> false
     | `Resolved r -> is_resolved_hidden ~weak_canonical_test:false r
     | `Identifier (_, hidden) -> hidden
     | `Substituted r -> is_path_hidden (r :> any)
@@ -752,7 +752,23 @@ module Path = struct
     end
 
     module ModuleType = struct
+      type old_t = t
+
       type t = Paths_types.Resolved_path.module_type
+
+      let rec identifier : t -> Identifier.ModuleType.t = function
+        | `Identifier id -> id
+        | `ModuleType (m, n) ->
+            Identifier.Mk.module_type (parent_module_identifier m, n)
+        | `AliasModuleType (sub, orig) ->
+            if is_resolved_hidden ~weak_canonical_test:false (sub :> old_t) then
+              identifier (orig :> t)
+            else identifier (sub :> t)
+        | `SubstT (p, _) -> identifier (p :> t)
+        | `CanonicalModuleType (_, `Resolved p) -> identifier (p :> t)
+        | `CanonicalModuleType (p, _) -> identifier (p :> t)
+        | `OpaqueModuleType mt -> identifier (mt :> t)
+        | `SubstitutedMT m -> identifier (m :> t)
     end
 
     module Type = struct
@@ -767,21 +783,26 @@ module Path = struct
       type t = Paths_types.Resolved_path.class_type
     end
 
-    let rec identifier : t -> Identifier.t = function
-      | `Identifier id -> id
+    let rec identifier : t -> Identifier.t option = function
+      | `Identifier id -> Some id
+      | `CoreType _ -> None
       | `Subst (sub, _) -> identifier (sub :> t)
       | `Hidden p -> identifier (p :> t)
-      | `Module (m, n) -> Identifier.Mk.module_ (parent_module_identifier m, n)
+      | `Module (m, n) ->
+          Some (Identifier.Mk.module_ (parent_module_identifier m, n))
       | `Canonical (_, `Resolved p) -> identifier (p :> t)
       | `Canonical (p, _) -> identifier (p :> t)
       | `Apply (m, _) -> identifier (m :> t)
-      | `Type (m, n) -> Identifier.Mk.type_ (parent_module_identifier m, n)
-      | `Value (m, n) -> Identifier.Mk.value (parent_module_identifier m, n)
+      | `Type (m, n) ->
+          Some (Identifier.Mk.type_ (parent_module_identifier m, n))
+      | `Value (m, n) ->
+          Some (Identifier.Mk.value (parent_module_identifier m, n))
       | `ModuleType (m, n) ->
-          Identifier.Mk.module_type (parent_module_identifier m, n)
-      | `Class (m, n) -> Identifier.Mk.class_ (parent_module_identifier m, n)
+          Some (Identifier.Mk.module_type (parent_module_identifier m, n))
+      | `Class (m, n) ->
+          Some (Identifier.Mk.class_ (parent_module_identifier m, n))
       | `ClassType (m, n) ->
-          Identifier.Mk.class_type (parent_module_identifier m, n)
+          Some (Identifier.Mk.class_type (parent_module_identifier m, n))
       | `Alias (dest, `Resolved src) ->
           if is_resolved_hidden ~weak_canonical_test:false (dest :> t) then
             identifier (src :> t)
@@ -814,10 +835,6 @@ module Path = struct
     type t = Paths_types.Path.module_type
   end
 
-  module NonCoreType = struct
-    type t = Paths_types.Path.non_core_type
-  end
-
   module Type = struct
     type t = Paths_types.Path.type_
   end
@@ -868,7 +885,7 @@ module Fragment = struct
     let rec identifier : t -> Identifier.t = function
       | `Root (`ModuleType _r) -> assert false
       | `Root (`Module _r) -> assert false
-      | `Subst (s, _) -> Path.Resolved.identifier (s :> Path.Resolved.t)
+      | `Subst (s, _) -> (Path.Resolved.ModuleType.identifier s :> Identifier.t)
       | `Alias (p, _) ->
           (Path.Resolved.parent_module_identifier p :> Identifier.t)
       | `Module (m, n) -> Identifier.Mk.module_ (Signature.sgidentifier m, n)

src/model/paths.mli

@@ -389,7 +389,8 @@ module rec Path : sig
 
     type t = Paths_types.Resolved_path.any
 
-    val identifier : t -> Identifier.t
+    val identifier : t -> Identifier.t option
+    (** If the path points to a core type, no identifier can be generated *)
 
     val is_hidden : t -> bool
   end
@@ -408,10 +409,6 @@ module rec Path : sig
     type t = Paths_types.Path.type_
   end
 
-  module NonCoreType : sig
-    type t = Paths_types.Path.non_core_type
-  end
-
   module Value : sig
     type t = Paths_types.Path.value
   end

src/model/paths_types.ml

@@ -326,14 +326,11 @@ module rec Path : sig
     | `DotMT of module_ * ModuleTypeName.t ]
   (** @canonical Odoc_model.Paths.Path.ModuleType.t *)
 
-  type non_core_type =
+  type type_ =
     [ `Resolved of Resolved_path.type_
-    | `SubstitutedT of non_core_type
+    | `SubstitutedT of type_
     | `Identifier of Identifier.path_type * bool
     | `DotT of module_ * TypeName.t ]
-  (** @canonical Odoc_model.Paths.Path.NonCoreType.t *)
-
-  type type_ = [ non_core_type | `CoreType of TypeName.t ]
   (** @canonical Odoc_model.Paths.Path.Type.t *)
 
   type value =
@@ -351,9 +348,8 @@ module rec Path : sig
 
   type any =
     [ `Resolved of Resolved_path.any
-    | `SubstitutedT of non_core_type
+    | `SubstitutedT of type_
     | `SubstitutedMT of module_type
-    | `CoreType of TypeName.t
     | `Substituted of module_
     | `SubstitutedCT of class_type
     | `Identifier of Identifier.path_any * bool
@@ -405,10 +401,11 @@ and Resolved_path : sig
     [ `Identifier of Identifier.path_type
     | `SubstitutedT of type_
     | `SubstitutedCT of class_type
-    | `CanonicalType of type_ * Path.non_core_type
+    | `CanonicalType of type_ * Path.type_
     | `Type of module_ * TypeName.t
     | `Class of module_ * TypeName.t
-    | `ClassType of module_ * TypeName.t ]
+    | `ClassType of module_ * TypeName.t
+    | `CoreType of TypeName.t ]
   (** @canonical Odoc_model.Paths.Path.Resolved.Type.t *)
 
   type any =
@@ -435,7 +432,8 @@ and Resolved_path : sig
     | `ClassType of module_ * TypeName.t
     | `Class of module_ * TypeName.t
     | `Value of module_ * ValueName.t
-    | `ClassType of module_ * TypeName.t ]
+    | `ClassType of module_ * TypeName.t
+    | `CoreType of TypeName.t ]
   (** @canonical Odoc_model.Paths.Path.Resolved.t *)
 end =
   Resolved_path

src/model_desc/paths_desc.ml

@@ -226,13 +226,13 @@ module General_paths = struct
       | `Substituted m -> C ("`Substituted", (m :> p), path)
       | `SubstitutedMT m -> C ("`SubstitutedMT", (m :> p), path)
       | `SubstitutedT m -> C ("`SubstitutedT", (m :> p), path)
-      | `SubstitutedCT m -> C ("`SubstitutedCT", (m :> p), path)
-      | `CoreType n -> C ("`CoreType", n, Names.typename))
+      | `SubstitutedCT m -> C ("`SubstitutedCT", (m :> p), path))
 
   and resolved_path : rp t =
     Variant
       (function
       | `Identifier x -> C ("`Identifier", x, identifier)
+      | `CoreType n -> C ("`CoreType", n, Names.typename)
       | `Subst (x1, x2) ->
           C
             ( "`Subst",

src/occurrences/odoc_occurrences.ml

@@ -5,7 +5,9 @@ let of_impl ~include_hidden unit htbl =
     let open Odoc_model.Paths.Path.Resolved in
     let p = (p :> t) in
     let id = identifier p in
-    if (not (is_hidden p)) || include_hidden then Table.add tbl id
+    match id with
+    | Some id when (not (is_hidden p)) || include_hidden -> Table.add tbl id
+    | _ -> ()
   in
   let open Odoc_model.Lang in
   List.iter

src/xref2/compile.ml

@@ -15,9 +15,8 @@ let type_path : Env.t -> Paths.Path.Type.t -> Paths.Path.Type.t =
  fun env p ->
   match p with
   | `Resolved _ -> p
-  | `CoreType _ as x -> x
-  | #Paths.Path.NonCoreType.t as p -> (
-      let cp = Component.Of_Lang.(non_core_type_path (empty ()) p) in
+  | _ -> (
+      let cp = Component.Of_Lang.(type_path (empty ()) p) in
       match Tools.resolve_type_path env cp with
       | Ok p' -> `Resolved Lang_of.(Path.resolved_type (empty ()) p')
       | Error _ -> p)
@@ -864,23 +863,19 @@ and type_expression : Env.t -> Id.LabelParent.t -> _ -> _ =
   | Arrow (lbl, t1, t2) ->
       Arrow (lbl, type_expression env parent t1, type_expression env parent t2)
   | Tuple ts -> Tuple (List.map (type_expression env parent) ts)
-  | Constr ((`CoreType _ as x), ts) ->
-      let ts = List.map (type_expression env parent) ts in
-      Constr (x, ts)
-  | Constr ((#Odoc_model.Paths.Path.NonCoreType.t as path), ts') -> (
-      let cp = Component.Of_Lang.(non_core_type_path (empty ()) path) in
+  | Constr (path, ts') -> (
+      let cp = Component.Of_Lang.(type_path (empty ()) path) in
       let ts = List.map (type_expression env parent) ts' in
       match Tools.resolve_type env cp with
-      | Ok (cp, (`FType _ | `FClass _ | `FClassType _)) ->
+      | Ok (cp, (`FType _ | `FClass _ | `FClassType _ | `CoreType _)) ->
           let p = Lang_of.(Path.resolved_type (empty ()) cp) in
           Constr (`Resolved p, ts)
       | Ok (_cp, `FType_removed (_, x, _eq)) ->
           (* Substitute type variables ? *)
           Lang_of.(type_expr (empty ()) parent x)
       | Error _e ->
-          Constr
-            ( (Lang_of.(Path.non_core_type (empty ()) cp) :> Paths.Path.Type.t),
-              ts ))
+          Constr ((Lang_of.(Path.type_ (empty ()) cp) :> Paths.Path.Type.t), ts)
+      )
   | Polymorphic_variant v ->
       Polymorphic_variant (type_expression_polyvar env parent v)
   | Object o -> Object (type_expression_object env parent o)