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

View File

@ -83,3 +83,10 @@ IN: modern.out.tests
{ t } [ "abc>[ ]" rewrite-same-string ] unit-test { t } [ "abc>[ ]" rewrite-same-string ] unit-test
{ t } [ "CC>n" rewrite-same-string ] unit-test { t } [ "CC>n" rewrite-same-string ] unit-test
{ t } [ "CC>CC" 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 n' string ?<slice>
n' dup search length + 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' ) : modify-from ( slice n -- slice' )
'[ from>> _ + ] [ to>> ] [ seq>> ] tri <slice> ; '[ from>> _ + ] [ to>> ] [ seq>> ] tri <slice> ;