From e239b7f6f75d25e54ab72c95b2d12aa28866595e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 21 Jun 2016 02:32:39 -0700
Subject: [PATCH] modern: more < > work.

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

diff --git a/core/modern/modern-tests.factor b/core/modern/modern-tests.factor
index 18571b8c2b..a5c31672d3 100644
--- a/core/modern/modern-tests.factor
+++ b/core/modern/modern-tests.factor
@@ -122,4 +122,8 @@ in: modern.tests
 ] unit-test
 
 { 1 }
-[ "PRIVATE< OMG:  PRIVATE>" string>literals length ] unit-test
\ No newline at end of file
+[ "PRIVATE< OMG:  PRIVATE>" string>literals length ] unit-test
+
+{ t } [ "=>" string>literals first tag-literal? ] unit-test
+{ t } [ ">>" string>literals first tag-literal? ] unit-test
+{ t } [ "<<" string>literals first tag-literal? ] unit-test
\ No newline at end of file
diff --git a/core/modern/modern.factor b/core/modern/modern.factor
index 699bb06e49..8c07133c31 100644
--- a/core/modern/modern.factor
+++ b/core/modern/modern.factor
@@ -115,8 +115,11 @@ M: array collapse-decorators
     collapse-decorators make-compound-literals ;
 
 ! foo:bar-baz09:
+: strict-upper-letter? ( ch -- ? )
+    { [ char: A char: Z between? ] [ char: 0 char: 9 between? ] [ ":-#" member? ] } 1|| ;
+
 : strict-upper? ( string -- ? )
-    [ { [ char: A char: Z between? ] [ char: 0 char: 9 between? ] [ ":-#" member? ] } 1|| ] all? ;
+    [ strict-upper-letter? ] all? ;
 
 : whitespace/f? ( ch -- ? )
     { char: \s char: \r char: \n f } member? ; inline
@@ -153,20 +156,20 @@ M: array collapse-decorators
             [ [ char: \: = ] find-last ] keep
             swap [ swap tail strict-upper? ] [ nip strict-upper? ] if
         ] [
-            "<" sequence=
+            [ char: \< = ] all? not
         ] if
     ] [
         drop f
     ] if ;
 
 : top-level-greater-than? ( string -- ? )
-    dup { [ ">" tail? ] [ length 1 > ] } 1&& [
+    dup { [ ">" tail? ] [ length 1 > ] [ first char: A char: Z between? ] } 1&& [
         but-last
         dup length 1 > [
             [ [ char: \: = ] find-last ] keep
             swap [ swap tail strict-upper? ] [ nip strict-upper? ] if
         ] [
-            ">" sequence=
+            [ char: \> = ] all? not
         ] if
     ] [
         drop f