Merging printf and strftime into formatting vocab.
							parent
							
								
									ceb78e417f
								
							
						
					
					
						commit
						e31b33bfbd
					
				| 
						 | 
				
			
			@ -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"
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -1,132 +1,97 @@
 | 
			
		|||
! Copyright (C) 2008 John Benediktsson
 | 
			
		||||
! 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" 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
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -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 ] ;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -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"
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -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 +0,0 @@
 | 
			
		|||
John Benediktsson
 | 
			
		||||
| 
						 | 
				
			
			@ -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"
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -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 ] ;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue