From a4c7f8bd98be2a200489325ff7c5061cf80ab4f3 Mon Sep 17 00:00:00 2001
From: Enrico Tassi <gareuselesinge@debian.org>
Date: Tue, 27 Dec 2016 16:53:30 +0100
Subject: Imported Upstream version 8.6

---
 lib/future.ml | 33 +++++++++++++++++----------------
 1 file changed, 17 insertions(+), 16 deletions(-)

(limited to 'lib/future.ml')

diff --git a/lib/future.ml b/lib/future.ml
index 5cd2beba..ea0382a6 100644
--- a/lib/future.ml
+++ b/lib/future.ml
@@ -7,8 +7,9 @@
 (************************************************************************)
 
 (* To deal with side effects we have to save/restore the system state *)
-let freeze = ref (fun () -> assert false : unit -> Dyn.t)
-let unfreeze = ref (fun _ -> () : Dyn.t -> unit)
+type freeze
+let freeze = ref (fun () -> assert false : unit -> freeze)
+let unfreeze = ref (fun _ -> () : freeze -> unit)
 let set_freeze f g = freeze := f; unfreeze := g
 
 let not_ready_msg = ref (fun name ->
@@ -29,10 +30,10 @@ let customize_not_here_msg f = not_here_msg := f
 
 exception NotReady of string
 exception NotHere of string
-let _ = Errors.register_handler (function
+let _ = CErrors.register_handler (function
   | NotReady name -> !not_ready_msg name
   | NotHere name -> !not_here_msg name
-  | _ -> raise Errors.Unhandled)
+  | _ -> raise CErrors.Unhandled)
 
 type fix_exn = Exninfo.iexn -> Exninfo.iexn
 let id x = prerr_endline "Future: no fix_exn.\nYou have probably created a Future.computation from a value without passing the ~fix_exn argument.  You probably want to chain with an already existing future instead."; x
@@ -58,11 +59,11 @@ type 'a assignement = [ `Val of 'a | `Exn of Exninfo.iexn | `Comp of 'a computat
 and 'a comp =
   | Delegated of (unit -> unit)
   | Closure of (unit -> 'a)
-  | Val of 'a * Dyn.t option
+  | Val of 'a * freeze option
   | Exn of Exninfo.iexn  (* Invariant: this exception is always "fixed" as in fix_exn *)
 
 and 'a comput =
-  | Ongoing of string * (UUID.t * fix_exn * 'a comp ref) Ephemeron.key
+  | Ongoing of string * (UUID.t * fix_exn * 'a comp ref) CEphemeron.key
   | Finished of 'a
 
 and 'a computation = 'a comput ref
@@ -70,13 +71,13 @@ and 'a computation = 'a comput ref
 let unnamed = "unnamed"
 
 let create ?(name=unnamed) ?(uuid=UUID.fresh ()) f x =
-  ref (Ongoing (name, Ephemeron.create (uuid, f, Pervasives.ref x)))
+  ref (Ongoing (name, CEphemeron.create (uuid, f, Pervasives.ref x)))
 let get x =
   match !x with
   | Finished v -> unnamed, UUID.invalid, id, ref (Val (v,None))
   | Ongoing (name, x) ->
-      try let uuid, fix, c = Ephemeron.get x in name, uuid, fix, c
-      with Ephemeron.InvalidKey ->
+      try let uuid, fix, c = CEphemeron.get x in name, uuid, fix, c
+      with CEphemeron.InvalidKey ->
         name, UUID.invalid, id, ref (Exn (NotHere name, Exninfo.null))
 
 type 'a value = [ `Val of 'a | `Exn of Exninfo.iexn  ]
@@ -135,7 +136,7 @@ let rec compute ~pure ck : 'a value =
         let state = if pure then None else Some (!freeze ()) in
         c := Val (data, state); `Val data
       with e ->
-        let e = Errors.push e in
+        let e = CErrors.push e in
         let e = fix_exn e in
         match e with
         | (NotReady _, _) -> `Exn e
@@ -155,9 +156,9 @@ let chain ~pure ck f =
   | Val (v, Some state) -> Closure (fun () -> !unfreeze state; f v)
   | Val (v, None) ->
       match !ck with
-      | Finished _ -> Errors.anomaly(Pp.str
+      | Finished _ -> CErrors.anomaly(Pp.str
           "Future.chain ~pure:false call on an already joined computation")
-      | Ongoing _ -> Errors.anomaly(Pp.strbrk(
+      | Ongoing _ -> CErrors.anomaly(Pp.strbrk(
           "Future.chain ~pure:false call on a pure computation. "^
           "This can happen if the computation was initial created with "^
           "Future.from_val or if it was Future.chain ~pure:true with a "^
@@ -169,7 +170,7 @@ let replace kx y =
   let _, _, _, x = get kx in
   match !x with
   | Exn _ -> x := Closure (fun () -> force ~pure:false y)
-  | _ -> Errors.anomaly
+  | _ -> CErrors.anomaly
            (Pp.str "A computation can be replaced only if is_exn holds")
 
 let purify f x =
@@ -179,13 +180,13 @@ let purify f x =
     !unfreeze state;
     v
   with e ->
-    let e = Errors.push e in !unfreeze state; Exninfo.iraise e
+    let e = CErrors.push e in !unfreeze state; Exninfo.iraise e
 
 let transactify f x =
   let state = !freeze () in
   try f x
   with e ->
-    let e = Errors.push e in !unfreeze state; Exninfo.iraise e
+    let e = CErrors.push e in !unfreeze state; Exninfo.iraise e
 
 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
@@ -212,7 +213,7 @@ let map2 ?greedy f x l =
     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
+          CErrors.anomaly (Pp.str "Future.map2 length mismatch")) in
     f xi y) 0 l
 
 let print f kx =
-- 
cgit v1.2.3