Restrict the scope of internal names

Otherwise building several packages at once doesn't always work

bin/main.ml

@@ -34,8 +34,9 @@ let set_common c =
 module Main = struct
   include Jbuilder.Main
 
-  let setup ?only_package common =
+  let setup ?only_package ?filter_out_optional_stanzas_with_missing_deps common =
-    setup ?workspace_file:common.workspace_file ?only_package ()
+    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

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 (<library-dependencies>))= is used to specify the
-  dependencies of the library. In here you should put library
+  dependencies of the library. See the [[Library dependencies][section about library
-  names. For library that are present in the workspace, you can use
+  dependencies]] for more details
-  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]]
 
 - =(wrapped <boolean>)= 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 =<name>.exe= being available.
 
 =<optional-fields>= are:
 
-- =(libraries (<library-dependencies>))= is the same as the
+- =(libraries (<library-dependencies>))= specifies the library
- =(libraries ...)= field of [[library][libraries]]
+  dependencies. See the [[Library dependencies][section about library dependencies]] for more
+  details
 
 - =(modules <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 =${<kind>:...}= 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 =<package>.opam= file. Moreover, a sub-tree containing
+=<package>.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

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

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 ctx.build_dir (sprintf ".ppx/%s/ppx.exe" key) in
-      let exe = Path.relative ppx_dir "ppx.exe" 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 context = context
-        let file_tree = file_tree
+        let stanzas = stanzas
-        let stanzas  = stanzas
+        include Common
-        let packages = packages
-        let filter_out_optional_stanzas_with_missing_deps =
-          filter_out_optional_stanzas_with_missing_deps
-        let alias_store = alias_store
       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)

src/lib_db.ml

@@ -3,87 +3,106 @@ open Jbuild_types
 
 type t =
   { findlib                  : Findlib.t
-  ; libs                     : (string, Lib.t) Hashtbl.t
+  ; (* This include both libraries from the current workspace and external ones *)
-  ; instalable_internal_libs : Lib.Internal.t String_map.t
+    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 =
+let rec internal_name_scope t ~dir =
-  match Hashtbl.find t.libs name with
+  match Hashtbl.find t.by_internal_name dir with
-  | Some x -> x
+  | Some scope -> scope
   | None ->
-    let pkg = Findlib.find_exn t.findlib name in
+    let scope = internal_name_scope t ~dir:(Path.parent dir) in
-    Hashtbl.add t.libs ~key:name ~data:(External pkg);
+    Hashtbl.add t.by_internal_name ~key:dir ~data:scope;
-    External pkg
+    scope
 
-let find_internal t name =
+let find_by_internal_name t ~from name =
-  match Hashtbl.find t.libs name with
+  let scope = internal_name_scope t ~dir:from in
-  | Some (Internal (dir, lib)) -> Some (dir, lib)
+  String_map.find name !scope
-  | _ -> None
+
+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 top_sort_internals t ~internal_libraries =
-  let internals =
+  match Local_closure.top_closure t internal_libraries with
-    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
   | 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 =
+let lib_is_installable t ~from name =
-  match find_internal t name with
+  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.Pos name ->      lib_is_installable t ~from name
-    | Lib_dep.Neg name -> not (lib_is_installable t 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
+  | Direct s -> lib_is_installable t ~from s
-  | Select { choices; _ } -> List.exists choices ~f:(choice_is_possible t)
+  | Select { choices; _ } -> List.exists choices ~f:(choice_is_possible t ~from)
 
-let compute_instalable_internal_libs t =
+let compute_instalable_internal_libs t ~internal_libraries =
-  List.fold_left (top_sort_internals t) ~init:t
+  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
+         List.for_all (Library.all_lib_deps lib) ~f:(dep_is_installable t ~from:dir) then
-        { t
+        { t with
-          with instalable_internal_libs =
+          instalable_internal_libs =
-                 String_map.add t.instalable_internal_libs
+            String_map.add t.instalable_internal_libs
-                   ~key:lib.name ~data:(dir, lib)
+              ~key:lib.name ~data:(dir, lib)
         }
       else
         t)
 
-let create findlib stanzas =
+let create findlib ~dirs_with_dot_opam_files internal_libraries =
-  let libs : (string, Lib.t) Hashtbl.t = Hashtbl.create 1024 in
+  let t =
-  List.iter stanzas ~f:(fun (dir, stanzas) ->
+    { findlib
-    List.iter stanzas ~f:(fun stanza ->
+    ; by_public_name   = Hashtbl.create 1024
-      match (stanza : Stanza.t) with
+    ; by_internal_name = Hashtbl.create 1024
-      | Library lib ->
+    ; instalable_internal_libs = String_map.empty
-        let data = Lib.Internal (dir, lib) in
+    }
-        Hashtbl.add libs ~key:lib.name ~data;
+  in
-        Option.iter lib.public ~f:(fun { name; _ } ->
+  (* Initializes the scopes *)
-          Hashtbl.add libs ~key:name ~data)
+  Path.Set.iter dirs_with_dot_opam_files ~f:(fun dir ->
-      | _ -> ()));
+    Hashtbl.add t.by_internal_name ~key:dir
-  let t = { findlib; libs; instalable_internal_libs = String_map.empty } in
+      ~data:(ref String_map.empty));
-  compute_instalable_internal_libs t
+  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

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 : t -> from:Path.t -> string -> Lib.t
-
-val find_internal : t -> string -> Lib.Internal.t option
 
 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

src/vfile_kind.ml

@@ -31,8 +31,8 @@ module type S = sig
 
   val id : t Id.t
 
-  val load : filename:string -> t
+  val load : Path.t -> t
-  val save : filename:string -> t -> unit
+  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)
+    (To_sexp : sig val t : Path.t -> T.t -> Sexp.t end)
-    (Of_sexp : sig val t : Sexp.Ast.t -> T.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 save path x =
-    let s = To_sexp.t x |> Sexp.to_string in
+    let s = To_sexp.t path x |> Sexp.to_string in
-    let oc = open_out filename in
+    let oc = open_out (Path.to_string path) in
     output_string oc s;
     close_out oc
 
-  let load ~filename =
+  let load path =
-    Of_sexp.t (Sexp_load.single filename)
+    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 Of_sexp = struct
-  module To_sexp = F(Sexp.To_sexp)
+    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

src/vfile_kind.mli

@@ -11,8 +11,8 @@ module type S = sig
 
   val id : t Id.t
 
-  val load : filename:string -> t
+  val load : Path.t -> t
-  val save : filename:string -> t -> unit
+  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)
+    (To_sexp : sig val t : Path.t -> T.t -> Sexp.t end)
-    (Of_sexp : sig val t : Sexp.Ast.t -> T.t end)
+    (Of_sexp : sig val t : Path.t -> Sexp.Ast.t -> T.t end)
   : S with type t = T.t