From dfe27752a031c75e798c6625300cefeac79db2ce Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 21 Jun 2016 02:07:13 -0700
Subject: [PATCH] modern: so confusing parser. make a separate handler for
 gt-delimiter.

---
 core/modern/modern-tests.factor |  5 ++++-
 core/modern/modern.factor       | 31 +++++++++++++++++++++++++++----
 2 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/core/modern/modern-tests.factor b/core/modern/modern-tests.factor
index ae459eaead..18571b8c2b 100644
--- a/core/modern/modern-tests.factor
+++ b/core/modern/modern-tests.factor
@@ -119,4 +119,7 @@ in: modern.tests
 [
     "foo<{ ptx-2op-instruction ptx-float-ftz }" string>literals
     [ length ] [ first single-matched-literal? ] [ first tag>> ] tri
-] unit-test
\ No newline at end of file
+] unit-test
+
+{ 1 }
+[ "PRIVATE< OMG:  PRIVATE>" string>literals length ] unit-test
\ No newline at end of file
diff --git a/core/modern/modern.factor b/core/modern/modern.factor
index 3648875dcd..699bb06e49 100644
--- a/core/modern/modern.factor
+++ b/core/modern/modern.factor
@@ -159,6 +159,19 @@ M: array collapse-decorators
         drop f
     ] if ;
 
+: top-level-greater-than? ( string -- ? )
+    dup { [ ">" tail? ] [ length 1 > ] } 1&& [
+        but-last
+        dup length 1 > [
+            [ [ char: \: = ] find-last ] keep
+            swap [ swap tail strict-upper? ] [ nip strict-upper? ] if
+        ] [
+            ">" sequence=
+        ] if
+    ] [
+        drop f
+    ] if ;
+
 : top-level-name? ( string -- ? )
     { [ top-level-colon? ] [ top-level-less-than? ] } 1|| ;
 
@@ -342,8 +355,6 @@ MACRO:: read-matched ( ch -- quot: ( lexer tag -- slice' ) )
     tag 1 cut-slice* dquote-literal make-matched-literal
     [ >string ] change-payload ;
 
-
-
 ERROR: cannot-nest-upper-colon n string string' ;
 : read-upper-colon ( lexer string' -- obj/f )
     over peek-tag top-level-colon? [
@@ -430,11 +441,22 @@ ERROR: backslash-expects-whitespace slice ;
     [ nip make-tag-literal ] if-empty ;
 
 ERROR: mismatched-terminator lexer slice ;
-: read-terminator ( lexer slice -- slice )
+: read-terminator ( lexer slice -- slice/f )
     2dup [ dup peek-tag ] dip delimiters-match? [
         nip terminator-literal make-tag-class-literal
     ] [
-        mismatched-terminator
+        roll-back-lexer f
+    ] if ;
+
+: gt-terminator ( lexer slice -- slice/f )
+    dupd merge-lex-til-whitespace dup top-level-greater-than? [
+        2dup [ dup peek-tag ] dip delimiters-match? [
+            nip terminator-literal make-tag-class-literal
+        ] [
+            roll-back-lexer f
+        ] if
+    ] [
+        nip make-tag-literal
     ] if ;
 
 : ?blank? ( ch/f -- blank/f )
@@ -506,6 +528,7 @@ CONSTANT: factor-lexing-rules {
     T{ terminator-lexer { generator read-terminator } { delimiter char: \] } }
     T{ terminator-lexer { generator read-terminator } { delimiter char: \} } }
     T{ terminator-lexer { generator read-terminator } { delimiter char: \) } }
+    T{ terminator-lexer { generator gt-terminator } { delimiter char: \> } }
     
     T{ whitespace-lexer { generator read-token-or-whitespace } { delimiter char: \s } }
     T{ whitespace-lexer { generator read-token-or-whitespace } { delimiter char: \r } }