Source file CCMixtbl.ml

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
167
168
169
170

(* This file is free software, part of containers. See file "license" for more details. *)

(** {1 Hash Table with Heterogeneous Keys} *)

(*$inject
  open CCFun

*)

type 'b injection = {
  get : (unit -> unit) -> 'b option;
  set : 'b -> (unit -> unit);
}

(*$R
  let inj_int = create_inj () in
  let tbl = create 10 in
  OUnit.assert_equal None (get ~inj:inj_int tbl "a");
  set ~inj:inj_int tbl "a" 1;
  OUnit.assert_equal (Some 1) (get ~inj:inj_int tbl "a");
  let inj_string = create_inj () in
  set ~inj:inj_string tbl "b" "Hello";
  OUnit.assert_equal (Some "Hello") (get ~inj:inj_string tbl "b");
  OUnit.assert_equal None (get ~inj:inj_string tbl "a");
  OUnit.assert_equal (Some 1) (get ~inj:inj_int tbl "a");
  set ~inj:inj_string tbl "a" "Bye";
  OUnit.assert_equal None (get ~inj:inj_int tbl "a");
  OUnit.assert_equal (Some "Bye") (get ~inj:inj_string tbl "a");
*)

type 'a t = ('a, unit -> unit) Hashtbl.t

let create n = Hashtbl.create n

let create_inj () =
  let r = ref None in
  let get f =
    r := None;
    f ();
    !r
  and set v =
    (fun () -> r := Some v)
  in
  {get;set}

let get ~inj tbl x =
  try inj.get (Hashtbl.find tbl x)
  with Not_found -> None

let set ~inj tbl x y =
  Hashtbl.replace tbl x (inj.set y)

let length tbl = Hashtbl.length tbl

(*$R
  let inj_int = create_inj () in
  let tbl = create 5 in
  set ~inj:inj_int tbl "foo" 1;
  set ~inj:inj_int tbl "bar" 2;
  OUnit.assert_equal 2 (length tbl);
  OUnit.assert_equal 2 (find ~inj:inj_int tbl "bar");
  set ~inj:inj_int tbl "foo" 42;
  OUnit.assert_equal 2 (length tbl);
  remove tbl "bar";
  OUnit.assert_equal 1 (length tbl);
*)

let clear tbl = Hashtbl.clear tbl

(*$R
  let inj_int = create_inj () in
  let inj_str = create_inj () in
  let tbl = create 5 in
  set ~inj:inj_int tbl "foo" 1;
  set ~inj:inj_int tbl "bar" 2;
  set ~inj:inj_str tbl "baaz" "hello";
  OUnit.assert_equal 3 (length tbl);
  clear tbl;
  OUnit.assert_equal 0 (length tbl);
*)

let remove tbl x = Hashtbl.remove tbl x

let copy tbl = Hashtbl.copy tbl

let is_some = function
  | None -> false
  | Some _ -> true

let mem ~inj tbl x =
  try
    is_some (inj.get (Hashtbl.find tbl x))
  with Not_found -> false

(*$R
  let inj_int = create_inj () in
  let inj_str = create_inj () in
  let tbl = create 5 in
  set ~inj:inj_int tbl "foo" 1;
  set ~inj:inj_int tbl "bar" 2;
  set ~inj:inj_str tbl "baaz" "hello";
  OUnit.assert_bool "mem foo int" (mem ~inj:inj_int tbl "foo");
  OUnit.assert_bool "mem bar int" (mem ~inj:inj_int tbl "bar");
  OUnit.assert_bool "not mem baaz int" (not (mem ~inj:inj_int tbl "baaz"));
  OUnit.assert_bool "not mem foo str" (not (mem ~inj:inj_str tbl "foo"));
  OUnit.assert_bool "not mem bar str" (not (mem ~inj:inj_str tbl "bar"));
  OUnit.assert_bool "mem baaz str" (mem ~inj:inj_str tbl "baaz");
*)

let find ~inj tbl x =
  match inj.get (Hashtbl.find tbl x) with
    | None -> raise Not_found
    | Some v -> v

let iter_keys tbl f =
  Hashtbl.iter (fun x _ -> f x) tbl

let fold_keys tbl acc f =
  Hashtbl.fold (fun x _ acc -> f acc x) tbl acc

(** {2 Iterators} *)

type 'a sequence = ('a -> unit) -> unit

let keys_seq tbl yield =
  Hashtbl.iter
    (fun x _ -> yield x)
    tbl

(*$R
  let inj_int = create_inj () in
  let inj_str = create_inj () in
  let tbl = create 5 in
  set ~inj:inj_int tbl "foo" 1;
  set ~inj:inj_int tbl "bar" 2;
  set ~inj:inj_str tbl "baaz" "hello";
  let l = keys_seq tbl |> Iter.to_list in
  OUnit.assert_equal ["baaz"; "bar"; "foo"] (List.sort compare l);
*)

let bindings_of ~inj tbl yield =
  Hashtbl.iter
    (fun k value ->
       match inj.get value with
         | None -> ()
         | Some v -> yield (k, v)
    ) tbl

type value =
  | Value : ('b injection -> 'b option) -> value

let bindings tbl yield =
  Hashtbl.iter
    (fun x y -> yield (x, Value (fun inj -> inj.get y)))
    tbl

(*$R
  let inj_int = create_inj () in
  let inj_str = create_inj () in
  let tbl = create 5 in
  set ~inj:inj_int tbl "foo" 1;
  set ~inj:inj_int tbl "bar" 2;
  set ~inj:inj_str tbl "baaz" "hello";
  set ~inj:inj_str tbl "str" "rts";
  let l_int = bindings_of ~inj:inj_int tbl |> Iter.to_list in
  OUnit.assert_equal ["bar", 2; "foo", 1] (List.sort compare l_int);
  let l_str = bindings_of ~inj:inj_str tbl |> Iter.to_list in
  OUnit.assert_equal ["baaz", "hello"; "str", "rts"] (List.sort compare l_str);
*)