From d2621d0da63d68ccb7e9a32cf711e6319d00219f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 19 Oct 2019 13:36:10 -0500
Subject: [PATCH] modern: Fix all unit tests.

Removing whitespace from the parse tree. The invariant is that the underlying source slice cannot change and we will calculate the whitespace between tokens on replacement. We have to reparse after writing the file (or not, we can calculate the new parse without reading the file since we are writing it...)
---
 extra/modern/lexer/lexer.factor  | 12 +++++++++---
 extra/modern/modern-tests.factor |  2 +-
 extra/modern/modern.factor       | 29 ++++++++++++++++-------------
 3 files changed, 26 insertions(+), 17 deletions(-)

diff --git a/extra/modern/lexer/lexer.factor b/extra/modern/lexer/lexer.factor
index ba0d4920cf..10a8c3bf65 100644
--- a/extra/modern/lexer/lexer.factor
+++ b/extra/modern/lexer/lexer.factor
@@ -10,14 +10,17 @@ TUPLE: ws string ;
 CONSTRUCTOR: <ws> ws ( string -- ws )
     dup string>> [ blank? not ] any? [ ws-expected ] when ;
 
+: no-ws ( seq -- seq' )
+    [ ws? ] reject ;
+
 M: ws nth string>> nth ;
 M: ws nth-unsafe string>> nth-unsafe ;
 M: ws length string>> length ;
 
 ! Weird experiment
-M: ws pprint*
+! M: ws pprint*
     ! drop ;
-    string>> dup "\"" "\"" pprint-string ;
+    ! string>> dup "\"" "\"" pprint-string ;
 
 TUPLE: lexed tokens ;
 
@@ -34,7 +37,10 @@ TUPLE: dbrace < lexed tag payload ;
 CONSTRUCTOR: <dbrace> dbrace ( tag payload -- obj ) ;
 
 TUPLE: lcolon < lexed tag payload ;
-CONSTRUCTOR: <lcolon> lcolon ( tag payload -- obj ) ;
+: <lcolon> ( tag payload -- obj )
+    lcolon new
+        swap no-ws >>payload
+        swap >>tag ; inline
 
 TUPLE: ucolon < lexed name effect body ;
 CONSTRUCTOR: <ucolon> ucolon ( name effect body -- obj ) ;
diff --git a/extra/modern/modern-tests.factor b/extra/modern/modern-tests.factor
index 37fe2c07f5..317db6f57f 100644
--- a/extra/modern/modern-tests.factor
+++ b/extra/modern/modern-tests.factor
@@ -137,7 +137,7 @@ IN: modern.tests
 
 [ "char: \\" string>literals >strings ] must-fail ! char: \ should be legal eventually
 
-{ { { "\\" { "(" } } } } [ "\\ (" string>literals >strings ] unit-test
+{ { { "\\" { "\\(" } } } } [ [[\ \(]] string>literals >strings ] unit-test
 
 { { "\\[[" } } [ "\\[[" string>literals >strings ] unit-test
 { { "\\[=[" } } [ "\\[=[" string>literals >strings ] unit-test
diff --git a/extra/modern/modern.factor b/extra/modern/modern.factor
index f33b23b6eb..f3020f0049 100644
--- a/extra/modern/modern.factor
+++ b/extra/modern/modern.factor
@@ -49,7 +49,9 @@ DEFER: lex-factor
 : lex-until ( string n tag-sequence -- string n' payload )
     3dup '[
         [
-            lex-factor-top dup f like [ , ] when* [
+            lex-factor-top f like ! <ws> possible
+            dup [ blank? ] all? [ dup , ] unless ! save unless blank
+            [
                 dup [
                     ! } gets a chance, but then also full seq { } after recursion...
                     [ _ ] dip '[ _ sequence= ] any? not
@@ -68,7 +70,9 @@ DEFER: lex-factor-nested
 : lex-colon-until ( string n tag-sequence -- string n' payload )
     '[
         [
-            lex-factor-nested dup f like [ , ] when* [
+            lex-factor-nested f like ! <ws> possible
+            dup [ blank? ] all? [ dup , ] unless ! save unless blank
+            [
                 dup [
                     ! This is for ending COLON: forms like ``A: PRIVATE>``
                     dup section-close? [
@@ -152,11 +156,10 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) )
     dup [ char: \: = ] count-tail
     '[
         _ [
-            slice-til-not-whitespace drop <ws> ! XXX: whitespace here
-            [ dup [ f unexpected-eof ] unless ] dip
-            [ lex-factor ] dip swap 2array
-        ] replicate
-        ensure-tokens
+            slice-til-not-whitespace drop <ws> drop ! XXX: whitespace here
+            dup [ f unexpected-eof ] unless
+            lex-factor
+        ] replicate ensure-tokens ! concat
     ] dip swap 2array ;
 
 : (strict-upper?) ( string -- ? )
@@ -342,9 +345,8 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) )
         '[
             _ [
                 slice-til-not-whitespace drop
-                [ <ws> ] [ "escaped string" unexpected-eof ] if*
-                [ lex-factor ] dip
-                swap 2array
+                [ <ws> drop ] [ "escaped string" unexpected-eof ] if*
+                lex-factor
             ] replicate
             ensure-tokens
         ] dip swap 2array
@@ -369,7 +371,7 @@ DEFER: lex-factor-top*
 ! Return it to the main loop as a ws form.
 : read-token-or-whitespace ( string n slice -- string n' slice/f )
     dup length 0 = [
-        merge-slice-til-not-whitespace <ws>
+        merge-slice-til-not-whitespace ! <ws>
     ] when ;
 
 : lex-factor-fallthrough ( string n/f slice/f ch/f -- string n'/f literal )
@@ -466,14 +468,15 @@ DEFER: lex-factor-top*
     [
         ! Compound syntax loop
         [
-            lex-factor-top f like [ , ] when*
+            lex-factor-top f like
+            dup [ blank? ] all? [ drop ] [ , ] if ! save unless blank
             ! concatenated syntax ( a )[ a 1 + ]( b )
             check-compound-loop
         ] loop
     ] { } make
     check-for-compound-syntax
     ! concat ! "ALIAS: n*quot (n*quot)" string>literals ... breaks here
-    ?first f like ;
+    ?first ;
 
 : string>literals ( string -- sequence )
     [