Copy virtual library artifacts
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
9b409da352
commit
fb45dbeab0
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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\
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 *)
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
|
@ -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
|
Loading…
Reference in New Issue