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

hash-sets: implement faster ?adjoin.

db4
John Benediktsson 2013-03-23 16:58:03 -07:00
parent fdcdc8daf7
commit 5c1d5a049f
1 changed files with 10 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
core/hash-sets/hash-sets.factor
View File

@ -54,18 +54,18 @@ TUPLE: hash-set
if if
] if ; inline recursive ] if ; inline recursive
: new-key@ ( key hash -- array n ) : new-key@ ( key hash -- array n ? )
[ array>> 2dup hash@ 0 f (new-key@) ] keep swap [ array>> 2dup hash@ 0 f (new-key@) ] keep swap
[ over [ hash-deleted- ] [ hash-count+ ] if swap or ] [ 2drop ] if ; inline [ over [ hash-deleted- ] [ hash-count+ ] if swap or t ] [ 2drop f ] if ; inline
: set-nth-item ( key seq n -- ) : set-nth-item ( key seq n -- )
2 fixnum+fast set-slot ; inline 2 fixnum+fast set-slot ; inline
: (adjoin) ( key hash -- ) : (adjoin) ( key hash -- ? )
dupd new-key@ set-nth-item ; inline dupd new-key@ [ set-nth-item ] dip ; inline
: (rehash) ( seq hash -- ) : (rehash) ( seq hash -- )
[ (adjoin) ] curry each ; inline [ (adjoin) drop ] curry each ; inline
: hash-large? ( hash -- ? ) : hash-large? ( hash -- ? )
[ count>> 3 fixnum*fast 1 fixnum+fast ] [ count>> 3 fixnum*fast 1 fixnum+fast ]
@ -82,7 +82,7 @@ TUPLE: hash-set
[ array>> ] [ array>> ]
[ cardinality 1 + ] [ cardinality 1 + ]
[ reset-hash ] tri [ reset-hash ] tri
] keep [ (adjoin) ] curry each-member ; ] keep [ (adjoin) drop ] curry each-member ;
: ?grow-hash ( hash -- ) : ?grow-hash ( hash -- )
dup hash-large? [ grow-hash ] [ drop ] if ; inline dup hash-large? [ grow-hash ] [ drop ] if ; inline
@ -112,7 +112,10 @@ M: hash-set cardinality
: rehash ( hash-set -- ) : rehash ( hash-set -- )
[ members ] [ clear-set ] [ (rehash) ] tri ; [ members ] [ clear-set ] [ (rehash) ] tri ;
M: hash-set adjoin ( key hash-set -- ) M: hash-set adjoin
dup ?grow-hash (adjoin) drop ;
M: hash-set ?adjoin
dup ?grow-hash (adjoin) ; dup ?grow-hash (adjoin) ;
M: hash-set members M: hash-set members