From 61d41841d37f784bf611d879da7fe8033da27180 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 3 Sep 2019 20:07:44 +0700 Subject: [PATCH] Add re_exports field to library This field allows libraries to re-export the interfaces of other libraries Signed-off-by: Rudi Grinberg --- src/dune/dune_file.ml | 8 +++++++- src/dune/dune_file.mli | 1 + src/dune/dune_package.ml | 12 +++++++++++- src/dune/dune_package.mli | 3 +++ src/dune/findlib/findlib.ml | 3 ++- src/dune/lib.ml | 19 ++++++++++++++++++- src/dune/lib.mli | 3 ++- src/dune/lib_info.ml | 13 +++++++++++++ src/dune/lib_info.mli | 8 ++++++++ 9 files changed, 65 insertions(+), 5 deletions(-) diff --git a/src/dune/dune_file.ml b/src/dune/dune_file.ml index 75c6b2dc0647..a98043218006 100644 --- a/src/dune/dune_file.ml +++ b/src/dune/dune_file.ml @@ -1015,6 +1015,7 @@ module Library = struct ; stdlib : Stdlib.t option ; special_builtin_support : Special_builtin_support.t option ; enabled_if : Blang.t + ; re_exports : Predicate_lang.t } let decode = @@ -1073,7 +1074,11 @@ module Library = struct field_o "special_builtin_support" ( Syntax.since Stanza.syntax (1, 10) >>> Special_builtin_support.decode ) - and+ enabled_if = enabled_if ~since:(Some (1, 10)) in + and+ enabled_if = enabled_if ~since:(Some (1, 10)) + and+ re_exports = + field "re_exports" ~default:Predicate_lang.false_ + (Syntax.since Stanza.syntax (2, 0) >>> Predicate_lang.decode) + in let wrapped = Wrapped.make ~wrapped ~implements ~special_builtin_support in @@ -1198,6 +1203,7 @@ module Library = struct ; stdlib ; special_builtin_support ; enabled_if + ; re_exports } )) let has_stubs t = diff --git a/src/dune/dune_file.mli b/src/dune/dune_file.mli index b57854677242..63472eaac736 100644 --- a/src/dune/dune_file.mli +++ b/src/dune/dune_file.mli @@ -280,6 +280,7 @@ module Library : sig ; stdlib : Stdlib.t option ; special_builtin_support : Special_builtin_support.t option ; enabled_if : Blang.t + ; re_exports : Predicate_lang.t } val has_stubs : t -> bool diff --git a/src/dune/dune_package.ml b/src/dune/dune_package.ml index d1c245cd3e24..d6b4670dc804 100644 --- a/src/dune/dune_package.ml +++ b/src/dune/dune_package.ml @@ -35,13 +35,14 @@ module Lib = struct ; modes : Mode.Dict.Set.t ; special_builtin_support : Dune_file.Library.Special_builtin_support.t option + ; re_exports : Lib_name.t list } let make ~loc ~kind ~name ~synopsis ~archives ~plugins ~foreign_objects ~foreign_archives ~jsoo_runtime ~main_module_name ~sub_systems ~requires ~ppx_runtime_deps ~implements ~default_implementation ~virtual_ ~known_implementations ~modules ~modes ~version ~orig_src_dir ~obj_dir - ~special_builtin_support = + ~special_builtin_support ~re_exports = let dir = Obj_dir.dir obj_dir in let map_path p = if Path.is_managed p then @@ -74,6 +75,7 @@ module Lib = struct ; modes ; obj_dir ; special_builtin_support + ; re_exports } let obj_dir t = t.obj_dir @@ -112,6 +114,7 @@ module Lib = struct ; modules ; modes ; special_builtin_support + ; re_exports } = let open Dune_lang.Encoder in let no_loc f (_loc, x) = f x in @@ -148,6 +151,7 @@ module Lib = struct ; field_o "special_builtin_support" Dune_file.Library.Special_builtin_support.encode special_builtin_support + ; field_l "re_exports" Lib_name.encode re_exports ] @ ( Sub_system_name.Map.to_list sub_systems |> List.map ~f:(fun (name, (_ver, sexps)) -> @@ -203,6 +207,9 @@ module Lib = struct field_o "special_builtin_support" ( Syntax.since Stanza.syntax (1, 10) >>> Dune_file.Library.Special_builtin_support.decode ) + and+ re_exports = + field_l "re_exports" + (Syntax.since Stanza.syntax (2, 0) >>> Lib_name.decode) in let known_implementations = Variant.Map.of_list_exn known_implementations @@ -231,6 +238,7 @@ module Lib = struct ; modules ; modes ; special_builtin_support + ; re_exports }) let name t = t.name @@ -278,6 +286,8 @@ module Lib = struct let compare_name x y = Lib_name.compare x.name y.name let wrapped t = Option.map t.modules ~f:Modules.wrapped + + let re_exports t = t.re_exports end type 'sub_system t = diff --git a/src/dune/dune_package.mli b/src/dune/dune_package.mli index 5565873250f7..b035b4b5475b 100644 --- a/src/dune/dune_package.mli +++ b/src/dune/dune_package.mli @@ -58,6 +58,8 @@ module Lib : sig val wrapped : _ t -> Wrapped.t option + val re_exports : _ t -> Lib_name.t list + val make : loc:Loc.t -> kind:Lib_kind.t @@ -83,6 +85,7 @@ module Lib : sig -> obj_dir:Path.t Obj_dir.t -> special_builtin_support: Dune_file.Library.Special_builtin_support.t option + -> re_exports:Lib_name.t list -> 'a t val set_subsystems : 'a t -> 'b Sub_system_name.Map.t -> 'b t diff --git a/src/dune/findlib/findlib.ml b/src/dune/findlib/findlib.ml index 43368a123cc4..a49f509da619 100644 --- a/src/dune/findlib/findlib.ml +++ b/src/dune/findlib/findlib.ml @@ -239,6 +239,7 @@ module Package = struct else discovered in + let re_exports = [] in Dune_package.Lib.make ~orig_src_dir:None ~loc ~kind:Normal ~name:(name t) ~synopsis:(description t) ~archives ~plugins:(plugins t) ~foreign_objects:[] ~foreign_archives:(Mode.Dict.make_both []) @@ -248,7 +249,7 @@ module Package = struct ~virtual_:false ~implements:None ~known_implementations:Variant.Map.empty ~default_implementation:None ~modules:None ~main_module_name:None (* XXX remove *) ~version:(version t) ~modes - ~obj_dir + ~obj_dir ~re_exports ~special_builtin_support: ( (* findlib has been around for much longer than dune, so it is acceptable to have a special case in dune for findlib. *) diff --git a/src/dune/lib.ml b/src/dune/lib.ml index 41181556b29b..a49854450fb2 100644 --- a/src/dune/lib.ml +++ b/src/dune/lib.ml @@ -282,6 +282,7 @@ module T = struct { info : Lib_info.external_ ; name : Lib_name.t ; unique_id : Id.t + ; re_exports : t list Or_exn.t ; requires : t list Or_exn.t ; ppx_runtime_deps : t list Or_exn.t ; pps : t list Or_exn.t @@ -1000,6 +1001,19 @@ end = struct Dep_path.prepend_exn e (Library (src_dir, name))) in let requires = map_error requires in + let re_exports : t list Or_exn.t = + let plang = + match Lib_info.re_exports info with + | Local plang -> plang + | External_ l -> + String.Set.of_list_map l ~f:Lib_name.to_string + |> Predicate_lang.of_string_set + in + let+ requires = requires in + List.filter requires ~f:(fun lib -> + Predicate_lang.exec plang ~standard:Predicate_lang.empty + (Lib_name.to_string lib.name)) + in let ppx_runtime_deps = map_error ppx_runtime_deps in let t = { info @@ -1015,6 +1029,7 @@ end = struct ; default_implementation ; resolved_implementations ; stdlib_dir = db.stdlib_dir + ; re_exports } in t.sub_systems <- @@ -1813,6 +1828,8 @@ let to_dune_lib ({ name; info; _ } as lib) ~modules ~foreign_objects ~dir = use_public_name ~info_field:(Lib_info.implements info) ~lib_field:(implements lib) in + let* re_exports = lib.re_exports in + let re_exports = List.map ~f:(fun t -> t.name) re_exports in let+ default_implementation = use_public_name ~info_field:(Lib_info.default_implementation info) @@ -1827,7 +1844,7 @@ let to_dune_lib ({ name; info; _ } as lib) ~modules ~foreign_objects ~dir = ~modules:(Some modules) ~main_module_name:(Result.ok_exn (main_module_name lib)) ~sub_systems:(Sub_system.dump_config lib) - ~special_builtin_support + ~special_builtin_support ~re_exports module Local : sig type t = private lib diff --git a/src/dune/lib.mli b/src/dune/lib.mli index 0bbd20f0dc68..bd81ec64806c 100644 --- a/src/dune/lib.mli +++ b/src/dune/lib.mli @@ -116,7 +116,8 @@ module Compile : sig (** Return the list of dependencies needed for linking this library/exe *) val requires_link : t -> L.t Or_exn.t Lazy.t - (** Dependencies listed by the user + runtime dependencies from ppx *) + (** Dependencies listed by the user + runtime dependencies from ppx + + exported dependencies *) val direct_requires : t -> L.t Or_exn.t module Resolved_select : sig diff --git a/src/dune/lib_info.ml b/src/dune/lib_info.ml index 05139f8c522c..982521971158 100644 --- a/src/dune/lib_info.ml +++ b/src/dune/lib_info.ml @@ -59,6 +59,12 @@ module Source = struct | External a -> External (f a) end +module Re_exports = struct + type t = + | Local of Predicate_lang.t + | External_ of Lib_name.t list +end + module Enabled_status = struct type t = | Normal @@ -99,6 +105,7 @@ type 'path t = ; modes : Mode.Dict.Set.t ; special_builtin_support : Dune_file.Library.Special_builtin_support.t option + ; re_exports : Re_exports.t } let name t = t.name @@ -161,6 +168,8 @@ let orig_src_dir t = t.orig_src_dir let best_src_dir t = Option.value ~default:t.src_dir t.orig_src_dir +let re_exports t = t.re_exports + let user_written_deps t = List.fold_left (t.virtual_deps @ t.ppx_runtime_deps) ~init:(Deps.to_lib_deps t.requires) ~f:(fun acc s -> @@ -255,6 +264,7 @@ let of_library_stanza ~dir |Private _ -> None in + let re_exports = Re_exports.Local conf.re_exports in { loc = conf.buildable.loc ; name ; kind = conf.kind @@ -286,6 +296,7 @@ let of_library_stanza ~dir ; modes ; wrapped = Some conf.wrapped ; special_builtin_support = conf.special_builtin_support + ; re_exports } let of_dune_lib dp = @@ -303,6 +314,7 @@ let of_dune_lib dp = |> Option.map ~f:(fun w -> Dune_file.Library.Inherited.This w) in let obj_dir = Lib.obj_dir dp in + let re_exports = Re_exports.External_ (Lib.re_exports dp) in { loc = Lib.loc dp ; name = Lib.name dp ; kind = Lib.kind dp @@ -334,6 +346,7 @@ let of_dune_lib dp = ; modes = Lib.modes dp ; wrapped ; special_builtin_support = Lib.special_builtin_support dp + ; re_exports } type external_ = Path.t t diff --git a/src/dune/lib_info.mli b/src/dune/lib_info.mli index a6caf8e33c4f..3288ea7e271d 100644 --- a/src/dune/lib_info.mli +++ b/src/dune/lib_info.mli @@ -37,6 +37,12 @@ module Source : sig | External of 'a end +module Re_exports : sig + type t = + | Local of Predicate_lang.t + | External_ of Lib_name.t list +end + module Enabled_status : sig type t = | Normal @@ -105,6 +111,8 @@ val orig_src_dir : 'path t -> 'path option val version : _ t -> string option +val re_exports : _ t -> Re_exports.t + (** Directory where the source files for the library are located. Returns the original src dir when it exists *) val best_src_dir : 'path t -> 'path