use if/when/unless-empty, docs

diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor
index 0f419678d1c0af11d00153988d274743001f1871..b32bac3a18b8bc04925411891a20466452ab1315 100755 (executable)
--- a/core/classes/algebra/algebra.factor
+++ b/core/classes/algebra/algebra.factor
@@ -208,9 +208,9 @@ M: anonymous-complement (classes-intersect?)
 \r
 : min-class ( class seq -- class/f )\r
     over [ classes-intersect? ] curry filter\r
-    dup empty? [ 2drop f ] [\r
+    [ drop f ] [\r
         tuck [ class<= ] with all? [ peek ] [ drop f ] if\r
-    ] if ;\r
+    ] if-empty ;\r
 \r
 GENERIC: (flatten-class) ( class -- )\r
 \r

diff --git a/core/classes/builtin/builtin.factor b/core/classes/builtin/builtin.factor
index b0e4754682b9f3029fe15034a723bb480d6ab477..ee687c2939abd1e49a7118eca546e4686582995b 100644 (file)
--- a/core/classes/builtin/builtin.factor
+++ b/core/classes/builtin/builtin.factor
@@ -44,11 +44,11 @@ M: builtin-class (classes-intersect?)
 
 M: anonymous-intersection (flatten-class)
     participants>> [ flatten-builtin-class ] map
-    dup empty? [
-        drop builtins get sift [ (flatten-class) ] each
+    [
+        builtins get sift [ (flatten-class) ] each
     ] [
         unclip [ assoc-intersect ] reduce [ swap set ] assoc-each
-    ] if ;
+    ] if-empty ;
 
 M: anonymous-complement (flatten-class)
     drop builtins get sift [ (flatten-class) ] each ;

diff --git a/core/classes/intersection/intersection.factor b/core/classes/intersection/intersection.factor
index bb7e0adc6222653486ed5407125ab17ddc415a2b..55831fcdb4936e89e85e8f0b9d8a631b73b5e147 100644 (file)
--- a/core/classes/intersection/intersection.factor
+++ b/core/classes/intersection/intersection.factor
@@ -8,14 +8,14 @@ PREDICATE: intersection-class < class
     "metaclass" word-prop intersection-class eq? ;
 
 : intersection-predicate-quot ( members -- quot )
-    dup empty? [
-        drop [ drop t ]
+    [
+        [ drop t ]
     ] [
         unclip "predicate" word-prop swap [
             "predicate" word-prop [ dup ] swap [ not ] 3append
             [ drop f ]
         ] { } map>assoc alist>quot
-    ] if ;
+    ] if-empty ;
 
 : define-intersection-predicate ( class -- )
     dup participants intersection-predicate-quot define-predicate ;

diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor
index 0865de16c3e88336a4c9678876aa631f05fe8ec1..531658a5e0c5507799616f4d14a9ed332106493c 100644 (file)
--- a/core/classes/tuple/parser/parser.factor
+++ b/core/classes/tuple/parser/parser.factor
@@ -26,7 +26,7 @@ ERROR: duplicate-slot-names names ;
 
 : check-duplicate-slots ( slots -- )
     slot-names duplicates
-    dup empty? [ drop ] [ duplicate-slot-names ] if ;
+    [ duplicate-slot-names ] unless-empty ;
 
 ERROR: invalid-slot-name name ;
 

diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor
index fbb1925363b7b4fa8b530fe38db607afe07f5165..81a0db52be467a332021d0ed0e711e47d8e1b148 100755 (executable)
--- a/core/classes/union/union.factor
+++ b/core/classes/union/union.factor
@@ -8,14 +8,14 @@ PREDICATE: union-class < class
     "metaclass" word-prop union-class eq? ;
 
 : union-predicate-quot ( members -- quot )
-    dup empty? [
-        drop [ drop f ]
+    [
+        [ drop f ]
     ] [
         unclip "predicate" word-prop swap [
             "predicate" word-prop [ dup ] prepend
             [ drop t ]
         ] { } map>assoc alist>quot
-    ] if ;
+    ] if-empty ;
 
 : define-union-predicate ( class -- )
     dup members union-predicate-quot define-predicate ;

diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor
index bed1c16bcf0f72ec695c47e4ffdec4eda0746dc9..154e1c30ac098180e80702b5c921a4079b1a09a9 100755 (executable)
--- a/core/destructors/destructors.factor
+++ b/core/destructors/destructors.factor
@@ -21,7 +21,7 @@ M: object dispose
 : dispose-each ( seq -- )
     [
         [ [ dispose ] curry [ , ] recover ] each
-    ] { } make dup empty? [ drop ] [ peek rethrow ] if ;
+    ] { } make [ peek rethrow ] unless-empty ;
 
 : with-disposal ( object quot -- )
     over [ dispose ] curry [ ] cleanup ; inline

diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 93405fe7c04003f5f57bb72d197d88737c080e62..e52799d10ab5e3e65a523ede96570204dcbfaab9 100755 (executable)
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -59,7 +59,7 @@ HOOK: (file-appender) io-backend ( path -- stream )
 HOOK: root-directory? io-backend ( path -- ? )
 
 M: object root-directory? ( path -- ? )
-    dup empty? [ drop f ] [ [ path-separator? ] all? ] if ;
+    [ f ] [ [ path-separator? ] all? ] if-empty ;
 
 ERROR: no-parent-directory path ;
 
@@ -80,7 +80,7 @@ ERROR: no-parent-directory path ;
 
 : head-path-separator? ( path1 ? -- ?' )
     [
-        dup empty? [ drop t ] [ first path-separator? ] if
+        [ t ] [ first path-separator? ] if-empty
     ] [
         drop f
     ] if ;

diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor
index 607076b80989f43f98a30e40995c92ffd31b3498..b2b75509e9874a4a458e409e4886c0d1df3806b1 100755 (executable)
--- a/core/io/streams/string/string.factor
+++ b/core/io/streams/string/string.factor
@@ -18,7 +18,7 @@ M: growable stream-flush drop ;
     <string-writer> swap [ output-stream get ] compose with-output-stream*
     >string ; inline
 
-M: growable stream-read1 dup empty? [ drop f ] [ pop ] if ;
+M: growable stream-read1 [ f ] [ pop ] if-empty ;
 
 : harden-as ( seq growble-exemplar -- newseq )
     underlying>> like ;
@@ -39,13 +39,13 @@ M: growable stream-read-until
     ] if ;
 
 M: growable stream-read
-    dup empty? [
-        2drop f
+    [
+        drop f
     ] [
         [ length swap - 0 max ] keep
         [ swap growable-read-until ] 2keep
         set-length
-    ] if ;
+    ] if-empty ;
 
 M: growable stream-read-partial
     stream-read ;

diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index 4ada1ece9a514e535213b8808ba6e8c2dcced76c..ea713b08147a9c94c38ba5524436f27d215323ae 100755 (executable)
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -335,6 +335,42 @@ HELP: if-empty
     "6"
 } ;
 
+HELP: when-empty
+{ $values
+     { "seq" sequence } { "quot1" quotation } }
+{ $description "Makes an implicit check if the sequence is empty. An empty sequence is dropped and the " { $snippet "quot1" } " is called." }
+{ $examples "This word is equivalent to " { $link if-empty } " with an empty second quotation:"
+    { $example
+    "USING: sequences prettyprint ;"
+    "{ } [ { 4 5 6 } ] [ ] if-empty ."
+    "{ 4 5 6 }"
+    }
+    { $example
+    "USING: sequences prettyprint ;"
+    "{ } [ { 4 5 6 } ] when-empty ."
+    "{ 4 5 6 }"
+    }
+} ;
+
+HELP: unless-empty
+{ $values
+     { "seq" sequence } { "quot2" quotation } }
+{ $description "Makes an implicit check if the sequence is empty. An empty sequence is dropped. Otherwise, the " { $snippet "quot2" } " is called on the sequence.." }
+{ $examples "This word is equivalent to " { $link if-empty } " with an empty first quotation:"
+    { $example
+    "USING: sequences prettyprint ;"
+    "{ 4 5 6 } [ ] [ sum ] if-empty ."
+    "15"
+    }
+    { $example
+    "USING: sequences prettyprint ;"
+    "{ 4 5 6 } [ sum ] unless-empty ."
+    "15"
+    }
+} ;
+
+{ if-empty when-empty unless-empty } related-words
+
 HELP: delete-all
 { $values { "seq" "a resizable sequence" } }
 { $description "Resizes the sequence to zero length, removing all elements. Not all sequences are resizable." }

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index b7f36eb07139680afe64afac76862dc54355745a..18291aaa7046c134bfd816c45a776039e91e1a89 100755 (executable)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -34,7 +34,7 @@ M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ;
 
 : when-empty ( seq quot1 -- ) [ ] if-empty ; inline
 
-: unless-empty ( seq quot1 -- ) [ ] swap if-empty ; inline
+: unless-empty ( seq quot2 -- ) [ ] swap if-empty ; inline
 
 : delete-all ( seq -- ) 0 swap set-length ;
 
@@ -91,7 +91,7 @@ M: sequence set-nth-unsafe set-nth ;
 ! The f object supports the sequence protocol trivially
 M: f length drop 0 ;
 M: f nth-unsafe nip ;
-M: f like drop dup empty? [ drop f ] when ;
+M: f like drop [ f ] when-empty ;
 
 INSTANCE: f immutable-sequence
 
@@ -630,14 +630,14 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
     0 [ length + ] reduce ;
 
 : concat ( seq -- newseq )
-    dup empty? [
-        drop { }
+    [
+        { }
     ] [
         [ sum-lengths ] keep
         [ first new-resizable ] keep
         [ [ over push-all ] each ] keep
         first like
-    ] if ;
+    ] if-empty ;
 
 : joined-length ( seq glue -- n )
     >r dup sum-lengths swap length 1 [-] r> length * + ;