Skip to content
This repository
Newer
Older
100644 100 lines (87 sloc) 2.894 kb
fccc6851 » MLstate
2011-06-21 Initial open-source release
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 type ('a,'b) t = ('a,'b) Hashtbl.t
19 let create = Hashtbl.create
20 let clear = Hashtbl.clear
21 let add = Hashtbl.add
22 let copy = Hashtbl.copy
23 let find = Hashtbl.find
24 let find_all = Hashtbl.find_all
25 let mem = Hashtbl.mem
26 let remove = Hashtbl.remove
27 let replace = Hashtbl.replace
28 let iter = Hashtbl.iter
29 let fold = Hashtbl.fold
30 let length = Hashtbl.length
31 let hash = Hashtbl.hash
32 external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
33 module type HashedType = Hashtbl.HashedType
34
35 (* could be done (with magic) more efficiently
36 * by just assigning the two fields of the hashtbls
37 * But then, we become dependent on the stdlib and if it changes,
38 * since not everybody uses the same version of ocaml, it won't be
39 * possible *)
40 let replace_content h1 h2 =
41 clear h1;
42 iter (fun k v -> add h1 k v) h2
43
44 let find_opt h v =
45 try Some (find h v) with Not_found -> None
46
47 module type S =
48 sig
49 include Hashtbl.S
50 val replace_content :'a t -> 'a t -> unit
51 val find_opt : 'a t -> key -> 'a option
52 end
53
54 module Make(H:HashedType) : S with type key = H.t =
55 struct
56 include Hashtbl.Make(H)
57 let replace_content h1 h2 =
58 clear h1;
59 iter (fun k v -> add h1 k v) h2
60
61 let find_opt h v =
62 try Some (find h v) with Not_found -> None
63 end
64
65 let combine a b = a * 19 + b
66
67 (*
68 To extending the interface with function needing to access the implementation
69 of the type [t], we use dark magie.
70 This MUST be exactly the same type than [Hashtbl.t]
71 *)
72 type ('a, 'b) public_t = {
73 mutable size: int ;
74 mutable data: ('a, 'b) public_bucketlist array ;
75 }
76 and ('a, 'b) public_bucketlist =
77 | Empty
78 | Cons of 'a * 'b * ('a, 'b) public_bucketlist
79
80 external public_of_t : ('a, 'b) t -> ('a, 'b) public_t = "%identity"
81 external t_of_public : ('a, 'b) public_t -> ('a, 'b) t = "%identity"
82
83 let pick_remove t =
84 let t = public_of_t t in
85 let size = t.size in
86 if size <> 0
87 then (
88 let data = t.data in
89 let length = Array.length data in
90 let rec aux index =
91 if index = length then () else (
92 match Array.unsafe_get data index with
93 | Empty -> aux (succ index)
94 | Cons (_, _, bucket) ->
95 Array.unsafe_set data index bucket ;
96 t.size <- pred size ;
97 )
98 in
99 aux 0 ;
100 )
Something went wrong with that request. Please try again.