From 51ce0c2dafbfcea4983b9d89d77780636284a288 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 2 Mar 2017 16:57:28 +0000 Subject: [PATCH] Restrict the scope of internal names Otherwise building several packages at once doesn't always work --- bin/main.ml | 8 ++- doc/manual.org | 51 +++++++++++++---- src/build_system.ml | 2 +- src/gen_rules.ml | 65 ++++++++++++++-------- src/lib_db.ml | 131 +++++++++++++++++++++++++------------------- src/lib_db.mli | 11 ++-- src/vfile_kind.ml | 28 ++++++---- src/vfile_kind.mli | 8 +-- 8 files changed, 192 insertions(+), 112 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 17413035..7b2d027e 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -34,8 +34,9 @@ let set_common c = module Main = struct include Jbuilder.Main - let setup ?only_package common = - setup ?workspace_file:common.workspace_file ?only_package () + let setup ?only_package ?filter_out_optional_stanzas_with_missing_deps common = + setup ?workspace_file:common.workspace_file ?only_package + ?filter_out_optional_stanzas_with_missing_deps () end let do_build (setup : Main.setup) targets = @@ -357,7 +358,8 @@ let external_lib_deps = let go common only_missing targets = set_common common; Future.Scheduler.go ~log:(create_log ()) - (Main.setup common >>= fun setup -> + (Main.setup common ~filter_out_optional_stanzas_with_missing_deps:false + >>= fun setup -> let targets = resolve_targets common setup targets in let failure = String_map.fold ~init:false diff --git a/doc/manual.org b/doc/manual.org index 1e307005..a40cec6f 100644 --- a/doc/manual.org +++ b/doc/manual.org @@ -293,13 +293,8 @@ the library and you are free to expose only the modules you want. =Foo=: =(modules (:standard \ foo))= - =(libraries ())= is used to specify the - dependencies of the library. In here you should put library - names. For library that are present in the workspace, you can use - either the real name or the public name. For libraries that are part - of the installed world, you need to use the public name. For - instance: =(libraries (base re))=. In addition to direct - dependencies you can specify alternative dependencies. This is - described in the [[Alternative dependencies][alternative dependencies section]] + dependencies of the library. See the [[Library dependencies][section about library + dependencies]] for more details - =(wrapped )= specifies whether the modules of the library should be available only through of the toplevel library module, or @@ -411,8 +406,9 @@ can always rely on =.exe= being available. == are: -- =(libraries ())= is the same as the - =(libraries ...)= field of [[library][libraries]] +- =(libraries ())= specifies the library + dependencies. See the [[Library dependencies][section about library dependencies]] for more + details - =(modules )= specifies which modules in the current directory Jbuilder should consider when building @@ -632,7 +628,42 @@ In addition, =(action ...)= fields support the following special variables: The =${:...}= forms are what allows you to write custom rules that work transparently whether things are installed or not. -***** Alternative dependencies +***** Library dependencies + +Dependencies on libraries are specified using =(libraries ...)= fields +in =library= and =executables= stanzas. + +For library that are present in the workspace, you can use either the +real name (with some restrictions, see below) or the public name. For +libraries that are part of the installed world, you need to use the +public name. For instance: =(libraries (base re))=. + +When resolving libraries, libraries that are part of the workspace are +always prefered to ones that are part of the installed world. + +****** Scope of internal library names + +The scope of internal library names is not the whole workspace. It is +restricted to the sub-tree starting from the closest parent containing +a =.opam= file. Moreover, a sub-tree containing +=.opam= doesn' t inherit the internal names available in its +parent scope. + +The idea behing this rule is that public library names must be +universally unique, but internal ones don't need to. In particular you +might have private libraries that are only used for tests or building +an executable. + +As a result, when you create a workspace including several projects +there might be a name clash between internal library names. + +This scoping rule ensure that this won't be a problem. + +****** Alternative dependencies + +In addition to direct dependencies you can specify alternative +dependencies. This is described in the [[Alternative dependencies][alternative dependencies +section]] It is sometimes the case that one wants to not depend on a specific library, but instead on whatever is already installed. For instance to diff --git a/src/build_system.ml b/src/build_system.ml index 9d7c6f44..8e723d7d 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -149,7 +149,7 @@ let get_file : type a. t -> Path.t -> a File_kind.t -> a File_spec.t = fun t fn file let save_vfile (type a) (module K : Vfile_kind.S with type t = a) fn x = - K.save x ~filename:(Path.to_string fn) + K.save fn x module Build_exec = struct open Build.Repr diff --git a/src/gen_rules.ml b/src/gen_rules.ml index fd0a0642..42647291 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -96,10 +96,11 @@ let obj_name_of_basename fn = module type Params = sig val context : Context.t val file_tree : File_tree.t - val stanzas : (Path.t * Jbuild_types.Stanza.t list) list + val stanzas : (Path.t * Stanza.t list) list val packages : Package.t String_map.t val filter_out_optional_stanzas_with_missing_deps : bool val alias_store : Alias.Store.t + val dirs_with_dot_opam_files : Path.Set.t end module Gen(P : Params) = struct @@ -119,6 +120,16 @@ module Gen(P : Params) = struct ; ctx_dir = Path.append context.build_dir dir ; stanzas }) + + let internal_libraries = + List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; _ } -> + List.filter_map stanzas ~f:(fun stanza -> + match (stanza : Stanza.t) with + | Library lib -> Some (ctx_dir, lib) + | _ -> None)) + + let dirs_with_dot_opam_files = + Path.Set.map dirs_with_dot_opam_files ~f:(Path.append context.build_dir) end let ctx = P.context @@ -151,32 +162,35 @@ module Gen(P : Params) = struct module Lib_db = struct open Lib_db - let t = create findlib (List.map P.stanzas ~f:(fun d -> (d.ctx_dir, d.stanzas))) + let t = + create findlib P.internal_libraries + ~dirs_with_dot_opam_files:P.dirs_with_dot_opam_files - let find name = Build.arr (fun () -> find t name) + let find ~from name = Build.arr (fun () -> find t ~from name) module Libs_vfile = Vfile_kind.Make_full (struct type t = Lib.t list end) (struct open Sexp.To_sexp - let t l = list string (List.map l ~f:Lib.best_name) + let t _dir l = list string (List.map l ~f:Lib.best_name) end) (struct open Sexp.Of_sexp - let t sexp = List.map (list string sexp) ~f:(Lib_db.find t) + let t dir sexp = + List.map (list string sexp) ~f:(Lib_db.find t ~from:dir) end) let vrequires ~dir ~item = let fn = Path.relative dir (item ^ ".requires.sexp") in - Build.Vspec.T (fn, (module Libs_vfile)) + Build.Vspec.T (fn, (module Libs_vfile)) let load_requires ~dir ~item = Build.vpath (vrequires ~dir ~item) let vruntime_deps ~dir ~item = let fn = Path.relative dir (item ^ ".runtime-deps.sexp") in - Build.Vspec.T (fn, (module Libs_vfile)) + Build.Vspec.T (fn, (module Libs_vfile)) let load_runtime_deps ~dir ~item = Build.vpath (vruntime_deps ~dir ~item) @@ -222,7 +236,7 @@ module Gen(P : Params) = struct internal_libs_without_non_installable_optional_ones t let select_rules ~dir lib_deps = - List.map (Lib_db.resolve_selects t lib_deps) ~f:(fun { dst_fn; src_fn } -> + List.map (Lib_db.resolve_selects t ~from:dir lib_deps) ~f:(fun { dst_fn; src_fn } -> let src = Path.relative dir src_fn in let dst = Path.relative dir dst_fn in Build.path src @@ -560,7 +574,7 @@ module Gen(P : Params) = struct Build.fanout (Lib_db.closure ~dir ~dep_kind (Direct "ppx_driver" :: List.map pp_names ~f:Lib_dep.direct)) - (Lib_db.find runner) + (Lib_db.find runner ~from:dir) >>^ (fun (libs, runner) -> let runner_name = Lib.best_name runner in List.filter libs ~f:(fun lib -> @@ -579,7 +593,7 @@ module Gen(P : Params) = struct ]); libs - let get_ppx_driver pps ~dep_kind = + let get_ppx_driver pps ~dir ~dep_kind = let names = Pp_set.elements pps |> List.map ~f:Pp.to_string @@ -588,10 +602,9 @@ module Gen(P : Params) = struct match Hashtbl.find ppx_drivers key with | Some x -> x | None -> - let ppx_dir = Path.relative ctx.build_dir (sprintf ".ppx/%s" key) in - let exe = Path.relative ppx_dir "ppx.exe" in + let exe = Path.relative ctx.build_dir (sprintf ".ppx/%s/ppx.exe" key) in let libs = - build_ppx_driver names ~dir:ppx_dir ~dep_kind ~target:exe + build_ppx_driver names ~dir ~dep_kind ~target:exe ~runner:"ppx_driver.runner" in Hashtbl.add ppx_drivers ~key ~data:(exe, libs); @@ -646,7 +659,7 @@ module Gen(P : Params) = struct (sprintf "%s %s" (expand_vars ~dir cmd) (Filename.quote (Path.reach src ~from:dir))))) | Pps { pps; flags } -> - let ppx_exe, libs = get_ppx_driver pps ~dep_kind in + let ppx_exe, libs = get_ppx_driver pps ~dir ~dep_kind in pped_module m ~dir ~f:(fun kind src dst -> add_rule (preprocessor_deps @@ -1794,7 +1807,17 @@ let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) ?only_package conf = let open Future in let { Jbuild_load. file_tree; tree; jbuilds; packages } = conf in - let alias_store = Alias.Store.create () in + let module Common = struct + let alias_store = Alias.Store.create () + let dirs_with_dot_opam_files = + String_map.fold packages ~init:Path.Set.empty + ~f:(fun ~key:_ ~data:{ Package. path; _ } acc -> + Path.Set.add path acc) + let file_tree = file_tree + let packages = packages + let filter_out_optional_stanzas_with_missing_deps = + filter_out_optional_stanzas_with_missing_deps + end in List.map contexts ~f:(fun context -> Jbuild_load.Jbuilds.eval ~context jbuilds >>| fun stanzas -> let stanzas = @@ -1812,20 +1835,16 @@ let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) in let module M = Gen(struct - let context = context - let file_tree = file_tree - let stanzas = stanzas - let packages = packages - let filter_out_optional_stanzas_with_missing_deps = - filter_out_optional_stanzas_with_missing_deps - let alias_store = alias_store + let context = context + let stanzas = stanzas + include Common end) in (!M.all_rules, (context.name, stanzas))) |> Future.all >>| fun l -> let rules, context_names_and_stanzas = List.split l in - (Alias.rules alias_store + (Alias.rules Common.alias_store ~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~tree @ List.concat rules, String_map.of_alist_exn context_names_and_stanzas) diff --git a/src/lib_db.ml b/src/lib_db.ml index 8a2950f7..338e5768 100644 --- a/src/lib_db.ml +++ b/src/lib_db.ml @@ -3,87 +3,106 @@ open Jbuild_types type t = { findlib : Findlib.t - ; libs : (string, Lib.t) Hashtbl.t - ; instalable_internal_libs : Lib.Internal.t String_map.t + ; (* This include both libraries from the current workspace and external ones *) + by_public_name : (string, Lib.t) Hashtbl.t + ; (* This is to implement the scoping described in the manual *) + by_internal_name : (Path.t, Lib.Internal.t String_map.t ref) Hashtbl.t + ; (* This is to filter out libraries that are not installable because of missing + dependencies *) + instalable_internal_libs : Lib.Internal.t String_map.t } -let find t name = - match Hashtbl.find t.libs name with - | Some x -> x +let rec internal_name_scope t ~dir = + match Hashtbl.find t.by_internal_name dir with + | Some scope -> scope | None -> - let pkg = Findlib.find_exn t.findlib name in - Hashtbl.add t.libs ~key:name ~data:(External pkg); - External pkg + let scope = internal_name_scope t ~dir:(Path.parent dir) in + Hashtbl.add t.by_internal_name ~key:dir ~data:scope; + scope -let find_internal t name = - match Hashtbl.find t.libs name with - | Some (Internal (dir, lib)) -> Some (dir, lib) - | _ -> None +let find_by_internal_name t ~from name = + let scope = internal_name_scope t ~dir:from in + String_map.find name !scope + +let find t ~from name = + match find_by_internal_name t ~from name with + | Some x -> Lib.Internal x + | None -> + Hashtbl.find_or_add t.by_public_name name + ~f:(fun name -> + External (Findlib.find_exn t.findlib name)) + +let find_internal t ~from name = + match find_by_internal_name t ~from name with + | Some _ as some -> some + | None -> + match Hashtbl.find t.by_public_name name with + | Some (Internal x) -> Some x + | _ -> None module Local_closure = Top_closure.Make(String)(struct type graph = t type t = Lib.Internal.t let key ((_, lib) : t) = lib.name - let deps ((_, lib) : Lib.Internal.t) graph = + let deps ((dir, lib) : Lib.Internal.t) graph = List.concat_map lib.buildable.libraries ~f:(fun dep -> - List.filter_map (Lib_dep.to_lib_names dep) ~f:(find_internal graph)) + List.filter_map (Lib_dep.to_lib_names dep) ~f:(find_internal ~from:dir graph)) end) -let top_sort_internals t = - let internals = - Hashtbl.fold t.libs ~init:[] ~f:(fun ~key:_ ~data acc -> - match data with - | Lib.Internal lib -> lib :: acc - | Lib.External _ -> acc) - in - match Local_closure.top_closure t internals with +let top_sort_internals t ~internal_libraries = + match Local_closure.top_closure t internal_libraries with | Ok l -> l | Error cycle -> die "dependency cycle between libraries:\n %s" (List.map cycle ~f:(fun lib -> Lib.describe (Internal lib)) |> String.concat ~sep:"\n-> ") -let lib_is_installable t name = - match find_internal t name with +let lib_is_installable t ~from name = + match find_internal t ~from name with | Some (_, lib) -> String_map.mem lib.name t.instalable_internal_libs | None -> Findlib.available t.findlib name -let choice_is_possible t { Lib_dep. lits; _ } = +let choice_is_possible t ~from { Lib_dep. lits; _ } = List.for_all lits ~f:(function - | Lib_dep.Pos name -> lib_is_installable t name - | Lib_dep.Neg name -> not (lib_is_installable t name)) + | Lib_dep.Pos name -> lib_is_installable t ~from name + | Lib_dep.Neg name -> not (lib_is_installable t ~from name)) -let dep_is_installable t dep = +let dep_is_installable t ~from dep = match (dep : Lib_dep.t) with - | Direct s -> lib_is_installable t s - | Select { choices; _ } -> List.exists choices ~f:(choice_is_possible t) + | Direct s -> lib_is_installable t ~from s + | Select { choices; _ } -> List.exists choices ~f:(choice_is_possible t ~from) -let compute_instalable_internal_libs t = - List.fold_left (top_sort_internals t) ~init:t +let compute_instalable_internal_libs t ~internal_libraries = + List.fold_left (top_sort_internals t ~internal_libraries) ~init:t ~f:(fun t (dir, lib) -> if not lib.Library.optional || - List.for_all (Library.all_lib_deps lib) ~f:(dep_is_installable t) then - { t - with instalable_internal_libs = - String_map.add t.instalable_internal_libs - ~key:lib.name ~data:(dir, lib) + List.for_all (Library.all_lib_deps lib) ~f:(dep_is_installable t ~from:dir) then + { t with + instalable_internal_libs = + String_map.add t.instalable_internal_libs + ~key:lib.name ~data:(dir, lib) } else t) -let create findlib stanzas = - let libs : (string, Lib.t) Hashtbl.t = Hashtbl.create 1024 in - List.iter stanzas ~f:(fun (dir, stanzas) -> - List.iter stanzas ~f:(fun stanza -> - match (stanza : Stanza.t) with - | Library lib -> - let data = Lib.Internal (dir, lib) in - Hashtbl.add libs ~key:lib.name ~data; - Option.iter lib.public ~f:(fun { name; _ } -> - Hashtbl.add libs ~key:name ~data) - | _ -> ())); - let t = { findlib; libs; instalable_internal_libs = String_map.empty } in - compute_instalable_internal_libs t +let create findlib ~dirs_with_dot_opam_files internal_libraries = + let t = + { findlib + ; by_public_name = Hashtbl.create 1024 + ; by_internal_name = Hashtbl.create 1024 + ; instalable_internal_libs = String_map.empty + } + in + (* Initializes the scopes *) + Path.Set.iter dirs_with_dot_opam_files ~f:(fun dir -> + Hashtbl.add t.by_internal_name ~key:dir + ~data:(ref String_map.empty)); + List.iter internal_libraries ~f:(fun ((dir, lib) as internal) -> + let scope = internal_name_scope t ~dir in + scope := String_map.add !scope ~key:lib.Library.name ~data:internal; + Option.iter lib.public ~f:(fun { name; _ } -> + Hashtbl.add t.by_public_name ~key:name ~data:(Internal internal))); + compute_instalable_internal_libs t ~internal_libraries let internal_libs_without_non_installable_optional_ones t = String_map.values t.instalable_internal_libs @@ -92,20 +111,20 @@ let interpret_lib_deps t ~dir lib_deps = let libs, failures = List.partition_map lib_deps ~f:(function | Lib_dep.Direct name -> begin - match find t name with + match find t ~from:dir name with | x -> Inl [x] | exception e -> (* Call [find] again to get a proper backtrace *) - Inr { fail = fun () -> ignore (find t name : Lib.t); raise e } + Inr { fail = fun () -> ignore (find t ~from:dir name : Lib.t); raise e } end | Select { result_fn; choices } -> match List.find_map choices ~f:(fun { lits; _ } -> match List.filter_map lits ~f:(function - | Pos s -> Some (find t s) + | Pos s -> Some (find t ~from:dir s) | Neg s -> - if lib_is_installable t s then + if lib_is_installable t ~from:dir s then raise Exit else None) @@ -142,12 +161,12 @@ type resolved_select = ; dst_fn : string } -let resolve_selects t lib_deps = +let resolve_selects t ~from lib_deps = List.filter_map lib_deps ~f:(function | Lib_dep.Direct _ -> None | Select { result_fn; choices } -> let src_fn = - match List.find choices ~f:(choice_is_possible t) with + match List.find choices ~f:(choice_is_possible t ~from) with | Some c -> c.file | None -> "no solution found" in diff --git a/src/lib_db.mli b/src/lib_db.mli index ab0a7b52..30809437 100644 --- a/src/lib_db.mli +++ b/src/lib_db.mli @@ -4,11 +4,13 @@ open Import type t -val create : Findlib.t -> (Path.t * Jbuild_types.Stanza.t list) list -> t +val create + : Findlib.t + -> dirs_with_dot_opam_files:Path.Set.t + -> (Path.t * Jbuild_types.Library.t) list + -> t -val find : t -> string -> Lib.t - -val find_internal : t -> string -> Lib.Internal.t option +val find : t -> from:Path.t -> string -> Lib.t val internal_libs_without_non_installable_optional_ones : t -> Lib.Internal.t list @@ -25,5 +27,6 @@ type resolved_select = val resolve_selects : t + -> from:Path.t -> Jbuild_types.Lib_dep.t list -> resolved_select list diff --git a/src/vfile_kind.ml b/src/vfile_kind.ml index 1d66557a..1e0b97bc 100644 --- a/src/vfile_kind.ml +++ b/src/vfile_kind.ml @@ -31,8 +31,8 @@ module type S = sig val id : t Id.t - val load : filename:string -> t - val save : filename:string -> t -> unit + val load : Path.t -> t + val save : Path.t -> t -> unit end type 'a t = (module S with type t = 'a) @@ -44,22 +44,22 @@ let eq (type a) (type b) module Make_full (T : sig type t end) - (To_sexp : sig val t : T.t -> Sexp.t end) - (Of_sexp : sig val t : Sexp.Ast.t -> T.t end) + (To_sexp : sig val t : Path.t -> T.t -> Sexp.t end) + (Of_sexp : sig val t : Path.t -> Sexp.Ast.t -> T.t end) : S with type t = T.t = struct type t = T.t let id = Id.create () - let save ~filename x = - let s = To_sexp.t x |> Sexp.to_string in - let oc = open_out filename in + let save path x = + let s = To_sexp.t path x |> Sexp.to_string in + let oc = open_out (Path.to_string path) in output_string oc s; close_out oc - let load ~filename = - Of_sexp.t (Sexp_load.single filename) + let load path = + Of_sexp.t path (Sexp_load.single (Path.to_string path)) end @@ -68,8 +68,14 @@ module Make (F : functor (C : Sexp.Combinators) -> sig val t : T.t C.t end) : S with type t = T.t = struct - module Of_sexp = F(Sexp.Of_sexp) - module To_sexp = F(Sexp.To_sexp) + module Of_sexp = struct + include F(Sexp.Of_sexp) + let t _ sexp = t sexp + end + module To_sexp = struct + include F(Sexp.To_sexp) + let t _ x = t x + end include Make_full(T)(To_sexp)(Of_sexp) end diff --git a/src/vfile_kind.mli b/src/vfile_kind.mli index b097d9dd..4ee25ccf 100644 --- a/src/vfile_kind.mli +++ b/src/vfile_kind.mli @@ -11,8 +11,8 @@ module type S = sig val id : t Id.t - val load : filename:string -> t - val save : filename:string -> t -> unit + val load : Path.t -> t + val save : Path.t -> t -> unit end type 'a t = (module S with type t = 'a) @@ -26,6 +26,6 @@ module Make module Make_full (T : sig type t end) - (To_sexp : sig val t : T.t -> Sexp.t end) - (Of_sexp : sig val t : Sexp.Ast.t -> T.t end) + (To_sexp : sig val t : Path.t -> T.t -> Sexp.t end) + (Of_sexp : sig val t : Path.t -> Sexp.Ast.t -> T.t end) : S with type t = T.t