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

formatting: make printf faster.

db4
John Benediktsson 2014-02-10 20:39:08 -08:00
parent a82dc84f2d
commit 6e0a9fdf1f
1 changed files with 20 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
basis/formatting/formatting.factor
View File

@ -1,10 +1,10 @@
! 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: accessors arrays assocs calendar combinators fry kernel USING: accessors arrays assocs calendar combinators
generalizations io io.streams.string macros math math.functions combinators.smart fry generalizations io io.streams.string
math.parser peg.ebnf prettyprint quotations sequences splitting kernel macros math math.functions math.parser namespaces
strings unicode.categories unicode.case vectors combinators.smart peg.ebnf present prettyprint quotations sequences strings
present ; unicode.case unicode.categories vectors ;
FROM: math.parser.private => format-float ; FROM: math.parser.private => format-float ;
IN: formatting IN: formatting
@ -56,7 +56,7 @@ width = (width_)? => [[ [ ] or ]]
digits_ = "." ([0-9])* => [[ second >digits ]] digits_ = "." ([0-9])* => [[ second >digits ]]
digits = (digits_)? => [[ 6 or ]] digits = (digits_)? => [[ 6 or ]]
fmt-% = "%" => [[ [ "%" ] ]] fmt-% = "%" => [[ "%" ]]
fmt-c = "c" => [[ [ 1string ] ]] fmt-c = "c" => [[ [ 1string ] ]]
fmt-C = "C" => [[ [ 1string >upper ] ]] fmt-C = "C" => [[ [ 1string >upper ] ]]
fmt-s = "s" => [[ [ present ] ]] fmt-s = "s" => [[ [ present ] ]]
@ -82,28 +82,33 @@ lists = "[%" types ", %]" => [[ second '[ _ map ", " join "{ " prepend "
assocs = "[%" types ": %" types " %]" => [[ [ second ] [ fourth ] bi '[ unzip [ _ map ] dip _ map zip [ ":" join ] map ", " join "{ " prepend " }" append ] ]] assocs = "[%" types ": %" types " %]" => [[ [ second ] [ fourth ] bi '[ unzip [ _ map ] dip _ map zip [ ":" join ] map ", " join "{ " prepend " }" append ] ]]
formats = "%" (types|fmt-%|lists|assocs|unknown) => [[ second '[ _ dip ] ]] formats = "%" (types|fmt-%|lists|assocs|unknown) => [[ second ]]
plain-text = (!("%").)+ => [[ >string '[ _ swap ] ]] plain-text = (!("%").)+ => [[ >string ]]
text = (formats|plain-text)* => [[ <reversed> [ [ [ push ] keep ] append ] map ]] text = (formats|plain-text)* => [[ ]]
;EBNF ;EBNF
PRIVATE> PRIVATE>
MACRO: printf ( format-string -- ) MACRO: printf ( format-string -- )
parse-printf [ length ] keep compose-all parse-printf [ [ callable? ] count ] keep [
'[ _ <vector> @ <reversed> [ write ] each ] ; dup string? [ 1quotation ] [ [ 1 - ] dip ] if
over [ ndip ] 2curry
] map nip [ compose-all ] [ length ] bi '[
@ output-stream get [ stream-write ] curry _ napply
] ;
: sprintf ( format-string -- result ) : sprintf ( format-string -- result )
[ printf ] with-string-writer ; inline [ printf ] with-string-writer ; inline
: vprintf ( seq format-string -- ) : vprintf ( seq format-string -- )
parse-printf reverse! [ parse-printf output-stream get '[
first dup string? dup string? [
[ '[ _ write ] ] [ '[ unclip-slice @ write ] ] if [ unclip-slice ] dip call( x -- y )
] map concat call( x -- x ) drop ; ] unless _ stream-write
] each drop ;
: vsprintf ( seq format-string -- result ) : vsprintf ( seq format-string -- result )
[ vprintf ] with-string-writer ; inline [ vprintf ] with-string-writer ; inline