modern: Fix all unit tests.
Removing whitespace from the parse tree. The invariant is that the underlying source slice cannot change and we will calculate the whitespace between tokens on replacement. We have to reparse after writing the file (or not, we can calculate the new parse without reading the file since we are writing it...)modern-harvey3
parent
5def4de6f3
commit
d2621d0da6
|
@ -10,14 +10,17 @@ TUPLE: ws string ;
|
||||||
CONSTRUCTOR: <ws> ws ( string -- ws )
|
CONSTRUCTOR: <ws> ws ( string -- ws )
|
||||||
dup string>> [ blank? not ] any? [ ws-expected ] when ;
|
dup string>> [ blank? not ] any? [ ws-expected ] when ;
|
||||||
|
|
||||||
|
: no-ws ( seq -- seq' )
|
||||||
|
[ ws? ] reject ;
|
||||||
|
|
||||||
M: ws nth string>> nth ;
|
M: ws nth string>> nth ;
|
||||||
M: ws nth-unsafe string>> nth-unsafe ;
|
M: ws nth-unsafe string>> nth-unsafe ;
|
||||||
M: ws length string>> length ;
|
M: ws length string>> length ;
|
||||||
|
|
||||||
! Weird experiment
|
! Weird experiment
|
||||||
M: ws pprint*
|
! M: ws pprint*
|
||||||
! drop ;
|
! drop ;
|
||||||
string>> dup "\"" "\"" pprint-string ;
|
! string>> dup "\"" "\"" pprint-string ;
|
||||||
|
|
||||||
TUPLE: lexed tokens ;
|
TUPLE: lexed tokens ;
|
||||||
|
|
||||||
|
@ -34,7 +37,10 @@ TUPLE: dbrace < lexed tag payload ;
|
||||||
CONSTRUCTOR: <dbrace> dbrace ( tag payload -- obj ) ;
|
CONSTRUCTOR: <dbrace> dbrace ( tag payload -- obj ) ;
|
||||||
|
|
||||||
TUPLE: lcolon < lexed tag payload ;
|
TUPLE: lcolon < lexed tag payload ;
|
||||||
CONSTRUCTOR: <lcolon> lcolon ( tag payload -- obj ) ;
|
: <lcolon> ( tag payload -- obj )
|
||||||
|
lcolon new
|
||||||
|
swap no-ws >>payload
|
||||||
|
swap >>tag ; inline
|
||||||
|
|
||||||
TUPLE: ucolon < lexed name effect body ;
|
TUPLE: ucolon < lexed name effect body ;
|
||||||
CONSTRUCTOR: <ucolon> ucolon ( name effect body -- obj ) ;
|
CONSTRUCTOR: <ucolon> ucolon ( name effect body -- obj ) ;
|
||||||
|
|
|
@ -137,7 +137,7 @@ IN: modern.tests
|
||||||
|
|
||||||
[ "char: \\" string>literals >strings ] must-fail ! char: \ should be legal eventually
|
[ "char: \\" string>literals >strings ] must-fail ! char: \ should be legal eventually
|
||||||
|
|
||||||
{ { { "\\" { "(" } } } } [ "\\ (" string>literals >strings ] unit-test
|
{ { { "\\" { "\\(" } } } } [ [[\ \(]] string>literals >strings ] unit-test
|
||||||
|
|
||||||
{ { "\\[[" } } [ "\\[[" string>literals >strings ] unit-test
|
{ { "\\[[" } } [ "\\[[" string>literals >strings ] unit-test
|
||||||
{ { "\\[=[" } } [ "\\[=[" string>literals >strings ] unit-test
|
{ { "\\[=[" } } [ "\\[=[" string>literals >strings ] unit-test
|
||||||
|
|
|
@ -49,7 +49,9 @@ DEFER: lex-factor
|
||||||
: lex-until ( string n tag-sequence -- string n' payload )
|
: lex-until ( string n tag-sequence -- string n' payload )
|
||||||
3dup '[
|
3dup '[
|
||||||
[
|
[
|
||||||
lex-factor-top dup f like [ , ] when* [
|
lex-factor-top f like ! <ws> possible
|
||||||
|
dup [ blank? ] all? [ dup , ] unless ! save unless blank
|
||||||
|
[
|
||||||
dup [
|
dup [
|
||||||
! } gets a chance, but then also full seq { } after recursion...
|
! } gets a chance, but then also full seq { } after recursion...
|
||||||
[ _ ] dip '[ _ sequence= ] any? not
|
[ _ ] dip '[ _ sequence= ] any? not
|
||||||
|
@ -68,7 +70,9 @@ DEFER: lex-factor-nested
|
||||||
: lex-colon-until ( string n tag-sequence -- string n' payload )
|
: lex-colon-until ( string n tag-sequence -- string n' payload )
|
||||||
'[
|
'[
|
||||||
[
|
[
|
||||||
lex-factor-nested dup f like [ , ] when* [
|
lex-factor-nested f like ! <ws> possible
|
||||||
|
dup [ blank? ] all? [ dup , ] unless ! save unless blank
|
||||||
|
[
|
||||||
dup [
|
dup [
|
||||||
! This is for ending COLON: forms like ``A: PRIVATE>``
|
! This is for ending COLON: forms like ``A: PRIVATE>``
|
||||||
dup section-close? [
|
dup section-close? [
|
||||||
|
@ -152,11 +156,10 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) )
|
||||||
dup [ char: \: = ] count-tail
|
dup [ char: \: = ] count-tail
|
||||||
'[
|
'[
|
||||||
_ [
|
_ [
|
||||||
slice-til-not-whitespace drop <ws> ! XXX: whitespace here
|
slice-til-not-whitespace drop <ws> drop ! XXX: whitespace here
|
||||||
[ dup [ f unexpected-eof ] unless ] dip
|
dup [ f unexpected-eof ] unless
|
||||||
[ lex-factor ] dip swap 2array
|
lex-factor
|
||||||
] replicate
|
] replicate ensure-tokens ! concat
|
||||||
ensure-tokens
|
|
||||||
] dip swap 2array ;
|
] dip swap 2array ;
|
||||||
|
|
||||||
: (strict-upper?) ( string -- ? )
|
: (strict-upper?) ( string -- ? )
|
||||||
|
@ -342,9 +345,8 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) )
|
||||||
'[
|
'[
|
||||||
_ [
|
_ [
|
||||||
slice-til-not-whitespace drop
|
slice-til-not-whitespace drop
|
||||||
[ <ws> ] [ "escaped string" unexpected-eof ] if*
|
[ <ws> drop ] [ "escaped string" unexpected-eof ] if*
|
||||||
[ lex-factor ] dip
|
lex-factor
|
||||||
swap 2array
|
|
||||||
] replicate
|
] replicate
|
||||||
ensure-tokens
|
ensure-tokens
|
||||||
] dip swap 2array
|
] dip swap 2array
|
||||||
|
@ -369,7 +371,7 @@ DEFER: lex-factor-top*
|
||||||
! Return it to the main loop as a ws form.
|
! Return it to the main loop as a ws form.
|
||||||
: read-token-or-whitespace ( string n slice -- string n' slice/f )
|
: read-token-or-whitespace ( string n slice -- string n' slice/f )
|
||||||
dup length 0 = [
|
dup length 0 = [
|
||||||
merge-slice-til-not-whitespace <ws>
|
merge-slice-til-not-whitespace ! <ws>
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
: lex-factor-fallthrough ( string n/f slice/f ch/f -- string n'/f literal )
|
: lex-factor-fallthrough ( string n/f slice/f ch/f -- string n'/f literal )
|
||||||
|
@ -466,14 +468,15 @@ DEFER: lex-factor-top*
|
||||||
[
|
[
|
||||||
! Compound syntax loop
|
! Compound syntax loop
|
||||||
[
|
[
|
||||||
lex-factor-top f like [ , ] when*
|
lex-factor-top f like
|
||||||
|
dup [ blank? ] all? [ drop ] [ , ] if ! save unless blank
|
||||||
! concatenated syntax ( a )[ a 1 + ]( b )
|
! concatenated syntax ( a )[ a 1 + ]( b )
|
||||||
check-compound-loop
|
check-compound-loop
|
||||||
] loop
|
] loop
|
||||||
] { } make
|
] { } make
|
||||||
check-for-compound-syntax
|
check-for-compound-syntax
|
||||||
! concat ! "ALIAS: n*quot (n*quot)" string>literals ... breaks here
|
! concat ! "ALIAS: n*quot (n*quot)" string>literals ... breaks here
|
||||||
?first f like ;
|
?first ;
|
||||||
|
|
||||||
: string>literals ( string -- sequence )
|
: string>literals ( string -- sequence )
|
||||||
[
|
[
|
||||||
|
|
Loading…
Reference in New Issue