src/utils/cdk/hashtbl2.ml

   1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19
  20 open Hashtbl
  21
  22 (*
  23 (* Hash tables *)
  24
  25 external hash_param : int -> int -> 'a -> int = "hash_univ_param" "noalloc"
  26
  27 let hash x = hash_param 10 100 x
  28
  29 (* We do dynamic hashing, and resize the table and rehash the elements
  30    when buckets become too long. *)
  31
  32 type ('a, 'b) t =
  33   { mutable max_len: int;                     (* max length of a bucket *)
  34     mutable data: ('a, 'b) bucketlist array } (* the buckets *)
  35
  36 and ('a, 'b) bucketlist =
  37     Empty
  38   | Cons of 'a * 'b * ('a, 'b) bucketlist
  39
  40 let create initial_size =
  41   let s = if initial_size < 1 then 1 else initial_size in
  42   let s = if s > Sys.max_array_length then Sys.max_array_length else s in
  43   { max_len = 3; data = Array.make s Empty }
  44
  45 let clear h =
  46   for i = 0 to Array.length h.data - 1 do
  47     h.data.(i) <- Empty
  48   done
  49
  50 let resize hashfun tbl =
  51   let odata = tbl.data in
  52   let osize = Array.length odata in
  53   let nsize = min (2 * osize + 1) Sys.max_array_length in
  54   if nsize <> osize then begin
  55     let ndata = Array.make nsize Empty in
  56     let rec insert_bucket = function
  57         Empty -> ()
  58       | Cons(key, data, rest) ->
  59           insert_bucket rest; (* preserve original order of elements *)
  60           let nidx = (hashfun key) mod nsize in
  61           ndata.(nidx) <- Cons(key, data, ndata.(nidx)) in
  62     for i = 0 to osize - 1 do
  63       insert_bucket odata.(i)
  64     done;
  65     tbl.data <- ndata;
  66   end;
  67   tbl.max_len <- 2 * tbl.max_len
  68
  69 let rec bucket_too_long n bucket =
  70   if n < 0 then true else
  71     match bucket with
  72       Empty -> false
  73     | Cons(_,_,rest) -> bucket_too_long (n - 1) rest
  74
  75 let add h key info =
  76   let i = (hash key) mod (Array.length h.data) in
  77   let bucket = Cons(key, info, h.data.(i)) in
  78   h.data.(i) <- bucket;
  79   if bucket_too_long h.max_len bucket then resize hash h
  80
  81 let remove h key =
  82   let rec remove_bucket = function
  83       Empty ->
  84         Empty
  85     | Cons(k, i, next) ->
  86         if k = key then next else Cons(k, i, remove_bucket next) in
  87   let i = (hash key) mod (Array.length h.data) in
  88   h.data.(i) <- remove_bucket h.data.(i)
  89
  90 let rec find_rec key = function
  91     Empty ->
  92       raise Not_found
  93   | Cons(k, d, rest) ->
  94       if key = k then d else find_rec key rest
  95
  96 let find h key =
  97   match h.data.((hash key) mod (Array.length h.data)) with
  98     Empty -> raise Not_found
  99   | Cons(k1, d1, rest1) ->
 100       if key = k1 then d1 else
 101       match rest1 with
 102         Empty -> raise Not_found
 103       | Cons(k2, d2, rest2) ->
 104           if key = k2 then d2 else
 105           match rest2 with
 106             Empty -> raise Not_found
 107           | Cons(k3, d3, rest3) ->
 108               if key = k3 then d3 else find_rec key rest3
 109
 110 let find_all h key =
 111   let rec find_in_bucket = function
 112     Empty ->
 113       []
 114   | Cons(k, d, rest) ->
 115       if k = key then d :: find_in_bucket rest else find_in_bucket rest in
 116   find_in_bucket h.data.((hash key) mod (Array.length h.data))
 117
 118 let replace h key info =
 119   let rec replace_bucket = function
 120       Empty ->
 121         raise Not_found
 122     | Cons(k, i, next) ->
 123         if k = key
 124         then Cons(k, info, next)
 125         else Cons(k, i, replace_bucket next) in
 126   let i = (hash key) mod (Array.length h.data) in
 127   let l = h.data.(i) in
 128   try
 129     h.data.(i) <- replace_bucket l
 130   with Not_found ->
 131     h.data.(i) <- Cons(key, info, l)
 132
 133 let mem h key =
 134   let rec mem_in_bucket = function
 135   | Empty ->
 136       false
 137   | Cons(k, d, rest) ->
 138       k = key || mem_in_bucket rest in
 139   mem_in_bucket h.data.((hash key) mod (Array.length h.data))
 140
 141 let iter f h =
 142   let rec do_bucket = function
 143       Empty ->
 144         ()
 145     | Cons(k, d, rest) ->
 146         f k d; do_bucket rest in
 147   let d = h.data in
 148   for i = 0 to Array.length d - 1 do
 149     do_bucket d.(i)
 150   done
 151
 152 let fold f h init =
 153   let rec do_bucket b accu =
 154     match b with
 155       Empty ->
 156         accu
 157     | Cons(k, d, rest) ->
 158         do_bucket rest (f k d accu) in
 159   let d = h.data in
 160   let accu = ref init in
 161   for i = 0 to Array.length d - 1 do
 162     accu := do_bucket d.(i) !accu
 163   done;
 164   !accu
 165
 166 (* Functorial interface *)
 167
 168 module type HashedType =
 169   sig
 170     type t
 171     val equal: t -> t -> bool
 172     val hash: t -> int
 173   end
 174
 175 module type S =
 176   sig
 177     type key
 178     type 'a t
 179     val create: int -> 'a t
 180     val clear: 'a t -> unit
 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   end
 190
 191 module Make(H: HashedType): (S with type key = H.t) =
 192   struct
 193     type key = H.t
 194     type 'a hashtbl = (key, 'a) t
 195     type 'a t = 'a hashtbl
 196     let create = create
 197     let clear = clear
 198
 199     let add h key info =
 200       let i = (H.hash key) mod (Array.length h.data) in
 201       let bucket = Cons(key, info, h.data.(i)) in
 202       h.data.(i) <- bucket;
 203       if bucket_too_long h.max_len bucket then resize H.hash h
 204
 205     let remove h key =
 206       let rec remove_bucket = function
 207           Empty ->
 208             Empty
 209         | Cons(k, i, next) ->
 210             if H.equal k key
 211             then next
 212             else Cons(k, i, remove_bucket next) in
 213       let i = (H.hash key) mod (Array.length h.data) in
 214       h.data.(i) <- remove_bucket h.data.(i)
 215
 216     let rec find_rec key = function
 217         Empty ->
 218           raise Not_found
 219       | Cons(k, d, rest) ->
 220           if H.equal key k then d else find_rec key rest
 221
 222     let find h key =
 223       match h.data.((H.hash key) mod (Array.length h.data)) with
 224         Empty -> raise Not_found
 225       | Cons(k1, d1, rest1) ->
 226           if H.equal key k1 then d1 else
 227           match rest1 with
 228             Empty -> raise Not_found
 229           | Cons(k2, d2, rest2) ->
 230               if H.equal key k2 then d2 else
 231               match rest2 with
 232                 Empty -> raise Not_found
 233               | Cons(k3, d3, rest3) ->
 234                   if H.equal key k3 then d3 else find_rec key rest3
 235
 236     let find_all h key =
 237       let rec find_in_bucket = function
 238         Empty ->
 239           []
 240       | Cons(k, d, rest) ->
 241           if H.equal k key
 242           then d :: find_in_bucket rest
 243           else find_in_bucket rest in
 244       find_in_bucket h.data.((H.hash key) mod (Array.length h.data))
 245
 246     let replace h key info =
 247       let rec replace_bucket = function
 248           Empty ->
 249             raise Not_found
 250         | Cons(k, i, next) ->
 251             if H.equal k key
 252             then Cons(k, info, next)
 253             else Cons(k, i, replace_bucket next) in
 254       let i = (H.hash key) mod (Array.length h.data) in
 255       let l = h.data.(i) in
 256       try
 257         h.data.(i) <- replace_bucket l
 258       with Not_found ->
 259         h.data.(i) <- Cons(key, info, l)
 260
 261     let mem h key =
 262       let rec mem_in_bucket = function
 263       | Empty ->
 264           false
 265       | Cons(k, d, rest) ->
 266           H.equal k key || mem_in_bucket rest in
 267       mem_in_bucket h.data.((H.hash key) mod (Array.length h.data))
 268
 269     let iter = iter
 270     let fold = fold
 271   end
 272   *)
 273
 274 let to_list h =
 275   let list = ref [] in
 276   iter (fun _ s -> list := s :: !list) h;
 277   !list
 278
 279 let to_list2 h =
 280   let list = ref [] in
 281   iter (fun k s -> list := (k,s) :: !list) h;
 282   !list
 283
 284 let safe_iter f h =
 285   List.iter (fun x -> f x) (to_list h)
 286
 287