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
@@ -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;

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
-   and has configurable dependencies. Alias are per-directory and some
-   are recursive; asking an alias to be built in a given directory will
-   trigger the construction of the alias in all children directories
-   recursively. The most interesting ones are:
+- **alias**: an alias is a build target that doesn't produce any file
+   and has configurable dependencies. Aliases are
+   per-directory. However, on the command line, asking for an alias to
+   be built in a given directory will trigger the construction of the
+   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
-to a target starting with a ``@``, simply write: ``./@foo``.
+``@src/runtest`` means the alias ``runtest`` in all descendant of
+``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

@@ -32,12 +32,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 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 =
@@ -77,13 +108,6 @@ 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
@@ -104,22 +128,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 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);
-
+let rules store =
   (* 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

@@ -2,6 +2,8 @@ type t
 
 val make : string -> dir:Path.t -> t
 
+val of_path : Path.t -> t
+
 (** The following always holds:
 
     {[
@@ -11,13 +13,19 @@ 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
 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
@@ -48,10 +56,4 @@ end
 
 val add_deps : Store.t -> t -> Path.t list -> unit
 
-type tree = Node of Path.t * tree list
-
-val rules
-  :  Store.t
-  -> prefixes:Path.t list
-  -> tree:tree
-  -> Build_interpret.Rule.t list
+val rules : Store.t -> Build_interpret.Rule.t list