changed the implementation of Behavior.Fut

behavior.ml

@@ -108,39 +108,34 @@ let closure f =
 (** {2 Lightweight futures} *)
 
 module Fut = struct
-  type 'a t = {
+  type 'a t = 'a fut_cell ref
-    mutable value : 'a option;
+  and 'a fut_cell =
-    mutable handlers : ('a -> unit) list;
+    | Waiting of ('a -> unit) list
-  }
+    | Done of 'a
 
   let create () =
-    let fut = {
+    let fut = ref (Waiting []) in
-      value = None;
+    let send x = match !fut with
-      handlers = [];
+      | Done _ -> raise (Invalid_argument "Behavior.Fut.create: future already set")
-    } in
+      | Waiting handlers ->
-    let send x = match fut.value with
+        List.iter (fun f -> f x) handlers;
-      | Some _ -> raise (Invalid_argument "Behavior.Fut.create: future already set")
+        fut := Done x
-      | None ->
-        fut.value <- Some x;
-        List.iter (fun f -> f x) fut.handlers
     in
     fut, send
 
   (* add [h] as a handler that waits for [fut] to complete. May call [h]
       immediately *)
   let subscribe fut h =
-    match fut.value with
+    match !fut with
-    | None -> fut.handlers <- h :: fut.handlers
+    | Done x -> h x
-    | Some x -> h x
+    | Waiting l -> fut := Waiting (h :: l)
 
-  let is_set fut = match fut.value with
+  let is_set fut = match !fut with
-    | None -> false
+    | Done _ -> true
-    | Some _ -> true
+    | Waiting _ -> false
 
-  let return x = {
+  let return x =
-    value = Some x;
+    ref (Done x)
-    handlers = [];
-  }
 
   let bind fut f =
     (* result *)
@@ -155,7 +150,7 @@ module Fut = struct
   let next e =
     let res, send = create () in
     let ev = React.E.map send (React.E.once e) in
-    res.handlers <- [fun _ -> ignore ev];  (* keep reference *)
+    subscribe res (fun _ -> ignore ev);  (* keep reference *)
     res
 
   let wait fut =
@@ -175,9 +170,9 @@ module Fut = struct
     let any_set = ref false in
     (try
       List.iter
-        (fun fut -> match fut.value with
+        (fun fut -> match !fut with
-          | None -> ()
+          | Waiting _ -> ()
-          | Some x -> any_set := true; send x; raise Exit)
+          | Done x -> any_set := true; send x; raise Exit)
       l
     with Exit -> ());
     (* if no element of [l] is already set, add handlers *)
@@ -216,9 +211,9 @@ module Fut = struct
     res
 
   (** Get value, which must be present *)
-  let unsafe_get fut = match fut.value with
+  let unsafe_get fut = match !fut with
-    | None -> assert false
+    | Waiting _-> assert false
-    | Some x -> x
+    | Done x -> x
 
   let l2 f a b =
     let res, send = create () in