Finishing porting sets features to new-sets
parent
b76c82048d
commit
366f36d73f
|
@ -47,5 +47,7 @@ IN: new-sets.tests
|
|||
[ { 1 2 3 } ] [ { 1 2 2 3 3 } { } 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
|
||||
|
||||
[ H{ { 3 HS{ 1 2 } } } ] [ H{ } clone 1 3 pick adjoin-at 2 3 pick adjoin-at ] unit-test
|
||||
|
|
|
@ -61,12 +61,12 @@ M: set all-unique? drop t ;
|
|||
<PRIVATE
|
||||
|
||||
: (prune) ( elt hash vec -- )
|
||||
3dup drop key? [ 3drop ] [
|
||||
[ drop dupd set-at ] [ nip push ] 3bi
|
||||
3dup drop in? [ 3drop ] [
|
||||
[ drop adjoin ] [ nip push ] 3bi
|
||||
] if ; inline
|
||||
|
||||
: prune ( seq -- newseq )
|
||||
[ ] [ length <hashtable> ] [ length <vector> ] tri
|
||||
[ f fast-set ] [ length <vector> ] bi
|
||||
[ [ (prune) ] 2curry each ] keep ;
|
||||
|
||||
PRIVATE>
|
||||
|
@ -98,3 +98,9 @@ USE: vocabs.loader
|
|||
|
||||
: combine ( sets -- set )
|
||||
f [ union ] reduce ;
|
||||
|
||||
: gather ( seq quot -- newseq )
|
||||
map concat members ; inline
|
||||
|
||||
: adjoin-at ( value key assoc -- )
|
||||
[ [ f fast-set ] unless* [ adjoin ] keep ] change-at ;
|
||||
|
|
Loading…
Reference in New Issue