All aliases on the command line are recursive

Calling 'jbuilder build @path/x' always request the alias `x` in
`path` and all its descendant.

To implement that, change the build system interface to take an
arbitrary request as argument.

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
@@ -381,7 +392,7 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
           else
             let dir = Path.parent path in
             let name = Path.basename path in
-            [Alias (path, Alias.make ~dir name)]
+            [Alias_rec (Alias.make ~dir name)]
         else
           let path = Path.relative Path.root (prefix_target common s) in
           let can't_build path =
@@ -420,13 +431,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, _) ->
-          Log.info log @@ "- alias " ^ (Path.to_string path));
+        | Alias_rec alias ->
+          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
-      | File path -> path
-      | Alias (_, alias) -> Alias.file alias)
+    targets
 
 let build_targets =
   let doc = "Build the given targets, or all installable targets if none are given." in
@@ -471,7 +482,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 +533,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 +635,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
-         | _  -> resolve_targets ~log common setup targets
+         | [] -> Build.paths (Build_system.all_targets setup.build_system)
+         | _  -> 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 +930,10 @@ let utop =
        let target =
          match resolve_targets ~log common setup [utop_target] with
          | [] -> die "no libraries defined in %s" dir
-         | [target] -> target
-         | _::_::_ -> assert false
+         | [File target] -> target
+         | [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;

src/alias.ml

@@ -32,12 +32,40 @@ 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 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)))
+    >>^ function
+    | false -> ()
+    | true ->
+      Loc.fail loc "This recursive 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 =

src/alias.mli

@@ -11,6 +11,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 +20,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

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
@@ -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 =
-  remove_old_artifacts t;
-  all_unit (List.map targets ~f:(fun fn -> wait_for_file t fn ~targeting:fn))
+let eval_request t ~request ~process_target =
+  let { Build_interpret.Static_deps.
+        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_exn : t -> Path.t list -> unit Future.t
+val do_build
+  :  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
-    targets *)
-val all_lib_deps : t -> Path.t list -> Build.lib_deps Path.Map.t
+(** Return all the library dependencies (as written by the user)
+   needed to build this request *)
+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
-    name *)
-val all_lib_deps_by_context : t -> Path.t list -> Build.lib_deps String_map.t
+(** Return all the library dependencies required to build this
+   request, by context name *)
+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 *)
-  -> Path.t list
+  :  ?recursive:bool (* default false *)
+  -> t
+  -> request:(unit, unit) Build.t
   -> Rule.t list Future.t
 
 val all_targets_ever_built

src/file_tree.mli

@@ -10,6 +10,13 @@ module Dir : sig
   (** 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

src/gen_rules.ml

@@ -1151,6 +1151,6 @@ let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
   >>| fun l ->
   let rules, context_names_and_stanzas = List.split l in
   (Alias.rules aliases
-     ~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~file_tree
+        ~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~file_tree
    @ List.concat rules,
    String_map.of_alist_exn context_names_and_stanzas)

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 *)