l4/pkg/ocaml/ocaml/contrib/stdlib/hashtbl.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the GNU Library General Public License, with    *)
  10 (*  the special exception on linking described in file ../LICENSE.     *)
  11 (*                                                                     *)
  12 (***********************************************************************)
  13
  14 (* $Id: hashtbl.ml 7164 2005-10-25 18:34:07Z doligez $ *)
  15
  16 (* Hash tables *)
  17
  18 external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
  19
  20 let hash x = hash_param 10 100 x
  21
  22 (* We do dynamic hashing, and resize the table and rehash the elements
  23    when buckets become too long. *)
  24
  25 type ('a, 'b) t =
  26   { mutable size: int;                        (* number of elements *)
  27     mutable data: ('a, 'b) bucketlist array } (* the buckets *)
  28
  29 and ('a, 'b) bucketlist =
  30     Empty
  31   | Cons of 'a * 'b * ('a, 'b) bucketlist
  32
  33 let create initial_size =
  34   let s = min (max 1 initial_size) Sys.max_array_length in
  35   { size = 0; data = Array.make s Empty }
  36
  37 let clear h =
  38   for i = 0 to Array.length h.data - 1 do
  39     h.data.(i) <- Empty
  40   done;
  41   h.size <- 0
  42
  43 let copy h =
  44   { size = h.size;
  45     data = Array.copy h.data }
  46
  47 let length h = h.size
  48
  49 let resize hashfun tbl =
  50   let odata = tbl.data in
  51   let osize = Array.length odata in
  52   let nsize = min (2 * osize + 1) Sys.max_array_length in
  53   if nsize <> osize then begin
  54     let ndata = Array.create nsize Empty in
  55     let rec insert_bucket = function
  56         Empty -> ()
  57       | Cons(key, data, rest) ->
  58           insert_bucket rest; (* preserve original order of elements *)
  59           let nidx = (hashfun key) mod nsize in
  60           ndata.(nidx) <- Cons(key, data, ndata.(nidx)) in
  61     for i = 0 to osize - 1 do
  62       insert_bucket odata.(i)
  63     done;
  64     tbl.data <- ndata;
  65   end
  66
  67 let add h key info =
  68   let i = (hash key) mod (Array.length h.data) in
  69   let bucket = Cons(key, info, h.data.(i)) in
  70   h.data.(i) <- bucket;
  71   h.size <- succ h.size;
  72   if h.size > Array.length h.data lsl 1 then resize hash h
  73
  74 let remove h key =
  75   let rec remove_bucket = function
  76       Empty ->
  77         Empty
  78     | Cons(k, i, next) ->
  79         if compare k key = 0
  80         then begin h.size <- pred h.size; next end
  81         else Cons(k, i, remove_bucket next) in
  82   let i = (hash key) mod (Array.length h.data) in
  83   h.data.(i) <- remove_bucket h.data.(i)
  84
  85 let rec find_rec key = function
  86     Empty ->
  87       raise Not_found
  88   | Cons(k, d, rest) ->
  89       if compare key k = 0 then d else find_rec key rest
  90
  91 let find h key =
  92   match h.data.((hash key) mod (Array.length h.data)) with
  93     Empty -> raise Not_found
  94   | Cons(k1, d1, rest1) ->
  95       if compare key k1 = 0 then d1 else
  96       match rest1 with
  97         Empty -> raise Not_found
  98       | Cons(k2, d2, rest2) ->
  99           if compare key k2 = 0 then d2 else
 100           match rest2 with
 101             Empty -> raise Not_found
 102           | Cons(k3, d3, rest3) ->
 103               if compare key k3 = 0 then d3 else find_rec key rest3
 104
 105 let find_all h key =
 106   let rec find_in_bucket = function
 107     Empty ->
 108       []
 109   | Cons(k, d, rest) ->
 110       if compare k key = 0
 111       then d :: find_in_bucket rest
 112       else find_in_bucket rest in
 113   find_in_bucket h.data.((hash key) mod (Array.length h.data))
 114
 115 let replace h key info =
 116   let rec replace_bucket = function
 117       Empty ->
 118         raise Not_found
 119     | Cons(k, i, next) ->
 120         if compare k key = 0
 121         then Cons(k, info, next)
 122         else Cons(k, i, replace_bucket next) in
 123   let i = (hash key) mod (Array.length h.data) in
 124   let l = h.data.(i) in
 125   try
 126     h.data.(i) <- replace_bucket l
 127   with Not_found ->
 128     h.data.(i) <- Cons(key, info, l);
 129     h.size <- succ h.size;
 130     if h.size > Array.length h.data lsl 1 then resize hash h
 131
 132 let mem h key =
 133   let rec mem_in_bucket = function
 134   | Empty ->
 135       false
 136   | Cons(k, d, rest) ->
 137       compare k key = 0 || mem_in_bucket rest in
 138   mem_in_bucket h.data.((hash key) mod (Array.length h.data))
 139
 140 let iter f h =
 141   let rec do_bucket = function
 142       Empty ->
 143         ()
 144     | Cons(k, d, rest) ->
 145         f k d; do_bucket rest in
 146   let d = h.data in
 147   for i = 0 to Array.length d - 1 do
 148     do_bucket d.(i)
 149   done
 150
 151 let fold f h init =
 152   let rec do_bucket b accu =
 153     match b with
 154       Empty ->
 155         accu
 156     | Cons(k, d, rest) ->
 157         do_bucket rest (f k d accu) in
 158   let d = h.data in
 159   let accu = ref init in
 160   for i = 0 to Array.length d - 1 do
 161     accu := do_bucket d.(i) !accu
 162   done;
 163   !accu
 164
 165 (* Functorial interface *)
 166
 167 module type HashedType =
 168   sig
 169     type t
 170     val equal: t -> t -> bool
 171     val hash: t -> int
 172   end
 173
 174 module type S =
 175   sig
 176     type key
 177     type 'a t
 178     val create: int -> 'a t
 179     val clear: 'a t -> unit
 180     val copy: 'a t -> 'a t
 181     val add: 'a t -> key -> 'a -> unit
 182     val remove: 'a t -> key -> unit
 183     val find: 'a t -> key -> 'a
 184     val find_all: 'a t -> key -> 'a list
 185     val replace : 'a t -> key -> 'a -> unit
 186     val mem : 'a t -> key -> bool
 187     val iter: (key -> 'a -> unit) -> 'a t -> unit
 188     val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
 189     val length: 'a t -> int
 190   end
 191
 192 module Make(H: HashedType): (S with type key = H.t) =
 193   struct
 194     type key = H.t
 195     type 'a hashtbl = (key, 'a) t
 196     type 'a t = 'a hashtbl
 197     let create = create
 198     let clear = clear
 199     let copy = copy
 200
 201     let safehash key = (H.hash key) land max_int
 202
 203     let add h key info =
 204       let i = (safehash key) mod (Array.length h.data) in
 205       let bucket = Cons(key, info, h.data.(i)) in
 206       h.data.(i) <- bucket;
 207       h.size <- succ h.size;
 208       if h.size > Array.length h.data lsl 1 then resize safehash h
 209
 210     let remove h key =
 211       let rec remove_bucket = function
 212           Empty ->
 213             Empty
 214         | Cons(k, i, next) ->
 215             if H.equal k key
 216             then begin h.size <- pred h.size; next end
 217             else Cons(k, i, remove_bucket next) in
 218       let i = (safehash key) mod (Array.length h.data) in
 219       h.data.(i) <- remove_bucket h.data.(i)
 220
 221     let rec find_rec key = function
 222         Empty ->
 223           raise Not_found
 224       | Cons(k, d, rest) ->
 225           if H.equal key k then d else find_rec key rest
 226
 227     let find h key =
 228       match h.data.((safehash key) mod (Array.length h.data)) with
 229         Empty -> raise Not_found
 230       | Cons(k1, d1, rest1) ->
 231           if H.equal key k1 then d1 else
 232           match rest1 with
 233             Empty -> raise Not_found
 234           | Cons(k2, d2, rest2) ->
 235               if H.equal key k2 then d2 else
 236               match rest2 with
 237                 Empty -> raise Not_found
 238               | Cons(k3, d3, rest3) ->
 239                   if H.equal key k3 then d3 else find_rec key rest3
 240
 241     let find_all h key =
 242       let rec find_in_bucket = function
 243         Empty ->
 244           []
 245       | Cons(k, d, rest) ->
 246           if H.equal k key
 247           then d :: find_in_bucket rest
 248           else find_in_bucket rest in
 249       find_in_bucket h.data.((safehash key) mod (Array.length h.data))
 250
 251     let replace h key info =
 252       let rec replace_bucket = function
 253           Empty ->
 254             raise Not_found
 255         | Cons(k, i, next) ->
 256             if H.equal k key
 257             then Cons(k, info, next)
 258             else Cons(k, i, replace_bucket next) in
 259       let i = (safehash key) mod (Array.length h.data) in
 260       let l = h.data.(i) in
 261       try
 262         h.data.(i) <- replace_bucket l
 263       with Not_found ->
 264         h.data.(i) <- Cons(key, info, l);
 265         h.size <- succ h.size;
 266         if h.size > Array.length h.data lsl 1 then resize safehash h
 267
 268     let mem h key =
 269       let rec mem_in_bucket = function
 270       | Empty ->
 271           false
 272       | Cons(k, d, rest) ->
 273           H.equal k key || mem_in_bucket rest in
 274       mem_in_bucket h.data.((safehash key) mod (Array.length h.data))
 275
 276     let iter = iter
 277     let fold = fold
 278     let length = length
 279   end