diff --git a/persistentHashtbl.ml b/persistentHashtbl.ml index 9aa17080..51952ce5 100644 --- a/persistentHashtbl.ml +++ b/persistentHashtbl.ml @@ -37,6 +37,9 @@ module type S = sig type key type 'a t + val empty : unit -> 'a t + (** Empty table. The table will be allocated at the first binding *) + val create : int -> 'a t (** Create a new hashtable *) @@ -63,6 +66,9 @@ module type S = sig (** Fresh copy of the table; the underlying structure is not shared anymore, so using both tables alternatively will be efficient *) + val merge : (key -> 'a option -> 'a option -> 'a option) -> 'a t -> 'a t -> 'a t + (** Merge two tables together into a new table *) + val iter : 'a t -> (key -> 'a -> unit) -> unit (** Iterate over bindings *) @@ -97,6 +103,8 @@ module Make(H : HashedType) : S with type key = H.t = struct let create i = ref (Table (Table.create i)) + let empty () = create 11 + (** Reroot: modify the zipper so that the current node is a proper hashtable, and return the hashtable *) let reroot t = @@ -202,6 +210,21 @@ module Make(H : HashedType) : S with type key = H.t = struct | _ -> reroot t in Table.fold (fun k v acc -> f acc k v) tbl acc + let merge f t1 t2 = + let tbl = Table.create (max (length t1) (length t2)) in + iter t1 + (fun k v1 -> + let v2 = try Some (find t2 k) with Not_found -> None in + match f k (Some v1) v2 with + | None -> () + | Some v' -> Table.replace tbl k v'); + iter t2 + (fun k v2 -> + if not (mem t1 k) then match f k None (Some v2) with + | None -> () + | Some v' -> Table.replace tbl k v2); + ref (Table tbl) + let of_seq ?init seq = let tbl = match init with | None -> Table.create 5 diff --git a/persistentHashtbl.mli b/persistentHashtbl.mli index 3ca89c08..77bc1049 100644 --- a/persistentHashtbl.mli +++ b/persistentHashtbl.mli @@ -37,6 +37,9 @@ module type S = sig type key type 'a t + val empty : unit -> 'a t + (** Empty table. The table will be allocated at the first binding *) + val create : int -> 'a t (** Create a new hashtable *) @@ -63,6 +66,9 @@ module type S = sig (** Fresh copy of the table; the underlying structure is not shared anymore, so using both tables alternatively will be efficient *) + val merge : (key -> 'a option -> 'a option -> 'a option) -> 'a t -> 'a t -> 'a t + (** Merge two tables together into a new table *) + val iter : 'a t -> (key -> 'a -> unit) -> unit (** Iterate over bindings *) diff --git a/tests/test_PersistentHashtbl.ml b/tests/test_PersistentHashtbl.ml index 75ecb9c2..feda17e6 100644 --- a/tests/test_PersistentHashtbl.ml +++ b/tests/test_PersistentHashtbl.ml @@ -90,6 +90,22 @@ let test_size () = OUnit.assert_bool "is_empty" (H.is_empty (H.create 16)); () +let test_merge () = + let t1 = H.of_list [1, "a"; 2, "b1"] in + let t2 = H.of_list [2, "b2"; 3, "c"] in + let t = H.merge + (fun _ v1 v2 -> match v1, v2 with + | None, _ -> v2 + | _ , None -> v1 + | Some s1, Some s2 -> if s1 < s2 then Some s1 else Some s2) + t1 t2 + in + OUnit.assert_equal ~printer:string_of_int 3 (H.length t); + OUnit.assert_equal "a" (H.find t 1); + OUnit.assert_equal "b1" (H.find t 2); + OUnit.assert_equal "c" (H.find t 3); + () + let suite = "test_H" >::: [ "test_add" >:: test_add; @@ -100,6 +116,7 @@ let suite = "test_big" >:: test_big; "test_remove" >:: test_remove; "test_size" >:: test_size; + "test_merge" >:: test_merge; ] open QCheck