Upstream OxCaml

dune-project

@@ -1,4 +1,4 @@
-(lang dune 3.18)
+(lang dune 3.21)
 
 (name odoc)
 

odoc-bench.opam

@@ -31,7 +31,7 @@ depends: [
   "astring"
   "cmdliner" {>= "1.3.0"}
   "cppo" {build & >= "1.1.0"}
-  "dune" {>= "3.18.0"}
+  "dune" {>= "3.21.0"}
   "fpath"
   "ocaml" {>= "4.02.0"}
   "result"

odoc-driver.opam

@@ -35,7 +35,7 @@ documentation for installed packages.
 depends: [
   "ocaml" {>= "5.1.0"}
   "odoc" {= version}
-  "dune" {>= "3.18.0"}
+  "dune" {>= "3.21.0"}
   "odoc-md"
   "bos"
   "fpath" {>= "0.7.3"}

odoc-md.opam

@@ -28,7 +28,7 @@ This package provides support for generating documentation from Markdown files.
 depends: [
   "ocaml" {>= "4.14.0"}
   "odoc" {= version}
-  "dune" {>= "3.18.0"}
+  "dune" {>= "3.21.0"}
   "cmdliner" {>= "1.3.0"}
   "cmarkit"
 ]

odoc-parser.opam

@@ -13,7 +13,7 @@ bug-reports: "https://github.com/ocaml/odoc/issues"
 dev-repo: "git+https://github.com/ocaml/odoc.git"
 doc: "https://ocaml.github.io/odoc/odoc_parser"
 depends: [
-  "dune" {>= "3.18"}
+  "dune" {>= "3.21"}
   "ocaml" {>= "4.08.0" & < "5.5"}
   "astring"
   "camlp-streams"

odoc.opam

@@ -43,7 +43,7 @@ depends: [
   "astring"
   "cmdliner" {>= "1.3.0"}
   "cppo" {build & >= "1.1.0"}
-  "dune" {>= "3.18.0"}
+  "dune" {>= "3.21.0"}
   "fpath" {>= "0.7.3"}
   "ocaml" {>= "4.08.0" & < "5.5"}
   "tyxml" {>= "4.4.0"}

sherlodoc.opam

@@ -8,7 +8,7 @@ homepage: "https://github.com/ocaml/odoc"
 doc: "https://ocaml.github.io/odoc/"
 bug-reports: "https://github.com/ocaml/odoc/issues"
 depends: [
-  "dune" {>= "3.18"}
+  "dune" {>= "3.21"}
   "ocaml" {>= "4.0.8"}
   "odoc" {= version}
   "base64" {>= "3.5.1"}

sherlodoc/index/load_doc.ml

@@ -116,7 +116,8 @@ let convert_kind ~db (Odoc_index.Entry.{ kind; _ } as entry) =
       let typ = searchable_type_of_constructor args res in
       let typ = Db_writer.type_of_odoc ~db typ in
       Entry.Kind.Exception typ
-  | Field { mutable_ = _; parent_type; type_ } ->
+  | Field { mutable_ = _; parent_type; type_ }
+  | UnboxedField { mutable_ = _; parent_type; type_ } ->
       let typ = searchable_type_of_record parent_type type_ in
       let typ = Db_writer.type_of_odoc ~db typ in
       Entry.Kind.Field typ
@@ -149,7 +150,7 @@ let rec categorize id =
   | `Parameter _ -> `ignore (* redundant with indexed signature *)
   | ( `InstanceVariable _ | `Method _ | `Field _ | `Result _ | `Label _ | `Type _
     | `Exception _ | `Class _ | `ClassType _ | `Value _ | `Constructor _ | `Extension _
-    | `ExtensionDecl _ | `Module _ ) as x ->
+    | `ExtensionDecl _ | `Module _ | `UnboxedField _ ) as x ->
       let parent = Identifier.label_parent { id with iv = x } in
       categorize (parent :> Identifier.Any.t)
   | `AssetFile _ | `SourceLocationMod _ | `SourceLocation _ | `SourcePage _
@@ -173,7 +174,7 @@ let register_entry
       ~favoured_prefixes
       ~pkg
       ~cat
-      (Odoc_index.Entry.{ id; doc; kind } as entry)
+      (Odoc_index.Entry.{ id; doc; kind; source_loc = _ } as entry)
   =
   let module Sherlodoc_entry = Entry in
   let open Odoc_search in

src/document/ML.mli

@@ -30,3 +30,5 @@ val implementation :
 val type_expr : ?needs_parentheses:bool -> Lang.TypeExpr.t -> Codefmt.t
 
 val record : Lang.TypeDecl.Field.t list -> Types.DocumentedSrc.one list
+
+val unboxed_record : Lang.TypeDecl.UnboxedField.t list -> Types.DocumentedSrc.one list

src/document/comment.ml

@@ -44,6 +44,7 @@ module Reference = struct
     | `PolyConstructor (r, s) ->
         render_resolved (r :> t) ^ ".`" ^ ConstructorName.to_string s
     | `Field (r, s) -> render_resolved (r :> t) ^ "." ^ FieldName.to_string s
+    | `UnboxedField (r, s) -> render_resolved (r :> t) ^ "." ^ UnboxedFieldName.to_string s
     | `Extension (r, s) ->
         render_resolved (r :> t) ^ "." ^ ExtensionName.to_string s
     | `ExtensionDecl (r, _, s) ->
@@ -88,6 +89,7 @@ module Reference = struct
     | `Constructor (p, f) ->
         render_unresolved (p :> t) ^ "." ^ ConstructorName.to_string f
     | `Field (p, f) -> render_unresolved (p :> t) ^ "." ^ FieldName.to_string f
+    | `UnboxedField (p, f) -> render_unresolved (p :> t) ^ "." ^ UnboxedFieldName.to_string f
     | `Extension (p, f) ->
         render_unresolved (p :> t) ^ "." ^ ExtensionName.to_string f
     | `ExtensionDecl (p, f) ->

src/document/generator.ml

@@ -289,8 +289,8 @@ module Make (Syntax : SYNTAX) = struct
 
     let source id syntax_info infos source_code =
       let url = path id in
-      let mapper (info, loc) =
-        match info_of_info info with Some x -> Some (x, loc) | None -> None
+      let mapper (info, (loc : Lang.Source_info.location_in_file)) =
+        match info_of_info info with Some x -> Some (x, (loc.loc_start.pos_cnum, loc.loc_end.pos_cnum)) | None -> None
       in
       let infos = Odoc_utils.List.filter_map mapper infos in
       let syntax_info =
@@ -410,6 +410,22 @@ module Make (Syntax : SYNTAX) = struct
           in
           Syntax.Type.handle_constructor_params path (O.box_hv params)
 
+    and tuple ?(needs_parentheses = false) ~boxed lst =
+      let opt_label = function
+          None -> O.noop
+        | Some lbl -> O.txt lbl ++ O.txt ":" ++ O.cut
+      in
+      let res =
+        O.box_hv_no_indent
+          (O.list lst ~sep:Syntax.Type.Tuple.element_separator
+             ~f:(fun (lbl, typ) ->
+               opt_label lbl ++ type_expr ~needs_parentheses:true typ))
+      in
+      let lparen = if boxed then "(" else "#(" in
+      if Syntax.Type.Tuple.always_parenthesize || needs_parentheses || not boxed then
+        enclose ~l:lparen res ~r:")"
+      else res
+
     and type_expr ?(needs_parentheses = false) (t : Odoc_model.Lang.TypeExpr.t)
         =
       let enclose_parens_if_needed res =
@@ -451,21 +467,8 @@ module Make (Syntax : SYNTAX) = struct
             ++ O.sp ++ type_expr dst
           in
           if not needs_parentheses then res else enclose ~l:"(" res ~r:")"
-      | Tuple lst ->
-          let res =
-            O.box_hv_no_indent
-              (O.list lst ~sep:Syntax.Type.Tuple.element_separator
-                 ~f:(fun (lbl, ty) ->
-                   match lbl with
-                   | None -> type_expr ~needs_parentheses:true ty
-                   | Some lbl ->
-                       tag "label" (O.txt lbl)
-                       ++ O.txt ":" ++ O.cut
-                       ++ type_expr ~needs_parentheses:true ty))
-          in
-          if Syntax.Type.Tuple.always_parenthesize || needs_parentheses then
-            enclose ~l:"(" res ~r:")"
-          else res
+      | Tuple lst -> tuple ~needs_parentheses ~boxed:true lst
+      | Unboxed_tuple lst -> tuple ~needs_parentheses ~boxed:false lst
       | Constr (path, args) ->
           let link = Link.from_path (path :> Paths.Path.t) in
           format_type_path ~delim:`parens args link
@@ -476,6 +479,10 @@ module Make (Syntax : SYNTAX) = struct
             (Link.from_path (path :> Paths.Path.t))
       | Poly (polyvars, t) ->
           O.txt ("'" ^ String.concat ~sep:" '" polyvars ^ ". ") ++ type_expr t
+      | Quote t ->
+          O.span (O.txt "<[ " ++ O.box_hv (type_expr t) ++ O.txt " ]>")
+      | Splice t ->
+          O.span (O.txt "$" ++ type_expr ~needs_parentheses:true t)
       | Package pkg ->
           enclose ~l:"(" ~r:")"
             (O.keyword "module" ++ O.txt " "
@@ -515,6 +522,8 @@ module Make (Syntax : SYNTAX) = struct
 
     val record : Lang.TypeDecl.Field.t list -> DocumentedSrc.one list
 
+    val unboxed_record : Lang.TypeDecl.UnboxedField.t list -> DocumentedSrc.one list
+
     val exn : Lang.Exception.t -> Item.t
 
     val format_params :
@@ -566,6 +575,46 @@ module Make (Syntax : SYNTAX) = struct
       in
       content
 
+    let unboxed_record fields =
+      let field mutable_ id typ =
+        let url = Url.from_identifier ~stop_before:true id in
+        let name = Paths.Identifier.name id in
+        let attrs =
+          [ "def"; "record"; Url.Anchor.string_of_kind url.kind ]
+        in
+        let cell =
+          (* O.td ~a:[ O.a_class ["def"; kind ] ]
+           *   [O.a ~a:[O.a_href ("#" ^ anchor); O.a_class ["anchor"]] []
+           *   ; *)
+          O.code
+            ((if mutable_ then O.keyword "mutable" ++ O.txt " " else O.noop)
+            ++ O.txt name
+            ++ O.txt Syntax.Type.annotation_separator
+            ++ type_expr typ
+            ++ O.txt Syntax.Type.Record.field_separator)
+          (* ] *)
+        in
+        (url, attrs, cell)
+      in
+      let rows =
+        fields
+        |> List.map (fun fld ->
+               let open Odoc_model.Lang.TypeDecl.UnboxedField in
+               let url, attrs, code =
+                 field fld.mutable_ (fld.id :> Paths.Identifier.t) fld.type_
+               in
+               let anchor = Some url in
+               let doc = fld.doc.elements in
+               let rhs = Comment.to_ir doc in
+               let doc = if not (Comment.has_doc doc) then [] else rhs in
+               let markers = Syntax.Comment.markers in
+               DocumentedSrc.Documented { anchor; attrs; code; doc; markers })
+      in
+      let content =
+        O.documentedSrc (O.txt "#{") @ rows @ O.documentedSrc (O.txt "}")
+      in
+      content
+
     let constructor :
         Paths.Identifier.t ->
         Odoc_model.Lang.TypeDecl.Constructor.argument ->
@@ -886,6 +935,7 @@ module Make (Syntax : SYNTAX) = struct
               | Extensible -> O.documentedSrc (O.txt "..")
               | Variant cstrs -> variant cstrs
               | Record fields -> record fields
+              | Record_unboxed_product fields -> unboxed_record fields
             in
             if List.length content > 0 then
               O.documentedSrc
@@ -1417,11 +1467,13 @@ module Make (Syntax : SYNTAX) = struct
         match t with
         | Path { p_expansion = None; _ }
         | TypeOf { t_expansion = None; _ }
-        | With { w_expansion = None; _ } ->
+        | With { w_expansion = None; _ }
+        | Strengthen { s_expansion = None; _ } ->
             None
         | Path { p_expansion = Some e; _ }
         | TypeOf { t_expansion = Some e; _ }
-        | With { w_expansion = Some e; _ } ->
+        | With { w_expansion = Some e; _ }
+        | Strengthen { s_expansion = Some e; _ } ->
             Some e
         | Signature sg -> Some (Signature sg)
         | Functor (f_parameter, e) -> (
@@ -1560,6 +1612,8 @@ module Make (Syntax : SYNTAX) = struct
       | TypeOf (ModPath m, _) | TypeOf (StructInclude m, _) ->
           Paths.Path.(is_hidden (m :> t))
       | Signature _ -> false
+      | Strengthen (expr, p, _) ->
+          umty_hidden expr || Paths.Path.(is_hidden (p :> t))
 
     and mty_hidden : Odoc_model.Lang.ModuleType.expr -> bool = function
       | Path { p_path = mty_path; _ } -> Paths.Path.(is_hidden (mty_path :> t))
@@ -1576,6 +1630,10 @@ module Make (Syntax : SYNTAX) = struct
            ~f:(fun x -> O.span (substitution x))
            subs
 
+    and mty_strengthen expr path =
+      umty expr ++ O.sp ++ O.keyword "with" ++ O.txt " "
+      ++ Link.from_path (path :> Paths.Path.t)
+
     and mty_typeof t_desc =
       match t_desc with
       | Odoc_model.Lang.ModuleType.ModPath m ->
@@ -1595,6 +1653,7 @@ module Make (Syntax : SYNTAX) = struct
       | Signature _ -> true
       | With (_, expr) -> is_elidable_with_u expr
       | TypeOf _ -> false
+      | Strengthen (expr,_,_) -> is_elidable_with_u expr
 
     and umty : Odoc_model.Lang.ModuleType.U.expr -> text =
      fun m ->
@@ -1606,6 +1665,9 @@ module Make (Syntax : SYNTAX) = struct
           Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag
       | With (subs, expr) -> mty_with subs expr
       | TypeOf (t_desc, _) -> mty_typeof t_desc
+      | Strengthen (expr, _, _) when is_elidable_with_u expr ->
+          Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag
+      | Strengthen (expr, p, _) -> mty_strengthen expr (p :> Paths.Path.t)
 
     and mty : Odoc_model.Lang.ModuleType.expr -> text =
      fun m ->
@@ -1644,12 +1706,15 @@ module Make (Syntax : SYNTAX) = struct
         | TypeOf { t_desc; _ } -> mty_typeof t_desc
         | Signature _ ->
             Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag
-
+        | Strengthen { s_expr; _ } when is_elidable_with_u s_expr ->
+            Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag
+        | Strengthen { s_expr; s_path; _ } ->
+            O.box_hv @@ mty_strengthen s_expr (s_path :> Paths.Path.t)
     and mty_in_decl :
         Paths.Identifier.Signature.t -> Odoc_model.Lang.ModuleType.expr -> text
         =
      fun base -> function
-      | (Path _ | Signature _ | With _ | TypeOf _) as m ->
+      | (Path _ | Signature _ | With _ | TypeOf _ | Strengthen _) as m ->
           O.txt Syntax.Type.annotation_separator ++ O.cut ++ mty m
       | Functor _ as m when not Syntax.Mod.functor_contraction ->
           O.txt Syntax.Type.annotation_separator ++ O.cut ++ mty m
@@ -1831,4 +1896,6 @@ module Make (Syntax : SYNTAX) = struct
   let type_expr = type_expr
 
   let record = record
+
+  let unboxed_record = unboxed_record
 end

src/document/generator_signatures.ml

@@ -114,4 +114,6 @@ module type GENERATOR = sig
   val type_expr : ?needs_parentheses:bool -> Lang.TypeExpr.t -> text
 
   val record : Lang.TypeDecl.Field.t list -> DocumentedSrc.one list
+
+  val unboxed_record : Lang.TypeDecl.UnboxedField.t list -> DocumentedSrc.one list
 end

src/document/targets.ml

@@ -49,7 +49,8 @@ and module_type_expr (t : Odoc_model.Lang.ModuleType.expr) =
       sub @ module_type_expr e
   | Path { p_expansion = e_opt; _ }
   | With { w_expansion = e_opt; _ }
-  | TypeOf { t_expansion = e_opt; _ } ->
+  | TypeOf { t_expansion = e_opt; _ }
+  | Strengthen { s_expansion = e_opt; _ } ->
       opt_expansion e_opt
 
 and module_ (t : Odoc_model.Lang.Module.t) =

src/document/url.ml

@@ -231,6 +231,7 @@ module Anchor = struct
     | `Val
     | `Constructor
     | `Field
+    | `UnboxedField
     | `SourceAnchor ]
 
   let string_of_kind : kind -> string = function
@@ -244,6 +245,7 @@ module Anchor = struct
     | `Val -> "val"
     | `Constructor -> "constructor"
     | `Field -> "field"
+    | `UnboxedField -> "unboxed-field"
     | `SourceAnchor -> "source-anchor"
 
   let pp_kind fmt kind = Format.fprintf fmt "%s" (string_of_kind kind)
@@ -358,6 +360,11 @@ module Anchor = struct
         let kind = `Field in
         let suffix = FieldName.to_string name in
         add_suffix ~kind page suffix
+    | { iv = `UnboxedField (parent, name); _ } ->
+        let page = from_identifier (parent :> Identifier.t) in
+        let kind = `UnboxedField in
+        let suffix = UnboxedFieldName.to_string name in
+        add_suffix ~kind page suffix
     | { iv = `Label (parent, anchor); _ } -> (
         let str_name = LabelName.to_string anchor in
         (* [Identifier.LabelParent.t] contains datatypes. [`CoreType] can't

src/document/url.mli

@@ -68,6 +68,7 @@ module Anchor : sig
     | `Val
     | `Constructor
     | `Field
+    | `UnboxedField
     | `SourceAnchor ]
 
   val pp_kind : Format.formatter -> kind -> unit

src/index/entry.ml

@@ -56,6 +56,7 @@ type kind =
   | ModuleType of module_entry
   | Constructor of constructor_entry
   | Field of field_entry
+  | UnboxedField of field_entry
   | Page of Odoc_model.Frontmatter.t
   | Impl
   | Dir
@@ -64,8 +65,9 @@ type t = {
   id : Odoc_model.Paths.Identifier.Any.t;
   doc : Odoc_model.Comment.elements;
   kind : kind;
+  source_loc : Odoc_model.Lang.Source_loc_jane.t option;
 }
 
-let entry ~id ~doc ~kind =
+let entry ~id ~doc ~kind ~source_loc =
   let id = (id :> Odoc_model.Paths.Identifier.Any.t) in
-  { id; kind; doc }
+  { id; kind; doc; source_loc }