Add Build.catch

src/build.ml

@@ -37,6 +37,7 @@ module Repr = struct
     | Record_lib_deps : lib_deps -> ('a, 'a) t
     | Fail : fail -> (_, _) t
     | Memo : 'a memo -> (unit, 'a) t
+    | Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t
 
   and 'a memo =
     { name          : string
@@ -135,6 +136,8 @@ let paths_glob ~loc ~dir re = Paths_glob (ref (G_unevaluated (loc, dir, re)))
 let vpath vp = Vpath vp
 let dyn_paths t = Dyn_paths t
 
+let catch t ~on_error = Catch (t, on_error)
+
 let contents p = Contents p
 let lines_of p = Lines_of p
 

src/build.mli

@@ -43,6 +43,10 @@ val vpath : 'a Vspec.t  -> (unit, 'a) t
 
 val dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
 
+(** [catch t ~on_error] evaluates to [on_error exn] if exception [exn] is
+    raised during the evaluation of [t]. *)
+val catch : ('a, 'b) t -> on_error:(exn -> 'b) -> ('a, 'b) t
+
 (** [contents path] returns an arrow that when run will return the contents of
     the file at [path]. *)
 val contents : Path.t -> ('a, string) t
@@ -157,6 +161,7 @@ module Repr : sig
     | Record_lib_deps : lib_deps -> ('a, 'a) t
     | Fail : fail -> (_, _) t
     | Memo : 'a memo -> (unit, 'a) t
+    | Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t
 
   and 'a memo =
     { name          : string

src/build_interpret.ml

@@ -112,6 +112,7 @@ let static_deps t ~all_targets ~file_tree =
     | Record_lib_deps _ -> acc
     | Fail _ -> acc
     | Memo m -> loop m.t acc
+    | Catch (t, _) -> loop t acc
   in
   loop (Build.repr t) { rule_deps = Pset.empty; action_deps = Pset.empty }
 
@@ -138,6 +139,7 @@ let lib_deps =
       | If_file_exists (_, state) ->
         loop (get_if_file_exists_exn state) acc
       | Memo m -> loop m.t acc
+      | Catch (t, _) -> loop t acc
   in
   fun t -> loop (Build.repr t) String_map.empty
 
@@ -172,6 +174,7 @@ let targets =
                          under a [if_file_exists]"
       end
     | Memo m -> loop m.t acc
+    | Catch (t, _) -> loop t acc
   in
   fun t -> loop (Build.repr t) []
 

src/build_system.ml

@@ -454,6 +454,12 @@ module Build_exec = struct
       | Fail { fail } -> fail ()
       | If_file_exists (_, state) ->
         exec dyn_deps (get_if_file_exists_exn state) x
+      | Catch (t, on_error) -> begin
+          try
+            exec dyn_deps t x
+          with exn ->
+            on_error exn
+        end
       | Memo m ->
         match m.state with
         | Evaluated (x, deps) ->