diff --git a/extra/printf/authors.txt b/extra/printf/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/printf/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/printf/printf-tests.factor b/extra/printf/printf-tests.factor new file mode 100644 index 0000000000..b2a49573f7 --- /dev/null +++ b/extra/printf/printf-tests.factor @@ -0,0 +1,79 @@ +! Copyright (C) 2008 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: kernel printf tools.test ; + +[ t ] [ "10" [ "%d" { 10 } sprintf ] call = ] unit-test + +[ t ] [ "123.456" [ "%f" { 123.456 } sprintf ] call = ] unit-test + +[ t ] [ "123.10" [ "%01.2f" { 123.1 } sprintf ] call = ] unit-test + +[ t ] [ "1.2345" [ "%.4f" { 1.23456789 } sprintf ] call = ] unit-test + +[ t ] [ " 1.23" [ "%6.2f" { 1.23456789 } sprintf ] call = ] unit-test + +[ t ] [ "3.625e+8" [ "%.3e" { 362525200 } sprintf ] call = ] unit-test + +[ t ] [ "2008-09-10" + [ "%04d-%02d-%02d" { 2008 9 10 } sprintf ] call = ] unit-test + +[ t ] [ "Hello, World!" + [ "%s" { "Hello, World!" } sprintf ] call = ] unit-test + +[ t ] [ "printf test" + [ "printf test" { } sprintf ] call = ] unit-test + +[ t ] [ "char a = 'a'" + [ "char %c = 'a'" { CHAR: a } sprintf ] call = ] unit-test + +[ t ] [ "00" [ "%02x" { HEX: 0 } sprintf ] call = ] unit-test + +[ t ] [ "ff" [ "%02x" { HEX: ff } sprintf ] call = ] unit-test + +[ t ] [ "signed -3 = unsigned 4294967293 = hex fffffffd" + [ "signed %d = unsigned %u = hex %x" { -3 -3 -3 } sprintf ] call = ] unit-test + +[ t ] [ "0 message(s)" + [ "%d %s(s)%" { 0 "message" } sprintf ] call = ] unit-test + +[ t ] [ "0 message(s) with %" + [ "%d %s(s) with %%" { 0 "message" } sprintf ] call = ] unit-test + +[ t ] [ "justif: \"left \"" + [ "justif: \"%-10s\"" { "left" } sprintf ] call = ] unit-test + +[ t ] [ "justif: \" right\"" + [ "justif: \"%10s\"" { "right" } sprintf ] call = ] unit-test + +[ t ] [ " 3: 0003 zero padded" + [ " 3: %04d zero padded" { 3 } sprintf ] call = ] unit-test + +[ t ] [ " 3: 3 left justif" + [ " 3: %-4d left justif" { 3 } sprintf ] call = ] unit-test + +[ t ] [ " 3: 3 right justif" + [ " 3: %4d right justif" { 3 } sprintf ] call = ] unit-test + +[ t ] [ " -3: -003 zero padded" + [ " -3: %04d zero padded" { -3 } sprintf ] call = ] unit-test + +[ t ] [ " -3: -3 left justif" + [ " -3: %-4d left justif" { -3 } sprintf ] call = ] unit-test + +[ t ] [ " -3: -3 right justif" + [ " -3: %4d right justif" { -3 } sprintf ] call = ] unit-test + +[ t ] [ "There are 10 monkeys in the kitchen" + [ "There are %d monkeys in the %s" { 10 "kitchen" } sprintf ] call = ] unit-test + +[ f ] [ "%d" [ "%d" 10 sprintf ] call = ] unit-test + +[ t ] [ "[monkey]" [ "[%s]" { "monkey" } sprintf ] call = ] unit-test +[ t ] [ "[ monkey]" [ "[%10s]" { "monkey" } sprintf ] call = ] unit-test +[ t ] [ "[monkey ]" [ "[%-10s]" { "monkey" } sprintf ] call = ] unit-test +[ t ] [ "[0000monkey]" [ "[%010s]" { "monkey" } sprintf ] call = ] unit-test +[ t ] [ "[####monkey]" [ "[%'#10s]" { "monkey" } sprintf ] call = ] unit-test +[ t ] [ "[many monke]" [ "[%10.10s]" { "many monkeys" } sprintf ] call = ] unit-test + + diff --git a/extra/printf/printf.factor b/extra/printf/printf.factor new file mode 100644 index 0000000000..8638afcca6 --- /dev/null +++ b/extra/printf/printf.factor @@ -0,0 +1,135 @@ +! Copyright (C) 2008 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: ascii io io.encodings.ascii io.files present kernel strings +math math.parser unicode.case sequences combinators +accessors namespaces prettyprint vectors ; + +IN: printf + +! FIXME: Handle invalid formats properly. +! FIXME: Handle incomplete formats properly. +! FIXME: Deal only with CHAR rather than converting to { CHAR } ? +! FIXME: Understand intermediate allocations that are happening... + +TUPLE: state type pad align width decimals neg loop ; + +SYMBOL: current + +SYMBOL: args + +>type + CHAR: \s >>pad + CHAR: r >>align + 0 >>width + -1 >>decimals + f >>neg + CHAR: % >>loop + current set ; + +: stop-% ( -- ) + current off ; + +: render ( s -- s ) + >vector + + current get decimals>> 0 >= current get type>> CHAR: f = and + [ CHAR: . swap dup rot swap index current get decimals>> + 1 + dup rot swap + CHAR: 0 pad-right swap 0 swap rot ] when + + current get align>> CHAR: l = + + [ current get neg>> [ { CHAR: - } prepend ] when + current get width>> CHAR: \s pad-right ] + + [ current get pad>> CHAR: \s = + [ current get neg>> [ { CHAR: - } prepend ] when + current get width>> current get pad>> pad-left ] + [ current get width>> current get neg>> [ 1 - ] when + current get pad>> pad-left + current get neg>> [ { CHAR: - } prepend ] when ] if + ] if + + current get decimals>> 0 >= current get type>> CHAR: f = not and + [ current get align>> CHAR: l = + [ current get decimals>> CHAR: \s pad-right ] + [ current get decimals>> current get pad>> pad-left ] if + current get decimals>> head-slice ] when + >string ; + +: loop-% ( c -- s ) + current get swap + { + { CHAR: % [ drop stop-% "%" ] } + { CHAR: ' [ CHAR: ' >>loop drop "" ] } + { CHAR: . [ CHAR: . >>loop 0 >>decimals drop "" ] } + { CHAR: - [ CHAR: l >>align drop "" ] } + { CHAR: 0 [ dup width>> 0 = [ CHAR: 0 >>pad ] when + [ 10 * 0 + ] change-width drop "" ] } + { CHAR: 1 [ [ 10 * 1 + ] change-width drop "" ] } + { CHAR: 2 [ [ 10 * 2 + ] change-width drop "" ] } + { CHAR: 3 [ [ 10 * 3 + ] change-width drop "" ] } + { CHAR: 4 [ [ 10 * 4 + ] change-width drop "" ] } + { CHAR: 5 [ [ 10 * 5 + ] change-width drop "" ] } + { CHAR: 6 [ [ 10 * 6 + ] change-width drop "" ] } + { CHAR: 7 [ [ 10 * 7 + ] change-width drop "" ] } + { CHAR: 8 [ [ 10 * 8 + ] change-width drop "" ] } + { CHAR: 9 [ [ 10 * 9 + ] change-width drop "" ] } + { CHAR: d [ CHAR: d >>type drop + args get pop >fixnum + dup 0 < [ current get t >>neg drop ] when + abs present render stop-% ] } + { CHAR: f [ CHAR: f >>type drop + args get pop >float + dup 0 < [ current get t >>neg drop ] when + abs present render stop-% ] } + { CHAR: s [ CHAR: s >>type drop + args get pop present render stop-% ] } + { CHAR: c [ CHAR: c >>type 1 >>width drop + 1 args get pop stop-% ] } + { CHAR: x [ CHAR: x >>type drop + args get pop >hex present render stop-% ] } + { CHAR: X [ CHAR: X >>type drop + args get pop >hex present >upper render stop-% ] } + [ drop drop stop-% "" ] + } case ; + +: loop-. ( c -- s ) + dup digit? current get swap + [ swap CHAR: 0 - swap [ 10 * + ] change-decimals drop "" ] + [ CHAR: % >>loop drop loop-% ] if ; + +: loop-' ( c -- s ) + current get swap >>pad CHAR: % >>loop drop "" ; + +: loop- ( c -- s ) + dup CHAR: % = [ drop start-% "" ] [ 1 swap ] if ; + +: loop ( c -- s ) + current get + [ current get loop>> + { + { CHAR: % [ loop-% ] } + { CHAR: ' [ loop-' ] } + { CHAR: . [ loop-. ] } + [ drop stop-% loop- ] ! FIXME: RAISE ERROR + } case ] + [ loop- ] if ; + +PRIVATE> + +: sprintf ( fmt args -- str ) + [ >vector reverse args set + V{ } swap [ loop append ] each >string ] with-scope ; + +: printf ( fmt args -- ) + sprintf print ; + +: fprintf ( path fmt args -- ) + rot ascii [ sprintf write flush ] with-file-appender ; + +