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

math.floats: fix abs on floats; -0.0 abs should be 0.0 not -0.0

db4
Slava Pestov 2009-09-12 16:24:07 -05:00
parent 87c7f882ca
commit 11f984e734
3 changed files with 15 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -67,3 +67,11 @@ unit-test
[ t ] [ 0/0. 1.0 unordered? ] unit-test [ t ] [ 0/0. 1.0 unordered? ] unit-test
[ f ] [ 1.0 1.0 unordered? ] unit-test [ f ] [ 1.0 1.0 unordered? ] unit-test
[ t ] [ -0.0 fp-sign ] unit-test
[ t ] [ -1.0 fp-sign ] unit-test
[ f ] [ 0.0 fp-sign ] unit-test
[ f ] [ 1.0 fp-sign ] unit-test
[ t ] [ -0.0 abs 0.0 fp-bitwise= ] unit-test
[ 1.5 ] [ -1.5 abs ] unit-test
[ 1.5 ] [ 1.5 abs ] unit-test

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

@ -50,7 +50,7 @@ M: float fp-snan?
M: float fp-infinity? M: float fp-infinity?
dup fp-special? [ fp-nan-payload zero? ] [ drop f ] if ; inline dup fp-special? [ fp-nan-payload zero? ] [ drop f ] if ; inline
M: float next-float ( m -- n ) M: float next-float
double>bits double>bits
dup -0.0 double>bits > [ 1 - bits>double ] [ ! negative non-zero dup -0.0 double>bits > [ 1 - bits>double ] [ ! negative non-zero
dup -0.0 double>bits = [ drop 0.0 ] [ ! negative zero dup -0.0 double>bits = [ drop 0.0 ] [ ! negative zero
@ -60,10 +60,14 @@ M: float next-float ( m -- n )
M: float unordered? [ fp-nan? ] bi@ or ; inline M: float unordered? [ fp-nan? ] bi@ or ; inline
M: float prev-float ( m -- n ) M: float prev-float
double>bits double>bits
dup -0.0 double>bits >= [ 1 + bits>double ] [ ! negative dup -0.0 double>bits >= [ 1 + bits>double ] [ ! negative
dup 0.0 double>bits = [ drop -0.0 ] [ ! positive zero dup 0.0 double>bits = [ drop -0.0 ] [ ! positive zero
1 - bits>double ! positive non-zero 1 - bits>double ! positive non-zero
] if ] if
] if ; inline ] if ; inline
M: float fp-sign double>bits 63 bit? ; inline
M: float abs double>bits 63 2^ bitnot bitand bits>double ; inline

2
core/math/math.factor
View File

@ -99,13 +99,13 @@ GENERIC: fp-qnan? ( x -- ? )
GENERIC: fp-snan? ( x -- ? ) GENERIC: fp-snan? ( x -- ? )
GENERIC: fp-infinity? ( x -- ? ) GENERIC: fp-infinity? ( x -- ? )
GENERIC: fp-nan-payload ( x -- bits ) GENERIC: fp-nan-payload ( x -- bits )
GENERIC: fp-sign ( x -- ? )
M: object fp-special? drop f ; inline M: object fp-special? drop f ; inline
M: object fp-nan? drop f ; inline M: object fp-nan? drop f ; inline
M: object fp-qnan? drop f ; inline M: object fp-qnan? drop f ; inline
M: object fp-snan? drop f ; inline M: object fp-snan? drop f ; inline
M: object fp-infinity? drop f ; inline M: object fp-infinity? drop f ; inline
M: object fp-nan-payload drop f ; inline
: <fp-nan> ( payload -- nan ) : <fp-nan> ( payload -- nan )
HEX: 7ff0000000000000 bitor bits>double ; inline HEX: 7ff0000000000000 bitor bits>double ; inline