[WIP] Load rules lazily (#370)

* Change jbuilder to load rules lazily

Rules are now loaded on a per directory basis as needed. This speed up
the start up time on large workspaces.

Does various refactoring as well.

* Simplify the handling of META files

We no longer generate a META.foo.from-jbuilder file. Nobody is using
this feature and it's making the new code more complicated.

CHANGES.md

@@ -56,6 +56,15 @@ next
   ppx_driver. This allows to use `[@@deriving_inline]` in .ml/.mli
   files. This require `ppx_driver >= v0.10.2` to work properly (#415)
 
+- Make jbuilder load rules lazily instead of generating them all
+  eagerly. This speeds up the initial startup time of jbuilder on big
+  workspaces (#370)
+
+- Now longer generate a `META.pkg.from-jbuilder` file. Now the only
+  way to customise the generated `META` file is through
+  `META.pkg.template`. This feature was unused and was making the code
+  complicated (#370)
+
 1.0+beta16 (05/11/2017)
 -----------------------
 

bin/main.ml

@@ -24,6 +24,7 @@ type common =
   ; x                : string option
   ; diff_command     : string option
   ; auto_promote     : bool
+  ; force            : bool
   ; (* Original arguments for the external-lib-deps hint *)
     orig_args        : string list
   }
@@ -43,6 +44,7 @@ let set_common c ~targets =
   Clflags.workspace_root := Sys.getcwd ();
   Clflags.diff_command := c.diff_command;
   Clflags.auto_promote := c.auto_promote;
+  Clflags.force := c.force;
   Clflags.external_lib_deps_hint :=
     List.concat
       [ ["jbuilder"; "external-lib-deps"; "--missing"]
@@ -73,10 +75,9 @@ let restore_cwd_and_execve common prog argv env =
 module Main = struct
   include Jbuilder.Main
 
-  let setup ~log ?unlink_aliases ?filter_out_optional_stanzas_with_missing_deps common =
+  let setup ~log ?filter_out_optional_stanzas_with_missing_deps common =
     setup
       ~log
-      ?unlink_aliases
       ?workspace_file:common.workspace_file
       ?only_packages:common.only_packages
       ?filter_out_optional_stanzas_with_missing_deps
@@ -86,17 +87,29 @@ end
 
 type target =
   | File      of Path.t
-  | Alias_rec of Alias.t
+  | Alias_rec of Path.t
 
 let request_of_targets (setup : Main.setup) targets =
   let open Build.O in
+  let contexts = List.map setup.contexts ~f:(fun c -> c.Context.name) 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_rec path ->
-      Alias.dep_rec ~loc:(Loc.in_file "<command-line>")
+      let dir = Path.parent path in
-        ~file_tree:setup.file_tree alias)
+      let name = Path.basename path in
+      let contexts, dir =
+        match Path.extract_build_context dir with
+        | None -> (contexts, dir)
+        | Some ("install", _) ->
+          die "Invalid alias: %s.\n\
+               There are no aliases in _build/install."
+            (Path.to_string_maybe_quoted path)
+        | Some (ctx, dir) -> ([ctx], dir)
+      in
+      Build_system.Alias.dep_rec_multi_contexts ~dir ~name
+        ~file_tree:setup.file_tree ~contexts)
 
 let do_build (setup : Main.setup) targets =
   Build_system.do_build_exn setup.build_system
@@ -162,6 +175,7 @@ let common =
         workspace_file
         diff_command
         auto_promote
+        force
         (root, only_packages, orig)
         x
     =
@@ -190,6 +204,7 @@ let common =
     ; target_prefix = String.concat ~sep:"" (List.map to_cwd ~f:(sprintf "%s/"))
     ; diff_command
     ; auto_promote
+    ; force
     ; only_packages =
         Option.map only_packages
           ~f:(fun s -> String_set.of_list (String.split s ~on:','))
@@ -287,6 +302,13 @@ let common =
              ~doc:"Automatically promote files. This is similar to running
                    $(b,jbuilder promote) after the build.")
   in
+  let force =
+    Arg.(value
+         & flag
+         & info ["force"; "f"]
+             ~doc:"Force actions associated to aliases to be re-executed even
+                   if their dependencies haven't changed.")
+  in
   let for_release = "for-release-of-packages" in
   let frop =
     Arg.(value
@@ -349,6 +371,7 @@ let common =
         $ workspace_file
         $ diff_command
         $ auto_promote
+        $ force
         $ root_and_only_packages
         $ x
        )
@@ -423,21 +446,43 @@ let target_hint (setup : Main.setup) path =
   let candidates = String_set.of_list candidates |> String_set.elements in
   hint (Path.to_string path) candidates
 
+let check_path contexts =
+  let contexts = String_set.of_list (List.map contexts ~f:(fun c -> c.Context.name)) in
+  fun path ->
+    let internal path =
+      die "This path is internal to jbuilder: %s" (Path.to_string_maybe_quoted path)
+    in
+    if Path.is_in_build_dir path then
+      match Path.extract_build_context path with
+      | None -> internal path
+      | Some (name, _) ->
+        if name = "" || name.[0] = '.' then internal path;
+        if not (name = "install" || String_set.mem name contexts) then
+          die "%s refers to unknown build context: %s%s"
+            (Path.to_string_maybe_quoted path)
+            name
+            (hint name (String_set.elements contexts))
+
 let resolve_targets ~log common (setup : Main.setup) user_targets =
   match user_targets with
   | [] -> []
   | _ ->
+    let check_path = check_path setup.contexts in
     let targets =
       List.map user_targets ~f:(fun s ->
-        if String.is_prefix s ~prefix:"@" then
+        if String.is_prefix s ~prefix:"@" then begin
           let s = String.sub s ~pos:1 ~len:(String.length s - 1) in
           let path = Path.relative Path.root (prefix_target common s) in
+          check_path path;
           if Path.is_root path then
             die "@@ on the command line must be followed by a valid alias name"
+          else if not (Path.is_local path) then
+            die "@@ on the command line must be followed by a relative path"
           else
-            Ok [Alias_rec (Alias.of_path path)]
+            Ok [Alias_rec path]
-        else
+        end else begin
           let path = Path.relative Path.root (prefix_target common s) in
+          check_path path;
           let can't_build path =
             Error (path, target_hint setup path);
           in
@@ -450,23 +495,17 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
               can't_build path
           end else
             match
-              let l =
+              List.filter_map setup.contexts ~f:(fun ctx ->
-                List.filter_map setup.contexts ~f:(fun ctx ->
+                let path = Path.append ctx.Context.build_dir path in
-                    let path = Path.append ctx.Context.build_dir path in
+                if Build_system.is_target setup.build_system path then
-                    if Build_system.is_target setup.build_system path then
+                  Some (File path)
-                      Some (File path)
+                else
-                    else
+                  None)
-                      None)
-              in
-              if Build_system.is_target setup.build_system path ||
-                 Path.exists path then
-                File path :: l
-              else
-                l
             with
             | [] -> can't_build path
             | l  -> Ok l
-        )
+        end
+      )
     in
     if !Clflags.verbose then begin
       Log.info log "Actual targets:";
@@ -477,8 +516,7 @@ 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_rec alias ->
+        | Alias_rec path ->
-          let path = Alias.fully_qualified_name alias in
           Log.info log @@ "- recursive alias " ^
                           (Path.to_string_maybe_quoted path));
       flush stdout;
@@ -524,8 +562,7 @@ let runtest =
     ]
   in
   let name_ = Arg.info [] ~docv:"DIR" in
-  let go common force dirs =
+  let go common dirs =
-    let unlink_aliases = if force then Some ["runtest"] else None in
     set_common common
       ~targets:(List.map dirs ~f:(function
         | "" | "." -> "@runtest"
@@ -533,16 +570,17 @@ let runtest =
         | dir -> sprintf "@%s/runtest" dir));
     let log = Log.create () in
     Future.Scheduler.go ~log
-      (Main.setup ?unlink_aliases ~log common >>= fun setup ->
+      (Main.setup ~log common >>= fun setup ->
+       let check_path = check_path setup.contexts in
        let targets =
          List.map dirs ~f:(fun dir ->
            let dir = Path.(relative root) (prefix_target common dir) in
-           Alias_rec (Alias.runtest ~dir))
+           check_path dir;
+           Alias_rec (Path.relative dir "runtest"))
        in
        do_build setup targets) in
   ( Term.(const go
           $ common
-          $ Arg.(value & flag & info ["force"; "f"])
           $ Arg.(value & pos_all string ["."] name_))
   , Term.info "runtest" ~doc ~man)
 
@@ -557,7 +595,8 @@ let clean =
   let go common =
     begin
       set_common common ~targets:[];
-      Build_system.all_targets_ever_built () |> List.iter ~f:Path.unlink_no_err;
+      Build_system.files_in_source_tree_to_delete ()
+      |> List.iter ~f:Path.unlink_no_err;
       Path.(rm_rf (append root (of_string "_build")))
     end
   in
@@ -928,7 +967,7 @@ let exec =
         | [] -> ()
         | targets ->
           Future.Scheduler.go ~log (do_build setup targets);
-          Build_system.dump_trace setup.build_system
+          Build_system.finalize setup.build_system
       end;
       match prog_where with
       | `Search prog ->
@@ -1061,7 +1100,7 @@ let utop =
        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;
+    Build_system.finalize build_system;
     restore_cwd_and_execve common utop_path (Array.of_list (utop_path :: args))
       (Context.env_for_exec context)
   in

doc/advanced-topics.rst

@@ -16,26 +16,19 @@ of a project to Jbuilder, it is allowed to write/generate a specific
 one.
 
 In order to do that, write or setup a rule to generate a
-``META.<package>`` file in the same directory as the ``<package>.opam``
+``META.<package>.template`` file in the same directory as the
-file. If you do that, Jbuilder will still generate a ``META`` file but
+``<package>.opam`` file. Jbuilder will generate a ``META.<package>``
-it will be called ``META.<package>.from-jbuilder``. So for instance if
+file from the ``META.<package>.template`` file by replacing lines of
-you want to extend the ``META`` file generated by Jbuilder you can
+the form ``# JBUILDER_GEN`` by the contents of the ``META`` it would
-write:
+normally generate.
 
-.. code:: scheme
+For instance if you want to extend the ``META`` file generated by
+Jbuilder you can write the folliwing ``META.foo.template`` file:
 
-    (rule
+.. code::
-     ((targets (META.foo))
-      (deps    (META.foo.from-jbuilder))
-      (action  (with-stdout-to ${@}
-                (progn
-                 (cat ${<})
-                 (echo blah))))))
 
-Additionally, Jbuilder provides a simpler mechanism for this scheme:
+   # JBUILDER_GEN
-just write or generate a ``META.<package>.template`` file containing a
+   blah = "..."
-line of the form ``# JBUILDER_GEN``. Jbuilder will automatically insert
-its generated ``META`` contents in place of this line.
 
 .. _custom-driver:
 

doc/usage.rst

@@ -91,14 +91,13 @@ the command line.
 Resolution
 ----------
 
-Most targets that Jbuilder knows how to build lives in the ``_build`` directory,
+All targets that Jbuilder knows how to build live in the ``_build``
-except for a few:
+directory.  Although, some are sometimes copied to the source tree for
+the need of external tools. These includes:
 
-= ``.merlin`` files
+- ``.merlin`` files
 
-- ``<package>.install`` files; for the ``default`` context Jbuilder knows how
+- ``<package>.install`` files
-   generate the install file both in ``_build/default`` and in the source tree
-   so that ``opam`` can find it
 
 As a result, if you want to ask ``jbuilder`` to produce a particular ``.exe``
 file you would have to type:
@@ -107,14 +106,15 @@ file you would have to type:
 
     $ jbuilder build _build/default/bin/prog.exe
 
-However, for convenience when a target on the command line doesn't start with
+However, for convenience when a target on the command line doesn't
-``_build``, ``jbuilder`` will expand it to the corresponding target in all the
+start with ``_build``, ``jbuilder`` will expand it to the
-build contexts where it knows how to build it. It prints out the actual set of
+corresponding target in all the build contexts where it knows how to
-targets when starting so that you know what is happening:
+build it. When using ``--verbose``, It prints out the actual set of
+targets when starting:
 
 .. code:: bash
 
-    $ jbuilder build bin/prog.exe
+    $ jbuilder build bin/prog.exe --verbose
     ...
     Actual targets:
     - _build/default/bin/prog.exe
@@ -126,11 +126,11 @@ Aliases
 
 Targets starting with a ``@`` are interpreted as aliases. For instance
 ``@src/runtest`` means the alias ``runtest`` in all descendant of
-``src`` where it is defined. If you want to refer to a target starting
+``src`` in all build contexts where it is defined. If you want to
-with a ``@``, simply write: ``./@foo``.
+refer to a target starting with a ``@``, simply write: ``./@foo``.
 
-Note that an alias not pointing to the ``_build`` directory always
+To build and run the tests for a particular build context, use
-depends on all the corresponding aliases in build contexts.
+``@_build/default/runtest`` instead.
 
 So for instance:
 

src/action.ml

@@ -795,7 +795,7 @@ let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to =
     exec_echo stdout_to s
   | Diff { optional; file1; file2 } ->
     if (optional && not (Path.exists file1 && Path.exists file2)) ||
-       Io.read_file (Path.to_string file1) = Io.read_file (Path.to_string file2) then
+       Io.compare_files (Path.to_string file1) (Path.to_string file2) = 0 then
       return ()
     else begin
       let is_copied_from_source_tree file =

src/alias.ml

@@ -1,210 +0,0 @@
-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 =
-  { name : Fq_name.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'
-
-let of_path path =
-  if not (Path.is_local path) then
-    die "Aliases are only supported for local paths!\n\
-         Tried to reference alias %S"
-      (Path.to_string path);
-  { name = Fq_name.make path
-  ; file = Path.extend_basename (Path.append aliases_path path) ~suffix
-  }
-
-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" | "lint" -> true
-  | _ -> false
-
-let dep_rec ~loc ~file_tree t =
-  let path = Path.parent   (Fq_name.path t.name) |> Path.drop_optional_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 =
-  let dir = Path.parent t.file in
-  let base = Path.basename t.file in
-  let len = String.length base in
-  Path.relative dir
-    (String.sub base ~pos:0 ~len:(len - 32) ^ Digest.to_hex digest)
-
-let of_file fn =
-  match Path.extract_build_context fn with
-  | Some (".aliases", fn) -> begin
-      let dir  = Path.parent   fn in
-      let name = Path.basename fn in
-      match String.rsplit2 name ~on:'-' with
-      | None -> assert false
-      | Some (name, digest) ->
-        assert (String.length digest = 32);
-        Some (make name ~dir)
-    end
-  | _ -> None
-
-let name_of_file fn =
-  match Path.extract_build_context fn with
-  | Some (".aliases", fn) -> begin
-      let name = Path.basename fn in
-      match String.rsplit2 name ~on:'-' with
-      | None -> assert false
-      | Some (name, digest) ->
-        assert (String.length digest = 32);
-        Some name
-    end
-  | _ -> None
-
-let default = make "DEFAULT"
-let runtest = make "runtest"
-let install = make "install"
-let doc     = make "doc"
-let lint    = make "lint"
-
-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
-
-  let unlink (store : t) = function
-    | [] -> ()
-    | alias_basenames ->
-      store
-      |> Hashtbl.fold ~init:Path.Set.empty ~f:(fun ~key:_ ~data:entry acc ->
-        if List.mem (name entry.alias) ~set:alias_basenames then (
-          Path.Set.union acc (Path.Set.add entry.alias.file entry.deps)
-        ) else (
-          acc
-        ))
-      |> Path.Set.iter ~f:Path.unlink_no_err
-end
-
-let add_deps store t deps =
-  let deps = Path.Set.of_list deps in
-  match Hashtbl.find store t.name with
-  | None ->
-    Hashtbl.add store ~key:t.name
-      ~data:{ Store.alias = t
-            ; deps = deps
-            }
-  | Some e -> e.deps <- Path.Set.union deps e.deps
-
-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
-    | None -> acc
-    | Some (_, in_src) -> (of_path in_src, alias) :: acc)
-  |> List.iter ~f:(fun (in_src, in_build_dir) ->
-      add_deps store in_src [in_build_dir.file]);
-
-  Hashtbl.fold store ~init:[] ~f:(fun ~key:_ ~data:{ Store. alias; deps } acc ->
-    let open Build.O in
-    let rule =
-      Build_interpret.Rule.make
-        (Build.path_set deps >>>
-         Build.action ~targets:[alias.file]
-           (Redirect (Stdout,
-                      alias.file,
-                      Digest_files
-                        (Path.Set.elements deps))))
-    in
-    rule :: acc)
-
-let add_build store t ~stamp build =
-  let digest = Digest.string (Sexp.to_string stamp) in
-  let digest_path = file_with_digest_suffix t ~digest in
-  add_deps store t [digest_path];
-  Build.progn
-    [ build
-    ; Build.create_file digest_path
-    ]
-
-let add_builds store t builds =
-  let digest_files, actions =
-    List.split
-      (List.map builds ~f:(fun (stamp, build) ->
-         let digest = Digest.string (Sexp.to_string stamp) in
-         let digest_path = file_with_digest_suffix t ~digest in
-         (digest_path,
-          Build.progn
-            [ build
-            ; Build.create_file digest_path
-            ])))
-  in
-  add_deps store t digest_files;
-  actions

src/alias.mli

@@ -1,95 +0,0 @@
-(** Rule aliases. *)
-
-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:
-
-    {[
-      make (name t) ~dir:(dir 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 lint    : 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
-
-(** Same as [file t], except that it sets the digest suffix to [digest]. Files
-    representing aliases ends with a hex-encoded md5sum of some data. It is usually filled
-    with zeros except for files that represent the running of an action associated to an
-    alias, it which case it is the md5 checksum of the action and its dependencies. *)
-val file_with_digest_suffix : t -> digest:Digest.t -> Path.t
-
-(** The following holds for any path [p]:
-
-    {[
-      match of_file p with
-      | None -> true
-      | Some t -> p = file t
-    ]}
-*)
-val of_file : Path.t -> t option
-
-(** Same as [Option.map (of_file p) ~f:name] but more efficient. *)
-val name_of_file : Path.t -> string option
-
-module Store : sig
-  type t
-
-  val pp : t Fmt.t
-
-  val create : unit -> t
-
-  val unlink : t -> string list -> unit
-end
-
-(** [add_build store alias deps] arrange things so that all [deps] are built as part of
-    the build of alias [alias]. *)
-val add_deps : Store.t -> t -> Path.t list -> unit
-
-(** [add_build store alias ~stamp build] arrange things so that [build] is part of the
-    build of alias [alias]. [stamp] is any S-expression that is unique and persistent
-    S-expression.
-
-    Return a rule that must be added with [Super_context.add_rule].
-*)
-val add_build
-  :  Store.t
-  -> t
-  -> stamp:Sexp.t
-  -> (unit, Action.t) Build.t
-  -> (unit, Action.t) Build.t
-
-(** Same as calling [add_build] in a loop but slightly more efficient. *)
-val add_builds
-  :  Store.t
-  -> t
-  -> (Sexp.t * (unit, Action.t) Build.t) list
-  -> (unit, Action.t) Build.t list
-
-val rules : Store.t -> Build_interpret.Rule.t list
-

src/build_interpret.ml

@@ -26,7 +26,7 @@ module Static_deps = struct
     }
 end
 
-let static_deps t ~all_targets_by_dir =
+let static_deps t ~all_targets =
   let rec loop : type a b. (a, b) t -> Static_deps.t -> Static_deps.t = fun t acc ->
     match t with
     | Arr _ -> acc
@@ -43,30 +43,32 @@ let static_deps t ~all_targets_by_dir =
         | G_evaluated l ->
           { acc with action_deps = Pset.union acc.action_deps (Pset.of_list l) }
         | G_unevaluated (loc, dir, re) ->
-          match Pmap.find dir (Lazy.force all_targets_by_dir) with
+          let targets = all_targets ~dir in
-          | None ->
+          let result =
-            Loc.warn loc "Directory %s doesn't exist."
+            Pset.filter targets ~f:(fun path ->
-              (Path.to_string_maybe_quoted dir);
+              Re.execp re (Path.basename path))
-            state := G_evaluated [];
+          in
-            acc
+          if Pset.is_empty result then begin
-          | Some targets ->
+            if not (Path.exists dir) then
-            let result =
+              Loc.warn loc "Directory %s doesn't exist."
-              Pset.filter targets ~f:(fun path ->
+                (Path.to_string_maybe_quoted dir)
-                Re.execp re (Path.basename path))
+            else if not (Path.is_directory dir) then
-            in
+              Loc.warn loc "%s is not a directory."
-            state := G_evaluated (Pset.elements result);
+                (Path.to_string_maybe_quoted dir)
-            let action_deps = Pset.union result acc.action_deps in
+            else
-            { acc with action_deps }
+              (* diml: we should probably warn in this case as well *)
+              ()
+          end;
+          state := G_evaluated (Pset.elements result);
+          let action_deps = Pset.union result acc.action_deps in
+          { acc with action_deps }
       end
     | If_file_exists (p, state) -> begin
         match !state with
         | Decided (_, t) -> loop t acc
         | Undecided (then_, else_) ->
           let dir = Path.parent p in
-          let targets =
+          let targets = all_targets ~dir in
-            Option.value (Pmap.find dir (Lazy.force all_targets_by_dir))
-              ~default:Pset.empty
-          in
           if Pset.mem p targets then begin
             state := Decided (true, then_);
             loop then_ acc
@@ -157,19 +159,38 @@ module Rule = struct
     ; build    : (unit, Action.t) Build.t
     ; targets  : Target.t list
     ; sandbox  : bool
-    ; fallback : Jbuild.Rule.Fallback.t
+    ; mode     : Jbuild.Rule.Mode.t
     ; locks    : Path.t list
     ; loc      : Loc.t option
+    ; dir      : Path.t
     }
 
-  let make ?(sandbox=false) ?(fallback=Jbuild.Rule.Fallback.Not_possible)
+  let make ?(sandbox=false) ?(mode=Jbuild.Rule.Mode.Not_a_rule_stanza)
         ?context ?(locks=[]) ?loc build =
+    let targets = targets build in
+    let dir =
+      match targets with
+      | [] ->
+        invalid_arg "Build_interpret.Rule.make: rule has no targets"
+      | x :: l ->
+        let dir = Path.parent (Target.path x) in
+        List.iter l ~f:(fun target ->
+          let path = Target.path target in
+          if Path.parent path <> dir then
+            Sexp.code_error "rule has targets in different directories"
+              [ "dir", Path.sexp_of_t dir
+              ; "targets", Sexp.To_sexp.list Path.sexp_of_t
+                             (List.map (x :: l) ~f:Target.path)
+              ]);
+        dir
+    in
     { context
     ; build
-    ; targets = targets build
+    ; targets
     ; sandbox
-    ; fallback
+    ; mode
     ; locks
     ; loc
+    ; dir
     }
 end

src/build_interpret.mli

@@ -15,14 +15,16 @@ module Rule : sig
     ; build    : (unit, Action.t) Build.t
     ; targets  : Target.t list
     ; sandbox  : bool
-    ; fallback : Jbuild.Rule.Fallback.t
+    ; mode     : Jbuild.Rule.Mode.t
     ; locks    : Path.t list
     ; loc      : Loc.t option
+    ; (** Directory where all the targets are produced *)
+      dir      : Path.t
     }
 
   val make
     :  ?sandbox:bool
-    -> ?fallback:Jbuild.Rule.Fallback.t
+    -> ?mode:Jbuild.Rule.Mode.t
     -> ?context:Context.t
     -> ?locks:Path.t list
     -> ?loc:Loc.t
@@ -40,7 +42,7 @@ end
 (* must be called first *)
 val static_deps
   :  (_, _) Build.t
-  -> all_targets_by_dir:Path.Set.t Path.Map.t Lazy.t
+  -> all_targets:(dir:Path.t -> Path.Set.t)
   -> Static_deps.t
 
 val lib_deps

src/build_system.mli

@@ -4,15 +4,137 @@ open! Import
 
 type t
 
+(** {1 Creation} *)
+
+(** Create a new build system. [file_tree] represent the source
+    tree. *)
 val create
   :  contexts:Context.t list
   -> file_tree:File_tree.t
-  -> rules:Build_interpret.Rule.t list
   -> t
 
-val is_target : t -> Path.t -> bool
+type extra_sub_directories_to_keep =
+  | All
+  | These of String_set.t
+
+(** Set the rule generators callback. There must be one callback per
+   build context name.
+
+    Each callback is used to generate the rules for a given directory
+    in the corresponding build context. It receive the directory for
+    which to generate the rules and the splitted part of the path after
+    the build context. It must return an additional list of
+    sub-directories to keep. This is in addition to the ones that are
+    present in the source tree and the ones that already contain rules.
+
+    It is expected that [f] only generate rules whose targets are
+   descendant of [dir]. *)
+val set_rule_generators : t -> (dir:Path.t -> string list -> extra_sub_directories_to_keep) String_map.t -> unit
+
+(** {1 Primitive for rule generations} *)
+
+(** Add a rule to the system. This function must be called from the [gen_rules]
+    callback. All the target of the rule must be in the same directory.
+
+    Assuming that [gen_rules ~dir:a] calls [add_rule r] where [r.dir] is [Some b], one of
+    the following assumption must hold:
+
+    - [a] and [b] are the same
+    - [gen_rules ~dir:b] calls [load_dir ~dir:a]
+
+    The call to [load_dir ~dir:a] from [gen_rules ~dir:b] declares a directory dependency
+    from [b] to [a]. There must be no cyclic directory dependencies.
+*)
+val add_rule : t -> Build_interpret.Rule.t -> unit
+
+(** [eval_glob t ~dir re ~f] returns the list of files in [dir] that matches [re] to
+    [f]. The list of files includes the list of targets. *)
+val eval_glob : t -> dir:Path.t -> Re.re -> string list
+
+(** Returns the set of targets in the given directory. *)
+val targets_of : t -> dir:Path.t -> Path.Set.t
+
+(** Load the rules for this directory. *)
+val load_dir : t -> dir:Path.t -> unit
+
+(** [on_load_dir ~dir ~f] remembers to run [f] when loading the rules for [dir]. *)
+val on_load_dir : t -> dir:Path.t -> f:(unit -> unit) -> unit
+
+(** Stamp file that depends on all files of [dir] with extension [ext]. *)
+val stamp_file_for_files_of : t -> dir:Path.t -> ext:string -> Path.t
+
+(** {1 Aliases} *)
+
+module Alias : sig
+  type build_system = t
+  type t
+
+  val pp : t Fmt.t
+
+  val make : string -> dir:Path.t -> t
+
+  val of_path : Path.t -> t
+
+  (** The following always holds:
+
+      {[
+        make (name t) ~dir:(dir 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 lint    : dir:Path.t -> t
+
+  (** Return the underlying stamp file *)
+  val stamp_file : t -> Path.t
+
+  (** [dep t = Build.path (stamp_file t)] *)
+  val dep : t -> ('a, 'a) Build.t
+
+  (** Implements [(alias_rec ...)] in dependency specification *)
+  val dep_rec
+    :  t
+    -> loc:Loc.t
+    -> file_tree:File_tree.t
+    -> (unit, unit) Build.t
+
+  (** Implements [@alias] on the command line *)
+  val dep_rec_multi_contexts
+    :  dir:Path.t
+    -> name:string
+    -> file_tree:File_tree.t
+    -> contexts:string list
+    -> (unit, unit) Build.t
+
+  (** [add_deps store alias deps] arrange things so that all [deps]
+      are built as part of the build of alias [alias]. *)
+  val add_deps : build_system -> t -> Path.t list -> unit
+
+  (** [add_action store alias ~stamp action] arrange things so that
+      [action] is executed as part of the build of alias
+      [alias]. [stamp] is any S-expression that is unique and
+      persistent S-expression.
+  *)
+  val add_action
+    :  build_system
+    -> t
+    -> ?locks:Path.t list
+    -> stamp:Sexp.t
+    -> (unit, Action.t) Build.t
+    -> unit
+end with type build_system := t
+
+(** {1 Building} *)
 
 module Build_error : sig
+  (** Exception raised in case of build error *)
   type t
 
   val backtrace : t -> Printexc.raw_backtrace
@@ -32,6 +154,10 @@ val do_build_exn
   -> request:(unit, unit) Build.t
   -> unit Future.t
 
+(** {1 Other queries} *)
+
+val is_target : t -> Path.t -> bool
+
 (** Return all the library dependencies (as written by the user)
    needed to build this request *)
 val all_lib_deps
@@ -49,6 +175,14 @@ val all_lib_deps_by_context
 (** List of all buildable targets *)
 val all_targets : t -> Path.t list
 
+(** Return the list of files that were created in the source tree and
+    needs to be deleted *)
+val files_in_source_tree_to_delete
+  :  unit
+  -> Path.t list
+
+(** {1 Build rules} *)
+
 (** A fully built rule *)
 module Rule : sig
   module Id : sig
@@ -75,8 +209,7 @@ val build_rules
   -> request:(unit, unit) Build.t
   -> Rule.t list Future.t
 
-val all_targets_ever_built
+(** {1 Misc} *)
-  :  unit
-  -> Path.t list
 
-val dump_trace : t -> unit
+(** Dump various databases on disk *)
+val finalize : t -> unit

src/clflags.ml

@@ -12,3 +12,4 @@ let capture_outputs = ref true
 let debug_backtraces = ref false
 let diff_command = ref None
 let auto_promote = ref false
+let force = ref false

src/clflags.mli

@@ -41,3 +41,6 @@ val diff_command : string option ref
 
 (** Automatically promote files *)
 val auto_promote : bool ref
+
+(** Force re-running actions associated to aliases *)
+val force : bool ref

src/file_tree.ml

@@ -13,6 +13,19 @@ module Dir = struct
   let sub_dirs t = t.sub_dirs
   let ignored t = t.ignored
 
+  let file_paths t =
+    Path.Set.of_string_set t.files ~f:(Path.relative t.path)
+
+  let sub_dir_names t =
+    String_map.fold t.sub_dirs ~init:String_set.empty
+      ~f:(fun ~key:s ~data:_ acc ->
+        String_set.add s acc)
+
+  let sub_dir_paths t =
+    String_map.fold t.sub_dirs ~init:Path.Set.empty
+      ~f:(fun ~key:s ~data:_ acc ->
+        Path.Set.add (Path.relative t.path s) acc)
+
   let rec fold t ~traverse_ignored_dirs ~init:acc ~f =
     if not traverse_ignored_dirs && t.ignored then
       acc
@@ -89,6 +102,12 @@ let fold t ~traverse_ignored_dirs ~init ~f =
 let find_dir t path =
   Path.Map.find path t.dirs
 
+let files_of t path =
+  match find_dir t path with
+  | None -> Path.Set.empty
+  | Some dir ->
+    Path.Set.of_string_set (Dir.files dir) ~f:(Path.relative path)
+
 let file_exists t path fn =
   match Path.Map.find path t.dirs with
   | None -> false

src/file_tree.mli

@@ -5,7 +5,10 @@ module Dir : sig
 
   val path     : t -> Path.t
   val files    : t -> String_set.t
+  val file_paths    : t -> Path.Set.t
   val sub_dirs : t -> t String_map.t
+  val sub_dir_paths : t -> Path.Set.t
+  val sub_dir_names : t -> String_set.t
 
   (** Whether this directory is ignored by a [jbuild-ignore] file in
       one of its ancestor directories. *)
@@ -34,6 +37,8 @@ val root : t -> Dir.t
 
 val find_dir : t -> Path.t -> Dir.t option
 
+val files_of : t -> Path.t -> Path.Set.t
+
 val exists : t -> Path.t -> bool
 val file_exists : t -> Path.t -> string -> bool
 

src/future.ml

@@ -387,30 +387,15 @@ module Scheduler = struct
       let rec split_paths targets_acc ctxs_acc = function
         | [] -> List.rev targets_acc, String_set.(elements (of_list ctxs_acc))
         | path :: rest ->
-          match Path.extract_build_context path with
+          let add_ctx ctx acc = if ctx = "default" then acc else ctx :: acc in
-          | None ->
+          match Utils.analyse_target path with
+          | Other path ->
             split_paths (Path.to_string path :: targets_acc) ctxs_acc rest
-          | Some ("default", filename) ->
+          | Regular (ctx, filename) ->
-            split_paths (Path.to_string filename :: targets_acc) ctxs_acc rest
+            split_paths (Path.to_string filename :: targets_acc) (add_ctx ctx ctxs_acc) rest
-          | Some (".aliases", filename) ->
+          | Alias (ctx, name) ->
-            let ctxs_acc, filename =
+            split_paths (("alias " ^ Path.to_string name) :: targets_acc) (add_ctx ctx ctxs_acc) rest
-              match Path.extract_build_context filename with
+      in
-              | None -> ctxs_acc, Path.to_string filename
-              | Some (ctx, fn) ->
-                let strip_digest fn =
-                  let fn = Path.to_string fn in
-                  match String.rsplit2 fn ~on:'-' with
-                  | None -> assert false
-                  | Some (name, digest) ->
-                    assert (String.length digest = 32);
-                    name
-                in
-                let ctxs_acc =
-                  if ctx = "default" then ctxs_acc else ctx :: ctxs_acc in
-                ctxs_acc, strip_digest fn in
-            split_paths (("alias " ^ filename) :: targets_acc) ctxs_acc rest
-          | Some (ctx, filename) ->
-            split_paths (Path.to_string filename :: targets_acc) (ctx :: ctxs_acc) rest in
       let target_names, contexts = split_paths [] [] targets in
       let target_names_grouped_by_prefix =
         List.map target_names ~f:Filename.split_extension_after_dot

src/gen_rules.mli

@@ -1,12 +1,11 @@
 open! Import
 open Jbuild
 
+(* Generate rules. Returns evaluated jbuilds per context names. *)
 val gen
   :  contexts:Context.t list
+  -> build_system:Build_system.t
   -> ?filter_out_optional_stanzas_with_missing_deps:bool (* default: true *)
   -> ?only_packages:String_set.t
-  -> ?unlink_aliases:string list
   -> Jbuild_load.conf
-  -> (Build_interpret.Rule.t list *
+  -> (Path.t * Scope.t * Stanzas.t) list String_map.t Future.t
-     (* Evaluated jbuilds per context names *)
-     (Path.t * Scope.t * Stanzas.t) list String_map.t) Future.t

src/import.ml

@@ -2,7 +2,29 @@ include Jbuilder_re
 
 module Array   = StdLabels.Array
 module Bytes   = StdLabels.Bytes
-module Set     = MoreLabels.Set
+
+module Set = struct
+  module type OrderedType = MoreLabels.Set.OrderedType
+  module type S = sig
+    include MoreLabels.Set.S
+    val map : f:(elt -> elt) -> t -> t
+  end
+
+  module Make(Elt : OrderedType) : S with type elt = Elt.t = struct
+    module M = MoreLabels.Set.Make(Elt)
+
+    include struct
+      [@@@warning "-32"]
+      (* [map] is only available since 4.04 *)
+      let map ~f t =
+        M.elements t
+        |> List.map f
+        |> M.of_list
+    end
+
+    include M
+  end
+end
 
 external reraise : exn -> _ = "%reraise"
 

src/io.ml

@@ -66,3 +66,6 @@ let copy_file ~src ~dst =
       ~finally:close_out
       ~f:(fun oc ->
         copy_channels ic oc))
+
+(* TODO: diml: improve this *)
+let compare_files fn1 fn2 = String.compare (read_file fn1) (read_file fn2)

src/io.mli

@@ -16,6 +16,8 @@ val lines_of_file : string -> string list
 val read_file : string -> string
 val write_file : string -> string -> unit
 
+val compare_files : string -> string -> int
+
 val copy_channels : in_channel -> out_channel -> unit
 
 val copy_file : src:string -> dst:string -> unit

src/jbuild.ml

@@ -727,18 +727,21 @@ module Rule = struct
       | Infer
   end
 
-  module Fallback = struct
+
+  module Mode = struct
     type t =
-      | Yes
+      | Standard
-      | No
+      | Fallback
-      | Not_possible
+      | Promote
+      | Promote_but_delete_on_clean
+      | Not_a_rule_stanza
   end
 
   type t =
     { targets  : Targets.t
     ; deps     : Dep_conf.t list
     ; action   : Action.Unexpanded.t
-    ; fallback : Fallback.t
+    ; mode     : Mode.t
     ; locks    : String_with_vars.t list
     ; loc      : Loc.t
     }
@@ -749,7 +752,7 @@ module Rule = struct
       { targets  = Infer
       ; deps     = []
       ; action   = Action.Unexpanded.t sexp
-      ; fallback = No
+      ; mode     = Standard
       ; locks    = []
       ; loc      = Loc.none
       }
@@ -763,7 +766,7 @@ module Rule = struct
          return { targets = Static targets
                 ; deps
                 ; action
-                ; fallback = if fallback then Yes else No
+                ; mode = if fallback then Fallback else Standard
                 ; locks
                 ; loc = Loc.none
                 })
@@ -785,7 +788,7 @@ module Rule = struct
                   ; S.virt_var __POS__ "@"
                   ; S.virt_var __POS__"<"
                   ]))
-      ; fallback = Not_possible
+      ; mode = Not_a_rule_stanza
       ; locks = []
       ; loc
       })
@@ -801,7 +804,7 @@ module Rule = struct
             (S.virt_var __POS__ "ROOT",
              Run (S.virt_text __POS__ "ocamlyacc",
                   [S.virt_var __POS__ "<"]))
-      ; fallback = Not_possible
+      ; mode = Not_a_rule_stanza
       ; locks = []
       ; loc
       })
@@ -841,7 +844,7 @@ module Menhir = struct
               (S.virt_var __POS__ "ROOT",
                Run (S.virt_text __POS__ "menhir",
                     t.flags @ [S.virt_var __POS__ "<"]))
-        ; fallback = Not_possible
+        ; mode = Not_a_rule_stanza
         ; locks = []
        ; loc
        })
@@ -861,7 +864,7 @@ module Menhir = struct
                      ; t.flags
                      ; [ S.virt_var __POS__ "^" ]
                      ]))
-       ; fallback = Not_possible
+       ; mode = Not_a_rule_stanza
        ; locks = []
        ; loc
        }]

src/jbuild.mli

@@ -203,20 +203,25 @@ module Rule : sig
       | Infer
   end
 
-  module Fallback : sig
+  module Mode : sig
     type t =
-      | Yes
+      | Standard
-      | No
+      (** Only use this rule if  the source files don't exist. *)
-      | Not_possible
+      | Fallback
-      (** It is not possible to add a [(fallback)] field to the rule. For instance for
+      (** Silently promote the targets to the source tree. *)
-          [ocamllex], ... *)
+      | Promote
+      (** Same as [Promote] but [jbuilder clean] must delete the file *)
+      | Promote_but_delete_on_clean
+      (** Same as [Standard] however this is not a rule stanza, so it is not possible to
+          add a [(fallback)] field to the rule. *)
+      | Not_a_rule_stanza
   end
 
   type t =
     { targets  : Targets.t
     ; deps     : Dep_conf.t list
     ; action   : Action.Unexpanded.t
-    ; fallback : Fallback.t
+    ; mode     : Mode.t
     ; locks    : String_with_vars.t list
     ; loc      : Loc.t
     }

src/js_of_ocaml_rules.ml

@@ -101,36 +101,34 @@ let build_cm sctx ~scope ~dir ~js_of_ocaml ~src =
       js_of_ocaml_rule ~sctx ~dir ~flags:(fun flags -> As flags) ~spec ~target ]
   else []
 
-let setup_separate_compilation_rules sctx =
+let setup_separate_compilation_rules sctx components =
   if separate_compilation_enabled ()
   then
-    let ctx = SC.context sctx in
+    match components with
-    let all_pkg =
+    | [] | _ :: _ :: _ -> ()
-      List.map
+    | [pkg] ->
-        (Findlib.all_packages ctx.findlib)
+      let ctx = SC.context sctx in
-        ~f:(fun pkg ->
+      match Findlib.find ctx.findlib pkg ~required_by:[] with
+      | None -> ()
+      | Some pkg ->
+        let pkg =
           (* Special case for the stdlib because it is not referenced in the META *)
-          let pkg =
+          match pkg.Findlib.name with
-            if pkg.Findlib.name = "stdlib"
+          | "stdlib" -> Findlib.stdlib_with_archives ctx.findlib
-            then Findlib.stdlib_with_archives ctx.findlib
+          | _ -> pkg
-            else pkg
+        in
-          in
+        let archives = Mode.Dict.get pkg.Findlib.archives Mode.Byte in
-          let archives = Mode.Dict.get pkg.Findlib.archives Mode.Byte in
+        List.iter archives ~f:(fun fn ->
-          pkg.Findlib.name, pkg.dir, archives)
-    in
-    List.concat_map all_pkg
-      ~f:(fun (pkg_name,pkg_dir,archives) ->
-        List.map archives ~f:(fun fn ->
           let name = Path.basename fn in
-          let src = Path.relative pkg_dir name in
+          let src = Path.relative pkg.dir name in
-          let target = in_build_dir ~ctx [ pkg_name; sprintf "%s.js" name] in
+          let target = in_build_dir ~ctx [ pkg.name; sprintf "%s.js" name] in
-          let dir = in_build_dir ~ctx [ pkg_name ] in
+          let dir = in_build_dir ~ctx [ pkg.name ] in
           let spec = Arg_spec.Dep src in
-          Build.return (standard ())
+          SC.add_rule sctx
-          >>>
+            (Build.return (standard ())
-          js_of_ocaml_rule ~sctx ~dir ~flags:(fun flags -> As flags) ~spec ~target
+             >>>
-        ))
+             js_of_ocaml_rule ~sctx ~dir ~flags:(fun flags -> As flags) ~spec ~target)
-  else []
+        )
 
 let build_exe sctx ~dir ~js_of_ocaml ~src =
   let {Jbuild.Js_of_ocaml.javascript_files; _} = js_of_ocaml in

src/js_of_ocaml_rules.mli

@@ -19,6 +19,7 @@ val build_exe
 
 val setup_separate_compilation_rules
   :  Super_context.t
-  -> (unit, Action.t) Build.t list
+  -> string list
+  -> unit
 
 val standard : unit -> string list

src/main.ml

@@ -15,7 +15,7 @@ let package_install_file { packages; _ } pkg =
   | Some p ->
     Ok (Path.relative p.path (Utils.install_file ~package:p.name ~findlib_toolchain:None))
 
-let setup ?(log=Log.no_log) ?unlink_aliases
+let setup ?(log=Log.no_log)
       ?filter_out_optional_stanzas_with_missing_deps
       ?workspace ?(workspace_file="jbuild-workspace")
       ?(use_findlib=true)
@@ -55,14 +55,15 @@ let setup ?(log=Log.no_log) ?unlink_aliases
   let contexts = List.concat contexts in
   List.iter contexts ~f:(fun (ctx : Context.t) ->
     Log.infof log "@[<1>Jbuilder context:@,%a@]@." Sexp.pp (Context.sexp_of_t ctx));
+  let build_system =
+    Build_system.create ~contexts ~file_tree:conf.file_tree
+  in
   Gen_rules.gen conf
+    ~build_system
     ~contexts
-    ?unlink_aliases
     ?only_packages
     ?filter_out_optional_stanzas_with_missing_deps
-  >>= fun (rules, stanzas) ->
+  >>= fun stanzas ->
-  let build_system = Build_system.create ~contexts
-                       ~file_tree:conf.file_tree ~rules in
   return { build_system
          ; stanzas
          ; contexts
@@ -211,7 +212,6 @@ let ignored_during_bootstrap =
 (* Called by the script generated by ../build.ml *)
 let bootstrap () =
   Ansi_color.setup_err_formatter_colors ();
-  let pkg = "jbuilder" in
   let main () =
     let anon s = raise (Arg.Bad (Printf.sprintf "don't know what to do with %s\n" s)) in
     let subst () =
@@ -228,13 +228,14 @@ let bootstrap () =
     Clflags.debug_dep_path := true;
     let log = Log.create () in
     Future.Scheduler.go ~log
-      (setup ~log ~workspace:{ merlin_context = Some "default"; contexts = [Default [Native]] }
+      (setup ~log ~workspace:{ merlin_context = Some "default"
+                             ; contexts = [Default [Native]] }
          ~use_findlib:false
          ~extra_ignored_subtrees:ignored_during_bootstrap
          ()
        >>= fun { build_system = bs; _ } ->
        Build_system.do_build_exn bs
-         ~request:(Build.path (Path.(relative root) (pkg ^ ".install"))))
+         ~request:(Build.path (Path.of_string "_build/default/jbuilder.install")))
   in
   try
     main ()

src/main.mli

@@ -17,7 +17,6 @@ val package_install_file : setup -> string -> (Path.t, unit) result
     it. *)
 val setup
   :  ?log:Log.t
-  -> ?unlink_aliases:string list
   -> ?filter_out_optional_stanzas_with_missing_deps:bool
   -> ?workspace:Workspace.t
   -> ?workspace_file:string

src/merlin.ml

@@ -12,10 +12,10 @@ type t =
   ; source_dirs: Path.Set.t
   }
 
-let ppx_flags sctx ~dir ~src_dir:_ { preprocess; libname; _ } =
+let ppx_flags sctx ~dir:_ ~src_dir:_ { preprocess; libname; _ } =
   match preprocess with
   | Pps { pps; flags } ->
-    let exe = SC.PP.get_ppx_driver sctx pps ~dir ~dep_kind:Optional in
+    let exe = SC.PP.get_ppx_driver sctx pps in
     let command =
       List.map (Path.to_absolute_filename  exe
                 :: "--as-ppx"
@@ -28,14 +28,10 @@ let ppx_flags sctx ~dir ~src_dir:_ { preprocess; libname; _ } =
   | _ -> []
 
 let dot_merlin sctx ~dir ({ requires; flags; _ } as t) =
-  match Path.extract_build_context dir with
+  match Path.drop_build_context dir with
-  | Some (_, remaindir) ->
+  | Some remaindir ->
-    let path = Path.relative remaindir ".merlin" in
+    let merlin_file = Path.relative dir ".merlin" in
-    SC.add_rule sctx
+    SC.add_rule sctx ~mode:Promote_but_delete_on_clean (
-      (Build.path path
-       >>>
-       Build.write_file (Path.relative dir ".merlin-exists") "");
-    SC.add_rule sctx (
       requires &&& flags
       >>^ (fun (libs, flags) ->
         let ppx_flags = ppx_flags sctx ~dir ~src_dir:remaindir t in
@@ -82,7 +78,7 @@ let dot_merlin sctx ~dir ({ requires; flags; _ } as t) =
         |> List.map ~f:(Printf.sprintf "%s\n")
         |> String.concat ~sep:"")
       >>>
-      Build.write_file_dyn path
+      Build.write_file_dyn merlin_file
     )
   | _ ->
     ()

src/odoc.ml

@@ -155,7 +155,7 @@ let setup_library_rules sctx (lib : Library.t) ~dir ~modules ~requires
      ~f:(fun (m, _) -> m.Module.name = main_module_name)
      else
      modules_and_odoc_files
-     in*)
+       in*)
   let html_files =
     List.map modules_and_odoc_files ~f:(fun (m, odoc_file) ->
       to_html sctx m odoc_file ~doc_dir ~odoc ~dir ~includes ~lib
@@ -165,7 +165,7 @@ let setup_library_rules sctx (lib : Library.t) ~dir ~modules ~requires
     lib_index sctx ~dir ~lib ~lib_unique_name ~lib_name ~doc_dir
       ~modules ~includes ~odoc
   in
-  Alias.add_deps (SC.aliases sctx) (Alias.doc ~dir)
+  SC.add_alias_deps sctx (Build_system.Alias.doc ~dir)
     (css_file ~doc_dir
      :: toplevel_index ~doc_dir
      :: lib_index_html
@@ -227,3 +227,13 @@ let setup_toplevel_index_rule sctx =
   let context = SC.context sctx in
   let doc_dir = doc_dir ~context in
   SC.add_rule sctx @@ Build.write_file (toplevel_index ~doc_dir) html
+
+let gen_rules sctx ~dir rest =
+  match rest with
+  | [] ->
+    setup_css_rule sctx;
+    setup_toplevel_index_rule sctx
+  | lib :: _ ->
+    match Lib_db.find (SC.libs sctx) ~from:dir lib with
+    | None | Some (External _) -> ()
+    | Some (Internal (dir, _)) -> SC.load_dir sctx ~dir

src/odoc.mli

@@ -12,6 +12,4 @@ val setup_library_rules
   -> dep_graph:Ocamldep.dep_graph
   -> unit
 
-val setup_css_rule : Super_context.t -> unit
+val gen_rules : Super_context.t -> dir:Path.t -> string list -> unit
-
-val setup_toplevel_index_rule: Super_context.t -> unit

src/path.ml

@@ -223,7 +223,9 @@ let compare = String.compare
 module Set = struct
   include String_set
   let sexp_of_t t = Sexp.To_sexp.(list string) (String_set.elements t)
+  let of_string_set = map
 end
+
 module Map = String_map
 
 module Kind = struct
@@ -346,9 +348,16 @@ let parent t =
 
 let build_prefix = "_build/"
 
+let build_dir = "_build"
+
 let is_in_build_dir t =
   String.is_prefix t ~prefix:build_prefix
 
+let is_in_source_tree t = is_local t && not (is_in_build_dir t)
+
+let is_alias_stamp_file t =
+  String.is_prefix t ~prefix:"_build/.aliases/"
+
 let extract_build_context t =
   if String.is_prefix t ~prefix:build_prefix then
     let i = String.length build_prefix in
@@ -380,11 +389,39 @@ let extract_build_context_dir t =
 let drop_build_context t =
   Option.map (extract_build_context t) ~f:snd
 
+let drop_build_context_exn t =
+  match extract_build_context t with
+  | None -> Sexp.code_error "Path.drop_build_context_exn" [ "t", sexp_of_t t ]
+  | Some (_, t) -> t
+
 let drop_optional_build_context t =
   match extract_build_context t with
   | None -> t
   | Some (_, t) -> t
 
+let split_first_component t =
+  if is_local t && not (is_root t)then
+    match String.index t '/' with
+    | None -> Some (t, root)
+    | Some i ->
+      Some
+        (String.sub t ~pos:0 ~len:i,
+         String.sub t ~pos:(i + 1) ~len:(String.length t - i - 1))
+  else
+    None
+
+let explode t =
+  if is_local t then
+    Some (String.split t ~on:'/')
+  else
+    None
+
+let explode_exn t =
+  if is_local t then
+    String.split t ~on:'/'
+  else
+    Sexp.code_error "Path.explode_exn" ["path", Atom t]
+
 let exists t = Sys.file_exists (to_string t)
 let readdir t = Sys.readdir (to_string t) |> Array.to_list
 let is_directory t =
@@ -405,13 +442,10 @@ let insert_after_build_dir_exn =
       ]
   in
   fun a b ->
-    if not (is_local a && is_local b) then error a b;
+    if not (is_local a) || String.contains b '/' then error a b;
     match String.lsplit2 a ~on:'/' with
     | Some ("_build", rest) ->
-      if is_root b then
+      sprintf "_build/%s/%s" b rest
-        a
-      else
-        sprintf "_build/%s/%s" b rest
     | _ ->
       error a b
 

src/path.mli

@@ -42,9 +42,12 @@ val compare : t -> t -> int
 module Set : sig
   include Set.S with type elt = t
   val sexp_of_t : t Sexp.To_sexp.t
+  val of_string_set : f:(string -> elt) -> String_set.t -> t
 end
+
 module Map : Map.S with type key = t
 
+
 val kind : t -> Kind.t
 
 val of_string : ?error_loc:Loc.t -> string -> t
@@ -99,13 +102,29 @@ val extract_build_context_dir : t -> (t * t) option
 
 (** Drop the "_build/blah" prefix *)
 val drop_build_context : t -> t option
+val drop_build_context_exn : t -> t
 
 (** Drop the "_build/blah" prefix if present, return [t] otherwise *)
 val drop_optional_build_context : t -> t
 
+val explode : t -> string list option
+val explode_exn : t -> string list
+
+(** The build directory *)
+val build_dir : t
+
+(** [is_in_build_dir t = is_descendant t ~of:build_dir] *)
 val is_in_build_dir : t -> bool
 
-val insert_after_build_dir_exn : t -> t -> t
+(** [is_in_build_dir t = is_local t && not (is_in_build_dir t)] *)
+val is_in_source_tree : t -> bool
+
+val is_alias_stamp_file : t -> bool
+
+(**  Split after the first component if [t] is local *)
+val split_first_component : t -> (string * t) option
+
+val insert_after_build_dir_exn : t -> string -> t
 
 val exists : t -> bool
 val readdir : t -> string list

src/super_context.ml

@@ -3,6 +3,7 @@ open Jbuild
 
 module A = Action
 module Pset = Path.Set
+module Alias = Build_system.Alias
 
 module Dir_with_jbuild = struct
   type t =
@@ -13,72 +14,36 @@ module Dir_with_jbuild = struct
     }
 end
 
-module External_dir = struct
-  (* Files in the directory, grouped by extension *)
-  type t = Path.t list String_map.t
-
-  let create ~dir : t =
-    match Path.readdir dir with
-    | exception _ -> String_map.empty
-    | files ->
-      List.map files ~f:(fun fn -> Filename.extension fn, Path.relative dir fn)
-      |> String_map.of_alist_multi
-  (* CR-someday jdimino: when we can have dynamic targets:
-
-     {[
-       |> String_map.mapi ~f:(fun ext files ->
-         lazy (
-           let alias =
-             Alias.make ~dir:Path.root (sprintf "external-files-%s%s" hash ext)
-           in
-           Alias.add_deps aliases alias files;
-           alias
-         ))
-     ]}
-  *)
-
-  let files t ~ext = String_map.find_default ext t ~default:[]
-end
-
 type t =
-  { context                                 : Context.t
+  { context                          : Context.t
-  ; libs                                    : Lib_db.t
+  ; build_system                     : Build_system.t
-  ; stanzas                                 : Dir_with_jbuild.t list
+  ; libs                             : Lib_db.t
-  ; packages                                : Package.t String_map.t
+  ; stanzas                          : Dir_with_jbuild.t list
-  ; aliases                                 : Alias.Store.t
+  ; packages                         : Package.t String_map.t
-  ; file_tree                               : File_tree.t
+  ; file_tree                        : File_tree.t
-  ; artifacts                               : Artifacts.t
+  ; artifacts                        : Artifacts.t
-  ; mutable rules                           : Build_interpret.Rule.t list
+  ; stanzas_to_consider_for_install  : (Path.t * Stanza.t) list
-  ; stanzas_to_consider_for_install         : (Path.t * Stanza.t) list
+  ; libs_vfile                       : (module Vfile_kind.S with type t = Lib.t list)
-  ; mutable known_targets_by_src_dir_so_far : String_set.t Path.Map.t
+  ; cxx_flags                        : string list
-  ; libs_vfile                              : (module Vfile_kind.S with type t = Lib.t list)
+  ; vars                             : Action.Var_expansion.t String_map.t
-  ; cxx_flags                               : string list
+  ; ppx_dir                          : Path.t
-  ; vars                                    : Action.Var_expansion.t String_map.t
+  ; chdir                            : (Action.t, Action.t) Build.t
-  ; ppx_dir                                 : Path.t
+  ; host                             : t option
-  ; ppx_drivers                             : (string, Path.t) Hashtbl.t
-  ; external_dirs                           : (Path.t, External_dir.t) Hashtbl.t
-  ; chdir                                   : (Action.t, Action.t) Build.t
-  ; host                                    : t option
   }
 
 let context t = t.context
-let aliases t = t.aliases
 let stanzas t = t.stanzas
 let packages t = t.packages
 let artifacts t = t.artifacts
 let file_tree t = t.file_tree
-let rules t = t.rules
 let stanzas_to_consider_for_install t = t.stanzas_to_consider_for_install
 let cxx_flags t = t.cxx_flags
+let libs t = t.libs
 
 let host_sctx t = Option.value t.host ~default:t
 
 let expand_var_no_root t var = String_map.find var t.vars
 
-let get_external_dir t ~dir =
-  Hashtbl.find_or_add t.external_dirs dir ~f:(fun dir ->
-    External_dir.create ~dir)
-
 let expand_vars t ~scope ~dir s =
   String_with_vars.expand s ~f:(fun _loc -> function
   | "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir)
@@ -98,12 +63,12 @@ let resolve_program t ?hint bin =
 let create
       ~(context:Context.t)
       ?host
-      ~aliases
       ~scopes
       ~file_tree
       ~packages
       ~stanzas
       ~filter_out_optional_stanzas_with_missing_deps
+      ~build_system
   =
   let stanzas =
     List.map stanzas
@@ -203,61 +168,55 @@ let create
   in
   { context
   ; host
+  ; build_system
   ; libs
   ; stanzas
   ; packages
-  ; aliases
   ; file_tree
-  ; rules = []
   ; stanzas_to_consider_for_install
-  ; known_targets_by_src_dir_so_far = Path.Map.empty
   ; libs_vfile = (module Libs_vfile)
   ; artifacts
   ; cxx_flags
   ; vars
-  ; ppx_drivers = Hashtbl.create 32
   ; ppx_dir = Path.relative context.build_dir ".ppx"
-  ; external_dirs = Hashtbl.create 1024
   ; chdir = Build.arr (fun (action : Action.t) ->
       match action with
       | Chdir _ -> action
       | _ -> Chdir (context.build_dir, action))
   }
 
-let add_rule t ?sandbox ?fallback ?locks ?loc build =
+let add_rule t ?sandbox ?mode ?locks ?loc build =
+  let build = Build.O.(>>>) build t.chdir in
+  Build_system.add_rule t.build_system
+    (Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc
+       ~context:t.context build)
+
+let add_rule_get_targets t ?sandbox ?mode ?locks ?loc build =
   let build = Build.O.(>>>) build t.chdir in
   let rule =
-    Build_interpret.Rule.make ?sandbox ?fallback ?locks ?loc
+    Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc
       ~context:t.context build
   in
-  t.rules <- rule :: t.rules;
+  Build_system.add_rule t.build_system rule;
-  t.known_targets_by_src_dir_so_far <-
+  List.map rule.targets ~f:Build_interpret.Target.path
-    List.fold_left rule.targets ~init:t.known_targets_by_src_dir_so_far
-      ~f:(fun acc target ->
-        match Path.extract_build_context (Build_interpret.Target.path target) with
-        | None -> acc
-        | Some (_, path) ->
-          let dir = Path.parent path in
-          let fn = Path.basename path in
-          let files =
-            match Path.Map.find dir acc with
-            | None -> String_set.singleton fn
-            | Some set -> String_set.add fn set
-          in
-          Path.Map.add acc ~key:dir ~data:files)
 
 let add_rules t ?sandbox builds =
   List.iter builds ~f:(add_rule t ?sandbox)
 
-let sources_and_targets_known_so_far t ~src_path =
+let add_alias_deps t alias deps =
-  let sources =
+  Alias.add_deps t.build_system alias deps
-    match File_tree.find_dir t.file_tree src_path with
+
-    | None -> String_set.empty
+let add_alias_action t alias ?locks ~stamp action =
-    | Some dir -> File_tree.Dir.files dir
+  Alias.add_action t.build_system alias ?locks ~stamp action
-  in
+
-  match Path.Map.find src_path t.known_targets_by_src_dir_so_far with
+let eval_glob t ~dir re = Build_system.eval_glob t.build_system ~dir re
-  | None -> sources
+let load_dir t ~dir = Build_system.load_dir t.build_system ~dir
-  | Some set -> String_set.union sources set
+let on_load_dir t ~dir ~f = Build_system.on_load_dir t.build_system ~dir ~f
+
+let source_files t ~src_path =
+  match File_tree.find_dir t.file_tree src_path with
+  | None -> String_set.empty
+  | Some dir -> File_tree.Dir.files dir
 
 let unique_library_name t lib =
   Lib_db.unique_library_name t.libs lib
@@ -363,14 +322,7 @@ module Libs = struct
     in
     let requires =
       if t.context.merlin && has_dot_merlin then
-        (* We don't depend on the dot_merlin directly, otherwise everytime it changes we
+        Build.path (Path.relative dir ".merlin")
-           would have to rebuild everything.
-
-           .merlin-exists depends on the .merlin and is an empty file. Depending on it
-           forces the generation of the .merlin but not recompilation when it
-           changes. Maybe one day we should add [Build.path_exists] to do the same in
-           general. *)
-        Build.path (Path.relative dir ".merlin-exists")
         >>>
         real_requires
       else
@@ -394,24 +346,21 @@ module Libs = struct
     Alias.make (sprintf "lib-%s%s-all" lib.name ext) ~dir
 
   let setup_file_deps_alias t lib ~ext files =
-    Alias.add_deps t.aliases (lib_files_alias lib ~ext) files
+    add_alias_deps t (lib_files_alias lib ~ext) files
 
   let setup_file_deps_group_alias t lib ~exts =
     setup_file_deps_alias t lib
       ~ext:(String.concat exts ~sep:"-and-")
-      (List.map exts ~f:(fun ext -> Alias.file (lib_files_alias lib ~ext)))
+      (List.map exts ~f:(fun ext -> Alias.stamp_file (lib_files_alias lib ~ext)))
 
   let file_deps t ~ext =
     Build.dyn_paths (Build.arr (fun libs ->
       List.fold_left libs ~init:[] ~f:(fun acc (lib : Lib.t) ->
         match lib with
-        | External pkg -> begin
+        | External pkg ->
-            List.rev_append
+          Build_system.stamp_file_for_files_of t.build_system ~dir:pkg.dir ~ext :: acc
-              (External_dir.files (get_external_dir t ~dir:pkg.dir) ~ext)
-              acc
-          end
         | Internal lib ->
-          Alias.file (lib_files_alias lib ~ext) :: acc)))
+          Alias.stamp_file (lib_files_alias lib ~ext) :: acc)))
 
   let static_file_deps ~ext lib =
     Alias.dep (lib_files_alias lib ~ext)
@@ -852,12 +801,31 @@ module PP = struct
          ; Dyn (Lib.link_flags ~mode)
          ])
 
-  let get_ppx_driver sctx pps ~dir ~dep_kind =
+  let gen_rules sctx components =
-    let driver, names =
+    match components with
+    | [key] ->
+      let ppx_dir = Path.relative sctx.ppx_dir key in
+      let exe = Path.relative ppx_dir "ppx.exe" in
+      let names =
+        match key with
+        | "+none+" -> []
+        | _ -> String.split key ~on:'+'
+      in
+      let driver, names =
+        match List.rev names with
+        | [] -> (None, [])
+        | driver :: rest ->
+          (Some driver, List.sort rest ~cmp:String.compare @ [driver])
+      in
+      build_ppx_driver sctx names ~dir:ppx_dir ~dep_kind:Required ~target:exe ~driver
+    | _ -> ()
+
+  let get_ppx_driver sctx pps =
+    let names =
       match List.rev_map pps ~f:Pp.to_string with
-      | [] -> (None, [])
+      | [] -> []
       | driver :: rest ->
-        (Some driver, List.sort rest ~cmp:String.compare @ [driver])
+        List.sort rest ~cmp:String.compare @ [driver]
     in
     let key =
       match names with
@@ -865,14 +833,8 @@ module PP = struct
       | _  -> String.concat names ~sep:"+"
     in
     let sctx = host_sctx sctx in
-    match Hashtbl.find sctx.ppx_drivers key with
+    let ppx_dir = Path.relative sctx.ppx_dir key in
-    | Some x -> x
+    Path.relative ppx_dir "ppx.exe"
-    | None ->
-      let ppx_dir = Path.relative sctx.ppx_dir key in
-      let exe = Path.relative ppx_dir "ppx.exe" in
-      build_ppx_driver sctx names ~dir ~dep_kind ~target:exe ~driver;
-      Hashtbl.add sctx.ppx_drivers ~key ~data:exe;
-      exe
 
   let target_var = String_with_vars.virt_var __POS__ "@"
   let root_var   = String_with_vars.virt_var __POS__ "ROOT"
@@ -933,12 +895,11 @@ module PP = struct
         ~dep_kind ~lint ~lib_name ~scope =
     let alias = Alias.lint ~dir in
     let add_alias fn build =
-      add_rule sctx
+      Alias.add_action sctx.build_system alias build
-        (Alias.add_build (aliases sctx) alias build
+        ~stamp:(List [ Atom "lint"
-           ~stamp:(List [ Atom "lint"
+                     ; Sexp.To_sexp.(option string) lib_name
-                        ; Sexp.To_sexp.(option string) lib_name
+                     ; Atom fn
-                        ; Atom fn
+                     ])
-                        ]))
     in
     match Preprocess_map.find source.name lint with
     | No_preprocessing -> ()
@@ -957,7 +918,7 @@ module PP = struct
                  ~scope)
       )
     | Pps { pps; flags } ->
-      let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in
+      let ppx_exe = get_ppx_driver sctx pps in
       Module.iter ast ~f:(fun kind src ->
         let src_path = Path.relative dir src.name in
         let args =
@@ -1020,7 +981,7 @@ module PP = struct
         lint_module ~ast ~source:m;
         ast
       | Pps { pps; flags } ->
-        let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in
+        let ppx_exe = get_ppx_driver sctx pps in
         let ast = setup_reason_rules sctx ~dir m in
         lint_module ~ast ~source:m;
         let uses_ppx_driver = uses_ppx_driver ~pps in

src/super_context.mli

@@ -23,41 +23,65 @@ type t
 val create
   :  context:Context.t
   -> ?host:t
-  -> aliases:Alias.Store.t
   -> scopes:Scope.t list
   -> file_tree:File_tree.t
   -> packages:Package.t String_map.t
   -> stanzas:(Path.t * Scope.t * Stanzas.t) list
   -> filter_out_optional_stanzas_with_missing_deps:bool
+  -> build_system:Build_system.t
   -> t
 
 val context   : t -> Context.t
-val aliases   : t -> Alias.Store.t
 val stanzas   : t -> Dir_with_jbuild.t list
 val packages  : t -> Package.t String_map.t
 val file_tree : t -> File_tree.t
 val artifacts : t -> Artifacts.t
 val stanzas_to_consider_for_install : t -> (Path.t * Stanza.t) list
 val cxx_flags : t -> string list
+val libs      : t -> Lib_db.t
 
 val expand_vars : t -> scope:Scope.t -> dir:Path.t -> String_with_vars.t -> string
 
 val add_rule
   :  t
   -> ?sandbox:bool
-  -> ?fallback:Jbuild.Rule.Fallback.t
+  -> ?mode:Jbuild.Rule.Mode.t
   -> ?locks:Path.t list
   -> ?loc:Loc.t
   -> (unit, Action.t) Build.t
   -> unit
+val add_rule_get_targets
+  :  t
+  -> ?sandbox:bool
+  -> ?mode:Jbuild.Rule.Mode.t
+  -> ?locks:Path.t list
+  -> ?loc:Loc.t
+  -> (unit, Action.t) Build.t
+  -> Path.t list
 val add_rules
   :  t
   -> ?sandbox:bool
   -> (unit, Action.t) Build.t list
   -> unit
-val rules : t -> Build_interpret.Rule.t list
+val add_alias_deps
+  :  t
+  -> Build_system.Alias.t
+  -> Path.t list
+  -> unit
+val add_alias_action
+  :  t
+  -> Build_system.Alias.t
+  -> ?locks:Path.t list
+  -> stamp:Sexp.t
+  -> (unit, Action.t) Build.t
+  -> unit
 
-val sources_and_targets_known_so_far : t -> src_path:Path.t -> String_set.t
+(** See [Build_system for details] *)
+val eval_glob : t -> dir:Path.t -> Re.re -> string list
+val load_dir : t -> dir:Path.t -> unit
+val on_load_dir : t -> dir:Path.t -> f:(unit -> unit) -> unit
+
+val source_files : t -> src_path:Path.t -> String_set.t
 
 (** [prog_spec t ?hint name] resolve a program. [name] is looked up in the
     workspace, if it is not found in the tree is is looked up in the PATH. If it
@@ -174,16 +198,13 @@ module PP : sig
     -> Module.t String_map.t
 
   (** Get a path to a cached ppx driver *)
-  val get_ppx_driver
+  val get_ppx_driver : t -> Pp.t list -> Path.t
-    :  t
-    -> Pp.t list
-    -> dir:Path.t
-    -> dep_kind:Build.lib_dep_kind
-    -> Path.t
 
   (** [cookie_library_name lib_name] is ["--cookie"; lib_name] if [lib_name] is not
       [None] *)
   val cookie_library_name : string option -> string list
+
+  val gen_rules : t -> string list -> unit
 end
 
 val expand_and_eval_set

src/utils.ml

@@ -73,19 +73,44 @@ let jbuild_name_in ~dir =
       (Path.to_string_maybe_quoted (Path.relative dir "jbuild"))
       ctx_name
 
-let describe_target fn =
+type target_kind =
+  | Regular of string * Path.t
+  | Alias   of string * Path.t
+  | Other of Path.t
+
+let analyse_target fn =
   match Path.extract_build_context fn with
-  | Some (".aliases", fn) ->
+  | Some (".aliases", sub) -> begin
-    let name =
+      match Path.split_first_component sub with
-      let fn = Path.to_string fn in
+      | None -> Other fn
-      match String.rsplit2 fn ~on:'-' with
+      | Some (ctx, fn) ->
-      | None -> assert false
+        if Path.is_root fn then
-      | Some (name, digest) ->
+          Other fn
-        assert (String.length digest = 32);
+        else
-        name
+          let basename =
-    in
+            match String.rsplit2 (Path.basename fn) ~on:'-' with
-    sprintf "alias %s" (maybe_quoted name)
+            | None -> assert false
-  | _ ->
+            | Some (name, digest) ->
+              assert (String.length digest = 32);
+              name
+          in
+          Alias (ctx, Path.relative (Path.parent fn) basename)
+    end
+  | Some (ctx, sub) -> Regular (ctx, sub)
+  | None ->
+    Other fn
+
+let describe_target fn =
+  let ctx_suffix = function
+    | "default" -> ""
+    | ctx -> sprintf " (context %s)" ctx
+  in
+  match analyse_target fn with
+  | Alias (ctx, p) ->
+    sprintf "alias %s%s" (Path.to_string_maybe_quoted p) (ctx_suffix ctx)
+  | Regular (ctx, fn) ->
+    sprintf "%s%s" (Path.to_string_maybe_quoted fn) (ctx_suffix ctx)
+  | Other fn ->
     Path.to_string_maybe_quoted fn
 
 let program_not_found ?context ?hint prog =

src/utils.mli

@@ -18,6 +18,14 @@ val jbuild_name_in : dir:Path.t -> string
 (** Nice description of a target *)
 val describe_target : Path.t -> string
 
+type target_kind =
+  | Regular of string (* build context *) * Path.t
+  | Alias   of string (* build context *) * Path.t
+  | Other of Path.t
+
+(** Return the name of an alias from its stamp file *)
+val analyse_target : Path.t -> target_kind
+
 (** Raise an error about a program not found in the PATH or in the tree *)
 val program_not_found
   :  ?context:string

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

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

test/blackbox-tests/test-cases/meta-gen/jbuild

@@ -23,5 +23,4 @@
 
 (alias
  ((name runtest)
-  (deps (META.foobar))
+  (action (echo "${read:META.foobar}"))))
-  (action (echo "${read:META.foobar}"))))