Copy virtual library artifacts

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

src/lib.ml

@@ -189,6 +189,8 @@ let plugins      t = t.info.plugins
 let jsoo_runtime t = t.info.jsoo_runtime
 let unique_id    t = t.unique_id
 
+let virtual_     t = t.info.virtual_
+
 let dune_version t = t.info.dune_version
 
 let src_dir t = t.info.src_dir

src/lib.mli

@@ -27,6 +27,8 @@ val archives     : t -> Path.t list Mode.Dict.t
 val plugins      : t -> Path.t list Mode.Dict.t
 val jsoo_runtime : t -> Path.t list
 
+val virtual_ : t -> Lib_info.Virtual.t option
+
 val dune_version : t -> Syntax.Version.t option
 
 (** A unique integer identifier. It is only unique for the duration of

src/lib_name.ml

@@ -53,6 +53,7 @@ module Local = struct
   let to_sexp = Sexp.To_sexp.string
 
   let pp_quoted fmt t = Format.fprintf fmt "%S" t
+  let pp fmt t = Format.fprintf fmt "%s" t
 
   let invalid_message =
     "invalid library name.\n\

src/lib_name.mli

@@ -30,6 +30,7 @@ module Local : sig
   val invalid_message : string
 
   val pp_quoted : t Fmt.t
+  val pp : t Fmt.t
 end
 
 val compare : t -> t -> Ordering.t

src/lib_rules.ml

@@ -17,6 +17,8 @@ module Gen (P : Install_rules.Params) = struct
 
   let opaque = SC.opaque sctx
 
+  module Virtual = Virtual_rules.Gen(P)
+
   (* +-----------------------------------------------------------------+
      | Library stuff                                                   |
      +-----------------------------------------------------------------+ *)
@@ -358,6 +360,8 @@ module Gen (P : Install_rules.Params) = struct
         ; virtual_modules = _ } =
       Dir_contents.modules_of_library dir_contents ~name:(Library.best_name lib)
     in
+    let impl = Virtual.impl ~lib ~scope ~modules in
+    Option.iter impl ~f:(Virtual.setup_copy_rules_for_impl ~dir);
     let source_modules = modules in
     (* Preprocess before adding the alias module as it doesn't need
        preprocessing *)

src/module.ml

@@ -100,6 +100,7 @@ let make ?impl ?intf ?obj_name name =
 let real_unit_name t = Name.of_string (Filename.basename t.obj_name)
 
 let has_impl t = Option.is_some t.impl
+let has_intf t = Option.is_some t.intf
 
 let file t (kind : Ml_kind.t) =
   let file =

src/module.mli

@@ -87,6 +87,7 @@ val cmti_file : t -> obj_dir:Path.t -> Path.t
 val iter : t -> f:(Ml_kind.t -> File.t -> unit) -> unit
 
 val has_impl : t -> bool
+val has_intf : t -> bool
 
 (** Prefix the object name with the library name. *)
 val with_wrapper : t -> libname:Lib_name.Local.t -> t

src/virtual_rules.ml

@@ -0,0 +1,107 @@
+open Import
+open! No_io
+
+module Implementation = struct
+  type t =
+    { vlib            : Lib.t
+    ; impl            : Dune_file.Library.t
+    ; vlib_modules    : Module.t Module.Name.Map.t
+    }
+end
+
+module Gen (P : sig val sctx : Super_context.t end) = struct
+  open P
+  let ctx = Super_context.context sctx
+
+  let setup_copy_rules_for_impl ~dir
+        { Implementation.vlib ; impl ; vlib_modules } =
+    let copy_to_obj_dir =
+      let obj_dir = Utils.library_object_directory ~dir impl.name in
+      fun file ->
+        let dst = Path.relative obj_dir (Path.basename file) in
+        Super_context.add_rule sctx (Build.symlink ~src:file ~dst)
+    in
+    let obj_dir = Lib.obj_dir vlib in
+    let modes =
+      Dune_file.Mode_conf.Set.eval impl.modes
+        ~has_native:(Option.is_some ctx.ocamlopt) in
+    Module.Name.Map.iter vlib_modules ~f:(fun m ->
+      let copy_obj_file ext =
+        copy_to_obj_dir (Module.obj_file m ~obj_dir ~ext) in
+      copy_obj_file (Cm_kind.ext Cmi);
+      if Module.has_impl m then begin
+        if modes.byte then
+          copy_obj_file (Cm_kind.ext Cmo);
+        if modes.native then
+          List.iter [Cm_kind.ext Cmx; ctx.ext_obj] ~f:copy_obj_file
+      end)
+
+  let impl ~(lib : Dune_file.Library.t) ~scope ~modules =
+    Option.map lib.implements ~f:begin fun (loc, implements) ->
+      match Lib.DB.find (Scope.libs scope) implements with
+      | Error _ ->
+        Errors.fail loc
+          "Cannot implement %a as that library isn't available"
+          Lib_name.pp implements
+      | Ok vlib ->
+        let virtual_modules =
+          Option.map (Lib.virtual_ vlib) ~f:(fun (v : Lib_info.Virtual.t) ->
+            v.modules)
+        in
+        let (vlib_modules, virtual_modules) =
+          match virtual_modules with
+          | None ->
+            Errors.fail lib.buildable.loc
+              "Library %a isn't virtual and cannot be implemented"
+              Lib_name.pp implements
+          | Some Unexpanded ->
+            let dir_contents = Dir_contents.get sctx ~dir:(Lib.src_dir vlib) in
+            let { Dir_contents.Library_modules.
+                  virtual_modules
+                ; modules = vlib_modules
+                ; main_module_name = _
+                ; alias_module = _
+                ; wrapped_compat = _
+                } =
+              Dir_contents.modules_of_library dir_contents
+                ~name:(Lib.name vlib) in
+            (vlib_modules, virtual_modules)
+        in
+        let (missing_modules, impl_modules_with_intf) =
+          Module.Name.Map.foldi virtual_modules ~init:([], [])
+            ~f:(fun m _ (mms, ims) ->
+              match Module.Name.Map.find modules m with
+              | None -> (m :: mms, ims)
+              | Some m ->
+                ( mms
+                , if Module.has_intf m then
+                    Module.name m :: ims
+                  else
+                    ims
+                ))
+        in
+        let module_list ms =
+          List.map ms ~f:Module.Name.to_string
+          |> String.concat ~sep:"\n"
+        in
+        if missing_modules <> [] then begin
+          Errors.fail lib.buildable.loc
+            "Library %a cannot implement %a because the following \
+             modules lack an implementation:\n%s"
+            Lib_name.Local.pp lib.name
+            Lib_name.pp implements
+            (module_list missing_modules)
+        end;
+        if impl_modules_with_intf <> [] then begin
+          Errors.fail lib.buildable.loc
+            "The following modules cannot have .mli files as they implement \
+             virtual modules:\n%s"
+            (module_list impl_modules_with_intf)
+        end;
+        { Implementation.
+          impl = lib
+        ; vlib
+        ; vlib_modules
+        }
+    end
+end

src/virtual_rules.mli

@@ -0,0 +1,18 @@
+open Stdune
+
+module Implementation : sig
+  type t
+end
+
+module Gen (S : sig val sctx : Super_context.t end) : sig
+  val setup_copy_rules_for_impl
+    :  dir:Path.t
+    -> Implementation.t
+    -> unit
+
+  val impl
+    :  lib:Dune_file.Library.t
+    -> scope:Scope.t
+    -> modules:Module.Name_map.t
+    -> Implementation.t option
+end