add if-seq and if-empty

diff --git a/extra/sequences/lib/lib-docs.factor b/extra/sequences/lib/lib-docs.factor
index 6f4a173874304f97420cf4235614c36e4fb7396e..14fb6eaebfcb0db0cab5b4b45fe765348d22afae 100755 (executable)
--- 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 ."\r
     "50"\r
 } ;\r
+\r
+HELP: if-seq\r
+{ $values { "seq" sequence } { "quot1" quotation } { "quot2" quotation } }\r
+{ $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." }\r
+{ $example\r
+    "USING: kernel prettyprint sequences sequences.lib ;"\r
+    "{ 1 2 3 } [ sum ] [ \"empty sequence\" throw ] if-seq ."\r
+    "6"\r
+} ;\r
+\r
+HELP: if-empty\r
+{ $values { "seq" sequence } { "quot1" quotation } { "quot2" quotation } }\r
+{ $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." }\r
+{ $example\r
+    "USING: kernel prettyprint sequences sequences.lib ;"\r
+    "{ 1 2 3 } [ \"empty sequence\" ] [ sum ] if-empty ."\r
+    "6"\r
+} ;\r
+\r
+{ if-seq if-empty } related-words\r

diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor
index 99565e966cc42600258a3ebd3c68e806e0d708db..019796c1a11856c8ac3aea4345c6013e881860e2 100755 (executable)
--- 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 b703bb55a01499c39d2ef951e1c17910a7a9f099..b26acbc54495e4d4ae73b758a11ee17ba9d49c7e 100755 (executable)
--- 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