if-empty changes

extra/backtrack/backtrack.factor

@@ -50,9 +50,8 @@ PRIVATE>
     [ amb-integer ] [ nth ] bi ;
 
 : amb ( seq -- elt )
-    dup empty?
-    [ drop fail f ]
-    [ unsafe-amb ] if ; inline
+    [ fail f ]
+    [ unsafe-amb ] if-empty ; inline
 
 MACRO: amb-execute ( seq -- quot )
     [ length 1 - ] [ <enum> [ 1quotation ] assoc-map ] bi

extra/cords/cords.factor

@@ -27,7 +27,7 @@ M: multi-cord virtual@
     [ first - ] [ second ] bi ;
 
 M: multi-cord virtual-seq
-    seqs>> dup empty? [ drop f ] [ first second ] if ;
+    seqs>> [ f ] [ first second ] if-empty ;
 
 : <cord> ( seqs -- cord )
     dup length 2 = [

extra/game-input/backend/iokit/iokit.factor

@@ -58,7 +58,7 @@ SINGLETON: iokit-game-input-backend
     buttons-matching-hash device-elements-matching length ;
 
 : ?axis ( device hash -- axis/f )
-    device-elements-matching dup empty? [ drop f ] [ first ] if ;
+    device-elements-matching [ f ] [ first ] if-empty ;
 
 : ?x-axis ( device -- ? )
     x-axis-matching-hash ?axis ;

extra/html/parser/parser.factor

@@ -103,11 +103,9 @@ SYMBOL: tagstack
     [ get-char CHAR: < = ] take-until ;
 
 : parse-text ( -- )
-    read-until-< dup empty? [
-        drop
-    ] [
+    read-until-< [
         make-text-tag push-tag
-    ] if ;
+    ] unless-empty ;
 
 : (parse-attributes) ( -- )
     read-whitespace*

extra/inverse/inverse.factor

@@ -34,9 +34,8 @@ M: no-inverse summary
     drop "The word cannot be used in pattern matching" ;
 
 : next ( revquot -- revquot* first )
-    dup empty?
     [ "Badly formed math inverse" throw ]
-    [ unclip-slice ] if ;
+    [ unclip-slice ] if-empty ;
 
 : constant-word? ( word -- ? )
     stack-effect
@@ -116,8 +115,7 @@ M: pop-inverse inverse
     "pop-inverse" word-prop compose call ;
 
 : (undo) ( revquot -- )
-    dup empty? [ drop ]
-    [ unclip-slice inverse % (undo) ] if ;
+    [ unclip-slice inverse % (undo) ] unless-empty ;
 
 : [undo] ( quot -- undo )
     flatten fold reverse [ (undo) ] [ ] make ;

extra/irc/ui/commandparser/commandparser.factor

@@ -8,7 +8,7 @@ IN: irc.ui.commandparser
 "irc.ui.commands" require
 
 : command ( string string -- string command )
-    dup empty? [ drop "say" ] when
+    [ "say" ] when-empty
     dup "irc.ui.commands" lookup
     [ nip ]
     [ " " append prepend "quote" "irc.ui.commands" lookup ] if* ;

extra/irc/ui/ui.factor

@@ -32,8 +32,8 @@ TUPLE: irc-tab < frame listener client window ;
 : dark-green T{ rgba f 0.0 0.5 0.0 1 } ;
 
 : dot-or-parens ( string -- string )
-    dup empty? [ drop "." ]
-    [ "(" prepend ")" append ] if ;
+    [ "." ]
+    [ "(" prepend ")" append ] if-empty ;
 
 GENERIC: write-irc ( irc-message -- )
 

extra/koszul/koszul.factor

@@ -115,8 +115,7 @@ DEFER: (d)
 : x.dy ( x y -- vec ) (d) wedge -1 alt*n ;
 
 : (d) ( product -- value )
-    dup empty?
-    [ drop H{ } ] [ unclip swap [ x.dy ] 2keep dx.y alt+ ] if ;
+    [ H{ } ] [ unclip swap [ x.dy ] 2keep dx.y alt+ ] if-empty ;
 
 : linear-op ( vec quot -- vec )
         [
@@ -211,7 +210,7 @@ DEFER: (d)
 : m'.m ( matrix -- matrix' ) dup flip swap m. ;
 
 : empty-matrix? ( matrix -- ? )
-    dup empty? [ drop t ] [ first empty? ] if ;
+    [ t ] [ first empty? ] if-empty ;
 
 : ?m+ ( m1 m2 -- m3 )
     over empty-matrix? [

extra/math/polynomials/polynomials.factor

@@ -15,7 +15,7 @@ IN: math.polynomials
 : 2pad-right ( p p n -- p p ) 0 [ pad-right swap ] 2keep pad-right swap ;
 : pextend ( p p -- p p ) 2dup [ length ] bi@ max 2pad-right ;
 : pextend-left ( p p -- p p ) 2dup [ length ] bi@ max 2pad-left ;
-: unempty ( seq -- seq ) dup empty? [ drop { 0 } ] when ;
+: unempty ( seq -- seq ) [ { 0 } ] when-empty ;
 : 2unempty ( seq seq -- seq seq ) [ unempty ] bi@ ;
 
 PRIVATE>

extra/math/primes/factors/factors.factor

@@ -10,11 +10,11 @@ IN: math.primes.factors
 
 : (count) ( n d -- n' )
     [ (factor) ] { } make
-    dup empty? [ drop ] [ [ first ] keep length 2array , ] if ;
+    [ [ first ] keep length 2array , ] unless-empty ;
 
 : (unique) ( n d -- n' )
     [ (factor) ] { } make
-    dup empty? [ drop ] [ first , ] if ;
+    [ first , ] unless-empty ;
 
 : (factors) ( quot list n -- )
     dup 1 > [ swap uncons swap >r pick call r> swap (factors) ] [ 3drop ] if ;

extra/math/text/english/english.factor

@@ -57,11 +57,9 @@ SYMBOL: and-needed?
 
 : text-with-scale ( index seq -- str )
     dupd nth 3digits>text swap
-    scale-numbers dup empty? [
-        drop
-    ] [
+    scale-numbers [
         " " swap 3append
-    ] if ;
+    ] unless-empty ;
 
 : append-with-conjunction ( str1 str2 -- newstr )
     over length zero? [

extra/money/money.factor

@@ -22,7 +22,7 @@ ERROR: not-a-decimal x ;
 : parse-decimal ( str -- ratio )
     "." split1
     >r dup "-" head? [ drop t "0" ] [ f swap ] if r>
-    [ dup empty? [ drop "0" ] when ] bi@
+    [ [ "0" ] when-empty ] bi@
     dup length
     >r [ dup string>number [ nip ] [ not-a-decimal ] if* ] bi@ r>
     10 swap ^ / + swap [ neg ] when ;

extra/multi-methods/multi-methods.factor

@@ -112,10 +112,10 @@ SYMBOL: total
     dup length <reversed>
     [ picker 2array ] 2map
     [ drop object eq? not ] assoc-filter
-    dup empty? [ drop [ t ] ] [
+    [ [ t ] ] [
         [ (multi-predicate) ] { } assoc>map
         unclip [ swap [ f ] \ if 3array append [ ] like ] reduce
-    ] if ;
+    ] if-empty ;
 
 : argument-count ( methods -- n )
     keys 0 [ length max ] reduce ;

extra/pack/pack.factor

@@ -84,7 +84,7 @@ M: string b, ( n string -- ) heap-size b, ;
     "\0" read-until [ drop f ] unless ;
 
 : read-c-string* ( n -- str/f )
-    read [ zero? ] trim-right dup empty? [ drop f ] when ;
+    read [ zero? ] trim-right [ f ] when-empty ;
 
 : (read-128-ber) ( n -- n )
     read1

extra/porter-stemmer/porter-stemmer.factor

@@ -163,11 +163,11 @@ USING: kernel math parser sequences combinators splitting ;
     } cond ;
 
 : -ion ( str -- newstr )
-    dup empty? [
-        drop "ion"
+    [
+        "ion"
     ] [
         dup "st" last-is? [ "ion" append ] unless
-    ] if ;
+    ] if-empty ;
 
 : step4 ( str -- newstr )
     dup {

extra/project-euler/079/079.factor

@@ -36,7 +36,7 @@ IN: project-euler.079
 
 : find-source ( seq -- elt )
     unzip diff prune
-    dup empty? [ "Topological sort failed" throw ] [ first ] if ;
+    [ "Topological sort failed" throw ] [ first ] if-empty ;
 
 : remove-source ( seq elt -- seq )
     [ swap member? not ] curry filter ;
@@ -45,7 +45,7 @@ IN: project-euler.079
     dup length 1 > [
         dup find-source dup , remove-source (topological-sort)
     ] [
-        dup empty? [ drop ] [ first [ , ] each ] if
+        [ first [ , ] each ] unless-empty
     ] if ;
 
 PRIVATE>

extra/reports/noise/noise.factor

@@ -155,11 +155,11 @@ M: lambda-word word-noise-factor
 : vocab-noise-factor ( vocab -- factor )
     words flatten-generics
     [ word-noise-factor dup 20 < [ drop 0 ] when ] map
-    dup empty? [ drop 0 ] [
+    [ 0 ] [
         [ [ sum ] [ length 5 max ] bi /i ]
         [ supremum ]
         bi +
-    ] if ;
+    ] if-empty ;
 
 : noisy-vocabs ( -- alist )
     vocabs [ dup vocab-noise-factor ] { } map>assoc

extra/sequences/lib/lib-docs.factor

@@ -18,23 +18,3 @@ HELP: each-withn
 "passed to the quotation given to each-withn for each element in the sequence."
 } 
 { $see-also map-withn } ;
-
-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

extra/sequences/lib/lib-tests.factor

@@ -63,6 +63,3 @@ IN: sequences.lib.tests
 [ 1 2 { 3 4 } [ + + drop ] 2 each-withn  ] must-infer
 { 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test
 [ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test
-
-[ "empty" ] [ { } [ "not empty" ] [ "empty" ] if-seq ] unit-test
-[ { 1 } "not empty" ] [ { 1 } [ "not empty" ] [ "empty" ] if-seq ] unit-test

extra/sequences/lib/lib.factor

@@ -189,12 +189,3 @@ PRIVATE>
 
 : ?nth* ( n seq -- elt/f ? )
     2dup bounds-check? [ nth-unsafe t ] [ 2drop f f ] if ; flushable
-
-: if-seq ( seq quot1 quot2 -- ) [ f like ] 2dip if* ; inline
- 
-: if-empty ( seq quot1 quot2 -- ) swap if-seq ; inline
-
-: when-empty ( seq quot1 -- ) [ ] if-empty ; inline
-
-: unless-empty ( seq quot1 -- ) [ ] swap if-empty ; inline
-

extra/units/units.factor

@@ -19,8 +19,8 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ;
     [ remove-one ] curry bi@ ;
 
 : symbolic-reduce ( seq seq -- seq seq )
-    2dup intersect dup empty?
-    [ drop ] [ first 2remove-one symbolic-reduce ] if ;
+    2dup intersect
+    [ first 2remove-one symbolic-reduce ] unless-empty ;
 
 : <dimensioned> ( n top bot -- obj )
     symbolic-reduce

extra/xml/syntax/syntax.factor

@@ -21,10 +21,10 @@ IN: xml.syntax
 DEFER: >>
 
 : attributes-parsed ( accum quot -- accum )
-    dup empty? [ drop f parsed ] [
+    [ f parsed ] [
         >r \ >r parsed r> parsed
         [ H{ } make-assoc r> swap ] [ parsed ] each
-    ] if ;
+    ] if-empty ;
 
 : <<
     parsed-name [