aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--stm/stm.ml12
-rw-r--r--stm/stm.mli4
2 files changed, 12 insertions, 4 deletions
diff --git a/stm/stm.ml b/stm/stm.ml
index 4afdb06a1..392225480 100644
--- a/stm/stm.ml
+++ b/stm/stm.ml
@@ -28,6 +28,9 @@ let state_computed, state_computed_hook = Hook.make
~default:(fun state_id ~in_cache ->
feedback ~state_id Feedback.Processed) ()
+let state_ready, state_ready_hook = Hook.make
+ ~default:(fun state_id -> ()) ()
+
let forward_feedback, forward_feedback_hook = Hook.make
~default:(function
| { Feedback.id = Feedback.Edit edit_id; route; contents } ->
@@ -422,7 +425,9 @@ end = struct (* {{{ *)
match get_info !vcs id with
| Some x -> x
| None -> raise Vcs_aux.Expired
- let set_state id s = (get_info id).state <- Some s
+ let set_state id s =
+ (get_info id).state <- Some s;
+ if Flags.async_proofs_is_master () then Hooks.(call state_ready id)
let get_state id = (get_info id).state
let reached id b =
let info = get_info id in
@@ -562,8 +567,8 @@ end = struct (* {{{ *)
end (* }}} *)
let state_of_id id =
- try (VCS.get_info id).state
- with VCS.Expired -> None
+ try `Valid (VCS.get_info id).state
+ with VCS.Expired -> `Expired
(****** A cache: fills in the nodes of the VCS document with their value ******)
@@ -2382,6 +2387,7 @@ let show_script ?proof () =
(* Export hooks *)
let state_computed_hook = Hooks.state_computed_hook
+let state_ready_hook = Hooks.state_ready_hook
let parse_error_hook = Hooks.parse_error_hook
let execution_error_hook = Hooks.execution_error_hook
let forward_feedback_hook = Hooks.forward_feedback_hook
diff --git a/stm/stm.mli b/stm/stm.mli
index 2cbd54dd5..1d926e998 100644
--- a/stm/stm.mli
+++ b/stm/stm.mli
@@ -99,6 +99,8 @@ val parse_error_hook :
(Feedback.edit_or_state_id -> Loc.t -> Pp.std_ppcmds -> unit) Hook.t
val execution_error_hook : (Stateid.t -> Loc.t -> Pp.std_ppcmds -> unit) Hook.t
val unreachable_state_hook : (Stateid.t -> unit) Hook.t
+(* ready means that master has it at hand *)
+val state_ready_hook : (Stateid.t -> unit) Hook.t
(* Messages from the workers to the master *)
val forward_feedback_hook : (Feedback.feedback -> unit) Hook.t
@@ -108,7 +110,7 @@ type state = {
proof : Proof_global.state;
shallow : bool
}
-val state_of_id : Stateid.t -> state option
+val state_of_id : Stateid.t -> [ `Valid of state option | `Expired ]
(** read-eval-print loop compatible interface ****************************** **)