]> gitweb.factorcode.org Git - factor.git/commitdiff
math: using if-zero in more places.
authorJohn Benediktsson <mrjbq7@gmail.com>
Mon, 18 Jun 2012 21:32:39 +0000 (14:32 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Mon, 18 Jun 2012 21:32:39 +0000 (14:32 -0700)
basis/classes/struct/bit-accessors/bit-accessors.factor
basis/compiler/tree/propagation/info/info.factor
basis/cpu/x86/assembler/assembler.factor
basis/sequences/generalizations/generalizations.factor
core/math/parser/parser.factor
extra/graphviz/ffi/ffi.factor
extra/trees/avl/avl.factor

index a8015387968f5cd0ffbeccac774307c3f3699d07..9893ce416c616a898c55058b81c2cbf4f0fe44cc 100644 (file)
@@ -26,10 +26,10 @@ IN: classes.struct.bit-accessors
                     combine-quot: ( prev-quot shift-amount next-quot -- quot )
                     -- quot )
     offset bits step-quot manipulate-bits
-    dup zero? [ 3drop ] [
+    [ 2drop ] [
         step-quot combine-quot bit-manipulator
         combine-quot call( prev shift next -- quot )
-    ] if ; inline recursive
+    ] if-zero ; inline recursive
 
 : bit-reader ( offset bits -- quot: ( alien -- n ) )
     [ neg '[ _ alien-unsigned-1 _ bitand _ shift ] ]
index 8f0fed8c2451803fce18e62ede5bb8fd997af02d..9056a7fb778cac3677b1d61e0a552c2c113a5b45 100644 (file)
@@ -47,7 +47,7 @@ CONSTANT: object-info T{ value-info f object full-interval }
             { [ over interval-length 0 > ] [ 3drop f f ] }
             { [ pick bignum class<= ] [ 2nip >bignum t ] }
             { [ pick integer class<= ] [ 2nip >fixnum t ] }
-            { [ pick float class<= ] [ 2nip dup zero? [ drop f f ] [ >float t ] if ] }
+            { [ pick float class<= ] [ 2nip [ f f ] [ >float t ] if-zero ] }
             [ 3drop f f ]
         } cond
     ] if ;
index 49cf0e2d965b73de70436137d6412205e8bdead2..a50544d8be8d3c216fead74a832584bcf6d97cbe 100644 (file)
@@ -309,8 +309,7 @@ PRIVATE>
 
 : LEAVE ( -- ) 0xc9 , ;
 
-: RET ( n -- )
-    dup zero? [ drop 0xc3 , ] [ 0xc2 , 2, ] if ;
+: RET ( n -- ) [ 0xc3 , ] [ 0xc2 , 2, ] if-zero ;
 
 ! Arithmetic
 
index 59eceb3375662bd77affb937535cdb70a0469846..e50daf549d0814edee3a3289331480e3920e8f10 100644 (file)
@@ -15,11 +15,11 @@ MACRO: firstn-unsafe ( n -- )
     [firstn] ;
 
 MACRO: firstn ( n -- )
-    dup zero? [ drop [ drop ] ] [
+    [ [ drop ] ] [
         [ 1 - swap bounds-check 2drop ]
         [ firstn-unsafe ]
         bi-curry '[ _ _ bi ]
-    ] if ;
+    ] if-zero ;
 
 MACRO: set-firstn-unsafe ( n -- )
     [ 1 + ]
@@ -27,11 +27,11 @@ MACRO: set-firstn-unsafe ( n -- )
     '[ _ -nrot _ spread drop ] ;
 
 MACRO: set-firstn ( n -- )
-    dup zero? [ drop [ drop ] ] [
+    [ [ drop ] ] [
         [ 1 - swap bounds-check 2drop ]
         [ set-firstn-unsafe ]
         bi-curry '[ _ _ bi ]
-    ] if ;
+    ] if-zero ;
 
 : nappend ( n -- seq ) narray concat ; inline
 
index ccadd376ed48aed83360ae5e4282119d077c61c6..54fb24158224f98e62bb419a07cee59c7a4a22bd 100644 (file)
@@ -377,9 +377,8 @@ M: ratio >base
 <PRIVATE
 
 : mantissa-expt-normalize ( mantissa expt -- mantissa' expt' )
-    dup zero?
-    [ over log2 52 swap - [ shift 52 2^ 1 - bitand ] [ 1022 + - ] bi-curry bi* ]
-    [ 1023 - ] if ;
+    [ dup log2 52 swap - [ shift 52 2^ 1 - bitand ] [ 1022 + neg ] bi ]
+    [ 1023 - ] if-zero ;
 
 : mantissa-expt ( float -- mantissa expt )
     [ 52 2^ 1 - bitand ]
index c1dcff4f03791cf604ab9db71a9358be2a6b541a..f5b7e1bc710b99cec605d8df3a92603c15004824 100644 (file)
@@ -105,7 +105,7 @@ M: ffi-errors error.
     "(The messages were probably printed to STDERR.)" print ;
 
 : gvFreeContext ( gvc -- )
-    int-gvFreeContext dup zero? [ drop ] [ ffi-errors ] if ;
+    int-gvFreeContext [ ] [ ffi-errors ] if-zero ;
 
 DESTRUCTOR: gvFreeContext
 
index c53d75de4cb741032eda14b526ad76145f4d03ea..b5efda4a622385dbfd3b4a7376d9cfd5ac929d9c 100644 (file)
@@ -141,11 +141,11 @@ M: f avl-delete ( key f -- f f f ) nip f f ;
     ] dip ;
 
 M: avl-node avl-delete ( key node -- node shorter? deleted? )
-    2dup key>> key-side dup zero? [
-        drop nip avl-delete-node t
+    2dup key>> key-side [
+        nip avl-delete-node t
     ] [
         [ (avl-delete) ] with-side
-    ] if ;
+    ] if-zero ;
 
 M: avl delete-at ( key node -- )
     [ avl-delete 2drop ] change-root drop ;