From 330b7346bb7f14fb40bd9b54d9db099fcff3a0a6 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 21 Jun 2016 11:44:00 -0700
Subject: [PATCH] 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
---
 core/modern/out/out.factor | 47 ++++++++++++++++++++++++++++++++++----
 1 file changed, 42 insertions(+), 5 deletions(-)

diff --git a/core/modern/out/out.factor b/core/modern/out/out.factor
index a0b640b0bf..7ae2869816 100644
--- a/core/modern/out/out.factor
+++ b/core/modern/out/out.factor
@@ -1,11 +1,12 @@
 ! Copyright (C) 2016 Doug Coleman.
 ! 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
 io.files io.streams.string kernel modern modern.paths
-modern.slices multiline namespaces prettyprint sequences sets
-splitting strings arrays unicode ;
-IN: modern.out
+modern.slices multiline namespaces prettyprint sequences
+sequences.extras sets splitting splitting.monotonic strings
+unicode ;
+in: modern.out
 
 symbol: last-slice
 
@@ -31,6 +32,9 @@ M: tag-literal write-literal
         [ tag>> write ]
     } cleave ;
 
+: split-last ( seq quot -- head tail )
+    '[ drop @ ] monotonic-split unclip-last [ concat ] dip ; inline
+
 M: single-matched-literal write-literal
     {
         [ seq>> 0 swap nth write-whitespace ]
@@ -96,7 +100,32 @@ M: line-comment-literal write-literal
         [ payload>> io:write ]
     } 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 ]
         [ tag>> write ]
@@ -107,6 +136,14 @@ M: uppercase-colon-literal write-literal
         [ closing-tag>> [ write ] when* ]
     } 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
     {
         [ seq>> 0 swap nth write-whitespace ]