← Back to branch summary

~ubuntu-branches/ubuntu/trusty/ocamlnet/trusty

« back to all changes in this revision

Viewing changes to src/netmulticore/netmcore_hashtbl.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-09-02 14:12:33 UTC
  • mfrom: (18.2.3 sid)
  • Revision ID: james.westby@ubuntu.com-20110902141233-zbj0ygxb92u6gy4z
Tags: 3.4-1
http://bugs.debian.org/637147
* New upstream release
  - add a new NetcgiRequire directive to ease dependency management
    (Closes: #637147)
  - remove patches that were applied upstream:
    + Added-missing-shebang-lines-in-example-shell-scripts
    + Try-also-ocamlc-for-POSIX-threads

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/netmulticore/netmcore_hashtbl.ml
 
1
(* $Id: netmcore_hashtbl.ml 1574 2011-04-10 15:13:54Z gerd $ *)
 
2
 
 
3
(* Parts of the implementation are taken over from hashtbl.ml of the
 
4
   O'Caml distribution
 
5
 *)
 
6
 
 
7
module H = Netmcore_heap
 
8
 
 
9
type ('a, 'b, 'h) tbl =
 
10
  { mutable size: int;                        (* number of elements *)
 
11
    mutable data: ('a, 'b) bucketlist array;  (* the buckets *)
 
12
    header : 'h;
 
13
  }
 
14
 
 
15
and ('a, 'b) bucketlist =
 
16
    Empty
 
17
  | Cons of ('a, 'b) bucketcell
 
18
 
 
19
and ('a, 'b) bucketcell =
 
20
    { mutable key : 'a;
 
21
      mutable value : 'b;
 
22
      mutable tail : ('a, 'b) bucketlist
 
23
    }
 
24
 
 
25
type ('a, 'b, 'h) t = ('a, 'b, 'h) tbl H.heap
 
26
 
 
27
type ('a, 'b, 'h) t_descr = ('a, 'b, 'h) tbl H.descr
 
28
  
 
29
let descr_of_hashtbl = H.descr_of_heap
 
30
let hashtbl_of_descr = H.heap_of_descr
 
31
 
 
32
let create pool h =
 
33
  let tbl =
 
34
    { size = 0;
 
35
      data = Array.make 391 Empty;
 
36
      header = h
 
37
    } in
 
38
  H.create_heap
 
39
    pool
 
40
    (H.minimum_size tbl)
 
41
    tbl
 
42
 
 
43
let clear t =
 
44
  H.modify t
 
45
    (fun mut ->
 
46
       let tbl = H.root t in
 
47
       tbl.size <- 0;
 
48
       Array.fill tbl.data 0 (Array.length tbl.data) Empty
 
49
    )
 
50
 
 
51
let length t =
 
52
  (H.root t).size
 
53
 
 
54
let resize mut tbl =
 
55
  let odata = tbl.data in
 
56
  let osize = Array.length odata in
 
57
  let nsize = min (2 * osize + 1) Sys.max_array_length in
 
58
  if nsize <> osize then (
 
59
    let ndata = H.add mut (Array.create nsize Empty) in
 
60
    H.pin mut ndata;
 
61
    let rec insert_bucket bucket = 
 
62
      match bucket with
 
63
        | Empty -> ()
 
64
        | Cons cell ->
 
65
            insert_bucket cell.tail; (* preserve original order of elements *)
 
66
            let nidx = (Hashtbl.hash cell.key) mod nsize in
 
67
            let prev = ndata.(nidx) in
 
68
            ndata.(nidx) <- bucket;
 
69
            cell.tail <- prev;
 
70
    in
 
71
    for i = 0 to osize - 1 do
 
72
      insert_bucket odata.(i)
 
73
    done;
 
74
    tbl.data <- ndata;
 
75
  )
 
76
 
 
77
let add_1 tbl mut key value =
 
78
  let i = (Hashtbl.hash key) mod (Array.length tbl.data) in
 
79
  let cell_orig = { key = key; value = value; tail = Empty } in
 
80
  let elem = H.add mut (Cons cell_orig) in
 
81
  let cell = match elem with Cons c -> c | _ -> assert false in
 
82
  cell.tail <- tbl.data.(i);
 
83
  tbl.data.(i) <- elem;
 
84
  tbl.size <- succ tbl.size;
 
85
  if tbl.size > Array.length tbl.data lsl 1 then resize mut tbl
 
86
    
 
87
let add t key value =
 
88
  H.modify t
 
89
    (fun mut ->
 
90
       let tbl = H.root t in
 
91
       add_1 tbl mut key value
 
92
    )
 
93
 
 
94
let remove t key =
 
95
  H.modify t
 
96
    (fun mut ->
 
97
       let tbl = H.root t in
 
98
       let i = (Hashtbl.hash key) mod (Array.length tbl.data) in
 
99
       let prev = ref None in
 
100
       let cur = ref tbl.data.(i) in
 
101
       while !cur <> Empty do
 
102
         match !cur with
 
103
           | Cons cell ->
 
104
               if compare cell.key key = 0 then (
 
105
                 ( match !prev with
 
106
                     | None ->
 
107
                         tbl.data.(i) <- cell.tail
 
108
                     | Some pcell ->
 
109
                         pcell.tail <- cell.tail
 
110
                 );
 
111
                 tbl.size <- pred tbl.size;
 
112
                 cur := Empty
 
113
               )
 
114
               else (
 
115
                 prev := Some cell;
 
116
                 cur := cell.tail;
 
117
               )
 
118
           | Empty -> assert false
 
119
       done;
 
120
    )
 
121
 
 
122
let rec find_rec key = function
 
123
  | Empty ->
 
124
      raise Not_found
 
125
  | Cons cell ->
 
126
      if compare cell.key key = 0 then cell.value else find_rec key cell.tail
 
127
 
 
128
let find_quickly tbl key =
 
129
  match tbl.data.((Hashtbl.hash key) mod (Array.length tbl.data)) with
 
130
      Empty -> raise Not_found
 
131
    | Cons cell1 ->
 
132
        if compare key cell1.key = 0 then cell1.value else
 
133
          match cell1.tail with
 
134
              Empty -> raise Not_found
 
135
            | Cons cell2 ->
 
136
                if compare key cell2.key = 0 then cell2.value else
 
137
                  match cell2.tail with
 
138
                      Empty -> raise Not_found
 
139
                    | Cons cell3 ->
 
140
                        if compare key cell3.key = 0 then cell3.value else
 
141
                          find_rec key cell3.tail
 
142
 
 
143
 
 
144
let find_ro t key =
 
145
  (* unprotected version! *)
 
146
  find_quickly (H.root t) key
 
147
 
 
148
let find_p t key f =
 
149
  H.with_value
 
150
    t
 
151
    (fun () ->
 
152
       find_quickly (H.root t) key
 
153
    )
 
154
    f
 
155
 
 
156
let find_c t key =
 
157
  find_p t key H.copy
 
158
 
 
159
let rec find_in_bucket key = function
 
160
  | Empty ->
 
161
      []
 
162
  | Cons cell ->
 
163
      if compare cell.key key = 0
 
164
      then cell.value :: find_in_bucket key cell.tail
 
165
      else find_in_bucket key cell.tail
 
166
 
 
167
let find_all_ro t key =
 
168
  let tbl = H.root t in
 
169
  find_in_bucket 
 
170
    key 
 
171
    tbl.data.((Hashtbl.hash key) mod (Array.length tbl.data))
 
172
 
 
173
let find_all_p t key f =
 
174
  let tbl = H.root t in
 
175
  H.with_value_n
 
176
    t
 
177
    (fun () ->
 
178
       find_in_bucket 
 
179
         key 
 
180
         tbl.data.((Hashtbl.hash key) mod (Array.length tbl.data))
 
181
    )
 
182
    f
 
183
 
 
184
let find_all_c t key =
 
185
  find_all_p t key H.copy
 
186
 
 
187
let replace t key value =
 
188
  H.modify t
 
189
    (fun mut ->
 
190
       let tbl = H.root t in
 
191
 
 
192
       let rec replace_bucket = function
 
193
         | Empty -> raise Not_found
 
194
         | Cons cell ->
 
195
             if compare cell.key key = 0 then
 
196
               cell.value <- H.add mut value
 
197
             else
 
198
               replace_bucket cell.tail in
 
199
 
 
200
       let i = (Hashtbl.hash key) mod (Array.length tbl.data) in
 
201
       try
 
202
         replace_bucket tbl.data.(i)
 
203
       with
 
204
         | Not_found ->
 
205
             add_1 tbl mut key value
 
206
    )
 
207
 
 
208
let mem_ro t key =
 
209
  try ignore(find_ro t key); true with Not_found -> false
 
210
 
 
211
let mem t key =
 
212
  H.with_value t
 
213
    (fun () ->
 
214
       mem_ro t key
 
215
    )
 
216
    (fun r -> r)
 
217
 
 
218
let iter f t =
 
219
  H.with_value t
 
220
    (fun () ->
 
221
       let rec do_bucket = function
 
222
         | Empty -> ()
 
223
         | Cons cell ->
 
224
             f cell.key cell.value; do_bucket cell.tail in
 
225
       let tbl = H.root t in
 
226
       let d = tbl.data in
 
227
       for i = 0 to Array.length d - 1 do
 
228
         do_bucket d.(i)
 
229
       done
 
230
    )
 
231
    (fun () -> ())
 
232
 
 
233
let header t =
 
234
  (H.root t).header
 
235
 
 
236
let heap t =
 
237
  Obj.magic t
 
238
 
 
239