From f363399fda6b1d52ca6fc733678289bf0d66294a Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 4 Mar 2013 16:01:37 +0100
Subject: [PATCH] PHashtbl.filter

---
 pHashtbl.ml            | 11 +++++++++++
 pHashtbl.mli           |  3 +++
 tests/test_pHashtbl.ml | 10 ++++++++++
 3 files changed, 24 insertions(+)

diff --git a/pHashtbl.ml b/pHashtbl.ml
index 6732595c..02dc55f2 100644
--- a/pHashtbl.ml
+++ b/pHashtbl.ml
@@ -179,6 +179,17 @@ let fold f acc t =
   done;
   !acc
 
+(** Destructive filter (remove bindings that do not satisfiy predicate) *)
+let filter pred t =
+  for i = 0 to Array.length t.buckets - 1 do
+    match t.buckets.(i) with
+    | (_, _, (Empty | Deleted)) -> ()
+    | (k, v, Used) when pred k v -> ()
+    | (k, v, Used) -> (* remove this element *)
+      t.buckets.(i) <- my_deleted k;
+      t.size <- t.size - 1
+  done
+
 (** Add the given pairs to the hashtable *)
 let of_seq t seq =
   Sequence.iter (fun (k,v) -> add t k v) seq
diff --git a/pHashtbl.mli b/pHashtbl.mli
index cac6d936..3151267f 100644
--- a/pHashtbl.mli
+++ b/pHashtbl.mli
@@ -61,6 +61,9 @@ val mem : ('a,_) t -> 'a -> bool
 val iter : ('a -> 'b -> unit) -> ('a, 'b) t -> unit
   (** Iterate on bindings *)
 
+val filter : ('a -> 'b -> bool) -> ('a, 'b) t -> unit
+  (** Destructive filter (remove bindings that do not satisfiy predicate) *)
+
 val fold : ('c -> 'a -> 'b -> 'c) -> 'c -> ('a, 'b) t -> 'c
   (** Fold on bindings *)
 
diff --git a/tests/test_pHashtbl.ml b/tests/test_pHashtbl.ml
index 6eca5c0e..9a021a5e 100644
--- a/tests/test_pHashtbl.ml
+++ b/tests/test_pHashtbl.ml
@@ -74,6 +74,15 @@ let test_remove () =
   (* test that 2 has been removed *)
   OUnit.assert_raises Not_found (fun () -> PHashtbl.find h 2)
 
+let test_filter () =
+  let h = PHashtbl.create 5 in
+  PHashtbl.of_seq h my_seq;
+  OUnit.assert_equal (PHashtbl.length h) 4;
+  PHashtbl.filter (fun k _ -> (k mod 2) = 0) h;
+  OUnit.assert_equal (PHashtbl.length h) 2;
+  OUnit.assert_bool "mem" (PHashtbl.mem h 4);
+  OUnit.assert_bool "mem" (PHashtbl.mem h 2)
+
 let suite =
   "test_pHashtbl" >:::
     [ "test_add" >:: test_add;
@@ -83,4 +92,5 @@ let suite =
       "test_eq" >:: test_eq;
       "test_copy" >:: test_copy;
       "test_remove" >:: test_remove;
+      "test_filter" >:: test_filter;
     ]