modern: no postprocessing for concatenated tokens, instead...
take tokens until there is whitespace between them, then start a new group of tokensmodern-harvey2
parent
0e1eb52c4c
commit
3e77867cd2
|
@ -3,8 +3,9 @@
|
||||||
USING: accessors arrays assocs combinators
|
USING: accessors arrays assocs combinators
|
||||||
combinators.short-circuit continuations fry io.encodings.utf8
|
combinators.short-circuit continuations fry io.encodings.utf8
|
||||||
io.files kernel locals make math math.order modern.paths
|
io.files kernel locals make math math.order modern.paths
|
||||||
modern.slices namespaces sequences sequences.extras shuffle
|
modern.slices namespaces sequences sequences.deep
|
||||||
splitting strings unicode ;
|
sequences.extras shuffle splitting splitting.monotonic strings
|
||||||
|
unicode ;
|
||||||
IN: modern
|
IN: modern
|
||||||
|
|
||||||
ERROR: string-expected-got-eof n string ;
|
ERROR: string-expected-got-eof n string ;
|
||||||
|
@ -75,7 +76,7 @@ ERROR: lex-expected-but-got-eof n string expected ;
|
||||||
drop t ! loop again?
|
drop t ! loop again?
|
||||||
] if
|
] if
|
||||||
] [
|
] [
|
||||||
f ! need to error here if { } unmatched
|
f
|
||||||
] if*
|
] if*
|
||||||
] loop
|
] loop
|
||||||
] { } make ;
|
] { } make ;
|
||||||
|
@ -129,23 +130,6 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) )
|
||||||
[ slice-til-eol drop ] dip swap 2array
|
[ slice-til-eol drop ] dip swap 2array
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: read-til-semicolon ( n string slice -- n' string semi )
|
|
||||||
dup '[ but-last ";" append ";" 2array lex-colon-until ] dip
|
|
||||||
swap
|
|
||||||
! Remove the ; from the paylaod if present
|
|
||||||
dup ?last ";" tail? [
|
|
||||||
unclip-last 3array
|
|
||||||
] [
|
|
||||||
2array
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
: read-word-or-til-semicolon ( n string slice -- n' string obj )
|
|
||||||
2over next-char-from* "\s\r\n" member? [
|
|
||||||
read-til-semicolon
|
|
||||||
] [
|
|
||||||
merge-slice-til-whitespace
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
: terminator? ( slice -- ? )
|
: terminator? ( slice -- ? )
|
||||||
{
|
{
|
||||||
[ ";" sequence= ]
|
[ ";" sequence= ]
|
||||||
|
@ -191,6 +175,16 @@ ERROR: unexpected-terminator n string slice ;
|
||||||
[ ">" tail? ]
|
[ ">" tail? ]
|
||||||
} 1&& ;
|
} 1&& ;
|
||||||
|
|
||||||
|
: read-til-semicolon ( n string slice -- n' string semi )
|
||||||
|
dup '[ but-last ";" append ";" 2array lex-colon-until ] dip
|
||||||
|
swap
|
||||||
|
! Remove the ; from the paylaod if present
|
||||||
|
dup ?last ";" tail? [
|
||||||
|
unclip-last 3array
|
||||||
|
] [
|
||||||
|
2array
|
||||||
|
] if ;
|
||||||
|
|
||||||
ERROR: colon-word-must-be-all-uppercase-or-lowercase n string word ;
|
ERROR: colon-word-must-be-all-uppercase-or-lowercase n string word ;
|
||||||
: read-colon ( n string slice -- n' string colon )
|
: read-colon ( n string slice -- n' string colon )
|
||||||
{
|
{
|
||||||
|
@ -220,9 +214,7 @@ ERROR: no-backslash-payload n string slice ;
|
||||||
! 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!
|
||||||
: read-token-or-whitespace ( n string slice -- n' string slice/f )
|
: read-token-or-whitespace ( n string slice -- n' string slice/f )
|
||||||
dup length 0 = [
|
dup length 0 = [ [ 1 + ] 2dip ] when ;
|
||||||
[ 1 + ] 2dip drop lex-factor
|
|
||||||
] when ;
|
|
||||||
|
|
||||||
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 ) ;
|
||||||
|
@ -274,7 +266,7 @@ ERROR: mismatched-terminator n string slice ;
|
||||||
{ char: \s [ read-token-or-whitespace ] }
|
{ char: \s [ read-token-or-whitespace ] }
|
||||||
{ char: \r [ read-token-or-whitespace ] }
|
{ char: \r [ read-token-or-whitespace ] }
|
||||||
{ char: \n [ read-token-or-whitespace ] }
|
{ char: \n [ read-token-or-whitespace ] }
|
||||||
{ f [ f like ] }
|
{ f [ ] }
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
: lex-factor ( n/f string -- n'/f string literal )
|
: lex-factor ( n/f string -- n'/f string literal )
|
||||||
|
@ -302,7 +294,19 @@ ERROR: mismatched-terminator n string slice ;
|
||||||
] if ; inline
|
] if ; inline
|
||||||
|
|
||||||
: string>literals ( string -- sequence )
|
: string>literals ( string -- sequence )
|
||||||
[ 0 ] dip [ [ lex-factor f like ] loop>array f like ] loop>array 2nip ;
|
[ 0 ] dip [
|
||||||
|
[
|
||||||
|
[
|
||||||
|
[
|
||||||
|
lex-factor f like [ , ] when*
|
||||||
|
! concatenated syntax ( a )[ a 1 + ]( b )
|
||||||
|
[ ]
|
||||||
|
[ peek-from blank? ]
|
||||||
|
[ previous-from blank? or not ] 2tri pick and
|
||||||
|
] loop
|
||||||
|
] { } make f like [ , ] when* over
|
||||||
|
] loop
|
||||||
|
] { } make 2nip ;
|
||||||
|
|
||||||
: vocab>literals ( vocab -- sequence )
|
: vocab>literals ( vocab -- sequence )
|
||||||
".private" ?tail drop
|
".private" ?tail drop
|
||||||
|
|
|
@ -33,6 +33,9 @@ ERROR: unexpected-end n string ;
|
||||||
: peek-from ( n/f string -- ch )
|
: peek-from ( n/f string -- ch )
|
||||||
over [ ?nth ] [ 2drop f ] if ;
|
over [ ?nth ] [ 2drop f ] if ;
|
||||||
|
|
||||||
|
: previous-from ( n/f string -- ch )
|
||||||
|
over [ [ 1 - ] dip ?nth ] [ 2drop f ] if ;
|
||||||
|
|
||||||
! Allow eof
|
! Allow eof
|
||||||
: next-char-from ( n/f string -- n'/f string ch/f )
|
: next-char-from ( n/f string -- n'/f string ch/f )
|
||||||
over [
|
over [
|
||||||
|
|
Loading…
Reference in New Issue