steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Debugging persistent hashtables

db4
Slava Pestov 2008-08-06 04:46:44 -05:00
parent f279015b85
commit 5670a157ef
4 changed files with 19 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
extra/persistent/hashtables/hashtables-tests.factor
View File

@ -75,7 +75,7 @@ M: hash-0-b hashcode* 2drop 0 ;
] unit-test ] unit-test
: random-string ( -- str ) : 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-assocs ( -- hash phash )
[ random-string ] replicate [ random-string ] replicate
@ -89,16 +89,16 @@ M: hash-0-b hashcode* 2drop 0 ;
: test-persistent-hashtables-1 ( n -- ) : test-persistent-hashtables-1 ( n -- )
random-assocs ok? ; random-assocs ok? ;
! [ t ] [ 10 test-persistent-hashtables-1 ] unit-test [ t ] [ 10 test-persistent-hashtables-1 ] unit-test
! [ t ] [ 20 test-persistent-hashtables-1 ] unit-test [ t ] [ 20 test-persistent-hashtables-1 ] unit-test
! [ t ] [ 30 test-persistent-hashtables-1 ] unit-test [ t ] [ 30 test-persistent-hashtables-1 ] unit-test
! [ t ] [ 50 test-persistent-hashtables-1 ] unit-test [ t ] [ 50 test-persistent-hashtables-1 ] unit-test
! [ t ] [ 100 test-persistent-hashtables-1 ] unit-test [ t ] [ 100 test-persistent-hashtables-1 ] unit-test
! [ t ] [ 500 test-persistent-hashtables-1 ] unit-test [ t ] [ 500 test-persistent-hashtables-1 ] unit-test
! [ t ] [ 1000 test-persistent-hashtables-1 ] unit-test [ t ] [ 1000 test-persistent-hashtables-1 ] unit-test
! [ t ] [ 5000 test-persistent-hashtables-1 ] unit-test [ t ] [ 5000 test-persistent-hashtables-1 ] unit-test
! [ t ] [ 10000 test-persistent-hashtables-1 ] unit-test [ t ] [ 10000 test-persistent-hashtables-1 ] unit-test
! [ t ] [ 50000 test-persistent-hashtables-1 ] unit-test [ t ] [ 50000 test-persistent-hashtables-1 ] unit-test
: test-persistent-hashtables-2 ( n -- ) : test-persistent-hashtables-2 ( n -- )
random-assocs random-assocs
@ -107,13 +107,4 @@ M: hash-0-b hashcode* 2drop 0 ;
2dup ok? 2dup ok?
] all? 2nip ; ] all? 2nip ;
[ t ] [ 10 test-persistent-hashtables-2 ] unit-test [ t ] [ 6000 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

9
extra/persistent/hashtables/nodes/bitmap/bitmap.factor
View File

@ -14,7 +14,7 @@ M:: bitmap-node (entry-at) ( key hashcode bitmap-node -- entry )
bit [ hashcode shift bitpos ] bit [ hashcode shift bitpos ]
bitmap [ bitmap-node bitmap>> ] bitmap [ bitmap-node bitmap>> ]
nodes [ bitmap-node nodes>> ] | nodes [ bitmap-node nodes>> ] |
bitmap bit bitand 0 = [ f ] [ bitmap bit bitand 0 eq? [ f ] [
key hashcode key hashcode
bit bitmap index nodes nth-unsafe bit bitmap index nodes nth-unsafe
(entry-at) (entry-at)
@ -27,7 +27,7 @@ M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-l
bitmap [ bitmap-node bitmap>> ] bitmap [ bitmap-node bitmap>> ]
idx [ bit bitmap index ] idx [ bit bitmap index ]
nodes [ bitmap-node nodes>> ] | nodes [ bitmap-node nodes>> ] |
bitmap bit bitand 0 = [ bitmap bit bitand 0 eq? [
[let | new-leaf [ value key hashcode <leaf-node> ] | [let | new-leaf [ value key hashcode <leaf-node> ] |
bitmap bit bitor bitmap bit bitor
new-leaf idx nodes insert-nth new-leaf idx nodes insert-nth
@ -58,7 +58,7 @@ M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' )
bitmap [ bitmap-node bitmap>> ] bitmap [ bitmap-node bitmap>> ]
nodes [ bitmap-node nodes>> ] nodes [ bitmap-node nodes>> ]
shift [ bitmap-node shift>> ] | shift [ bitmap-node shift>> ] |
bit bitmap bitand 0 = [ bitmap-node ] [ bit bitmap bitand 0 eq? [ bitmap-node ] [
[let* | idx [ bit bitmap index ] [let* | idx [ bit bitmap index ]
n [ idx nodes nth-unsafe ] n [ idx nodes nth-unsafe ]
n' [ key hashcode n (pluck-at) ] | n' [ key hashcode n (pluck-at) ] |
@ -71,8 +71,7 @@ M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' )
shift shift
<bitmap-node> <bitmap-node>
] [ ] [
bitmap bit = [ f ] [ bitmap bit eq? [ f ] [
nodes length 1 = [ bitmap bit 2array throw ] when
bitmap bit bitnot bitand bitmap bit bitnot bitand
idx nodes remove-nth idx nodes remove-nth
shift shift

4
extra/persistent/hashtables/nodes/collision/collision.factor
View File

@ -14,7 +14,7 @@ M:: collision-node (entry-at) ( key hashcode collision-node -- leaf-node )
key hashcode collision-node find-index nip ; key hashcode collision-node find-index nip ;
M:: collision-node (pluck-at) ( key hashcode collision-node -- leaf-node ) 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 ] | [let | idx [ key hashcode collision-node find-index drop ] |
idx [ idx [
idx collision-node leaves>> smash [ idx collision-node leaves>> smash [
@ -26,7 +26,7 @@ M:: collision-node (pluck-at) ( key hashcode collision-node -- leaf-node )
] [ collision-node ] if ; ] [ collision-node ] if ;
M:: collision-node (new-at) ( shift value key hashcode collision-node -- node' added-leaf ) 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 key hashcode collision-node find-index
[let | leaf-node [ ] idx [ ] | [let | leaf-node [ ] idx [ ] |
idx [ idx [

2
extra/persistent/hashtables/nodes/full/full.factor
View File

@ -34,7 +34,7 @@ M:: full-node (pluck-at) ( key hashcode full-node -- node' )
full-node shift>> full-node shift>>
<full-node> <full-node>
] [ ] [
hashcode full-node shift>> bitpos bitnot hashcode full-node shift>> bitpos bitnot full-bitmap-mask bitand
idx full-node nodes>> remove-nth idx full-node nodes>> remove-nth
full-node shift>> full-node shift>>
<bitmap-node> <bitmap-node>