pool.ml 1.05 KB
Newer Older
1 2
module type T = 
sig
3
  include Custom.T
4 5 6 7 8 9 10 11 12 13 14 15
  type value
    
  val clear: unit -> unit  
  val mk: value -> t
  val dummy_min: t
  val dummy_max: t

  val value: t -> value
end

module Make(H : Hashtbl.HashedType) =
struct
16
  include Custom.Int
17 18
  type value = H.t

19 20 21
  module Tbl = Hashtbl.Make(H)

  let cache    = State.ref "Pool.cache" (Tbl.create 63)
22 23
  let values   = State.ref "Pool.values" (Array.create 63 None)
  let counter  = State.ref "Pool.counter" 0
24
  let check x = assert (!values.(x) <> None)
25 26

  let clear () =
27
    Tbl.clear !cache;
28 29 30 31
    values := Array.create 63 None;
    counter := 0

  let mk x =
32
    try Tbl.find !cache x
33 34 35
    with Not_found ->
      let n = !counter in
      incr counter;
36
      Tbl.add !cache x n;
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
      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
end