aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--lib/future.ml9
-rw-r--r--lib/future.mli4
2 files changed, 13 insertions, 0 deletions
diff --git a/lib/future.ml b/lib/future.ml
index 6001da30d..c1fb176df 100644
--- a/lib/future.ml
+++ b/lib/future.ml
@@ -47,6 +47,10 @@ let is_val x = match !x with
| Val _ -> true
| Exn _ | Closure _ | Delegated | Dropped -> false
+let is_exn x = match !x with
+ | Exn _ -> true
+ | Val _ | Closure _ | Delegated | Dropped -> false
+
let peek_val x = match !x with
| Val (v, _) -> Some v
| Exn _ | Closure _ | Delegated | Dropped -> None
@@ -103,6 +107,11 @@ let chain ?(id="none") ?(pure=false) c f = ref (match !c with
let create_here f = chain ~pure:false (from_here ()) f
+let replace x y =
+ match !x with
+ | Exn _ -> x := Closure (fun () -> force ~pure:false y)
+ | _ -> Errors.anomaly (Pp.str "Only Exn futures can be replaced")
+
let purify f x =
let state = !freeze () in
try
diff --git a/lib/future.mli b/lib/future.mli
index f07d325e0..a1535b13d 100644
--- a/lib/future.mli
+++ b/lib/future.mli
@@ -22,6 +22,9 @@ val from_val : 'a -> 'a computation
type 'a assignement = [ `Val of 'a | `Exn of exn | `Comp of 'a computation]
val create_delegate : unit -> 'a computation * ('a assignement -> unit)
+(* Given a computation that is_exn, replace it by another one *)
+val replace : 'a computation -> 'a computation -> unit
+
(* Variants to stock a copy of the current environment *)
val create_here : (unit -> 'a) -> 'a computation
val from_here : 'a -> 'a computation
@@ -29,6 +32,7 @@ val from_here : 'a -> 'a computation
(* Inspect a computation *)
val is_over : 'a computation -> bool
val is_val : 'a computation -> bool
+val is_exn : 'a computation -> bool
val peek_val : 'a computation -> 'a option
(* Chain computations.