simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 11:15:31 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

deletion for FHashtbl.Tree implemented

Browse source
This commit is contained in:
Simon Cruanes 2013-03-07 18:22:42 +01:00
parent f561e7af7c
commit 7d96c9092a
2 changed files with 44 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
fHashtbl.ml
View file

@ -268,9 +268,43 @@ module Tree(X : HASH) = struct
let h = X.hash key in let h = X.hash key in
insert t ~depth:0 h key value insert t ~depth:0 h key value
(** Recursive removal function *)
let rec rec_remove t h key =
match t with
| Split (l, r) ->
if h land 0x1 = 0
then (* bit=0, goto left *)
let l' = rec_remove l (h lsr 1) key in
if l == l' then t else Split (l', r)
else (* bit=1, goto right *)
let r' = rec_remove r (h lsr 1) key in
if r == r' then t else Split (l, r')
| Table buckets ->
(* remove from the flat hashtable *)
probe_remove t buckets h key
(* remove key from the buckets *)
and probe_remove old_table buckets h key =
let n = PArray.length buckets in
let rec probe i =
if i = n
then old_table (* not present *)
else
let j = addr n h i in
match PArray.get buckets j with
| Empty -> old_table (* not present *)
| Deleted -> probe (i+1)
| Used (key', _) ->
if X.equal key key'
then Table (PArray.set buckets j Deleted)
else probe (i+1)
in
probe 0
(** Remove the bindings for the given key *) (** Remove the bindings for the given key *)
let remove t key = let remove t key =
failwith "not implemented" (* TODO *) let h = X.hash key in
rec_remove t h key
(** Fold on bindings *) (** Fold on bindings *)
let rec fold f acc t = let rec fold f acc t =

23
tests/test_fHashtbl.ml
View file

@ -67,20 +67,17 @@ module Test(SomeHashtbl : FHashtbl.S with type key = int) = struct
OUnit.assert_raises Not_found (fun () -> SomeHashtbl.find h (n+1)); OUnit.assert_raises Not_found (fun () -> SomeHashtbl.find h (n+1));
() ()
(*
let test_remove () = let test_remove () =
let h = IHashtbl.create 3 in let h = SomeHashtbl.of_seq my_seq in
IHashtbl.of_seq h my_seq; OUnit.assert_equal (SomeHashtbl.find h 2) "b";
OUnit.assert_equal (IHashtbl.find h 2) "b"; OUnit.assert_equal (SomeHashtbl.find h 3) "c";
OUnit.assert_equal (IHashtbl.find h 3) "c"; OUnit.assert_equal (SomeHashtbl.find h 4) "d";
OUnit.assert_equal (IHashtbl.find h 4) "d"; OUnit.assert_equal (SomeHashtbl.size h) 4;
OUnit.assert_equal (IHashtbl.length h) 4; let h = SomeHashtbl.remove h 2 in
IHashtbl.remove h 2; OUnit.assert_equal (SomeHashtbl.find h 3) "c";
OUnit.assert_equal (IHashtbl.find h 3) "c"; OUnit.assert_equal (SomeHashtbl.size h) 3;
OUnit.assert_equal (IHashtbl.length h) 3;
(* test that 2 has been removed *) (* test that 2 has been removed *)
OUnit.assert_raises Not_found (fun () -> IHashtbl.find h 2) OUnit.assert_raises Not_found (fun () -> SomeHashtbl.find h 2)
*)
let suite = let suite =
"test_FHashtbl" >::: "test_FHashtbl" >:::
@ -90,9 +87,7 @@ module Test(SomeHashtbl : FHashtbl.S with type key = int) = struct
"test_resize" >:: test_resize; "test_resize" >:: test_resize;
"test_persistent" >:: test_persistent; "test_persistent" >:: test_persistent;
"test_big" >:: test_big; "test_big" >:: test_big;
(*
"test_remove" >:: test_remove; "test_remove" >:: test_remove;
*)
] ]
end end