driver: Pass --current-package when linking

src/driver/compile.ml

@@ -16,6 +16,7 @@ type compiled = {
   include_dirs : Fpath.Set.t;
   impl : impl option;
   pkg_args : pkg_args;
+  current_package : string;
 }
 
 let mk_byhash (pkgs : Packages.t Util.StringMap.t) =
@@ -145,6 +146,7 @@ let compile output_dir all =
             include_dirs = includes;
             impl;
             pkg_args;
+            current_package = modty.m_package;
           }
   in
 
@@ -189,6 +191,7 @@ let compile output_dir all =
             include_dirs;
             impl = None;
             pkg_args;
+            current_package = pkg.name;
           }
           :: acc)
         acc pkg.mlds)
@@ -201,12 +204,15 @@ let link : compiled list -> _ =
   let link : compiled -> linked list =
    fun c ->
     let includes = Fpath.Set.add c.output_dir c.include_dirs in
+    let link input_file =
+      let { pkg_args = { libs; docs }; current_package; _ } = c in
+      Odoc.link ~input_file ~includes ~libs ~docs ~current_package ()
+    in
     let impl =
       match c.impl with
       | Some { impl; src } ->
           Logs.debug (fun m -> m "Linking impl: %a" Fpath.pp impl);
-          Odoc.link ~input_file:impl ~includes ~libs:c.pkg_args.libs
-            ~docs:c.pkg_args.docs ();
+          link impl;
           Atomic.incr Stats.stats.linked_impls;
           [ { output_file = Fpath.(set_ext "odocl" impl); src = Some src } ]
       | None -> []
@@ -217,8 +223,7 @@ let link : compiled list -> _ =
         impl
     | _ ->
         Logs.debug (fun m -> m "linking %a" Fpath.pp c.output_file);
-        Odoc.link ~input_file:c.output_file ~includes ~libs:c.pkg_args.libs
-          ~docs:c.pkg_args.docs ();
+        link c.output_file;
         (match c.m with
         | Module _ -> Atomic.incr Stats.stats.linked_units
         | Mld _ -> Atomic.incr Stats.stats.linked_mlds);

src/driver/odoc.ml

@@ -81,7 +81,8 @@ let compile_impl ~output_dir ~input_file:file ~includes ~parent_id ~source_id =
   let lines = submit desc cmd output_file in
   add_prefixed_output cmd compile_output (Fpath.to_string file) lines
 
-let link ?(ignore_output = false) ~input_file:file ~includes ~docs ~libs () =
+let link ?(ignore_output = false) ~input_file:file ~includes ~docs ~libs
+    ~current_package () =
   let open Cmd in
   let output_file = Fpath.set_ext "odocl" file in
   let includes =
@@ -105,7 +106,7 @@ let link ?(ignore_output = false) ~input_file:file ~includes ~docs ~libs () =
   in
   let cmd =
     odoc % "link" % p file % "-o" % p output_file %% includes %% docs %% libs
-    % "--enable-missing-root-warning"
+    % "--current-package" % current_package % "--enable-missing-root-warning"
   in
   let cmd =
     if Fpath.to_string file = "stdlib.odoc" then cmd % "--open=\"\"" else cmd

src/driver/odoc.mli

@@ -14,14 +14,17 @@ val compile :
   includes:Fpath.set ->
   parent_id:string ->
   unit
+
 val link :
   ?ignore_output:bool ->
   input_file:Fpath.t ->
   includes:Fpath.set ->
   docs:(string * Fpath.t) list ->
   libs:(string * Fpath.t) list ->
+  current_package:string ->
   unit ->
   unit
+
 val html_generate :
   output_dir:string ->
   ?ignore_output:bool ->

src/driver/packages.ml

@@ -30,6 +30,7 @@ type modulety = {
   m_intf : intf;
   m_impl : impl option;
   m_hidden : bool;
+  m_package : string;
 }
 
 type mld = {
@@ -67,7 +68,7 @@ module Module = struct
 
   let is_hidden name = Astring.String.is_infix ~affix:"__" name
 
-  let vs pkg_name lib_name dir modules =
+  let vs m_package lib_name dir modules =
     let mk m_name =
       let exists ext =
         let p =
@@ -86,7 +87,7 @@ module Module = struct
             | _ -> None)
       in
       let mk_intf mif_path =
-        let mif_parent_id = Printf.sprintf "%s/lib/%s" pkg_name lib_name in
+        let mif_parent_id = Printf.sprintf "%s/lib/%s" m_package lib_name in
         let mif_odoc_file =
           Fpath.(
             v mif_parent_id
@@ -106,7 +107,7 @@ module Module = struct
         | Error _ -> failwith "bad deps"
       in
       let mk_impl mip_path =
-        let mip_parent_id = Printf.sprintf "%s/lib/%s" pkg_name lib_name in
+        let mip_parent_id = Printf.sprintf "%s/lib/%s" m_package lib_name in
         let mip_odoc_file =
           Fpath.(
             v mip_parent_id
@@ -123,7 +124,7 @@ module Module = struct
                   m "Found source file %a for %s" Fpath.pp src_path m_name);
               let src_name = Fpath.filename src_path in
               let src_id =
-                Printf.sprintf "%s/src/%s/%s" pkg_name lib_name src_name
+                Printf.sprintf "%s/src/%s/%s" m_package lib_name src_name
               in
               Some { src_path; src_id }
         in
@@ -142,7 +143,7 @@ module Module = struct
               Logs.err (fun m -> m "No files for module: %s" m_name);
               failwith "no files"
         in
-        Some { m_name; m_intf; m_impl; m_hidden }
+        Some { m_name; m_intf; m_impl; m_hidden; m_package }
       with _ ->
         Logs.err (fun m -> m "Error processing module %s. Ignoring." m_name);
         None

src/driver/packages.mli

@@ -36,6 +36,7 @@ type modulety = {
   m_intf : intf;
   m_impl : impl option;
   m_hidden : bool;
+  m_package : string;
 }
 
 (** {1 Standalone pages units} *)