diff --git a/src/document/generator.ml b/src/document/generator.ml index 3c29852388..b3beecb0ed 100644 --- a/src/document/generator.ml +++ b/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 diff --git a/src/document/url.ml b/src/document/url.ml index b0d0771781..57864ee175 100644 --- a/src/document/url.ml +++ b/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" diff --git a/src/index/entry.ml b/src/index/entry.ml index 26aa98f78f..5f597e9cab 100644 --- a/src/index/entry.ml +++ b/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 diff --git a/src/index/entry.mli b/src/index/entry.mli index be3b4bb8dc..4415a0d49e 100644 --- a/src/index/entry.mli +++ b/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; } diff --git a/src/loader/doc_attr.ml b/src/loader/doc_attr.ml index 9ddcf3fc9f..287318f0c1 100644 --- a/src/loader/doc_attr.ml +++ b/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 diff --git a/src/loader/doc_attr.mli b/src/loader/doc_attr.mli index 5317601d65..792015a8ad 100644 --- a/src/loader/doc_attr.mli +++ b/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 diff --git a/src/loader/ident_env.cppo.ml b/src/loader/ident_env.cppo.ml index eef3e6d6b9..389dab488b 100644 --- a/src/loader/ident_env.cppo.ml +++ b/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) diff --git a/src/model/lang.ml b/src/model/lang.ml index 0ef3481e1e..8dc917a407 100644 --- a/src/model/lang.ml +++ b/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; } diff --git a/src/model/paths.ml b/src/model/paths.ml index 6a6366255c..7e8d21e428 100644 --- a/src/model/paths.ml +++ b/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) diff --git a/src/model/paths.mli b/src/model/paths.mli index 314053f5eb..e19dcae21f 100644 --- a/src/model/paths.mli +++ b/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 diff --git a/src/model/paths_types.ml b/src/model/paths_types.ml index de841313da..ac0d0cfc18 100644 --- a/src/model/paths_types.ml +++ b/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 diff --git a/src/model_desc/paths_desc.ml b/src/model_desc/paths_desc.ml index 2ff89541af..c3c4792a6d 100644 --- a/src/model_desc/paths_desc.ml +++ b/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", diff --git a/src/occurrences/odoc_occurrences.ml b/src/occurrences/odoc_occurrences.ml index 1bf5b40f1b..31bc9da042 100644 --- a/src/occurrences/odoc_occurrences.ml +++ b/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 diff --git a/src/xref2/compile.ml b/src/xref2/compile.ml index be7bd0067e..140ba42188 100644 --- a/src/xref2/compile.ml +++ b/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) diff --git a/src/xref2/component.ml b/src/xref2/component.ml index 7e7b79957a..9f08ccbd16 100644 --- a/src/xref2/component.ml +++ b/src/xref2/component.ml @@ -270,7 +270,7 @@ and TypeDecl : sig type t = { source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; doc : CComment.docs; - canonical : Odoc_model.Paths.Path.NonCoreType.t option; + canonical : Odoc_model.Paths.Path.Type.t option; equation : Equation.t; representation : Representation.t option; } @@ -429,8 +429,7 @@ and Substitution : sig | `Renamed of Ident.module_type ] type subst_type = - [ `Prefixed of Cpath.non_core_type * Cpath.Resolved.type_ - | `Renamed of Ident.type_ ] + [ `Prefixed of Cpath.type_ * Cpath.Resolved.type_ | `Renamed of Ident.type_ ] type subst_class_type = [ `Prefixed of Cpath.class_type * Cpath.Resolved.class_type @@ -1218,6 +1217,7 @@ module Fmt = struct config -> Format.formatter -> Cpath.Resolved.type_ -> unit = fun c ppf p -> match p with + | `CoreType n -> Format.fprintf ppf "%s" (TypeName.to_string n) | `Local id -> ident_fmt c ppf id | `Gpath p -> model_resolved_path c ppf (p :> rpath) | `Substituted x -> wrap c "substituted" resolved_type_path ppf x @@ -1253,15 +1253,14 @@ module Fmt = struct else Format.fprintf ppf ">>%a<<" (resolved_module_type_path c) m | `FragmentRoot -> Format.fprintf ppf "FragmentRoot" - and non_core_type_path : - config -> Format.formatter -> Cpath.non_core_type -> unit = + and type_path : config -> Format.formatter -> Cpath.type_ -> unit = fun c ppf p -> match p with | `Resolved r -> wrap c "resolved" resolved_type_path ppf r | `Identifier (id, b) -> wrap2 c "identifier" model_identifier bool ppf (id :> id) b | `Local (id, b) -> wrap2 c "local" ident_fmt bool ppf id b - | `Substituted s -> wrap c "substituted" non_core_type_path ppf s + | `Substituted s -> wrap c "substituted" type_path ppf s | `DotT (m, s) -> Format.fprintf ppf "%a.%a" (module_path c) m TypeName.fmt s | `Class (p, t) -> @@ -1274,12 +1273,6 @@ module Fmt = struct Format.fprintf ppf "%a.%s" (resolved_parent_path c) p (TypeName.to_string t) - and type_path : config -> Format.formatter -> Cpath.type_ -> unit = - fun c ppf p -> - match p with - | `CoreType x -> Format.fprintf ppf "%s" (TypeName.to_string x) - | #Cpath.non_core_type as x -> non_core_type_path c ppf x - and value_path : config -> Format.formatter -> Cpath.value -> unit = fun c ppf p -> match p with @@ -1332,7 +1325,6 @@ module Fmt = struct in match p with - | `CoreType n -> Format.fprintf ppf "%s" (TypeName.to_string n) | `Resolved rp -> wrap c "resolved" model_resolved_path ppf rp | `Identifier (id, b) -> wrap2 c "identifier" model_identifier bool ppf (id :> id) b @@ -1359,6 +1351,7 @@ module Fmt = struct and model_resolved_path (c : config) ppf (p : rpath) = let open Odoc_model.Paths.Path.Resolved in match p with + | `CoreType x -> Format.fprintf ppf "%s" (TypeName.to_string x) | `Identifier id -> Format.fprintf ppf "%a" (model_identifier c) (id :> id) | `Module (parent, name) -> Format.fprintf ppf "%a.%s" (model_resolved_path c) @@ -1959,6 +1952,7 @@ module Of_Lang = struct _ -> Odoc_model.Paths.Path.Resolved.Type.t -> Cpath.Resolved.type_ = fun ident_map p -> match p with + | `CoreType _ as c -> c | `Identifier i -> ( match identifier Maps.Path.Type.find ident_map.path_types i with | `Local l -> `Local l @@ -2028,25 +2022,17 @@ module Of_Lang = struct | `Local i -> `Local (i, b)) | `DotMT (path', x) -> `DotMT (module_path ident_map path', x) - and non_core_type_path : - _ -> Odoc_model.Paths.Path.NonCoreType.t -> Cpath.non_core_type = + and type_path : _ -> Odoc_model.Paths.Path.Type.t -> Cpath.type_ = fun ident_map p -> match p with | `Resolved r -> `Resolved (resolved_type_path ident_map r) - | `SubstitutedT t -> `Substituted (non_core_type_path ident_map t) + | `SubstitutedT t -> `Substituted (type_path ident_map t) | `Identifier (i, b) -> ( match identifier Maps.Path.Type.find ident_map.path_types i with | `Identifier i -> `Identifier (i, b) | `Local i -> `Local (i, b)) | `DotT (path', x) -> `DotT (module_path ident_map path', x) - and type_path : _ -> Odoc_model.Paths.Path.Type.t -> Cpath.type_ = - fun ident_map p -> - match p with - | `CoreType x -> `CoreType x - | #Odoc_model.Paths.Path.NonCoreType.t as x -> - (non_core_type_path ident_map x :> Cpath.type_) - and value_path : _ -> Odoc_model.Paths.Path.Value.t -> Cpath.value = fun ident_map p -> match p with diff --git a/src/xref2/component.mli b/src/xref2/component.mli index cbeddf4fb0..5e009dc2d6 100644 --- a/src/xref2/component.mli +++ b/src/xref2/component.mli @@ -259,7 +259,7 @@ and TypeDecl : sig type t = { source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; doc : CComment.docs; - canonical : Odoc_model.Paths.Path.NonCoreType.t option; + canonical : Odoc_model.Paths.Path.Type.t option; equation : Equation.t; representation : Representation.t option; } @@ -407,8 +407,7 @@ and Substitution : sig | `Renamed of Ident.module_type ] type subst_type = - [ `Prefixed of Cpath.non_core_type * Cpath.Resolved.type_ - | `Renamed of Ident.type_ ] + [ `Prefixed of Cpath.type_ * Cpath.Resolved.type_ | `Renamed of Ident.type_ ] type subst_class_type = [ `Prefixed of Cpath.class_type * Cpath.Resolved.class_type @@ -689,8 +688,7 @@ module Of_Lang : sig val module_type_path : map -> Odoc_model.Paths.Path.ModuleType.t -> Cpath.module_type - val non_core_type_path : - map -> Odoc_model.Paths.Path.NonCoreType.t -> Cpath.non_core_type + val type_path : map -> Odoc_model.Paths.Path.Type.t -> Cpath.type_ val value_path : map -> Odoc_model.Paths.Path.Value.t -> Cpath.value diff --git a/src/xref2/cpath.ml b/src/xref2/cpath.ml index 2ca27fb631..8eb67bf16d 100644 --- a/src/xref2/cpath.ml +++ b/src/xref2/cpath.ml @@ -31,7 +31,8 @@ module rec Resolved : sig [ `Local of Ident.type_ | `Gpath of Path.Resolved.Type.t | `Substituted of type_ - | `CanonicalType of type_ * Path.NonCoreType.t + | `CanonicalType of type_ * Path.Type.t + | `CoreType of TypeName.t | `Type of parent * TypeName.t | `Class of parent * TypeName.t | `ClassType of parent * TypeName.t ] @@ -68,9 +69,9 @@ and Cpath : sig | `DotMT of module_ * ModuleTypeName.t | `ModuleType of Resolved.parent * ModuleTypeName.t ] - and non_core_type = + and type_ = [ `Resolved of Resolved.type_ - | `Substituted of non_core_type + | `Substituted of type_ | `Local of Ident.type_ * bool | `Identifier of Odoc_model.Paths.Identifier.Path.Type.t * bool | `DotT of module_ * TypeName.t @@ -78,8 +79,6 @@ and Cpath : sig | `Class of Resolved.parent * TypeName.t | `ClassType of Resolved.parent * TypeName.t ] - type type_ = [ `CoreType of TypeName.t | non_core_type ] - and value = [ `Resolved of Resolved.value | `DotV of module_ * ValueName.t @@ -127,6 +126,7 @@ and is_resolved_module_type_substituted : Resolved.module_type -> bool = and is_resolved_type_substituted : Resolved.type_ -> bool = function | `Local _ -> false + | `CoreType _ -> false | `Substituted _ -> true | `Gpath _ -> false | `CanonicalType (t, _) -> is_resolved_type_substituted t @@ -158,7 +158,6 @@ let is_module_type_substituted : module_type -> bool = function | `ModuleType (a, _) -> is_resolved_parent_substituted a let is_type_substituted : type_ -> bool = function - | `CoreType _ -> false | `Resolved a -> is_resolved_type_substituted a | `Identifier _ -> false | `Local _ -> false @@ -249,12 +248,12 @@ and is_type_hidden : type_ -> bool = function | `Identifier ({ iv = `Class (_, t); _ }, b) -> b || TypeName.is_hidden t | `Local (_, b) -> b | `Substituted p -> is_type_hidden (p :> type_) - | `CoreType _ -> false | `DotT (p, _) -> is_module_hidden p | `Type (p, _) | `Class (p, _) | `ClassType (p, _) -> is_resolved_parent_hidden ~weak_canonical_test:false p and is_resolved_type_hidden : Resolved.type_ -> bool = function + | `CoreType n -> TypeName.is_hidden n | `Local _ -> false | `Gpath p -> Odoc_model.Paths.Path.Resolved.(is_hidden (p :> t)) | `Substituted p -> is_resolved_type_hidden p @@ -364,8 +363,8 @@ and unresolve_resolved_parent_path : Resolved.parent -> module_ = function | `Module m -> unresolve_resolved_module_path m | `FragmentRoot | `ModuleType _ -> assert false -and unresolve_resolved_type_path : Resolved.type_ -> non_core_type = function - | (`Gpath _ | `Local _) as p -> `Resolved p +and unresolve_resolved_type_path : Resolved.type_ -> type_ = function + | (`Gpath _ | `Local _ | `CoreType _) as p -> `Resolved p | `Substituted x -> unresolve_resolved_type_path x | `CanonicalType (t1, _) -> unresolve_resolved_type_path t1 | `Type (p, n) -> `DotT (unresolve_resolved_parent_path p, n) diff --git a/src/xref2/find.ml b/src/xref2/find.ml index fad642d0a1..7aabd3e1a1 100644 --- a/src/xref2/find.ml +++ b/src/xref2/find.ml @@ -7,6 +7,8 @@ type module_type = [ `FModuleType of ModuleTypeName.t * ModuleType.t ] type datatype = [ `FType of TypeName.t * TypeDecl.t ] +type core_type = [ `CoreType of TypeName.t ] + type class_ = [ `FClass of TypeName.t * Class.t | `FClassType of TypeName.t * ClassType.t ] @@ -127,7 +129,7 @@ type careful_module = [ module_ | `FModule_removed of Cpath.module_ ] type careful_module_type = [ module_type | `FModuleType_removed of ModuleType.expr ] -type careful_type = [ type_ | removed_type ] +type careful_type = [ type_ | removed_type | core_type ] type careful_class = [ class_ | removed_type ] diff --git a/src/xref2/find.mli b/src/xref2/find.mli index 33045ef4e9..4016e24478 100644 --- a/src/xref2/find.mli +++ b/src/xref2/find.mli @@ -113,7 +113,9 @@ type careful_module = [ module_ | `FModule_removed of Cpath.module_ ] type careful_module_type = [ module_type | `FModuleType_removed of ModuleType.expr ] -type careful_type = [ type_ | removed_type ] +type core_type = [ `CoreType of TypeName.t ] + +type careful_type = [ type_ | removed_type | core_type ] type careful_class = [ class_ | removed_type ] diff --git a/src/xref2/lang_of.ml b/src/xref2/lang_of.ml index f6e0d202a0..db8e0f304a 100644 --- a/src/xref2/lang_of.ml +++ b/src/xref2/lang_of.ml @@ -97,10 +97,9 @@ module Path = struct | `ModuleType (`Module p, n) -> `DotMT (`Resolved (resolved_module map p), n) | `ModuleType (_, _) -> failwith "Probably shouldn't happen" - and non_core_type map (p : Cpath.non_core_type) : - Odoc_model.Paths.Path.NonCoreType.t = + and type_ map (p : Cpath.type_) : Odoc_model.Paths.Path.Type.t = match p with - | `Substituted x -> `SubstitutedT (non_core_type map x) + | `Substituted x -> `SubstitutedT (type_ map x) | `Identifier (({ iv = #Odoc_model.Paths.Identifier.Path.Type.t_pv; _ } as y), b) -> `Identifier (y, b) @@ -112,12 +111,6 @@ module Path = struct | `ClassType (`Module p, n) -> `DotT (`Resolved (resolved_module map p), n) | `Type _ | `Class _ | `ClassType _ -> failwith "Probably shouldn't happen" - and type_ map (p : Cpath.type_) : Odoc_model.Paths.Path.Type.t = - match p with - | `CoreType x -> `CoreType x - | #Cpath.non_core_type as v -> - (non_core_type map v :> Odoc_model.Paths.Path.Type.t) - and class_type map (p : Cpath.class_type) : Odoc_model.Paths.Path.ClassType.t = match p with @@ -185,6 +178,7 @@ module Path = struct and resolved_type map (p : Cpath.Resolved.type_) : Odoc_model.Paths.Path.Resolved.Type.t = match p with + | `CoreType _ as c -> c | `Gpath y -> y | `Local id -> `Identifier (Component.TypeMap.find id map.path_type) | `CanonicalType (t1, t2) -> `CanonicalType (resolved_type map t1, t2) diff --git a/src/xref2/lang_of.mli b/src/xref2/lang_of.mli index 8c5950bda7..835c739210 100644 --- a/src/xref2/lang_of.mli +++ b/src/xref2/lang_of.mli @@ -16,7 +16,7 @@ module Path : sig val module_type : maps -> Cpath.module_type -> Path.ModuleType.t - val non_core_type : maps -> Cpath.non_core_type -> Path.NonCoreType.t + val type_ : maps -> Cpath.type_ -> Path.Type.t val class_type : maps -> Cpath.class_type -> Path.ClassType.t diff --git a/src/xref2/link.ml b/src/xref2/link.ml index 6bf3518bd8..6684315665 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -74,8 +74,9 @@ let expansion_needed self target = let hidden_alias = Paths.Path.Resolved.is_hidden self and self_canonical = let i = Paths.Path.Resolved.identifier self in - i = (target :> Paths.Identifier.t) + i = Some (target :> Paths.Identifier.t) in + self_canonical || hidden_alias exception Loop @@ -93,6 +94,7 @@ let rec should_reresolve : Paths.Path.Resolved.t -> bool = fun p -> let open Paths.Path.Resolved in match p with + | `CoreType _ -> false | `Identifier _ -> false | `Subst (x, y) -> should_reresolve (x :> t) || should_reresolve (y :> t) | `Hidden p -> should_reresolve (p :> t) @@ -130,22 +132,19 @@ let type_path : Env.t -> Paths.Path.Type.t -> Paths.Path.Type.t = fun env p -> if not (should_resolve (p :> Paths.Path.t)) then p else - match p with - | `CoreType _ as x -> x - | #Paths.Path.NonCoreType.t as p -> ( - let cp = Component.Of_Lang.(non_core_type_path (empty ()) p) in - match cp with - | `Resolved p -> - let result = Tools.reresolve_type env p in + let cp = Component.Of_Lang.(type_path (empty ()) p) in + match cp with + | `Resolved p -> + let result = Tools.reresolve_type env p in + `Resolved Lang_of.(Path.resolved_type (empty ()) result) + | _ -> ( + match Tools.resolve_type_path env cp with + | Ok p' -> + let result = Tools.reresolve_type env p' in `Resolved Lang_of.(Path.resolved_type (empty ()) result) - | #Cpath.non_core_type as cp -> ( - match Tools.resolve_type_path env cp with - | Ok p' -> - let result = Tools.reresolve_type env p' in - `Resolved Lang_of.(Path.resolved_type (empty ()) result) - | Error e -> - Errors.report ~what:(`Type_path cp) ~tools_error:e `Lookup; - p)) + | Error e -> + Errors.report ~what:(`Type_path cp) ~tools_error:e `Lookup; + p) let value_path : Env.t -> Paths.Path.Value.t -> Paths.Path.Value.t = fun env p -> @@ -925,7 +924,7 @@ and type_decl : Env.t -> Id.Signature.t -> TypeDecl.t -> TypeDecl.t = | Some (Constr (`Resolved path, params)) when Paths.Path.Resolved.(is_hidden (path :> t)) || Paths.Path.Resolved.(identifier (path :> t)) - = (t.id :> Paths.Identifier.t) -> + = Some (t.id :> Paths.Identifier.t) -> Some (path, params) | _ -> None in @@ -953,7 +952,9 @@ and type_decl : Env.t -> Id.Signature.t -> TypeDecl.t -> TypeDecl.t = with _ -> default.equation in { default with equation = type_decl_equation env parent equation } - | Ok (`FClass _ | `FClassType _ | `FType_removed _) | Error _ -> default) + | Ok (`FClass _ | `FClassType _ | `FType_removed _ | `CoreType _) + | Error _ -> + default) | None -> default and type_decl_equation env parent t = @@ -1047,15 +1048,12 @@ and type_expression : Env.t -> Id.Signature.t -> _ -> _ = type_expression env parent visited t1, type_expression env parent visited t2 ) | Tuple ts -> Tuple (List.map (type_expression env parent visited) ts) - | Constr ((`CoreType _ as x), ts) -> - let ts = List.map (type_expression env parent visited) ts in - Constr (x, ts) - | Constr ((#Paths.Path.NonCoreType.t as path'), ts') -> ( + | Constr (path', ts') -> ( let path = type_path env path' in let ts = List.map (type_expression env parent visited) ts' in if not (Paths.Path.is_hidden (path :> Paths.Path.t)) then Constr (path, ts) else - let cp = Component.Of_Lang.(non_core_type_path (empty ()) path') in + let cp = Component.Of_Lang.(type_path (empty ()) path') in match Tools.resolve_type env cp with | Ok (cp', `FType (_, t)) -> let cp' = Tools.reresolve_type env cp' in @@ -1090,7 +1088,7 @@ and type_expression : Env.t -> Id.Signature.t -> _ -> _ = Constr (`Resolved p, ts)) | _ -> Constr (`Resolved p, ts) else Constr (`Resolved p, ts) - | Ok (cp', (`FClass _ | `FClassType _)) -> + | Ok (cp', (`FClass _ | `FClassType _ | `CoreType _)) -> let p = Lang_of.(Path.resolved_type (empty ()) cp') in Constr (`Resolved p, ts) | Ok (_cp, `FType_removed (_, x, _eq)) -> diff --git a/src/xref2/shape_tools.cppo.ml b/src/xref2/shape_tools.cppo.ml index 4db1b4137e..c01ed5390b 100644 --- a/src/xref2/shape_tools.cppo.ml +++ b/src/xref2/shape_tools.cppo.ml @@ -105,7 +105,6 @@ let rec shape_of_kind_path env kind : | `SubstitutedCT t -> shape_of_kind_path env kind (t :> Odoc_model.Paths.Path.t) | `Identifier (id, _) -> shape_of_id env (id :> Odoc_model.Paths.Identifier.NonSrc.t) | `Substituted t -> shape_of_kind_path env kind (t :> Odoc_model.Paths.Path.t) - | `CoreType _ | `Forward _ | `Dot _ | `Root _ diff --git a/src/xref2/subst.ml b/src/xref2/subst.ml index 0abda57273..2e149045e9 100644 --- a/src/xref2/subst.ml +++ b/src/xref2/subst.ml @@ -43,8 +43,7 @@ let add_module_type id p rp t = module_type = ModuleTypeMap.add id (`Prefixed (p, rp)) t.module_type; } -let add_type : - Ident.type_ -> Cpath.non_core_type -> Cpath.Resolved.type_ -> t -> t = +let add_type : Ident.type_ -> Cpath.type_ -> Cpath.Resolved.type_ -> t -> t = fun id p rp t -> { t with type_ = TypeMap.add (id :> Ident.type_) (`Prefixed (p, rp)) t.type_ } @@ -56,7 +55,7 @@ let add_class : type_ = TypeMap.add (id :> Ident.type_) - (`Prefixed ((p :> Cpath.non_core_type), (rp :> Cpath.Resolved.type_))) + (`Prefixed ((p :> Cpath.type_), (rp :> Cpath.Resolved.type_))) t.type_; class_type = TypeMap.add (id :> Ident.type_) (`Prefixed (p, rp)) t.class_type; @@ -70,7 +69,7 @@ let add_class_type : type_ = TypeMap.add (id :> Ident.type_) - (`Prefixed ((p :> Cpath.non_core_type), (rp :> Cpath.Resolved.type_))) + (`Prefixed ((p :> Cpath.type_), (rp :> Cpath.Resolved.type_))) t.type_; class_type = TypeMap.add (id :> Ident.type_) (`Prefixed (p, rp)) t.class_type; @@ -315,6 +314,7 @@ and resolved_type_path : (Cpath.Resolved.type_, TypeExpr.t * TypeDecl.Equation.t) or_replaced = fun s p -> match p with + | `CoreType _ as c -> Not_replaced c | `Local id -> ( if TypeMap.mem id s.type_replacement then Replaced (TypeMap.find id s.type_replacement) @@ -334,17 +334,15 @@ and resolved_type_path : | `ClassType (p, n) -> Not_replaced (`ClassType (resolved_parent_path s p, n)) | `Class (p, n) -> Not_replaced (`Class (resolved_parent_path s p, n)) -and non_core_type_path : - t -> Cpath.non_core_type -> Cpath.non_core_type type_or_replaced = +and type_path : t -> Cpath.type_ -> Cpath.type_ type_or_replaced = fun s p -> match p with | `Resolved r -> ( try resolved_type_path s r |> map_replaced (fun r -> `Resolved r) with Invalidated -> let path' = Cpath.unresolve_resolved_type_path r in - non_core_type_path s path') - | `Substituted p -> - non_core_type_path s p |> map_replaced (fun r -> `Substituted r) + type_path s path') + | `Substituted p -> type_path s p |> map_replaced (fun r -> `Substituted r) | `Local (id, b) -> ( if TypeMap.mem id s.type_replacement then Replaced (TypeMap.find id s.type_replacement) @@ -359,13 +357,6 @@ and non_core_type_path : | `Class (p, n) -> Not_replaced (`Class (resolved_parent_path s p, n)) | `ClassType (p, n) -> Not_replaced (`ClassType (resolved_parent_path s p, n)) -and type_path : t -> Cpath.type_ -> Cpath.type_ type_or_replaced = - fun s p -> - match p with - | `CoreType x -> Not_replaced (`CoreType x) - | #Cpath.non_core_type as x -> - (non_core_type_path s x :> Cpath.type_ type_or_replaced) - and resolved_class_type_path : t -> Cpath.Resolved.class_type -> Cpath.Resolved.class_type = fun s p -> diff --git a/src/xref2/subst.mli b/src/xref2/subst.mli index 1d29017c50..6ca8300f7b 100644 --- a/src/xref2/subst.mli +++ b/src/xref2/subst.mli @@ -15,8 +15,7 @@ val add_module : val add_module_type : Ident.module_type -> Cpath.module_type -> Cpath.Resolved.module_type -> t -> t -val add_type : - Ident.type_ -> Cpath.non_core_type -> Cpath.Resolved.type_ -> t -> t +val add_type : Ident.type_ -> Cpath.type_ -> Cpath.Resolved.type_ -> t -> t val add_class : Ident.type_ -> Cpath.class_type -> Cpath.Resolved.class_type -> t -> t diff --git a/src/xref2/test.md b/src/xref2/test.md index 80e8c67bde..d48abbd261 100644 --- a/src/xref2/test.md +++ b/src/xref2/test.md @@ -3260,7 +3260,7 @@ let sg = Common.signature_of_mli_string test_data;; ihash = 1011043008; ikey = "v_{x}6/shadowed/(XXXX).m_Foo3.r_Root.p_None"}; source_loc = None; value = Odoc_model.Lang.Value.Abstract; doc = []; - type_ = Odoc_model.Lang.TypeExpr.Constr (`CoreType int, [])}; + type_ = Odoc_model.Lang.TypeExpr.Constr (`Resolved (`CoreType int), [])}; Odoc_model.Lang.Signature.Value {Odoc_model.Lang.Value.id = {Odoc_model__Paths_types.iv = diff --git a/src/xref2/tools.ml b/src/xref2/tools.ml index b32cfa8d5a..77f842d66c 100644 --- a/src/xref2/tools.ml +++ b/src/xref2/tools.ml @@ -531,6 +531,7 @@ and handle_module_type_lookup env id p sg sub = and handle_type_lookup env id p sg = match Find.careful_type_in_sig sg id with | Some (`FClass (name, _) as t) -> Ok (`Class (p, name), t) + | Some (`CoreType _ as c) -> Ok (c, c) | Some (`FClassType (name, _) as t) -> Ok (`ClassType (p, name), t) | Some (`FType (name, _) as t) -> Ok (simplify_type env (`Type (p, name)), t) | Some (`FType_removed (name, _, _) as t) -> Ok (`Type (p, name), t) @@ -740,10 +741,12 @@ and lookup_type_gpath : | Some (`FType (name, t)) -> Ok (`FType (name, Subst.type_ sub t)) | Some (`FType_removed (name, texpr, eq)) -> Ok (`FType_removed (name, Subst.type_expr sub texpr, eq)) + | Some (`CoreType _ as c) -> Ok c | None -> Error `Find_failure in let res = match p with + | `CoreType _ as c -> Ok c | `Identifier ({ iv = `Type _; _ } as i) -> of_option ~error:(`Lookup_failureT i) (Env.(lookup_by_id s_datatype) i env) @@ -836,6 +839,7 @@ and lookup_type : handle_type_lookup env name p sg >>= fun (_, t') -> let t = match t' with + | `CoreType _ as c -> c | `FClass (name, c) -> `FClass (name, Subst.class_ sub c) | `FClassType (name, ct) -> `FClassType (name, Subst.class_type sub ct) | `FType (name, t) -> `FType (name, Subst.type_ sub t) @@ -846,6 +850,7 @@ and lookup_type : in let res = match p with + | `CoreType _ as c -> Ok c | `Local id -> Error (`LocalType (env, id)) | `Gpath p -> lookup_type_gpath env p | `CanonicalType (t1, _) -> lookup_type env t1 @@ -998,7 +1003,7 @@ and resolve_module_type : |> map_error (fun e -> `Parent (`Parent_module_type e)) >>= fun (p, m) -> Ok (`Substituted p, m) -and resolve_type : Env.t -> Cpath.non_core_type -> resolve_type_result = +and resolve_type : Env.t -> Cpath.type_ -> resolve_type_result = fun env p -> let result = match p with @@ -1009,6 +1014,7 @@ and resolve_type : Env.t -> Cpath.non_core_type -> resolve_type_result = handle_type_lookup env id parent parent_sig >>= fun (p', t') -> let t = match t' with + | `CoreType _ as c -> c | `FClass (name, c) -> `FClass (name, Subst.class_ sub c) | `FClassType (name, ct) -> `FClassType (name, Subst.class_type sub ct) | `FType (name, t) -> `FType (name, Subst.type_ sub t) @@ -1046,6 +1052,7 @@ and resolve_type : Env.t -> Cpath.non_core_type -> resolve_type_result = handle_type_lookup env id parent parent_sg >>= fun (p', t') -> let t = match t' with + | `CoreType _ as c -> c | `FClass (name, c) -> `FClass (name, Subst.class_ sub c) | `FClassType (name, ct) -> `FClassType (name, Subst.class_type sub ct) | `FType (name, t) -> `FType (name, Subst.type_ sub t) @@ -1406,7 +1413,7 @@ and handle_canonical_module_type env p2 = | Some (rp, _) -> `Resolved Lang_of.(Path.resolved_module_type (empty ()) rp) and handle_canonical_type env p2 = - let cp2 = Component.Of_Lang.(non_core_type_path (empty ()) p2) in + let cp2 = Component.Of_Lang.(type_path (empty ()) p2) in let lang_of cpath = (Lang_of.(Path.resolved_type (empty ()) cpath) :> Odoc_model.Paths.Path.Resolved.t) @@ -1476,7 +1483,7 @@ and reresolve_type : Env.t -> Cpath.Resolved.type_ -> Cpath.Resolved.type_ = fun env path -> let result = match path with - | `Gpath _ | `Local _ -> path + | `Gpath _ | `Local _ | `CoreType _ -> path | `Substituted s -> `Substituted (reresolve_type env s) | `CanonicalType (p1, p2) -> `CanonicalType (reresolve_type env p1, handle_canonical_type env p2) @@ -2300,7 +2307,7 @@ and class_signature_of_class_type_expr : match e with | Signature s -> Some s | Constr (p, _) -> ( - match resolve_type env (p :> Cpath.non_core_type) with + match resolve_type env (p :> Cpath.type_) with | Ok (_, `FClass (_, c)) -> class_signature_of_class env c | Ok (_, `FClassType (_, c)) -> class_signature_of_class_type env c | _ -> None) diff --git a/src/xref2/tools.mli b/src/xref2/tools.mli index 0439445c34..bc54c338ca 100644 --- a/src/xref2/tools.mli +++ b/src/xref2/tools.mli @@ -98,7 +98,7 @@ val resolve_module_type : val resolve_type : Env.t -> - Cpath.non_core_type -> + Cpath.type_ -> ( Cpath.Resolved.type_ * Find.careful_type, simple_type_lookup_error ) Result.result @@ -140,7 +140,7 @@ val resolve_module_type_path : val resolve_type_path : Env.t -> - Cpath.non_core_type -> + Cpath.type_ -> (Cpath.Resolved.type_, simple_type_lookup_error) Result.result val resolve_value_path : diff --git a/test/xref2/classes.t/run.t b/test/xref2/classes.t/run.t index 54dc53836b..f83eb9bec8 100644 --- a/test/xref2/classes.t/run.t +++ b/test/xref2/classes.t/run.t @@ -136,7 +136,9 @@ resolve correctly. All of the 'Class' json objects should contain { "Constr": [ { - "`CoreType": "unit" + "`Resolved": { + "`CoreType": "unit" + } }, [] ] diff --git a/test/xref2/deep_substitution.t/run.t b/test/xref2/deep_substitution.t/run.t index 18cfef8973..3431498bac 100644 --- a/test/xref2/deep_substitution.t/run.t +++ b/test/xref2/deep_substitution.t/run.t @@ -46,7 +46,9 @@ its RHS correctly replaced with an `int` "Some": { "Constr": [ { - "`CoreType": "int" + "`Resolved": { + "`CoreType": "int" + } }, [] ] diff --git a/test/xref2/lib/common.cppo.ml b/test/xref2/lib/common.cppo.ml index 7742050b1b..3a7822761d 100644 --- a/test/xref2/lib/common.cppo.ml +++ b/test/xref2/lib/common.cppo.ml @@ -582,6 +582,7 @@ module LangUtils = struct | `Hidden _ | `SubstitutedT _ | `SubstitutedMT _ + | `CoreType _ | `Substituted _ | `SubstitutedCT _ | `Canonical _ -> Format.fprintf ppf "unimplemented resolved_path" @@ -598,7 +599,7 @@ module LangUtils = struct | `DotT (parent,s) -> Format.fprintf ppf "%a.%a" path (parent :> Odoc_model.Paths.Path.t) TypeName.fmt s | `DotV (parent,s) -> Format.fprintf ppf "%a.%a" path (parent :> Odoc_model.Paths.Path.t) ValueName.fmt s | `Apply (func,arg) -> Format.fprintf ppf "%a(%a)" path (func :> Odoc_model.Paths.Path.t) path (arg :> Odoc_model.Paths.Path.t) - | `SubstitutedT _|`SubstitutedMT _|`Substituted _|`SubstitutedCT _ | `CoreType _ -> Format.fprintf ppf "Unimplemented path" + | `SubstitutedT _|`SubstitutedMT _|`Substituted _|`SubstitutedCT _ -> Format.fprintf ppf "Unimplemented path" and model_fragment ppf (f : Odoc_model.Paths.Fragment.t) = match f with diff --git a/test/xref2/subst/test.md b/test/xref2/subst/test.md index 9e08c9aeea..1d6f9599fa 100644 --- a/test/xref2/subst/test.md +++ b/test/xref2/subst/test.md @@ -141,11 +141,11 @@ module SomeMonad/20 : module ComplexTypeExpr/19 : sig type t/28 - include r(Monad/21) with [resolved(root(Monad/21).t) = ([int * a] resolved(t/28) * [a * int] resolved(t/28))] + include r(Monad/21) with [resolved(root(Monad/21).t) = ([resolved(int) * a] resolved(t/28) * [a * resolved(int)] resolved(t/28))] (sig : - val map/29 : (([int * a] resolved(t/28) * [a * int] resolved(t/28))) -> ((a) -> b) -> ([int * b] resolved(t/28) * [b * int] resolved(t/28)) - val join/30 : (([int * ([int * a] resolved(t/28) * [a * int] resolved(t/28))] resolved(t/28) * [([int * a] resolved(t/28) * [a * int] resolved(t/28)) * int] resolved(t/28))) -> ([int * a] resolved(t/28) * [a * int] resolved(t/28)) - (removed=type (a) t = (([int * a] local(t/28,false) * [a * int] local(t/28,false)))) + val map/29 : (([resolved(int) * a] resolved(t/28) * [a * resolved(int)] resolved(t/28))) -> ((a) -> b) -> ([resolved(int) * b] resolved(t/28) * [b * resolved(int)] resolved(t/28)) + val join/30 : (([resolved(int) * ([resolved(int) * a] resolved(t/28) * [a * resolved(int)] resolved(t/28))] resolved(t/28) * [([resolved(int) * a] resolved(t/28) * [a * resolved(int)] resolved(t/28)) * resolved(int)] resolved(t/28))) -> ([resolved(int) * a] resolved(t/28) * [a * resolved(int)] resolved(t/28)) + (removed=type (a) t = (([resolved(int) * a] local(t/28,false) * [a * resolved(int)] local(t/28,false)))) end) end (canonical=None) module Erase/18 :