modern: add support for backticks.

tag`payload
tag``payload``
tag```payload```
locals-and-roots
Doug Coleman 2016-06-23 21:12:51 -07:00
parent 25bde7941f
commit 2069b47183
4 changed files with 52 additions and 9 deletions

View File

@ -170,3 +170,18 @@ ERROR: subseq-expected-but-got-eof n string expected ;
: skip-blanks ( lexer -- lexer )
dup >lexer< skip-blank-from drop >>n ; inline
ERROR: char-expected-but-got-eof n string expected ;
:: slice-til-not-char ( n string slice char -- n' string found )
n string [ char = not ] find-from drop :> n'
n' [ n string char char-expected-but-got-eof ] unless
n'
string
slice from>> n' string ?<slice> ;
:: lex-til-not-char ( lexer slice char -- n'/f string' found )
lexer >lexer< slice char slice-til-not-char :> ( n' string' found )
lexer
n' >>n drop
n' string' found ;

View File

@ -5,8 +5,8 @@ combinators.short-circuit constructors continuations fry
generalizations io.encodings.utf8 io.files kernel locals macros
make math math.order modern.lexer modern.paths modern.slices
namespaces quotations sequences sequences.extras
shuffle splitting splitting.extras splitting.monotonic strings
unicode vocabs.loader ;
sequences.private shuffle splitting splitting.extras
splitting.monotonic strings unicode vocabs.loader ;
IN: modern
COMPILE<
@ -42,8 +42,8 @@ TUPLE: uppercase-colon-literal < single-matched-literal ;
TUPLE: lowercase-colon-literal < delimited-literal ;
! TUPLE: standalone-colon-literal < delimited-literal ; ! :foo
TUPLE: backtick-literal < delimited-literal ;
TUPLE: backslash-literal < delimited-literal ;
TUPLE: semicolon-literal < delimited-literal ;
TUPLE: matched-backtick-literal < double-matched-literal ;
TUPLE: backslash-literal < single-matched-literal ;
TUPLE: line-comment-literal < delimited-literal ;
TUPLE: terminator-literal < tag-literal ;
TUPLE: whitespace-literal < tag-literal ;
@ -419,13 +419,24 @@ ERROR: closing-tag-required lexer tag ;
dup { [ "!" sequence= ] [ "#!" sequence= ] } 1||
[ take-comment ] [ >>partial [ 1 + ] change-n lex-factor ] if ;
: count-head ( seq quot -- n )
(trim-head) [ length ] dip - ; inline
: read-backtick ( lexer opening -- obj )
[
lex-til-whitespace drop 2nip
dup
] dip 1 cut-slice* backtick-literal make-delimited-literal ;
: count-tail ( seq quot -- n )
(trim-tail) [ length ] dip - ; inline
:: read-backtick ( lexer slice -- obj )
lexer slice char: \` lex-til-not-char 2nip :> tag-opening
tag-opening [ char: \` = ] count-tail :> count
tag-opening count cut-slice* :> ( tag opening )
count 1 > [
lexer opening lex-til-string :> ( n' string' payload closing )
payload closing tag opening matched-backtick-literal make-matched-literal
[ >string ] change-payload
] [
lexer lex-til-whitespace drop 2nip
dup slice 1 cut-slice* backtick-literal make-delimited-literal
] if ;
ERROR: backslash-expects-whitespace slice ;
: read-backslash ( lexer slice -- obj )

View File

@ -83,3 +83,10 @@ IN: modern.out.tests
{ t } [ "abc>[ ]" rewrite-same-string ] unit-test
{ t } [ "CC>n" rewrite-same-string ] unit-test
{ t } [ "CC>CC" rewrite-same-string ] unit-test
{ t } [ "`omg" rewrite-same-string ] unit-test
{ t } [ "``omg``" rewrite-same-string ] unit-test
{ t } [ "```omg```" rewrite-same-string ] unit-test
{ t } [ "lol`omg" rewrite-same-string ] unit-test
{ t } [ "lol``omg``" rewrite-same-string ] unit-test
{ t } [ "lol```omg```" rewrite-same-string ] unit-test

View File

@ -182,6 +182,16 @@ ERROR: subseq-expected-but-got-eof n string expected ;
n n' string ?<slice>
n' dup search length + string ?<slice> ;
ERROR: char-expected-but-got-eof n string expected ;
:: slice-til-not-char ( n string slice char -- n' string found )
n string [ char = not ] find-from drop :> n'
n' [ n string char char-expected-but-got-eof ] unless
B
n'
string
slice from>> n' string ?<slice> ;
: modify-from ( slice n -- slice' )
'[ from>> _ + ] [ to>> ] [ seq>> ] tri <slice> ;