mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-07 11:45:31 -05:00
modify CCPersistentHashtbl.merge and add CCMap.merge_safe
This commit is contained in:
parent
33dd681acd
commit
d694d20b26
4 changed files with 33 additions and 7 deletions
|
|
@ -24,6 +24,12 @@ module type S = sig
|
||||||
[k] is removed from [m], and if the result is [Some v'] then
|
[k] is removed from [m], and if the result is [Some v'] then
|
||||||
[add k v' m] is returned. *)
|
[add k v' m] is returned. *)
|
||||||
|
|
||||||
|
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 NEXT_RELEASE *)
|
||||||
|
|
||||||
val of_seq : (key * 'a) sequence -> 'a t
|
val of_seq : (key * 'a) sequence -> 'a t
|
||||||
|
|
||||||
val add_seq : 'a t -> (key * 'a) sequence -> 'a t
|
val add_seq : 'a t -> (key * 'a) sequence -> 'a t
|
||||||
|
|
@ -75,6 +81,15 @@ module Make(O : Map.OrderedType) = struct
|
||||||
| None -> remove k m
|
| None -> remove k m
|
||||||
| Some v' -> add k v' m
|
| Some v' -> add k v' m
|
||||||
|
|
||||||
|
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 add_seq m s =
|
||||||
let m = ref m in
|
let m = ref m in
|
||||||
s (fun (k,v) -> m := add k v !m);
|
s (fun (k,v) -> m := add k v !m);
|
||||||
|
|
|
||||||
|
|
@ -27,6 +27,12 @@ module type S = sig
|
||||||
[k] is removed from [m], and if the result is [Some v'] then
|
[k] is removed from [m], and if the result is [Some v'] then
|
||||||
[add k v' m] is returned. *)
|
[add k v' m] is returned. *)
|
||||||
|
|
||||||
|
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 NEXT_RELEASE *)
|
||||||
|
|
||||||
val of_seq : (key * 'a) sequence -> 'a t
|
val of_seq : (key * 'a) sequence -> 'a t
|
||||||
|
|
||||||
val add_seq : 'a t -> (key * 'a) sequence -> 'a t
|
val add_seq : 'a t -> (key * 'a) sequence -> 'a t
|
||||||
|
|
|
||||||
|
|
@ -67,7 +67,8 @@ module type S = sig
|
||||||
(** Fresh copy of the table; the underlying structure is not shared
|
(** Fresh copy of the table; the underlying structure is not shared
|
||||||
anymore, so using both tables alternatively will be efficient *)
|
anymore, so using both tables alternatively will be efficient *)
|
||||||
|
|
||||||
val merge : (key -> 'a option -> 'b option -> 'c option) ->
|
val merge :
|
||||||
|
(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) ->
|
||||||
'a t -> 'b t -> 'c t
|
'a t -> 'b t -> 'c t
|
||||||
(** Merge two tables together into a new table. The function's argument
|
(** Merge two tables together into a new table. The function's argument
|
||||||
correspond to values associated with the key (if present); if the
|
correspond to values associated with the key (if present); if the
|
||||||
|
|
@ -543,8 +544,11 @@ module Make(H : HashedType) : S with type key = H.t = struct
|
||||||
let tbl = create (max (length t1) (length t2)) in
|
let tbl = create (max (length t1) (length t2)) in
|
||||||
let tbl = fold
|
let tbl = fold
|
||||||
(fun tbl k v1 ->
|
(fun tbl k v1 ->
|
||||||
let v2 = try Some (find t2 k) with Not_found -> None in
|
let comb =
|
||||||
match f k (Some v1) v2 with
|
try `Both (v1, find t2 k)
|
||||||
|
with Not_found -> `Left v1
|
||||||
|
in
|
||||||
|
match f k comb with
|
||||||
| None -> tbl
|
| None -> tbl
|
||||||
| Some v' -> replace tbl k v')
|
| Some v' -> replace tbl k v')
|
||||||
tbl t1
|
tbl t1
|
||||||
|
|
@ -552,7 +556,7 @@ module Make(H : HashedType) : S with type key = H.t = struct
|
||||||
fold
|
fold
|
||||||
(fun tbl k v2 ->
|
(fun tbl k v2 ->
|
||||||
if mem t1 k then tbl
|
if mem t1 k then tbl
|
||||||
else match f k None (Some v2) with
|
else match f k (`Right v2) with
|
||||||
| None -> tbl
|
| None -> tbl
|
||||||
| Some v' -> replace tbl k v'
|
| Some v' -> replace tbl k v'
|
||||||
) tbl t2
|
) tbl t2
|
||||||
|
|
|
||||||
|
|
@ -74,7 +74,8 @@ module type S = sig
|
||||||
(** Fresh copy of the table; the underlying structure is not shared
|
(** Fresh copy of the table; the underlying structure is not shared
|
||||||
anymore, so using both tables alternatively will be efficient *)
|
anymore, so using both tables alternatively will be efficient *)
|
||||||
|
|
||||||
val merge : (key -> 'a option -> 'b option -> 'c option) ->
|
val merge :
|
||||||
|
f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) ->
|
||||||
'a t -> 'b t -> 'c t
|
'a t -> 'b t -> 'c t
|
||||||
(** Merge two tables together into a new table. The function's argument
|
(** Merge two tables together into a new table. The function's argument
|
||||||
correspond to values associated with the key (if present); if the
|
correspond to values associated with the key (if present); if the
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue