File: extHashtbl.ml

package info (click to toggle)
extlib 1.7.7-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 632 kB
  • sloc: ml: 6,980; makefile: 128; sh: 42; ansic: 31
file content (166 lines) | stat: -rw-r--r-- 4,466 bytes parent folder | download
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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
(* 
 * ExtHashtbl, extra functions over hashtables.
 * Copyright (C) 2003 Nicolas Cannasse
 * 
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version,
 * with the special exception on linking described in file LICENSE.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 

module Hashtbl =
  struct

#if OCAML >= 400
  external old_hash_param :
    int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
#endif

  type ('a, 'b) h_bucketlist =
    | Empty
    | Cons of 'a * 'b * ('a, 'b) h_bucketlist

#if OCAML >= 400
  type ('a, 'b) h_t = {
    mutable size: int;
    mutable data: ('a, 'b) h_bucketlist array;
    mutable seed: int;
    initial_size: int;
  }
#else
  type ('a, 'b) h_t = {
    mutable size: int;
    mutable data: ('a, 'b) h_bucketlist array
  }
#endif

  include Hashtbl

#if OCAML < 400
  let create ?random:_ n = Hashtbl.create (* no seed *) n
#endif

  external h_conv : ('a, 'b) t -> ('a, 'b) h_t = "%identity"
  external h_make : ('a, 'b) h_t -> ('a, 'b) t = "%identity"

  let exists = mem

  let enum h =
    let rec make ipos ibuck idata icount =
      let pos = ref ipos in
      let buck = ref ibuck in
      let hdata = ref idata in
      let hcount = ref icount in
      let force() =
        (** this is a hack in order to keep an O(1) enum constructor **)
        if !hcount = -1 then begin
          hcount := (h_conv h).size;
          hdata := Array.copy (h_conv h).data;
        end;
      in
      let rec next() =
        force();
        match !buck with
        | Empty ->
          if !hcount = 0 then raise Enum.No_more_elements;
          incr pos;
          buck := Array.unsafe_get !hdata !pos;
          next()
        | Cons (k,i,next_buck) ->
          buck := next_buck;
          decr hcount;
          (k,i)
      in
      let count() =
        if !hcount = -1 then (h_conv h).size else !hcount
      in
      let clone() =
        force();
        make !pos !buck !hdata !hcount
      in
      Enum.make ~next ~count ~clone
    in
    make (-1) Empty (Obj.magic()) (-1)

  let keys h =
    Enum.map (fun (k,_) -> k) (enum h)

  let values h =
    Enum.map (fun (_,v) -> v) (enum h)

  let map f h =
    let rec loop = function
      | Empty -> Empty
      | Cons (k,v,next) -> Cons (k,f v,loop next)
    in
    h_make { (h_conv h) with
      data = Array.map loop (h_conv h).data; 
    }

#if OCAML >= 400
  (* copied from stdlib :( *)
  let key_index h key =
    (* compatibility with old hash tables *)
    if Obj.size (Obj.repr h) >= 3
    then (seeded_hash_param 10 100 (h_conv h).seed key) land (Array.length (h_conv h).data - 1)
    else (old_hash_param 10 100 key) mod (Array.length (h_conv h).data)
#else
  let key_index h key = (hash key) mod (Array.length (h_conv h).data)
#endif

  let remove_all h key =
    let hc = h_conv h in
    let rec loop = function
      | Empty -> Empty
      | Cons(k,v,next) ->
        if k = key then begin
          hc.size <- pred hc.size;
          loop next
        end else
          Cons(k,v,loop next)
    in
    let pos = key_index h key in
    Array.unsafe_set hc.data pos (loop (Array.unsafe_get hc.data pos))

  let find_default h key defval =
    let rec loop = function
      | Empty -> defval
      | Cons (k,v,next) ->
        if k = key then v else loop next
    in
    let pos = key_index h key in
    loop (Array.unsafe_get (h_conv h).data pos)

#if OCAML < 405
  let find_opt h key =
    let rec loop = function
      | Empty -> None
      | Cons (k,v,next) ->
        if k = key then Some v else loop next
    in
    let pos = key_index h key in
    loop (Array.unsafe_get (h_conv h).data pos)
#endif

  let find_option = find_opt

  let of_enum e =
    let h = create (if Enum.fast_count e then Enum.count e else 0) in
    Enum.iter (fun (k,v) -> add h k v) e;
    h

  let length h =
    (h_conv h).size

  end