--- /dev/null
+John Benediktsson
--- /dev/null
+
+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"
+
+
--- /dev/null
+! Copyright (C) 2008 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: calendar kernel formatting tools.test ;
+
+IN: formatting.tests
+
+[ "%s" printf ] must-infer
+[ "%s" sprintf ] must-infer
+
+[ t ] [ "" "" 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 "%5d" 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 ] [ "2.44" 2.436 "%.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.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.234567e+08" 123456700 "%e" 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 ] [ " 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 ] [ "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 ] [ "2008-09-10"
+ 2008 9 10 "%04d-%02d-%02d" sprintf = ] unit-test
+[ t ] [ "Hello, World!"
+ "Hello, World!" "%s" sprintf = ] unit-test
+[ t ] [ "printf test"
+ "printf test" sprintf = ] unit-test
+[ t ] [ "char a = 'a'"
+ CHAR: a "char %c = 'a'" sprintf = ] unit-test
+[ t ] [ "00" HEX: 0 "%02x" sprintf = ] unit-test
+[ t ] [ "ff" HEX: ff "%02x" sprintf = ] unit-test
+[ t ] [ "0 message(s)"
+ 0 "message" "%d %s(s)" sprintf = ] unit-test
+[ t ] [ "0 message(s) with %"
+ 0 "message" "%d %s(s) with %%" sprintf = ] unit-test
+[ t ] [ "justif: \"left \""
+ "left" "justif: \"%-10s\"" sprintf = ] unit-test
+[ t ] [ "justif: \" right\""
+ "right" "justif: \"%10s\"" sprintf = ] unit-test
+[ t ] [ " 3: 0003 zero padded"
+ 3 " 3: %04d zero padded" sprintf = ] unit-test
+[ t ] [ " 3: 3 left justif"
+ 3 " 3: %-4d left justif" sprintf = ] unit-test
+[ t ] [ " 3: 3 right justif"
+ 3 " 3: %4d right justif" sprintf = ] unit-test
+[ t ] [ " -3: -003 zero padded"
+ -3 " -3: %04d zero padded" sprintf = ] unit-test
+[ t ] [ " -3: -3 left justif"
+ -3 " -3: %-4d left justif" sprintf = ] unit-test
+[ t ] [ " -3: -3 right justif"
+ -3 " -3: %4d right justif" sprintf = ] unit-test
+[ t ] [ "There are 10 monkeys in the kitchen"
+ 10 "kitchen" "There are %d monkeys in the %s" sprintf = ] unit-test
+[ f ] [ "%d" 10 "%d" 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 ] [ "[0000monkey]" "monkey" "[%010s]" sprintf = ] unit-test
+[ t ] [ "[####monkey]" "monkey" "[%'#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
+
--- /dev/null
+! 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 ] ;
+
+
--- /dev/null
+Format data according to a specified format string, and writes (or returns) the result string.
+++ /dev/null
-John Benediktsson
+++ /dev/null
-
-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"
-
-
+++ /dev/null
-! Copyright (C) 2008 John Benediktsson
-! See http://factorcode.org/license.txt for BSD license
-
-USING: kernel printf tools.test ;
-
-[ "%s" printf ] must-infer
-
-[ "%s" sprintf ] must-infer
-
-[ t ] [ "" "" 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 "%5d" 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 ] [ "2.44" 2.436 "%.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.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.234567e+08" 123456700 "%e" 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 ] [ " 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 ] [ "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 ] [ "2008-09-10"
- 2008 9 10 "%04d-%02d-%02d" sprintf = ] unit-test
-
-[ t ] [ "Hello, World!"
- "Hello, World!" "%s" sprintf = ] unit-test
-
-[ t ] [ "printf test"
- "printf test" sprintf = ] unit-test
-
-[ t ] [ "char a = 'a'"
- CHAR: a "char %c = 'a'" sprintf = ] unit-test
-
-[ t ] [ "00" HEX: 0 "%02x" sprintf = ] unit-test
-
-[ t ] [ "ff" HEX: ff "%02x" sprintf = ] unit-test
-
-[ t ] [ "0 message(s)"
- 0 "message" "%d %s(s)" sprintf = ] unit-test
-
-[ t ] [ "0 message(s) with %"
- 0 "message" "%d %s(s) with %%" sprintf = ] unit-test
-
-[ t ] [ "justif: \"left \""
- "left" "justif: \"%-10s\"" sprintf = ] unit-test
-
-[ t ] [ "justif: \" right\""
- "right" "justif: \"%10s\"" sprintf = ] unit-test
-
-[ t ] [ " 3: 0003 zero padded"
- 3 " 3: %04d zero padded" sprintf = ] unit-test
-
-[ t ] [ " 3: 3 left justif"
- 3 " 3: %-4d left justif" sprintf = ] unit-test
-
-[ t ] [ " 3: 3 right justif"
- 3 " 3: %4d right justif" sprintf = ] unit-test
-
-[ t ] [ " -3: -003 zero padded"
- -3 " -3: %04d zero padded" sprintf = ] unit-test
-
-[ t ] [ " -3: -3 left justif"
- -3 " -3: %-4d left justif" sprintf = ] unit-test
-
-[ t ] [ " -3: -3 right justif"
- -3 " -3: %4d right justif" sprintf = ] unit-test
-
-[ t ] [ "There are 10 monkeys in the kitchen"
- 10 "kitchen" "There are %d monkeys in the %s" sprintf = ] unit-test
-
-[ f ] [ "%d" 10 "%d" 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 ] [ "[0000monkey]" "monkey" "[%010s]" sprintf = ] unit-test
-
-[ t ] [ "[####monkey]" "monkey" "[%'#10s]" sprintf = ] unit-test
-
-[ t ] [ "[many monke]" "many monkeys" "[%10.10s]" sprintf = ] unit-test
-
-
-
+++ /dev/null
-! 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
-
-
+++ /dev/null
-Format data according to a specified format string, and writes (or returns) the result string.
+++ /dev/null
-John Benediktsson
+++ /dev/null
-
-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"
-
-
+++ /dev/null
-! 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
-
+++ /dev/null
-! 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 ] ;
-
-
projects / factor.git / commitdiff