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

add an "unordered?" predicate to math, with a dumb implementation for now

db4
Joe Groff 2009-09-10 23:45:18 -04:00
parent 2a4df54969
commit 14f412b404
3 changed files with 12 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
core/math/floats/floats-tests.factor
View File

@ -61,3 +61,9 @@ unit-test
[ t ] [ 64 [ 2^ 0.5 * ] map [ < ] monotonic? ] unit-test [ t ] [ 64 [ 2^ 0.5 * ] map [ < ] monotonic? ] unit-test
[ 5 ] [ 10.5 1.9 /i ] unit-test [ 5 ] [ 10.5 1.9 /i ] unit-test
[ t ] [ 0/0. 0/0. unordered? ] unit-test
[ t ] [ 1.0 0/0. unordered? ] unit-test
[ t ] [ 0/0. 1.0 unordered? ] unit-test
[ f ] [ 1.0 1.0 unordered? ] unit-test

4
core/math/floats/floats.factor
View File

@ -39,7 +39,7 @@ M: float fp-nan-payload
double>bits 52 2^ 1 - bitand ; inline double>bits 52 2^ 1 - bitand ; inline
M: float fp-nan? M: float fp-nan?
dup fp-special? [ fp-nan-payload zero? not ] [ drop f ] if ; inline dup float= not ;
M: float fp-qnan? M: float fp-qnan?
dup fp-nan? [ fp-nan-payload 51 2^ bitand zero? not ] [ drop f ] if ; inline dup fp-nan? [ fp-nan-payload 51 2^ bitand zero? not ] [ drop f ] if ; inline
@ -58,6 +58,8 @@ M: float next-float ( m -- n )
] if ] if
] if ; inline ] if ; inline
M: float unordered? [ fp-nan? ] bi@ or ; inline
M: float prev-float ( m -- n ) M: float prev-float ( m -- n )
double>bits double>bits
dup -0.0 double>bits >= [ 1 + bits>double ] [ ! negative dup -0.0 double>bits >= [ 1 + bits>double ] [ ! negative

3
core/math/math.factor
View File

@ -22,6 +22,9 @@ MATH: < ( x y -- ? ) foldable
MATH: <= ( x y -- ? ) foldable MATH: <= ( x y -- ? ) foldable
MATH: > ( x y -- ? ) foldable MATH: > ( x y -- ? ) foldable
MATH: >= ( x y -- ? ) foldable MATH: >= ( x y -- ? ) foldable
MATH: unordered? ( x y -- ? ) foldable
M: object unordered? 2drop f ;
MATH: + ( x y -- z ) foldable MATH: + ( x y -- z ) foldable
MATH: - ( x y -- z ) foldable MATH: - ( x y -- z ) foldable