diff --git a/extra/modern/modern-tests.factor b/extra/modern/modern-tests.factor
index 30f7aa90ce..05e47737c0 100644
--- a/extra/modern/modern-tests.factor
+++ b/extra/modern/modern-tests.factor
@@ -37,3 +37,40 @@ IN: modern.tests
{
{ { "" } }
} [ "" string>literals >strings ] unit-test
+
+{
+ { { "" } }
+} [ "" string>literals >strings ] unit-test
+
+{ { "" } } [ "" 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
+{ { "literals >strings ] unit-test
+{ { "literals >strings ] unit-test
+{ { "<literals >strings ] unit-test
+{ { "<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
diff --git a/extra/modern/modern.factor b/extra/modern/modern.factor
index 5e09baa0e4..9b9cabdf77 100644
--- a/extra/modern/modern.factor
+++ b/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 ;
diff --git a/extra/modern/slices/slices.factor b/extra/modern/slices/slices.factor
index 2aefa1a2c4..b027e3a5c8 100644
--- a/extra/modern/slices/slices.factor
+++ b/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 ?
- ch ; inline
+ n [
+ n string [ "\s\r\n" member? ] find-from :> ( n' ch )
+ n' string
+ n n' string ?
+ 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 )