{ 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
+{ 1.0 } [ "1" 3000 [ CHAR: 0 ] "" replicate-as append "." append
+ 3000 [ CHAR: 0 ] "" replicate-as append "e-3000" append string>number ] unit-test
+
+! We correctly parse the biggest/smallest float correctly
+! (ie the 1/0. or 0/0. short-circuit optimization doesn't apply)
+{ 1 } [ "4.9406564584124655e-324" string>number double>bits ] unit-test
+{ 1 } [ "0x1.0p-1074" string>number double>bits ] unit-test
+{ 1 } [ "0o1.0p-1074" string>number double>bits ] unit-test
+{ 1 } [ "0b1.0p-1074" string>number double>bits ] unit-test
+{ 0x7fefffffffffffff } [ "1.7976931348623157e+308" string>number double>bits ] unit-test
+{ 0x7fefffffffffffff } [ "0x1.fffffffffffffp1023" string>number double>bits ] unit-test
+{ 0x7fefffffffffffff } [ "0o1.777777777777777774p1023" string>number double>bits ] unit-test
+{ 0x7fefffffffffffff } [ "0b1.1111111111111111111111111111111111111111111111111111p1023" string>number double>bits ] unit-test
+! Actual biggest/smallest parseable floats are a little
+! larger/smaller than IEE754 values because of rounding
+{ 0x1.0p-1074 } [ "0x0.fffffffffffffcp-1074" string>number ] unit-test
+{ 4.94065645841246544e-324 } [ "4.94065645841246517e-324" string>number ] unit-test
+{ 0x1.fffffffffffffp1023 } [ "0x1.fffffffffffff7ffffffffffffffffp1023" string>number ] unit-test
+{ 1.79769313486231571e+308 } [ "1.797693134862315807e+308" string>number ] unit-test
+
+! works with ratios
+{ 0.25 } [ "1/4" 3000 [ CHAR: 0 ] "" replicate-as append "e-3000" append string>number ] unit-test
+{ 1.25 } [ "1+1/4" 3000 [ CHAR: 0 ] "" replicate-as append "e-3000" append string>number ] unit-test
+
+! #1356 #1231
+{ 1/0. } [ "1e100000" string>number ] unit-test
+{ 0.0 } [ "1e-100000" string>number ] unit-test
+{ 1/0. } [ "0x1p300000" string>number ] unit-test
+{ 0.0 } [ "0x1p-300000" string>number ] unit-test
<PRIVATE
+! magnitude is used only for floats to avoid
+! expensive computations when we know that
+! the result will overflow/underflow.
+! The computation of magnitude starts in
+! number-parse and continues in float-parse.
TUPLE: number-parse
{ str read-only }
{ length fixnum read-only }
- { radix fixnum } ;
+ { radix fixnum }
+ { magnitude fixnum } ;
: <number-parse> ( str radix -- i number-parse n )
- [ 0 ] 2dip [ dup length ] dip number-parse boa 0 ; inline
+ [ 0 ] 2dip [ dup length ] dip 0 number-parse boa 0 ; inline
: (next-digit) ( i number-parse n digit-quot end-quot -- n/f )
[ 2over length>> < ] 2dip
: next-digit ( i number-parse n quot -- n/f )
[ 2nip ] (next-digit) ; inline
+: inc-magnitude ( number-parse -- number-parse' )
+ [ 1 + ] change-magnitude ; inline
+
+: ?inc-magnitude ( number-parse n -- number-parse' )
+ zero? [ inc-magnitude ] unless ; inline
+
+: (add-digit) ( number-parse n digit -- number-parse n' )
+ [ dup radix>> ] [ * ] [ + ] tri* ;
+
: add-digit ( i number-parse n digit quot -- n/f )
- [ [ dup radix>> ] [ * ] [ + ] tri* ] dip next-digit ; inline
+ [ (add-digit) [ ?inc-magnitude ] keep ] dip next-digit ; inline
+
+: add-exponent-digit ( i number-parse n digit quot -- n/f )
+ [ (add-digit) ] dip next-digit ; inline
: digit-in-radix ( number-parse n char -- number-parse n digit ? )
digit> pick radix>> over > ; inline
TUPLE: float-parse
{ radix fixnum }
{ point }
- { exponent } ;
-
-: inc-point ( float-parse -- float-parse' )
+ { exponent }
+ { magnitude } ;
+: inc-point-?dec-magnitude ( float-parse n -- float-parse' )
+ zero? [ [ 1 - ] change-magnitude ] when
[ 1 + ] change-point ; inline
: store-exponent ( float-parse n expt -- float-parse' n )
dup 0 >= [ ((pow)) ] [ [ recip ] [ neg ] bi* ((pow)) ] if ; inline
: add-mantissa-digit ( float-parse i number-parse n digit quot -- float-parse' n/f )
- [ [ inc-point ] 4dip ] dip add-digit ; inline
+ [ (add-digit)
+ dup [ inc-point-?dec-magnitude ] curry 3dip
+ ] dip next-digit ; inline
+
+! IEE754 doubles are in the range ]10^309,10^-324[,
+! or expressed in base 2, ]2^1024, 2^-1074].
+! We don't need those ranges to be accurate as long as we are
+! excluding all the floats because they are used only to
+! optimize when we know there will be an overflow/underflow
+! We compare these numbers to the magnitude slot of float-parse,
+! which has the following behavior:
+! ... ; 0.0xxx -> -1; 0.xxx -> 0; x.xxx -> 1; xx.xxx -> 2; ...;
+! Also, take some margin as the current float parsing algorithm
+! does some rounding; For example,
+! 0x1.0p-1074 is the smallest IE754 double, but floats down to
+! 0x0.fffffffffffffcp-1074 are parsed as 0x1.0p-1074
+CONSTANT: max-magnitude-10 309
+CONSTANT: min-magnitude-10 -323
+CONSTANT: max-magnitude-2 1027
+CONSTANT: min-magnitude-2 -1074
: make-float-dec-exponent ( float-parse n/f -- float/f )
- [ [ radix>> ] [ point>> ] [ exponent>> ] tri - (pow) ] [ swap /f ] bi* ; inline
+ over [ exponent>> ] [ magnitude>> ] bi +
+ {
+ { [ dup max-magnitude-10 > ] [ 3drop 1/0. ] }
+ { [ dup min-magnitude-10 < ] [ 3drop 0.0 ] }
+ [ drop
+ [ [ radix>> ] [ point>> ] [ exponent>> ] tri - (pow) ]
+ [ swap /f ] bi*
+ ]
+ } cond ; inline
: base2-digits ( digits radix -- digits' )
{
: base2-point ( float-parse -- point )
[ point>> ] [ radix>> ] bi base2-digits ; inline
+: base2-magnitude ( float-parse -- point )
+ [ magnitude>> ] [ radix>> ] bi base2-digits ; inline
+
: make-float-bin-exponent ( float-parse n/f -- float/f )
- [ [ drop 2 ] [ base2-point ] [ exponent>> ] tri - (pow) ] [ swap /f ] bi* ; inline
+ over [ exponent>> ] [ base2-magnitude ] bi +
+ {
+ { [ dup max-magnitude-2 > ] [ 3drop 1/0. ] }
+ { [ dup min-magnitude-2 < ] [ 3drop 0.0 ] }
+ [ drop
+ [ [ drop 2 ] [ base2-point ] [ exponent>> ] tri - (pow) ]
+ [ swap /f ] bi*
+ ]
+ } cond ; inline
: ?default-exponent ( float-parse n/f -- float-parse' n/f' )
over exponent>> [
: @abort ( i number-parse n x -- f )
4drop f ; inline
-: @split ( i number-parse n -- n i number-parse n' )
- -rot 0 ; inline
+: @split ( i number-parse n -- n i number-parse' n' )
+ -rot 0 >>magnitude 0 ; inline
: @split-exponent ( i number-parse n -- n i number-parse' n' )
-rot 10 >>radix 0 ; inline
: <float-parse> ( i number-parse n -- float-parse i number-parse n )
- [ drop nip radix>> 0 f float-parse boa ] 3keep ; inline
+ [ drop nip [ radix>> ] [ magnitude>> ] bi [ 0 f ] dip float-parse boa ] 3keep ; inline
DEFER: @exponent-digit
DEFER: @mantissa-digit
: @exponent-digit ( float-parse i number-parse n char -- float-parse n/f )
{ float-parse fixnum number-parse integer fixnum } declare
- digit-in-radix [ [ @exponent-digit-or-punc ] add-digit ] [ @abort ] if ;
+ digit-in-radix [ [ @exponent-digit-or-punc ] add-exponent-digit ] [ @abort ] if ;
: @exponent-first-char ( float-parse i number-parse n char -- float-parse n/f )
{