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

modern.out: trim whitespace everywhere.

locals-and-roots
Doug Coleman 2016-06-20 19:43:37 -07:00
parent d6f4899b13
commit 9fe98d1c1e
1 changed files with 11 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
core/modern/out/out.factor
View File

@ -10,21 +10,13 @@ IN: modern.out
symbol: last-slice
: replace-whitespace ( string -- string' )
dup [ "\r\n" member? ] find drop [ tail ] when*
[ dup blank? [ drop char: \s ] unless ] map ;
: replace-first-whitespace ( string -- string' )
dup [ "\r\n" member? ] find drop [
tail replace-whitespace
] when* ;
: write-whitespace ( obj -- )
[ last-slice get [ swap slice-between ] [ slice-before ] if* replace-whitespace io:write ]
[ last-slice namespaces:set ] bi ;
: write-first-whitespace ( obj -- )
[ last-slice get [ swap slice-between ] [ slice-before ] if* replace-first-whitespace io:write ]
[ last-slice namespaces:set ] bi ;
defer: write-literal
GENERIC: write-literal ( obj -- ) ;
! M: object write-literal lexed-underlying write ;
@ -35,13 +27,13 @@ M: array write-literal [ write-literal ] each ;
M: tag-literal write-literal
{
[ seq>> 0 swap nth write-first-whitespace ]
[ seq>> 0 swap nth write-whitespace ]
[ tag>> write ]
} cleave ;
M: single-matched-literal write-literal
{
[ seq>> 0 swap nth write-first-whitespace ]
[ seq>> 0 swap nth write-whitespace ]
[ tag>> write ]
[ seq>> 1 swap nth write-whitespace ]
[ delimiter>> write ]
@ -52,7 +44,7 @@ M: single-matched-literal write-literal
M: double-matched-literal write-literal
{
[ seq>> 0 swap nth write-first-whitespace ]
[ seq>> 0 swap nth write-whitespace ]
[ tag>> io:write ]
[ seq>> 1 swap nth write-whitespace ]
[ delimiter>> io:write ]
@ -64,7 +56,7 @@ M: double-matched-literal write-literal
M: dquote-literal write-literal
{
[ seq>> 0 swap nth write-first-whitespace ]
[ seq>> 0 swap nth write-whitespace ]
[ tag>> io:write ]
[ seq>> 1 swap nth write-whitespace ]
[ delimiter>> io:write ]
@ -76,7 +68,7 @@ M: dquote-literal write-literal
M: backtick-literal write-literal
{
[ seq>> 0 swap nth write-first-whitespace ]
[ seq>> 0 swap nth write-whitespace ]
[ tag>> io:write ]
[ seq>> 1 swap nth write-whitespace ]
[ delimiter>> io:write ]
@ -86,7 +78,7 @@ M: backtick-literal write-literal
M: backslash-literal write-literal
{
[ seq>> 0 swap nth write-first-whitespace ]
[ seq>> 0 swap nth write-whitespace ]
[ tag>> io:write ]
[ seq>> 1 swap nth write-whitespace ]
[ delimiter>> io:write ]
@ -96,7 +88,7 @@ M: backslash-literal write-literal
M: line-comment-literal write-literal
{
[ seq>> 0 swap nth write-first-whitespace ]
[ seq>> 0 swap nth write-whitespace ]
[ tag>> io:write ]
[ seq>> 1 swap nth write-whitespace ]
[ delimiter>> io:write ]
@ -106,7 +98,7 @@ M: line-comment-literal write-literal
M: uppercase-colon-literal write-literal
{
[ seq>> 0 swap nth write-first-whitespace ]
[ seq>> 0 swap nth write-whitespace ]
[ tag>> write ]
[ seq>> 1 swap nth write-whitespace ]
[ delimiter>> write ]
@ -117,7 +109,7 @@ M: uppercase-colon-literal write-literal
M: lowercase-colon-literal write-literal
{
[ seq>> 0 swap nth write-first-whitespace ]
[ seq>> 0 swap nth write-whitespace ]
[ tag>> io:write ]
[ seq>> 1 swap nth write-whitespace ]
[ delimiter>> io:write ]
@ -126,7 +118,7 @@ M: lowercase-colon-literal write-literal
M: left-decorator-literal write-literal
{
[ seq>> 0 swap nth write-first-whitespace ]
[ seq>> 0 swap nth write-whitespace ]
[ delimiter>> io:write ]
[ payload>> write-literal ] ! don't need write-whitespace here, the recursion does it
} cleave ;