diff options
author | Alec Faithfull <alef@itu.dk> | 2015-10-06 14:19:34 +0200 |
---|---|---|
committer | Enrico Tassi <Enrico.Tassi@inria.fr> | 2015-10-09 11:01:43 +0200 |
commit | 56ca108e63191e90c3d4169c37a4c97017e3c6ae (patch) | |
tree | 7f2e6e23ed8093d43ec3179980dcfaf5464eebc1 | |
parent | ce0c536b4430711db1e30cd7ac35ae8d71d34e64 (diff) |
TQueue: Expose the length of TQueues
-rw-r--r-- | stm/tQueue.ml | 8 | ||||
-rw-r--r-- | stm/tQueue.mli | 2 |
2 files changed, 10 insertions, 0 deletions
diff --git a/stm/tQueue.ml b/stm/tQueue.ml index 6fef895ae..2a43cd7d1 100644 --- a/stm/tQueue.ml +++ b/stm/tQueue.ml @@ -15,6 +15,7 @@ module PriorityQueue : sig val pop : ?picky:('a -> bool) -> 'a t -> 'a val push : 'a t -> 'a -> unit val clear : 'a t -> unit + val length : 'a t -> int end = struct type 'a item = int * 'a type 'a rel = 'a item -> 'a item -> int @@ -38,6 +39,7 @@ end = struct let set_rel rel ({ contents = (xs, _) } as t) = let rel (_,x) (_,y) = rel x y in t := (List.sort rel xs, rel) + let length ({ contents = (l, _) }) = List.length l end type 'a t = { @@ -92,6 +94,12 @@ let push { queue = q; lock = m; cond = c; release } x = Condition.broadcast c; Mutex.unlock m +let length { queue = q; lock = m } = + Mutex.lock m; + let n = PriorityQueue.length q in + Mutex.unlock m; + n + let clear { queue = q; lock = m; cond = c } = Mutex.lock m; PriorityQueue.clear q; diff --git a/stm/tQueue.mli b/stm/tQueue.mli index 7458de510..f54af4df4 100644 --- a/stm/tQueue.mli +++ b/stm/tQueue.mli @@ -28,3 +28,5 @@ exception BeingDestroyed (* Threads blocked in pop can get this exception if the queue is being * destroyed *) val destroy : 'a t -> unit + +val length : 'a t -> int |