modern: revamp paths.

core/modern/modern.factor

@@ -6,7 +6,7 @@ generalizations io.encodings.utf8 io.files kernel locals macros
 make math math.order modern.lexer modern.paths modern.slices
 multiline namespaces quotations sequences sequences.extras
 shuffle splitting splitting.extras splitting.monotonic strings
-unicode ;
+unicode vocabs.loader ;
 IN: modern
 
 COMPILE<
@@ -549,7 +549,7 @@ CONSTANT: factor-lexing-rules {
 
 : vocab>literals ( vocab -- sequence )
     ".private" ?tail drop
-    modern-source-path path>literals ;
+    vocab-source-path path>literals ;
 
 
 ! What a lexer body looks like, produced by make-lexer

core/modern/out/out.factor

@@ -211,14 +211,7 @@ M: compound-sequence-literal write-literal
     [ string>literals ] dip '[ _ map-literals ] map write-modern-string ; inline
 
 : rewrite-paths ( seq quot -- ) '[ _ rewrite-path ] each ; inline
-: lexable-core-paths ( -- seq ) core-source-paths ;
-: lexable-basis-paths ( -- seq )
-    basis-source-paths {
-    } diff ;
 
-: lexable-extra-paths ( -- seq )
-    extra-source-paths {
-    } diff ;
 
 /*
 ! These work except they use pegs/ebnf, grep for [[ ]]
@@ -232,13 +225,6 @@ M: compound-sequence-literal write-literal
 	modified:   extra/shell/parser/parser.factor
 */
 
-: lexable-paths ( -- seq )
-    [
-        lexable-core-paths
-        lexable-basis-paths
-        lexable-extra-paths
-    ] append-outputs ;
-
 : paren-word>tick-word ( string -- string' )
     dup [ "(" ?head drop ")" ?tail drop "'" append ] [ ] if ;
 
@@ -259,7 +245,6 @@ M: compound-sequence-literal write-literal
     ] when ;
 
 : transform-source ( quot -- )
-    lexable-paths swap rewrite-paths ; inline
+    all-paths swap rewrite-paths ; inline
 
-: transform-core ( quot -- )
+! : transform-core ( quot -- ) lexable-core-paths swap rewrite-paths ; inline
-    lexable-core-paths swap rewrite-paths ; inline

core/modern/paths/paths.factor

@@ -1,36 +1,9 @@
 ! Copyright (C) 2015 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators.smart io.files kernel sequences
+USING: accessors combinators.smart io.files kernel namespaces
-splitting vocabs.files vocabs.hierarchy vocabs.loader
+sequences sets splitting vocabs.files vocabs.hierarchy
-vocabs.metadata sets ;
+vocabs.loader vocabs.metadata ;
-IN: modern.paths
+in: modern.paths
-
-: modern-if-available ( path -- path' )
-    dup ".factor" ?tail [
-        ".modern" append
-        dup exists? [ nip ] [ drop ] if
-    ] [
-        drop
-    ] if ;
-
-ERROR: not-a-source-path path ;
-: force-modern-path ( path -- path' )
-    ".factor" ?tail [ ".modern" append ] [ not-a-source-path ] if ;
-: modern-docs-path ( path -- path' )
-    vocab-docs-path modern-if-available ;
-: modern-tests-path ( path -- path' )
-    vocab-tests-path modern-if-available ;
-: modern-source-path ( path -- path' )
-    vocab-source-path modern-if-available ;
-: modern-syntax-path ( path -- path' )
-    vocab-source-path ".factor" ?tail drop "-syntax.modern" append ;
-
-: force-modern-docs-path ( path -- path' )
-    vocab-docs-path force-modern-path ;
-: force-modern-tests-path ( path -- path' )
-    vocab-tests-path force-modern-path ;
-: force-modern-source-path ( path -- path' )
-    vocab-source-path force-modern-path ;
 
 : vocabs-from ( root -- vocabs )
     "" disk-vocabs-in-root/prefix
@@ -60,15 +33,6 @@ ERROR: not-a-source-path path ;
 : core-bootstrap-vocabs ( -- seq )
     core-vocabs less-core-test-vocabs ;
 
-: basis-vocabs ( -- seq ) "resource:basis" vocabs-from ;
-: extra-vocabs ( -- seq ) "resource:extra" vocabs-from ;
-: all-vocabs ( -- seq )
-    [
-        core-vocabs
-        basis-vocabs
-        extra-vocabs
-    ] { } append-outputs-as ;
-
 : filter-exists ( seq -- seq' ) [ exists? ] filter ;
 
 ! These paths have syntax errors on purpose...
@@ -98,37 +62,30 @@ ERROR: not-a-source-path path ;
     [ ".modern" tail? ] reject ;
 
 : modern-source-paths ( names -- paths )
-    [ modern-source-path ] map filter-exists reject-some-paths ;
+    [ vocab-source-path ] map filter-exists reject-some-paths ;
 : modern-docs-paths ( names -- paths )
-    [ modern-docs-path ] map filter-exists reject-some-paths ;
+    [ vocab-docs-path ] map filter-exists reject-some-paths ;
 : modern-tests-paths ( names -- paths )
-    [ vocab-tests ] map concat
+    [ vocab-tests-path ] map filter-exists reject-some-paths ;
-    [ modern-if-available ] map filter-exists reject-some-paths ;
 
-: all-source-paths ( -- seq )
+: unsupported-vocabs ( -- seq )
-    all-vocabs modern-source-paths ;
+    {
+        "specialized-arrays" "specialized-vectors"
+        "math.blas.matrices" "math.blas.vectors" "math.vectors.simd"
+        "math.vectors.simd.cords" "game.debug" "gpu.util" "gpu.effects.blur"
+        "gpu.effects.step" "model-viewer" "terrain.shaders" "spheres"
+        "bunny.cel-shaded" "bunny.outlined"
+    } ;
 
-: all-docs-paths ( -- seq )
-    all-vocabs modern-docs-paths ;
 
-: all-tests-paths ( -- seq )
+: all-vocabs ( -- seq )
-    all-vocabs modern-tests-paths ;
-
-: all-syntax-paths ( -- seq )
-    all-vocabs [ modern-syntax-path ] map filter-exists reject-some-paths ;
-
-: all-factor-paths ( -- seq )
     [
-        all-syntax-paths all-source-paths all-docs-paths all-tests-paths
+        vocab-roots get [ vocabs-from ] map concat
     ] { } append-outputs-as ;
 
-: vocab-names>syntax ( strings -- seq )
+: all-paths ( -- seq )
-    [ modern-syntax-path ] map [ exists? ] filter ;
+    [
-
+        all-vocabs less-core-test-vocabs
-: core-syntax-paths ( -- seq ) core-vocabs vocab-names>syntax reject-some-paths ;
+        unsupported-vocabs diff
-: basis-syntax-paths ( -- seq ) basis-vocabs vocab-names>syntax reject-some-paths ;
+        [ modern-source-paths ] [ modern-docs-paths ] [ modern-tests-paths ] tri
-: extra-syntax-paths ( -- seq ) extra-vocabs vocab-names>syntax reject-some-paths ;
+    ] { } append-outputs-as reject-some-paths filter-exists ;
-
-: core-source-paths ( -- seq ) core-vocabs modern-source-paths reject-some-paths ;
-: basis-source-paths ( -- seq ) basis-vocabs modern-source-paths reject-some-paths ;
-: extra-source-paths ( -- seq ) extra-vocabs modern-source-paths reject-some-paths ;