if-empty changes

diff --git a/extra/backtrack/backtrack.factor b/extra/backtrack/backtrack.factor
index db2c50173c9f8c85c7585fb448d4e9e5bf4bb9f9..df397025f60f9399971fb1efcc1a60a8b5afce9e 100755 (executable)
--- a/extra/backtrack/backtrack.factor
+++ b/extra/backtrack/backtrack.factor
@@ -50,9 +50,8 @@ PRIVATE>
     [ amb-integer ] [ nth ] bi ;\r
 \r
 : amb ( seq -- elt )\r
-    dup empty?\r
-    [ drop fail f ]\r
-    [ unsafe-amb ] if ; inline\r
+    [ fail f ]\r
+    [ unsafe-amb ] if-empty ; inline\r
 \r
 MACRO: amb-execute ( seq -- quot )\r
     [ length 1 - ] [ <enum> [ 1quotation ] assoc-map ] bi\r

diff --git a/extra/cords/cords.factor b/extra/cords/cords.factor
index 52cb9914b4e8db65334d30a640537f839bab2ee3..915744491fa6ce3b1c97a495da767e755592a592 100644 (file)
--- a/extra/cords/cords.factor
+++ b/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 = [

diff --git a/extra/game-input/backend/iokit/iokit.factor b/extra/game-input/backend/iokit/iokit.factor
index 4a7d251425e57706fa5fbb37a7292a52ce9f8b3c..5267dd6d6e9f3c69912a2a69c86db526a5ea2ba7 100755 (executable)
--- a/extra/game-input/backend/iokit/iokit.factor
+++ b/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 ;

diff --git a/extra/html/parser/parser.factor b/extra/html/parser/parser.factor
index 94a50196a6b6041264d20766df8426a6937a5cbd..ccd225e6e0b9341eaf8aeb911bb2f2eba03e2992 100644 (file)
--- a/extra/html/parser/parser.factor
+++ b/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*

diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor
index c7925b94bed4b86a57e5c8724294bbbd9eee72e1..b843c73983d6adafb616fef992dee8bc98ec9a7f 100755 (executable)
--- a/extra/inverse/inverse.factor
+++ b/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 ;

diff --git a/extra/irc/ui/commandparser/commandparser.factor b/extra/irc/ui/commandparser/commandparser.factor
index 2835023c0d624aedda30d7f2baf9c114f990addd..163517698ae94fa2636032c236c33c14707ecaee 100755 (executable)
--- a/extra/irc/ui/commandparser/commandparser.factor
+++ b/extra/irc/ui/commandparser/commandparser.factor
@@ -8,7 +8,7 @@ IN: irc.ui.commandparser
 "irc.ui.commands" require\r
 \r
 : command ( string string -- string command )\r
-    dup empty? [ drop "say" ] when\r
+    [ "say" ] when-empty\r
     dup "irc.ui.commands" lookup\r
     [ nip ]\r
     [ " " append prepend "quote" "irc.ui.commands" lookup ] if* ;\r

diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor
index 1aebfcbfcb684b0fe76d4d942703723070fefbe4..457a98482056a513f25dc0b4ae771d26507302bb 100755 (executable)
--- a/extra/irc/ui/ui.factor
+++ b/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 } ;\r
 \r
 : dot-or-parens ( string -- string )\r
-    dup empty? [ drop "." ]\r
-    [ "(" prepend ")" append ] if ;\r
+    [ "." ]\r
+    [ "(" prepend ")" append ] if-empty ;\r
 \r
 GENERIC: write-irc ( irc-message -- )\r
 \r

diff --git a/extra/koszul/koszul.factor b/extra/koszul/koszul.factor
index 2b67a3755e23d06901faea9a1165c0dcc69ed534..5bd679d92a737e29ae153b36669c120504db6ee5 100755 (executable)
--- a/extra/koszul/koszul.factor
+++ b/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? [

diff --git a/extra/math/polynomials/polynomials.factor b/extra/math/polynomials/polynomials.factor
index 1883f5692982a02ccc3096e1cc7828dbf3627ddf..018b041afd493be3c12987584a8ff54d477d2845 100644 (file)
--- a/extra/math/polynomials/polynomials.factor
+++ b/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>

diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor
index aba7e90bc906da5b1cf6cd7ed7e93742dc649ca2..83d53c42153a59040665e4bb903881eeef9369c8 100644 (file)
--- a/extra/math/primes/factors/factors.factor
+++ b/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 ;

diff --git a/extra/math/text/english/english.factor b/extra/math/text/english/english.factor
index b8256533bf438f946f6bfb128bb4eb7e263a7e74..387be4d7912f240cada6484e965b884efc76fd87 100755 (executable)
--- a/extra/math/text/english/english.factor
+++ b/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? [

diff --git a/extra/money/money.factor b/extra/money/money.factor
index bf9f4d3a67952ba0a4089c1b5f72697bf9035b9a..fb743e15af24568ffc4fe9ee1b43175d85e57430 100644 (file)
--- a/extra/money/money.factor
+++ b/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 ;

diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor
index 8859f07340b4d8cfef8792d1d04856020d56b94f..a8025828f1fb6d876d6809e701f09ee18ec9dbea 100755 (executable)
--- a/extra/multi-methods/multi-methods.factor
+++ b/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 ;

diff --git a/extra/pack/pack.factor b/extra/pack/pack.factor
index b487b385b918ccde3c2c8bd9eac009e9176b6130..a5d4b36c0b651cf17f926960a148e3c982749314 100755 (executable)
--- a/extra/pack/pack.factor
+++ b/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

diff --git a/extra/porter-stemmer/porter-stemmer.factor b/extra/porter-stemmer/porter-stemmer.factor
index 9a2a08bcbeb45b4f7fea169f678f8a596ff5e192..7ae273f20a7cc76120c632ed3f55f46cb8a49db5 100644 (file)
--- a/extra/porter-stemmer/porter-stemmer.factor
+++ b/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 {

diff --git a/extra/project-euler/079/079.factor b/extra/project-euler/079/079.factor
index f64c345694d5690280d3b1ba548873fd79b22df3..1e6a2fb0b477be3526e97cb8b91db01f0dbd6295 100644 (file)
--- a/extra/project-euler/079/079.factor
+++ b/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>

diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor
index 4a361210463fe252b9d6bf25ed87b4096aa1baf3..78ede328013cd382dd1333ba2652d8c427c7107f 100755 (executable)
--- a/extra/reports/noise/noise.factor
+++ b/extra/reports/noise/noise.factor
@@ -155,11 +155,11 @@ M: lambda-word word-noise-factor
 : vocab-noise-factor ( vocab -- factor )\r
     words flatten-generics\r
     [ word-noise-factor dup 20 < [ drop 0 ] when ] map\r
-    dup empty? [ drop 0 ] [\r
+    [ 0 ] [\r
         [ [ sum ] [ length 5 max ] bi /i ]\r
         [ supremum ]\r
         bi +\r
-    ] if ;\r
+    ] if-empty ;\r
 \r
 : noisy-vocabs ( -- alist )\r
     vocabs [ dup vocab-noise-factor ] { } map>assoc\r

diff --git a/extra/sequences/lib/lib-docs.factor b/extra/sequences/lib/lib-docs.factor
index b2e805304ed07914b069934a9ae7762d3846eef6..9975da00db05628c123072f7cd562aade7f9b3ec 100755 (executable)
--- a/extra/sequences/lib/lib-docs.factor
+++ b/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."\r
 } \r
 { $see-also map-withn } ;\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 76f3bb4f5b61d159a11740fe6fe0b8cb1fd5c5dd..12bdd45c46cd67f985fc0e7e20ba712d4f302754 100755 (executable)
--- a/extra/sequences/lib/lib-tests.factor
+++ b/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

diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor
index 2eb3c44b421755f7380b9fc21beec35525011f6b..225b3b7d9ed84dc6fed4eb25245dacff2c9fc6f3 100755 (executable)
--- a/extra/sequences/lib/lib.factor
+++ b/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
-

diff --git a/extra/units/units.factor b/extra/units/units.factor
index 7604108b82cd00d9b130fa95cb8b9db52e0cc0f9..02005fcd1f6c4143f2dc928a0c817204d48383ac 100755 (executable)
--- a/extra/units/units.factor
+++ b/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

diff --git a/extra/xml/syntax/syntax.factor b/extra/xml/syntax/syntax.factor
index 283efa84120ce04d97026ad70316c75c089f2e74..6b765461e579c2b33128e85823fe3e797993f292 100644 (file)
--- a/extra/xml/syntax/syntax.factor
+++ b/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 [