assocs: Add harvest-keys, harvest-values to core/. Remove assoc-sift because it's sift-keys, sift-values in core/.
parent
21013d4571
commit
434f08a303
|
@ -161,6 +161,8 @@ $nl
|
|||
{ $subsections
|
||||
sift-keys
|
||||
sift-values
|
||||
harvest-keys
|
||||
harvest-values
|
||||
}
|
||||
"Mapping between assocs and sequences:"
|
||||
{ $subsections
|
||||
|
@ -343,11 +345,42 @@ HELP: assoc-subset?
|
|||
|
||||
HELP: sift-keys
|
||||
{ $values { "assoc" assoc } { "assoc'" "a new assoc" } }
|
||||
{ $description "Outputs an assoc removing keys that are " { $link f } "." } ;
|
||||
{ $description "Outputs an assoc removing keys that are " { $link f } "." }
|
||||
{ $examples
|
||||
{ $example "USING: prettyprint assocs hashtables ;"
|
||||
"H{ { 1 2 } { f 3 } } sift-keys ."
|
||||
"H{ { 1 2 } }" }
|
||||
} ;
|
||||
|
||||
HELP: sift-values
|
||||
{ $values { "assoc" assoc } { "assoc'" "a new assoc" } }
|
||||
{ $description "Outputs an assoc removing values that are " { $link f } "." } ;
|
||||
{ $description "Outputs an assoc removing values that are " { $link f } "." }
|
||||
{ $examples
|
||||
{ $example "USING: prettyprint assocs hashtables ;"
|
||||
"H{ { 1 f } { 3 4 } } sift-values ."
|
||||
"H{ { 3 4 } }" }
|
||||
} ;
|
||||
|
||||
{ sift-keys sift-values harvest-keys harvest-values } related-words
|
||||
|
||||
HELP: harvest-keys
|
||||
{ $values { "assoc" assoc } { "assoc'" "a new assoc" } }
|
||||
{ $description "Outputs an assoc removing keys that are empty sequences." }
|
||||
{ $examples
|
||||
{ $example "USING: prettyprint assocs hashtables ;"
|
||||
"H{ { { 2 } 1 } { { } 3 } } harvest-keys ."
|
||||
"H{ { { 2 } 1 } }" }
|
||||
} ;
|
||||
|
||||
HELP: harvest-values
|
||||
{ $values { "assoc" assoc } { "assoc'" "a new assoc" } }
|
||||
{ $description "Outputs an assoc removing values that are empty sequences." }
|
||||
{ $examples
|
||||
{ $example "USING: prettyprint assocs hashtables ;"
|
||||
"H{ { 1 { } } { 3 { 4 } } } harvest-values ."
|
||||
"H{ { 3 { 4 } } }" }
|
||||
} ;
|
||||
|
||||
|
||||
HELP: assoc=
|
||||
{ $values { "assoc1" assoc } { "assoc2" assoc } { "?" boolean } }
|
||||
|
|
|
@ -217,6 +217,28 @@ unit-test
|
|||
{ { 1 f } { f 2 } } sift-keys
|
||||
] unit-test
|
||||
|
||||
{
|
||||
{
|
||||
{ { 2 } 1 }
|
||||
}
|
||||
} [
|
||||
{
|
||||
{ { 2 } 1 }
|
||||
{ { } 3 }
|
||||
} harvest-keys
|
||||
] unit-test
|
||||
|
||||
{
|
||||
{
|
||||
{ 1 { 2 } }
|
||||
}
|
||||
} [
|
||||
{
|
||||
{ 1 { 2 } }
|
||||
{ 3 { } }
|
||||
} harvest-values
|
||||
] unit-test
|
||||
|
||||
{
|
||||
{ { f 2 } }
|
||||
} [
|
||||
|
|
|
@ -95,6 +95,12 @@ PRIVATE>
|
|||
: sift-values ( assoc -- assoc' )
|
||||
[ nip ] assoc-filter ; inline
|
||||
|
||||
: harvest-keys ( assoc -- assoc' )
|
||||
[ drop empty? ] assoc-reject ; inline
|
||||
|
||||
: harvest-values ( assoc -- assoc' )
|
||||
[ nip empty? ] assoc-reject ; inline
|
||||
|
||||
: assoc-partition ( ... assoc quot: ( ... key value -- ... ? ) -- ... true-assoc false-assoc )
|
||||
[ (assoc-each) partition ] [ drop ] 2bi
|
||||
[ assoc-like ] curry bi@ ; inline
|
||||
|
|
|
@ -5,12 +5,6 @@ USING: arrays assocs assocs.private kernel math sequences ;
|
|||
|
||||
IN: assocs.extras
|
||||
|
||||
: assoc-sift ( assoc -- assoc' )
|
||||
[ nip ] assoc-filter ; inline
|
||||
|
||||
: assoc-harvest ( assoc -- assoc' )
|
||||
[ nip empty? ] assoc-reject ; inline
|
||||
|
||||
: deep-at ( assoc seq -- value/f )
|
||||
[ of ] each ; inline
|
||||
|
||||
|
|
Loading…
Reference in New Issue