add Build.memoize

src/build.ml

@@ -42,6 +42,18 @@ module Repr = struct
     | Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
     | Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
     | Fail : fail -> (_, _) t
+    | Memo : 'a memo -> (unit, 'a) t
+
+  and 'a memo =
+    { name          : string
+    ; t             : (unit, 'a) t
+    ; mutable state : 'a memo_state
+    }
+
+  and 'a memo_state =
+    | Unevaluated
+    | Evaluating
+    | Evaluated of 'a
 
   and ('a, 'b) if_file_exists_state =
     | Undecided of ('a, 'b) t * ('a, 'b) t
@@ -137,6 +149,9 @@ let fail ?targets x =
   | None -> Fail x
   | Some l -> Targets l >>> Fail x
 
+let memoize name t =
+  Memo { name; t; state = Unevaluated }
+
 let files_recursively_in ~dir ~file_tree =
   let prefix_with, dir =
     match Path.extract_build_context_dir dir with

src/build.mli

@@ -65,6 +65,10 @@ val file_exists_opt : Path.t -> ('a, 'b) t -> ('a, 'b option) t
     backtrace *)
 val fail : ?targets:Path.t list -> fail -> (_, _) t
 
+(** [memoize name t] is an arrow that behaves like [t] except that its
+    result is computed only once. *)
+val memoize : string -> (unit, 'a) t -> (unit, 'a) t
+
 module Prog_spec : sig
   type 'a t =
     | Dep of Path.t
@@ -149,6 +153,18 @@ module Repr : sig
     | Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
     | Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
     | Fail : fail -> (_, _) t
+    | Memo : 'a memo -> (unit, 'a) t
+
+  and 'a memo =
+    { name          : string
+    ; t             : (unit, 'a) t
+    ; mutable state : 'a memo_state
+    }
+
+  and 'a memo_state =
+    | Unevaluated
+    | Evaluating
+    | Evaluated of 'a
 
   and ('a, 'b) if_file_exists_state =
     | Undecided of ('a, 'b) t * ('a, 'b) t

src/build_interpret.ml

@@ -62,6 +62,7 @@ let deps t ~all_targets_by_dir =
     | Lines_of p -> Pset.add p acc
     | Record_lib_deps _ -> acc
     | Fail _ -> acc
+    | Memo m -> loop m.t acc
   in
   loop (Build.repr t) Pset.empty
 
@@ -93,6 +94,7 @@ let lib_deps =
       | Fail _ -> acc
       | If_file_exists (_, state) ->
         loop (get_if_file_exists_exn state) acc
+      | Memo m -> loop m.t acc
   in
   fun t -> loop (Build.repr t) Pmap.empty
 
@@ -126,6 +128,7 @@ let targets =
             code_errorf "Build_interpret.targets: cannot have targets \
                          under a [if_file_exists]"
       end
+    | Memo m -> loop m.t acc
   in
   fun t -> loop (Build.repr t) []
 

src/build_system.ml

@@ -250,6 +250,16 @@ module Build_exec = struct
       | Fail { fail } -> fail ()
       | If_file_exists (_, state) ->
         exec (get_if_file_exists_exn state) x
+      | Memo m ->
+        match m.state with
+        | Evaluated x -> x
+        | Evaluating ->
+          die "Dependency cycle evaluating memoized build arrow %s" m.name
+        | Unevaluated ->
+          m.state <- Evaluating;
+          let x = exec m.t x in
+          m.state <- Evaluated x;
+          x
     in
     let action = exec (Build.repr t) x in
     (action, !dyn_deps)