add if-seq and if-empty

db4
Doug Coleman 2008-05-23 23:25:32 -05:00
parent 104baa137c
commit 4186034de6
3 changed files with 32 additions and 0 deletions

View File

@ -37,3 +37,23 @@ HELP: count
"100 [1,b] [ even? ] count ."
"50"
} ;
HELP: if-seq
{ $values { "seq" sequence } { "quot1" quotation } { "quot2" quotation } }
{ $description "Makes an implicit check if the sequence is empty. If the sequence has any elements, " { $snippet "quot1" } " is called on it. Otherwise, the empty sequence is dropped and " { $snippet "quot2" } " is called." }
{ $example
"USING: kernel prettyprint sequences sequences.lib ;"
"{ 1 2 3 } [ sum ] [ \"empty sequence\" throw ] if-seq ."
"6"
} ;
HELP: if-empty
{ $values { "seq" sequence } { "quot1" quotation } { "quot2" quotation } }
{ $description "Makes an implicit check if the sequence is empty. An empty sequence is dropped and " { $snippet "quot1" } " is called. Otherwise, if the sequence has any elements, " { $snippet "quot2" } " is called on it." }
{ $example
"USING: kernel prettyprint sequences sequences.lib ;"
"{ 1 2 3 } [ \"empty sequence\" ] [ sum ] if-empty ."
"6"
} ;
{ if-seq if-empty } related-words

View File

@ -79,3 +79,9 @@ IN: sequences.lib.tests
[ ] [ { } 0 firstn ] unit-test
[ "a" ] [ { "a" } 1 firstn ] unit-test
[ "empty" ] [ { } [ "not empty" ] [ "empty" ] if-seq ] unit-test
[ { 1 } "not empty" ] [ { 1 } [ "not empty" ] [ "empty" ] if-seq ] unit-test
[ "empty" ] [ { } [ "empty" ] [ "not empty" ] if-empty ] unit-test
[ { 1 } "not empty" ] [ { 1 } [ "empty" ] [ "not empty" ] if-empty ] unit-test

View File

@ -243,3 +243,9 @@ PRIVATE>
: short ( seq n -- seq n' )
over length min ; inline
: if-seq ( seq quot1 quot2 -- )
[ f like ] 2dip if* ; inline
: if-empty ( seq quot1 quot2 -- )
swap if-seq ; inline