From 4186034de6ab147970037c98087a84f64c15ebb7 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
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