From 6e3b0f534a9ae182a9945b42dbc98b4a3e186ffd Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 23 Nov 2014 13:49:04 +0100 Subject: [PATCH] CCache.{size,iter} --- core/CCCache.ml | 53 +++++++++++++++++++++++++++++++++++++++--------- core/CCCache.mli | 48 ++++++++++++------------------------------- 2 files changed, 56 insertions(+), 45 deletions(-) diff --git a/core/CCCache.ml b/core/CCCache.ml index b5a657ff..e65b2e2f 100644 --- a/core/CCCache.ml +++ b/core/CCCache.ml @@ -23,7 +23,7 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) -(** {1 Memoization caches} *) +(** {1 Caches} *) type 'a equal = 'a -> 'a -> bool type 'a hash = 'a -> int @@ -36,6 +36,8 @@ let default_hash_ = Hashtbl.hash type ('a,'b) t = { set : 'a -> 'b -> unit; get : 'a -> 'b; (* or raise Not_found *) + size : unit -> int; + iter : ('a -> 'b -> unit) -> unit; clear : unit -> unit; } @@ -53,10 +55,16 @@ let with_cache_rec c f = let rec f' x = with_cache c (f f') x in f' +let size c = c.size () + +let iter c f = c.iter f + let dummy = { set=(fun _ _ -> ()); get=(fun _ -> raise Not_found); clear=(fun _ -> ()); + size=(fun _ -> 0); + iter=(fun _ -> ()); } module Linear = struct @@ -91,6 +99,14 @@ module Linear = struct let set c x y = c.arr.(c.i) <- Pair (x,y); c.i <- (c.i + 1) mod Array.length c.arr + + let iter c f = + Array.iter (function Pair (x,y) -> f x y | Empty -> ()) c.arr + + let size c () = + let r = ref 0 in + iter c (fun _ _ -> incr r); + !r end let linear ?(eq=default_eq_) size = @@ -99,6 +115,8 @@ let linear ?(eq=default_eq_) size = { get=(fun x -> Linear.get arr x); set=(fun x y -> Linear.set arr x y); clear=(fun () -> Linear.clear arr); + size=Linear.size arr; + iter=Linear.iter arr; } module Replacing = struct @@ -110,13 +128,15 @@ module Replacing = struct eq : 'a equal; hash : 'a hash; arr : ('a,'b) bucket array; + mutable c_size : int; } let make eq hash size = assert (size>0); - {arr=Array.make size Empty; eq; hash } + {arr=Array.make size Empty; eq; hash; c_size=0 } let clear c = + c.c_size <- 0; Array.fill c.arr 0 (Array.length c.arr) Empty let get c x = @@ -128,7 +148,13 @@ module Replacing = struct let set c x y = let i = c.hash x mod Array.length c.arr in + if c.arr.(i) = Empty then c.c_size <- c.c_size + 1; c.arr.(i) <- Pair (x,y) + + let iter c f = + Array.iter (function Empty -> () | Pair (x,y) -> f x y) c.arr + + let size c () = c.c_size end let replacing ?(eq=default_eq_) ?(hash=default_hash_) size = @@ -136,6 +162,8 @@ let replacing ?(eq=default_eq_) ?(hash=default_hash_) size = { get=(fun x -> Replacing.get c x); set=(fun x y -> Replacing.set c x y); clear=(fun () -> Replacing.clear c); + size=Replacing.size c; + iter=Replacing.iter c; } module type HASH = sig @@ -173,10 +201,6 @@ module LRU(X:HASH) = struct c.first <- None; () - let get_opt = function - | None -> assert false - | Some x -> x - (* take first from queue *) let take_ c = match c.first with @@ -248,6 +272,11 @@ module LRU(X:HASH) = struct if len = c.size then replace_ c x y else insert_ c x y + + let size c () = H.length c.table + + let iter c f = + H.iter (fun x node -> f x node.value) c.table end let lru (type a) ?(eq=default_eq_) ?(hash=default_hash_) size = @@ -260,15 +289,13 @@ let lru (type a) ?(eq=default_eq_) ?(hash=default_hash_) size = { get=(fun x -> L.get c x); set=(fun x y -> L.set c x y); clear=(fun () -> L.clear c); + size=L.size c; + iter=L.iter c; } module UNBOUNDED(X:HASH) = struct - type key = X.t - module H = Hashtbl.Make(X) - type 'a t = 'a H.t - let make size = assert (size > 0); H.create size @@ -278,6 +305,10 @@ module UNBOUNDED(X:HASH) = struct let get c x = H.find c x let set c x y = H.replace c x y + + let size c () = H.length c + + let iter c f = H.iter f c end let unbounded (type a) ?(eq=default_eq_) ?(hash=default_hash_) size = @@ -290,4 +321,6 @@ let unbounded (type a) ?(eq=default_eq_) ?(hash=default_hash_) size = { get=(fun x -> C.get c x); set=(fun x y -> C.set c x y); clear=(fun () -> C.clear c); + iter=C.iter c; + size=C.size c; } diff --git a/core/CCCache.mli b/core/CCCache.mli index d548bbfd..a50b8ee6 100644 --- a/core/CCCache.mli +++ b/core/CCCache.mli @@ -23,7 +23,11 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) -(** {1 Memoization caches} *) +(** {1 Caches} + +Particularly useful for memoization. See {!with_cache} and {!with_cache_rec} +for more details. +@since NEXT_RELEASE *) type 'a equal = 'a -> 'a -> bool type 'a hash = 'a -> int @@ -72,6 +76,13 @@ fib 70;; ]} *) +val size : (_,_) t -> int +(** Size of the cache (number of entries). At most linear in the number + of entries. *) + +val iter : ('a,'b) t -> ('a -> 'b -> unit) -> unit +(** Iterate on cached values. Should yield [size cache] pairs. *) + val dummy : ('a,'b) t (** dummy cache, never stores any value *) @@ -92,42 +103,9 @@ val replacing : ?eq:'a equal -> ?hash:'a hash -> val lru : ?eq:'a equal -> ?hash:'a hash -> int -> ('a,'b) t (** LRU cache of the given size ("Least Recently Used": keys that have not been - used recently are deleted first). Never grows wider. *) + used recently are deleted first). Never grows wider than the given size. *) val unbounded : ?eq:'a equal -> ?hash:'a hash -> int -> ('a,'b) t (** Unbounded cache, backed by a Hash table. Will grow forever unless {!clear} is called manually. *) - -(** {2 Binary Caches} -TODO - -module C2 : sig - type ('a, 'b, 'c) t - - val clear : (_,_,_) t -> unit - - val with_cache : ('a, 'b, 'c) t -> ('a -> 'b -> 'c) -> 'a -> 'b -> 'c - - val with_cache_rec : ('a,'b,'c) t -> - (('a -> 'b -> 'c) -> 'a -> 'b -> 'c) -> - 'a -> 'b -> 'c - - val dummy : ('a,'b,'c) t - - val linear : ?eq1:('a -> 'a -> bool) -> ?eq2:('b -> 'b -> bool) -> - int -> ('a, 'b, 'c) t - - val replacing : ?eq1:('a -> 'a -> bool) -> ?hash1:('a -> int) -> - ?eq2:('b -> 'b -> bool) -> ?hash2:('b -> int) -> - int -> ('a,'b,'c) t - - val lru : ?eq1:('a -> 'a -> bool) -> ?hash1:('a -> int) -> - ?eq2:('b -> 'b -> bool) -> ?hash2:('b -> int) -> - int -> ('a,'b,'c) t - - val unbounded : ?eq1:('a -> 'a -> bool) -> ?hash1:('a -> int) -> - ?eq2:('b -> 'b -> bool) -> ?hash2:('b -> int) -> - int -> ('a,'b,'c) t -end -*)