modern: Trying to get a using list graph.

extra/modern/manifest/manifest.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2019 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators
-combinators.short-circuit kernel modern sequences
+combinators.short-circuit kernel modern modern.compiler
-splitting.monotonic strings words ;
+sequences splitting.monotonic strings words ;
 IN: modern.manifest
 
 MIXIN: token
@@ -228,27 +228,3 @@ GENERIC: upper-colon>definitions ( form -- seq )
         { [ dup ?first upper-colon? ] [ upper-colon>definitions ] }
         [ ]
     } cond ;
-
-DEFER: map-literals
-: map-literal ( obj quot: ( obj -- obj' ) -- obj )
-    over { [ array? ] [ ?first section-open? ] } 1&& [
-        [ first3 swap ] dip map-literals swap 3array
-    ] [
-        call
-    ] if ; inline recursive
-
-: map-literals ( seq quot: ( obj -- obj' ) -- seq' )
-    '[ _ map-literal ] map ; inline recursive
-
-DEFER: map-literals!
-: map-literal! ( obj quot: ( obj -- obj' ) -- obj )
-    over { [ array? ] [ ?first section-open? ] } 1&& [
-        [ call drop ] [
-            map-literals!
-        ] 2bi
-    ] [
-        call
-    ] if ; inline recursive
-
-: map-literals! ( seq quot: ( obj -- obj' ) -- seq )
-    '[ _ map-literal! ] map! ; inline recursive

extra/modern/modern.factor

@@ -66,8 +66,7 @@ DEFER: lex-factor
         ] loop
     ] { } make ;
 
-DEFER: section-close?
+DEFER: section-close-form?
-DEFER: upper-colon?
 DEFER: lex-factor-nested
 : lex-colon-until ( string n tag-sequence -- string n' payload )
     '[
@@ -77,7 +76,7 @@ DEFER: lex-factor-nested
             [
                 dup [
                     ! This is for ending COLON: forms like ``A: PRIVATE>``
-                    dup section-close? [
+                    dup section-close-form? [
                         drop f
                     ] [
                         ! } gets a chance, but then also full seq { } after recursion...
@@ -249,7 +248,7 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) )
         [ html-close? ]
     } 1|| ;
 
-: upper-colon? ( string -- ? )
+: upper-colon-form? ( string -- ? )
     dup { [ length 0 > ] [ [ char: \: = ] all? ] } 1&& [
         drop t
     ] [
@@ -261,7 +260,7 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) )
         } 1&&
     ] if ;
 
-: section-close? ( string -- ? )
+: section-close-form? ( string -- ? )
     {
         [ length 2 >= ]
         [ "\\" head? not ] ! XXX: good?
@@ -290,8 +289,8 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) )
         { [ dup "]" sequence= ] [ drop unclip-last -rot 2array <upper-colon> [ rewind-slice ] dip ] }
         { [ dup "}" sequence= ] [ drop unclip-last -rot 2array <upper-colon> [ rewind-slice ] dip ] }
         { [ dup ")" sequence= ] [ drop unclip-last -rot 2array <upper-colon> [ rewind-slice ] dip ] } ! (n*quot) breaks
-        { [ dup section-close? ] [ drop unclip-last -rot 2array <upper-colon> [ rewind-slice ] dip ] }
+        { [ dup section-close-form? ] [ drop unclip-last -rot 2array <upper-colon> [ rewind-slice ] dip ] }
-        { [ dup upper-colon? ] [ drop unclip-last -rot 2array <upper-colon> [ rewind-slice ] dip ] }
+        { [ dup upper-colon-form? ] [ drop unclip-last -rot 2array <upper-colon> [ rewind-slice ] dip ] }
         [ drop 2array <upper-colon> ]
     } cond ;
 
@@ -415,7 +414,7 @@ DEFER: lex-factor-top*
         { char: \! [ read-exclamation ] }
         { char: > [
             [ [ char: > = not ] slice-until-exclude drop ] dip merge-slices
-            dup section-close? [
+            dup section-close-form? [
                 [ slice-til-whitespace drop ] dip ?span-slices
             ] unless
         ] }
@@ -432,7 +431,7 @@ DEFER: lex-factor-top*
             ! A: B: then interrupt the current parser
             ! A: b: then keep going
             merge-slice-til-whitespace
-            dup { [ upper-colon? ] [ ":" = ] } 1||
+            dup { [ upper-colon-form? ] [ ":" = ] } 1||
             ! dup upper-colon?
             [ rewind-slice f ]
             [ read-colon ] if

extra/modern/out/out.factor

@@ -30,6 +30,7 @@ M: renamed write-literal*
     [ slice>> ] tri ; ! for refactoring
 : write-literal ( obj -- ) f swap write-literal* drop ;
 
+![[
 DEFER: map-literals
 : (map-literals) ( obj quot: ( obj -- obj' ) -- seq )
     over array? [
@@ -41,6 +42,32 @@ DEFER: map-literals
 
 : map-literals ( obj quot: ( obj -- obj' ) -- seq )
     '[ _ (map-literals) ] map ; inline recursive
+]]
+
+DEFER: map-literals
+: map-literal ( obj quot: ( ..a obj -- ..a obj' ) -- obj )
+    over section? [
+        [ second ] dip map-literals
+    ] [
+        call
+    ] if ; inline recursive
+
+: map-literals ( seq quot: ( ..a obj -- ..a obj' ) -- seq' )
+    '[ _ map-literal ] map ; inline recursive
+
+DEFER: map-literals!
+: map-literal! ( obj quot: ( obj -- obj' ) -- obj )
+    over { [ array? ] [ ?first section-open? ] } 1&& [
+        [ call drop ] [
+            map-literals!
+        ] 2bi
+    ] [
+        call
+    ] if ; inline recursive
+
+: map-literals! ( seq quot: ( obj -- obj' ) -- seq )
+    '[ _ map-literal! ] map! ; inline recursive
+
 
 : write-modern-string ( seq -- string )
     [ write-literal ] with-string-writer ; inline

extra/modern/tools/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/modern/tools/tools.factor

@@ -0,0 +1,28 @@
+! Copyright (C) 2019 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs combinators.short-circuit kernel modern
+modern.compiler modern.out modern.slices sequences
+sequences.extras ;
+IN: modern.tools
+
+: vocabs>using-tool ( vocabs -- assoc )
+    [ vocab>literals ] map-zip
+    [
+        [
+            { [ upper-colon? ] [ first "USING:" sequence= ] } 1&&
+        ] filter
+        [ second >strings ] map
+    ] assoc-map ;
+
+! Needs filter-literals
+: vocabs>using-tool2 ( vocabs -- assoc )
+    [ vocab>literals ] map-zip
+    [
+      [
+        dup { [ upper-colon? ] [ first "USING:" sequence= ] } 1&& [
+          second >strings
+        ] [
+          drop f
+        ] if
+      ] map-literals harvest concat harvest
+    ] assoc-map ;