Build_system.prefix_rules (#479)

* Build_system.prefix_rules

Add a way to implicitly add a build prefix to all rules added by the given
function

* Make sure that on_load_dir callbacks handle the prefix right

* Make sure that prefix_rules prefixes don't contain targets

* Move prefix validation to user facing function

* document prefix_rules

src/build_system.ml

@@ -287,6 +287,7 @@ type t =
        all their ancestors. *)
     mutable build_dirs_to_keep : Path.Set.t
   ; files_of : (Path.t, Files_of.t) Hashtbl.t
+  ; mutable prefix : (unit, unit) Build.t option
   }
 
 let string_of_paths set =
@@ -1107,6 +1108,7 @@ let create ~contexts ~file_tree =
     ; gen_rules = String_map.map contexts ~f:(fun _ ~dir:_ -> die "gen_rules called too early")
     ; build_dirs_to_keep = Pset.empty
     ; files_of = Hashtbl.create 1024
+    ; prefix = None
     }
   in
   at_exit (fun () -> finalize t);
@@ -1355,11 +1357,31 @@ let get_collector t ~dir =
       ]
 
 let add_rule t (rule : Build_interpret.Rule.t) =
+  let rule =
+    match t.prefix with
+    | None -> rule
+    | Some prefix -> { rule with build = Build.O.(>>>) prefix rule.build } in
   let collector = get_collector t ~dir:rule.dir in
   collector.rules <- rule :: collector.rules
 
+let prefix_rules' t prefix ~f =
+  let old_prefix = t.prefix in
+  t.prefix <- prefix;
+  protectx () ~f ~finally:(fun () -> t.prefix <- old_prefix)
+
+let prefix_rules t prefix ~f =
+  begin match Build_interpret.targets prefix with
+  | [] -> ()
+  | targets ->
+    Sexp.code_error "Build_system.prefix_rules' prefix contains targets"
+      ["targets", Path.Set.sexp_of_t (Build_interpret.Target.paths targets)]
+  end;
+  prefix_rules' t (Some prefix) ~f
+
 let on_load_dir t ~dir ~f =
   let collector = get_collector t ~dir in
+  let current_prefix = t.prefix in
+  let f () = prefix_rules' t current_prefix ~f in
   match collector.stage with
   | Loading -> f ()
   | Pending p ->

src/build_system.mli

@@ -47,6 +47,10 @@ val set_rule_generators : t -> (dir:Path.t -> string list -> extra_sub_directori
 *)
 val add_rule : t -> Build_interpret.Rule.t -> unit
 
+(** [prefix_rules t prefix ~f] Runs [f] and adds [prefix] as a dependency to all
+    the rules generated by [f] *)
+val prefix_rules : t -> (unit, unit) Build.t -> f:(unit -> 'a) -> 'a
+
 (** [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