diff options
| -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 2a43cd7d13..2dad962bec 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 f54af4df47..1df52d2523 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 |