diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor index b136cf10b6..c3202f12b3 100644 --- a/basis/cocoa/subclassing/subclassing.factor +++ b/basis/cocoa/subclassing/subclassing.factor @@ -74,7 +74,7 @@ C: cocoa-protocol SYNTAX: \COCOA-PROTOCOL: scan-token suffix! ; -SYMBOL: ;CLASS> +SYMBOL: \;CLASS> SYNTAX: \ delimiter +DEFER: \;FUNCTOR> delimiter unit-test-failed-section ( quot -- obj ) ; -SYMBOL: UNIT-TEST-FAILED> +SYMBOL: \UNIT-TEST-FAILED> SYNTAX: \ parse-until suffix! ; diff --git a/extra/modern/compiler/compiler.factor b/extra/modern/compiler/compiler.factor index 732aaa75c3..6d4a69105c 100644 --- a/extra/modern/compiler/compiler.factor +++ b/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 ; diff --git a/extra/modern/modern-tests.factor b/extra/modern/modern-tests.factor index 91cfe4495c..5c85b47aa6 100644 --- a/extra/modern/modern-tests.factor +++ b/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 { { { "!" "" } } diff --git a/extra/modern/modern.factor b/extra/modern/modern.factor index 003a15e775..46bb9645a5 100644 --- a/extra/modern/modern.factor +++ b/extra/modern/modern.factor @@ -181,15 +181,21 @@ ERROR: unexpected-terminator n string slice ; } 1&& ; : upper-colon? ( string -- ? ) - { - [ length 2 >= ] - [ ":" tail? ] - [ dup [ char: \: = ] find drop head strict-upper? ] - } 1&& ; + dup { [ length 0 > ] [ [ char: \: = ] all? ] } 1&& [ + drop t + ] [ + { + [ length 2 >= ] + [ "\\" head? not ] ! XXX: good? + [ ":" tail? ] + [ dup [ char: \: = ] find drop head strict-upper? ] + } 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 ] }