modify CCPersistentHashtbl.merge and add CCMap.merge_safe

This commit is contained in:
Simon Cruanes 2016-03-14 20:13:20 +01:00
parent 33dd681acd
commit d694d20b26
4 changed files with 33 additions and 7 deletions

View file

@ -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);

View file

@ -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

View file

@ -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

View file

@ -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