update of persistent hashtable

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

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 *)
 

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