Add Build.if_file_exists

src/action.ml

@@ -342,11 +342,7 @@ module Mini_shexp = struct
     | Copy_and_add_line_directive (src, dst) ->
       with_file_in (Path.to_string src) ~f:(fun ic ->
         with_file_out (Path.to_string dst) ~f:(fun oc ->
-          let fn =
-            match Path.extract_build_context src with
-            | None -> src
-            | Some (_, rem) -> rem
-          in
+          let fn = Path.drop_build_context src in
           Printf.fprintf oc "# 1 %S\n" (Path.to_string fn);
           copy_channels ic oc));
       return ()

src/build.ml

@@ -34,12 +34,23 @@ module Repr = struct
     | Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
     | Paths : Pset.t -> ('a, 'a) t
     | Paths_glob : Path.t * Re.re -> ('a, 'a) t
+    (* The reference gets decided in Build_interpret.deps *)
+    | If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
     | Contents : Path.t -> ('a, string) t
     | Lines_of : Path.t -> ('a, string list) t
     | Vpath : 'a Vspec.t -> (unit, 'a) t
     | Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
     | Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
     | Fail : fail -> (_, _) t
+
+  and ('a, 'b) if_file_exists_state =
+    | Undecided of ('a, 'b) t * ('a, 'b) t
+    | Decided   of bool * ('a, 'b) t
+
+  let get_if_file_exists_exn state =
+    match !state with
+    | Decided (_, t) -> t
+    | Undecided _ -> code_errorf "Build.get_if_file_exists_exn: got undecided"
 end
 include Repr
 let repr t = t
@@ -108,6 +119,19 @@ let dyn_paths t = Dyn_paths t
 let contents p = Contents p
 let lines_of p = Lines_of p
 
+let if_file_exists p ~then_ ~else_ =
+  If_file_exists (p, ref (Undecided (then_, else_)))
+
+let file_exists p =
+  if_file_exists p
+    ~then_:(arr (fun _ -> true))
+    ~else_:(arr (fun _ -> false))
+
+let file_exists_opt p t =
+  if_file_exists p
+    ~then_:(t >>^ fun x -> Some x)
+    ~else_:(arr (fun _ -> None))
+
 let fail ?targets x =
   match targets with
   | None -> Fail x

src/build.mli

@@ -45,6 +45,22 @@ val dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
 val contents : Path.t -> ('a, string) t
 val lines_of : Path.t -> ('a, string list) t
 
+(** Evaluates to [true] if the file is present on the file system or is the target of a
+    rule. *)
+val file_exists : Path.t -> ('a, bool)  t
+
+(** [if_file_exists p ~then ~else] is an arrow that behaves like [then_] if [file_exists
+    p] evaluates to [true], and [else_] otherwise. *)
+val if_file_exists : Path.t -> then_:('a, 'b) t -> else_:('a, 'b) t -> ('a, 'b) t
+
+(** [file_exists_opt p t] is:
+
+    {[
+      if_file_exists p ~then_:(t >>^ fun x -> Some x) ~else_:(arr (fun _ -> None))
+    ]}
+*)
+val file_exists_opt : Path.t -> ('a, 'b) t -> ('a, 'b option) t
+
 (** Always fail when executed. We pass a function rather than an exception to get a proper
     backtrace *)
 val fail : ?targets:Path.t list -> fail -> (_, _) t
@@ -126,12 +142,19 @@ module Repr : sig
     | Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
     | Paths : Path.Set.t -> ('a, 'a) t
     | Paths_glob : Path.t * Re.re -> ('a, 'a) t
+    | If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
     | Contents : Path.t -> ('a, string) t
     | Lines_of : Path.t -> ('a, string list) t
     | Vpath : 'a Vspec.t -> (unit, 'a) t
     | Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
     | Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
     | Fail : fail -> (_, _) t
+
+  and ('a, 'b) if_file_exists_state =
+    | Undecided of ('a, 'b) t * ('a, 'b) t
+    | Decided   of bool * ('a, 'b) t
+
+  val get_if_file_exists_exn : ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
 end
 
 val repr : ('a, 'b) t -> ('a, 'b) Repr.t

src/build_interpret.ml

@@ -40,6 +40,23 @@ let deps t ~all_targets_by_dir =
             Re.execp re (Path.basename path))
           |> Pset.union acc
       end
+    | If_file_exists (p, state) -> begin
+        match !state with
+        | Decided (exists, t) -> loop t (if exists then Pset.add p acc else acc)
+        | Undecided (then_, else_) ->
+          let dir = Path.parent p in
+          let targets =
+            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_ (Pset.add p acc)
+          end else begin
+            state := Decided (false, else_);
+            loop else_ acc
+          end
+      end
     | Dyn_paths t -> loop t acc
     | Contents p -> Pset.add p acc
     | Lines_of p -> Pset.add p acc
@@ -74,6 +91,8 @@ let lib_deps =
         in
         Pmap.add acc ~key:dir ~data
       | Fail _ -> acc
+      | If_file_exists (_, state) ->
+        loop (get_if_file_exists_exn state) acc
   in
   fun t -> loop (Build.repr t) Pmap.empty
 
@@ -97,6 +116,16 @@ let targets =
     | Lines_of _ -> acc
     | Record_lib_deps _ -> acc
     | Fail _ -> acc
+    | If_file_exists (_, state) -> begin
+        match !state with
+        | Decided _ -> code_errorf "Build_interpret.targets got decided if_file_exists"
+        | Undecided (a, b) ->
+          match loop a [], loop b [] with
+          | [], [] -> acc
+          | _ ->
+            code_errorf "Build_interpret.targets: cannot have targets \
+                         under a [if_file_exists]"
+      end
   in
   fun t -> loop (Build.repr t) []
 

src/build_system.ml

@@ -248,6 +248,8 @@ module Build_exec = struct
         x
       | Record_lib_deps _ -> x
       | Fail { fail } -> fail ()
+      | If_file_exists (_, state) ->
+        exec (get_if_file_exists_exn state) x
     in
     let action = exec (Build.repr t) x in
     (action, !dyn_deps)

src/gen_rules.ml

@@ -639,7 +639,9 @@ module Gen(P : Params) = struct
       let meta_fn = "META." ^ pkg.name in
       let meta_templ_fn = meta_fn ^ ".template" in
 
-      let files = SC.sources_and_targets_known_so_far sctx ~src_path:pkg.path in
+      let files =
+        SC.sources_and_targets_known_so_far sctx ~src_path:pkg.path
+      in
       let has_meta, has_meta_tmpl =
         (String_set.mem meta_fn files,
          String_set.mem meta_templ_fn files)