From 4a3d63e00ae0a5e27d65a0fee0c55c98a49f627b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 11 Aug 2009 18:15:53 -0500 Subject: [PATCH] use if-zero in a few more places --- basis/calendar/calendar.factor | 4 ++-- basis/io/sockets/unix/unix.factor | 2 +- basis/math/bits/bits.factor | 2 +- basis/math/functions/functions.factor | 8 ++++---- basis/math/primes/erato/erato.factor | 4 ++-- basis/math/ratios/ratios.factor | 14 ++++++++++---- basis/serialize/serialize.factor | 12 ++++++------ basis/windows/errors/errors.factor | 6 +----- extra/benchmark/fasta/fasta.factor | 2 +- extra/game-loop/game-loop.factor | 7 ++++--- 10 files changed, 32 insertions(+), 29 deletions(-) diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 4b58b1b496..e9028b7841 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -45,11 +45,11 @@ M: not-a-month summary PRIVATE> -: month-names ( -- array ) +CONSTANT: month-names { "January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December" - } ; + } : month-name ( n -- string ) check-month 1- month-names nth ; diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor index fe136cd887..ec8b4206e3 100644 --- a/basis/io/sockets/unix/unix.factor +++ b/basis/io/sockets/unix/unix.factor @@ -19,7 +19,7 @@ IN: io.sockets.unix [ handle-fd ] 2dip 1 "int" heap-size setsockopt io-error ; M: unix addrinfo-error ( n -- ) - dup zero? [ drop ] [ gai_strerror throw ] if ; + [ gai_strerror throw ] unless-zero ; ! Client sockets - TCP and Unix domain M: object (get-local-address) ( handle remote -- sockaddr ) diff --git a/basis/math/bits/bits.factor b/basis/math/bits/bits.factor index 0fbfdf0bd9..27a9a23ca3 100644 --- a/basis/math/bits/bits.factor +++ b/basis/math/bits/bits.factor @@ -7,7 +7,7 @@ TUPLE: bits { number read-only } { length read-only } ; C: bits : make-bits ( number -- bits ) - dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1 + ] if ; inline + [ T{ bits f 0 0 } ] [ dup abs log2 1 + ] if-zero ; inline M: bits length length>> ; diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 3cbe8e19d4..8a0d39063b 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -71,7 +71,7 @@ PRIVATE> 2dup [ real? ] both? [ drop 0 >= ] [ 2drop f ] if ; inline : 0^ ( x -- z ) - dup zero? [ drop 0/0. ] [ 0 < 1/0. 0 ? ] if ; inline + [ 0/0. ] [ 0 < 1/0. 0 ? ] if-zero ; inline : (^mod) ( n x y -- z ) make-bits 1 [ @@ -263,13 +263,13 @@ M: real atan fatan ; : round ( x -- y ) dup sgn 2 / + truncate ; inline : floor ( x -- y ) - dup 1 mod dup zero? - [ drop ] [ dup 0 < [ - 1 - ] [ - ] if ] if ; foldable + dup 1 mod + [ ] [ dup 0 < [ - 1 - ] [ - ] if ] if-zero ; foldable : ceiling ( x -- y ) neg floor neg ; foldable : floor-to ( x step -- y ) - dup zero? [ drop ] [ [ / floor ] [ * ] bi ] if ; + [ [ / floor ] [ * ] bi ] unless-zero ; : lerp ( a b t -- a_t ) [ over - ] dip * + ; inline diff --git a/basis/math/primes/erato/erato.factor b/basis/math/primes/erato/erato.factor index 673f9c97cd..fdc2f9fc3b 100644 --- a/basis/math/primes/erato/erato.factor +++ b/basis/math/primes/erato/erato.factor @@ -9,7 +9,7 @@ IN: math.primes.erato CONSTANT: masks B{ 0 128 0 0 0 0 0 64 0 0 0 32 0 16 0 0 0 8 0 4 0 0 0 2 0 0 0 0 0 1 } : bit-pos ( n -- byte/f mask/f ) - 30 /mod masks nth-unsafe dup zero? [ 2drop f f ] when ; + 30 /mod masks nth-unsafe [ drop f f ] when-zero ; : marked-unsafe? ( n arr -- ? ) [ bit-pos ] dip swap [ [ nth-unsafe ] [ bitand zero? not ] bi* ] [ 2drop f ] if* ; @@ -38,4 +38,4 @@ PRIVATE> : marked-prime? ( n arr -- ? ) 2dup upper-bound 2 swap between? [ bounds-error ] unless - over { 2 3 5 } member? [ 2drop t ] [ marked-unsafe? ] if ; \ No newline at end of file + over { 2 3 5 } member? [ 2drop t ] [ marked-unsafe? ] if ; diff --git a/basis/math/ratios/ratios.factor b/basis/math/ratios/ratios.factor index d4f457180e..10ba14d13c 100644 --- a/basis/math/ratios/ratios.factor +++ b/basis/math/ratios/ratios.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel kernel.private math math.functions math.private ; +USING: accessors kernel kernel.private math math.functions +math.private sequences summary ; IN: math.ratios : 2>fraction ( a/b c/d -- a c b d ) @@ -19,13 +20,18 @@ IN: math.ratios PRIVATE> +ERROR: division-by-zero ; + +M: division-by-zero summary + drop "Division by zero" ; + M: integer / - dup zero? [ - "Division by zero" throw + [ + division-by-zero ] [ dup 0 < [ [ neg ] bi@ ] when 2dup gcd nip [ /i ] curry bi@ fraction> - ] if ; + ] if-zero ; M: ratio hashcode* nip >fraction [ hashcode ] bi@ bitxor ; diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor index b7e395fa35..da154444c1 100644 --- a/basis/serialize/serialize.factor +++ b/basis/serialize/serialize.factor @@ -47,7 +47,7 @@ M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ; ! The last case is needed because a very large number would ! otherwise be confused with a small number. : serialize-cell ( n -- ) - dup zero? [ drop 0 write1 ] [ + [ 0 write1 ] [ dup HEX: 7e <= [ HEX: 80 bitor write1 ] [ @@ -60,7 +60,7 @@ M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ; ] if >be write ] if - ] if ; + ] if-zero ; : deserialize-cell ( -- n ) read1 { @@ -79,12 +79,12 @@ M: f (serialize) ( obj -- ) drop CHAR: n write1 ; M: integer (serialize) ( obj -- ) - dup zero? [ - drop CHAR: z write1 + [ + CHAR: z write1 ] [ dup 0 < [ neg CHAR: m ] [ CHAR: p ] if write1 serialize-cell - ] if ; + ] if-zero ; M: float (serialize) ( obj -- ) CHAR: F write1 @@ -295,4 +295,4 @@ PRIVATE> binary [ deserialize ] with-byte-reader ; : object>bytes ( obj -- bytes ) - binary [ serialize ] with-byte-writer ; \ No newline at end of file + binary [ serialize ] with-byte-writer ; diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index d180cb20e7..8bdbb9f1e9 100644 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -713,11 +713,7 @@ ERROR: error-message-failed id ; GetLastError n>win32-error-string ; : (win32-error) ( n -- ) - dup zero? [ - drop - ] [ - win32-error-string throw - ] if ; + [ win32-error-string throw ] unless-zero ; : win32-error ( -- ) GetLastError (win32-error) ; diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor index f457b90c30..c1d554a5a3 100755 --- a/extra/benchmark/fasta/fasta.factor +++ b/extra/benchmark/fasta/fasta.factor @@ -63,7 +63,7 @@ CONSTANT: homo-sapiens :: split-lines ( n quot -- ) n line-length /mod [ [ line-length quot call ] times ] dip - dup zero? [ drop ] quot if ; inline + quot unless-zero ; inline : write-random-fasta ( seed n chars floats desc id -- seed ) write-description diff --git a/extra/game-loop/game-loop.factor b/extra/game-loop/game-loop.factor index 982319541b..5fe3d85e02 100644 --- a/extra/game-loop/game-loop.factor +++ b/extra/game-loop/game-loop.factor @@ -1,5 +1,6 @@ USING: accessors calendar continuations destructors kernel math -math.order namespaces system threads ui ui.gadgets.worlds ; +math.order namespaces system threads ui ui.gadgets.worlds +sequences ; IN: game-loop TUPLE: game-loop @@ -52,11 +53,11 @@ TUPLE: game-loop-error game-loop error ; drop ; : ?tick ( loop count -- ) - dup zero? [ drop millis >>last-tick drop ] [ + [ millis >>last-tick drop ] [ over [ since-last-tick ] [ tick-length>> ] bi >= [ [ drop increment-tick ] [ drop tick ] [ 1- ?tick ] 2tri ] [ 2drop ] if - ] if ; + ] if-zero ; : (run-loop) ( loop -- ) dup running?>>