modern: Fixing backslashes.

extra/modern/modern-tests.factor

@@ -37,3 +37,40 @@ IN: modern.tests
 {
     { { "<A" { } "A>" } }
 } [ "<A A>" string>literals >strings ] unit-test
+
+{
+    { { "<B:" { "hi" } ";B>" } }
+} [ "<B: hi ;B>" string>literals >strings ] unit-test
+
+{ { "<foo>" } } [ "<foo>" string>literals >strings ] unit-test
+{ { ">foo<" } } [ ">foo<" string>literals >strings ] unit-test
+
+{ { "foo>" } } [ "foo>" string>literals >strings ] unit-test
+{ { ">foo" } } [ ">foo" string>literals >strings ] unit-test
+{ { ">foo>" } } [ ">foo>" string>literals >strings ] unit-test
+{ { ">>foo>" } } [ ">>foo>" string>literals >strings ] unit-test
+{ { ">>foo>>" } } [ ">>foo>>" string>literals >strings ] unit-test
+
+{ { "foo<" } } [ "foo<" string>literals >strings ] unit-test
+{ { "<foo" } } [ "<foo" string>literals >strings ] unit-test
+{ { "<foo<" } } [ "<foo<" string>literals >strings ] unit-test
+{ { "<<foo<" } } [ "<<foo<" string>literals >strings ] unit-test
+{ { "<<foo<<" } } [ "<<foo<<" string>literals >strings ] unit-test
+
+! Backslash
+{
+    { { "SYNTAX\\" "AVL{" } }
+} [ "SYNTAX\\ AVL{" string>literals >strings ] unit-test
+
+[ "\\" string>literals >strings ] must-fail
+[ "SYNTAX\\" string>literals >strings ] must-fail
+
+{
+    { "foo\\bar" }
+} [ "foo\\bar" string>literals >strings ] unit-test
+
+[ "foo\\bar{" string>literals >strings ] must-fail
+
+{
+    { { "foo\\bar{" { "1" } "}" } }
+} [ "foo\\bar{ 1 }" string>literals >strings ] unit-test

extra/modern/modern.factor

@@ -199,14 +199,15 @@ ERROR: colon-word-must-be-all-uppercase-or-lowercase n string word ;
     [ take-comment ] [ merge-slice-til-whitespace ] if ;
 
 ERROR: backslash-expects-whitespace slice ;
+ERROR: no-backslash-payload n string slice ;
 : read-backslash ( n string slice -- n' string obj )
-    2over peek-from blank? [
+    merge-slice-til-whitespace dup "\\" tail? [
         ! \ foo, M\ foo
-        [ skip-blank-from slice-til-whitespace drop dup ] dip 1 cut-slice* 4array
-    ] [
-        ! M\N
-        merge-slice-til-whitespace
-    ] if ;
+        [
+                skip-blank-from slice-til-whitespace drop
+                dup [ no-backslash-payload ] unless
+        ] dip swap 2array
+    ] when ;
 
 ! If the slice is 0 width, we stopped on whitespace.
 ! Advance the index and read again!
@@ -219,10 +220,8 @@ ERROR: mismatched-terminator n string slice ;
 
 : lex-factor ( n/f string -- n'/f string literal )
     over [
-        skip-whitespace "\"\\!:[{(<>\s\r\n" slice-til-either {
-            ! { CHAR: ` [ read-backtick ] }
+        skip-whitespace "\"!:[{(<>\s\r\n" slice-til-either {
             { CHAR: \" [ read-string ] }
-            { CHAR: \\ [ read-backslash ] }
             { CHAR: \! [ read-exclamation ] }
             { CHAR: \: [
                 merge-slice-til-whitespace
@@ -266,7 +265,7 @@ ERROR: mismatched-terminator n string slice ;
             { CHAR: \r [ read-token-or-whitespace ] }
             { CHAR: \n [ read-token-or-whitespace ] }
             { f [ f like ] }
-        } case
+        } case dup "\\" tail? [ read-backslash ] when
     ] [
         f
     ] if ; inline
@@ -289,3 +288,4 @@ ERROR: mismatched-terminator n string slice ;
 : lex-core ( -- assoc ) core-bootstrap-vocabs lex-vocabs ;
 : lex-basis ( -- assoc ) basis-vocabs lex-vocabs ;
 : lex-extra ( -- assoc ) extra-vocabs lex-vocabs ;
+: lex-all ( -- assoc ) lex-core lex-basis lex-extra 3append ;

extra/modern/slices/slices.factor

@@ -64,17 +64,23 @@ ERROR: unexpected-end n string ;
     pick [ drop t ] [ length -rot nip f ] if ; inline
 
 : skip-blank-from ( n string -- n' string )
-    [ [ blank? not ] find-from* 2drop ] keep ; inline
+    over [
+        [ [ blank? not ] find-from* 2drop ] keep
+    ] when ; inline
 
 : skip-til-eol-from ( n string -- n' string )
     [ [ "\r\n" member? ] find-from* 2drop ] keep ; inline
 
 ! Don't include the whitespace in the slice
 :: slice-til-whitespace ( n string -- n' string slice/f ch/f )
-    n string [ "\s\r\n" member? ] find-from :> ( n' ch )
-    n' string
-    n n' string ?<slice>
-    ch ; inline
+    n [
+        n string [ "\s\r\n" member? ] find-from :> ( n' ch )
+        n' string
+        n n' string ?<slice>
+        ch
+    ] [
+        f string f f
+    ] if ; inline
 
 :: slice-until' ( n string quot -- n' string slice/f ch/f )
     n string quot find-from :> ( n' ch )