Merge pull request #1219 from rgrinberg/lib-info-virtual
Add virtual implementation info to lib info
This commit is contained in:
commit
9409f46cc0
|
@ -231,8 +231,7 @@ end = struct
|
||||||
|
|
||||||
let make (lib : Library.t) ~dir (modules : Module.Name_map.t)
|
let make (lib : Library.t) ~dir (modules : Module.Name_map.t)
|
||||||
~virtual_modules =
|
~virtual_modules =
|
||||||
let main_module_name =
|
let main_module_name = Library.main_module_name lib in
|
||||||
Module.Name.of_string (Lib_name.Local.to_string lib.name) in
|
|
||||||
let (modules, wrapped_compat) =
|
let (modules, wrapped_compat) =
|
||||||
let wrap_modules modules =
|
let wrap_modules modules =
|
||||||
let open Module.Name.Infix in
|
let open Module.Name.Infix in
|
||||||
|
|
|
@ -916,7 +916,7 @@ module Library = struct
|
||||||
; no_keep_locs : bool
|
; no_keep_locs : bool
|
||||||
; dune_version : Syntax.Version.t
|
; dune_version : Syntax.Version.t
|
||||||
; virtual_modules : Ordered_set_lang.t option
|
; virtual_modules : Ordered_set_lang.t option
|
||||||
; implements : (Loc.t * string) option
|
; implements : (Loc.t * Lib_name.t) option
|
||||||
}
|
}
|
||||||
|
|
||||||
let dparse =
|
let dparse =
|
||||||
|
@ -958,7 +958,7 @@ module Library = struct
|
||||||
and implements =
|
and implements =
|
||||||
field_o "implements" (
|
field_o "implements" (
|
||||||
Syntax.since Variants.syntax (0, 1)
|
Syntax.since Variants.syntax (0, 1)
|
||||||
>>= fun () -> (located string))
|
>>= fun () -> located Lib_name.dparse)
|
||||||
in
|
in
|
||||||
let name =
|
let name =
|
||||||
let open Syntax.Version.Infix in
|
let open Syntax.Version.Infix in
|
||||||
|
@ -993,7 +993,8 @@ module Library = struct
|
||||||
of_sexp_errorf
|
of_sexp_errorf
|
||||||
(Ordered_set_lang.loc virtual_modules
|
(Ordered_set_lang.loc virtual_modules
|
||||||
|> Option.value_exn)
|
|> Option.value_exn)
|
||||||
"A library cannot be both virtual and implement %s" impl);
|
"A library cannot be both virtual and implement %s"
|
||||||
|
(Lib_name.to_string impl));
|
||||||
begin match virtual_modules, wrapped, implements with
|
begin match virtual_modules, wrapped, implements with
|
||||||
| Some _, Some (loc, Wrapped.Simple false), _ ->
|
| Some _, Some (loc, Wrapped.Simple false), _ ->
|
||||||
of_sexp_error loc "A virtual library must be wrapped"
|
of_sexp_error loc "A virtual library must be wrapped"
|
||||||
|
@ -1052,6 +1053,9 @@ module Library = struct
|
||||||
| Some p -> snd p.name
|
| Some p -> snd p.name
|
||||||
|
|
||||||
let is_virtual t = Option.is_some t.virtual_modules
|
let is_virtual t = Option.is_some t.virtual_modules
|
||||||
|
|
||||||
|
let main_module_name t =
|
||||||
|
Module.Name.of_local_lib_name t.name
|
||||||
end
|
end
|
||||||
|
|
||||||
module Install_conf = struct
|
module Install_conf = struct
|
||||||
|
|
|
@ -250,7 +250,7 @@ module Library : sig
|
||||||
; no_keep_locs : bool
|
; no_keep_locs : bool
|
||||||
; dune_version : Syntax.Version.t
|
; dune_version : Syntax.Version.t
|
||||||
; virtual_modules : Ordered_set_lang.t option
|
; virtual_modules : Ordered_set_lang.t option
|
||||||
; implements : (Loc.t * string) option
|
; implements : (Loc.t * Lib_name.t) option
|
||||||
}
|
}
|
||||||
|
|
||||||
val has_stubs : t -> bool
|
val has_stubs : t -> bool
|
||||||
|
@ -259,6 +259,7 @@ module Library : sig
|
||||||
val archive : t -> dir:Path.t -> ext:string -> Path.t
|
val archive : t -> dir:Path.t -> ext:string -> Path.t
|
||||||
val best_name : t -> Lib_name.t
|
val best_name : t -> Lib_name.t
|
||||||
val is_virtual : t -> bool
|
val is_virtual : t -> bool
|
||||||
|
val main_module_name : t -> Module.Name.t
|
||||||
end
|
end
|
||||||
|
|
||||||
module Install_conf : sig
|
module Install_conf : sig
|
||||||
|
|
37
src/lib.ml
37
src/lib.ml
|
@ -82,6 +82,7 @@ type t =
|
||||||
; pps : t list Or_exn.t
|
; pps : t list Or_exn.t
|
||||||
; resolved_selects : Resolved_select.t list
|
; resolved_selects : Resolved_select.t list
|
||||||
; user_written_deps : Dune_file.Lib_deps.t
|
; user_written_deps : Dune_file.Lib_deps.t
|
||||||
|
; implements : t Or_exn.t option
|
||||||
; (* This is mutable to avoid this error:
|
; (* This is mutable to avoid this error:
|
||||||
|
|
||||||
{[
|
{[
|
||||||
|
@ -188,6 +189,8 @@ let plugins t = t.info.plugins
|
||||||
let jsoo_runtime t = t.info.jsoo_runtime
|
let jsoo_runtime t = t.info.jsoo_runtime
|
||||||
let unique_id t = t.unique_id
|
let unique_id t = t.unique_id
|
||||||
|
|
||||||
|
let virtual_ t = t.info.virtual_
|
||||||
|
|
||||||
let dune_version t = t.info.dune_version
|
let dune_version t = t.info.dune_version
|
||||||
|
|
||||||
let src_dir t = t.info.src_dir
|
let src_dir t = t.info.src_dir
|
||||||
|
@ -197,6 +200,11 @@ let is_local t = Path.is_managed t.info.obj_dir
|
||||||
|
|
||||||
let status t = t.info.status
|
let status t = t.info.status
|
||||||
|
|
||||||
|
let foreign_objects t ~ext =
|
||||||
|
let obj_dir = obj_dir t in
|
||||||
|
List.map t.info.foreign_objects ~f:(fun p ->
|
||||||
|
Path.extend_basename (Path.relative obj_dir p) ~suffix:ext)
|
||||||
|
|
||||||
let package t =
|
let package t =
|
||||||
match t.info.status with
|
match t.info.status with
|
||||||
| Installed -> Some (Lib_name.package_name t.name)
|
| Installed -> Some (Lib_name.package_name t.name)
|
||||||
|
@ -492,11 +500,33 @@ let rec instantiate db name (info : Lib_info.t) ~stack ~hidden =
|
||||||
|
|
||||||
let allow_private_deps = Lib_info.Status.is_private info.status in
|
let allow_private_deps = Lib_info.Status.is_private info.status in
|
||||||
|
|
||||||
|
let resolve (loc, name) =
|
||||||
|
resolve_dep db (name : Lib_name.t) ~allow_private_deps ~loc ~stack in
|
||||||
|
|
||||||
|
let implements = Option.map info.implements ~f:resolve in
|
||||||
|
|
||||||
let requires, pps, resolved_selects =
|
let requires, pps, resolved_selects =
|
||||||
resolve_user_deps db info.requires ~allow_private_deps ~pps:info.pps ~stack
|
resolve_user_deps db info.requires ~allow_private_deps ~pps:info.pps ~stack
|
||||||
in
|
in
|
||||||
|
let requires =
|
||||||
|
match implements with
|
||||||
|
| None -> requires
|
||||||
|
| Some implements ->
|
||||||
|
implements >>= fun implements ->
|
||||||
|
implements.requires >>= fun irequires ->
|
||||||
|
requires >>| fun requires ->
|
||||||
|
L.remove_dups (List.rev_append irequires requires)
|
||||||
|
in
|
||||||
let ppx_runtime_deps =
|
let ppx_runtime_deps =
|
||||||
resolve_simple_deps db info.ppx_runtime_deps ~allow_private_deps ~stack
|
let ppx_rd =
|
||||||
|
resolve_simple_deps db info.ppx_runtime_deps ~allow_private_deps ~stack in
|
||||||
|
match implements with
|
||||||
|
| None -> ppx_rd
|
||||||
|
| Some implements ->
|
||||||
|
implements >>= fun implements ->
|
||||||
|
implements.ppx_runtime_deps >>= fun ippx_rd ->
|
||||||
|
ppx_rd >>| fun ppx_rd ->
|
||||||
|
L.remove_dups (List.rev_append ippx_rd ppx_rd)
|
||||||
in
|
in
|
||||||
let map_error x =
|
let map_error x =
|
||||||
Result.map_error x ~f:(fun e ->
|
Result.map_error x ~f:(fun e ->
|
||||||
|
@ -504,8 +534,6 @@ let rec instantiate db name (info : Lib_info.t) ~stack ~hidden =
|
||||||
in
|
in
|
||||||
let requires = map_error requires in
|
let requires = map_error requires in
|
||||||
let ppx_runtime_deps = map_error ppx_runtime_deps in
|
let ppx_runtime_deps = map_error ppx_runtime_deps in
|
||||||
let resolve (loc, name) =
|
|
||||||
resolve_dep db (name : Lib_name.t) ~allow_private_deps ~loc ~stack in
|
|
||||||
let t =
|
let t =
|
||||||
{ info
|
{ info
|
||||||
; name
|
; name
|
||||||
|
@ -516,6 +544,7 @@ let rec instantiate db name (info : Lib_info.t) ~stack ~hidden =
|
||||||
; resolved_selects
|
; resolved_selects
|
||||||
; user_written_deps = Lib_info.user_written_deps info
|
; user_written_deps = Lib_info.user_written_deps info
|
||||||
; sub_systems = Sub_system_name.Map.empty
|
; sub_systems = Sub_system_name.Map.empty
|
||||||
|
; implements
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
t.sub_systems <-
|
t.sub_systems <-
|
||||||
|
@ -702,7 +731,7 @@ and resolve_user_deps db deps ~allow_private_deps ~pps ~stack =
|
||||||
in
|
in
|
||||||
(deps, pps, resolved_selects)
|
(deps, pps, resolved_selects)
|
||||||
|
|
||||||
and closure_with_overlap_checks db ts ~stack =
|
and closure_with_overlap_checks db ts ~stack =
|
||||||
let visited = ref Lib_name.Map.empty in
|
let visited = ref Lib_name.Map.empty in
|
||||||
let res = ref [] in
|
let res = ref [] in
|
||||||
let orig_stack = stack in
|
let orig_stack = stack in
|
||||||
|
|
|
@ -27,6 +27,10 @@ val archives : t -> Path.t list Mode.Dict.t
|
||||||
val plugins : t -> Path.t list Mode.Dict.t
|
val plugins : t -> Path.t list Mode.Dict.t
|
||||||
val jsoo_runtime : t -> Path.t list
|
val jsoo_runtime : t -> Path.t list
|
||||||
|
|
||||||
|
val foreign_objects : t -> ext:string -> Path.t list
|
||||||
|
|
||||||
|
val virtual_ : t -> Lib_info.Virtual.t option
|
||||||
|
|
||||||
val dune_version : t -> Syntax.Version.t option
|
val dune_version : t -> Syntax.Version.t option
|
||||||
|
|
||||||
(** A unique integer identifier. It is only unique for the duration of
|
(** A unique integer identifier. It is only unique for the duration of
|
||||||
|
|
|
@ -41,6 +41,23 @@ module Deps = struct
|
||||||
| Complex l -> l
|
| Complex l -> l
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Virtual = struct
|
||||||
|
module Modules = struct
|
||||||
|
type t =
|
||||||
|
| Unexpanded
|
||||||
|
end
|
||||||
|
|
||||||
|
module Dep_graph = struct
|
||||||
|
type t =
|
||||||
|
| Local
|
||||||
|
end
|
||||||
|
|
||||||
|
type t =
|
||||||
|
{ modules : Modules.t
|
||||||
|
; dep_graph : Dep_graph.t
|
||||||
|
}
|
||||||
|
end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ loc : Loc.t
|
{ loc : Loc.t
|
||||||
; kind : Dune_file.Library.Kind.t
|
; kind : Dune_file.Library.Kind.t
|
||||||
|
@ -51,6 +68,7 @@ type t =
|
||||||
; synopsis : string option
|
; synopsis : string option
|
||||||
; archives : Path.t list Mode.Dict.t
|
; archives : Path.t list Mode.Dict.t
|
||||||
; plugins : Path.t list Mode.Dict.t
|
; plugins : Path.t list Mode.Dict.t
|
||||||
|
; foreign_objects : string list
|
||||||
; foreign_archives : Path.t list Mode.Dict.t
|
; foreign_archives : Path.t list Mode.Dict.t
|
||||||
; jsoo_runtime : Path.t list
|
; jsoo_runtime : Path.t list
|
||||||
; requires : Deps.t
|
; requires : Deps.t
|
||||||
|
@ -60,6 +78,8 @@ type t =
|
||||||
; virtual_deps : (Loc.t * Lib_name.t) list
|
; virtual_deps : (Loc.t * Lib_name.t) list
|
||||||
; dune_version : Syntax.Version.t option
|
; dune_version : Syntax.Version.t option
|
||||||
; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t
|
; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t
|
||||||
|
; virtual_ : Virtual.t option
|
||||||
|
; implements : (Loc.t * Lib_name.t) option
|
||||||
}
|
}
|
||||||
|
|
||||||
let user_written_deps t =
|
let user_written_deps t =
|
||||||
|
@ -82,19 +102,40 @@ let of_library_stanza ~dir ~ext_lib (conf : Dune_file.Library.t) =
|
||||||
| None -> Status.Private (Dune_project.name conf.project)
|
| None -> Status.Private (Dune_project.name conf.project)
|
||||||
| Some p -> Public p.package
|
| Some p -> Public p.package
|
||||||
in
|
in
|
||||||
let foreign_archives =
|
let virtual_library = Dune_file.Library.is_virtual conf in
|
||||||
|
let (foreign_archives, foreign_objects) =
|
||||||
let stubs =
|
let stubs =
|
||||||
if Dune_file.Library.has_stubs conf then
|
if Dune_file.Library.has_stubs conf then
|
||||||
[Dune_file.Library.stubs_archive conf ~dir ~ext_lib]
|
[Dune_file.Library.stubs_archive conf ~dir ~ext_lib]
|
||||||
else
|
else
|
||||||
[]
|
[]
|
||||||
in
|
in
|
||||||
{ Mode.Dict.
|
({ Mode.Dict.
|
||||||
byte = stubs
|
byte = stubs
|
||||||
; native =
|
; native =
|
||||||
Path.relative dir (Lib_name.Local.to_string conf.name ^ ext_lib)
|
Path.relative dir (Lib_name.Local.to_string conf.name ^ ext_lib)
|
||||||
:: stubs
|
:: stubs
|
||||||
}
|
}
|
||||||
|
, List.map (conf.c_names @ conf.cxx_names) ~f:snd
|
||||||
|
)
|
||||||
|
in
|
||||||
|
let virtual_ =
|
||||||
|
Option.map conf.virtual_modules ~f:(fun _ ->
|
||||||
|
{ Virtual.
|
||||||
|
modules = Virtual.Modules.Unexpanded
|
||||||
|
; dep_graph = Virtual.Dep_graph.Local
|
||||||
|
}
|
||||||
|
)
|
||||||
|
in
|
||||||
|
let (archives, plugins) =
|
||||||
|
if virtual_library then
|
||||||
|
( Mode.Dict.make_both []
|
||||||
|
, Mode.Dict.make_both []
|
||||||
|
)
|
||||||
|
else
|
||||||
|
( archive_files ~f_ext:Mode.compiled_lib_ext
|
||||||
|
, archive_files ~f_ext:Mode.plugin_ext
|
||||||
|
)
|
||||||
in
|
in
|
||||||
{ loc = conf.buildable.loc
|
{ loc = conf.buildable.loc
|
||||||
; kind = conf.kind
|
; kind = conf.kind
|
||||||
|
@ -102,9 +143,10 @@ let of_library_stanza ~dir ~ext_lib (conf : Dune_file.Library.t) =
|
||||||
; obj_dir = Utils.library_object_directory ~dir conf.name
|
; obj_dir = Utils.library_object_directory ~dir conf.name
|
||||||
; version = None
|
; version = None
|
||||||
; synopsis = conf.synopsis
|
; synopsis = conf.synopsis
|
||||||
; archives = archive_files ~f_ext:Mode.compiled_lib_ext
|
; archives
|
||||||
; plugins = archive_files ~f_ext:Mode.plugin_ext
|
; plugins
|
||||||
; optional = conf.optional
|
; optional = conf.optional
|
||||||
|
; foreign_objects
|
||||||
; foreign_archives
|
; foreign_archives
|
||||||
; jsoo_runtime
|
; jsoo_runtime
|
||||||
; status
|
; status
|
||||||
|
@ -114,6 +156,8 @@ let of_library_stanza ~dir ~ext_lib (conf : Dune_file.Library.t) =
|
||||||
; pps = Dune_file.Preprocess_map.pps conf.buildable.preprocess
|
; pps = Dune_file.Preprocess_map.pps conf.buildable.preprocess
|
||||||
; sub_systems = conf.sub_systems
|
; sub_systems = conf.sub_systems
|
||||||
; dune_version = Some conf.dune_version
|
; dune_version = Some conf.dune_version
|
||||||
|
; virtual_
|
||||||
|
; implements = conf.implements
|
||||||
}
|
}
|
||||||
|
|
||||||
let of_findlib_package pkg =
|
let of_findlib_package pkg =
|
||||||
|
@ -140,8 +184,11 @@ let of_findlib_package pkg =
|
||||||
; virtual_deps = []
|
; virtual_deps = []
|
||||||
; optional = false
|
; optional = false
|
||||||
; status = Installed
|
; status = Installed
|
||||||
|
; foreign_objects = []
|
||||||
; (* We don't know how these are named for external libraries *)
|
; (* We don't know how these are named for external libraries *)
|
||||||
foreign_archives = Mode.Dict.make_both []
|
foreign_archives = Mode.Dict.make_both []
|
||||||
; sub_systems = sub_systems
|
; sub_systems = sub_systems
|
||||||
; dune_version = None
|
; dune_version = None
|
||||||
|
; virtual_ = None
|
||||||
|
; implements = None
|
||||||
}
|
}
|
||||||
|
|
|
@ -21,6 +21,23 @@ module Deps : sig
|
||||||
val of_lib_deps : Dune_file.Lib_deps.t -> t
|
val of_lib_deps : Dune_file.Lib_deps.t -> t
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Virtual : sig
|
||||||
|
module Modules : sig
|
||||||
|
type t = private
|
||||||
|
| Unexpanded
|
||||||
|
end
|
||||||
|
|
||||||
|
module Dep_graph : sig
|
||||||
|
type t = private
|
||||||
|
| Local
|
||||||
|
end
|
||||||
|
|
||||||
|
type t = private
|
||||||
|
{ modules : Modules.t
|
||||||
|
; dep_graph : Dep_graph.t
|
||||||
|
}
|
||||||
|
end
|
||||||
|
|
||||||
type t = private
|
type t = private
|
||||||
{ loc : Loc.t
|
{ loc : Loc.t
|
||||||
; kind : Dune_file.Library.Kind.t
|
; kind : Dune_file.Library.Kind.t
|
||||||
|
@ -31,6 +48,7 @@ type t = private
|
||||||
; synopsis : string option
|
; synopsis : string option
|
||||||
; archives : Path.t list Mode.Dict.t
|
; archives : Path.t list Mode.Dict.t
|
||||||
; plugins : Path.t list Mode.Dict.t
|
; plugins : Path.t list Mode.Dict.t
|
||||||
|
; foreign_objects : string list
|
||||||
; foreign_archives : Path.t list Mode.Dict.t (** [.a/.lib/...] files *)
|
; foreign_archives : Path.t list Mode.Dict.t (** [.a/.lib/...] files *)
|
||||||
; jsoo_runtime : Path.t list
|
; jsoo_runtime : Path.t list
|
||||||
; requires : Deps.t
|
; requires : Deps.t
|
||||||
|
@ -40,6 +58,8 @@ type t = private
|
||||||
; virtual_deps : (Loc.t * Lib_name.t) list
|
; virtual_deps : (Loc.t * Lib_name.t) list
|
||||||
; dune_version : Syntax.Version.t option
|
; dune_version : Syntax.Version.t option
|
||||||
; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t
|
; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t
|
||||||
|
; virtual_ : Virtual.t option
|
||||||
|
; implements : (Loc.t * Lib_name.t) option
|
||||||
}
|
}
|
||||||
|
|
||||||
val of_library_stanza
|
val of_library_stanza
|
||||||
|
|
|
@ -53,6 +53,7 @@ module Local = struct
|
||||||
let to_sexp = Sexp.To_sexp.string
|
let to_sexp = Sexp.To_sexp.string
|
||||||
|
|
||||||
let pp_quoted fmt t = Format.fprintf fmt "%S" t
|
let pp_quoted fmt t = Format.fprintf fmt "%S" t
|
||||||
|
let pp fmt t = Format.fprintf fmt "%s" t
|
||||||
|
|
||||||
let invalid_message =
|
let invalid_message =
|
||||||
"invalid library name.\n\
|
"invalid library name.\n\
|
||||||
|
|
|
@ -30,6 +30,7 @@ module Local : sig
|
||||||
val invalid_message : string
|
val invalid_message : string
|
||||||
|
|
||||||
val pp_quoted : t Fmt.t
|
val pp_quoted : t Fmt.t
|
||||||
|
val pp : t Fmt.t
|
||||||
end
|
end
|
||||||
|
|
||||||
val compare : t -> t -> Ordering.t
|
val compare : t -> t -> Ordering.t
|
||||||
|
|
|
@ -17,6 +17,8 @@ module Gen (P : Install_rules.Params) = struct
|
||||||
|
|
||||||
let opaque = SC.opaque sctx
|
let opaque = SC.opaque sctx
|
||||||
|
|
||||||
|
module Virtual = Virtual_rules.Gen(P)
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
(* +-----------------------------------------------------------------+
|
||||||
| Library stuff |
|
| Library stuff |
|
||||||
+-----------------------------------------------------------------+ *)
|
+-----------------------------------------------------------------+ *)
|
||||||
|
@ -283,8 +285,7 @@ module Gen (P : Install_rules.Params) = struct
|
||||||
build_cxx_file lib ~scope ~dir ~includes (resolve_name name ~ext:".cpp")
|
build_cxx_file lib ~scope ~dir ~includes (resolve_name name ~ext:".cpp")
|
||||||
)
|
)
|
||||||
|
|
||||||
let build_stubs lib ~dir ~scope ~requires ~dir_contents =
|
let build_stubs lib ~dir ~scope ~requires ~dir_contents ~vlib_stubs_o_files =
|
||||||
let vlib_stubs_o_files = [] in (* TODO *)
|
|
||||||
let lib_o_files =
|
let lib_o_files =
|
||||||
if Library.has_stubs lib then
|
if Library.has_stubs lib then
|
||||||
build_o_files lib ~dir ~scope ~requires ~dir_contents
|
build_o_files lib ~dir ~scope ~requires ~dir_contents
|
||||||
|
@ -358,6 +359,8 @@ module Gen (P : Install_rules.Params) = struct
|
||||||
; virtual_modules = _ } =
|
; virtual_modules = _ } =
|
||||||
Dir_contents.modules_of_library dir_contents ~name:(Library.best_name lib)
|
Dir_contents.modules_of_library dir_contents ~name:(Library.best_name lib)
|
||||||
in
|
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
|
let source_modules = modules in
|
||||||
(* Preprocess before adding the alias module as it doesn't need
|
(* Preprocess before adding the alias module as it doesn't need
|
||||||
preprocessing *)
|
preprocessing *)
|
||||||
|
@ -418,8 +421,13 @@ module Gen (P : Install_rules.Params) = struct
|
||||||
~f:(build_alias_module ~main_module_name ~modules ~cctx ~dynlink
|
~f:(build_alias_module ~main_module_name ~modules ~cctx ~dynlink
|
||||||
~js_of_ocaml);
|
~js_of_ocaml);
|
||||||
|
|
||||||
if Library.has_stubs lib then
|
let vlib_stubs_o_files =
|
||||||
build_stubs lib ~dir ~scope ~requires ~dir_contents;
|
match impl with
|
||||||
|
| None -> []
|
||||||
|
| Some impl -> Virtual.vlib_stubs_o_files impl
|
||||||
|
in
|
||||||
|
if Library.has_stubs lib || not (List.is_empty vlib_stubs_o_files) then
|
||||||
|
build_stubs lib ~dir ~scope ~requires ~dir_contents ~vlib_stubs_o_files;
|
||||||
|
|
||||||
setup_file_deps lib ~dir ~obj_dir ~modules ~wrapped_compat;
|
setup_file_deps lib ~dir ~obj_dir ~modules ~wrapped_compat;
|
||||||
|
|
||||||
|
|
|
@ -28,6 +28,9 @@ module Name = struct
|
||||||
module Map = String.Map
|
module Map = String.Map
|
||||||
module Top_closure = Top_closure.String
|
module Top_closure = Top_closure.String
|
||||||
module Infix = Comparable.Operators(T)
|
module Infix = Comparable.Operators(T)
|
||||||
|
|
||||||
|
let of_local_lib_name s =
|
||||||
|
of_string (Lib_name.Local.to_string s)
|
||||||
end
|
end
|
||||||
|
|
||||||
module Syntax = struct
|
module Syntax = struct
|
||||||
|
@ -97,6 +100,7 @@ let make ?impl ?intf ?obj_name name =
|
||||||
let real_unit_name t = Name.of_string (Filename.basename t.obj_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_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 t (kind : Ml_kind.t) =
|
||||||
let file =
|
let file =
|
||||||
|
|
|
@ -24,6 +24,8 @@ module Name : sig
|
||||||
module Top_closure : Top_closure.S with type key := t
|
module Top_closure : Top_closure.S with type key := t
|
||||||
|
|
||||||
module Infix : Comparable.OPS with type t = t
|
module Infix : Comparable.OPS with type t = t
|
||||||
|
|
||||||
|
val of_local_lib_name : Lib_name.Local.t -> t
|
||||||
end
|
end
|
||||||
|
|
||||||
module Syntax : sig
|
module Syntax : sig
|
||||||
|
@ -85,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 iter : t -> f:(Ml_kind.t -> File.t -> unit) -> unit
|
||||||
|
|
||||||
val has_impl : t -> bool
|
val has_impl : t -> bool
|
||||||
|
val has_intf : t -> bool
|
||||||
|
|
||||||
(** Prefix the object name with the library name. *)
|
(** Prefix the object name with the library name. *)
|
||||||
val with_wrapper : t -> libname:Lib_name.Local.t -> t
|
val with_wrapper : t -> libname:Lib_name.Local.t -> t
|
||||||
|
|
|
@ -0,0 +1,110 @@
|
||||||
|
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 vlib_stubs_o_files { Implementation.vlib ; _ } =
|
||||||
|
Lib.foreign_objects vlib ~ext:ctx.ext_obj
|
||||||
|
|
||||||
|
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,20 @@
|
||||||
|
open Stdune
|
||||||
|
|
||||||
|
module Implementation : sig
|
||||||
|
type t
|
||||||
|
end
|
||||||
|
|
||||||
|
module Gen (S : sig val sctx : Super_context.t end) : sig
|
||||||
|
val vlib_stubs_o_files : Implementation.t -> Path.t list
|
||||||
|
|
||||||
|
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