Start caching errors in Memo

Signed-off-by: Andrey Mokhov <amokhov@janestreet.com>

Author: snowleopard

src/memo/memo.ml

@@ -718,15 +718,19 @@ module Cached_value = struct
     t.deps <- capture_dep_values ~deps_rev;
     t
 
-  let value_changed (type o) (node : (_, o) Dep_node.t) prev_output curr_output
-      =
-    match (prev_output, curr_output) with
-    | (Value.Error _ | Cancelled _), _ -> true
-    | _, (Value.Error _ | Cancelled _) -> true
-    | Ok prev_output, Ok curr_output -> (
+  let value_changed (node : _ Dep_node.t) prev_value cur_value =
+    match ((prev_value : _ Value.t), (cur_value : _ Value.t)) with
+    | Cancelled _, _
+    | _, Cancelled _
+    | Error _, Ok _
+    | Ok _, Error _ ->
+      true
+    | Ok prev_value, Ok cur_value -> (
       match node.without_state.spec.allow_cutoff with
-      | Yes equal -> not (equal prev_output curr_output)
+      | Yes equal -> not (equal prev_value cur_value)
       | No -> true)
+    | Error prev_error, Error cur_error ->
+      not (Exn_set.equal prev_error cur_error)
 end
 
 (* Add a dependency on the [dep_node] from the caller, if there is one. Returns
@@ -832,7 +836,7 @@ let dep_node (t : (_, _) t) input =
 
    - [Unchanged]: all the dependencies of the current node are up to date and we
    can therefore skip recomputing the node and can reuse the value computed in
-   the previuos run.
+   the previous run.
 
    - [Changed]: one of the dependencies has changed since the previous run and
    the current node should therefore be recomputed.
@@ -873,13 +877,15 @@ end = struct
         (* Dependencies of cancelled computations are not accurate, so we can't
            use [deps_changed] in this case. *)
         Fiber.return (Error Cache_lookup.Failure.Not_found)
-      | Error _ ->
-        (* We always recompute errors, so there is no point in checking if any
-           of their dependencies changed. In principle, we could introduce
-           "persistent errors" that are recomputed only when their dependencies
-           have changed. *)
-        Fiber.return (Error Cache_lookup.Failure.Not_found)
-      | Ok _ -> (
+      | Ok _
+      | Error _ -> (
+        (* We cache errors just like normal values. We assume that all [Memo]
+           computations are deterministic, which means if we rerun a computation
+           that previously led to raising a set of errors, we expect to get the
+           same set of errors back and we might as well skip the unnecessary
+           work. The downside is that if a computation is non-deterministic,
+           there is no way to force rerunning it, apart from changing some of
+           its dependencies. *)
         let+ deps_changed =
           let rec go deps =
             match deps with
@@ -891,8 +897,16 @@ end = struct
                    is up to date. If not, we must recompute [last_cached_value]. *)
                 let* restore_result = consider_and_restore_from_cache dep in
                 match restore_result with
-                | Ok cached_value -> (
-                  match Value_id.equal cached_value.id v_id with
+                | Ok cached_value_of_dep -> (
+                  (* Here we know that [dep] can be restored from the cache, so
+                     how can [v_id] be different from [cached_value_of_dep.id]?
+                     Good question! This can happen if [cached_value]'s node was
+                     skipped in the previous run (because it was unreachable),
+                     while [dep] wasn't skipped and its value changed. In the
+                     current run, [cached_value] is therefore stale. We learn
+                     this when we see that the [cached_value_of_dep] is not as
+                     recorded when computing [cached_value]. *)
+                  match Value_id.equal cached_value_of_dep.id v_id with
                   | true -> go deps
                   | false -> Fiber.return Changed_or_not.Changed)
                 | Error (Cancelled { dependency_cycle }) ->

test/expect-tests/memo/memoize_tests.ml

@@ -972,34 +972,34 @@ let%expect_test "dynamic cycles with non-uniform cutoff structure" =
   evaluate_and_print summit_no_cutoff 0;
   [%expect
     {|
-    Started evaluating the summit with input 0
-    Started evaluating incrementing_chain_4_yes_cutoff
-    Started evaluating incrementing_chain_3_no_cutoff
+    Started evaluating base
+    Evaluated base: 3
     Started evaluating incrementing_chain_2_yes_cutoff
     Started evaluating incrementing_chain_1_no_cutoff
     Started evaluating cycle_creator_no_cutoff
-    Started evaluating base
-    Evaluated base: 3
     Evaluated cycle_creator_no_cutoff: 3
     Evaluated incrementing_chain_1_no_cutoff: 4
     Evaluated incrementing_chain_2_yes_cutoff: 5
+    Started evaluating incrementing_chain_4_yes_cutoff
+    Started evaluating incrementing_chain_3_no_cutoff
     Evaluated incrementing_chain_3_no_cutoff: 6
     Evaluated incrementing_chain_4_yes_cutoff: 7
+    Started evaluating the summit with input 0
     Evaluated the summit with input 0: 7
     f 0 = Ok 7 |}];
   evaluate_and_print summit_yes_cutoff 0;
   [%expect
     {|
-    Started evaluating the summit with input 0
-    Started evaluating incrementing_chain_4_no_cutoff
-    Started evaluating incrementing_chain_3_yes_cutoff
-    Started evaluating incrementing_chain_2_no_cutoff
-    Started evaluating incrementing_chain_1_yes_cutoff
     Started evaluating cycle_creator_yes_cutoff
     Evaluated cycle_creator_yes_cutoff: 3
+    Started evaluating incrementing_chain_1_yes_cutoff
     Evaluated incrementing_chain_1_yes_cutoff: 4
+    Started evaluating incrementing_chain_3_yes_cutoff
+    Started evaluating incrementing_chain_2_no_cutoff
     Evaluated incrementing_chain_2_no_cutoff: 5
     Evaluated incrementing_chain_3_yes_cutoff: 6
+    Started evaluating the summit with input 0
+    Started evaluating incrementing_chain_4_no_cutoff
     Evaluated incrementing_chain_4_no_cutoff: 7
     Evaluated the summit with input 0: 7
     f 0 = Ok 7 |}];
@@ -1403,7 +1403,6 @@ let%expect_test "error handling and duplicate exceptions" =
   in
   Fdecl.set f_impl (fun x ->
       printf "Calling f %d\n" x;
-
       match x with
       | 0 -> Memo.exec forward_fail x
       | 1 -> Memo.exec forward_fail2 x
@@ -1420,3 +1419,35 @@ let%expect_test "error handling and duplicate exceptions" =
     Calling f 0
     Error [ "(Failure 42)" ]
     |}]
+
+let%expect_test "errors are cached" =
+  Printexc.record_backtrace false;
+  let f =
+    Memo.create_hidden "area of a square"
+      ~input:(module Int)
+      (fun x ->
+        printf "Started evaluating %d\n" x;
+        if x < 0 then failwith (sprintf "Negative input %d" x);
+        let res = x * x in
+        printf "Evaluated %d: %d\n" x res;
+        Memo.Build.return res)
+  in
+  evaluate_and_print f 5;
+  evaluate_and_print f (-5);
+  [%expect
+    {|
+    Started evaluating 5
+    Evaluated 5: 25
+    f 5 = Ok 25
+    Started evaluating -5
+    f -5 = Error [ { exn = "(Failure \"Negative input -5\")"; backtrace = "" } ]
+    |}];
+  evaluate_and_print f 5;
+  evaluate_and_print f (-5);
+  (* Note that we do not see any "Started evaluating" messages because both [Ok]
+     and [Error] results have been cached. *)
+  [%expect
+    {|
+    f 5 = Ok 25
+    f -5 = Error [ { exn = "(Failure \"Negative input -5\")"; backtrace = "" } ]
+    |}]