From 5670a157ef5821cd1b537517405774de161ec2fe Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 Aug 2008 04:46:44 -0500 Subject: [PATCH] Debugging persistent hashtables --- .../hashtables/hashtables-tests.factor | 33 +++++++------------ .../hashtables/nodes/bitmap/bitmap.factor | 9 +++-- .../nodes/collision/collision.factor | 4 +-- .../hashtables/nodes/full/full.factor | 2 +- 4 files changed, 19 insertions(+), 29 deletions(-) diff --git a/extra/persistent/hashtables/hashtables-tests.factor b/extra/persistent/hashtables/hashtables-tests.factor index 2c8ffaee00..accebfd778 100644 --- a/extra/persistent/hashtables/hashtables-tests.factor +++ b/extra/persistent/hashtables/hashtables-tests.factor @@ -75,7 +75,7 @@ M: hash-0-b hashcode* 2drop 0 ; ] unit-test : random-string ( -- str ) - 100 random [ CHAR: a CHAR: z [a,b] random ] "" replicate-as ; + 1000000 random ; ! [ CHAR: a CHAR: z [a,b] random ] "" replicate-as ; : random-assocs ( -- hash phash ) [ random-string ] replicate @@ -89,16 +89,16 @@ M: hash-0-b hashcode* 2drop 0 ; : test-persistent-hashtables-1 ( n -- ) random-assocs ok? ; -! [ t ] [ 10 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 20 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 30 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 50 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 100 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 500 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 1000 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 5000 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 10000 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 50000 test-persistent-hashtables-1 ] unit-test +[ t ] [ 10 test-persistent-hashtables-1 ] unit-test +[ t ] [ 20 test-persistent-hashtables-1 ] unit-test +[ t ] [ 30 test-persistent-hashtables-1 ] unit-test +[ t ] [ 50 test-persistent-hashtables-1 ] unit-test +[ t ] [ 100 test-persistent-hashtables-1 ] unit-test +[ t ] [ 500 test-persistent-hashtables-1 ] unit-test +[ t ] [ 1000 test-persistent-hashtables-1 ] unit-test +[ t ] [ 5000 test-persistent-hashtables-1 ] unit-test +[ t ] [ 10000 test-persistent-hashtables-1 ] unit-test +[ t ] [ 50000 test-persistent-hashtables-1 ] unit-test : test-persistent-hashtables-2 ( n -- ) random-assocs @@ -107,13 +107,4 @@ M: hash-0-b hashcode* 2drop 0 ; 2dup ok? ] all? 2nip ; -[ t ] [ 10 test-persistent-hashtables-2 ] unit-test -[ t ] [ 20 test-persistent-hashtables-2 ] unit-test -[ t ] [ 30 test-persistent-hashtables-2 ] unit-test -[ t ] [ 50 test-persistent-hashtables-2 ] unit-test -[ t ] [ 100 test-persistent-hashtables-2 ] unit-test -[ t ] [ 500 test-persistent-hashtables-2 ] unit-test -[ t ] [ 1000 test-persistent-hashtables-2 ] unit-test -[ t ] [ 5000 test-persistent-hashtables-2 ] unit-test -[ t ] [ 10000 test-persistent-hashtables-2 ] unit-test -[ t ] [ 50000 test-persistent-hashtables-2 ] unit-test +[ t ] [ 6000 test-persistent-hashtables-2 ] unit-test diff --git a/extra/persistent/hashtables/nodes/bitmap/bitmap.factor b/extra/persistent/hashtables/nodes/bitmap/bitmap.factor index a08b2748d8..7fb14a4541 100644 --- a/extra/persistent/hashtables/nodes/bitmap/bitmap.factor +++ b/extra/persistent/hashtables/nodes/bitmap/bitmap.factor @@ -14,7 +14,7 @@ M:: bitmap-node (entry-at) ( key hashcode bitmap-node -- entry ) bit [ hashcode shift bitpos ] bitmap [ bitmap-node bitmap>> ] nodes [ bitmap-node nodes>> ] | - bitmap bit bitand 0 = [ f ] [ + bitmap bit bitand 0 eq? [ f ] [ key hashcode bit bitmap index nodes nth-unsafe (entry-at) @@ -27,7 +27,7 @@ M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-l bitmap [ bitmap-node bitmap>> ] idx [ bit bitmap index ] nodes [ bitmap-node nodes>> ] | - bitmap bit bitand 0 = [ + bitmap bit bitand 0 eq? [ [let | new-leaf [ value key hashcode ] | bitmap bit bitor new-leaf idx nodes insert-nth @@ -58,7 +58,7 @@ M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' ) bitmap [ bitmap-node bitmap>> ] nodes [ bitmap-node nodes>> ] shift [ bitmap-node shift>> ] | - bit bitmap bitand 0 = [ bitmap-node ] [ + bit bitmap bitand 0 eq? [ bitmap-node ] [ [let* | idx [ bit bitmap index ] n [ idx nodes nth-unsafe ] n' [ key hashcode n (pluck-at) ] | @@ -71,8 +71,7 @@ M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' ) shift ] [ - bitmap bit = [ f ] [ - nodes length 1 = [ bitmap bit 2array throw ] when + bitmap bit eq? [ f ] [ bitmap bit bitnot bitand idx nodes remove-nth shift diff --git a/extra/persistent/hashtables/nodes/collision/collision.factor b/extra/persistent/hashtables/nodes/collision/collision.factor index cb2f40c682..b74a2ed45d 100644 --- a/extra/persistent/hashtables/nodes/collision/collision.factor +++ b/extra/persistent/hashtables/nodes/collision/collision.factor @@ -14,7 +14,7 @@ M:: collision-node (entry-at) ( key hashcode collision-node -- leaf-node ) key hashcode collision-node find-index nip ; M:: collision-node (pluck-at) ( key hashcode collision-node -- leaf-node ) - hashcode collision-node hashcode>> = [ + hashcode collision-node hashcode>> eq? [ [let | idx [ key hashcode collision-node find-index drop ] | idx [ idx collision-node leaves>> smash [ @@ -26,7 +26,7 @@ M:: collision-node (pluck-at) ( key hashcode collision-node -- leaf-node ) ] [ collision-node ] if ; M:: collision-node (new-at) ( shift value key hashcode collision-node -- node' added-leaf ) - hashcode collision-node hashcode>> = [ + hashcode collision-node hashcode>> eq? [ key hashcode collision-node find-index [let | leaf-node [ ] idx [ ] | idx [ diff --git a/extra/persistent/hashtables/nodes/full/full.factor b/extra/persistent/hashtables/nodes/full/full.factor index 59123758ad..e0fcc1a0ab 100644 --- a/extra/persistent/hashtables/nodes/full/full.factor +++ b/extra/persistent/hashtables/nodes/full/full.factor @@ -34,7 +34,7 @@ M:: full-node (pluck-at) ( key hashcode full-node -- node' ) full-node shift>> ] [ - hashcode full-node shift>> bitpos bitnot + hashcode full-node shift>> bitpos bitnot full-bitmap-mask bitand idx full-node nodes>> remove-nth full-node shift>>