OxCaml: Support for unboxed named types

.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: |

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)

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

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) ->

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

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

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

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

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 =

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 ->

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

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 =

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)

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 _

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)

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)

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# }