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

math.integers: bignum/f rounding was wrong (reported by Joe Groff)

db4
Slava Pestov 2010-11-13 16:02:12 -08:00
parent 65dcd56b0b
commit 0c840a7965
2 changed files with 14 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
core/math/integers/integers-tests.factor
View File

@ -216,8 +216,8 @@ unit-test
: random-integer ( -- n ) : random-integer ( -- n )
32 random-bits 32 random-bits
1 random zero? [ neg ] when { t f } random [ neg ] when
1 random zero? [ >bignum ] when ; { t f } random [ >bignum ] when ;
[ t ] [ [ t ] [
10000 [ 10000 [
@ -232,5 +232,11 @@ unit-test
[ HEX: 1.758bec11492f9p-54 ] [ 1 12345678901234567 /f ] unit-test [ HEX: 1.758bec11492f9p-54 ] [ 1 12345678901234567 /f ] unit-test
[ HEX: -1.758bec11492f9p-54 ] [ 1 -12345678901234567 /f ] unit-test [ HEX: -1.758bec11492f9p-54 ] [ 1 -12345678901234567 /f ] unit-test
! Ensure that /f rounds to nearest and not to zero
[ HEX: 1.0p55 ] [ HEX: 7f,ffff,ffff,ffff >bignum 1 /f ] unit-test
[ HEX: 1.0p55 ] [ HEX: -7f,ffff,ffff,ffff >bignum -1 /f ] unit-test
[ HEX: -1.0p55 ] [ HEX: -7f,ffff,ffff,ffff >bignum 1 /f ] unit-test
[ HEX: -1.0p55 ] [ HEX: 7f,ffff,ffff,ffff >bignum -1 /f ] unit-test
[ 17 ] [ 17 >bignum 5 max ] unit-test [ 17 ] [ 17 >bignum 5 max ] unit-test
[ 5 ] [ 17 >bignum 5 min ] unit-test [ 5 ] [ 17 >bignum 5 min ] unit-test

7
core/math/integers/integers.factor
View File

@ -140,13 +140,18 @@ M: bignum (log2) bignum-log2 ; inline
[ 2/ ] dip over log2 52 > [ [ 2/ ] [ 1 + ] bi* ] when [ 2/ ] dip over log2 52 > [ [ 2/ ] [ 1 + ] bi* ] when
[ unscaled-float ] dip scale-float ; inline [ unscaled-float ] dip scale-float ; inline
: round-to-nearest ( fraction-and-guard rem -- fraction-and-guard' )
over odd?
[ zero? [ dup zero? [ 1 + ] unless ] [ 1 + ] if ] [ drop ] if ;
inline
! Main word ! Main word
: /f-abs ( m n -- f ) : /f-abs ( m n -- f )
over zero? [ nip zero? 0/0. 0.0 ? ] [ over zero? [ nip zero? 0/0. 0.0 ? ] [
[ drop 1/0. ] [ [ drop 1/0. ] [
pre-scale pre-scale
/f-loop /f-loop
[ over odd? [ zero? [ 1 + ] unless ] [ drop ] if ] dip [ round-to-nearest ] dip
post-scale post-scale
] if-zero ] if-zero
] if ; inline ] if ; inline