Source file CCMap.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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
(** {1 Extensions of Standard Map} *)
type 'a iter = ('a -> unit) -> unit
type 'a printer = Format.formatter -> 'a -> unit
module type OrderedType = Map.OrderedType
module type S = sig
include Map.S
val get : key -> 'a t -> 'a option
(** [get k m] returns [Some v] if the current binding of [k] in [m] is [v],
or [None] if the key [k] is not present.
Safe version of {!find}. *)
val get_or : key -> 'a t -> default:'a -> 'a
(** [get_or k m ~default] returns the value associated to [k] if present,
and returns [default] otherwise (if [k] doesn't belong in [m]).
@since 0.16 *)
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
(** [update k f m] calls [f (Some v)] if [find k m = v],
otherwise it calls [f None]. In any case, if the result is [None]
[k] is removed from [m], and if the result is [Some v'] then
[add k v' m] is returned. *)
val choose_opt : 'a t -> (key * 'a) option
(** [choose_opt m] returns one binding of the given map [m], or [None] if [m] is empty.
Safe version of {!choose}.
@since 1.5 *)
val min_binding_opt : 'a t -> (key * 'a) option
(** [min_binding_opt m] returns the smallest binding of the given map [m],
or [None] if [m] is empty.
Safe version of {!min_binding}.
@since 1.5 *)
val max_binding_opt : 'a t -> (key * 'a) option
(** [max_binding_opt m] returns the largest binding of the given map [m],
or [None] if [m] is empty.
Safe version of {!max_binding}.
@since 1.5 *)
val find_opt : key -> 'a t -> 'a option
(** [find_opt k m] returns [Some v] if the current binding of [k] in [m] is [v],
or [None] if the key [k] is not present.
Safe version of {!find}.
@since 1.5 *)
val find_first : (key -> bool) -> 'a t -> key * 'a
(** [find_first f m] where [f] is a monotonically increasing function, returns the binding of [m]
with the lowest key [k] such that [f k], or raises [Not_found] if no such key exists.
See {!Map.S.find_first}.
@since 1.5 *)
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
(** [find_first_opt f m] where [f] is a monotonically increasing function, returns an option containing
the binding of [m] with the lowest key [k] such that [f k], or [None] if no such key exists.
Safe version of {!find_first}.
@since 1.5 *)
val merge_safe :
f:(key -> [ `Left of 'a | `Right of 'b | `Both of 'a * 'b ] -> 'c option) ->
'a t ->
'b t ->
'c t
(** [merge_safe ~f a b] merges the maps [a] and [b] together.
@since 0.17 *)
val add_seq : 'a t -> (key * 'a) Seq.t -> 'a t
(** [add_seq m seq] adds the given [Seq.t] of bindings to the map [m].
Like {!add_list}.
Renamed from [add_std_seq] since 3.0.
@since 3.0 *)
val add_seq_with :
f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> 'a t
(** [add_seq ~f m l] adds the given seq [l] of bindings to the map [m],
using [f] to combine values that have the same key.
@since 3.3 *)
val of_seq : (key * 'a) Seq.t -> 'a t
(** [of_seq seq] builds a map from the given [Seq.t] of bindings.
Like {!of_list}.
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val of_seq_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) Seq.t -> 'a t
(** [of_seq_with ~f l] builds a map from the given seq [l] of bindings [k_i -> v_i],
added in order using {!add}.
If a key occurs several times, all its bindings are combined using the
function [f], with [f key v1 v2] being called with [v1] occurring
later in the seq than [v2].
@since 3.3 *)
val add_iter : 'a t -> (key * 'a) iter -> 'a t
(** [add_iter m iter] adds the given [iter] of bindings to the map [m].
Like {!add_list}.
@since 2.8 *)
val add_iter_with :
f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) iter -> 'a t
(** [add_iter ~f m l] adds the given iter [l] of bindings to the map [m],
using [f] to combine values that have the same key.
@since 3.3 *)
val of_iter : (key * 'a) iter -> 'a t
(** [of_iter iter] builds a map from the given [iter] of bindings.
Like {!of_list}.
@since 2.8 *)
val of_iter_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) iter -> 'a t
(** [of_iter_with ~f l] builds a map from the given iter [l] of bindings [k_i -> v_i],
added in order using {!add}.
If a key occurs several times, all its bindings are combined using the
function [f], with [f key v1 v2] being called with [v1] occurring
later in the iter than [v2].
@since 3.3 *)
val to_iter : 'a t -> (key * 'a) iter
(** [to_iter m] iterates on the whole map [m], creating an [iter] of bindings.
Like {!to_list}.
@since 2.8 *)
val of_list : (key * 'a) list -> 'a t
(** [of_list l] builds a map from the given list [l] of bindings [k_i -> v_i],
added in order using {!add}.
If a key occurs several times, only its last binding
will be present in the result. *)
val of_list_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) list -> 'a t
(** [of_list_with ~f l] builds a map from the given list [l] of bindings [k_i -> v_i],
added in order using {!add}.
If a key occurs several times, all its bindings are combined using the
function [f], with [f key v1 v2] being called with [v1] occurring
later in the list than [v2].
@since 3.3 *)
val add_list : 'a t -> (key * 'a) list -> 'a t
(** [add_list m l] adds the given list [l] of bindings to the map [m].
@since 0.14 *)
val add_list_with :
f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) list -> 'a t
(** [add_list ~f m l] adds the given list [l] of bindings to the map [m],
using [f] to combine values that have the same key.
@since 3.3 *)
val keys : _ t -> key iter
(** [keys m] iterates on the keys of [m] only, creating an [iter] of keys.
@since 0.15 *)
val values : 'a t -> 'a iter
(** [values m] iterates on the values of [m] only, creating an [iter] of values.
@since 0.15 *)
val to_list : 'a t -> (key * 'a) list
(** [to_list m] builds a list of the bindings of the given map [m].
The order is unspecified. *)
val pp :
?pp_start:unit printer ->
?pp_stop:unit printer ->
?pp_arrow:unit printer ->
?pp_sep:unit printer ->
key printer ->
'a printer ->
'a t printer
(** [pp ?pp_start ?pp_stop ?pp_arrow ?pp_sep pp_key pp_v m] pretty-prints the
contents of the map. *)
end
module Make (O : Map.OrderedType) = struct
module M = Map.Make (O)
[@@@ocaml.warning "-32"]
let union f a b =
M.merge
(fun k v1 v2 ->
match v1, v2 with
| None, None -> assert false
| None, (Some _ as r) -> r
| (Some _ as r), None -> r
| Some v1, Some v2 -> f k v1 v2)
a b
let update k f m =
let x = try f (Some (M.find k m)) with Not_found -> f None in
match x with
| None -> M.remove k m
| Some v' -> M.add k v' m
let choose_opt m = try Some (M.choose m) with Not_found -> None
let find_opt k m = try Some (M.find k m) with Not_found -> None
let max_binding_opt m = try Some (M.max_binding m) with Not_found -> None
let min_binding_opt m = try Some (M.min_binding m) with Not_found -> None
exception Find_binding_exit
let find_first_opt f m =
let res = ref None in
try
M.iter
(fun k v ->
if f k then (
res := Some (k, v);
raise Find_binding_exit
))
m;
None
with Find_binding_exit -> !res
let find_first f m =
match find_first_opt f m with
| None -> raise Not_found
| Some (k, v) -> k, v
let find_last_opt f m =
let res = ref None in
M.iter (fun k v -> if f k then res := Some (k, v)) m;
!res
let find_last f m =
match find_last_opt f m with
| None -> raise Not_found
| Some (k, v) -> k, v
[@@@ocaml.warning "+32"]
include M
let get = find_opt
let get_or k m ~default = try find k m with Not_found -> default
let merge_safe ~f a b =
merge
(fun k v1 v2 ->
match v1, v2 with
| None, None -> assert false
| Some v1, None -> f k (`Left v1)
| None, Some v2 -> f k (`Right v2)
| Some v1, Some v2 -> f k (`Both (v1, v2)))
a b
let add_seq m s =
let m = ref m in
Seq.iter (fun (k, v) -> m := add k v !m) s;
!m
let add_seq_with ~f m s =
let combine k v = function
| None -> Some v
| Some v0 -> Some (f k v v0)
in
Seq.fold_left (fun m (k, v) -> update k (combine k v) m) m s
let of_seq s = add_seq empty s
let of_seq_with ~f s = add_seq_with ~f empty s
let add_iter m s =
let m = ref m in
s (fun (k, v) -> m := add k v !m);
!m
let add_iter_with ~f m s =
let combine k v = function
| None -> Some v
| Some v0 -> Some (f k v v0)
in
let m = ref m in
s (fun (k, v) -> m := update k (combine k v) !m);
!m
let of_iter s = add_iter empty s
let of_iter_with ~f s = add_iter_with ~f empty s
let to_iter m yield = iter (fun k v -> yield (k, v)) m
let keys m yield = iter (fun k _ -> yield k) m
let values m yield = iter (fun _ v -> yield v) m
let add_list m l = List.fold_left (fun m (k, v) -> add k v m) m l
let add_list_with ~f m l =
let combine k v = function
| None -> Some v
| Some v0 -> Some (f k v v0)
in
List.fold_left (fun m (k, v) -> update k (combine k v) m) m l
let of_list l = add_list empty l
let of_list_with ~f l = add_list_with ~f empty l
let to_list m = fold (fun k v acc -> (k, v) :: acc) m []
let pp ?(pp_start = fun _ () -> ()) ?(pp_stop = fun _ () -> ())
?(pp_arrow = fun fmt () -> Format.fprintf fmt "@ -> ")
?(pp_sep = fun fmt () -> Format.fprintf fmt ",@ ") pp_k pp_v fmt m =
pp_start fmt ();
let first = ref true in
iter
(fun k v ->
if !first then
first := false
else
pp_sep fmt ();
pp_k fmt k;
pp_arrow fmt ();
pp_v fmt v)
m;
pp_stop fmt ()
end