modern: basis works with vocabs>identifiers

basis-vocabs [ dup . flush vocab>identifiers ] map

basis/cocoa/subclassing/subclassing.factor

@@ -74,7 +74,7 @@ C: <cocoa-protocol> cocoa-protocol
 SYNTAX: \COCOA-PROTOCOL:
     scan-token <cocoa-protocol> suffix! ;
 
-SYMBOL: ;CLASS>
+SYMBOL: \;CLASS>
 
 SYNTAX: \<CLASS:
     scan-token

basis/functors/functors.factor

@@ -139,7 +139,7 @@ SYNTAX: DEFINES-PRIVATE [ begin-private create-word-in end-private ] (INTERPOLAT
 
 SYNTAX: DEFINES-CLASS [ create-class-in ] (INTERPOLATE) ;
 
-DEFER: ;FUNCTOR> delimiter
+DEFER: \;FUNCTOR> delimiter
 
 <PRIVATE
 

basis/tools/test/test.factor

@@ -241,7 +241,7 @@ SYNTAX: \UNIT-TEST:
 
 TUPLE: unit-test-failed-section quot ;
 CONSTRUCTOR: <unit-test-failed-section> unit-test-failed-section ( quot -- obj ) ;
-SYMBOL: UNIT-TEST-FAILED>
+SYMBOL: \UNIT-TEST-FAILED>
 SYNTAX: \<UNIT-TEST-FAILED
     \ UNIT-TEST-FAILED> parse-until <unit-test-failed-section> suffix! ;
 

extra/modern/compiler/compiler.factor

@@ -308,9 +308,6 @@ GENERIC: tuple>identifiers ( obj -- obj' )
 
 M: comment tuple>identifiers drop f ;
 
-M: section tuple>identifiers
-    payload>> [ tuple>identifiers ] map sift ;
-
 M: identifier tuple>identifiers drop f ;
 M: lower-colon tuple>identifiers drop f ;
 M: escaped-object tuple>identifiers drop f ;
@@ -318,6 +315,15 @@ M: double-quote tuple>identifiers drop f ;
 M: single-bracket tuple>identifiers drop f ;
 M: single-brace tuple>identifiers drop f ;
 M: single-paren tuple>identifiers drop f ;
+M: double-bracket tuple>identifiers drop f ;
+M: double-brace tuple>identifiers drop f ;
+M: double-paren tuple>identifiers drop f ;
+
+M: section tuple>identifiers
+    payload>> [ tuple>identifiers ] map sift ;
+
+M: named-section tuple>identifiers
+    payload>> [ tuple>identifiers ] map sift ;
 
 ERROR: upper-colon-identifer-expected obj ;
 ERROR: unknown-upper-colon upper-colon string ;
@@ -331,7 +337,10 @@ M: upper-colon tuple>identifiers
         { "IN" [ drop f ] }
         { "M" [ drop f ] }
         { "INSTANCE" [ drop f ] }
+        { "ARTICLE" [ drop f ] } ! TODO: Should be a word imo
+        { "ABOUT" [ drop f ] } ! TODO: Should be a word imo
         { "ROMAN-OP" [ ?first name>> "roman" prepend ] }
+        { "TYPEDEF" [ ?second name>> ] }
         [ drop ?first name>> ]
     } case nip ;
 

extra/modern/modern-tests.factor

@@ -3,6 +3,23 @@
 USING: modern modern.slices multiline tools.test ;
 IN: modern.tests
 
+{ f } [ "" upper-colon? ] unit-test
+{ t } [ ":" upper-colon? ] unit-test
+{ t } [ "::" upper-colon? ] unit-test
+{ t } [ ":::" upper-colon? ] unit-test
+{ t } [ "FOO:" upper-colon? ] unit-test
+{ t } [ "FOO::" upper-colon? ] unit-test
+{ t } [ "FOO:::" upper-colon? ] unit-test
+
+{ f } [ "\\" upper-colon? ] unit-test
+{ f } [ "\\:" upper-colon? ] unit-test
+{ f } [ "\\::" upper-colon? ] unit-test
+{ f } [ "\\:::" upper-colon? ] unit-test
+{ f } [ "\\FOO:" upper-colon? ] unit-test
+{ f } [ "\\FOO::" upper-colon? ] unit-test
+{ f } [ "\\FOO:::" upper-colon? ] unit-test
+
+
 ! Comment
 {
     { { "!" "" } }

extra/modern/modern.factor

@@ -181,15 +181,21 @@ ERROR: unexpected-terminator n string slice ;
     } 1&& ;
 
 : upper-colon? ( string -- ? )
+    dup { [ length 0 > ] [ [ char: \: = ] all? ] } 1&& [
+        drop t
+    ] [
         {
             [ length 2 >= ]
+            [ "\\" head? not ] ! XXX: good?
             [ ":" tail? ]
             [ dup [ char: \: = ] find drop head strict-upper? ]
-    } 1&& ;
+        } 1&&
+    ] if ;
 
 : section-close? ( string -- ? )
     {
         [ length 2 >= ]
+        [ "\\" head? not ] ! XXX: good?
         [ ">" tail? ]
         [
             {
@@ -296,7 +302,8 @@ DEFER: lex-factor-top*
             ! A: B: then interrupt the current parser
             ! A: b: then keep going
             merge-slice-til-whitespace
-            dup upper-colon?
+            dup { [ upper-colon? ] [ ":" = ] } 1||
+            ! dup upper-colon?
             [ rewind-slice f ]
             [ read-colon ] if
         ] }