Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

cancellable functions are also cancelled by timeline

  • Loading branch information...
commit e2a6ac364ab654004067da3e8b884a57259a28c8 1 parent 6b3b744
Jake Donham authored
Showing with 29 additions and 33 deletions.
  1. +20 −24 src/froc/froc_ddg.ml
  2. +9 −9 src/froc/froc_ddg.mli
View
44 src/froc/froc_ddg.ml
@@ -121,34 +121,28 @@ let make_cancel f = f
let no_cancel = ignore
let cancel c = c ()
-let add_dep_cancel t f =
- match repr_of_t t with
- | Constant _ -> ignore
- | Changeable c ->
- let dl = Dlist.add_after c.deps f in
- make_cancel (fun () -> Dlist.remove dl)
-
-let add_dep ts t dep =
- let cancel = add_dep_cancel t dep in
- TS.add_cleanup ts cancel
+let add_dep_cancel ts t dep =
+ let cancel =
+ match repr_of_t t with
+ | Constant _ -> no_cancel
+ | Changeable c ->
+ let dl = Dlist.add_after c.deps dep in
+ make_cancel (fun () -> Dlist.remove dl) in
+ TS.add_cleanup ts cancel;
+ cancel
+
+let add_dep ts t dep = let _ = add_dep_cancel ts t dep in ()
let notify_result_cancel t f =
- add_dep_cancel t f
+ add_dep_cancel (TS.tick ()) t f
-let notify_result t f =
- add_dep (TS.tick ()) t (fun () -> f (read_result t))
+let notify_result t f = let _ = notify_result_cancel t f in ()
let notify_cancel t f =
- notify_result_cancel t
- (function
- | Fail _ -> ()
- | Value v -> f v)
+ notify_result_cancel t (function Fail _ -> () | Value v -> f v)
let notify t f =
- notify_result t
- (function
- | Fail _ -> ()
- | Value v -> f v)
+ notify_result t (function Fail _ -> () | Value v -> f v)
let cleanup f =
TS.add_cleanup (TS.tick ()) f
@@ -260,16 +254,18 @@ let init () =
let enqueue e = PQ.add !pq e
-let add_reader t read =
+let add_reader_cancel t read =
let start = TS.tick () in
read ();
let r = { read = read; start = start; finish = TS.tick () } in
let dep _ = enqueue r in
- add_dep start t dep
+ add_dep_cancel start t dep
+
+let add_reader t read = let _ = add_reader_cancel t read in ()
let connect_cancel u t' =
write_result u (read_result t');
- add_dep_cancel t' (write_result_no_eq u)
+ add_dep_cancel (TS.tick ()) t' (write_result_no_eq u)
let connect u t' =
write_result u (read_result t');
View
18 src/froc/froc_ddg.mli
@@ -23,6 +23,11 @@
type +'a t
type -'a u
+type cancel = unit -> unit
+val make_cancel : (unit -> unit) -> cancel
+val no_cancel : cancel
+val cancel : cancel -> unit
+
val changeable : ?eq:('a -> 'a -> bool) -> 'a -> 'a t * 'a u
val return : 'a -> 'a t
val fail : exn -> 'a t
@@ -32,6 +37,7 @@ 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 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
@@ -47,18 +53,12 @@ val write_exn : 'a u -> exn -> unit
val write_result : 'a u -> 'a result -> unit
val notify : 'a t -> ('a -> unit) -> unit
-val notify_result : 'a t -> ('a result -> unit) -> unit
-val connect : 'a u -> 'a t -> unit
-val cleanup : (unit -> unit) -> unit
-
-type cancel = unit -> unit
-val make_cancel : (unit -> unit) -> cancel
-val no_cancel : cancel
-val cancel : cancel -> unit
-
val notify_cancel : 'a t -> ('a -> unit) -> cancel
+val notify_result : 'a t -> ('a result -> unit) -> unit
val notify_result_cancel : '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
val make_changeable : ?eq:('a -> 'a -> bool) -> ?result:'a result -> unit -> 'a t * 'a u
val make_constant : 'a result -> 'a t
Please sign in to comment.
Something went wrong with that request. Please try again.