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

modern: working on parser. 

! not sure what these all do.
\ foo
\\ foo foo
\ \abc{
\ abc{ }
\\ abc{ } def{ }
modern-harvey3
Doug Coleman 2019-10-17 01:14:36 -05:00
parent 4ef0a41d05
commit 5def4de6f3
2 changed files with 13 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
extra/modern/lexer/lexer.factor
View File

@ -15,9 +15,9 @@ 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 ;

19
extra/modern/modern.factor
View File

@ -329,14 +329,21 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) )
dup { [ "!" sequence= ] [ "#!" sequence= ] } 1|| dup { [ "!" sequence= ] [ "#!" sequence= ] } 1||
[ take-comment ] [ merge-slice-til-whitespace ] if ; [ take-comment ] [ merge-slice-til-whitespace ] if ;
! \ foo ! push the word, don't call it
! \\ foo bar ! push two words
! \ ! error, expects another token
! \\ ! error, expects two tokens
! \ \abc{ ! push the abc{ word
! \ abc{ } ! push the ``abc{ }`` form for running later
: (read-backslash) ( string n slice -- string n' obj ) : (read-backslash) ( string n slice -- string n' obj )
merge-slice-til-whitespace dup "\\" tail? [ merge-slice-til-whitespace dup "\\" tail? [
! \ foo, M\ foo ! \ foo, M\ foo
dup [ char: \\ = ] count-tail dup [ char: \\ = ] count-tail
'[ '[
_ [ _ [
slice-til-not-whitespace drop <ws> slice-til-not-whitespace drop
[ slice-til-whitespace drop ] dip [ <ws> ] [ "escaped string" unexpected-eof ] if*
[ lex-factor ] dip
swap 2array swap 2array
] replicate ] replicate
ensure-tokens ensure-tokens
@ -419,9 +426,7 @@ DEFER: lex-factor-top*
} case ; } case ;
: lex-factor-nested ( n/f string -- n'/f string literal ) : lex-factor-nested ( n/f string -- n'/f string literal )
! skip-whitespace "\"\\!:[{(]})<>\s\r\n" slice-til-either lex-factor-nested* ; inline
"\"\\!:[{(]})<>\s\r\n" slice-til-either
lex-factor-nested* ; inline
: lex-factor-top* ( n/f string slice/f ch/f -- n'/f string literal ) : lex-factor-top* ( n/f string slice/f ch/f -- n'/f string literal )
{ {
@ -447,9 +452,7 @@ DEFER: lex-factor-top*
} case ; } case ;
: lex-factor-top ( string/f n/f -- string/f n'/f literal ) : lex-factor-top ( string/f n/f -- string/f n'/f literal )
! skip-whitespace "\"\\!:[{(]})<>\s\r\n" slice-til-either lex-factor-top* ; inline
"\"\\!:[{(]})<>\s\r\n" slice-til-either
lex-factor-top* ; inline
: check-for-compound-syntax ( seq n/f obj -- seq n/f obj ) : check-for-compound-syntax ( seq n/f obj -- seq n/f obj )
dup length 1 > [ compound-syntax-disallowed ] when ; dup length 1 > [ compound-syntax-disallowed ] when ;