math.parser: Improve performance

Add + in exponents back in, you can easily overlook them

diff --git a/basis/toml/toml-tests.factor b/basis/toml/toml-tests.factor
index 2cf3fba611a83e54e7d41f709e70895a71ea7821..da30d329b16ca97d2d69cf74b8137fa713194b7f 100644 (file)
--- a/basis/toml/toml-tests.factor
+++ b/basis/toml/toml-tests.factor
@@ -359,7 +359,7 @@ bin1 = 0b11010110
         { "flt1" "1.0" }
         { "flt2" "3.1415" }
         { "flt3" "-0.01" }
-        { "flt4" "5e22" }
+        { "flt4" "5e+22" }
         { "flt5" "1000000.0" }
         { "flt6" "-0.02" }
         { "flt7" "6.626e-34" }

diff --git a/core/math/parser/parser-tests.factor b/core/math/parser/parser-tests.factor
index 2cd11d8514a66e2fb4ea8a68d8526118eb661d7f..6748a256c949166dce63a525a90beb0e1e270c3e 100644 (file)
--- a/core/math/parser/parser-tests.factor
+++ b/core/math/parser/parser-tests.factor
@@ -503,40 +503,40 @@ unit-test
     {                   0     5  "3.5601181736115222e-307"  }
     {                   0     6   "7.120236347223045e-307"  }
     {                   0    10  "1.1392378155556871e-305"  }
-    {  0x000ffffffffffffe  2046   "1.7976931348623155e308"  }
-    {  0x000fffffffffffff  2046   "1.7976931348623157e308"  }
+    {  0x000ffffffffffffe  2046  "1.7976931348623155e+308"  }
+    {  0x000fffffffffffff  2046  "1.7976931348623157e+308"  }
 
     ! stress tests, < 1/2 ulp
     {  4007430392905160   733                  "9.5e-88"  }
     {   698388779696245   251                "4.65e-233"  }
-    {  1903293320899403  1312                 "1.415e87"  }
-    {  3927554571361996  1147                "3.9815e37"  }
-    {  1971449568774091  1174               "4.10405e45"  }
-    {  3770707915602346  1801             "2.920845e234"  }
+    {  1903293320899403  1312                "1.415e+87"  }
+    {  3927554571361996  1147               "3.9815e+37"  }
+    {  1971449568774091  1174              "4.10405e+45"  }
+    {  3770707915602346  1801            "2.920845e+234"  }
     {   877465856894836   619           "2.8919465e-122"  }
     {  2258128958129238    18          "4.37877185e-303"  }
-    {  3472938851240260  1451          "1.227701635e129"  }
-    {  1478804231587571  1452         "1.8415524525e129"  }
-    {  1033395563260341  1168         "5.48357443505e43"  }
-    {  2721851261911698  1785       "3.891901811465e229"  }
-    {  2721851261911698  1784      "1.9459509057325e229"  }
-    {  4199773113776883  1192      "1.44609583816055e51"  }
+    {  3472938851240260  1451         "1.227701635e+129"  }
+    {  1478804231587571  1452        "1.8415524525e+129"  }
+    {  1033395563260341  1168        "5.48357443505e+43"  }
+    {  2721851261911698  1785      "3.891901811465e+229"  }
+    {  2721851261911698  1784     "1.9459509057325e+229"  }
+    {  4199773113776883  1192     "1.44609583816055e+51"  }
     {  4440663047904721    74   "4.173677474585315e-286"  }
     {  2956204068717196   368  "1.1079507728788885e-197"  }
     {  1576869389299883   694    "1.234550136632744e-99"  }
-    {  3881915519664261  1796     "9.25031711960365e232"  }
+    {  3881915519664261  1796    "9.25031711960365e+232"  }
     {  3010617184019290   247    "4.19804715028489e-234"  }
     {  3893698175890015   730   "1.1716315319786511e-88"  }
-    {  2229859611940047  1277     "4.328100728446125e76"  }
+    {  2229859611940047  1277    "4.328100728446125e+76"  }
     {  3587850959922298   602   "3.317710118160031e-127"  }
 
     ! stress tests, > 1/2 ulp
-    {  2063659254706906  2027                  "2.5e302"  }
-    {  2209131796074438  1610                 "7.55e176"  }
-    {  2209131796074438  1609                "3.775e176"  }
+    {  2063659254706906  2027                 "2.5e+302"  }
+    {  2209131796074438  1610                "7.55e+176"  }
+    {  2209131796074438  1609               "3.775e+176"  }
     {   794805784202541   118              "4.3495e-273"  }
     {   633711540289011   931              "2.30365e-28"  }
-    {  2218681082291372  1438             "1.263005e125"  }
+    {  2218681082291372  1438            "1.263005e+125"  }
     {   840836770664431   906            "7.1422105e-36"  }
     {  3865523976906785   222          "1.39345735e-241"  }
     {  4492222481117167   295         "1.414634485e-219"  }
@@ -546,30 +546,31 @@ unit-test
     {  2462349842116650   826      "7.7003665618895e-60"  }
     {  2462349842116650   825     "3.85018328094475e-60"  }
     {  2462349842116650   824    "1.925091640472375e-60"  }
-    {  2983653093616330  1623   "6.8985865317742005e180"  }
-    {  1088518052258015  1239    "1.3076622631878654e65"  }
-    {  4383455621985292  1740   "1.3605202075612124e216"  }
-    {  2490587845261953  1765   "3.5928102174759597e223"  }
-    {  4293976951641647  1663    "8.912519771248455e192"  }
-    {  2859727106134841  1347    "5.5876975736230114e97"  }
+    {  2983653093616330  1623  "6.8985865317742005e+180"  }
+    {  1088518052258015  1239   "1.3076622631878654e+65"  }
+    {  4383455621985292  1740  "1.3605202075612124e+216"  }
+    {  2490587845261953  1765  "3.5928102174759597e+223"  }
+    {  4293976951641647  1663   "8.912519771248455e+192"  }
+    {  2859727106134841  1347   "5.5876975736230114e+97"  }
     {  4045897783924006   627  "1.1762578307285404e-119"  }
 } [| tuple |
     tuple first3 :> ( F E str )
-    { str } [ "" F E dragonbox general-format ] unit-test
+    { str } [ f F E dragonbox general-format ] unit-test
 ] each
 
 {
     ! regression tests
-    {   1.5745340942675811e257    "1.574534094267581e257"  }
+    {  1.5745340942675811e+257   "1.574534094267581e+257"  }
     {  1.6521200219181297e-180  "1.6521200219181297e-180"  }
     {  4.6663180925160944e-302  "4.6663180925160944e-302"  }
-    {    2.0919495182368195e19    "2.0919495182368195e19"  }
-    {    2.6760179287532483e19    "2.6760179287532483e19"  }
-    {    3.2942957306323907e19    "3.2942957306323907e19"  }
-    {    3.9702293349085635e19    "3.9702293349085635e19"  }
-    {    4.0647939013152195e19    "4.0647939013152195e19"  }
-    {    1.8014398509481984e16    "1.8014398509481984e16"  }
-    {    1.8014398509481985e16    "1.8014398509481984e16"  }
+    {   2.0919495182368195e+19   "2.0919495182368195e+19"  }
+    {   2.6760179287532483e+19   "2.6760179287532483e+19"  }
+    {   3.2942957306323907e+19   "3.2942957306323907e+19"  }
+    {   3.9702293349085635e+19   "3.9702293349085635e+19"  }
+    {   4.0647939013152195e+19   "4.0647939013152195e+19"  }
+    {      18014398509481984.0      "18014398509481984.0"  }
+    {      18014398509481985.0      "18014398509481984.0"  }
+    {      0.16996714290024104      "0.16996714290024104"  }
 
     ! rounding tests
     {      1.00000000000000005                      "1.0"  }
@@ -622,8 +623,8 @@ unit-test
     {  1000000000000000.0  "1000000000000000.0"  }
     {  9007199254740000.0  "9007199254740000.0"  }
     {  9007199254740992.0  "9007199254740992.0"  }
-    {                1e22                "1e22"  }
-    {                1e23                "1e23"  }
+    {               1e+22               "1e+22"  }
+    {               1e+23               "1e+23"  }
 } [| tuple |
     tuple first2 :> ( n str )
     { str } [ n float>dec ] unit-test
@@ -631,84 +632,46 @@ unit-test
 
 {
     ! regression tests
-     6.1734402962680736e199
-    2.4400113864427797e-153
-     5.2632699518024996e199
-     5.0806205262434145e252
-     6.7785205636751565e118
-    1.1240911411101675e-251
-      8.139240250313929e194
-     4.8614002257993364e178
-      2.752696193128505e129
-    3.1770556126883376e-271
-     2.242759017628732e-248
-     1.7802970329193148e-77
-      3.806109028477244e187
-     1.1848198569896827e213
-    2.9391656381652973e-100
-         6.424228912347e278
-     1.2645752114230544e236
-      8.42515920555967e-234
-      2.7329003323103567e46
-     1.3794281777002848e132
-     1.7142202471499735e280
-      9.634269789762257e200
-      8.083700236068939e-82
-     1.5588992945750237e163
-    1.0074862449311154e-133
-     3.1674528983750413e156
-     1.8663368017075642e168
-     2.7789467828287196e-24
-     1.3816831617696479e116
-     8.197561614832019e-114
-    1.7020441232782313e-247
-    4.1401971003386077e-194
-    1.5769408597238478e-194
-     3.3471805328331117e299
-      5.529329422375565e-66
-    1.6103234499457023e-135
-    2.9198565218330256e-280
-      8.038156131293134e163
-    1.3920716328733164e-171
-      6.827324062276435e-27
-      8.807592735347699e-71
-    3.3728552641313123e-123
-     2.4122679021903798e236
-     8.266944620606866e-263
-     2.7137385859318285e105
-      1.863720230324117e232
-      7.972905225864674e-54
-     2.2844314792315022e125
-      9.70790738880233e-169
-      1.2665834799024419e44
-     3.3484409434495807e284
-      1.3582268200372764e84
-    3.4534664118884534e-136
-      9.035819340849007e181
-     2.0437259151405597e174
-     9.859326049199017e-251
-     1.3201219024272826e162
-      1.3893748715780833e65
-       6.447847606411378e49
-       5.465125341473931e80
+    6.1734402962680736e+199  2.4400113864427797e-153
+    5.2632699518024996e+199  5.0806205262434145e+252
+    6.7785205636751565e+118  1.1240911411101675e-251
+     8.139240250313929e+194  4.8614002257993364e+178
+     2.752696193128505e+129  3.1770556126883376e-271
+     2.242759017628732e-248   1.7802970329193148e-77
+     3.806109028477244e+187  1.1848198569896827e+213
+    2.9391656381652973e-100      6.424228912347e+278
+    1.2645752114230544e+236    8.42515920555967e-234
+     2.7329003323103567e+46  1.3794281777002848e+132
+    1.7142202471499735e+280   9.634269789762257e+200
+      8.083700236068939e-82  1.5588992945750237e+163
+    1.0074862449311154e-133  3.1674528983750413e+156
+    1.8663368017075642e+168   2.7789467828287196e-24
+    1.3816831617696479e+116   8.197561614832019e-114
+    1.7020441232782313e-247  4.1401971003386077e-194
+    1.5769408597238478e-194  3.3471805328331117e+299
+      5.529329422375565e-66  1.6103234499457023e-135
+    2.9198565218330256e-280   8.038156131293134e+163
+    1.3920716328733164e-171    6.827324062276435e-27
+      8.807592735347699e-71  3.3728552641313123e-123
+    2.4122679021903798e+236   8.266944620606866e-263
+    2.7137385859318285e+105   1.863720230324117e+232
+      7.972905225864674e-54  2.2844314792315022e+125
+      9.70790738880233e-169   1.2665834799024419e+44
+    3.3484409434495807e+284   1.3582268200372764e+84
+    3.4534664118884534e-136   9.035819340849007e+181
+    2.0437259151405597e+174   9.859326049199017e-251
+    1.3201219024272826e+162   1.3893748715780833e+65
+      6.447847606411378e+49    5.465125341473931e+80
 } [| n |
     { n } [ n float>dec dec> ] unit-test
 ] each
 
 {
     ! regression tests
-    0x38FB2D4A60898DAB
-    0x453F265980DCB674
-    0x0A4FB5016FF839C0
-    0x38F1C98B4F73D69C
-    0x1F8D0A0A25B8C46D
-    0x4361B4CCC78673FD
-    0x43C3F516F5C2AE90
-    0x4386C73EFAE567DA
-    0x471F25D5F53ACB9B
-    0x459AF3D7E7CDDDFF
-    0x465D1C534CC2368F
-    0x455FCEB5B44D932F
+    0x38FB2D4A60898DAB  0x453F265980DCB674  0x0A4FB5016FF839C0
+    0x38F1C98B4F73D69C  0x1F8D0A0A25B8C46D  0x4361B4CCC78673FD
+    0x43C3F516F5C2AE90  0x4386C73EFAE567DA  0x471F25D5F53ACB9B
+    0x459AF3D7E7CDDDFF  0x465D1C534CC2368F  0x455FCEB5B44D932F
     0x45B5C534DA985042
 } [| n |
     { n } [ n bits>double float>dec dec> double>bits ]

diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor
index 65e510bb9801eacccc26ced87e49f0f88fcac0fb..344864da9933f98ebf5fb70a5eaaf7616fddd009 100644 (file)
--- a/core/math/parser/parser.factor
+++ b/core/math/parser/parser.factor
@@ -515,7 +515,7 @@ M: ratio >base
 : mantissa-expt ( bits -- mantissa expt )
     (mantissa-expt) mantissa-expt-normalize ;
 
-: float-sign ( bits -- str ) 63 bit? "-" "" ? ; inline
+: sign-negative? ( bits -- ? ) 63 bit? ; inline
 
 : bin-float-value ( str size -- str' )
     CHAR: 0 pad-head [ CHAR: 0 = ] trim-tail
@@ -535,7 +535,7 @@ M: ratio >base
 
 : (bin-float>base) ( value-quot n -- str )
     double>bits
-    [ float-sign swap ] [
+    [ sign-negative? "-" "" ? swap ] [
         mantissa-expt rot [ bin-float-expt ] bi*
     ] bi 3append ; inline
 
@@ -560,11 +560,12 @@ M: ratio >base
 : 100/mod ( n -- t ρ≠0? )
     656 * [ -16 shift ] [ 16 2^ 1 - bitand 656 >= ] bi ; inline
 
-: >double< ( n -- s F E )
-    double>bits [ float-sign ] [ (mantissa-expt) ] bi ; inline
+: >float< ( n -- s F E )
+    double>bits [ sign-negative? ] [ (mantissa-expt) ] bi ; inline
 
 : mantissa-expt-normalize* ( F E -- F' E' )
-    [ -1022 ] [ [ 52 2^ bitor ] [ 1023 - ] bi* ] if-zero 52 - ; inline
+    [ -1022 ] [ [ 52 2^ bitor ] [ 1023 - ] bi* ] if-zero
+    52 - >fixnum ; inline
 
 : shorter-interval? ( F E -- ? )
     [ zero? ] [ 1 > ] bi* and ; inline
@@ -967,23 +968,43 @@ CONSTANT: lookup-table {
     [ mantissa-expt-normalize* ] [ shorter-interval? ] 2bi
     [ shorter-interval ] [ normal-interval ] if ; inline
 
-: exponential-format ( sign-str e f-length f-str -- str )
-    [ + 1 - ] dip 1 cut [ "." glue ] unless-empty
-    "e" append swap >dec 3append ; inline
-
-: decimal-format ( sign-str e f-length f-str -- str )
-    2over + neg? [ pick neg CHAR: 0 pad-head ] when
-    pick 0 > [ 2over + CHAR: 0 pad-tail ] when
-    nip swap neg 0 max cut*
-    [ [ "0" ] when-empty ] bi@ "." glue append ; inline
-
-: general-format ( s f e -- str )
-    swap >dec [ length ] keep
-    2over swap [ + ] [ neg ] bi [ 0 max ] [ 1 max ] bi* + 17 >
-    [ exponential-format ] [ decimal-format ] if ; inline
+: ?minus ( accum ? -- accum ) [ CHAR: - over push ] when ; inline
+
+: ?exponent ( accum e -- accum )
+    CHAR: e pick push
+    dup 0 >= [ CHAR: + pick push ] when
+    >dec over push-all ; inline
+
+: exponential-format ( neg? f-str f-len e -- sbuf )
+    + 1 - [ 24 <sbuf> ] 3dip
+    [ ?minus ]
+    [ unclip-slice pick push [
+        CHAR: . pick push over push-all
+    ] unless-empty ]
+    [ ?exponent ] tri* ; inline
+
+: decimal-format ( neg? f-str f-len e -- sbuf )
+    [ 19 <sbuf> ] 4dip {
+        { [ dup 0 >= ] [ nip 0 swap 1 ] }
+        { [ 2dup neg <= ] [ over + neg 1 swap ] }
+        [ nip neg 0 0 ]
+    } cond [ cut-slice* ] 2dip rot
+    [ ?minus ] 4dip
+    [ over push-all ] 3dip
+    [ CHAR: 0 <string> over push-all CHAR: . over push ]
+    [ CHAR: 0 <string> over push-all ]
+    [ over push-all ] tri* ; inline
+
+: (format) ( neg? f e quot -- str )
+    [ >dec dup length ] 2dip call "" like ; inline
+
+: general-format ( neg? f e -- str )
+    [
+        2dup [ + ] [ neg ] bi [ 0 max ] bi@ + 17 >
+        [ exponential-format ] [ decimal-format ] if
+    ] (format) ; inline
 
-: float>dec ( n -- str )
-    >double< dragonbox general-format ; inline
+: float>dec ( n -- str ) >float< dragonbox general-format ; inline
 
 : float>base ( n radix -- str )
     {