Throw error on failed parse, returning relevant error information
parent
37ade561a9
commit
00827d3b12
|
@ -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 )
|
||||||
|
|
Loading…
Reference in New Issue