math: using if-zero in more places.
parent
3a2d507ee2
commit
d1f3b326e5
|
@ -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 ] ]
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -309,8 +309,7 @@ PRIVATE>
|
|||
|
||||
: LEAVE ( -- ) 0xc9 , ;
|
||||
|
||||
: RET ( n -- )
|
||||
dup zero? [ drop 0xc3 , ] [ 0xc2 , 2, ] if ;
|
||||
: RET ( n -- ) [ 0xc3 , ] [ 0xc2 , 2, ] if-zero ;
|
||||
|
||||
! Arithmetic
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ]
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue