modern.out: Print nice semicolons if necessary.

CONSTANT: a 1 ! foo
converting to semi-colon close would print as
CONSTANT: a 1 ! foo ;
since the comment is inside the form, but nice printing does this instead:
CONSTANT: a 1 ; ! foo
locals-and-roots
Doug Coleman 2016-06-21 11:44:00 -07:00
parent 5b278223df
commit 330b7346bb
1 changed files with 42 additions and 5 deletions

View File

@ -1,11 +1,12 @@
! Copyright (C) 2016 Doug Coleman. ! Copyright (C) 2016 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators combinators.short-circuit USING: accessors arrays combinators combinators.short-circuit
combinators.smart continuations fry io io.encodings.utf8 combinators.smart continuations fry io io.encodings.utf8
io.files io.streams.string kernel modern modern.paths io.files io.streams.string kernel modern modern.paths
modern.slices multiline namespaces prettyprint sequences sets modern.slices multiline namespaces prettyprint sequences
splitting strings arrays unicode ; sequences.extras sets splitting splitting.monotonic strings
IN: modern.out unicode ;
in: modern.out
symbol: last-slice symbol: last-slice
@ -31,6 +32,9 @@ M: tag-literal write-literal
[ tag>> write ] [ tag>> write ]
} cleave ; } cleave ;
: split-last ( seq quot -- head tail )
'[ drop @ ] monotonic-split unclip-last [ concat ] dip ; inline
M: single-matched-literal write-literal M: single-matched-literal write-literal
{ {
[ seq>> 0 swap nth write-whitespace ] [ seq>> 0 swap nth write-whitespace ]
@ -96,7 +100,32 @@ M: line-comment-literal write-literal
[ payload>> io:write ] [ payload>> io:write ]
} cleave ; } cleave ;
M: uppercase-colon-literal write-literal
: nice-semi-needed? ( obj -- ? )
{
[ seq>> 3 swap ?nth not ]
[ closing-tag>> ]
[ payload>> [ line-comment-literal? ] last? ]
} 1&& ;
: write-uppercase-colon-literal-nice ( obj -- )
{
[ seq>> 0 swap nth write-whitespace ]
[ tag>> write ]
[ seq>> 1 swap nth write-whitespace ]
[ delimiter>> write ]
[
dup payload>> [ line-comment-literal? ] split-last
[ drop nip write-literal ]
[ 2drop closing-tag>> [ write ] when* ]
[ 2nip write-literal ] 3tri
]
[ seq>> 3 swap nth lexed-underlying [ write-whitespace ] when* ]
} cleave ;
: write-uppercase-colon-literal-vanilla ( obj -- )
{ {
[ seq>> 0 swap nth write-whitespace ] [ seq>> 0 swap nth write-whitespace ]
[ tag>> write ] [ tag>> write ]
@ -107,6 +136,14 @@ M: uppercase-colon-literal write-literal
[ closing-tag>> [ write ] when* ] [ closing-tag>> [ write ] when* ]
} cleave ; } cleave ;
M: uppercase-colon-literal write-literal
dup nice-semi-needed? [
write-uppercase-colon-literal-nice
] [
write-uppercase-colon-literal-vanilla
] if ;
M: lowercase-colon-literal write-literal M: lowercase-colon-literal write-literal
{ {
[ seq>> 0 swap nth write-whitespace ] [ seq>> 0 swap nth write-whitespace ]