diff options
| author |  Alec Faithfull <alef@itu.dk> | 2015-10-06 14:20:22 +0200 |
|---|---|---|
| committer |  Enrico Tassi <Enrico.Tassi@inria.fr> | 2015-10-09 11:01:49 +0200 |
| commit | f6b3704391de97ee544da9ae7316685cd2d9fae3 (patch) | |
| tree | 68c2b7507386e0cea221893b7bd28d45c91d8b65 | |
| parent | 56ca108e63191e90c3d4169c37a4c97017e3c6ae (diff) | |
TQueue: Allow some tasks to be saved when clearing a TQueue
| -rw-r--r-- | stm/tQueue.ml | 12 | ||||
| -rw-r--r-- | stm/tQueue.mli | 1 |
2 files changed, 13 insertions, 0 deletions
diff --git a/stm/tQueue.ml b/stm/tQueue.ml index 2a43cd7d1..2dad962be 100644 --- a/stm/tQueue.ml +++ b/stm/tQueue.ml @@ -105,6 +105,18 @@ let clear { queue = q; lock = m; cond = c } = PriorityQueue.clear q; Mutex.unlock m +let clear_saving { queue = q; lock = m; cond = c } f = + Mutex.lock m; + let saved = ref [] in + while not (PriorityQueue.is_empty q) do + let elem = PriorityQueue.pop q in + match f elem with + | Some x -> saved := x :: !saved + | None -> () + done; + Mutex.unlock m; + List.rev !saved + let is_empty { queue = q } = PriorityQueue.is_empty q let destroy tq = diff --git a/stm/tQueue.mli b/stm/tQueue.mli index f54af4df4..1df52d252 100644 --- a/stm/tQueue.mli +++ b/stm/tQueue.mli @@ -22,6 +22,7 @@ val broadcast : 'a t -> unit val wait_until_n_are_waiting_then_snapshot : int -> 'a t -> 'a list val clear : 'a t -> unit +val clear_saving : 'a t -> ('a -> 'b option) -> 'b list val is_empty : 'a t -> bool exception BeingDestroyed |