From 9a983d611fbb5efb5f320761a9f1d3bb76c6033d Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 3 Sep 2017 12:59:44 -0500
Subject: [PATCH] modern: refactorig

---
 extra/modern/compiler/compiler.factor | 26 ----------------
 extra/modern/out/out.factor           | 44 +++++++++++++++++++--------
 2 files changed, 32 insertions(+), 38 deletions(-)

diff --git a/extra/modern/compiler/compiler.factor b/extra/modern/compiler/compiler.factor
index 40a000594c..ad8fd4a484 100644
--- a/extra/modern/compiler/compiler.factor
+++ b/extra/modern/compiler/compiler.factor
@@ -90,31 +90,5 @@ VARIABLE-ARITY: \WORD: 2
 VARIABLE-ARITY: \<CLASS: 3
 VARIABLE-ARITY: \<FUNCTOR: 2
 
-: matched-literal? ( obj -- ? )
-    dup array? [
-        {
-            [ ?first "[" tail? ]
-            [ ?first "{" tail? ]
-            [ ?first "(" tail? ]
-            [ { [ ?first ":" tail? ] [ ?last ";" tail? ] } 1&& ]
-        } 1||
-    ] [
-        drop f
-    ] if ;
-
-DEFER: map-literals
-: (map-literals) ( obj quot: ( obj -- obj' ) -- seq )
-    over [ array? ] any? [
-        [ call drop ] [
-            map-literals
-        ] 2bi
-    ] [
-        over array? [ map-literals ] [ call ] if
-    ] if ; inline recursive
-
-: map-literals ( obj quot: ( obj -- obj' ) -- seq )
-    '[ _ (map-literals) ] map ; inline recursive
-
-
 
 
diff --git a/extra/modern/out/out.factor b/extra/modern/out/out.factor
index 1c4f3a3f62..91ed64b73e 100644
--- a/extra/modern/out/out.factor
+++ b/extra/modern/out/out.factor
@@ -3,7 +3,7 @@
 USING: arrays assocs io io.encodings.utf8 io.files
 io.streams.string kernel modern modern.paths modern.slices
 multiline namespaces prettyprint sequences sequences.extras
-splitting strings ;
+splitting strings continuations fry ;
 IN: modern.out
 
 : trim-before-newline ( seq -- seq' )
@@ -19,7 +19,22 @@ IN: modern.out
 GENERIC: write-literal* ( last obj -- last' )
 M: slice write-literal* [ write-whitespace ] [ write ] [ ] tri ;
 M: array write-literal* [ write-literal* ] each ;
-! M: string write-literal* drop [ write ] keep ; ! for refactoring
+M: string write-literal* [ write-whitespace ] [ write ] [ ] tri ; ! for refactoring
+
+
+
+DEFER: map-literals
+: (map-literals) ( obj quot: ( obj -- obj' ) -- seq )
+    over [ array? ] any? [
+        [ call drop ] [ map-literals ] 2bi
+    ] [
+        over array? [ map-literals ] [ call ] if
+    ] if ; inline recursive
+
+: map-literals ( obj quot: ( obj -- obj' ) -- seq )
+    '[ _ (map-literals) ] map ; inline recursive
+
+
 
 ! Start with no slice as ``last``
 : write-literal ( obj -- ) f swap write-literal* drop ;
@@ -30,23 +45,27 @@ M: array write-literal* [ write-literal* ] each ;
 : write-modern-path ( seq path -- )
     utf8 [ write-literal nl ] with-file-writer ; inline
 
-![[
-: rewrite-path ( path quot -- )
-    ! dup print
-    '[ [ path>literals [ _ map-literals ] map ] [ ] bi write-modern-path ]
-    [ drop . ] recover ; inline
+: write-modern-vocab ( seq vocab -- )
+    modern-source-path write-modern-path ; inline
 
-: rewrite-string ( string quot -- )
+: rewrite-path ( path quot: ( obj -- obj' ) -- )
     ! dup print
-    [ string>literals ] dip '[ _ map-literals ] map write-modern-string ; inline
+    '[ [ path>literals _ map-literals ] [ ] bi write-modern-path ]
+    [ drop . ] recover ; inline recursive
 
-: rewrite-paths ( seq quot -- ) '[ _ rewrite-path ] each ; inline
-]]
+: rewrite-string ( string quot: ( obj -- obj' ) -- )
+    ! dup print
+    [ string>literals ] dip map-literals write-modern-string ; inline recursive
+
+: rewrite-paths ( seq quot: ( obj -- obj' ) -- ) '[ _ rewrite-path ] each ; inline recursive
+
+: rewrite-vocab ( vocab quot: ( obj -- obj' ) -- )
+    [ [ vocab>literals ] dip map-literals ] 2keep drop write-modern-vocab ; inline recursive
 
 : rewrite-string-exact ( string -- string' )
     string>literals write-modern-string ;
 
-
+![[
 : rewrite-path-exact ( path -- )
     [ path>literals ] [ ] bi write-modern-path ;
 
@@ -55,6 +74,7 @@ M: array write-literal* [ write-literal* ] each ;
 
 : rewrite-paths ( paths -- )
     [ rewrite-path-exact ] each ;
+]]
 
 : strings-core-to-file ( -- )
     core-bootstrap-vocabs