simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 03:05:28 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

CCache.{size,iter}

Browse source
This commit is contained in:
Simon Cruanes 2014-11-23 13:49:04 +01:00
parent f010bc6ebc
commit 6e3b0f534a
2 changed files with 56 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
core/CCCache.ml
View file

@ -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;
}

48
core/CCCache.mli
View file

@ -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
*)