From 4186034de6ab147970037c98087a84f64c15ebb7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 23 May 2008 23:25:32 -0500 Subject: [PATCH] add if-seq and if-empty --- extra/sequences/lib/lib-docs.factor | 20 ++++++++++++++++++++ extra/sequences/lib/lib-tests.factor | 6 ++++++ extra/sequences/lib/lib.factor | 6 ++++++ 3 files changed, 32 insertions(+) diff --git a/extra/sequences/lib/lib-docs.factor b/extra/sequences/lib/lib-docs.factor index 6f4a173874..14fb6eaebf 100755 --- a/extra/sequences/lib/lib-docs.factor +++ b/extra/sequences/lib/lib-docs.factor @@ -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 diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor index 99565e966c..019796c1a1 100755 --- a/extra/sequences/lib/lib-tests.factor +++ b/extra/sequences/lib/lib-tests.factor @@ -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 diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index b703bb55a0..b26acbc544 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -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