diff options
| -rw-r--r-- | lib/future.ml | 17 | ||||
| -rw-r--r-- | lib/future.mli | 30 |
2 files changed, 29 insertions, 18 deletions
diff --git a/lib/future.ml b/lib/future.ml index e9a2be989..8c40f0edb 100644 --- a/lib/future.ml +++ b/lib/future.ml @@ -37,8 +37,7 @@ type 'a comp = a mutex and a condition to make this possible *) | Closure of (unit -> 'a) | Val of 'a * Dyn.t option - | Exn of exn - (* Invariant: this exception is always "fixed" as in fix_exn *) + | Exn of exn (* Invariant: this exception is always "fixed" as in fix_exn *) type 'a comput = | Ongoing of (fix_exn * 'a comp ref) Ephemeron.key @@ -151,19 +150,23 @@ let transactify f x = let purify_future f x = if is_over x then f x else purify f x let compute x = purify_future (compute ~pure:false) x let force x = purify_future (force ~pure:false) x +let chain ?(greedy=false) ~pure x f = + let y = chain ~pure x f in + if is_over x && greedy then ignore(force y); + y let join kx = let v = force kx in kx := Finished v; v -let split2 x = - chain ~pure:true x (fun x -> fst x), - chain ~pure:true x (fun x -> snd x) +let split2 ?greedy x = + chain ?greedy ~pure:true x (fun x -> fst x), + chain ?greedy ~pure:true x (fun x -> snd x) -let map2 f x l = +let map2 ?greedy f x l = CList.map_i (fun i y -> - let xi = chain ~pure:true x (fun x -> + let xi = chain ?greedy ~pure:true x (fun x -> try List.nth x i with Failure _ | Invalid_argument _ -> Errors.anomaly (Pp.str "Future.map2 length mismatch")) in diff --git a/lib/future.mli b/lib/future.mli index f1a68f3b3..1a1648ff1 100644 --- a/lib/future.mli +++ b/lib/future.mli @@ -87,15 +87,22 @@ val is_val : 'a computation -> bool val is_exn : 'a computation -> bool val peek_val : 'a computation -> 'a option -(* Chain computations. When pure:true, the computation will not keep a copy - * of the global state. - * [let c' = chain ~pure:true c f in let c'' = chain ~pure:false c' g in] - * is invalid. It works if one forces [c''] since the whole computation will - * be executed in one go. It will not work, and raise an anomaly, if one - * forces c' and then c''. - * [join c; chain ~pure:false c g] is invalid and fails at runtime. - * [force c; chain ~pure:false c g] is correct. *) -val chain : pure:bool -> 'a computation -> ('a -> 'b) -> 'b computation +(* [chain greedy pure c f] chains computation [c] with [f]. + * The [greedy] and [pure] parameters are tricky: + * [pure]: + * When pure is true, the returned computation will not keep a copy + * of the global state. + * [let c' = chain ~pure:true c f in let c'' = chain ~pure:false c' g in] + * is invalid. It works if one forces [c''] since the whole computation + * will be executed in one go. It will not work, and raise an anomaly, if + * one forces c' and then c''. + * [join c; chain ~pure:false c g] is invalid and fails at runtime. + * [force c; chain ~pure:false c g] is correct. + * [greedy]: + * The [greedy] parameter forces immediately the new computation if + * the old one is_over (Exn or Val). Defaults to false. *) +val chain : ?greedy:bool -> pure:bool -> + 'a computation -> ('a -> 'b) -> 'b computation (* Forcing a computation *) val force : 'a computation -> 'a @@ -105,8 +112,9 @@ val compute : 'a computation -> 'a value val join : 'a computation -> 'a (*** Utility functions ************************************************* ***) -val split2 : ('a * 'b) computation -> 'a computation * 'b computation -val map2 : +val split2 : ?greedy:bool -> + ('a * 'b) computation -> 'a computation * 'b computation +val map2 : ?greedy:bool -> ('a computation -> 'b -> 'c) -> 'a list computation -> 'b list -> 'c list |