[r2002-11-06 16:19:24 by cvscast] Empty log message

Original author: cvscast
Date: 2002-11-06 16:19:25+00:00

misc/pool.ml

+module type T = 
+sig
+  type t  
+  type value
+    
+  val clear: unit -> unit  
+  val mk: value -> t
+  val dummy_min: t
+  val dummy_max: t
+
+  val value: t -> value
+
+  val compare: t -> t -> int
+  val hash: t -> int
+  val equal: t -> t -> bool
+end
+
+module Make(H : Hashtbl.HashedType) =
+struct
+  type t = int
+  type value = H.t
+
+  let cache    = Hashtbl.create 63
+  let values   = ref (Array.create 63 None)
+  let counter  = ref 0
+
+  let clear () =
+    Hashtbl.clear cache;
+    values := Array.create 63 None;
+    counter := 0
+
+  let mk x =
+    try Hashtbl.find cache x
+    with Not_found ->
+      let n = !counter in
+      incr counter;
+      Hashtbl.add cache x n;
+      if (n = Array.length !values) then
+	( 
+	  let new_values = Array.create (2 * Array.length !values) None in
+	  Array.blit !values 0 new_values 0 n;
+	  values := new_values
+	);
+      !values.(n) <- Some x;
+      n
+
+  let dummy_min = -1
+  let dummy_max = max_int
+
+  let value n = match !values.(n) with Some x -> x | None -> assert false
+
+  let compare (n1 : int) (n2 : int) = Pervasives.compare n1 n2
+  let hash n = n
+  let equal (n1 : int) (n2 : int) = n1 = n2
+end
+

misc/pool.mli

+module type T = 
+sig
+  type t  
+    (* Hashtbl.hash'able and Pervasives.compare'able type;
+       typically, t is an integer *)
+  type value
+    
+  val clear: unit -> unit  
+    (* Previously allocated symbols are no longer valid; no check
+       is provided. Registered values can be released by the GC only after
+       a call to clear. *)
+
+  val mk: value -> t
+  val dummy_min: t
+  val dummy_max: t
+    (* Two dummy symbols, not associated with any registered value;
+       resp. smallest and largest than any other symbol *)
+
+  val value: t -> value
+
+  val compare: t -> t -> int
+  val hash: t -> int
+  val equal: t -> t -> bool
+end
+
+module Make(H : Hashtbl.HashedType) : T with type value = H.t
+