From 14ef1649d423a8e6b18f8c50b3f9c8d8ae2fc55b Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 11 Aug 2009 17:59:40 -0500
Subject: [PATCH] add if-zero/when-zero/unless-zero to core/ and update usages

---
 core/arrays/arrays.factor            |  2 +-
 core/io/encodings/utf8/utf8.factor   |  4 ++--
 core/math/integers/integers.factor   |  6 +++---
 core/math/parser/parser.factor       |  2 +-
 core/sequences/sequences-docs.factor |  2 +-
 core/sequences/sequences.factor      | 16 +++++++++++++++-
 core/splitting/splitting.factor      |  2 +-
 7 files changed, 24 insertions(+), 10 deletions(-)

diff --git a/core/arrays/arrays.factor b/core/arrays/arrays.factor
index 4a998a1ebb..dd70e45b6b 100644
--- a/core/arrays/arrays.factor
+++ b/core/arrays/arrays.factor
@@ -14,7 +14,7 @@ M: array resize resize-array ;
 
 M: object new-sequence drop 0 <array> ;
 
-M: f new-sequence drop dup zero? [ drop f ] [ 0 <array> ] if ;
+M: f new-sequence drop [ f ] [ 0 <array> ] if-zero ;
 
 M: array equal?
     over array? [ sequence= ] [ 2drop f ] if ;
diff --git a/core/io/encodings/utf8/utf8.factor b/core/io/encodings/utf8/utf8.factor
index 4846b06f32..a722655cad 100755
--- a/core/io/encodings/utf8/utf8.factor
+++ b/core/io/encodings/utf8/utf8.factor
@@ -73,14 +73,14 @@ M: utf8 encode-char
 PRIVATE>
 
 : code-point-length ( n -- x )
-    dup zero? [ drop 1 ] [
+    [ 1 ] [
         log2 {
             { [ dup 0 6 between? ] [ 1 ] }
             { [ dup 7 10 between? ] [ 2 ] }
             { [ dup 11 15 between? ] [ 3 ] }
             { [ dup 16 20 between? ] [ 4 ] }
         } cond nip
-    ] if ;
+    ] if-zero ;
 
 : code-point-offsets ( string -- indices )
     0 [ code-point-length + ] accumulate swap suffix ;
diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor
index bb7fc107b2..2b35ef76fd 100644
--- a/core/math/integers/integers.factor
+++ b/core/math/integers/integers.factor
@@ -121,14 +121,14 @@ M: bignum (log2) bignum-log2 ;
     over zero? [
         2drop 0.0
     ] [
-        dup zero? [
-            2drop 1/0.
+        [
+            drop 1/0.
         ] [
             pre-scale
             /f-loop over odd?
             [ zero? [ 1 + ] unless ] [ drop ] if
             post-scale
-        ] if
+        ] if-zero
     ] if ; inline
 
 M: bignum /f ( m n -- f )
diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor
index 437308d53f..ef8f350e27 100644
--- a/core/math/parser/parser.factor
+++ b/core/math/parser/parser.factor
@@ -131,7 +131,7 @@ M: ratio >base
     [
         dup 0 < negative? set
         abs 1 /mod
-        [ dup zero? [ drop "" ] [ (>base) sign append ] if ]
+        [ [ "" ] [ (>base) sign append ] if-zero ]
         [
             [ numerator (>base) ]
             [ denominator (>base) ] bi
diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index 71d42705a2..d7db7f5242 100755
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -1214,7 +1214,7 @@ HELP: follow
 { $examples "Get random numbers until zero is reached:"
     { $unchecked-example
     "USING: random sequences prettyprint math ;"
-    "100 [ random dup zero? [ drop f ] when ] follow ."
+    "100 [ random [ f ] when-zero ] follow ."
     "{ 100 86 34 32 24 11 7 2 }"
 } } ;
 
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index f0dc6d36c7..2e41d9d2e1 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -29,13 +29,27 @@ M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ;
 
 : empty? ( seq -- ? ) length 0 = ; inline
 
+<PRIVATE
+
+: (if-empty) ( seq quot1 quot2 quot3 -- )
+    [ [ drop ] prepose ] [ ] tri* if ; inline
+
+PRIVATE>
+
 : if-empty ( seq quot1 quot2 -- )
-    [ dup empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline
+    [ dup empty? ] (if-empty) ; inline
 
 : when-empty ( seq quot -- ) [ ] if-empty ; inline
 
 : unless-empty ( seq quot -- ) [ ] swap if-empty ; inline
 
+: if-zero ( n quot1 quot2 -- )
+    [ dup zero? ] (if-empty) ; inline
+
+: when-zero ( seq quot -- ) [ ] if-zero ; inline
+
+: unless-zero ( seq quot -- ) [ ] swap if-zero ; inline
+
 : delete-all ( seq -- ) 0 swap set-length ;
 
 : first ( seq -- first ) 0 swap nth ; inline
diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor
index 5ec396e5ba..7aae30f20b 100644
--- a/core/splitting/splitting.factor
+++ b/core/splitting/splitting.factor
@@ -58,7 +58,7 @@ PRIVATE>
 : (split) ( separators n seq -- )
     3dup rot [ member? ] curry find-from drop
     [ [ swap subseq , ] 2keep 1 + swap (split) ]
-    [ swap dup zero? [ drop ] [ tail ] if , drop ] if* ; inline recursive
+    [ swap [ tail ] unless-zero , drop ] if* ; inline recursive
 
 : split, ( seq separators -- ) 0 rot (split) ;
 
-- 
2.34.1