Merge pull request #268 from janestreet/new-alias-semantic

Sort out recursive/non-recursive aliases

CHANGES.md

@@ -1,3 +1,16 @@
+next
+----
+
+- Change the semantic of aliases: there are no longer aliases that are
+  recursive such as `install` or `runtest`. All aliases are
+  non-recursive. However, when requesting an alias from the command
+  line, this request the construction of the alias in the specified
+  directory and all its children recursively. This allows users to get
+  the same behavior as previous recursive aliases for their own
+  aliases, such as `example`. Inside jbuild files, one can use `(deps
+  (... (alias_rec xxx) ...))` to get the same behavior as on the
+  command line.
+
 1.0+beta14 (11/10/2017)
 -----------------------
 

bin/main.ml

@@ -70,8 +70,23 @@ module Main = struct
       ?filter_out_optional_stanzas_with_missing_deps ()
 end
 
+type target =
+  | File      of Path.t
+  | Alias_rec of Alias.t
+
+let request_of_targets (setup : Main.setup) targets =
+  let open Build.O in
+  List.fold_left targets ~init:(Build.return ()) ~f:(fun acc target ->
+    acc >>>
+    match target with
+    | File path -> Build.path path
+    | Alias_rec alias ->
+      Alias.dep_rec ~loc:(Loc.in_file "<command-line>")
+        ~file_tree:setup.file_tree alias)
+
 let do_build (setup : Main.setup) targets =
-  Build_system.do_build_exn setup.build_system targets
+  Build_system.do_build_exn setup.build_system
+    ~request:(request_of_targets setup targets)
 
 let find_root () =
   let cwd = Sys.getcwd () in
@@ -338,10 +353,6 @@ let resolve_package_install setup pkg =
   | Error () ->
     die "Unknown package %s!%s" pkg (hint pkg (String_map.keys setup.packages))
 
-type target =
-  | File  of Path.t
-  | Alias of Path.t * Alias.t
-
 let target_hint (setup : Main.setup) path =
   assert (Path.is_local path);
   let sub_dir = Path.parent path in
@@ -379,9 +390,7 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
           if Path.is_root path then
             die "@@ on the command line must be followed by a valid alias name"
           else
-            let dir = Path.parent path in
+            [Alias_rec (Alias.of_path path)]
-            let name = Path.basename path in
-            [Alias (path, Alias.make ~dir name)]
         else
           let path = Path.relative Path.root (prefix_target common s) in
           let can't_build path =
@@ -420,13 +429,13 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
       List.iter targets ~f:(function
         | File path ->
           Log.info log @@ "- " ^ (Path.to_string path)
-        | Alias (path, _) ->
+        | Alias_rec alias ->
-          Log.info log @@ "- alias " ^ (Path.to_string path));
+          let path = Alias.fully_qualified_name alias in
+          Log.info log @@ "- recursive alias " ^
+                          (Path.to_string_maybe_quoted path));
       flush stdout;
     end;
-    List.map targets ~f:(function
+    targets
-      | File path -> path
-      | Alias (_, alias) -> Alias.file alias)
 
 let build_targets =
   let doc = "Build the given targets, or all installable targets if none are given." in
@@ -471,7 +480,7 @@ let runtest =
        let targets =
          List.map dirs ~f:(fun dir ->
            let dir = Path.(relative root) (prefix_target common dir) in
-           Alias.file (Alias.runtest ~dir))
+           Alias_rec (Alias.runtest ~dir))
        in
        do_build setup targets) in
   ( Term.(const go
@@ -522,9 +531,10 @@ let external_lib_deps =
       (Main.setup ~log common ~filter_out_optional_stanzas_with_missing_deps:false
        >>= fun setup ->
        let targets = resolve_targets ~log common setup targets in
+       let request = request_of_targets setup targets in
        let failure =
          String_map.fold ~init:false
-           (Build_system.all_lib_deps_by_context setup.build_system targets)
+           (Build_system.all_lib_deps_by_context setup.build_system ~request)
            ~f:(fun ~key:context_name ~data:lib_deps acc ->
              let internals =
                Jbuild.Stanzas.lib_names
@@ -623,12 +633,12 @@ let rules =
     Future.Scheduler.go ~log
       (Main.setup ~log common ~filter_out_optional_stanzas_with_missing_deps:false
        >>= fun setup ->
-       let targets =
+       let request =
          match targets with
-         | [] -> Build_system.all_targets setup.build_system
+         | [] -> Build.paths (Build_system.all_targets setup.build_system)
-         | _  -> resolve_targets ~log common setup targets
+         | _  -> resolve_targets ~log common setup targets |> request_of_targets setup
        in
-       Build_system.build_rules setup.build_system targets ~recursive >>= fun rules ->
+       Build_system.build_rules setup.build_system ~request ~recursive >>= fun rules ->
        let print oc =
          let ppf = Format.formatter_of_out_channel oc in
          Sexp.prepare_formatter ppf;
@@ -918,10 +928,10 @@ let utop =
        let target =
          match resolve_targets ~log common setup [utop_target] with
          | [] -> die "no libraries defined in %s" dir
-         | [target] -> target
+         | [File target] -> target
-         | _::_::_ -> assert false
+         | [Alias_rec _] | _::_::_ -> assert false
        in
-       do_build setup [target] >>| fun () ->
+       do_build setup [File target] >>| fun () ->
        (setup.build_system, context, Path.to_string target)
       ) |> Future.Scheduler.go ~log in
     Build_system.dump_trace build_system;

doc/jbuild.rst

@@ -843,6 +843,10 @@ syntax:
 - ``(file <filename>)`` or simply ``<filename>``: depend on this file
 - ``(alias <alias-name>)``: depend on the construction of this alias, for
   instance: ``(alias src/runtest)``
+- ``(alias_rec <alias-name>)``: depend on the construction of this
+  alias recursively in all children directories wherever it is
+  defined. For instance: ``(alias_rec src/runtest)`` might depend on
+  ``(alias src/runtest)``, ``(alias src/foo/bar/runtest)``, ...
 - ``(glob_files <glob>)``: depend on all files matched by ``<glob>``, see the
   :ref:`glob <glob>` for details
 - ``(files_recursively_in <dir>)``: depend on all files in the subtree with root

doc/terminology.rst

@@ -43,11 +43,12 @@ Terminology
 -  **build context root**: the root of a build context named ``foo`` is
    ``<root>/_build/<foo>``
 
--  **alias**: an alias is a build target that doesn't produce any file
+- **alias**: an alias is a build target that doesn't produce any file
-   and has configurable dependencies. Alias are per-directory and some
+   and has configurable dependencies. Aliases are
-   are recursive; asking an alias to be built in a given directory will
+   per-directory. However, on the command line, asking for an alias to
-   trigger the construction of the alias in all children directories
+   be built in a given directory will trigger the construction of the
-   recursively. The most interesting ones are:
+   alias in all children directories recursively. Jbuilder defines the
+   following standard aliases:
 
    -  ``runtest`` which runs user defined tests
    -  ``install`` which depends on everything that should be installed

doc/usage.rst

@@ -125,8 +125,9 @@ Aliases
 -------
 
 Targets starting with a ``@`` are interpreted as aliases. For instance
-``@src/runtest`` means the alias ``src/runtest``. If you want to refer
+``@src/runtest`` means the alias ``runtest`` in all descendant of
-to a target starting with a ``@``, simply write: ``./@foo``.
+``src`` where it is defined. If you want to refer to a target starting
+with a ``@``, simply write: ``./@foo``.
 
 Note that an alias not pointing to the ``_build`` directory always
 depends on all the corresponding aliases in build contexts.

src/alias.ml

@@ -3,12 +3,14 @@ open! Import
 (** Fully qualified name *)
 module Fq_name : sig
   type t
+  val pp : Format.formatter -> t -> unit
   val make : Path.t -> t
   val path : t -> Path.t
 end = struct
   type t = Path.t
   let make t = t
   let path t = t
+  let pp = Path.pp
 end
 
 type t =
@@ -16,6 +18,10 @@ type t =
   ; file : Path.t
   }
 
+let pp fmt t =
+  Format.fprintf fmt "@[<2>{ name@ =@ %a@ ;@ file@ =@ %a }@]"
+    Path.pp (Fq_name.path t.name) Path.pp t.file
+
 let aliases_path = Path.(relative root) "_build/.aliases"
 
 let suffix = "-" ^ String.make 32 '0'
@@ -32,12 +38,43 @@ let of_path path =
 let name t = Path.basename (Fq_name.path t.name)
 let dir  t = Path.parent   (Fq_name.path t.name)
 
+let fully_qualified_name t = Fq_name.path t.name
+
 let make name ~dir =
   assert (not (String.contains name '/'));
   of_path (Path.relative dir name)
 
 let dep t = Build.path t.file
 
+let is_standard = function
+  | "runtest" | "install" | "doc" -> true
+  | _ -> false
+
+let dep_rec ~loc ~file_tree t =
+  let path = Path.parent   (Fq_name.path t.name) |> Path.drop_build_context in
+  let name = Path.basename (Fq_name.path t.name) in
+  match File_tree.find_dir file_tree path with
+  | None -> Build.fail { fail = fun () ->
+    Loc.fail loc "Don't know about directory %s!" (Path.to_string_maybe_quoted path) }
+  | Some dir ->
+    let open Build.O in
+    File_tree.Dir.fold dir ~traverse_ignored_dirs:false ~init:(Build.return true)
+      ~f:(fun dir acc ->
+        let path = File_tree.Dir.path dir in
+        let t = of_path (Path.relative path name) in
+        acc
+        >>>
+        Build.if_file_exists t.file
+          ~then_:(Build.path t.file
+                  >>^
+                  fun _ -> false)
+          ~else_:(Build.arr (fun x -> x)))
+    >>^ fun is_empty ->
+    if is_empty && not (is_standard name) then
+      Loc.fail loc "This alias is empty.\n\
+                    Alias %S is not defined in %s or any of its descendants."
+        name (Path.to_string_maybe_quoted path)
+
 let file t = t.file
 
 let file_with_digest_suffix t ~digest =
@@ -77,20 +114,29 @@ let runtest = make "runtest"
 let install = make "install"
 let doc     = make "doc"
 
-let recursive_aliases =
-  [ default
-  ; runtest
-  ; install
-  ; doc
-  ]
-
 module Store = struct
   type entry =
     { alias : t
     ; mutable deps : Path.Set.t
     }
+  let pp_entry fmt entry =
+    let pp_deps fmt deps =
+      Format.pp_print_list Path.pp fmt (Path.Set.elements deps) in
+    Format.fprintf fmt "@[<2>{@ alias@ =@ %a@ ;@ deps@ = (%a)@ }@]"
+      pp entry.alias pp_deps entry.deps
+
   type t = (Fq_name.t, entry) Hashtbl.t
 
+  let pp fmt (t : t) =
+    let bindings = Hashtbl.fold ~init:[] ~f:(fun ~key ~data acc ->
+      (key, data)::acc
+    ) t in
+    let pp_bindings fmt b =
+      Format.pp_print_list (fun fmt (k, v) ->
+        Format.fprintf fmt "@[<2>(%a@ %a)@]" Fq_name.pp k pp_entry v
+      ) fmt b in
+    Format.fprintf fmt "Store.t@ @[@<2>(%a)@]" pp_bindings bindings
+
   let create () = Hashtbl.create 1024
 end
 
@@ -104,22 +150,7 @@ let add_deps store t deps =
             }
   | Some e -> e.deps <- Path.Set.union deps e.deps
 
-type tree = Node of Path.t * tree list
+let rules store =
-
-let rec setup_rec_alias store ~make_alias ~prefix ~tree:(Node (dir, children)) =
-  let alias = make_alias ~dir:(Path.append prefix dir) in
-  add_deps store alias (List.map children ~f:(fun child ->
-    setup_rec_alias store ~make_alias ~prefix ~tree:child));
-  alias.file
-
-let setup_rec_aliases store ~prefix ~tree =
-  List.iter recursive_aliases ~f:(fun make_alias ->
-    ignore (setup_rec_alias store ~make_alias ~prefix ~tree : Path.t))
-
-let rules store ~prefixes ~tree =
-  List.iter prefixes ~f:(fun prefix ->
-    setup_rec_aliases store ~prefix ~tree);
-
   (* For each alias @_build/blah/../x, add a dependency: @../x --> @_build/blah/../x *)
   Hashtbl.fold store ~init:[] ~f:(fun ~key:_ ~data:{ Store. alias; _ } acc ->
     match Path.extract_build_context (Fq_name.path alias.name) with

src/alias.mli

@@ -1,7 +1,13 @@
+open Import
+
 type t
 
+val pp : t Fmt.t
+
 val make : string -> dir:Path.t -> t
 
+val of_path : Path.t -> t
+
 (** The following always holds:
 
     {[
@@ -11,6 +17,8 @@ val make : string -> dir:Path.t -> t
 val name : t -> string
 val dir  : t -> Path.t
 
+val fully_qualified_name : t -> Path.t
+
 val default : dir:Path.t -> t
 val runtest : dir:Path.t -> t
 val install : dir:Path.t -> t
@@ -18,6 +26,10 @@ val doc     : dir:Path.t -> t
 
 val dep : t -> ('a, 'a) Build.t
 
+(** Implements [(alias_rec ...)] in dependency specification and
+    [@alias] on the command line. *)
+val dep_rec : loc:Loc.t -> file_tree:File_tree.t -> t -> (unit, unit) Build.t
+
 (** File that represent the alias in the filesystem. It is a file under
     [_build/.aliases]. *)
 val file : t -> Path.t
@@ -43,15 +55,12 @@ val name_of_file : Path.t -> string option
 
 module Store : sig
   type t
+
+  val pp : t Fmt.t
+
   val create : unit -> t
 end
 
 val add_deps : Store.t -> t -> Path.t list -> unit
 
-type tree = Node of Path.t * tree list
+val rules : Store.t -> Build_interpret.Rule.t list
-
-val rules
-  :  Store.t
-  -> prefixes:Path.t list
-  -> tree:tree
-  -> Build_interpret.Rule.t list

src/build_system.ml

@@ -125,6 +125,7 @@ type t =
        [(deps (filename + contents), targets (filename only), action)] *)
     trace      : (Path.t, Digest.t) Hashtbl.t
   ; mutable local_mkdirs : Path.Local.Set.t
+  ; all_targets_by_dir : Pset.t Pmap.t Lazy.t
   }
 
 let all_targets t = Hashtbl.fold t.files ~init:[] ~f:(fun ~key ~data:_ acc -> key :: acc)
@@ -304,6 +305,9 @@ module Build_exec = struct
     let dyn_deps = ref Pset.empty in
     let action = exec dyn_deps (Build.repr t) x in
     (action, !dyn_deps)
+
+  let exec_nop bs t x =
+    snd (exec bs (Build.O.(>>^) t (fun () -> Action.Progn [])) x)
 end
 
 (* This variable is filled during the creation of the build system. Once the build system
@@ -603,14 +607,14 @@ let dump_trace t = Trace.dump t.trace
 
 let create ~contexts ~file_tree ~rules =
   let all_source_files =
-    File_tree.fold file_tree ~init:Pset.empty ~f:(fun dir acc ->
+    File_tree.fold file_tree ~init:Pset.empty ~traverse_ignored_dirs:true
-      let path = File_tree.Dir.path dir in
+      ~f:(fun dir acc ->
-      Cont
+        let path = File_tree.Dir.path dir in
-        (Pset.union acc
+        Pset.union acc
-           (File_tree.Dir.files dir
+          (File_tree.Dir.files dir
-            |> String_set.elements
+           |> String_set.elements
-            |> List.map ~f:(Path.relative path)
+           |> List.map ~f:(Path.relative path)
-            |> Pset.of_list)))
+           |> Pset.of_list))
   in
   let all_copy_targets =
     List.fold_left contexts ~init:Pset.empty ~f:(fun acc (ctx : Context.t) ->
@@ -638,6 +642,7 @@ let create ~contexts ~file_tree ~rules =
     ; files      = Hashtbl.create 1024
     ; trace      = Trace.load ()
     ; local_mkdirs = Path.Local.Set.empty
+    ; all_targets_by_dir
     } in
   List.iter rules ~f:(compile_rule t ~all_targets_by_dir ~copy_source:false);
   setup_copy_rules t ~all_targets_by_dir
@@ -717,13 +722,34 @@ let remove_old_artifacts t =
     walk (Config.local_install_dir ~context:ctx.name);
   )
 
-let do_build_exn t targets =
+let eval_request t ~request ~process_target =
-  remove_old_artifacts t;
+  let { Build_interpret.Static_deps.
-  all_unit (List.map targets ~f:(fun fn -> wait_for_file t fn ~targeting:fn))
+        rule_deps
+      ; action_deps = static_deps
+      } = Build_interpret.static_deps request ~all_targets_by_dir:t.all_targets_by_dir
+  in
 
-let do_build t targets =
+  let process_targets ts =
+    Future.all_unit (List.map (Pset.elements ts) ~f:process_target)
+  in
+
+  Future.both
+    (process_targets static_deps)
+    (Future.all_unit (List.map (Pset.elements rule_deps) ~f:(fun fn ->
+       wait_for_file t fn ~targeting:fn))
+     >>= fun () ->
+     let dyn_deps = Build_exec.exec_nop t request () in
+     process_targets (Pset.diff dyn_deps static_deps))
+  >>| fun ((), ()) -> ()
+
+let do_build_exn t ~request =
+  remove_old_artifacts t;
+  eval_request t ~request ~process_target:(fun fn ->
+    wait_for_file t fn ~targeting:fn)
+
+let do_build t ~request =
   try
-    Ok (do_build_exn t targets)
+    Ok (do_build_exn t ~request)
   with Build_error.E e ->
     Error e
 
@@ -760,7 +786,16 @@ let rules_for_targets t targets =
          Path.to_string (Pset.choose rule.Internal_rule.targets))
        |> String.concat ~sep:"\n-> ")
 
-let all_lib_deps t targets =
+let static_deps_of_request t request =
+  let { Build_interpret.Static_deps.
+        rule_deps
+      ; action_deps
+      } = Build_interpret.static_deps request ~all_targets_by_dir:t.all_targets_by_dir
+  in
+  Pset.elements (Pset.union rule_deps action_deps)
+
+let all_lib_deps t ~request =
+  let targets = static_deps_of_request t request in
   List.fold_left (rules_for_targets t targets) ~init:Pmap.empty
     ~f:(fun acc rule ->
       let lib_deps = Build_interpret.lib_deps rule.Internal_rule.build in
@@ -771,7 +806,8 @@ let all_lib_deps t targets =
         | None, Some b -> Some b
         | Some a, Some b -> Some (Build.merge_lib_deps a b)))
 
-let all_lib_deps_by_context t targets =
+let all_lib_deps_by_context t ~request =
+  let targets = static_deps_of_request t request in
   List.fold_left (rules_for_targets t targets) ~init:[] ~f:(fun acc rule ->
     let lib_deps = Build_interpret.lib_deps rule.Internal_rule.build in
     Path.Map.fold lib_deps ~init:acc ~f:(fun ~key:path ~data:lib_deps acc ->
@@ -817,7 +853,7 @@ module Rule_closure =
         rules_for_files graph (Pset.elements t.deps)
     end)
 
-let build_rules t ?(recursive=false) targets =
+let build_rules ?(recursive=false) t ~request =
   let rules_seen = ref Id_set.empty in
   let rules = ref [] in
   let rec loop fn =
@@ -863,7 +899,10 @@ let build_rules t ?(recursive=false) targets =
           return ()
       end
   in
-  Future.all_unit (List.map targets ~f:loop)
+  let targets = ref Pset.empty in
+  eval_request t ~request ~process_target:(fun fn ->
+    targets := Pset.add fn !targets;
+    loop fn)
   >>= fun () ->
   Future.all !rules
   >>| fun rules ->
@@ -872,7 +911,10 @@ let build_rules t ?(recursive=false) targets =
       Pset.fold r.targets ~init:acc ~f:(fun fn acc ->
         Pmap.add acc ~key:fn ~data:r))
   in
-  match Rule_closure.top_closure rules (rules_for_files rules targets) with
+  match
+    Rule_closure.top_closure rules
+      (rules_for_files rules (Pset.elements !targets))
+  with
   | Ok l -> l
   | Error cycle ->
     die "dependency cycle detected:\n   %s"

src/build_system.mli

@@ -23,16 +23,28 @@ module Build_error : sig
 end
 
 (** Do the actual build *)
-val do_build     : t -> Path.t list -> (unit Future.t, Build_error.t) result
+val do_build
-val do_build_exn : t -> Path.t list -> unit Future.t
+  :  t
+  -> request:(unit, unit) Build.t
+  -> (unit Future.t, Build_error.t) result
+val do_build_exn
+  :  t
+  -> request:(unit, unit) Build.t
+  -> unit Future.t
 
-(** Return all the library dependencies (as written by the user) needed to build these
+(** Return all the library dependencies (as written by the user)
-    targets *)
+   needed to build this request *)
-val all_lib_deps : t -> Path.t list -> Build.lib_deps Path.Map.t
+val all_lib_deps
+  :  t
+  -> request:(unit, unit) Build.t
+  -> Build.lib_deps Path.Map.t
 
-(** Return all the library dependencies required to build these targets, by context
+(** Return all the library dependencies required to build this
-    name *)
+   request, by context name *)
-val all_lib_deps_by_context : t -> Path.t list -> Build.lib_deps String_map.t
+val all_lib_deps_by_context
+  :  t
+  -> request:(unit, unit) Build.t
+  -> Build.lib_deps String_map.t
 
 (** List of all buildable targets *)
 val all_targets : t -> Path.t list
@@ -58,9 +70,9 @@ end
     [recursive] is [true], return all the rules needed to build the
     given targets and their transitive dependencies. *)
 val build_rules
-  :  t
+  :  ?recursive:bool (* default false *)
-  -> ?recursive:bool (* default false *)
+  -> t
-  -> Path.t list
+  -> request:(unit, unit) Build.t
   -> Rule.t list Future.t
 
 val all_targets_ever_built

src/file_tree.ml

@@ -1,31 +1,25 @@
 open! Import
 
-type 'a fold_callback_result =
-  | Cont            of 'a
-  | Dont_recurse_in of String_set.t * 'a
-
 module Dir = struct
   type t =
     { path     : Path.t
     ; files    : String_set.t
     ; sub_dirs : t String_map.t
+    ; ignored  : bool
     }
 
   let path t = t.path
   let files t = t.files
   let sub_dirs t = t.sub_dirs
+  let ignored t = t.ignored
 
-  let rec fold t ~init ~f =
+  let rec fold t ~traverse_ignored_dirs ~init:acc ~f =
-    match f t init with
+    if not traverse_ignored_dirs && t.ignored then
-    | Cont init ->
+      acc
-      String_map.fold t.sub_dirs ~init ~f:(fun ~key:_ ~data:t acc ->
+    else
-        fold t ~init:acc ~f)
+      let acc = f t acc in
-    | Dont_recurse_in (forbidden, init) ->
+      String_map.fold t.sub_dirs ~init:acc ~f:(fun ~key:_ ~data:t acc ->
-      String_map.fold t.sub_dirs ~init ~f:(fun ~key:sub_dir ~data:t acc ->
+        fold t ~traverse_ignored_dirs ~init:acc ~f)
-        if String_set.mem sub_dir forbidden then
-          acc
-        else
-          fold t ~init:acc ~f)
 end
 
 type t =
@@ -40,38 +34,59 @@ let ignore_file fn ~is_directory =
   (is_directory && (fn.[0] = '.' || fn.[0] = '_')) ||
   (fn.[0] = '.' && fn.[1] = '#')
 
-let load path =
+let load ?(extra_ignored_subtrees=Path.Set.empty) path =
-  let rec walk path : Dir.t =
+  let rec walk path ~ignored : Dir.t =
     let files, sub_dirs =
       Path.readdir path
       |> List.filter_map ~f:(fun fn ->
         let path = Path.relative path fn in
-        let is_directory = Path.exists path && Path.is_directory path in
+        let is_directory =
+          try Path.is_directory path with _ -> false
+        in
         if ignore_file fn ~is_directory then
           None
+        else if is_directory then
+          Some (Inr (fn, path))
         else
-          Some (fn, path, is_directory))
+          Some (Inl fn))
-      |> List.partition_map ~f:(fun (fn, path, is_directory)  ->
+      |> List.partition_map ~f:(fun x -> x)
-          if is_directory then
+    in
-            Inr (fn, walk path)
+    let files = String_set.of_list files in
-          else
+    let ignored_sub_dirs =
-            Inl fn)
+      if not ignored && String_set.mem "jbuild-ignore" files then
+        String_set.of_list
+          (Io.lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
+      else
+        String_set.empty
+    in
+    let sub_dirs =
+      List.map sub_dirs ~f:(fun (fn, path) ->
+        let ignored =
+          ignored
+          || String_set.mem fn ignored_sub_dirs
+          || Path.Set.mem path extra_ignored_subtrees
+        in
+        (fn, walk path ~ignored))
+      |> String_map.of_alist_exn
     in
     { path
-    ; files    = String_set.of_list files
+    ; files
-    ; sub_dirs = String_map.of_alist_exn sub_dirs
+    ; sub_dirs
+    ; ignored
     }
   in
-  let root = walk path in
+  let root = walk path ~ignored:false in
   let dirs =
-    Dir.fold root ~init:Path.Map.empty ~f:(fun dir acc ->
+    Dir.fold root ~init:Path.Map.empty ~traverse_ignored_dirs:true
-      Cont (Path.Map.add acc ~key:dir.path ~data:dir))
+      ~f:(fun dir acc ->
+        Path.Map.add acc ~key:dir.path ~data:dir)
   in
   { root
   ; dirs
   }
 
-let fold t ~init ~f = Dir.fold t.root ~init ~f
+let fold t ~traverse_ignored_dirs ~init ~f =
+  Dir.fold t.root ~traverse_ignored_dirs ~init ~f
 
 let find_dir t path =
   Path.Map.find path t.dirs
@@ -89,8 +104,8 @@ let files_recursively_in t ?(prefix_with=Path.root) path =
   match find_dir t path with
   | None -> Path.Set.empty
   | Some dir ->
-    Dir.fold dir ~init:Path.Set.empty ~f:(fun dir acc ->
+    Dir.fold dir ~init:Path.Set.empty ~traverse_ignored_dirs:true
-      let path = Path.append prefix_with (Dir.path dir) in
+      ~f:(fun dir acc ->
-      Cont
+        let path = Path.append prefix_with (Dir.path dir) in
-        (String_set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc ->
+        String_set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc ->
-           Path.Set.add (Path.relative path fn) acc)))
+          Path.Set.add (Path.relative path fn) acc))

src/file_tree.mli

@@ -1,23 +1,34 @@
 open! Import
 
-
 module Dir : sig
   type t
 
   val path     : t -> Path.t
   val files    : t -> String_set.t
   val sub_dirs : t -> t String_map.t
+
+  (** Whether this directory is ignored by a [jbuild-ignore] file in
+      one of its ancestor directories. *)
+  val ignored : t -> bool
+
+  val fold
+    :  t
+    -> traverse_ignored_dirs:bool
+    -> init:'a
+    -> f:(t -> 'a -> 'a)
+    -> 'a
 end
 
 type t
 
-val load : Path.t -> t
+val load : ?extra_ignored_subtrees:Path.Set.t -> Path.t -> t
 
-type 'a fold_callback_result =
+val fold
-  | Cont            of 'a
+  :  t
-  | Dont_recurse_in of String_set.t * 'a
+  -> traverse_ignored_dirs:bool
-
+  -> init:'a
-val fold : t -> init:'a -> f:(Dir.t -> 'a -> 'a fold_callback_result) -> 'a
+  -> f:(Dir.t -> 'a -> 'a)
+  -> 'a
 
 val root : t -> Dir.t
 

src/gen_rules.ml

@@ -1104,7 +1104,7 @@ end
 let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
       ?only_packages conf =
   let open Future in
-  let { Jbuild_load. file_tree; tree; jbuilds; packages } = conf in
+  let { Jbuild_load. file_tree; jbuilds; packages } = conf in
   let aliases = Alias.Store.create () in
   let dirs_with_dot_opam_files =
     String_map.fold packages ~init:Path.Set.empty
@@ -1150,7 +1150,5 @@ let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
   |> Future.all
   >>| fun l ->
   let rules, context_names_and_stanzas = List.split l in
-  (Alias.rules aliases
+  (Alias.rules aliases @ List.concat rules,
-     ~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/import.ml

@@ -504,3 +504,7 @@ let open_out_gen = `Use_Io
 module No_io = struct
   module Io = struct end
 end
+
+module Fmt = struct
+  type 'a t = Format.formatter -> 'a -> unit
+end

src/jbuild.ml

@@ -200,6 +200,7 @@ module Dep_conf = struct
   type t =
     | File of String_with_vars.t
     | Alias of String_with_vars.t
+    | Alias_rec of String_with_vars.t
     | Glob_files of String_with_vars.t
     | Files_recursively_in of String_with_vars.t
 
@@ -211,6 +212,7 @@ module Dep_conf = struct
       sum
         [ cstr "file"                 (fun x -> File x)
         ; cstr "alias"                (fun x -> Alias x)
+        ; cstr "alias_rec"            (fun x -> Alias_rec x)
         ; cstr "glob_files"           (fun x -> Glob_files x)
         ; cstr "files_recursively_in" (fun x -> Files_recursively_in x)
         ]
@@ -226,6 +228,8 @@ module Dep_conf = struct
       List [Atom "file" ; String_with_vars.sexp_of_t t]
     | Alias t ->
       List [Atom "alias" ; String_with_vars.sexp_of_t t]
+    | Alias_rec t ->
+      List [Atom "alias_rec" ; String_with_vars.sexp_of_t t]
     | Glob_files t ->
       List [Atom "glob_files" ; String_with_vars.sexp_of_t t]
     | Files_recursively_in t ->

src/jbuild.mli

@@ -93,6 +93,7 @@ module Dep_conf : sig
   type t =
     | File of String_with_vars.t
     | Alias of String_with_vars.t
+    | Alias_rec of String_with_vars.t
     | Glob_files of String_with_vars.t
     | Files_recursively_in of String_with_vars.t
 

src/jbuild_load.ml

@@ -151,7 +151,6 @@ end
 
 type conf =
   { file_tree : File_tree.t
-  ; tree      : Alias.tree
   ; jbuilds   : Jbuilds.t
   ; packages  : Package.t String_map.t
   }
@@ -164,41 +163,27 @@ let load ~dir ~scope =
   | Ocaml_script ->
     Script { dir; scope }
 
-let load ?(extra_ignored_subtrees=Path.Set.empty) () =
+let load ?extra_ignored_subtrees () =
-  let ftree = File_tree.load Path.root in
+  let ftree = File_tree.load Path.root ?extra_ignored_subtrees in
-  let packages, ignored_subtrees =
+  let packages =
-    File_tree.fold ftree ~init:([], extra_ignored_subtrees) ~f:(fun dir (pkgs, ignored) ->
+    File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[] ~f:(fun dir pkgs ->
       let path = File_tree.Dir.path dir in
       let files = File_tree.Dir.files dir in
-      let pkgs =
+      String_set.fold files ~init:pkgs ~f:(fun fn acc ->
-        String_set.fold files ~init:pkgs ~f:(fun fn acc ->
+        match Filename.split_extension fn with
-          match Filename.split_extension fn with
+        | (pkg, ".opam") when pkg <> "" ->
-          | (pkg, ".opam") when pkg <> "" ->
+          let version_from_opam_file =
-            let version_from_opam_file =
+            let opam = Opam_file.load (Path.relative path fn |> Path.to_string) in
-              let opam = Opam_file.load (Path.relative path fn |> Path.to_string) in
+            match Opam_file.get_field opam "version" with
-              match Opam_file.get_field opam "version" with
+            | Some (String (_, s)) -> Some s
-              | Some (String (_, s)) -> Some s
+            | _ -> None
-              | _ -> None
+          in
-            in
+          (pkg,
-            (pkg,
+           { Package. name = pkg
-             { Package. name = pkg
+           ; path
-             ; path
+           ; version_from_opam_file
-             ; version_from_opam_file
+           }) :: acc
-             }) :: acc
+        | _ -> acc))
-          | _ -> acc)
-      in
-      if String_set.mem "jbuild-ignore" files then
-        let ignore_set =
-          String_set.of_list
-            (Io.lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
-        in
-        Dont_recurse_in
-          (ignore_set,
-           (pkgs,
-            String_set.fold ignore_set ~init:ignored ~f:(fun fn acc ->
-              Path.Set.add (Path.relative path fn) acc)))
-      else
-        Cont (pkgs, ignored))
   in
   let packages =
     String_map.of_alist_multi packages
@@ -219,32 +204,27 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) () =
     |> Path.Map.map ~f:Scope.make
   in
   let rec walk dir jbuilds scope =
-    let path = File_tree.Dir.path dir in
+    if File_tree.Dir.ignored dir then
-    let files = File_tree.Dir.files dir in
+      jbuilds
-    let sub_dirs = File_tree.Dir.sub_dirs dir in
+    else begin
-    let scope = Path.Map.find_default path scopes ~default:scope in
+      let path = File_tree.Dir.path dir in
-    let jbuilds =
+      let files = File_tree.Dir.files dir in
-      if String_set.mem "jbuild" files then
+      let sub_dirs = File_tree.Dir.sub_dirs dir in
-        let jbuild = load ~dir:path ~scope in
+      let scope = Path.Map.find_default path scopes ~default:scope in
-        jbuild :: jbuilds
+      let jbuilds =
-      else
+        if String_set.mem "jbuild" files then
-        jbuilds
+          let jbuild = load ~dir:path ~scope in
-    in
+          jbuild :: jbuilds
-    let children, jbuilds =
+        else
-      String_map.fold sub_dirs ~init:([], jbuilds)
+          jbuilds
-        ~f:(fun ~key:_ ~data:dir (children, jbuilds) ->
+      in
-          if Path.Set.mem (File_tree.Dir.path dir) ignored_subtrees then
+      String_map.fold sub_dirs ~init:jbuilds
-            (children, jbuilds)
+        ~f:(fun ~key:_ ~data:dir jbuilds ->
-          else
+          walk dir jbuilds scope)
-            let child, jbuilds = walk dir jbuilds scope in
+    end
-            (child :: children, jbuilds))
-    in
-    (Alias.Node (path, children), jbuilds)
   in
-  let root = File_tree.root ftree in
+  let jbuilds = walk (File_tree.root ftree) [] Scope.empty in
-  let tree, jbuilds = walk root [] Scope.empty in
   { file_tree = ftree
-  ; tree
   ; jbuilds
   ; packages
   }

src/jbuild_load.mli

@@ -9,7 +9,6 @@ end
 
 type conf =
   { file_tree : File_tree.t
-  ; tree      : Alias.tree
   ; jbuilds   : Jbuilds.t
   ; packages  : Package.t String_map.t
   }

src/main.ml

@@ -6,6 +6,7 @@ type setup =
   ; stanzas      : (Path.t * Jbuild.Scope.t * Jbuild.Stanzas.t) list String_map.t
   ; contexts     : Context.t list
   ; packages     : Package.t String_map.t
+  ; file_tree    : File_tree.t
   }
 
 let package_install_file { packages; _ } pkg =
@@ -54,6 +55,7 @@ let setup ?(log=Log.no_log) ?filter_out_optional_stanzas_with_missing_deps
          ; stanzas
          ; contexts
          ; packages = conf.packages
+         ; file_tree = conf.file_tree
          }
 
 let external_lib_deps ?log ~packages () =
@@ -71,7 +73,8 @@ let external_lib_deps ?log ~packages () =
      | Some stanzas ->
        let internals = Jbuild.Stanzas.lib_names stanzas in
        Path.Map.map
-         (Build_system.all_lib_deps setup.build_system install_files)
+         (Build_system.all_lib_deps setup.build_system
+            ~request:(Build.paths install_files))
          ~f:(String_map.filter ~f:(fun name _ ->
            not (String_set.mem name internals))))
 
@@ -211,7 +214,8 @@ let bootstrap () =
          ~extra_ignored_subtrees:ignored_during_bootstrap
          ()
        >>= fun { build_system = bs; _ } ->
-       Build_system.do_build_exn bs [Path.(relative root) (pkg ^ ".install")])
+       Build_system.do_build_exn bs
+         ~request:(Build.path (Path.(relative root) (pkg ^ ".install"))))
   in
   try
     main ()

src/main.mli

@@ -7,6 +7,7 @@ type setup =
     stanzas      : (Path.t * Scope.t * Stanzas.t) list String_map.t
   ; contexts     : Context.t list
   ; packages     : Package.t String_map.t
+  ; file_tree    : File_tree.t
   }
 
 (* Returns [Error ()] if [pkg] is unknown *)

src/path.ml

@@ -424,3 +424,5 @@ let rm_rf =
 let change_extension ~ext t =
   let t = try Filename.chop_extension t with Not_found -> t in
   t ^ ext
+
+let pp = Format.pp_print_string

src/path.mli

@@ -111,3 +111,5 @@ val rm_rf : t -> unit
 
 (** Changes the extension of the filename (or adds an extension if there was none) *)
 val change_extension : ext:string -> t -> t
+
+val pp : t Fmt.t

src/super_context.ml

@@ -406,15 +406,21 @@ module Deps = struct
   open Build.O
   open Dep_conf
 
+  let make_alias t ~scope ~dir s =
+    Alias.of_path (Path.relative dir (expand_vars t ~scope ~dir s))
+
   let dep t ~scope ~dir = function
     | File  s ->
       let path = Path.relative dir (expand_vars t ~scope ~dir s) in
       Build.path path
-      >>^ fun _ -> [path]
+      >>^ fun () -> [path]
     | Alias s ->
-      let path = Alias.file (Alias.make ~dir (expand_vars t ~scope ~dir s)) in
+      Alias.dep (make_alias t ~scope ~dir s)
-      Build.path path
+      >>^ fun () -> []
-      >>^ fun _ -> []
+    | Alias_rec s ->
+      Alias.dep_rec ~loc:(String_with_vars.loc s) ~file_tree:t.file_tree
+        (make_alias t ~scope ~dir s)
+      >>^ fun () -> []
     | Glob_files s -> begin
         let path = Path.relative dir (expand_vars t ~scope ~dir s) in
         match Glob_lexer.parse_string (Path.basename path) with

test/blackbox-tests/jbuild

@@ -71,3 +71,10 @@
   (action
    (chdir test-cases/copy_files
     (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+
+(alias
+ ((name runtest)
+  (deps ((files_recursively_in test-cases/aliases)))
+  (action
+   (chdir test-cases/aliases
+    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))

test/blackbox-tests/test-cases/aliases/jbuild

@@ -0,0 +1,9 @@
+(jbuild_version 1)
+
+(alias
+ ((name just-in-src)
+  (deps ((alias src/x)))))
+
+(alias
+ ((name everywhere)
+  (deps ((alias_rec x)))))

test/blackbox-tests/test-cases/aliases/run.t

@@ -0,0 +1,22 @@
+  $ $JBUILDER clean -j1 --root .
+  $ $JBUILDER build -j1 --root . @just-in-src
+  running in src
+  $ $JBUILDER clean -j1 --root .
+  $ $JBUILDER build -j1 --root . @everywhere
+  running in src/foo/bar
+  running in src/foo/baz
+  running in src
+  $ $JBUILDER clean -j1 --root .
+  $ $JBUILDER build -j1 --root . @x
+  running in src/foo/bar
+  running in src/foo/baz
+  running in src
+  $ $JBUILDER build -j1 --root . @plop
+  File "<command-line>", line 1, characters 0-0:
+  Error: This alias is empty.
+  Alias "plop" is not defined in . or any of its descendants.
+  [1]
+  $ $JBUILDER build -j1 --root . @truc/x
+  File "<command-line>", line 1, characters 0-0:
+  Error: Don't know about directory truc!
+  [1]

test/blackbox-tests/test-cases/aliases/src/foo/bar/jbuild

@@ -0,0 +1,5 @@
+(jbuild_version 1)
+
+(alias
+ ((name x)
+  (action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n")))))

test/blackbox-tests/test-cases/aliases/src/foo/baz/jbuild

@@ -0,0 +1,5 @@
+(jbuild_version 1)
+
+(alias
+ ((name x)
+  (action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n")))))

test/blackbox-tests/test-cases/aliases/src/jbuild

@@ -0,0 +1,5 @@
+(jbuild_version 1)
+
+(alias
+ ((name x)
+  (action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n")))))

test/blackbox-tests/test-cases/js_of_ocaml/run.t

@@ -1,29 +1,29 @@
   $ $JBUILDER build -j1 --root . --dev bin/technologic.bc.js @install lib/x.cma.js lib/x__Y.cmo.js bin/z.cmo.js
-      ocamlopt .ppx/js_of_ocaml-ppx/ppx.exe
         ocamlc lib/stubs.o
+      ocamlopt .ppx/js_of_ocaml-ppx/ppx.exe
         ocamlc lib/x__.{cmi,cmo,cmt}
-           ppx bin/technologic.pp.ml
+    ocamlmklib lib/dllx_stubs.so,lib/libx_stubs.a
-           ppx bin/z.pp.ml
            ppx lib/x.pp.ml
            ppx lib/y.pp.ml
-    ocamlmklib lib/dllx_stubs.so,lib/libx_stubs.a
+           ppx bin/technologic.pp.ml
+           ppx bin/z.pp.ml
       ocamlopt lib/x__.{cmx,o}
-      ocamldep bin/technologic.depends.ocamldep-output
       ocamldep lib/x.depends.ocamldep-output
+      ocamldep bin/technologic.depends.ocamldep-output
+        ocamlc lib/x__Y.{cmi,cmo,cmt}
    js_of_ocaml .js/js_of_ocaml/js_of_ocaml.cma.js
    js_of_ocaml .js/stdlib/stdlib.cma.js
-        ocamlc lib/x__Y.{cmi,cmo,cmt}
    js_of_ocaml lib/x__Y.cmo.js
       ocamlopt lib/x__Y.{cmx,o}
         ocamlc lib/x.{cmi,cmo,cmt}
       ocamlopt lib/x.{cmx,o}
-        ocamlc bin/z.{cmi,cmo,cmt}
         ocamlc lib/x.cma
+        ocamlc bin/z.{cmi,cmo,cmt}
       ocamlopt lib/x.{a,cmxa}
-   js_of_ocaml bin/z.cmo.js
-        ocamlc bin/technologic.{cmi,cmo,cmt}
    js_of_ocaml lib/x.cma.js
    js_of_ocaml bin/technologic.bc.runtime.js
+   js_of_ocaml bin/z.cmo.js
+        ocamlc bin/technologic.{cmi,cmo,cmt}
       ocamlopt lib/x.cmxs
    js_of_ocaml bin/technologic.cmo.js
      jsoo_link bin/technologic.bc.js
@@ -34,17 +34,17 @@
   fix it
   $ $JBUILDER build -j1 --root . bin/technologic.bc.js @install
         ocamlc lib/x__.{cmi,cmo,cmt}
-        ocamlc lib/x__Y.{cmi,cmo,cmt}
       ocamlopt lib/x__.{cmx,o}
-        ocamlc lib/x.{cmi,cmo,cmt}
+        ocamlc lib/x__Y.{cmi,cmo,cmt}
       ocamlopt lib/x__Y.{cmx,o}
+        ocamlc lib/x.{cmi,cmo,cmt}
+      ocamlopt lib/x.{cmx,o}
         ocamlc lib/x.cma
         ocamlc bin/z.{cmi,cmo,cmt}
-      ocamlopt lib/x.{cmx,o}
-        ocamlc bin/technologic.{cmi,cmo,cmt}
       ocamlopt lib/x.{a,cmxa}
-        ocamlc bin/technologic.bc
+        ocamlc bin/technologic.{cmi,cmo,cmt}
       ocamlopt lib/x.cmxs
+        ocamlc bin/technologic.bc
    js_of_ocaml bin/technologic.bc.js
   $ $NODE ./_build/default/bin/technologic.bc.js
   buy it