OxCaml: support for parameterized libraries

CHANGES.md

@@ -7,6 +7,7 @@
 - Support OxCaml 5.2.0minus39 (@jonludlam, #1469)
 - Support for OxCaml modes (@art-w, #1454)
 - Fix OxCaml with-bounds for arbitrary types (@art-w, #1466)
+- Support for OxCaml parameterized libraries (@art-w, #1464)
 
 ### Fixed
 - Remove requirement for ppx_expect in tests (@jonludlam, #1445)

src/document/doctree.ml

@@ -322,14 +322,15 @@ module PageTitle : sig
 
   val render_src_title : Source_page.t -> Item.t list
 end = struct
-  let format_title ~source_anchor kind name preamble =
-    let mk title =
-      let level = 0 and label = None in
-      [ Types.Item.Heading { level; label; title; source_anchor } ]
-    in
-    let prefix s =
-      mk (Types.inline (Text (s ^ " ")) :: Codefmt.code (Codefmt.txt name))
+  let prefixed_title ~source_anchor name s =
+    let level = 0 and label = None in
+    let title =
+      Types.inline (Text (s ^ " ")) :: Codefmt.code (Codefmt.txt name)
     in
+    [ Types.Item.Heading { level; label; title; source_anchor } ]
+
+  let format_title ~source_anchor kind name preamble =
+    let prefix = prefixed_title ~source_anchor name in
     match kind with
     | `Module -> (prefix "Module", preamble)
     | `Parameter _ -> (prefix "Parameter", preamble)
@@ -349,9 +350,10 @@ end = struct
     | Some p -> Printf.sprintf "%s.%s" p.name name
 
   let render_title ?source_anchor (p : Page.t) =
-    format_title ~source_anchor p.url.kind
-      (make_name_from_path p.url)
-      p.preamble
+    let name = make_name_from_path p.url in
+    if p.library_parameter then
+      (prefixed_title ~source_anchor name "Library parameter", p.preamble)
+    else format_title ~source_anchor p.url.kind name p.preamble
 
   let render_src_title (p : Source_page.t) =
     format_title ~source_anchor:None p.url.kind (make_name_from_path p.url) []

src/document/generator.ml

@@ -84,23 +84,51 @@ let prepare_preamble comment items =
   in
   (Comment.standalone preamble, Comment.standalone first_comment @ items)
 
-let make_expansion_page ~source_anchor url comments items =
+let make_expansion_page ?(library_parameter = false) ~source_anchor url comments
+    items =
   let comment = List.concat comments in
   let preamble, items = prepare_preamble comment items in
-  { Page.preamble; items; url; source_anchor }
+  { Page.preamble; items; url; source_anchor; library_parameter }
 
 include Generator_signatures
 
 module Make (Syntax : SYNTAX) = struct
   module Link : sig
     val from_path : Paths.Path.t -> text
 
+    val href_of_path : Paths.Path.t -> Url.t option
+
     val from_fragment : Paths.Fragment.leaf -> text
 
     val render_fragment_any : Paths.Fragment.t -> string
   end = struct
     open Paths
 
+    let href_of_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
+         the declaration of the opaque module(_type) *)
+      let stop_before =
+        match rp with
+        | `OpaqueModule _ | `OpaqueModuleType _ -> true
+        | _ -> false
+      in
+      match Paths.Path.Resolved.identifier rp with
+      | Some id -> Some (Url.from_identifier ~stop_before id)
+      | None -> None
+
+    let rec href_of_path : Path.t -> Url.t option =
+     fun path ->
+      match path with
+      | `Substituted m -> href_of_path (m :> Path.t)
+      | `SubstitutedMT m -> href_of_path (m :> Path.t)
+      | `SubstitutedT m -> href_of_path (m :> Path.t)
+      | `SubstitutedCT m -> href_of_path (m :> Path.t)
+      | `Resolved _ when Paths.Path.is_hidden path -> None
+      | `Resolved rp -> href_of_resolved rp
+      | _ -> None
+
     let rec from_path : Path.t -> text =
      fun path ->
       match path with
@@ -129,24 +157,18 @@ module Make (Syntax : SYNTAX) = struct
           let link1 = from_path (p1 :> Path.t) in
           let link2 = from_path (p2 :> Path.t) in
           link1 ++ O.txt "(" ++ link2 ++ O.txt ")"
+      | `ApplyParam (p1, p2, p3) ->
+          let link1 = from_path (p1 :> Path.t) in
+          let link2 = from_path (p2 :> Path.t) in
+          let link3 = from_path (p3 :> Path.t) in
+          link1 ++ O.txt "[" ++ link2 ++ O.txt ":" ++ link3 ++ O.txt "]"
       | `Resolved _ when Paths.Path.is_hidden path ->
           let txt = Url.render_path path in
           unresolved [ inline @@ Text txt ]
       | `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
-             the declaration of the opaque module(_type) *)
-          let stop_before =
-            match rp with
-            | `OpaqueModule _ | `OpaqueModuleType _ -> true
-            | _ -> false
-          in
           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
+          match href_of_resolved rp with
+          | Some href -> resolved href txt
           | None -> O.elt txt)
 
     let dot prefix suffix = prefix ^ "." ^ suffix
@@ -1978,15 +2000,76 @@ module Make (Syntax : SYNTAX) = struct
       in
       List.map f t
 
+    let parameterisation_items
+        (p : Odoc_model.Lang.Compilation_unit.Parameterisation.t) =
+      let text s : Inline.t = [ inline (Inline.Text s) ] in
+      let link (path : Paths.Path.Module.t) : Inline.t =
+        let path = (path :> Paths.Path.t) in
+        let content = O.code (O.txt (Url.render_path path)) in
+        match Link.href_of_path path with
+        | Some href ->
+            [
+              inline
+                (Inline.Link
+                   {
+                     target = Internal (Resolved href);
+                     content;
+                     tooltip = None;
+                   });
+            ]
+        | None -> content
+      in
+      let para parts =
+        Item.Text [ block (Block.Paragraph (List.concat parts)) ]
+      in
+      let implements =
+        match p.argument_for with
+        | None -> []
+        | Some path ->
+            [
+              para
+                [
+                  text "Implements the library parameter "; link path; text ".";
+                ];
+            ]
+      in
+      let parameters =
+        match p.parameters with
+        | [] -> []
+        | parameters ->
+            let decl_of_parameter (path : Paths.Path.Module.t) =
+              let path = (path :> Paths.Path.t) in
+              let content =
+                O.documentedSrc (O.keyword "parameter " ++ Link.from_path path)
+              in
+              Item.Declaration
+                {
+                  content;
+                  anchor = None;
+                  attr = [ "parameter" ];
+                  doc = [];
+                  source_anchor = None;
+                }
+            in
+            mk_heading ~label:"library-parameters" "Library parameters"
+            :: List.map decl_of_parameter parameters
+            @ [ mk_heading ~label:"signature" "Signature" ]
+      in
+      implements @ parameters
+
     let compilation_unit (t : Odoc_model.Lang.Compilation_unit.t) =
       let url = Url.Path.from_identifier t.id in
       let unit_doc, items =
         match t.content with
         | Module sign -> signature sign
         | Pack packed -> ([], pack packed)
       in
+      let items = parameterisation_items t.parameterisation @ items in
       let source_anchor = source_anchor t.source_loc in
-      let page = make_expansion_page ~source_anchor url [ unit_doc ] items in
+      let page =
+        make_expansion_page ~library_parameter:t.parameterisation.is_parameter
+          ~source_anchor url [ unit_doc ] items
+      in
       Document.Page page
 
     let page (t : Odoc_model.Lang.Page.t) =
@@ -1997,7 +2080,8 @@ module Make (Syntax : SYNTAX) = struct
       let url = Url.Path.from_identifier t.name in
       let preamble, items = Sectioning.docs t.content.elements in
       let source_anchor = None in
-      Document.Page { Page.preamble; items; url; source_anchor }
+      Document.Page
+        { Page.preamble; items; url; source_anchor; library_parameter = false }
 
     let implementation (v : Odoc_model.Lang.Implementation.t) syntax_info
         source_code =

src/document/types.ml

@@ -185,6 +185,7 @@ and Page : sig
     source_anchor : Url.t option;
         (** Url to the corresponding source code. Might be a whole source file
             or a sub part. *)
+    library_parameter : bool;
   }
 end =
   Page

src/document/url.ml

@@ -58,6 +58,13 @@ let render_path : Path.t -> string =
     | `DotV (p, s) -> dot p (ValueName.to_string s)
     | `Apply (p1, p2) ->
         render_path (p1 :> Path.t) ^ "(" ^ render_path (p2 :> Path.t) ^ ")"
+    | `ApplyParam (p1, p2, p3) ->
+        render_path (p1 :> Path.t)
+        ^ "["
+        ^ render_path (p2 :> Path.t)
+        ^ ":"
+        ^ render_path (p3 :> Path.t)
+        ^ "]"
     | `Resolved rp -> render_resolved rp
     | `Substituted m -> render_path (m :> Path.t)
     | `SubstitutedMT m -> render_path (m :> Path.t)

src/loader/ident_env.ml

@@ -709,8 +709,31 @@ let is_shadowed
     List.mem id env.shadowed
 module Path = struct
 
+let module_of_id id = `Root (ModuleName.of_ident id)
+
+#if defined OXCAML
+  let rec read_global_name (n : Global_module.Name.t) : Paths.Path.Module.t =
+    (* OxCaml parameterized library application "Lib[Param:Impl][P2:I2]" *)
+    let base = `Root (ModuleName.make_std n.head) in
+    List.fold_left
+      (fun acc (arg : Global_module.Name.argument) ->
+        let param =
+          `Root
+            (ModuleName.make_std
+               (Global_module.Parameter_name.to_string arg.param))
+        in
+        `ApplyParam (acc, param, read_global_name arg.value))
+      base n.args
+
+  let module_of_id id =
+    match Ident.to_global id with
+    | Some ({ Global_module.Name.args = _ :: _; _ } as n) -> read_global_name n
+    | _ -> module_of_id id
+#endif
+
   let read_module_ident env id =
-    if ident_is_global_or_predef id then `Root (ModuleName.of_ident id)
+    if ident_is_global_or_predef id then
+      module_of_id id
     else
       try find_module env id
       with Not_found -> assert false