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

hashtables: switch to quadratic probing.

db4
John Benediktsson 2011-10-02 13:47:51 -07:00
parent 98e7793799
commit 4ad888b530
1 changed files with 18 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
core/hashtables/hashtables.factor
View File

@ -17,21 +17,23 @@ TUPLE: hashtable
: hash@ ( key array -- i ) : hash@ ( key array -- i )
[ hashcode >fixnum dup fixnum+fast ] dip wrap ; inline [ hashcode >fixnum dup fixnum+fast ] dip wrap ; inline
: probe ( array i -- array i ) : probe ( array i probe# -- array i' probe# )
2 fixnum+fast over wrap ; inline 2 fixnum+fast [ fixnum+fast over wrap ] keep ; inline
: no-key ( key array -- array n ? ) nip f f ; inline : no-key ( key array -- array n ? ) nip f f ; inline
: (key@) ( key array i -- array n ? ) : (key@) ( key array i probe# -- array n ? )
3dup swap array-nth [ 3dup swap array-nth ] dip over ((empty)) eq?
dup ((empty)) eq? [ drop 3drop no-key ] [
[ 3drop no-key ] [ [ = ] dip swap
= [ rot drop t ] [ probe (key@) ] if [ drop rot drop t ]
[ probe (key@) ]
if
] if ; inline recursive ] if ; inline recursive
: key@ ( key hash -- array n ? ) : key@ ( key hash -- array n ? )
array>> dup length>> 0 eq? array>> dup length>> 0 eq?
[ no-key ] [ 2dup hash@ (key@) ] if ; inline [ no-key ] [ 2dup hash@ 0 (key@) ] if ; inline
: <hash-array> ( n -- array ) : <hash-array> ( n -- array )
1 + next-power-of-2 4 * ((empty)) <array> ; inline 1 + next-power-of-2 4 * ((empty)) <array> ; inline
@ -42,19 +44,17 @@ TUPLE: hashtable
: reset-hash ( n hash -- ) : reset-hash ( n hash -- )
swap <hash-array> >>array init-hash ; inline swap <hash-array> >>array init-hash ; inline
: (new-key@) ( key keys i -- keys n empty? ) : (new-key@) ( key array i probe# -- array i empty? )
3dup swap array-nth dup ((empty)) eq? [ [ 3dup swap array-nth ] dip over ((empty)) eq?
2drop rot drop t [ 3drop rot drop t ] [
] [ [ = ] dip swap
= [ [ drop rot drop f ]
rot drop f [ probe (new-key@) ]
] [ if
probe (new-key@)
] if
] if ; inline recursive ] if ; inline recursive
: new-key@ ( key hash -- array n empty? ) : new-key@ ( key hash -- array n empty? )
array>> 2dup hash@ (new-key@) ; inline array>> 2dup hash@ 0 (new-key@) ; inline
: set-nth-pair ( value key seq n -- ) : set-nth-pair ( value key seq n -- )
2 fixnum+fast [ set-slot ] 2keep 2 fixnum+fast [ set-slot ] 2keep