Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

fix_e, fix_b

  • Loading branch information...
commit dad62d98da881ca5a768c57fb70d38de7831a29d 1 parent 237b929
Jake Donham authored
Showing with 45 additions and 9 deletions.
  1. +33 −9 src/froc/froc.ml
  2. +12 −0 src/froc/froc.mli
View
42 src/froc/froc.ml
@@ -30,12 +30,14 @@ type 'a event = 'a t
type 'a event_sender = 'a u
let q = Queue.create ()
+let temps = ref []
+let running = ref false
let init () =
init ();
- Queue.clear q
-
-let running = ref false
+ Queue.clear q;
+ temps := [];
+ running := false
let run_queue () =
if not !running then begin
@@ -49,7 +51,13 @@ let run_queue () =
raise e
end
-let temps = ref []
+let with_run_queue f =
+ (* don't run the queue until f is done *)
+ let running' = !running in
+ running := true;
+ f ();
+ running := running';
+ run_queue ()
let write_temp_result u r =
temps := (fun () -> clear u) :: !temps;
@@ -58,11 +66,12 @@ let write_temp_result u r =
let send_result s r =
match !temps with
| [] ->
- write_temp_result s r;
- propagate ();
- List.iter (fun f -> f ()) !temps;
- temps := [];
- run_queue ()
+ with_run_queue begin fun () ->
+ write_temp_result s r;
+ propagate ();
+ List.iter (fun f -> f ()) !temps;
+ temps := []
+ end
| _ -> failwith "already in update loop"
let send s v = send_result s (Value v)
@@ -176,6 +185,12 @@ let join_e ee =
end;
rt
+let fix_e ef =
+ let t, u = make_event () in
+ let e = ef t in
+ notify_result_e e (send_result_deferred u);
+ e
+
type 'a behavior = 'a t
let sample = read
@@ -190,6 +205,15 @@ let hash_behavior = hash
let join_b ?eq bb = bind ?eq bb (fun b -> b)
+let fix_b ?eq bf =
+ let t, u = make_changeable ?eq () in
+ let b = bf t in
+ notify_result_b b begin fun r ->
+ Queue.add (fun () -> write_result u r) q;
+ run_queue ()
+ end;
+ b
+
let switch ?eq b e =
if is_never e then b else
let bt, bu = make_changeable ?eq () in
View
12 src/froc/froc.mli
@@ -142,6 +142,12 @@ val try_bind_lift : ?eq:('b -> 'b -> bool) -> (unit -> 'a behavior) -> ('a -> 'b
val join_b : ?eq:('a -> 'a -> bool) -> 'a behavior behavior -> 'a behavior
(** [join_b b] behaves as whichever behavior is currently the value of [b]. *)
+val fix_b : ?eq:('a -> 'a -> bool) -> ('a behavior -> 'a behavior) -> 'a behavior
+ (**
+ [fix_b bf] returns [bf b'] where [b'] behaves like [bf b'], but
+ delayed one update cycle.
+ *)
+
val notify_b : ?current:bool -> 'a behavior -> ('a -> unit) -> unit
(**
Adds a listener for the value of a behavior, which is called
@@ -291,6 +297,12 @@ val collect : ('b -> 'a -> 'b) -> 'b -> 'a event -> 'b event
val join_e : 'a event event -> 'a event
(** [join_e ee] fires whenever the event last fired from [ee] fires *)
+val fix_e : ('a event -> 'a event) -> 'a event
+ (**
+ [fix_e ef] returns [ef e'] where [e'] is an event that fires
+ whenever [ef e'] fires, but in the next update cycle.
+ *)
+
val hash_event : 'a event -> int
(** A hash function for events. *)
Please sign in to comment.
Something went wrong with that request. Please try again.