Restrict the scope of internal names

Otherwise building several packages at once doesn't always work
2017-03-02 16:57:28 +00:00 · 2017-03-02 16:57:28 +00:00 · 51ce0c2daf
parent 2628eba306
commit 51ce0c2daf
8 changed files with 192 additions and 112 deletions
--- 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
--- 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 (<library-dependencies>))= 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 <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 ...)= field of [[library][libraries]]
+- =(libraries (<library-dependencies>))= specifies the library
+  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
--- 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
--- 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)
--- 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
--- 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
--- 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
--- 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