bundles/extlib/extlib-1.5.2/extHashtbl.ml

   1 (*
   2  * ExtHashtbl, extra functions over hashtables.
   3  * Copyright (C) 2003 Nicolas Cannasse
   4  *
   5  * This library is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU Lesser General Public
   7  * License as published by the Free Software Foundation; either
   8  * version 2.1 of the License, or (at your option) any later version,
   9  * with the special exception on linking described in file LICENSE.
  10  *
  11  * This library is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14  * Lesser General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU Lesser General Public
  17  * License along with this library; if not, write to the Free Software
  18  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19  *)
  20
  21
  22 module Hashtbl =
  23   struct
  24
  25         type ('a, 'b) h_bucketlist =
  26                 | Empty
  27                 | Cons of 'a * 'b * ('a, 'b) h_bucketlist
  28
  29         type ('a, 'b) h_t = {
  30                 mutable size: int;
  31                 mutable data: ('a, 'b) h_bucketlist array
  32         }
  33
  34         include Hashtbl
  35
  36         external h_conv : ('a, 'b) t -> ('a, 'b) h_t = "%identity"
  37         external h_make : ('a, 'b) h_t -> ('a, 'b) t = "%identity"
  38
  39         let exists = mem
  40
  41         let enum h =
  42                 let rec make ipos ibuck idata icount =
  43                         let pos = ref ipos in
  44                         let buck = ref ibuck in
  45                         let hdata = ref idata in
  46                         let hcount = ref icount in
  47                         let force() =
  48                                 (** this is a hack in order to keep an O(1) enum constructor **)
  49                                 if !hcount = -1 then begin
  50                                         hcount := (h_conv h).size;
  51                                         hdata := Array.copy (h_conv h).data;
  52                                 end;
  53                         in
  54                         let rec next() =
  55                                 force();
  56                                 match !buck with
  57                                 | Empty ->
  58                                         if !hcount = 0 then raise Enum.No_more_elements;
  59                                         incr pos;
  60                                         buck := Array.unsafe_get !hdata !pos;
  61                                         next()
  62                                 | Cons (k,i,next_buck) ->
  63                                         buck := next_buck;
  64                                         decr hcount;
  65                                         (k,i)
  66                         in
  67                         let count() =
  68                                 if !hcount = -1 then (h_conv h).size else !hcount
  69                         in
  70                         let clone() =
  71                                 force();
  72                                 make !pos !buck !hdata !hcount
  73                         in
  74                         Enum.make ~next ~count ~clone
  75                 in
  76                 make (-1) Empty (Obj.magic()) (-1)
  77
  78         let keys h =
  79                 Enum.map (fun (k,_) -> k) (enum h)
  80
  81         let values h =
  82                 Enum.map (fun (_,v) -> v) (enum h)
  83
  84         let map f h =
  85                 let rec loop = function
  86                         | Empty -> Empty
  87                         | Cons (k,v,next) -> Cons (k,f v,loop next)
  88                 in
  89                 h_make {
  90                         size = (h_conv h).size;
  91                         data = Array.map loop (h_conv h).data;
  92                 }
  93
  94         let remove_all h key =
  95                 let hc = h_conv h in
  96                 let rec loop = function
  97                         | Empty -> Empty
  98                         | Cons(k,v,next) ->
  99                                 if k = key then begin
 100                                         hc.size <- pred hc.size;
 101                                         loop next
 102                                 end else
 103                                         Cons(k,v,loop next)
 104                 in
 105                 let pos = (hash key) mod (Array.length hc.data) in
 106                 Array.unsafe_set hc.data pos (loop (Array.unsafe_get hc.data pos))
 107
 108         let find_default h key defval =
 109                 let rec loop = function
 110                         | Empty -> defval
 111                         | Cons (k,v,next) ->
 112                                 if k = key then v else loop next
 113                 in
 114                 let pos = (hash key) mod (Array.length (h_conv h).data) in
 115                 loop (Array.unsafe_get (h_conv h).data pos)
 116
 117         let find_option h key =
 118                 let rec loop = function
 119                         | Empty -> None
 120                         | Cons (k,v,next) ->
 121                                 if k = key then Some v else loop next
 122                 in
 123                 let pos = (hash key) mod (Array.length (h_conv h).data) in
 124                 loop (Array.unsafe_get (h_conv h).data pos)
 125
 126         let of_enum e =
 127                 let h = create (if Enum.fast_count e then Enum.count e else 0) in
 128                 Enum.iter (fun (k,v) -> add h k v) e;
 129                 h
 130
 131         let length h =
 132                 (h_conv h).size
 133
 134   end