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

Merging printf and strftime into formatting vocab.

db4
John Benediktsson 2008-12-15 14:43:01 -08:00
parent ceb78e417f
commit e31b33bfbd
11 changed files with 328 additions and 397 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
extra/printf/authors.txt → extra/formatting/authors.txt
View File

123
extra/formatting/formatting-docs.factor Normal file
View File

@ -0,0 +1,123 @@
USING: help.syntax help.markup kernel prettyprint sequences strings ;
IN: formatting
HELP: printf
{ $values { "format-string" string } }
{ $description
"Writes the arguments (specified on the stack) formatted according to the format string.\n"
"\n"
"Several format specifications exist for handling arguments of different types, and "
"specifying attributes for the result string, including such things as maximum width, "
"padding, and decimals.\n"
{ $table
{ "%%" "Single %" "" }
{ "%P.Ds" "String format" "string" }
{ "%P.DS" "String format uppercase" "string" }
{ "%c" "Character format" "char" }
{ "%C" "Character format uppercase" "char" }
{ "%+Pd" "Integer format" "fixnum" }
{ "%+P.De" "Scientific notation" "fixnum, float" }
{ "%+P.DE" "Scientific notation" "fixnum, float" }
{ "%+P.Df" "Fixed format" "fixnum, float" }
{ "%+Px" "Hexadecimal" "hex" }
{ "%+PX" "Hexadecimal uppercase" "hex" }
}
"\n"
"A plus sign ('+') is used to optionally specify that the number should be "
"formatted with a '+' preceeding it if positive.\n"
"\n"
"Padding ('P') is used to optionally specify the minimum width of the result "
"string, the padding character, and the alignment. By default, the padding "
"character defaults to a space and the alignment defaults to right-aligned. "
"For example:\n"
{ $list
"\"%5s\" formats a string padding with spaces up to 5 characters wide."
"\"%08d\" formats an integer padding with zeros up to 3 characters wide."
"\"%'#5f\" formats a float padding with '#' up to 3 characters wide."
"\"%-10d\" formats an integer to 10 characters wide and left-aligns."
}
"\n"
"Digits ('D') is used to optionally specify the maximum digits in the result "
"string. For example:\n"
{ $list
"\"%.3s\" formats a string to truncate at 3 characters (from the left)."
"\"%.10f\" formats a float to pad-right with zeros up to 10 digits beyond the decimal point."
"\"%.5E\" formats a float into scientific notation with zeros up to 5 digits beyond the decimal point, but before the exponent."
}
}
{ $examples
{ $example
"USING: printf ;"
"123 \"%05d\" printf"
"00123" }
{ $example
"USING: printf ;"
"HEX: ff \"%04X\" printf"
"00FF" }
{ $example
"USING: printf ;"
"1.23456789 \"%.3f\" printf"
"1.235" }
{ $example
"USING: printf ;"
"1234567890 \"%.5e\" printf"
"1.23457e+09" }
{ $example
"USING: printf ;"
"12 \"%'#4d\" printf"
"##12" }
{ $example
"USING: printf ;"
"1234 \"%+d\" printf"
"+1234" }
} ;
HELP: sprintf
{ $values { "format-string" string } { "result" string } }
{ $description "Returns the arguments (specified on the stack) formatted according to the format string as a result string." }
{ $see-also printf } ;
HELP: strftime
{ $values { "format-string" string } }
{ $description
"Writes the timestamp (specified on the stack) formatted according to the format string.\n"
"\n"
"Different attributes of the timestamp can be retrieved using format specifications.\n"
{ $table
{ "%a" "Abbreviated weekday name." }
{ "%A" "Full weekday name." }
{ "%b" "Abbreviated month name." }
{ "%B" "Full month name." }
{ "%c" "Date and time representation." }
{ "%d" "Day of the month as a decimal number [01,31]." }
{ "%H" "Hour (24-hour clock) as a decimal number [00,23]." }
{ "%I" "Hour (12-hour clock) as a decimal number [01,12]." }
{ "%j" "Day of the year as a decimal number [001,366]." }
{ "%m" "Month as a decimal number [01,12]." }
{ "%M" "Minute as a decimal number [00,59]." }
{ "%p" "Either AM or PM." }
{ "%S" "Second as a decimal number [00,59]." }
{ "%U" "Week number of the year (Sunday as the first day of the week) as a decimal number [00,53]." }
{ "%w" "Weekday as a decimal number [0(Sunday),6]." }
{ "%W" "Week number of the year (Monday as the first day of the week) as a decimal number [00,53]." }
{ "%x" "Date representation." }
{ "%X" "Time representation." }
{ "%y" "Year without century as a decimal number [00,99]." }
{ "%Y" "Year with century as a decimal number." }
{ "%Z" "Time zone name (no characters if no time zone exists)." }
{ "%%" "A literal '%' character." }
}
} ;
ARTICLE: "formatting" "Formatted printing"
"The " { $vocab-link "formatting" } " vocabulary is used for formatted printing.\n"
{ $subsection printf }
{ $subsection sprintf }
{ $subsection strftime }
;
ABOUT: "formatting"

73
extra/printf/printf-tests.factor → extra/formatting/formatting-tests.factor
View File

@ -1,132 +1,97 @@
! Copyright (C) 2008 John Benediktsson ! Copyright (C) 2008 John Benediktsson
! See http://factorcode.org/license.txt for BSD license ! See http://factorcode.org/license.txt for BSD license
USING: kernel printf tools.test ; USING: calendar kernel formatting tools.test ;
IN: formatting.tests
[ "%s" printf ] must-infer [ "%s" printf ] must-infer
[ "%s" sprintf ] must-infer [ "%s" sprintf ] must-infer
[ t ] [ "" "" sprintf = ] unit-test [ t ] [ "" "" sprintf = ] unit-test
[ t ] [ "asdf" "asdf" sprintf = ] unit-test [ t ] [ "asdf" "asdf" sprintf = ] unit-test
[ t ] [ "10" 10 "%d" sprintf = ] unit-test [ t ] [ "10" 10 "%d" sprintf = ] unit-test
[ t ] [ "+10" 10 "%+d" sprintf = ] unit-test [ t ] [ "+10" 10 "%+d" sprintf = ] unit-test
[ t ] [ "-10" -10 "%d" sprintf = ] unit-test [ t ] [ "-10" -10 "%d" sprintf = ] unit-test
[ t ] [ " -10" -10 "%5d" sprintf = ] unit-test [ t ] [ " -10" -10 "%5d" sprintf = ] unit-test
[ t ] [ "-0010" -10 "%05d" sprintf = ] unit-test [ t ] [ "-0010" -10 "%05d" sprintf = ] unit-test
[ t ] [ "+0010" 10 "%+05d" sprintf = ] unit-test [ t ] [ "+0010" 10 "%+05d" sprintf = ] unit-test
[ t ] [ "123.456000" 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 ] [ "2.44" 2.436 "%.2f" sprintf = ] unit-test
[ t ] [ "123.10" 123.1 "%01.2f" sprintf = ] unit-test [ t ] [ "123.10" 123.1 "%01.2f" sprintf = ] unit-test
[ t ] [ "1.2346" 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.23" 1.23456789 "%6.2f" sprintf = ] unit-test
[ t ] [ "1.234000e+08" 123400000 "%e" sprintf = ] unit-test [ t ] [ "1.234000e+08" 123400000 "%e" sprintf = ] unit-test
[ t ] [ "-1.234000e+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 ] [ "1.234567e+08" 123456700 "%e" sprintf = ] unit-test
[ t ] [ "3.625e+08" 362525200 "%.3e" sprintf = ] unit-test [ t ] [ "3.625e+08" 362525200 "%.3e" sprintf = ] unit-test
[ t ] [ "2.500000e-03" 0.0025 "%e" sprintf = ] unit-test [ t ] [ "2.500000e-03" 0.0025 "%e" sprintf = ] unit-test
[ t ] [ "2.500000E-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 [ t ] [ " 1.0E+01" 10 "%10.1E" sprintf = ] unit-test
[ t ] [ " -1.0E+01" -10 "%10.1E" sprintf = ] unit-test [ t ] [ " -1.0E+01" -10 "%10.1E" sprintf = ] unit-test
[ t ] [ " -1.0E+01" -10 "%+10.1E" sprintf = ] unit-test [ t ] [ " -1.0E+01" -10 "%+10.1E" sprintf = ] unit-test
[ t ] [ " +1.0E+01" 10 "%+10.1E" sprintf = ] unit-test [ t ] [ " +1.0E+01" 10 "%+10.1E" sprintf = ] unit-test
[ t ] [ "-001.0E+01" -10 "%+010.1E" sprintf = ] unit-test [ t ] [ "-001.0E+01" -10 "%+010.1E" sprintf = ] unit-test
[ t ] [ "+001.0E+01" 10 "%+010.1E" sprintf = ] unit-test [ t ] [ "+001.0E+01" 10 "%+010.1E" sprintf = ] unit-test
[ t ] [ "ff" HEX: ff "%x" sprintf = ] unit-test [ t ] [ "ff" HEX: ff "%x" sprintf = ] unit-test
[ t ] [ "FF" HEX: ff "%X" sprintf = ] unit-test [ t ] [ "FF" HEX: ff "%X" sprintf = ] unit-test
[ t ] [ "0f" HEX: f "%02x" sprintf = ] unit-test [ t ] [ "0f" HEX: f "%02x" sprintf = ] unit-test
[ t ] [ "0F" HEX: f "%02X" sprintf = ] unit-test [ t ] [ "0F" HEX: f "%02X" sprintf = ] unit-test
[ t ] [ "2008-09-10" [ t ] [ "2008-09-10"
2008 9 10 "%04d-%02d-%02d" sprintf = ] unit-test 2008 9 10 "%04d-%02d-%02d" sprintf = ] unit-test
[ t ] [ "Hello, World!" [ t ] [ "Hello, World!"
"Hello, World!" "%s" sprintf = ] unit-test "Hello, World!" "%s" sprintf = ] unit-test
[ t ] [ "printf test" [ t ] [ "printf test"
"printf test" sprintf = ] unit-test "printf test" sprintf = ] unit-test
[ t ] [ "char a = 'a'" [ t ] [ "char a = 'a'"
CHAR: a "char %c = 'a'" sprintf = ] unit-test CHAR: a "char %c = 'a'" sprintf = ] unit-test
[ t ] [ "00" HEX: 0 "%02x" sprintf = ] unit-test [ t ] [ "00" HEX: 0 "%02x" sprintf = ] unit-test
[ t ] [ "ff" HEX: ff "%02x" sprintf = ] unit-test [ t ] [ "ff" HEX: ff "%02x" sprintf = ] unit-test
[ t ] [ "0 message(s)" [ t ] [ "0 message(s)"
0 "message" "%d %s(s)" sprintf = ] unit-test 0 "message" "%d %s(s)" sprintf = ] unit-test
[ t ] [ "0 message(s) with %" [ t ] [ "0 message(s) with %"
0 "message" "%d %s(s) with %%" sprintf = ] unit-test 0 "message" "%d %s(s) with %%" sprintf = ] unit-test
[ t ] [ "justif: \"left \"" [ t ] [ "justif: \"left \""
"left" "justif: \"%-10s\"" sprintf = ] unit-test "left" "justif: \"%-10s\"" sprintf = ] unit-test
[ t ] [ "justif: \" right\"" [ t ] [ "justif: \" right\""
"right" "justif: \"%10s\"" sprintf = ] unit-test "right" "justif: \"%10s\"" sprintf = ] unit-test
[ t ] [ " 3: 0003 zero padded" [ t ] [ " 3: 0003 zero padded"
3 " 3: %04d zero padded" sprintf = ] unit-test 3 " 3: %04d zero padded" sprintf = ] unit-test
[ t ] [ " 3: 3 left justif" [ t ] [ " 3: 3 left justif"
3 " 3: %-4d left justif" sprintf = ] unit-test 3 " 3: %-4d left justif" sprintf = ] unit-test
[ t ] [ " 3: 3 right justif" [ t ] [ " 3: 3 right justif"
3 " 3: %4d right justif" sprintf = ] unit-test 3 " 3: %4d right justif" sprintf = ] unit-test
[ t ] [ " -3: -003 zero padded" [ t ] [ " -3: -003 zero padded"
-3 " -3: %04d zero padded" sprintf = ] unit-test -3 " -3: %04d zero padded" sprintf = ] unit-test
[ t ] [ " -3: -3 left justif" [ t ] [ " -3: -3 left justif"
-3 " -3: %-4d left justif" sprintf = ] unit-test -3 " -3: %-4d left justif" sprintf = ] unit-test
[ t ] [ " -3: -3 right justif" [ t ] [ " -3: -3 right justif"
-3 " -3: %4d right justif" sprintf = ] unit-test -3 " -3: %4d right justif" sprintf = ] unit-test
[ t ] [ "There are 10 monkeys in the kitchen" [ t ] [ "There are 10 monkeys in the kitchen"
10 "kitchen" "There are %d monkeys in the %s" sprintf = ] unit-test 10 "kitchen" "There are %d monkeys in the %s" sprintf = ] unit-test
[ f ] [ "%d" 10 "%d" sprintf = ] unit-test [ f ] [ "%d" 10 "%d" sprintf = ] unit-test
[ t ] [ "[monkey]" "monkey" "[%s]" sprintf = ] unit-test [ t ] [ "[monkey]" "monkey" "[%s]" sprintf = ] unit-test
[ t ] [ "[ monkey]" "monkey" "[%10s]" sprintf = ] unit-test [ t ] [ "[ monkey]" "monkey" "[%10s]" sprintf = ] unit-test
[ t ] [ "[monkey ]" "monkey" "[%-10s]" sprintf = ] unit-test [ t ] [ "[monkey ]" "monkey" "[%-10s]" sprintf = ] unit-test
[ t ] [ "[0000monkey]" "monkey" "[%010s]" sprintf = ] unit-test [ t ] [ "[0000monkey]" "monkey" "[%010s]" sprintf = ] unit-test
[ t ] [ "[####monkey]" "monkey" "[%'#10s]" sprintf = ] unit-test [ t ] [ "[####monkey]" "monkey" "[%'#10s]" sprintf = ] unit-test
[ t ] [ "[many monke]" "many monkeys" "[%10.10s]" sprintf = ] unit-test [ t ] [ "[many monke]" "many monkeys" "[%10.10s]" sprintf = ] unit-test
[ "%H:%M:%S" strftime ] must-infer
: testtime ( -- timestamp )
2008 10 9 12 3 15 instant <timestamp> ;
[ t ] [ "12:03:15" testtime "%H:%M:%S" strftime = ] unit-test
[ t ] [ "12:03:15" testtime "%X" strftime = ] unit-test
[ t ] [ "10/09/2008" testtime "%m/%d/%Y" strftime = ] unit-test
[ t ] [ "10/09/2008" testtime "%x" strftime = ] unit-test
[ t ] [ "Thu" testtime "%a" strftime = ] unit-test
[ t ] [ "Thursday" testtime "%A" strftime = ] unit-test
[ t ] [ "Oct" testtime "%b" strftime = ] unit-test
[ t ] [ "October" testtime "%B" strftime = ] unit-test

186
extra/formatting/formatting.factor Normal file
View File

@ -0,0 +1,186 @@
! Copyright (C) 2008 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
USING: accessors arrays ascii calendar combinators fry kernel
io io.encodings.ascii io.files io.streams.string
macros math math.functions math.parser peg.ebnf quotations
sequences splitting strings unicode.case vectors ;
IN: formatting
<PRIVATE
: compose-all ( seq -- quot )
[ ] [ compose ] reduce ;
: fix-sign ( string -- string )
dup CHAR: 0 swap index 0 =
[ dup 0 swap [ [ CHAR: 0 = not ] keep digit? and ] find-from
[ dup 1- rot dup [ nth ] dip swap
{
{ CHAR: - [ [ 1- ] dip remove-nth "-" prepend ] }
{ CHAR: + [ [ 1- ] dip remove-nth "+" prepend ] }
[ drop swap drop ]
} case
] [ drop ] if
] when ;
: >digits ( string -- digits )
[ 0 ] [ string>number ] if-empty ;
: pad-digits ( string digits -- string' )
[ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." glue ;
: max-digits ( n digits -- n' )
10 swap ^ [ * round ] keep / ;
: max-width ( string length -- string' )
short head ;
: >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-printf
zero = "0" => [[ CHAR: 0 ]]
char = "'" (.) => [[ second ]]
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 [ "+" prepend ] unless ] [ ] ? ]]
width_ = "." ([0-9])* => [[ second >digits '[ _ max-width ] ]]
width = (width_)? => [[ [ ] or ]]
digits_ = "." ([0-9])* => [[ second >digits ]]
digits = (digits_)? => [[ 6 or ]]
fmt-% = "%" => [[ [ "%" ] ]]
fmt-c = "c" => [[ [ 1string ] ]]
fmt-C = "C" => [[ [ 1string >upper ] ]]
fmt-s = "s" => [[ [ ] ]]
fmt-S = "S" => [[ [ >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-x = "x" => [[ [ >hex ] ]]
fmt-X = "X" => [[ [ >hex >upper ] ]]
unknown = (.)* => [[ "Unknown directive" throw ]]
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 = "%" (strings|numbers|fmt-%|unknown) => [[ second '[ _ dip ] ]]
plain-text = (!("%").)+ => [[ >string '[ _ swap ] ]]
text = (formats|plain-text)* => [[ reverse [ [ [ push ] keep ] append ] map ]]
;EBNF
PRIVATE>
MACRO: printf ( format-string -- )
parse-printf [ length ] keep compose-all '[ _ <vector> @ reverse [ write ] each ] ;
: sprintf ( format-string -- result )
[ printf ] with-string-writer ; inline
<PRIVATE
: zero-pad 2 CHAR: 0 pad-left ; inline
: >time ( timestamp -- string )
[ hour>> ] [ minute>> ] [ second>> floor ] tri 3array
[ number>string zero-pad ] map ":" join ; inline
: >date ( timestamp -- string )
[ month>> ] [ day>> ] [ year>> ] tri 3array
[ number>string zero-pad ] map "/" join ; inline
: >datetime ( timestamp -- string )
{ [ day-of-week day-abbreviation3 ]
[ month>> month-abbreviation ]
[ day>> number>string zero-pad ]
[ >time ]
[ year>> number>string ]
} cleave 3array [ 2array ] dip append " " join ; inline
: (week-of-year) ( timestamp day -- n )
[ dup clone 1 >>month 1 >>day day-of-week dup ] dip > [ 7 swap - ] when
[ day-of-year ] dip 2dup < [ 0 2nip ] [ - 7 / 1+ >fixnum ] if ;
: week-of-year-sunday ( timestamp -- n ) 0 (week-of-year) ; inline
: week-of-year-monday ( timestamp -- n ) 1 (week-of-year) ; inline
EBNF: parse-strftime
fmt-% = "%" => [[ [ "%" ] ]]
fmt-a = "a" => [[ [ dup day-of-week day-abbreviation3 ] ]]
fmt-A = "A" => [[ [ dup day-of-week day-name ] ]]
fmt-b = "b" => [[ [ dup month>> month-abbreviation ] ]]
fmt-B = "B" => [[ [ dup month>> month-name ] ]]
fmt-c = "c" => [[ [ dup >datetime ] ]]
fmt-d = "d" => [[ [ dup day>> number>string zero-pad ] ]]
fmt-H = "H" => [[ [ dup hour>> number>string zero-pad ] ]]
fmt-I = "I" => [[ [ dup hour>> dup 12 > [ 12 - ] when number>string zero-pad ] ]]
fmt-j = "j" => [[ [ dup day-of-year number>string ] ]]
fmt-m = "m" => [[ [ dup month>> number>string zero-pad ] ]]
fmt-M = "M" => [[ [ dup minute>> number>string zero-pad ] ]]
fmt-p = "p" => [[ [ dup hour>> 12 < "AM" "PM" ? ] ]]
fmt-S = "S" => [[ [ dup second>> round number>string zero-pad ] ]]
fmt-U = "U" => [[ [ dup week-of-year-sunday ] ]]
fmt-w = "w" => [[ [ dup day-of-week number>string ] ]]
fmt-W = "W" => [[ [ dup week-of-year-monday ] ]]
fmt-x = "x" => [[ [ dup >date ] ]]
fmt-X = "X" => [[ [ dup >time ] ]]
fmt-y = "y" => [[ [ dup year>> 100 mod number>string ] ]]
fmt-Y = "Y" => [[ [ dup year>> number>string ] ]]
fmt-Z = "Z" => [[ [ "Not yet implemented" throw ] ]]
unknown = (.)* => [[ "Unknown directive" throw ]]
formats_ = fmt-%|fmt-a|fmt-A|fmt-b|fmt-B|fmt-c|fmt-d|fmt-H|fmt-I|
fmt-j|fmt-m|fmt-M|fmt-p|fmt-S|fmt-U|fmt-w|fmt-W|fmt-x|
fmt-X|fmt-y|fmt-Y|fmt-Z|unknown
formats = "%" (formats_) => [[ second '[ _ dip ] ]]
plain-text = (!("%").)+ => [[ >string '[ _ swap ] ]]
text = (formats|plain-text)* => [[ reverse [ [ [ push ] keep ] append ] map ]]
;EBNF
PRIVATE>
MACRO: strftime ( format-string -- )
parse-strftime [ length ] keep [ ] join
'[ _ <vector> @ reverse concat nip ] ;

0
extra/printf/summary.txt → extra/formatting/summary.txt
View File

80
extra/printf/printf-docs.factor
View File

@ -1,80 +0,0 @@
USING: help.syntax help.markup kernel prettyprint sequences strings ;
IN: printf
HELP: printf
{ $values { "format-string" string } }
{ $description "Writes the arguments (specified on the stack) formatted according to the format string." }
{ $examples
{ $example
"USING: printf ;"
"123 \"%05d\" printf"
"00123" }
{ $example
"USING: printf ;"
"HEX: ff \"%04X\" printf"
"00FF" }
{ $example
"USING: printf ;"
"1.23456789 \"%.3f\" printf"
"1.235" }
{ $example
"USING: printf ;"
"1234567890 \"%.5e\" printf"
"1.23457e+09" }
{ $example
"USING: printf ;"
"12 \"%'#4d\" printf"
"##12" }
{ $example
"USING: printf ;"
"1234 \"%+d\" printf"
"+1234" }
} ;
HELP: sprintf
{ $values { "format-string" string } { "result" string } }
{ $description "Returns the arguments (specified on the stack) formatted according to the format string as a result string." }
{ $see-also printf } ;
ARTICLE: "printf" "Formatted printing"
"The " { $vocab-link "printf" } " vocabulary is used for formatted printing.\n"
{ $subsection printf }
{ $subsection sprintf }
"\n"
"Several format specifications exist for handling arguments of different types, and specifying attributes for the result string, including such things as maximum width, padding, and decimals.\n"
{ $table
{ "%%" "Single %" "" }
{ "%P.Ds" "String format" "string" }
{ "%P.DS" "String format uppercase" "string" }
{ "%c" "Character format" "char" }
{ "%C" "Character format uppercase" "char" }
{ "%+Pd" "Integer format" "fixnum" }
{ "%+P.De" "Scientific notation" "fixnum, float" }
{ "%+P.DE" "Scientific notation" "fixnum, float" }
{ "%+P.Df" "Fixed format" "fixnum, float" }
{ "%+Px" "Hexadecimal" "hex" }
{ "%+PX" "Hexadecimal uppercase" "hex" }
}
"\n"
"A plus sign ('+') is used to optionally specify that the number should be formatted with a '+' preceeding it if positive.\n"
"\n"
"Padding ('P') is used to optionally specify the minimum width of the result string, the padding character, and the alignment. By default, the padding character defaults to a space and the alignment defaults to right-aligned. For example:\n"
{ $list
"\"%5s\" formats a string padding with spaces up to 5 characters wide."
"\"%08d\" formats an integer padding with zeros up to 3 characters wide."
"\"%'#5f\" formats a float padding with '#' up to 3 characters wide."
"\"%-10d\" formats an integer to 10 characters wide and left-aligns."
}
"\n"
"Digits ('D') is used to optionally specify the maximum digits in the result string. For example:\n"
{ $list
"\"%.3s\" formats a string to truncate at 3 characters (from the left)."
"\"%.10f\" formats a float to pad-right with zeros up to 10 digits beyond the decimal point."
"\"%.5E\" formats a float into scientific notation with zeros up to 5 digits beyond the decimal point, but before the exponent."
} ;
ABOUT: "printf"

112
extra/printf/printf.factor
View File

@ -1,112 +0,0 @@
! Copyright (C) 2008 John Benediktsson
! 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.functions math.parser
macros fry peg.ebnf ascii unicode.case arrays quotations vectors ;
IN: printf
<PRIVATE
: compose-all ( seq -- quot )
[ ] [ compose ] reduce ;
: fix-sign ( string -- string )
dup CHAR: 0 swap index 0 =
[ dup 0 swap [ [ CHAR: 0 = not ] keep digit? and ] find-from
[ dup 1- rot dup [ nth ] dip swap
{
{ CHAR: - [ [ 1- ] dip remove-nth "-" prepend ] }
{ CHAR: + [ [ 1- ] dip remove-nth "+" prepend ] }
[ drop swap drop ]
} case
] [ drop ] if
] when ;
: >digits ( string -- digits )
[ 0 ] [ string>number ] if-empty ;
: pad-digits ( string digits -- string' )
[ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." glue ;
: max-digits ( n digits -- n' )
10 swap ^ [ * round ] keep / ;
: max-width ( string length -- string' )
short head ;
: >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 ]]
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 [ "+" prepend ] unless ] [ ] ? ]]
width_ = "." ([0-9])* => [[ second >digits '[ _ max-width ] ]]
width = (width_)? => [[ [ ] or ]]
digits_ = "." ([0-9])* => [[ second >digits ]]
digits = (digits_)? => [[ 6 or ]]
fmt-% = "%" => [[ [ "%" ] ]]
fmt-c = "c" => [[ [ 1string ] ]]
fmt-C = "C" => [[ [ 1string >upper ] ]]
fmt-s = "s" => [[ [ ] ]]
fmt-S = "S" => [[ [ >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-x = "x" => [[ [ >hex ] ]]
fmt-X = "X" => [[ [ >hex >upper ] ]]
unknown = (.)* => [[ "Unknown directive" throw ]]
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 = "%" (strings|numbers|fmt-%|unknown) => [[ second '[ _ dip ] ]]
plain-text = (!("%").)+ => [[ >string '[ _ swap ] ]]
text = (formats|plain-text)* => [[ reverse [ [ [ push ] keep ] append ] map ]]
;EBNF
PRIVATE>
MACRO: printf ( format-string -- )
parse-format-string [ length ] keep compose-all '[ _ <vector> @ reverse [ write ] each ] ;
: sprintf ( format-string -- result )
[ printf ] with-string-writer ; inline

1
extra/time/authors.txt
View File

@ -1 +0,0 @@
John Benediktsson

43
extra/time/time-docs.factor
View File

@ -1,43 +0,0 @@
USING: help.syntax help.markup kernel prettyprint sequences strings ;
IN: time
HELP: strftime
{ $values { "format-string" string } }
{ $description "Writes the timestamp (specified on the stack) formatted according to the format string." }
;
ARTICLE: "strftime" "Formatted timestamps"
"The " { $vocab-link "time" } " vocabulary is used for formatted timestamps.\n"
{ $subsection strftime }
"\n"
"Several format specifications exist for handling arguments of different types, and specifying attributes for the result string, including such things as maximum width, padding, and decimals.\n"
{ $table
{ "%a" "Abbreviated weekday name." }
{ "%A" "Full weekday name." }
{ "%b" "Abbreviated month name." }
{ "%B" "Full month name." }
{ "%c" "Date and time representation." }
{ "%d" "Day of the month as a decimal number [01,31]." }
{ "%H" "Hour (24-hour clock) as a decimal number [00,23]." }
{ "%I" "Hour (12-hour clock) as a decimal number [01,12]." }
{ "%j" "Day of the year as a decimal number [001,366]." }
{ "%m" "Month as a decimal number [01,12]." }
{ "%M" "Minute as a decimal number [00,59]." }
{ "%p" "Either AM or PM." }
{ "%S" "Second as a decimal number [00,59]." }
{ "%U" "Week number of the year (Sunday as the first day of the week) as a decimal number [00,53]." }
{ "%w" "Weekday as a decimal number [0(Sunday),6]." }
{ "%W" "Week number of the year (Monday as the first day of the week) as a decimal number [00,53]." }
{ "%x" "Date representation." }
{ "%X" "Time representation." }
{ "%y" "Year without century as a decimal number [00,99]." }
{ "%Y" "Year with century as a decimal number." }
{ "%Z" "Time zone name (no characters if no time zone exists)." }
{ "%%" "A literal '%' character." }
} ;
ABOUT: "strftime"

24
extra/time/time-tests.factor
View File

@ -1,24 +0,0 @@
! Copyright (C) 2008 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
USING: kernel time tools.test calendar ;
IN: time.tests
[ "%H:%M:%S" strftime ] must-infer
: testtime ( -- timestamp )
2008 10 9 12 3 15 instant <timestamp> ;
[ t ] [ "12:03:15" testtime "%H:%M:%S" strftime = ] unit-test
[ t ] [ "12:03:15" testtime "%X" strftime = ] unit-test
[ t ] [ "10/09/2008" testtime "%m/%d/%Y" strftime = ] unit-test
[ t ] [ "10/09/2008" testtime "%x" strftime = ] unit-test
[ t ] [ "Thu" testtime "%a" strftime = ] unit-test
[ t ] [ "Thursday" testtime "%A" strftime = ] unit-test
[ t ] [ "Oct" testtime "%b" strftime = ] unit-test
[ t ] [ "October" testtime "%B" strftime = ] unit-test

83
extra/time/time.factor
View File

@ -1,83 +0,0 @@
! Copyright (C) 2008 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
USING: accessors arrays calendar combinators io kernel fry
macros math math.functions math.parser peg.ebnf sequences
strings vectors ;
IN: time
: zero-pad 2 CHAR: 0 pad-left ; inline
: >timestring ( timestamp -- string )
[ hour>> ] [ minute>> ] [ second>> floor ] tri 3array
[ number>string zero-pad ] map ":" join ; inline
: >datestring ( timestamp -- string )
[ month>> ] [ day>> ] [ year>> ] tri 3array
[ number>string zero-pad ] map "/" join ; inline
: >datetimestring ( timestamp -- string )
{ [ day-of-week day-abbreviation3 ]
[ month>> month-abbreviation ]
[ day>> number>string zero-pad ]
[ >timestring ]
[ year>> number>string ]
} cleave 3array [ 2array ] dip append " " join ; inline
: (week-of-year) ( timestamp day -- n )
[ dup clone 1 >>month 1 >>day day-of-week dup ] dip > [ 7 swap - ] when
[ day-of-year ] dip 2dup < [ 0 2nip ] [ - 7 / 1+ >fixnum ] if ;
: week-of-year-sunday ( timestamp -- n ) 0 (week-of-year) ; inline
: week-of-year-monday ( timestamp -- n ) 1 (week-of-year) ; inline
<PRIVATE
EBNF: parse-format-string
fmt-% = "%" => [[ [ "%" ] ]]
fmt-a = "a" => [[ [ dup day-of-week day-abbreviation3 ] ]]
fmt-A = "A" => [[ [ dup day-of-week day-name ] ]]
fmt-b = "b" => [[ [ dup month>> month-abbreviation ] ]]
fmt-B = "B" => [[ [ dup month>> month-name ] ]]
fmt-c = "c" => [[ [ dup >datetimestring ] ]]
fmt-d = "d" => [[ [ dup day>> number>string zero-pad ] ]]
fmt-H = "H" => [[ [ dup hour>> number>string zero-pad ] ]]
fmt-I = "I" => [[ [ dup hour>> dup 12 > [ 12 - ] when number>string zero-pad ] ]]
fmt-j = "j" => [[ [ dup day-of-year number>string ] ]]
fmt-m = "m" => [[ [ dup month>> number>string zero-pad ] ]]
fmt-M = "M" => [[ [ dup minute>> number>string zero-pad ] ]]
fmt-p = "p" => [[ [ dup hour>> 12 < "AM" "PM" ? ] ]]
fmt-S = "S" => [[ [ dup second>> round number>string zero-pad ] ]]
fmt-U = "U" => [[ [ dup week-of-year-sunday ] ]]
fmt-w = "w" => [[ [ dup day-of-week number>string ] ]]
fmt-W = "W" => [[ [ dup week-of-year-monday ] ]]
fmt-x = "x" => [[ [ dup >datestring ] ]]
fmt-X = "X" => [[ [ dup >timestring ] ]]
fmt-y = "y" => [[ [ dup year>> 100 mod number>string ] ]]
fmt-Y = "Y" => [[ [ dup year>> number>string ] ]]
fmt-Z = "Z" => [[ [ "Not yet implemented" throw ] ]]
unknown = (.)* => [[ "Unknown directive" throw ]]
formats_ = fmt-%|fmt-a|fmt-A|fmt-b|fmt-B|fmt-c|fmt-d|fmt-H|fmt-I|
fmt-j|fmt-m|fmt-M|fmt-p|fmt-S|fmt-U|fmt-w|fmt-W|fmt-x|
fmt-X|fmt-y|fmt-Y|fmt-Z|unknown
formats = "%" (formats_) => [[ second '[ _ dip ] ]]
plain-text = (!("%").)+ => [[ >string '[ _ swap ] ]]
text = (formats|plain-text)* => [[ reverse [ [ [ push ] keep ] append ] map ]]
;EBNF
PRIVATE>
MACRO: strftime ( format-string -- )
parse-format-string [ length ] keep [ ] join
'[ _ <vector> @ reverse concat nip ] ;