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

assocs: adding assoc-reject, assoc-reject-as, assoc-reject!.

db4
John Benediktsson 2015-05-12 19:07:00 -07:00
parent b366a06c41
commit 016e03410d
3 changed files with 37 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
core/assocs/assocs-docs.factor
View File

@ -151,6 +151,8 @@ $nl
assoc-map assoc-map
assoc-filter assoc-filter
assoc-filter-as assoc-filter-as
assoc-reject
assoc-reject-as
assoc-partition assoc-partition
assoc-any? assoc-any?
assoc-all? assoc-all?
@ -169,6 +171,7 @@ $nl
"Destructive combinators:" "Destructive combinators:"
{ $subsections { $subsections
assoc-filter! assoc-filter!
assoc-reject!
cache cache
2cache 2cache
} ; } ;
@ -300,6 +303,21 @@ HELP: assoc-filter!
{ assoc-filter assoc-filter-as assoc-filter! } related-words { assoc-filter assoc-filter-as assoc-filter! } related-words
HELP: assoc-reject
{ $values { "assoc" assoc } { "quot" { $quotation ( ... key value -- ... ? ) } } { "subassoc" "a new assoc" } }
{ $description "Outputs an assoc of the same type as " { $snippet "assoc" } " consisting of all entries for which the predicate quotation yields false." } ;
HELP: assoc-reject-as
{ $values { "assoc" assoc } { "quot" { $quotation ( ... key value -- ... ? ) } } { "exemplar" assoc } { "subassoc" "a new assoc" } }
{ $description "Outputs an assoc of the same type as " { $snippet "exemplar" } " consisting of all entries for which the predicate quotation yields false." } ;
HELP: assoc-reject!
{ $values { "assoc" assoc } { "quot" { $quotation ( ... key value -- ... ? ) } } }
{ $description "Removes all entries for which the predicate quotation yields false." }
{ $side-effects "assoc" } ;
{ assoc-reject assoc-reject-as assoc-reject! } related-words
HELP: assoc-partition HELP: assoc-partition
{ $values { $values
{ "assoc" assoc } { "quot" quotation } { "assoc" assoc } { "quot" quotation }

10
core/assocs/assocs-tests.factor
View File

@ -50,6 +50,16 @@ IN: assocs.tests
[ drop 3 >= ] assoc-filter! drop [ drop 3 >= ] assoc-filter! drop
] unit-test ] unit-test
[ H{ { 1 2 } { 2 3 } } ] [
H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } }
[ drop 3 >= ] assoc-reject
] unit-test
[ H{ { 1 2 } { 2 3 } } ] [
H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } } clone
[ drop 3 >= ] assoc-reject!
] unit-test
[ 21 ] [ [ 21 ] [
0 H{ 0 H{
{ 1 2 } { 1 2 }

9
core/assocs/assocs.factor
View File

@ -74,12 +74,21 @@ PRIVATE>
: assoc-filter ( ... assoc quot: ( ... key value -- ... ? ) -- ... subassoc ) : assoc-filter ( ... assoc quot: ( ... key value -- ... ? ) -- ... subassoc )
over assoc-filter-as ; inline over assoc-filter-as ; inline
: assoc-reject-as ( ... assoc quot: ( ... key value -- ... ? ) exemplar -- ... subassoc )
[ [ not ] compose ] [ assoc-filter-as ] bi* ; inline
: assoc-reject ( ... assoc quot: ( ... key value -- ... ? ) -- ... subassoc )
over assoc-reject-as ; inline
: assoc-filter! ( ... assoc quot: ( ... key value -- ... ? ) -- ... assoc ) : assoc-filter! ( ... assoc quot: ( ... key value -- ... ? ) -- ... assoc )
[ [
over [ [ [ drop ] 2bi ] dip [ delete-at ] 2curry unless ] 2curry over [ [ [ drop ] 2bi ] dip [ delete-at ] 2curry unless ] 2curry
assoc-each assoc-each
] [ drop ] 2bi ; inline ] [ drop ] 2bi ; inline
: assoc-reject! ( ... assoc quot: ( ... key value -- ... ? ) -- ... assoc )
[ not ] compose assoc-filter! ; inline
: sift-keys ( assoc -- assoc' ) : sift-keys ( assoc -- assoc' )
[ drop ] assoc-filter ; inline [ drop ] assoc-filter ; inline