Install private cmi's

src/dir_contents.ml

@@ -29,7 +29,7 @@ module Modules = struct
         match (stanza : Stanza.t) with
         | Library lib ->
           let obj_dir =
-            Obj_dir.make_local ~dir:d.ctx_dir (snd lib.name)
+            Obj_dir.make_lib ~dir:d.ctx_dir (snd lib.name)
               ~has_private_modules:(Option.is_some lib.private_modules)
           in
           let modules =

src/dune_file.ml

@@ -1059,7 +1059,7 @@ module Library = struct
   let is_impl t = Option.is_some t.implements
 
   let obj_dir ~dir t =
-    Obj_dir.make_local ~dir
+    Obj_dir.make_lib ~dir
       ~has_private_modules:(t.private_modules <> None)
       (snd t.name)
 

src/dune_lang/dune_lang.ml

@@ -1080,6 +1080,7 @@ module Decoder = struct
       | Values (loc, cstr, _) -> (Values (loc, cstr), state)
       | Fields (loc, cstr, _) -> (Fields (loc, cstr), state)
 
+  let ( let* ) = ( >>= )
   let ( let+ ) = ( >>| )
   let ( and+ ) a b ctx state =
     let a, state = a ctx state in

src/dune_lang/dune_lang.mli

@@ -487,6 +487,7 @@ module Decoder : sig
 
   val leftover_fields : Ast.t list fields_parser
 
+  val ( let* ) : ('a, 'k) parser -> ('a -> ('b, 'k) parser) -> ('b, 'k) parser
   val ( let+ ) : ('a, 'k) parser -> ('a -> 'b) -> ('b, 'k) parser
   val ( and+ ) : ('a, 'k) parser -> ('b, 'k) parser -> ('a * 'b, 'k) parser
 end

src/dune_package.ml

@@ -7,7 +7,7 @@ module Lib = struct
   type 'sub_system t =
     { loc              : Loc.t
     ; name             : Lib_name.t
-    ; dir              : Path.t
+    ; obj_dir          : Obj_dir.t
     ; orig_src_dir     : Path.t option
     ; kind             : Lib_kind.t
     ; synopsis         : string option
@@ -33,7 +33,8 @@ module Lib = struct
         ~foreign_archives ~jsoo_runtime ~main_module_name ~sub_systems
         ~requires ~ppx_runtime_deps ~implements ~variant
         ~default_implementation ~virtual_ ~modules ~modes
-        ~version ~orig_src_dir ~dir =
+        ~version ~orig_src_dir ~obj_dir =
+    let dir = Obj_dir.dir obj_dir in
     let map_path p =
       if Path.is_managed p then
         Path.relative dir (Path.basename p)
@@ -59,14 +60,15 @@ module Lib = struct
     ; variant
     ; default_implementation
     ; version
-    ; dir
     ; orig_src_dir
     ; virtual_
     ; modules
     ; modes
+    ; obj_dir
     }
 
-  let dir t = t.dir
+  let obj_dir t = t.obj_dir
+  let dir t = Obj_dir.dir t.obj_dir
   let orig_src_dir t = t.orig_src_dir
 
   let set_subsystems t sub_systems =
@@ -81,7 +83,7 @@ module Lib = struct
         ; foreign_objects ; foreign_archives ; jsoo_runtime ; requires
         ; ppx_runtime_deps ; sub_systems ; virtual_
         ; implements ; variant ; default_implementation
-        ; main_module_name ; version = _; dir = _; orig_src_dir
+        ; main_module_name ; version = _; obj_dir ; orig_src_dir
         ; modules ; modes
         } =
     let open Dune_lang.Encoder in
@@ -110,6 +112,7 @@ module Lib = struct
         (no_loc Lib_name.encode) default_implementation
     ; field_o "main_module_name" Module.Name.encode main_module_name
     ; field_l "modes" sexp (Mode.Dict.Set.encode modes)
+    ; field_l "obj_dir" sexp (Obj_dir.encode obj_dir)
     ; field_l "modules" sexp
         (match modules with
          | None -> []
@@ -128,13 +131,19 @@ module Lib = struct
       field ~default:Mode.Dict.List.empty
         name (Mode.Dict.List.decode path) in
     record (
-      field_o "main_module_name" Module.Name.decode >>= fun main_module_name ->
-      field_o "implements" (located Lib_name.decode) >>= fun implements ->
-      field_o "variant" Variant.decode >>= fun variant ->
-      field_o "default_implementation" (located Lib_name.decode)
-      >>= fun default_implementation ->
-      field "name" Lib_name.decode >>= fun name ->
+      let* main_module_name = field_o "main_module_name" Module.Name.decode in
+      let* implements = field_o "implements" (located Lib_name.decode) in
+      let* variant = field_o "variant" Variant.decode in
+      let* default_implementation =
+        field_o "default_implementation" (located Lib_name.decode) in
+      let* name = field "name" Lib_name.decode in
       let dir = Path.append_local base (dir_of_name name) in
+      let* obj_dir = field_o "obj_dir" (Obj_dir.decode ~dir) in
+      let obj_dir =
+        match obj_dir with
+        | None -> Obj_dir.make_external_no_private ~dir
+        | Some obj_dir -> obj_dir
+      in
       let+ synopsis = field_o "synopsis" string
       and+ loc = loc
       and+ modes = field_l "modes" Mode.decode
@@ -150,7 +159,7 @@ module Lib = struct
       and+ sub_systems = Sub_system_info.record_parser ()
       and+ orig_src_dir = field_o "orig_src_dir" path
       and+ modules = field_o "modules" (Lib_modules.decode
-                         ~implements:(Option.is_some implements) ~dir)
+                         ~implements:(Option.is_some implements) ~obj_dir)
       in
       let modes = Mode.Dict.Set.of_list modes in
       { kind
@@ -171,8 +180,8 @@ module Lib = struct
       ; main_module_name
       ; virtual_
       ; version = None
-      ; dir
       ; orig_src_dir
+      ; obj_dir
       ; modules
       ; modes
       }

src/dune_package.mli

@@ -5,6 +5,7 @@ module Lib : sig
 
   val dir : _ t -> Path.t
   val orig_src_dir : _ t -> Path.t option
+  val obj_dir : _ t -> Obj_dir.t
   val requires : _ t -> (Loc.t * Lib_name.t) list
   val name : _ t -> Lib_name.t
   val version : _ t -> string option
@@ -55,7 +56,7 @@ module Lib : sig
     -> modes:Mode.Dict.Set.t
     -> version:string option
     -> orig_src_dir:Path.t option
-    -> dir:Path.t
+    -> obj_dir:Obj_dir.t
     -> 'a t
 
   val set_subsystems : 'a t -> 'b Sub_system_name.Map.t -> 'b t

src/exe.ml

@@ -134,7 +134,7 @@ let link_exe
   let compiler = Option.value_exn (Context.compiler ctx mode) in
   let kind = Mode.cm_kind mode in
   let artifacts ~ext modules =
-    List.map modules ~f:(Module.obj_file ~mode ~ext)
+    List.map modules ~f:(Module.obj_file ~kind ~ext)
   in
   let modules_and_cm_files =
     Build.memoize "cm files"

src/findlib.ml

@@ -212,6 +212,7 @@ module Package = struct
       | Some p -> Installed_dune_file.load p
     in
     let archives = archives t in
+    let obj_dir = Obj_dir.make_external_no_private ~dir:t.dir in
     let modes : Mode.Dict.Set.t =
       Mode.Dict.map ~f:(fun x -> not (List.is_empty x)) archives in
     Dune_package.Lib.make
@@ -236,7 +237,7 @@ module Package = struct
       ~main_module_name:None (* XXX remove *)
       ~version:(version t)
       ~modes
-      ~dir:t.dir
+      ~obj_dir
 
   let parse db ~meta_file ~name ~parent_dir ~vars =
     let pkg_dir = Vars.get vars "directory" Ps.empty in

src/install_rules.ml

@@ -189,10 +189,10 @@ let lib_ppxs sctx ~(lib : Dune_file.Library.t) ~scope ~dir_kind =
       in
       [Preprocessing.get_compat_ppx_exe sctx ~name ~kind:(Jbuild driver)]
 
-let lib_install_files sctx ~dir_contents ~dir ~sub_dir ~scope ~dir_kind
-      (lib : Library.t) =
+let lib_install_files sctx ~dir_contents ~dir ~sub_dir:default_subdir
+      ~scope ~dir_kind (lib : Library.t) =
   let loc = lib.buildable.loc in
-  let make_entry section ?dst fn =
+  let make_entry section ?sub_dir ?dst fn =
     ( Some loc
     , Install.Entry.make section fn
         ~dst:(
@@ -201,6 +201,11 @@ let lib_install_files sctx ~dir_contents ~dir ~sub_dir ~scope ~dir_kind
             | Some s -> s
             | None   -> Path.basename fn
           in
+          let sub_dir =
+            match sub_dir with
+            | Some _ -> sub_dir
+            | None -> default_subdir
+          in
           match sub_dir with
           | None -> dst
           | Some dir -> sprintf "%s/%s" dir dst))
@@ -227,23 +232,33 @@ let lib_install_files sctx ~dir_contents ~dir ~sub_dir ~scope ~dir_kind
     in
     let virtual_library = Library.is_virtual lib in
     List.concat_map installable_modules ~f:(fun m ->
-      List.concat
-        [ if_ (Module.is_public m)
-            [ Module.cm_public_file_unsafe m Cmi ]
-        ; if_ (native && Module.has_impl m)
+      let cmi_file = (Module.visibility m, Module.cm_file_unsafe m Cmi) in
+      let other_cm_files =
+        [ if_ (native && Module.has_impl m)
             [ Module.cm_file_unsafe m Cmx ]
         ; if_ (byte && Module.has_impl m && virtual_library)
             [ Module.cm_file_unsafe m Cmo ]
         ; if_ (native && Module.has_impl m && virtual_library)
-            [ Module.obj_file m ~mode:Native ~ext:ctx.ext_obj ]
+            [ Module.obj_file m ~kind:Cmx ~ext:ctx.ext_obj ]
         ; List.filter_map Ml_kind.all ~f:(Module.cmt_file m)
-        ])
+        ]
+        |> List.concat
+        |> List.map ~f:(fun f -> (Visibility.Public, f))
+      in
+      cmi_file :: other_cm_files
+    )
   in
   let archives = Lib_archives.make ~ctx ~dir_contents ~dir lib in
   let execs = lib_ppxs sctx ~lib ~scope ~dir_kind in
   List.concat
     [ sources
-    ; List.map module_files ~f:(make_entry Lib)
+    ; List.map module_files ~f:(fun (visibility, file) ->
+        let sub_dir =
+          match (visibility : Visibility.t) with
+          | Public -> None
+          | Private -> Some ".private"
+        in
+        make_entry ?sub_dir Lib file)
     ; List.map (Lib_archives.files archives) ~f:(make_entry Lib)
     ; List.map execs ~f:(make_entry Libexec)
     ; List.map (Lib_archives.dlls archives) ~f:(fun a ->

src/lib.ml

@@ -1604,8 +1604,9 @@ let () =
 let to_dune_lib ({ name ; info ; _ } as lib) ~lib_modules ~foreign_objects ~dir =
   let add_loc = List.map ~f:(fun x -> (info.loc, x.name)) in
   let virtual_ = Option.is_some info.virtual_ in
+  let obj_dir = Obj_dir.convert_to_external ~dir (obj_dir lib) in
   let lib_modules =
-    Lib_modules.version_installed ~install_dir:dir lib_modules in
+    Lib_modules.version_installed ~install_dir:obj_dir lib_modules in
   let orig_src_dir =
     if !Clflags.store_orig_src_dir
     then Some (
@@ -1624,7 +1625,7 @@ let to_dune_lib ({ name ; info ; _ } as lib) ~lib_modules ~foreign_objects ~dir
     | Local -> foreign_objects
   in
   Dune_package.Lib.make
-    ~dir
+    ~obj_dir
     ~orig_src_dir
     ~name
     ~loc:info.loc

src/lib_info.ml

@@ -88,7 +88,7 @@ let of_library_stanza ~dir ~has_native ~ext_lib ~ext_obj
       (conf : Dune_file.Library.t) =
   let (_loc, lib_name) = conf.name in
   let obj_dir =
-    Obj_dir.make_local ~dir
+    Obj_dir.make_lib ~dir
       ~has_private_modules:(conf.private_modules <> None) lib_name in
   let gen_archive_file ~dir ext =
     Path.relative dir (Lib_name.Local.to_string lib_name ^ ext) in
@@ -196,7 +196,7 @@ let of_dune_lib dp =
     Lib.wrapped dp
     |> Option.map ~f:(fun w -> Dune_file.Library.Inherited.This w)
   in
-  let obj_dir = Obj_dir.make_external ~dir:src_dir in
+  let obj_dir = Lib.obj_dir dp in
   { loc = Lib.loc dp
   ; name = Lib.name dp
   ; kind = Lib.kind dp

src/lib_modules.ml

@@ -160,9 +160,8 @@ let installable_modules t =
   | None -> modules
   | Some alias -> alias :: modules
 
-let version_installed t ~install_dir:(dir) =
-  let obj_dir = Obj_dir.make_external ~dir in
-  let set = Module.set_obj_dir ~obj_dir in
+let version_installed t ~install_dir =
+  let set = Module.set_obj_dir ~obj_dir:install_dir in
   { t with
     alias_module = Option.map ~f:set t.alias_module
   ; modules = Module.Name.Map.map ~f:set t.modules;
@@ -228,13 +227,13 @@ let encode
     ; field "wrapped" Wrapped.encode wrapped
     ]
 
-let decode ~implements ~dir =
+let decode ~implements ~obj_dir =
   let open Stanza.Decoder in
   fields (
-    let+ alias_module = field_o "alias_module" (Module.decode ~dir)
+    let+ alias_module = field_o "alias_module" (Module.decode ~obj_dir)
     and+ main_module_name = field_o "main_module_name" Module.Name.decode
     and+ modules =
-      field ~default:[] "modules" (list (enter (Module.decode ~dir)))
+      field ~default:[] "modules" (list (enter (Module.decode ~obj_dir)))
     and+ wrapped = field "wrapped" Wrapped.decode
     in
     let modules =

src/lib_modules.mli

@@ -1,4 +1,4 @@
-open Stdune
+open! Stdune
 
 type t
 
@@ -32,7 +32,7 @@ val make
 
 val set_modules : t -> Module.Name_map.t -> t
 
-val version_installed : t -> install_dir:Path.t -> t
+val version_installed : t -> install_dir:Obj_dir.t -> t
 
 val for_compilation : t -> Module.Name_map.t
 
@@ -42,7 +42,7 @@ val for_alias : t -> Module.Name_map.t
 
 val encode : t -> Dune_lang.t list
 
-val decode : implements:bool -> dir:Path.t -> t Dune_lang.Decoder.t
+val decode : implements:bool -> obj_dir:Obj_dir.t -> t Dune_lang.Decoder.t
 
 val is_wrapped : t -> bool
 

src/lib_rules.ml

@@ -46,7 +46,7 @@ module Gen (P : sig val sctx : Super_context.t end) = struct
           Fn.id
       in
       let artifacts ~ext modules =
-        List.map modules ~f:(Module.obj_file ~mode ~ext)
+        List.map modules ~f:(Module.obj_file ~kind ~ext)
       in
       let obj_deps =
         Build.paths (artifacts modules ~ext:(Cm_kind.ext kind))
@@ -346,11 +346,11 @@ module Gen (P : sig val sctx : Super_context.t end) = struct
           | Some m ->
             (* These files needs to be alongside stdlib.cma as the
                compiler implicitly adds this module. *)
-            [ Mode.Native, ".cmx"
-            ; Byte, ".cmo"
-            ; Native, ctx.ext_obj ]
-            |> List.iter ~f:(fun (mode, ext) ->
-              let src = Module.obj_file m ~mode ~ext in
+            [ Cm_kind.Cmx, ".cmx"
+            ; Cmo, ".cmo"
+            ; Cmx, ctx.ext_obj ]
+            |> List.iter ~f:(fun (kind, ext) ->
+              let src = Module.obj_file m ~kind ~ext in
               let dst = Path.relative dir ((Module.obj_name m) ^ ext) in
               SC.add_rule sctx ~dir (Build.copy ~src ~dst));
             Module.Name.Map.remove modules name
@@ -524,7 +524,7 @@ module Gen (P : sig val sctx : Super_context.t end) = struct
       ; compile_info
       };
 
-    let objs_dirs = Path.Set.singleton (Obj_dir.byte_dir obj_dir) in
+    let objs_dirs = Path.Set.of_list (Obj_dir.all_cmis obj_dir) in
 
     (cctx,
      Merlin.make ()