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

formatting: use the new format-float word to fix a failing test case

release
Slava Pestov 2010-04-13 21:24:35 -07:00
parent 288090d993
commit 8f4210436b
2 changed files with 17 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
basis/formatting/formatting-tests.factor
View File

@ -16,6 +16,7 @@ IN: formatting.tests
[ t ] [ "+0010" 10 "%+05d" sprintf = ] unit-test
[ t ] [ "123.456000" 123.456 "%f" sprintf = ] unit-test
[ t ] [ "2.44" 2.436 "%.2f" sprintf = ] unit-test
[ t ] [ "8.950" 8.950179003580072 "%.3f" sprintf = ] unit-test
[ t ] [ "123.10" 123.1 "%01.2f" sprintf = ] unit-test
[ t ] [ "1.2346" 1.23456789 "%.4f" sprintf = ] unit-test
[ t ] [ " 1.23" 1.23456789 "%6.2f" sprintf = ] unit-test

46
basis/formatting/formatting.factor
View File

@ -3,7 +3,9 @@
USING: accessors arrays assocs calendar combinators fry kernel
generalizations io io.streams.string macros math math.functions
math.parser peg.ebnf quotations sequences splitting strings
unicode.categories unicode.case vectors combinators.smart ;
unicode.categories unicode.case vectors combinators.smart
present ;
FROM: math.parser.private => format-float ;
IN: formatting
<PRIVATE
@ -26,31 +28,15 @@ IN: formatting
: >digits ( string -- digits )
[ 0 ] [ string>number ] if-empty ;
: pad-digits ( string digits -- string' )
[ "." split1 ] dip [ CHAR: 0 pad-tail ] [ head-slice ] bi "." glue ;
: format-simple ( x digits string -- string )
[ [ >float ] [ number>string ] bi* "%." ] dip
surround format-float ;
: max-digits ( n digits -- n' )
10^ [ * round ] keep / ; inline
: format-scientific ( x digits -- string ) "e" format-simple ;
: >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 ;
: format-decimal ( x digits -- string ) "f" format-simple ;
: exp>string ( exp base digits -- string )
[ max-digits ] keep -rot
[
[ 0 < "-" "+" ? ]
[ abs number>string 2 CHAR: 0 pad-head ] bi
"e" -rot 3append
]
[ number>string ] bi*
rot pad-digits prepend ;
ERROR: unknown-printf-directive ;
EBNF: parse-printf
@ -73,15 +59,15 @@ digits = (digits_)? => [[ 6 or ]]
fmt-% = "%" => [[ [ "%" ] ]]
fmt-c = "c" => [[ [ 1string ] ]]
fmt-C = "C" => [[ [ 1string >upper ] ]]
fmt-s = "s" => [[ [ dup number? [ number>string ] when ] ]]
fmt-S = "S" => [[ [ dup number? [ number>string ] when >upper ] ]]
fmt-d = "d" => [[ [ >fixnum 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-s = "s" => [[ [ present ] ]]
fmt-S = "S" => [[ [ present >upper ] ]]
fmt-d = "d" => [[ [ >integer number>string ] ]]
fmt-e = digits "e" => [[ first '[ _ format-scientific ] ]]
fmt-E = digits "E" => [[ first '[ _ format-scientific >upper ] ]]
fmt-f = digits "f" => [[ first '[ _ format-decimal ] ]]
fmt-x = "x" => [[ [ >hex ] ]]
fmt-X = "X" => [[ [ >hex >upper ] ]]
unknown = (.)* => [[ "Unknown directive" throw ]]
unknown = (.)* => [[ unknown-printf-directive ]]
strings_ = fmt-c|fmt-C|fmt-s|fmt-S
strings = pad width strings_ => [[ reverse compose-all ]]