modern: Backslashes should be like \AVL{ instead of \ AVL{
The only thing that matters is a leading \ Backslashed patterns: \foo \foo\bar Non-backslashed patterns: foo\bar foo\bar{modern-harvey2
parent
c436f6dbad
commit
15fe8c3844
|
@ -57,13 +57,13 @@ IN: modern.tests
|
||||||
{ { "<<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
|
! Backslash \AVL{ foo\bar foo\bar{
|
||||||
{
|
{
|
||||||
{ { "SYNTAX\\" "AVL{" } }
|
{ { "SYNTAX:" { "\\AVL{" } } }
|
||||||
} [ "SYNTAX\\ AVL{" string>literals >strings ] unit-test
|
} [ "SYNTAX: \\AVL{" string>literals >strings ] unit-test
|
||||||
|
|
||||||
[ "\\" string>literals >strings ] must-fail
|
{ { "\\" } } [ "\\" string>literals >strings ] unit-test
|
||||||
[ "SYNTAX\\" string>literals >strings ] must-fail
|
{ { "\\FOO" } } [ "\\FOO" string>literals >strings ] unit-test
|
||||||
|
|
||||||
{
|
{
|
||||||
{ "foo\\bar" }
|
{ "foo\\bar" }
|
||||||
|
@ -74,3 +74,11 @@ IN: modern.tests
|
||||||
{
|
{
|
||||||
{ { "foo\\bar{" { "1" } "}" } }
|
{ { "foo\\bar{" { "1" } "}" } }
|
||||||
} [ "foo\\bar{ 1 }" string>literals >strings ] unit-test
|
} [ "foo\\bar{ 1 }" string>literals >strings ] unit-test
|
||||||
|
|
||||||
|
{ { { "char:" "\\{" } } } [ "char: \\{" string>literals >strings ] unit-test
|
||||||
|
[ "char: {" string>literals >strings ] must-fail
|
||||||
|
[ "char: [" string>literals >strings ] must-fail
|
||||||
|
[ "char: {" string>literals >strings ] must-fail
|
||||||
|
[ "char: \"" string>literals >strings ] must-fail
|
||||||
|
{ { { "char:" "\\\\" } } } [ "char: \\\\" string>literals >strings ] unit-test
|
||||||
|
{ { { "char:" "\\" } } } [ "char: \\" string>literals >strings ] unit-test
|
|
@ -199,15 +199,6 @@ ERROR: colon-word-must-be-all-uppercase-or-lowercase n string word ;
|
||||||
[ take-comment ] [ merge-slice-til-whitespace ] if ;
|
[ take-comment ] [ merge-slice-til-whitespace ] if ;
|
||||||
|
|
||||||
ERROR: backslash-expects-whitespace slice ;
|
ERROR: backslash-expects-whitespace slice ;
|
||||||
ERROR: no-backslash-payload n string slice ;
|
|
||||||
: read-backslash ( n string slice -- n' string obj )
|
|
||||||
merge-slice-til-whitespace dup "\\" tail? [
|
|
||||||
! \ foo, M\ foo
|
|
||||||
[
|
|
||||||
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.
|
! If the slice is 0 width, we stopped on whitespace.
|
||||||
! Advance the index and read again!
|
! Advance the index and read again!
|
||||||
|
@ -218,53 +209,70 @@ ERROR: no-backslash-payload n string slice ;
|
||||||
ERROR: mismatched-terminator n string slice ;
|
ERROR: mismatched-terminator n string slice ;
|
||||||
: read-terminator ( n string slice -- n' string slice ) ;
|
: read-terminator ( n string slice -- n' string slice ) ;
|
||||||
|
|
||||||
|
: (lex-factor) ( n/f string slice/f ch/f -- n'/f string literal )
|
||||||
|
{
|
||||||
|
{ char: \" [ read-string ] }
|
||||||
|
{ char: \! [ read-exclamation ] }
|
||||||
|
{ char: \: [
|
||||||
|
merge-slice-til-whitespace
|
||||||
|
dup strict-upper? strict-upper get and [
|
||||||
|
length swap [ - ] dip f
|
||||||
|
strict-upper off
|
||||||
|
] [
|
||||||
|
read-colon
|
||||||
|
] if
|
||||||
|
] }
|
||||||
|
{ char: < [
|
||||||
|
! FOO: a b <BAR: ;BAR>
|
||||||
|
! FOO: a b <BAR BAR>
|
||||||
|
! FOO: a b <asdf>
|
||||||
|
! FOO: a b <asdf asdf>
|
||||||
|
|
||||||
|
! if we are in a FOO: and we hit a <BAR or <BAR:
|
||||||
|
! then end the FOO:
|
||||||
|
[ slice-til-whitespace drop ] dip span-slices
|
||||||
|
dup section-open? [
|
||||||
|
strict-upper get [
|
||||||
|
length swap [ - ] dip f strict-upper off
|
||||||
|
] [
|
||||||
|
read-acute
|
||||||
|
] if
|
||||||
|
] when
|
||||||
|
] }
|
||||||
|
{ char: > [
|
||||||
|
[ slice-til-whitespace drop ] dip span-slices
|
||||||
|
dup section-close? [
|
||||||
|
strict-upper get [
|
||||||
|
length swap [ - ] dip f strict-upper off
|
||||||
|
] when
|
||||||
|
] when
|
||||||
|
] }
|
||||||
|
{ char: \[ [ read-bracket ] }
|
||||||
|
{ char: \{ [ read-brace ] }
|
||||||
|
{ char: \( [ read-paren ] }
|
||||||
|
{ char: \s [ read-token-or-whitespace ] }
|
||||||
|
{ char: \r [ read-token-or-whitespace ] }
|
||||||
|
{ char: \n [ read-token-or-whitespace ] }
|
||||||
|
{ f [ f like ] }
|
||||||
|
} case ;
|
||||||
|
|
||||||
: lex-factor ( n/f string -- n'/f string literal )
|
: lex-factor ( n/f string -- n'/f string literal )
|
||||||
over [
|
over [
|
||||||
skip-whitespace "\"!:[{(<>\s\r\n" slice-til-either {
|
skip-whitespace "\"\\!:[{(<>\s\r\n" slice-til-either
|
||||||
{ char: \" [ read-string ] }
|
! \foo foo\bar \foo{
|
||||||
{ char: \! [ read-exclamation ] }
|
dup char: \\ = [
|
||||||
{ char: \: [
|
drop
|
||||||
merge-slice-til-whitespace
|
! foo\ so far, could be foo\bar{
|
||||||
dup strict-upper? strict-upper get and [
|
! remove the \ and continue til delimiter/eof
|
||||||
length swap [ - ] dip f
|
[ "\"!:[{(<>\s\r\n" slice-til-either ] dip swap [ span-slices ] dip
|
||||||
strict-upper off
|
over "\\" head? [
|
||||||
] [
|
drop
|
||||||
read-colon
|
] [
|
||||||
] if
|
(lex-factor)
|
||||||
] }
|
] if
|
||||||
{ char: < [
|
] [
|
||||||
! FOO: a b <BAR: ;BAR>
|
(lex-factor)
|
||||||
! FOO: a b <BAR BAR>
|
] if
|
||||||
! FOO: a b <asdf>
|
|
||||||
! FOO: a b <asdf asdf>
|
|
||||||
|
|
||||||
! if we are in a FOO: and we hit a <BAR or <BAR:
|
|
||||||
! then end the FOO:
|
|
||||||
[ slice-til-whitespace drop ] dip span-slices
|
|
||||||
dup section-open? [
|
|
||||||
strict-upper get [
|
|
||||||
length swap [ - ] dip f strict-upper off
|
|
||||||
] [
|
|
||||||
read-acute
|
|
||||||
] if
|
|
||||||
] when
|
|
||||||
] }
|
|
||||||
{ char: > [
|
|
||||||
[ slice-til-whitespace drop ] dip span-slices
|
|
||||||
dup section-close? [
|
|
||||||
strict-upper get [
|
|
||||||
length swap [ - ] dip f strict-upper off
|
|
||||||
] when
|
|
||||||
] when
|
|
||||||
] }
|
|
||||||
{ char: \[ [ read-bracket ] }
|
|
||||||
{ char: \{ [ read-brace ] }
|
|
||||||
{ char: \( [ read-paren ] }
|
|
||||||
{ char: \s [ read-token-or-whitespace ] }
|
|
||||||
{ char: \r [ read-token-or-whitespace ] }
|
|
||||||
{ char: \n [ read-token-or-whitespace ] }
|
|
||||||
{ f [ f like ] }
|
|
||||||
} case dup "\\" tail? [ read-backslash ] when
|
|
||||||
] [
|
] [
|
||||||
f
|
f
|
||||||
] if ; inline
|
] if ; inline
|
||||||
|
|
Loading…
Reference in New Issue