]> gitweb.factorcode.org Git - factor.git/commitdiff
ryu: faster and simpler using number>string for integer conversion.
authorJohn Benediktsson <mrjbq7@gmail.com>
Fri, 4 Jan 2019 05:13:55 +0000 (21:13 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Fri, 4 Jan 2019 05:13:55 +0000 (21:13 -0800)
extra/ryu/data/data.factor
extra/ryu/ryu.factor

index 501c3d7287a50530cb16b3c51ebccc2c9b3f5bdb..589482eb38cfdd0b4d9390054ef33417031deb68 100644 (file)
@@ -2,8 +2,6 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: ryu.data
 
-CONSTANT: DIGIT_TABLE "00010203040506070809101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899"
-
 CONSTANT: DOUBLE_POW5_INV_SPLIT {
     {                    1   288230376151711744 } {  3689348814741910324   230584300921369395 }
     {  2951479051793528259   184467440737095516 } { 17118578500402463900   147573952589676412 }
index dec350491a069f084a01b3d1e568a7ba4aabc2a7..079d6d8ed1379f4e38be1dee4cd29f2760e4768e 100644 (file)
@@ -1,7 +1,8 @@
 ! Copyright (C) 2018 Alexander Ilin.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: formatting kernel locals math math.bitwise math.functions
-math.order ryu.data sequences shuffle strings vectors ;
+USING: combinators.smart kernel locals math math.bitwise
+math.functions math.order math.parser ryu.data sequences
+sequences.private ;
 
 IN: ryu
 
@@ -17,10 +18,9 @@ IN: ryu
     [                     mul-shift ] 3tri ;
 
 :: pow-5-factor ( x -- y )
-    x :> value!
-    f 0 [ 2dup x <= swap not and ] [
-        value 5 /mod zero? [ value! 1 + ] [ nipd swap ] if
-    ] while nip ; inline
+    x f 0 [ 2dup x > or ] [
+        [ 5 /mod ] 2dip rot zero? [ 1 + ] [ nip dupd ] if
+    ] until 2nip ; inline
 
 : multiple-of-power-of-5 ( p value -- ? )
     pow-5-factor <= ;
@@ -80,34 +80,32 @@ CONSTANT: offset 1023 ! (1 << (exponentBits - 1)) - 1
         ] if-zero
     ] if [ e2 m2 dup even? ieeeExponent 1 <= sign ] dip ; inline
 
-:: prepare-output ( vp! vplength acceptBounds vmIsTrailingZeros! vrIsTrailingZeros! vr! vm! -- vplength' output )
+:: prepare-output ( vp! acceptBounds vmIsTrailingZeros! vrIsTrailingZeros! vr! vm! -- output )
     ! vr is converted into the output
-    0 vplength
-    ! the if has this stack-effect: ( lastRemovedDigit vplength -- lastRemovedDigit' vplength' output )
+    0
+    ! the if has this stack-effect: ( lastRemovedDigit -- lastRemovedDigit' output )
     vmIsTrailingZeros vrIsTrailingZeros or [
         ! rare
         [ vp 10 /i vm 10 /i 2dup > ] [
             vm! vp!
             vmIsTrailingZeros [ vm 10 divisor? vmIsTrailingZeros! ] when
-            vrIsTrailingZeros [ over zero? vrIsTrailingZeros! ] when
-            vr 10 /mod -roll vr! nip ! lastRemovedDigit!
-            1 - ! vplength!
+            vrIsTrailingZeros [ dup zero? vrIsTrailingZeros! ] when
+            vr 10 /mod swap vr! nip ! lastRemovedDigit!
         ] while 2drop
         vmIsTrailingZeros [
             [ vm dup 10 /i dup 10 * swapd = ] [
                 vm!
-                vrIsTrailingZeros [ over zero? vrIsTrailingZeros! ] when
-                vr 10 /mod -roll vr! nip ! lastRemovedDigit!
+                vrIsTrailingZeros [ dup zero? vrIsTrailingZeros! ] when
+                vr 10 /mod swap vr! nip ! lastRemovedDigit!
                 vp 10 /i vp!
-                1 - ! vplength!
             ] while drop ! Drop (vm 10 /i) result from the while condition.
         ] when
         vrIsTrailingZeros [
-            over 5 = [
-                vr even? [ 4 -rot nip ] when ! 4 lastRemovedDigit!
+            dup 5 = [
+                vr even? [ drop 4 ] when ! 4 lastRemovedDigit!
             ] when
         ] when
-        vr pick 5 >= [ 1 + ] [
+        vr over 5 >= [ 1 + ] [
             dup vm = [
                 acceptBounds vmIsTrailingZeros and not [ 1 + ] when
             ] when
@@ -116,69 +114,20 @@ CONSTANT: offset 1023 ! (1 << (exponentBits - 1)) - 1
         ! common
         [ vp 10 /i vm 10 /i 2dup > ] [
             vm! vp!
-            vr 10 /mod -roll vr! nip ! lastRemovedDigit!
-            1 - ! vplength!
+            vr 10 /mod swap vr! nip ! lastRemovedDigit!
         ] while 2drop
         vr dup vm = [ 1 + ] [
-            pick 5 >= [ 1 + ] when
+            over 5 >= [ 1 + ] when
         ] if
-    ] if nipd ; inline
+    ] if nip ; inline
 
-: write-char ( index seq char -- index+1 seq' )
-    -rot [ tuck ] dip [ set-nth 1 + ] keep ; inline
-
-: write-exp ( exp index result -- result' )
-    CHAR: e write-char
-    pick neg? [
-        CHAR: - write-char [ neg ] 2dip
-    ] when
-    pick dup 100 >= [
-        100 /i CHAR: 0 + write-char
-        [ 100 mod 2 * ] 2dip
-        pick DIGIT_TABLE nth write-char
-        [ 1 + DIGIT_TABLE nth ] 2dip [ set-nth ] keep
-    ] [
-        10 >= [
-            [ 2 * ] 2dip
-            pick DIGIT_TABLE nth write-char
-            [ 1 + DIGIT_TABLE nth ] 2dip [ set-nth ] keep
-        ] [
-            [ CHAR: 0 + ] 2dip [ set-nth ] keep
-        ] if
-    ] if ; inline
-
-:: produce-output ( exp sign olength output2! -- string )
-    25 <vector> 0 :> ( result i! )
-    0 sign [ CHAR: - swap result set-nth 1 ] when :> index!
-    [ output2 10000 >= ] [
-        output2 dup 10000 /i dup output2! 10000 * - :> c
-        index olength + i - 1 - :> res-index
-        c 100 mod 2 *
-        dup DIGIT_TABLE nth res-index result set-nth
-        1 + DIGIT_TABLE nth res-index 1 + result set-nth
-        c 100 /i 2 *
-        dup DIGIT_TABLE nth res-index 2 - result set-nth
-        1 + DIGIT_TABLE nth res-index 1 - result set-nth
-        i 4 + i!
-    ] while
-    output2 100 >= [
-        output2 dup 100 /i dup output2! 100 * - 2 * :> c
-        index olength + i - :> res-index
-        c DIGIT_TABLE nth res-index 1 - result set-nth
-        c 1 + DIGIT_TABLE nth res-index result set-nth
-        i 2 + i!
-    ] when
-    output2 10 >= [
-        output2 2 * :> c
-        index olength + i - :> res-index
-        c 1 + DIGIT_TABLE nth res-index result set-nth
-        c DIGIT_TABLE nth index result set-nth
-    ] [ CHAR: 0 output2 + index result set-nth ] if
-    index 1 + index!
-    olength 1 > [
-        CHAR: . index result set-nth
-        index olength + index!
-    ] when exp index result write-exp >string ; inline
+:: produce-output ( exp sign output -- string )
+    [
+        sign "-" f ?
+        output number>string 1 cut-slice dup empty? f "." ? swap
+        "e"
+        exp number>string
+    ] "" append-outputs-as ; inline
 
 PRIVATE>
 
@@ -195,7 +144,7 @@ PRIVATE>
             q e10!
             q double-pow-5-bits DOUBLE_POW5_INV_BITCOUNT + 1 - :> k
             q k + e2 - :> i
-            mmShift m2 q DOUBLE_POW5_INV_SPLIT nth i mul-shift-all vr! swap vm! ! vp on stack
+            mmShift m2 q DOUBLE_POW5_INV_SPLIT nth-unsafe i mul-shift-all vr! swap vm! ! vp on stack
             q 21 <= [
                 mv 5 divisor? [
                     q mv multiple-of-power-of-5 vrIsTrailingZeros!
@@ -213,7 +162,7 @@ PRIVATE>
             e2 neg q - :> i
             i double-pow-5-bits DOUBLE_POW5_BITCOUNT - :> k
             q k - :> j
-            mmShift m2 i DOUBLE_POW5_SPLIT nth j mul-shift-all vr! swap vm! ! vp on stack
+            mmShift m2 i DOUBLE_POW5_SPLIT nth-unsafe j mul-shift-all vr! swap vm! ! vp on stack
             q 1 <= [
                 mv 1 bitand bitnot q >= vrIsTrailingZeros!
                 acceptBounds [
@@ -225,8 +174,7 @@ PRIVATE>
                 ] when
             ] if
         ] if
-        dup decimal-length ! vp vplength
-        dup e10 + 1 - sign 2swap ! exp and sign for produce-output
+        [ decimal-length e10 + 1 - sign ] keep ! exp sign vp
         acceptBounds vmIsTrailingZeros vrIsTrailingZeros vr vm
         prepare-output produce-output
     ] if* ;