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

peg fixes

db4
Chris Double 2008-07-08 16:56:12 +12:00
parent d92c19f694
commit ec896eeba8
3 changed files with 9 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/peg/parsers/parsers.factor
View File

@ -20,7 +20,7 @@ M: just-parser (compile) ( parser -- quot )
just-parser-p1 compiled-parser just-pattern curry ; just-parser-p1 compiled-parser just-pattern curry ;
: just ( parser -- parser ) : just ( parser -- parser )
just-parser boa init-parser ; just-parser boa wrap-peg ;
: 1token ( ch -- parser ) 1string token ; : 1token ( ch -- parser ) 1string token ;

2
extra/peg/peg-tests.factor
View File

@ -181,7 +181,7 @@ IN: peg.tests
{ t } [ { t } [
#! Ensure a circular parser doesn't loop infinitely #! Ensure a circular parser doesn't loop infinitely
[ f , "a" token , ] seq* [ f , "a" token , ] seq*
dup parsers>> dup peg>> parsers>>
dupd 0 swap set-nth compile word? dupd 0 swap set-nth compile word?
] unit-test ] unit-test

11
extra/peg/peg.factor
View File

@ -245,12 +245,15 @@ C: <head> peg-head
GENERIC: (compile) ( peg -- quot ) GENERIC: (compile) ( peg -- quot )
: execute-parser ( word -- result ) : process-parser-result ( result -- result )
pos get apply-rule dup failed? [ dup failed? [
drop f drop f
] [ ] [
input-slice swap <parse-result> input-slice swap <parse-result>
] if ; inline ] if ;
: execute-parser ( word -- result )
pos get apply-rule process-parser-result ; inline
: parser-body ( parser -- quot ) : parser-body ( parser -- quot )
#! Return the body of the word that is the compiled version #! Return the body of the word that is the compiled version
@ -323,7 +326,7 @@ TUPLE: token-parser symbol ;
dup >r ?head-slice [ dup >r ?head-slice [
r> <parse-result> f f add-error r> <parse-result> f f add-error
] [ ] [
drop input-slice input-from "token '" r> append "'" append 1vector add-error f drop pos get "token '" r> append "'" append 1vector add-error f
] if ; ] if ;
M: token-parser (compile) ( peg -- quot ) M: token-parser (compile) ( peg -- quot )