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 ] ]
{ [ 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 ;
: LEAVE ( -- ) 0xc9 , ;
-: RET ( n -- )
- dup zero? [ drop 0xc3 , ] [ 0xc2 , 2, ] if ;
+: RET ( n -- ) [ 0xc3 , ] [ 0xc2 , 2, ] if-zero ;
! Arithmetic
[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 + ]
'[ _ -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
<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 ]
"(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
] 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 ;