use if/when/unless-empty, docs

core/classes/algebra/algebra.factor

@@ -208,9 +208,9 @@ M: anonymous-complement (classes-intersect?)
 
 : min-class ( class seq -- class/f )
     over [ classes-intersect? ] curry filter
-    dup empty? [ 2drop f ] [
+    [ drop f ] [
         tuck [ class<= ] with all? [ peek ] [ drop f ] if
-    ] if ;
+    ] if-empty ;
 
 GENERIC: (flatten-class) ( class -- )
 

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 ;

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 ;

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 ;
 

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 ;

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

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 ;

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 ;

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." }

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 * + ;