From 39ac04a535ca0bce0ce6ae735d1356e5fdd41999 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jeremie@dimino.org>
Date: Thu, 1 Mar 2018 23:16:22 +0000
Subject: [PATCH] Add Build.catch

---
 src/build.ml           | 3 +++
 src/build.mli          | 5 +++++
 src/build_interpret.ml | 3 +++
 src/build_system.ml    | 6 ++++++
 4 files changed, 17 insertions(+)

diff --git a/src/build.ml b/src/build.ml
index 7006fedd..4902aba9 100644
--- a/src/build.ml
+++ b/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
 
diff --git a/src/build.mli b/src/build.mli
index 4e1bc60e..9a297f19 100644
--- a/src/build.mli
+++ b/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
diff --git a/src/build_interpret.ml b/src/build_interpret.ml
index 6a715368..42c4a902 100644
--- a/src/build_interpret.ml
+++ b/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) []
 
diff --git a/src/build_system.ml b/src/build_system.ml
index 05c6e86b..f10d0660 100644
--- a/src/build_system.ml
+++ b/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) ->