modern.out: rewrite optional semis nicely when comments are present without extra whitespace.

locals-and-roots
Doug Coleman 2016-06-24 10:40:24 -07:00
parent 4f2ec33899
commit 37bf9ab99a
2 changed files with 51 additions and 10 deletions

View File

@ -90,3 +90,34 @@ IN: modern.out.tests
{ t } [ "lol`omg" rewrite-same-string ] unit-test
{ t } [ "lol``omg``" rewrite-same-string ] unit-test
{ t } [ "lol```omg```" rewrite-same-string ] unit-test
! name = "CONSTANT" etc
:: insert-closing-semi ( tag name -- tag )
tag dup { [ uppercase-colon-literal? ] [ tag>> name sequence= ] [ closing-tag>> not ] } 1&& [
" ;" >>closing-tag
] when ;
:: remove-closing-semi ( tag name -- tag )
tag dup { [ uppercase-colon-literal? ] [ tag>> name sequence= ] [ closing-tag>> ";" sequence= ] } 1&& [
f >>closing-tag
] when ;
{ "CONSTANT: XYBitmap 0 ; ! depth 1, XYFormat" } [
"CONSTANT: XYBitmap 0 ! depth 1, XYFormat" [
"CONSTANT" insert-closing-semi
] rewrite-string
] unit-test
{ "CONSTANT: XYBitmap 0 ! depth 1, XYFormat" } [
"CONSTANT: XYBitmap 0 ; ! depth 1, XYFormat" [
"CONSTANT" remove-closing-semi
] rewrite-string
] unit-test
{ "CONSTANT: base { 3 4 5 } ;" } [
"CONSTANT: base { 3 4 5 } ;" [
"CONSTANT" remove-closing-semi
] rewrite-string [
"CONSTANT" insert-closing-semi
] rewrite-string
] unit-test

View File

@ -5,7 +5,7 @@ combinators.smart continuations fry io io.encodings.utf8
io.files io.streams.string kernel modern modern.paths
modern.slices namespaces prettyprint sequences
sequences.extras sets splitting splitting.monotonic strings
unicode ;
unicode math ;
IN: modern.out
SYMBOL: last-slice
@ -18,6 +18,13 @@ SYMBOL: last-slice
[ last-slice get [ swap slice-between ] [ slice-before ] if* replace-whitespace io:write ]
[ last-slice namespaces:set ] bi ;
: write-whitespace-nice ( obj tag -- )
[
[ last-slice get [ swap slice-between ] [ slice-before ] if* replace-whitespace ] dip
length modify-from io:write
] [ drop last-slice namespaces:set ] 2bi ;
DEFER: write-literal
GENERIC: write-literal ( obj -- ) ;
! M: object write-literal lexed-underlying write ;
@ -33,7 +40,7 @@ M: tag-literal write-literal
} cleave ;
: split-last ( seq quot -- head tail )
'[ drop @ ] monotonic-split unclip-last [ concat ] dip ; inline
[ count-tail ] 2keep drop swap cut* ; inline
M: single-matched-literal write-literal
{
@ -107,13 +114,10 @@ M: line-comment-literal write-literal
: removing-semi? ( obj -- ? )
{ [ seq>> 3 swap ?nth ] [ closing-tag>> not ] } 1&& ;
: changing-semi? ( obj -- ? )
{ [ adding-semi? ] [ removing-semi? ] } 1|| ;
: nice-semi-needed? ( obj -- ? )
{
[ { [ adding-semi? ] [ removing-semi? ] } 1|| ]
[ payload>> [ line-comment-literal? ] last? ]
} 1&& ;
! either adding or removing a semi
: write-uppercase-colon-literal-nice ( obj -- )
{
[ seq>> 0 swap nth write-whitespace ]
@ -126,7 +130,13 @@ M: line-comment-literal write-literal
[ 2drop closing-tag>> [ write ] when* ]
[ 2nip write-literal ] 3tri
]
[ [ seq>> 3 swap ?nth ] [ closing-tag>> ] bi 2dup and [ drop [ lexed-underlying [ write-whitespace ] when* ] when* ] [ 2drop ] if ]
[
[ seq>> 3 swap ?nth ] [ closing-tag>> ] bi 2dup and
! inserting ;
[ write-whitespace-nice ]
! removing ;
[ drop [ tag>> length 1 + last-slice swap '[ _ modify-to ] change ] when* ] if
]
} cleave ;
: write-uppercase-colon-literal-vanilla ( obj -- )
@ -141,7 +151,7 @@ M: line-comment-literal write-literal
} cleave ;
M: uppercase-colon-literal write-literal
dup nice-semi-needed? [
dup changing-semi? [
write-uppercase-colon-literal-nice
] [
write-uppercase-colon-literal-vanilla