steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math: using if-zero in more places.

db4
John Benediktsson 2012-06-18 14:32:39 -07:00
parent 3a2d507ee2
commit d1f3b326e5
7 changed files with 14 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/classes/struct/bit-accessors/bit-accessors.factor
View File

@ -26,10 +26,10 @@ IN: classes.struct.bit-accessors
combine-quot: ( prev-quot shift-amount next-quot -- quot ) combine-quot: ( prev-quot shift-amount next-quot -- quot )
-- quot ) -- quot )
offset bits step-quot manipulate-bits offset bits step-quot manipulate-bits
dup zero? [ 3drop ] [ [ 2drop ] [
step-quot combine-quot bit-manipulator step-quot combine-quot bit-manipulator
combine-quot call( prev shift next -- quot ) combine-quot call( prev shift next -- quot )
] if ; inline recursive ] if-zero ; inline recursive
: bit-reader ( offset bits -- quot: ( alien -- n ) ) : bit-reader ( offset bits -- quot: ( alien -- n ) )
[ neg '[ _ alien-unsigned-1 _ bitand _ shift ] ] [ neg '[ _ alien-unsigned-1 _ bitand _ shift ] ]

2
basis/compiler/tree/propagation/info/info.factor
View File

@ -47,7 +47,7 @@ CONSTANT: object-info T{ value-info f object full-interval }
{ [ over interval-length 0 > ] [ 3drop f f ] } { [ over interval-length 0 > ] [ 3drop f f ] }
{ [ pick bignum class<= ] [ 2nip >bignum t ] } { [ pick bignum class<= ] [ 2nip >bignum t ] }
{ [ pick integer class<= ] [ 2nip >fixnum 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 ] [ 3drop f f ]
} cond } cond
] if ; ] if ;

3
basis/cpu/x86/assembler/assembler.factor
View File

@ -309,8 +309,7 @@ PRIVATE>
: LEAVE ( -- ) 0xc9 , ; : LEAVE ( -- ) 0xc9 , ;
: RET ( n -- ) : RET ( n -- ) [ 0xc3 , ] [ 0xc2 , 2, ] if-zero ;
dup zero? [ drop 0xc3 , ] [ 0xc2 , 2, ] if ;
! Arithmetic ! Arithmetic

8
basis/sequences/generalizations/generalizations.factor
View File

@ -15,11 +15,11 @@ MACRO: firstn-unsafe ( n -- )
[firstn] ; [firstn] ;
MACRO: firstn ( n -- ) MACRO: firstn ( n -- )
dup zero? [ drop [ drop ] ] [ [ [ drop ] ] [
[ 1 - swap bounds-check 2drop ] [ 1 - swap bounds-check 2drop ]
[ firstn-unsafe ] [ firstn-unsafe ]
bi-curry '[ _ _ bi ] bi-curry '[ _ _ bi ]
] if ; ] if-zero ;
MACRO: set-firstn-unsafe ( n -- ) MACRO: set-firstn-unsafe ( n -- )
[ 1 + ] [ 1 + ]
@ -27,11 +27,11 @@ MACRO: set-firstn-unsafe ( n -- )
'[ _ -nrot _ spread drop ] ; '[ _ -nrot _ spread drop ] ;
MACRO: set-firstn ( n -- ) MACRO: set-firstn ( n -- )
dup zero? [ drop [ drop ] ] [ [ [ drop ] ] [
[ 1 - swap bounds-check 2drop ] [ 1 - swap bounds-check 2drop ]
[ set-firstn-unsafe ] [ set-firstn-unsafe ]
bi-curry '[ _ _ bi ] bi-curry '[ _ _ bi ]
] if ; ] if-zero ;
: nappend ( n -- seq ) narray concat ; inline : nappend ( n -- seq ) narray concat ; inline

5
core/math/parser/parser.factor
View File

@ -377,9 +377,8 @@ M: ratio >base
<PRIVATE <PRIVATE
: mantissa-expt-normalize ( mantissa expt -- mantissa' expt' ) : mantissa-expt-normalize ( mantissa expt -- mantissa' expt' )
dup zero? [ dup log2 52 swap - [ shift 52 2^ 1 - bitand ] [ 1022 + neg ] bi ]
[ over log2 52 swap - [ shift 52 2^ 1 - bitand ] [ 1022 + - ] bi-curry bi* ] [ 1023 - ] if-zero ;
[ 1023 - ] if ;
: mantissa-expt ( float -- mantissa expt ) : mantissa-expt ( float -- mantissa expt )
[ 52 2^ 1 - bitand ] [ 52 2^ 1 - bitand ]

2
extra/graphviz/ffi/ffi.factor
View File

@ -105,7 +105,7 @@ M: ffi-errors error.
"(The messages were probably printed to STDERR.)" print ; "(The messages were probably printed to STDERR.)" print ;
: gvFreeContext ( gvc -- ) : gvFreeContext ( gvc -- )
int-gvFreeContext dup zero? [ drop ] [ ffi-errors ] if ; int-gvFreeContext [ ] [ ffi-errors ] if-zero ;
DESTRUCTOR: gvFreeContext DESTRUCTOR: gvFreeContext

6
extra/trees/avl/avl.factor
View File

@ -141,11 +141,11 @@ M: f avl-delete ( key f -- f f f ) nip f f ;
] dip ; ] dip ;
M: avl-node avl-delete ( key node -- node shorter? deleted? ) M: avl-node avl-delete ( key node -- node shorter? deleted? )
2dup key>> key-side dup zero? [ 2dup key>> key-side [
drop nip avl-delete-node t nip avl-delete-node t
] [ ] [
[ (avl-delete) ] with-side [ (avl-delete) ] with-side
] if ; ] if-zero ;
M: avl delete-at ( key node -- ) M: avl delete-at ( key node -- )
[ avl-delete 2drop ] change-root drop ; [ avl-delete 2drop ] change-root drop ;