use if-zero in a few more places

db4
Doug Coleman 2009-08-11 18:15:53 -05:00
parent 15ae8fb673
commit 4a3d63e00a
10 changed files with 32 additions and 29 deletions

View File

@ -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 ;

View File

@ -19,7 +19,7 @@ IN: io.sockets.unix
[ handle-fd ] 2dip 1 <int> "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 )

View File

@ -7,7 +7,7 @@ TUPLE: bits { number read-only } { length read-only } ;
C: <bits> bits
: make-bits ( number -- bits )
dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1 + <bits> ] if ; inline
[ T{ bits f 0 0 } ] [ dup abs log2 1 + <bits> ] if-zero ; inline
M: bits length length>> ;

View File

@ -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

View File

@ -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 ;
over { 2 3 5 } member? [ 2drop t ] [ marked-unsafe? ] if ;

View File

@ -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 ;

View File

@ -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 ;
binary [ serialize ] with-byte-writer ;

View File

@ -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) ;

View File

@ -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

View File

@ -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?>>