diff --git a/src/froc/froc.ml b/src/froc/froc.ml index 25644df..33afc8c 100644 --- a/src/froc/froc.ml +++ b/src/froc/froc.ml @@ -91,10 +91,10 @@ let make_event () = make_changeable ~eq:never_eq () let never = make_constant (Fail Unset) let is_never = is_constant -let notify_result_e_cancel t f = notify_result_cancel ~current:false t f -let notify_result_e t f = notify_result ~current:false t f -let notify_e_cancel t f = notify_cancel ~current:false t f -let notify_e t f = notify ~current:false t f +let notify_result_e_cancel t f = notify_result_cancel ~now:false t f +let notify_result_e t f = notify_result ~now:false t f +let notify_e_cancel t f = notify_cancel ~now:false t f +let notify_e t f = notify ~now:false t f let hash_event = hash @@ -116,16 +116,13 @@ let merge ts = if List.for_all is_never ts then never else let rt, ru = make_event () in - let notify = ref false in - add_readerN ts begin fun () -> - if not !notify then notify := true - else - let rec loop = function - | [] -> assert false - | h :: t -> - match read_result h with - | Fail Unset -> loop t - | r -> r in + add_readerN ~now:false ts begin fun () -> + let rec loop = function + | [] -> assert false + | h :: t -> + match read_result h with + | Fail Unset -> loop t + | r -> r in write_temp_result ru (loop ts) end; rt @@ -147,21 +144,18 @@ let map2 f t1 t2 = if is_never t1 && is_never t2 then never else let rt, ru = make_event () in - let notify = ref false in - add_reader2 t1 t2 begin fun () -> - if not !notify then notify := true - else - let r = - match read_result t1, read_result t2 with - | Fail Unset, _ - | _, Fail Unset -> None - | Fail e, _ - | _, Fail e -> Some (Fail e) - | Value v1, Value v2 -> - try Some (Value (f v1 v2)) with e -> Some (Fail e) in - match r with - | None -> () - | Some r -> write_temp_result ru r + add_reader2 ~now:false t1 t2 begin fun () -> + let r = + match read_result t1, read_result t2 with + | Fail Unset, _ + | _, Fail Unset -> None + | Fail e, _ + | _, Fail e -> Some (Fail e) + | Value v1, Value v2 -> + try Some (Value (f v1 v2)) with e -> Some (Fail e) in + match r with + | None -> () + | Some r -> write_temp_result ru r end; rt @@ -259,7 +253,7 @@ let hold ?eq init e = hold_result ?eq (Value init) e let changes b = if is_constant b then never else let t, u = make_event () in - notify_result_b ~current:false b (write_temp_result u); + notify_result_b ~now:false b (write_temp_result u); t let when_true b = diff --git a/src/froc/froc.mli b/src/froc/froc.mli index 2ace889..0abb903 100644 --- a/src/froc/froc.mli +++ b/src/froc/froc.mli @@ -183,7 +183,7 @@ val fix_b : ?eq:('a -> 'a -> bool) -> ('a behavior -> 'a behavior) -> 'a behavio delayed one update cycle. *) -val notify_b : ?current:bool -> 'a behavior -> ('a -> unit) -> unit +val notify_b : ?now:bool -> 'a behavior -> ('a -> unit) -> unit (** [notify_b b f] adds [f] as a listener for [b], which is called whenever [b] changes. When [b] fails the listener is not @@ -191,24 +191,24 @@ val notify_b : ?current:bool -> 'a behavior -> ('a -> unit) -> unit scope is cleaned up. The listener is called immediately with the current value of the - behavior, unless [current] is false. The function [f] delimits a + behavior, unless [now] is false. The function [f] delimits a dynamic scope governed by [b]. *) -val notify_b_cancel : ?current:bool -> 'a behavior -> ('a -> unit) -> cancel +val notify_b_cancel : ?now:bool -> 'a behavior -> ('a -> unit) -> cancel (** Same as [notify_b], and returns a cancel handle (the notification is still cancelled when the enclosing dynamic scope is cleaned up). *) -val notify_result_b : ?current:bool -> 'a behavior -> ('a result -> unit) -> unit +val notify_result_b : ?now:bool -> 'a behavior -> ('a result -> unit) -> unit (** Same as [notify_b] but the listener is called with a result when the value changes or when the behavior fails. *) -val notify_result_b_cancel : ?current:bool -> 'a behavior -> ('a result -> unit) -> cancel +val notify_result_b_cancel : ?now:bool -> 'a behavior -> ('a result -> unit) -> cancel (** Same as [notify_result_b], and returns a cancel handle (the notification is still cancelled when the enclosing dynamic scope diff --git a/src/froc/froc_ddg.ml b/src/froc/froc_ddg.ml index 0689373..8046d94 100644 --- a/src/froc/froc_ddg.ml +++ b/src/froc/froc_ddg.ml @@ -249,14 +249,21 @@ let init () = let enqueue e = PQ.add !pq e -let add_reader_cancel t read = +let read_now ?(now=true) read = + if now then read + else + let notify = ref false in + fun () -> if not !notify then notify := true else read () + +let add_reader_cancel ?now t read = + let read = read_now ?now read in let start = TS.tick () in read (); let r = { read = read; start = start; finish = TS.tick () } in let dep _ = enqueue r in add_dep_cancel start t dep -let add_reader t read = let _ = add_reader_cancel t read in () +let add_reader ?now t read = let _ = add_reader_cancel ?now t read in () let connect_cancel u t' = write_result u (read_result t'); @@ -266,27 +273,18 @@ let connect u t' = write_result u (read_result t'); add_dep (TS.tick ()) t' (write_result_no_eq u) -let notify_result_cancel ?(current=true) t f = - if current - then - add_reader_cancel t begin fun () -> - try f (read_result t) with e -> !handle_exn e - end - else - let notify = ref false in - add_reader_cancel t begin fun () -> - if not !notify then notify := true - else - try f (read_result t) with e -> !handle_exn e - end +let notify_result_cancel ?now t f = + add_reader_cancel ?now t begin fun () -> + try f (read_result t) with e -> !handle_exn e + end -let notify_result ?current t f = let _ = notify_result_cancel ?current t f in () +let notify_result ?now t f = let _ = notify_result_cancel ?now t f in () -let notify_cancel ?current t f = - notify_result_cancel ?current t (function Fail _ -> () | Value v -> f v) +let notify_cancel ?now t f = + notify_result_cancel ?now t (function Fail _ -> () | Value v -> f v) -let notify ?current t f = - notify_result ?current t (function Fail _ -> () | Value v -> f v) +let notify ?now t f = + notify_result ?now t (function Fail _ -> () | Value v -> f v) let cleanup f = TS.add_cleanup (TS.tick ()) f @@ -400,7 +398,8 @@ let memo ?size ?hash ?eq () = result in match result with Value v -> v | Fail e -> raise e -let add_reader2 t1 t2 read = +let add_reader2 ?now t1 t2 read = + let read = read_now ?now read in let start = TS.tick () in read (); let r = { read = read; start = start; finish = TS.tick () } in @@ -427,7 +426,8 @@ let bind2 ?eq t1 t2 f = bind2_gen ?eq identity connect f t1 t2 let lift2 ?eq f = bind2_gen ?eq return write f let blift2 ?eq t1 t2 f = lift2 ?eq f t1 t2 -let add_reader3 t1 t2 t3 read = +let add_reader3 ?now t1 t2 t3 read = + let read = read_now ?now read in let start = TS.tick () in read (); let r = { read = read; start = start; finish = TS.tick () } in @@ -457,7 +457,8 @@ let bind3 ?eq t1 t2 t3 f = bind3_gen ?eq identity connect f t1 t2 t3 let lift3 ?eq f = bind3_gen ?eq return write f let blift3 ?eq t1 t2 t3 f = lift3 ?eq f t1 t2 t3 -let add_reader4 t1 t2 t3 t4 read = +let add_reader4 ?now t1 t2 t3 t4 read = + let read = read_now ?now read in let start = TS.tick () in read (); let r = { read = read; start = start; finish = TS.tick () } in @@ -493,7 +494,8 @@ let bind4 ?eq t1 t2 t3 t4 f = bind4_gen ?eq identity connect f t1 t2 t3 t4 let lift4 ?eq f = bind4_gen ?eq return write f let blift4 ?eq t1 t2 t3 t4 f = lift4 ?eq f t1 t2 t3 t4 -let add_reader5 t1 t2 t3 t4 t5 read = +let add_reader5 ?now t1 t2 t3 t4 t5 read = + let read = read_now ?now read in let start = TS.tick () in read (); let r = { read = read; start = start; finish = TS.tick () } in @@ -532,7 +534,8 @@ let bind5 ?eq t1 t2 t3 t4 t5 f = bind5_gen ?eq identity connect f t1 t2 t3 t4 t5 let lift5 ?eq f = bind5_gen ?eq return write f let blift5 ?eq t1 t2 t3 t4 t5 f = lift5 ?eq f t1 t2 t3 t4 t5 -let add_reader6 t1 t2 t3 t4 t5 t6 read = +let add_reader6 ?now t1 t2 t3 t4 t5 t6 read = + let read = read_now ?now read in let start = TS.tick () in read (); let r = { read = read; start = start; finish = TS.tick () } in @@ -575,7 +578,8 @@ let bind6 ?eq t1 t2 t3 t4 t5 t6 f = bind6_gen ?eq identity connect f t1 t2 t3 t4 let lift6 ?eq f = bind6_gen ?eq return write f let blift6 ?eq t1 t2 t3 t4 t5 t6 f = lift6 ?eq f t1 t2 t3 t4 t5 t6 -let add_reader7 t1 t2 t3 t4 t5 t6 t7 read = +let add_reader7 ?now t1 t2 t3 t4 t5 t6 t7 read = + let read = read_now ?now read in let start = TS.tick () in read (); let r = { read = read; start = start; finish = TS.tick () } in @@ -621,7 +625,8 @@ let bind7 ?eq t1 t2 t3 t4 t5 t6 t7 f = bind7_gen ?eq identity connect f t1 t2 t3 let lift7 ?eq f = bind7_gen ?eq return write f let blift7 ?eq t1 t2 t3 t4 t5 t6 t7 f = lift7 ?eq f t1 t2 t3 t4 t5 t6 t7 -let add_readerN ts read = +let add_readerN ?now ts read = + let read = read_now ?now read in let start = TS.tick () in read (); let r = { read = read; start = start; finish = TS.tick () } in diff --git a/src/froc/froc_ddg.mli b/src/froc/froc_ddg.mli index 6bba94e..662df68 100644 --- a/src/froc/froc_ddg.mli +++ b/src/froc/froc_ddg.mli @@ -42,8 +42,8 @@ val bind : ?eq:('b -> 'b -> bool) -> 'a t -> ('a -> 'b t) -> 'b t val (>>=) : 'a t -> ('a -> 'b t) -> 'b t val lift : ?eq:('b -> 'b -> bool) -> ('a -> 'b) -> 'a t -> 'b t val blift : ?eq:('b -> 'b -> bool) -> 'a t -> ('a -> 'b) -> 'b t -val add_reader : 'a t -> (unit -> unit) -> unit -val add_reader_cancel : 'a t -> (unit -> unit) -> cancel +val add_reader : ?now:bool -> 'a t -> (unit -> unit) -> unit +val add_reader_cancel : ?now:bool -> 'a t -> (unit -> unit) -> cancel val catch : ?eq:('a -> 'a -> bool) -> (unit -> 'a t) -> (exn -> 'a t) -> 'a t val try_bind : ?eq:('b -> 'b -> bool) -> (unit -> 'a t) -> ('a -> 'b t) -> (exn -> 'b t) -> 'b t @@ -57,10 +57,10 @@ val write_exn : 'a u -> exn -> unit val write_result : 'a u -> 'a result -> unit val clear : 'a u -> unit -val notify : ?current:bool -> 'a t -> ('a -> unit) -> unit -val notify_cancel : ?current:bool -> 'a t -> ('a -> unit) -> cancel -val notify_result : ?current:bool -> 'a t -> ('a result -> unit) -> unit -val notify_result_cancel : ?current:bool -> 'a t -> ('a result -> unit) -> cancel +val notify : ?now:bool -> 'a t -> ('a -> unit) -> unit +val notify_cancel : ?now:bool -> 'a t -> ('a -> unit) -> cancel +val notify_result : ?now:bool -> 'a t -> ('a result -> unit) -> unit +val notify_result_cancel : ?now:bool -> 'a t -> ('a result -> unit) -> cancel val connect : 'a u -> 'a t -> unit val connect_cancel : 'a u -> 'a t -> cancel val cleanup : (unit -> unit) -> unit @@ -96,6 +96,7 @@ val blift2 : ('a1 -> 'a2 -> 'b) -> 'b t val add_reader2 : + ?now:bool -> 'a1 t -> 'a2 t -> (unit -> unit) -> unit @@ -115,6 +116,7 @@ val blift3 : ('a1 -> 'a2 -> 'a3 -> 'b) -> 'b t val add_reader3 : + ?now:bool -> 'a1 t -> 'a2 t -> 'a3 t -> (unit -> unit) -> unit @@ -134,6 +136,7 @@ val blift4 : ('a1 -> 'a2 -> 'a3 -> 'a4 -> 'b) -> 'b t val add_reader4 : + ?now:bool -> 'a1 t -> 'a2 t -> 'a3 t -> 'a4 t -> (unit -> unit) -> unit @@ -153,6 +156,7 @@ val blift5 : ('a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'b) -> 'b t val add_reader5 : + ?now:bool -> 'a1 t -> 'a2 t -> 'a3 t -> 'a4 t -> 'a5 t -> (unit -> unit) -> unit @@ -172,6 +176,7 @@ val blift6 : ('a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'a6 -> 'b) -> 'b t val add_reader6 : + ?now:bool -> 'a1 t -> 'a2 t -> 'a3 t -> 'a4 t -> 'a5 t -> 'a6 t -> (unit -> unit) -> unit @@ -191,10 +196,11 @@ val blift7 : ('a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'a6 -> 'a7 -> 'b) -> 'b t val add_reader7 : + ?now:bool -> 'a1 t -> 'a2 t -> 'a3 t -> 'a4 t -> 'a5 t -> 'a6 t -> 'a7 t -> (unit -> unit) -> unit val bindN : ?eq:('b -> 'b -> bool) -> 'a t list -> ('a list -> 'b t) -> 'b t val liftN : ?eq:('b -> 'b -> bool) -> ('a list -> 'b) -> 'a t list -> 'b t val bliftN : ?eq:('b -> 'b -> bool) -> 'a t list -> ('a list -> 'b) -> 'b t -val add_readerN : 'a t list -> (unit -> unit) -> unit +val add_readerN : ?now:bool -> 'a t list -> (unit -> unit) -> unit