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

math.parser: don't lose precision in make-float-bin-exponent

db4
Jon Harper 2015-06-23 23:08:57 +02:00 committed by John Benediktsson
parent fc029a937c
commit dce2ca1366
2 changed files with 17 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -367,3 +367,9 @@ unit-test
{ t } [ most-positive-fixnum number>string string>number fixnum? ] unit-test { t } [ most-positive-fixnum number>string string>number fixnum? ] unit-test
{ t } [ most-negative-fixnum number>string string>number fixnum? ] unit-test { t } [ most-negative-fixnum number>string string>number fixnum? ] unit-test
! large/small numbers/exponents correctly cancel out
{ 1.0 } [ "1" 3000 [ CHAR: 0 ] "" replicate-as append "e-3000" append string>number ] unit-test
{ 1.0 } [ "0x1" 1000 [ CHAR: 0 ] "" replicate-as append "p-4000" append string>number ] unit-test
{ 1.0 } [ "0." 3000 [ CHAR: 0 ] "" replicate-as append "1e3001" append string>number ] unit-test
{ 1.0 } [ "0x0." 1000 [ CHAR: 0 ] "" replicate-as append "1p4004" append string>number ] unit-test

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

@ -84,10 +84,18 @@ TUPLE: float-parse
: make-float-dec-exponent ( float-parse n/f -- float/f ) : make-float-dec-exponent ( float-parse n/f -- float/f )
[ [ radix>> ] [ point>> ] [ exponent>> ] tri - (pow) ] [ swap /f ] bi* ; inline [ [ radix>> ] [ point>> ] [ exponent>> ] tri - (pow) ] [ swap /f ] bi* ; inline
: base2-digits ( digits radix -- digits' )
{
{ 16 [ 4 * ] }
{ 8 [ 3 * ] }
{ 2 [ ] }
} case ; inline
: base2-point ( float-parse -- point )
[ point>> ] [ radix>> ] bi base2-digits ; inline
: make-float-bin-exponent ( float-parse n/f -- float/f ) : make-float-bin-exponent ( float-parse n/f -- float/f )
[ drop [ radix>> ] [ point>> ] bi (pow) ] [ [ drop 2 ] [ base2-point ] [ exponent>> ] tri - (pow) ] [ swap /f ] bi* ; inline
[ nip swap /f ]
[ drop 2.0 swap exponent>> (pow) * ] 2tri ; inline
: ?default-exponent ( float-parse n/f -- float-parse' n/f' ) : ?default-exponent ( float-parse n/f -- float-parse' n/f' )
over exponent>> [ over exponent>> [