assocs: adding assoc-reject, assoc-reject-as, assoc-reject!.
parent
b366a06c41
commit
016e03410d
|
@ -151,6 +151,8 @@ $nl
|
|||
assoc-map
|
||||
assoc-filter
|
||||
assoc-filter-as
|
||||
assoc-reject
|
||||
assoc-reject-as
|
||||
assoc-partition
|
||||
assoc-any?
|
||||
assoc-all?
|
||||
|
@ -169,6 +171,7 @@ $nl
|
|||
"Destructive combinators:"
|
||||
{ $subsections
|
||||
assoc-filter!
|
||||
assoc-reject!
|
||||
cache
|
||||
2cache
|
||||
} ;
|
||||
|
@ -300,6 +303,21 @@ HELP: assoc-filter!
|
|||
|
||||
{ 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
|
||||
{ $values
|
||||
{ "assoc" assoc } { "quot" quotation }
|
||||
|
|
|
@ -50,6 +50,16 @@ IN: assocs.tests
|
|||
[ drop 3 >= ] assoc-filter! drop
|
||||
] 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 ] [
|
||||
0 H{
|
||||
{ 1 2 }
|
||||
|
|
|
@ -74,12 +74,21 @@ PRIVATE>
|
|||
: assoc-filter ( ... assoc quot: ( ... key value -- ... ? ) -- ... subassoc )
|
||||
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 )
|
||||
[
|
||||
over [ [ [ drop ] 2bi ] dip [ delete-at ] 2curry unless ] 2curry
|
||||
assoc-each
|
||||
] [ drop ] 2bi ; inline
|
||||
|
||||
: assoc-reject! ( ... assoc quot: ( ... key value -- ... ? ) -- ... assoc )
|
||||
[ not ] compose assoc-filter! ; inline
|
||||
|
||||
: sift-keys ( assoc -- assoc' )
|
||||
[ drop ] assoc-filter ; inline
|
||||
|
||||
|
|
Loading…
Reference in New Issue