pool.ml 1.11 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
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