diff --git a/.github/workflows/oxcaml.yml b/.github/workflows/oxcaml.yml index 1acd116727..af0d19c922 100644 --- a/.github/workflows/oxcaml.yml +++ b/.github/workflows/oxcaml.yml @@ -33,8 +33,9 @@ jobs: # Do not pin odoc to not break Mdx installation opam-pin: ${{ matrix.run-mdx != true }} opam-repositories: | - oxcaml: "git+https://github.com/oxcaml/opam-repository.git" + oxcaml: "git+https://github.com/art-w/oxcaml-opam-repository#dune322" default: "git+https://github.com/ocaml/opam-repository.git" + # TODO: use "git+https://github.com/oxcaml/opam-repository.git" once #39 is merged - name: Install dependencies run: | diff --git a/CHANGES.md b/CHANGES.md index a8a70a41be..757800e115 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -12,6 +12,7 @@ invocation, eliminating the need for shell scripting (@davesnx, #1387) - Support for OxCaml (@lukemaurer, @art-w, #1399) - OCaml 5.5.0 support (@panglesd, @xvw, #1406) +- Support for OxCaml unboxed named types (@art-w, #1407) ### Fixed - Fix compile-time crashing bugs #930 and #1385 (@jonludlam, #1400) diff --git a/sherlodoc/index/typename.ml b/sherlodoc/index/typename.ml index 979f2e6e09..b611f32d40 100644 --- a/sherlodoc/index/typename.ml +++ b/sherlodoc/index/typename.ml @@ -36,5 +36,6 @@ let rec show_type_name_verbose h : Path.Type.t -> _ = function (Odoc_document.Url.render_path (mdl :> Path.t)) (Odoc_model.Names.TypeName.to_string x) | `SubstitutedT x -> show_type_name_verbose h x + | `Unbox x -> Format.fprintf h "%a#" show_type_name_verbose x let to_string t = Format.asprintf "%a" show_type_name_verbose t diff --git a/src/document/generator.ml b/src/document/generator.ml index 0e481f582c..5e261b7e11 100644 --- a/src/document/generator.ml +++ b/src/document/generator.ml @@ -108,6 +108,7 @@ 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) + | `Unbox t -> from_path (t :> Path.t) | `Root root -> unresolved [ inline @@ Text (ModuleName.to_string root) ] | `Forward root -> unresolved [ inline @@ Text root ] (* FIXME *) | `Dot (prefix, suffix) -> diff --git a/src/document/url.ml b/src/document/url.ml index 87f1fce429..2b982cf14e 100644 --- a/src/document/url.ml +++ b/src/document/url.ml @@ -44,6 +44,7 @@ let render_path : 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 + | `Unbox p -> render_resolved (p :> t) ^ "#" and dot p s = render_path (p : Path.Module.t :> Path.t) ^ "." ^ s and render_path : Path.t -> string = fun x -> @@ -62,6 +63,7 @@ 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) + | `Unbox t -> render_path (t :> Path.t) in render_path @@ -298,12 +300,8 @@ module Anchor = struct | { iv = `Type (parent, type_name); _ } -> let page = Path.from_identifier (parent :> Path.any) in let kind = `Type in - { - page; - anchor = - Format.asprintf "%a-%s" pp_kind kind (TypeName.to_string type_name); - kind; - } + let name = TypeName.to_string type_name in + { page; anchor = Format.asprintf "%a-%s" pp_kind kind name; kind } | { iv = `Extension (parent, name); _ } -> let page = Path.from_identifier (parent :> Path.any) in let kind = `Extension in diff --git a/src/loader/ident_env.ml b/src/loader/ident_env.ml index 99e7e59dce..ade7db97a4 100644 --- a/src/loader/ident_env.ml +++ b/src/loader/ident_env.ml @@ -836,11 +836,16 @@ module Path = struct #endif | Path.Pident id -> read_type_ident env id #if OCAML_VERSION >= (4,8,0) - | Path.Pdot(p, s) -> `DotT(read_module env p, TypeName.make_std (strip_hash s)) + | Path.Pdot(p, s) -> #else - | Path.Pdot(p, s, _) -> `DotT(read_module env p, TypeName.make_std (strip_hash s)) + | Path.Pdot(p, s, _) -> #endif + `DotT(read_module env p, TypeName.make_std (strip_hash s)) | Path.Papply(_, _)-> assert false +#if defined OXCAML + | Path.Pextra_ty (p, Punboxed_ty) -> + `Unbox (read_type env p) +#endif #if OCAML_VERSION >= (5,1,0) | Path.Pextra_ty (p,_) -> read_type env p #endif diff --git a/src/model/paths.ml b/src/model/paths.ml index 9d26fdad87..408479d8d6 100644 --- a/src/model/paths.ml +++ b/src/model/paths.ml @@ -730,6 +730,7 @@ module Path = struct | `CanonicalType (x, _) -> inner (x : type_ :> any) | `OpaqueModule m -> inner (m :> any) | `OpaqueModuleType mt -> inner (mt :> any) + | `Unbox mt -> inner (mt :> any) in inner x @@ -742,6 +743,7 @@ module Path = struct | `SubstitutedMT r -> is_path_hidden (r :> any) | `SubstitutedT r -> is_path_hidden (r :> any) | `SubstitutedCT r -> is_path_hidden (r :> any) + | `Unbox r -> is_path_hidden (r :> any) | `Root s -> ModuleName.is_hidden s | `Forward _ -> false | `Dot (p, n) -> @@ -867,6 +869,7 @@ module Path = struct | `SubstitutedMT m -> identifier (m :> t) | `SubstitutedCT m -> identifier (m :> t) | `SubstitutedT m -> identifier (m :> t) + | `Unbox m -> identifier (m :> t) let is_hidden r = is_resolved_hidden ~weak_canonical_test:false r end diff --git a/src/model/paths_types.ml b/src/model/paths_types.ml index 3550ffadaf..197949c687 100644 --- a/src/model/paths_types.ml +++ b/src/model/paths_types.ml @@ -347,7 +347,8 @@ module rec Path : sig [ `Resolved of Resolved_path.type_ | `SubstitutedT of type_ | `Identifier of Identifier.path_type * bool - | `DotT of module_ * TypeName.t ] + | `DotT of module_ * TypeName.t + | `Unbox of type_ ] (** @canonical Odoc_model.Paths.Path.Type.t *) type value = @@ -376,7 +377,8 @@ module rec Path : sig | `DotT of module_ * TypeName.t | `DotMT of module_ * ModuleTypeName.t | `DotV of module_ * ValueName.t - | `Apply of module_ * module_ ] + | `Apply of module_ * module_ + | `Unbox of type_ ] (** @canonical Odoc_model.Paths.Path.t *) end = Path @@ -422,7 +424,8 @@ and Resolved_path : sig | `Type of module_ * TypeName.t | `Class of module_ * TypeName.t | `ClassType of module_ * TypeName.t - | `CoreType of TypeName.t ] + | `CoreType of TypeName.t + | `Unbox of type_ ] (** @canonical Odoc_model.Paths.Path.Resolved.Type.t *) type any = @@ -450,7 +453,8 @@ and Resolved_path : sig | `Class of module_ * TypeName.t | `Value of module_ * ValueName.t | `ClassType of module_ * TypeName.t - | `CoreType of TypeName.t ] + | `CoreType of TypeName.t + | `Unbox of type_ ] (** @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 7edea31b8e..5082f02206 100644 --- a/src/model_desc/paths_desc.ml +++ b/src/model_desc/paths_desc.ml @@ -234,7 +234,8 @@ 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)) + | `SubstitutedCT m -> C ("`SubstitutedCT", (m :> p), path) + | `Unbox x -> C ("`Unbox", (x :> p), path)) and resolved_path : rp t = Variant @@ -299,7 +300,8 @@ module General_paths = struct | `Substituted c -> C ("`Substituted", (c :> rp), resolved_path) | `SubstitutedMT c -> C ("`SubstitutedMT", (c :> rp), resolved_path) | `SubstitutedT c -> C ("`SubstitutedT", (c :> rp), resolved_path) - | `SubstitutedCT c -> C ("`SubstitutedCT", (c :> rp), resolved_path)) + | `SubstitutedCT c -> C ("`SubstitutedCT", (c :> rp), resolved_path) + | `Unbox c -> C ("`Unbox", (c :> rp), resolved_path)) and hierarchy_reference : Paths.Reference.Hierarchy.t t = let tag_page_path = diff --git a/src/xref2/component.ml b/src/xref2/component.ml index 12d633813b..2676337fc5 100644 --- a/src/xref2/component.ml +++ b/src/xref2/component.ml @@ -1307,6 +1307,7 @@ module Fmt = struct | `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 + | `Unbox x -> wrap c "unbox" resolved_type_path ppf x | `CanonicalType (t1, t2) -> wrap2 c "canonicaltype" resolved_type_path model_path ppf t1 (t2 :> path) @@ -1358,6 +1359,7 @@ module Fmt = struct | `Type (p, t) -> Format.fprintf ppf "%a.%s" (resolved_parent_path c) p (TypeName.to_string t) + | `Unbox t -> Format.fprintf ppf "%a#" (type_path c) t and value_path : config -> Format.formatter -> Cpath.value -> unit = fun c ppf p -> @@ -1433,6 +1435,7 @@ module Fmt = struct wrap c "substitutedt" model_path ppf (m :> Odoc_model.Paths.Path.t) | `SubstitutedCT m -> wrap c "substitutedct" model_path ppf (m :> Odoc_model.Paths.Path.t) + | `Unbox t -> wrap c "unbox" model_path ppf (t :> Odoc_model.Paths.Path.t) and model_resolved_path (c : config) ppf (p : rpath) = let open Odoc_model.Paths.Path.Resolved in @@ -1506,6 +1509,7 @@ module Fmt = struct | `SubstitutedT m -> wrap c "substitutedt" model_resolved_path ppf (m :> t) | `SubstitutedCT m -> wrap c "substitutedct" model_resolved_path ppf (m :> t) + | `Unbox t -> wrap c "unbox" model_resolved_path ppf (t :> t) and model_fragment c ppf (f : Odoc_model.Paths.Fragment.t) = match f with @@ -2061,6 +2065,7 @@ module Of_Lang = struct | `SubstitutedCT m -> `Substituted (resolved_class_type_path ident_map m :> Cpath.Resolved.type_) + | `Unbox m -> `Unbox (resolved_type_path ident_map m) and resolved_value_path : _ -> Odoc_model.Paths.Path.Resolved.Value.t -> Cpath.Resolved.value = @@ -2125,6 +2130,7 @@ module Of_Lang = struct | `Identifier i -> `Identifier (i, b) | `Local i -> `Local (i, b)) | `DotT (path', x) -> `DotT (module_path ident_map path', x) + | `Unbox t -> `Unbox (type_path ident_map t) and value_path : _ -> Odoc_model.Paths.Path.Value.t -> Cpath.value = fun ident_map p -> diff --git a/src/xref2/cpath.ml b/src/xref2/cpath.ml index 8eb67bf16d..e59bbf2a52 100644 --- a/src/xref2/cpath.ml +++ b/src/xref2/cpath.ml @@ -35,7 +35,8 @@ module rec Resolved : sig | `CoreType of TypeName.t | `Type of parent * TypeName.t | `Class of parent * TypeName.t - | `ClassType of parent * TypeName.t ] + | `ClassType of parent * TypeName.t + | `Unbox of type_ ] and value = [ `Value of parent * ValueName.t | `Gpath of Path.Resolved.Value.t ] @@ -77,7 +78,8 @@ and Cpath : sig | `DotT of module_ * TypeName.t | `Type of Resolved.parent * TypeName.t | `Class of Resolved.parent * TypeName.t - | `ClassType of Resolved.parent * TypeName.t ] + | `ClassType of Resolved.parent * TypeName.t + | `Unbox of type_ ] and value = [ `Resolved of Resolved.value @@ -127,6 +129,7 @@ and is_resolved_module_type_substituted : Resolved.module_type -> bool = and is_resolved_type_substituted : Resolved.type_ -> bool = function | `Local _ -> false | `CoreType _ -> false + | `Unbox _ -> false | `Substituted _ -> true | `Gpath _ -> false | `CanonicalType (t, _) -> is_resolved_type_substituted t @@ -161,6 +164,7 @@ let is_type_substituted : type_ -> bool = function | `Resolved a -> is_resolved_type_substituted a | `Identifier _ -> false | `Local _ -> false + | `Unbox _ -> false | `Substituted _ -> true | `DotT (a, _) -> is_module_substituted a | `Type (a, _) | `Class (a, _) | `ClassType (a, _) -> @@ -249,6 +253,7 @@ and is_type_hidden : type_ -> bool = function | `Local (_, b) -> b | `Substituted p -> is_type_hidden (p :> type_) | `DotT (p, _) -> is_module_hidden p + | `Unbox p -> is_type_hidden p | `Type (p, _) | `Class (p, _) | `ClassType (p, _) -> is_resolved_parent_hidden ~weak_canonical_test:false p @@ -259,6 +264,7 @@ and is_resolved_type_hidden : Resolved.type_ -> bool = function | `Substituted p -> is_resolved_type_hidden p | `CanonicalType (_, `Resolved _) -> false | `CanonicalType (p, _) -> is_resolved_type_hidden p + | `Unbox p -> is_resolved_type_hidden p | `Type (p, _) | `Class (p, _) | `ClassType (p, _) -> is_resolved_parent_hidden ~weak_canonical_test:false p @@ -370,6 +376,7 @@ and unresolve_resolved_type_path : Resolved.type_ -> type_ = function | `Type (p, n) -> `DotT (unresolve_resolved_parent_path p, n) | `Class (p, n) -> `DotT (unresolve_resolved_parent_path p, n) | `ClassType (p, n) -> `DotT (unresolve_resolved_parent_path p, n) + | `Unbox p -> `Unbox (unresolve_resolved_type_path p) and unresolve_resolved_class_type_path : Resolved.class_type -> class_type = function diff --git a/src/xref2/lang_of.ml b/src/xref2/lang_of.ml index a344b411b9..bebaf611dc 100644 --- a/src/xref2/lang_of.ml +++ b/src/xref2/lang_of.ml @@ -103,6 +103,7 @@ module Path = struct | `Identifier (({ iv = #Odoc_model.Paths.Identifier.Path.Type.t_pv; _ } as y), b) -> `Identifier (y, b) + | `Unbox x -> `Unbox (type_ map x) | `Local (id, b) -> `Identifier (Component.TypeMap.find id map.path_type, b) | `Resolved x -> `Resolved (resolved_type map x) | `DotT (p, n) -> `DotT (module_ map p, n) @@ -186,6 +187,7 @@ module Path = struct | `Class (p, name) -> `Class (resolved_parent map p, name) | `ClassType (p, name) -> `ClassType (resolved_parent map p, name) | `Substituted s -> `SubstitutedT (resolved_type map s) + | `Unbox t -> `Unbox (resolved_type map t) and resolved_value map (p : Cpath.Resolved.value) : Odoc_model.Paths.Path.Resolved.Value.t = diff --git a/src/xref2/link.ml b/src/xref2/link.ml index 82c5809af5..cb78b758b2 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -128,6 +128,7 @@ let rec should_reresolve : Paths.Path.Resolved.t -> bool = | `ModuleType (p, _) | `Module (p, _) -> should_reresolve (p :> t) + | `Unbox x -> should_reresolve (x :> t) | `OpaqueModule m -> should_reresolve (m :> t) | `OpaqueModuleType m -> should_reresolve (m :> t) | `Substituted m -> should_reresolve (m :> t) diff --git a/src/xref2/shape_tools.cppo.ml b/src/xref2/shape_tools.cppo.ml index 9302b56ce5..7ddacd386f 100644 --- a/src/xref2/shape_tools.cppo.ml +++ b/src/xref2/shape_tools.cppo.ml @@ -105,6 +105,7 @@ 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) + | `Unbox t -> shape_of_kind_path env kind (t :> Odoc_model.Paths.Path.t) | `Forward _ | `Dot _ | `Root _ diff --git a/src/xref2/subst.ml b/src/xref2/subst.ml index c7cc903ca8..707a7d19be 100644 --- a/src/xref2/subst.ml +++ b/src/xref2/subst.ml @@ -382,6 +382,7 @@ and resolved_type_path : match resolved_type_path s t1 with | Not_replaced t1' -> Not_replaced (`CanonicalType (t1', t2)) | x -> x) + | `Unbox t -> resolved_type_path s t |> map_replaced (fun p -> `Unbox p) | `Gpath _ -> Not_replaced p | `Substituted p -> resolved_type_path s p |> map_replaced (fun p -> `Substituted p) @@ -398,6 +399,7 @@ and type_path : t -> Cpath.type_ -> Cpath.type_ type_or_replaced = let path' = Cpath.unresolve_resolved_type_path r in type_path s path') | `Substituted p -> type_path s p |> map_replaced (fun r -> `Substituted r) + | `Unbox p -> type_path s p |> map_replaced (fun r -> `Unbox r) | `Local (id, b) -> ( if TypeMap.mem id s.type_replacement then Replaced (TypeMap.find id s.type_replacement) diff --git a/src/xref2/tools.ml b/src/xref2/tools.ml index 9e25ac5299..ec760139e2 100644 --- a/src/xref2/tools.ml +++ b/src/xref2/tools.ml @@ -761,6 +761,7 @@ and lookup_type_gpath : | `Type (p, id) -> do_type p id | `Class (p, id) -> do_type p id | `ClassType (p, id) -> do_type p id + | `Unbox t -> lookup_type_gpath env t | `SubstitutedT t -> lookup_type_gpath env t | `SubstitutedCT t -> lookup_type_gpath env (t :> Odoc_model.Paths.Path.Resolved.Type.t) @@ -851,6 +852,7 @@ and lookup_type : | `Gpath p -> lookup_type_gpath env p | `CanonicalType (t1, _) -> lookup_type env t1 | `Substituted s -> lookup_type env s + | `Unbox t -> lookup_type env t | `Type (p, id) -> do_type p id | `Class (p, id) -> do_type p id | `ClassType (p, id) -> do_type p id @@ -1061,6 +1063,7 @@ and resolve_type : Env.t -> Cpath.type_ -> resolve_type_result = | `Local (l, _) -> Error (`LocalType (env, l)) | `Substituted s -> resolve_type env s >>= fun (p, m) -> Ok (`Substituted p, m) + | `Unbox s -> resolve_type env s >>= fun (p, m) -> Ok (`Unbox p, m) in result >>= fun (p, t) -> match t with @@ -1479,6 +1482,7 @@ and reresolve_type : Env.t -> Cpath.Resolved.type_ -> Cpath.Resolved.type_ = match path with | `Gpath _ | `Local _ | `CoreType _ -> path | `Substituted s -> `Substituted (reresolve_type env s) + | `Unbox t -> `Unbox (reresolve_type env t) | `CanonicalType (p1, p2) -> `CanonicalType (reresolve_type env p1, handle_canonical_type env p2) | `Type (p, n) -> `Type (reresolve_parent env p, n) diff --git a/test/generators/cases/oxcaml.mli b/test/generators/cases/oxcaml.mli index 9a60035c51..2891f57666 100644 --- a/test/generators/cases/oxcaml.mli +++ b/test/generators/cases/oxcaml.mli @@ -1,2 +1,7 @@ val f : int -> ('a . 'a -> 'a) -> unit (** Polymorphic arguments require parentheses *) + +(** Unboxed types have a trailing hash '#' *) + +type pt = { x : int ; y : float32# } +type segment = { start : pt# ; stop : pt# } diff --git a/test/generators/html/Oxcaml.html b/test/generators/html/Oxcaml.html index f6760c5410..8f21a8aeef 100644 --- a/test/generators/html/Oxcaml.html +++ b/test/generators/html/Oxcaml.html @@ -33,6 +33,42 @@
OxcamlPolymorphic arguments require parentheses
Unboxed types have a trailing hash '#'
+ +