Initial version of printf.
John Benediktsson
parent
b1231476c5
commit
571794ba05
extra/printf
|
|
@ -0,0 +1 @@
|
|||
John Benediktsson
|
||||
|
|
@ -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
|
||||
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: start-% ( -- )
|
||||
state new
|
||||
CHAR: s >>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 <slice> ] 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 <string> 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 <string> ] 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 ;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue