PHashtbl.filter

This commit is contained in:
Simon Cruanes 2013-03-04 16:01:37 +01:00
parent 4c7f8fad7c
commit f363399fda
3 changed files with 24 additions and 0 deletions

View file

@ -179,6 +179,17 @@ let fold f acc t =
done; done;
!acc !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 *) (** Add the given pairs to the hashtable *)
let of_seq t seq = let of_seq t seq =
Sequence.iter (fun (k,v) -> add t k v) seq Sequence.iter (fun (k,v) -> add t k v) seq

View file

@ -61,6 +61,9 @@ val mem : ('a,_) t -> 'a -> bool
val iter : ('a -> 'b -> unit) -> ('a, 'b) t -> unit val iter : ('a -> 'b -> unit) -> ('a, 'b) t -> unit
(** Iterate on bindings *) (** 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 val fold : ('c -> 'a -> 'b -> 'c) -> 'c -> ('a, 'b) t -> 'c
(** Fold on bindings *) (** Fold on bindings *)

View file

@ -74,6 +74,15 @@ let test_remove () =
(* test that 2 has been removed *) (* test that 2 has been removed *)
OUnit.assert_raises Not_found (fun () -> PHashtbl.find h 2) 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 = let suite =
"test_pHashtbl" >::: "test_pHashtbl" >:::
[ "test_add" >:: test_add; [ "test_add" >:: test_add;
@ -83,4 +92,5 @@ let suite =
"test_eq" >:: test_eq; "test_eq" >:: test_eq;
"test_copy" >:: test_copy; "test_copy" >:: test_copy;
"test_remove" >:: test_remove; "test_remove" >:: test_remove;
"test_filter" >:: test_filter;
] ]