Throw error on failed parse, returning relevant error information

db4
Chris Double 2008-06-25 13:14:15 +12:00
parent 37ade561a9
commit 00827d3b12
1 changed files with 20 additions and 8 deletions

View File

@ -9,19 +9,30 @@ IN: peg
USE: prettyprint USE: prettyprint
TUPLE: parse-result remaining ast ; TUPLE: parse-result remaining ast ;
TUPLE: parse-error details ;
TUPLE: error-details remaining message ;
TUPLE: parser id compiled ; TUPLE: parser id compiled ;
M: parser equal? [ id>> ] bi@ = ; M: parser equal? [ id>> ] bi@ = ;
M: parser hashcode* id>> hashcode* ; M: parser hashcode* id>> hashcode* ;
C: <parse-result> parse-result
C: <error-details> error-details
C: <parser> parser C: <parser> parser
SYMBOL: ignore SYMBOL: errors
: <parse-result> ( remaining ast -- parse-result ) : <parse-error> ( -- parse-error )
parse-result boa ; V{ } clone parse-error boa ;
: add-error ( remaining message -- )
errors get [
[ <error-details> ] [ details>> ] bi* push
] [
2drop
] if* ;
SYMBOL: ignore
SYMBOL: packrat SYMBOL: packrat
SYMBOL: pos SYMBOL: pos
@ -207,6 +218,7 @@ C: <head> peg-head
input set input set
0 pos set 0 pos set
f lrstack set f lrstack set
<parse-error> errors set
H{ } clone heads set H{ } clone heads set
H{ } clone packrat set H{ } clone packrat set
] H{ } make-assoc swap bind ; inline ] H{ } make-assoc swap bind ; inline
@ -257,7 +269,7 @@ SYMBOL: delayed
] with-compilation-unit ; ] with-compilation-unit ;
: compiled-parse ( state word -- result ) : compiled-parse ( state word -- result )
swap [ execute ] with-packrat ; inline swap [ execute [ errors get throw ] unless* ] with-packrat ; inline
: parse ( input parser -- result ) : parse ( input parser -- result )
dup word? [ compile ] unless compiled-parse ; dup word? [ compile ] unless compiled-parse ;
@ -288,7 +300,7 @@ TUPLE: token-parser symbol ;
dup >r ?head-slice [ dup >r ?head-slice [
r> <parse-result> r> <parse-result>
] [ ] [
r> 2drop f drop input-slice "Expected token '" r> append "'" append add-error f
] if ; ] if ;
M: token-parser (compile) ( parser -- quot ) M: token-parser (compile) ( parser -- quot )