use if-zero in a few more places
parent
15ae8fb673
commit
4a3d63e00a
|
@ -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 ;
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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>> ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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) ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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?>>
|
||||
|
|
Loading…
Reference in New Issue