steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

modern: more fixes for PRIVATE< PRIVATE> etc.

locals-and-roots
Doug Coleman 2016-06-20 13:40:01 -07:00
parent 28ed878543
commit 42d6d59993
2 changed files with 13 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
core/modern/modern-tests.factor
View File

@ -104,3 +104,7 @@ in: modern.tests
{ 1 } [ "postpone\\ main:" string>literals length ] unit-test { 1 } [ "postpone\\ main:" string>literals length ] unit-test
{ 1 } [ "char: \\!" string>literals length ] unit-test { 1 } [ "char: \\!" string>literals length ] unit-test
{ 1 } [ "HI< OMG: BYE< BYE> HI>" string>literals length ] unit-test
{ 1 } [ "HI< OMG: ; BYE< BYE> HI>" string>literals length ] unit-test

13
core/modern/modern.factor
View File

@ -204,6 +204,7 @@ ERROR: string-expected-got-eof n string ;
delimiter >string >>delimiter delimiter >string >>delimiter
tag delimiter payload 3array >>seq ; inline tag delimiter payload 3array >>seq ; inline
ERROR: closing-delimiter-required opening-delimiter ;
:: make-matched-literal ( payload closing tag opening-delimiter class -- literal ) :: make-matched-literal ( payload closing tag opening-delimiter class -- literal )
class new class new
tag >string >>tag tag >string >>tag
@ -213,6 +214,11 @@ ERROR: string-expected-got-eof n string ;
dup single-matched-literal? [ dup single-matched-literal? [
closing dup [ tag>> ] when >>closing-tag closing dup [ tag>> ] when >>closing-tag
] when ] when
! PRIVATE< PRIVATE>
dup less-than-literal? [
closing dup [ tag>> ] when >>closing-tag
closing f = [ opening-delimiter closing-delimiter-required ] when
] when
tag opening-delimiter payload closing 4array >>seq ; inline tag opening-delimiter payload closing 4array >>seq ; inline
:: make-decorator-literal ( payload delimiter class -- literal ) :: make-decorator-literal ( payload delimiter class -- literal )
@ -367,13 +373,12 @@ ERROR: cannot-nest-upper-colon n string string' ;
ERROR: closing-tag-required lexer tag ; ERROR: closing-tag-required lexer tag ;
:: read-upper-less-than ( lexer slice -- less-than/f ) :: read-upper-less-than ( lexer slice -- less-than/f )
lexer peek-tag top-level-less-than? [ lexer peek-tag top-level-colon? [
lexer slice roll-back-lexer f lexer slice roll-back-lexer f
] [ ] [
lexer slice [ lexer slice [
lexer slice scoped-less-than-name lexer slice scoped-less-than-name but-last ">" append 1array lex-until
[ but-last ">" append 1array ] [ ">" 1array ] if* lex-until ! dup [ lexer slice >string closing-tag-required ] unless
dup [ lexer slice >string closing-tag-required ] unless
slice 1 cut-slice* less-than-literal make-matched-literal slice 1 cut-slice* less-than-literal make-matched-literal
] with-tag ] with-tag
] if ; ] if ;