printf: Fix rounding of floats and exps, default to 6 digits, update docs and tests.

diff --git a/extra/printf/printf-docs.factor b/extra/printf/printf-docs.factor
index b28b5e1c86bc44ea78d2de6a442ebd5c05347b89..3ca9c07c367614a5c1ceaa66fa3d79051cf83807 100644 (file)
--- a/extra/printf/printf-docs.factor
+++ b/extra/printf/printf-docs.factor
@@ -18,11 +18,11 @@ HELP: printf
     { $example
         "USING: printf ;"
         "1.23456789 \"%.3f\" printf"
-        "1.234" }
+        "1.235" }
     { $example 
         "USING: printf ;"
         "1234567890 \"%.5e\" printf"
-        "1.23456e+09" }
+        "1.23457e+09" }
     { $example
         "USING: printf ;"
         "12 \"%'#4d\" printf"

diff --git a/extra/printf/printf-tests.factor b/extra/printf/printf-tests.factor
index 5302048dfe8be5dc9ab6b16dc8c2fee52bb6eb90..2123784ea1b18588d9adf1997b0f7c0e7537c7ae 100644 (file)
--- a/extra/printf/printf-tests.factor
+++ b/extra/printf/printf-tests.factor
@@ -23,25 +23,27 @@ USING: kernel printf tools.test ;
 
 [ t ] [ "+0010" 10 "%+05d" sprintf = ] unit-test
 
-[ t ] [ "123.456" 123.456 "%f" sprintf = ] unit-test
+[ t ] [ "123.456000" 123.456 "%f" sprintf = ] unit-test
+
+[ t ] [ "2.44" 2.436 "%.2f" sprintf = ] unit-test
 
 [ t ] [ "123.10" 123.1 "%01.2f" sprintf = ] unit-test
 
-[ t ] [ "1.2345" 1.23456789 "%.4f" sprintf = ] unit-test
+[ t ] [ "1.2346" 1.23456789 "%.4f" sprintf = ] unit-test
 
 [ t ] [ "  1.23" 1.23456789 "%6.2f" sprintf = ] unit-test
 
-[ t ] [ "1.234e+08" 123400000 "%e" sprintf = ] unit-test
+[ t ] [ "1.234000e+08" 123400000 "%e" sprintf = ] unit-test
 
-[ t ] [ "-1.234e+08" -123400000 "%e" sprintf = ] unit-test
+[ t ] [ "-1.234000e+08" -123400000 "%e" sprintf = ] unit-test
 
 [ t ] [ "1.234567e+08" 123456700 "%e" sprintf = ] unit-test
 
 [ t ] [ "3.625e+08" 362525200 "%.3e" sprintf = ] unit-test
 
-[ t ] [ "2.5e-03" 0.0025 "%e" sprintf = ] unit-test
+[ t ] [ "2.500000e-03" 0.0025 "%e" sprintf = ] unit-test
 
-[ t ] [ "2.5E-03" 0.0025 "%E" sprintf = ] unit-test
+[ t ] [ "2.500000E-03" 0.0025 "%E" sprintf = ] unit-test
 
 [ t ] [ "   1.0E+01" 10 "%10.1E" sprintf = ] unit-test
 

diff --git a/extra/printf/printf.factor b/extra/printf/printf.factor
index c7a7153d6ac5b08c6367592f931ab9c9bf2903b0..0120891e1294dc34e81a03e1de3ff95a25b97720 100644 (file)
--- a/extra/printf/printf.factor
+++ b/extra/printf/printf.factor
@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license
 
 USING: io io.encodings.ascii io.files io.streams.string combinators
-kernel sequences splitting strings math math.parser macros
-fry peg.ebnf ascii unicode.case arrays quotations vectors ;
+kernel sequences splitting strings math math.functions math.parser 
+macros fry peg.ebnf ascii unicode.case arrays quotations vectors ;
 
 IN: printf
 
@@ -27,42 +27,52 @@ IN: printf
 : >digits ( string -- digits ) 
     [ 0 ] [ string>number ] if-empty ;
 
-: max-digits ( string digits -- string ) 
+: pad-digits ( string digits -- string' )
     [ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." swap 3append ;
 
-: max-width ( string length -- string ) 
+: max-digits ( n digits -- n' )
+    10 swap ^ [ * round ] keep / ;
+
+: max-width ( string length -- string' ) 
     short head ;
 
-: >exponential ( n -- base exp ) 
-    [ 0 < ] keep abs 0 
-    [ swap dup [ 10.0 >= ] keep 1.0 < or ] 
-    [ dup 10.0 >= 
-      [ 10.0 / [ 1+ ] dip swap ] 
-      [ 10.0 * [ 1- ] dip swap ] if
-    ] [ swap ] while 
-    [ number>string ] dip 
-    dup abs number>string 2 CHAR: 0 pad-left
-    [ 0 < "-" "+" ? ] dip append
-    "e" prepend 
-    rot [ [ "-" prepend ] dip ] when ; 
+: >exp ( x -- exp base )
+    [ 
+        abs 0 swap
+        [ dup [ 10.0 >= ] [ 1.0 < ] bi or ]
+        [ dup 10.0 >=
+          [ 10.0 / [ 1+ ] dip ]
+          [ 10.0 * [ 1- ] dip ] if
+        ] [ ] while 
+     ] keep 0 < [ neg ] when ;
+
+: exp>string ( exp base digits -- string )
+    [ max-digits ] keep -rot
+    [
+        [ 0 < "-" "+" ? ]
+        [ abs number>string 2 CHAR: 0 pad-left ] bi 
+        "e" -rot 3append
+    ]
+    [ number>string ] bi*
+    rot pad-digits prepend ;
 
 EBNF: parse-format-string
 
 zero      = "0"                  => [[ CHAR: 0 ]]
 char      = "'" (.)              => [[ second ]]
 
-pad-char  = (zero|char)?         => [[ CHAR: \s or 1quotation ]]
-pad-align = ("-")?               => [[ [ pad-right ] [ pad-left ] ? ]] 
-pad-width = ([0-9])*             => [[ >digits 1quotation ]]
-pad       = pad-align pad-char pad-width => [[ reverse compose-all [ first ] keep swap 0 = [ drop [ ] ] when ]]
+pad-char  = (zero|char)?         => [[ CHAR: \s or ]]
+pad-align = ("-")?               => [[ \ pad-right \ pad-left ? ]] 
+pad-width = ([0-9])*             => [[ >digits ]]
+pad       = pad-align pad-char pad-width => [[ reverse >quotation dup first 0 = [ drop [ ] ] when ]]
 
-sign      = ("+")?               => [[ [ dup CHAR: - swap index not [ "+" prepend ] when ] [ ] ? ]]
+sign      = ("+")?               => [[ [ dup CHAR: - swap index [ "+" prepend ] unless ] [ ] ? ]]
 
 width_    = "." ([0-9])*         => [[ second >digits '[ _ max-width ] ]]
 width     = (width_)?            => [[ [ ] or ]] 
 
-digits_   = "." ([0-9])*         => [[ second >digits '[ _ max-digits ] ]]
-digits    = (digits_)?           => [[ [ ] or ]]
+digits_   = "." ([0-9])*         => [[ second >digits ]]
+digits    = (digits_)?           => [[ 6 or ]]
 
 fmt-%     = "%"                  => [[ [ "%" ] ]] 
 fmt-c     = "c"                  => [[ [ 1string ] ]]
@@ -70,26 +80,24 @@ fmt-C     = "C"                  => [[ [ 1string >upper ] ]]
 fmt-s     = "s"                  => [[ [ ] ]]
 fmt-S     = "S"                  => [[ [ >upper ] ]]
 fmt-d     = "d"                  => [[ [ >fixnum number>string ] ]]
-fmt-e     = "e"                  => [[ [ >exponential ] ]]
-fmt-E     = "E"                  => [[ [ >exponential >upper ] ]]
-fmt-f     = "f"                  => [[ [ >float number>string ] ]] 
+fmt-e     = digits "e"           => [[ first '[ >exp _ exp>string ] ]]
+fmt-E     = digits "E"           => [[ first '[ >exp _ exp>string >upper ] ]]
+fmt-f     = digits "f"           => [[ first dup '[ >float _ max-digits number>string _ pad-digits ] ]] 
 fmt-x     = "x"                  => [[ [ >hex ] ]]
 fmt-X     = "X"                  => [[ [ >hex >upper ] ]]
 unknown   = (.)*                 => [[ "Unknown directive" throw ]]
 
-chars     = fmt-c | fmt-C
-strings   = pad width (fmt-s|fmt-S) => [[ reverse compose-all ]]
-decimals  = fmt-d
-exps      = digits (fmt-e|fmt-E) => [[ reverse [ swap ] join [ swap append ] append ]] 
-floats    = digits fmt-f         => [[ reverse compose-all ]]
-hex       = fmt-x | fmt-X
-numbers   = sign pad (decimals|floats|hex|exps) => [[ reverse first3 swap 3append [ fix-sign ] append ]]
+strings_  = fmt-c|fmt-C|fmt-s|fmt-S
+strings   = pad width strings_   => [[ reverse compose-all ]]
+
+numbers_  = fmt-d|fmt-e|fmt-E|fmt-f|fmt-x|fmt-X
+numbers   = sign pad numbers_    => [[ unclip-last prefix compose-all [ fix-sign ] append ]]
 
-formats   = "%" (chars|strings|numbers|fmt-%|unknown) => [[ second '[ _ dip ] ]]
+formats   = "%" (strings|numbers|fmt-%|unknown) => [[ second '[ _ dip ] ]]
 
-plain-text = (!("%").)+           => [[ >string '[ _ swap ] ]]
+plain-text = (!("%").)+          => [[ >string '[ _ swap ] ]]
 
-text      = (formats|plain-text)* => [[ reverse [ [ dup [ push ] dip ] append ] map ]]
+text      = (formats|plain-text)* => [[ reverse [ [ [ push ] keep ] append ] map ]]
 
 ;EBNF