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

Finishing porting sets features to new-sets

db4
Daniel Ehrenberg 2010-02-26 13:22:56 -05:00
parent b76c82048d
commit 366f36d73f
2 changed files with 12 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
core/new-sets/new-sets-tests.factor
View File

@ -47,5 +47,7 @@ IN: new-sets.tests
[ { 1 2 3 } ] [ { 1 2 2 3 3 } { } set-like ] unit-test [ { 1 2 3 } ] [ { 1 2 2 3 3 } { } set-like ] unit-test
[ { 3 2 1 } ] [ { 3 3 2 2 1 } { } set-like ] unit-test [ { 3 2 1 } ] [ { 3 3 2 2 1 } { } set-like ] unit-test
[ { 1 2 1 } ] [ { 1 2 3 2 1 2 1 } duplicates ] unit-test [ { 2 1 2 1 } ] [ { 1 2 3 2 1 2 1 } duplicates ] unit-test
[ f ] [ HS{ 1 2 3 1 2 1 } duplicates ] unit-test [ f ] [ HS{ 1 2 3 1 2 1 } duplicates ] unit-test
[ H{ { 3 HS{ 1 2 } } } ] [ H{ } clone 1 3 pick adjoin-at 2 3 pick adjoin-at ] unit-test

12
core/new-sets/new-sets.factor
View File

@ -61,12 +61,12 @@ M: set all-unique? drop t ;
<PRIVATE <PRIVATE
: (prune) ( elt hash vec -- ) : (prune) ( elt hash vec -- )
3dup drop key? [ 3drop ] [ 3dup drop in? [ 3drop ] [
[ drop dupd set-at ] [ nip push ] 3bi [ drop adjoin ] [ nip push ] 3bi
] if ; inline ] if ; inline
: prune ( seq -- newseq ) : prune ( seq -- newseq )
[ ] [ length <hashtable> ] [ length <vector> ] tri [ f fast-set ] [ length <vector> ] bi
[ [ (prune) ] 2curry each ] keep ; [ [ (prune) ] 2curry each ] keep ;
PRIVATE> PRIVATE>
@ -98,3 +98,9 @@ USE: vocabs.loader
: combine ( sets -- set ) : combine ( sets -- set )
f [ union ] reduce ; f [ union ] reduce ;
: gather ( seq quot -- newseq )
map concat members ; inline
: adjoin-at ( value key assoc -- )
[ [ f fast-set ] unless* [ adjoin ] keep ] change-at ;