modern: don't search for two ] ], just one. throw an error on unmatched tags.

locals-and-roots
Doug Coleman 2016-06-19 14:06:41 -07:00
parent c09fa97634
commit e9c388c649
1 changed files with 11 additions and 8 deletions

View File

@ -5,7 +5,7 @@ combinators.short-circuit constructors continuations fry
io.encodings.utf8 io.files kernel locals macros make math io.encodings.utf8 io.files kernel locals macros make math
math.order modern.paths modern.slices multiline namespaces math.order modern.paths modern.slices multiline namespaces
quotations sequences sequences.extras splitting modern.lexer quotations sequences sequences.extras splitting modern.lexer
splitting.monotonic strings unicode generalizations ; splitting.monotonic strings unicode generalizations shuffle ;
in: modern in: modern
COMPILE< COMPILE<
@ -243,22 +243,22 @@ defer: lex-factor
! lex-matched lexes til foo) foo} foo] ) } ] or TAG:, on TAG: throw error ! lex-matched lexes til foo) foo} foo] ) } ] or TAG:, on TAG: throw error
ERROR: lex-expected-but-got-eof n string quot ; ERROR: lex-expected-but-got-eof lexer tags ;
ERROR: unnestable-form n string obj ; ERROR: unnestable-form n string obj ;
! For implementing [ { ( ! For implementing [ { (
: lex-until ( lexer tags -- payload closing ) : lex-until ( lexer tags -- payload closing )
! 3 npick [ lex-expected-but-got-eof ] unless ! over lexer-found-eof? [ "more tokens expected" throw ] when
'[ 2dup '[
[ [
_ lex-factor [ _ lex-factor [
! [ _ _ _ lex-expected-but-got-eof ] unless*
dup tag-literal? [ dup tag-literal? [
dup , dup ,
underlying>> ! { [ dup scoped-upper? ] [ 4 npick 0 > ] } 0&& [ unnestable-form ] when underlying>> ! { [ dup scoped-upper? ] [ 4 npick 0 > ] } 0&& [ unnestable-form ] when
_ [ sequence= ] with any? not _ [ sequence= ] with any? not
] [ , t ] if ] [ , t ] if
] [ ] [
_ _ lex-expected-but-got-eof
f , f f , f
] if* ] if*
] loop ] loop
@ -274,7 +274,10 @@ MACRO:: read-matched ( ch -- quot: ( lexer tag -- slice' ) )
lexer tag lexer tag
over lexer-nth-check-eof { over lexer-nth-check-eof {
{ [ dup openstreq member? ] [ ch read-double-matched ] } ! (=( or (( { [ dup openstreq member? ] [ ch read-double-matched ] } ! (=( or ((
{ [ dup blank? ] [ drop dup '[ _ matching-delimiter-string closestr1 2array lex-until ] dip 1 cut-slice* single-matched-literal make-matched-literal ] } ! ( foo ) { [ dup blank? ] [
drop dup '[ _ matching-delimiter-string closestr1 2dup = [ drop 1array ] [ 2array ] if lex-until ] dip
1 cut-slice* single-matched-literal make-matched-literal
] } ! ( foo )
[ drop [ lex-til-whitespace drop 2nip ] dip span-slices make-tag-literal ] ! (foo) [ drop [ lex-til-whitespace drop 2nip ] dip span-slices make-tag-literal ] ! (foo)
} cond } cond
] ; ] ;