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

peg: add 'got' slot to parse-error, so you get a little more info about why the parsing fails

db4
Björn Lindqvist 2014-10-21 16:27:33 +02:00 committed by Doug Coleman
parent 84663ca054
commit 3ed3e10074
4 changed files with 55 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/peg/debugger/debugger-tests.factor Normal file
View File

@ -0,0 +1,7 @@
USING: arrays continuations debugger io.streams.string peg tools.test ;
IN: peg.debugger.tests
{ "Peg parsing error at character position 0.\nExpected 'A' or 'B'\nGot 'xxxx'\n" } [
[ "xxxx" "A" token "B" token 2array choice parse ] [ ] recover
[ error. ] with-string-writer
] unit-test

13
basis/peg/debugger/debugger.factor
View File

@ -1,12 +1,13 @@
USING: io kernel accessors math.parser sequences prettyprint
USING: formatting io kernel accessors math.parser sequences prettyprint
debugger peg ;
IN: peg.debugger
M: parse-error error.
"Peg parsing error at character position " write dup position>> number>string write
"." print "Expected " write messages>> [ " or " write ] [ write ] interleave nl ;
[ position>> ] [ messages>> " or " join ] [ got>> ] tri
"Peg parsing error at character position %d.\nExpected %s\nGot '%s'\n"
printf ;
M: parse-failed error.
"The " write dup word>> pprint " word could not parse the following input:" print nl
input>> . ;
"The " write dup word>> pprint " word could not parse the following input:" print nl
input>> . ;

14
basis/peg/peg-tests.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
!
USING: kernel tools.test strings namespaces make arrays sequences
peg peg.private peg.parsers words math accessors ;
USING: continuations kernel tools.test strings namespaces make arrays
sequences peg peg.private peg.parsers words math accessors ;
IN: peg.tests
[ ] [ reset-pegs ] unit-test
@ -206,3 +206,13 @@ USE: compiler
[ ] [ enable-optimizer ] unit-test
[ [ ] ] [ "" epsilon [ drop [ [ ] ] call ] action parse ] unit-test
{
T{ parse-error
{ position 0 }
{ got "fbcd" }
{ messages V{ "'a'" "'b'" } }
}
} [
[ "fbcd" "a" token "b" token 2array choice parse ] [ ] recover
] unit-test

14
basis/peg/peg.factor
View File

@ -9,7 +9,7 @@ FROM: namespaces => set ;
IN: peg
TUPLE: parse-result remaining ast ;
TUPLE: parse-error position messages ;
TUPLE: parse-error position got messages ;
TUPLE: parser peg compiled id ;
M: parser equal? { [ [ class-of ] same? ] [ [ id>> ] same? ] } 2&& ;
@ -20,6 +20,10 @@ C: <parse-error> parse-error
SYMBOL: error-stack
: merge-overlapping-errors ( a b -- c )
dupd [ messages>> ] bi@ union [ [ position>> ] [ got>> ] bi ] dip
<parse-error> ;
: (merge-errors) ( a b -- c )
{
{ [ over position>> not ] [ nip ] }
@ -28,7 +32,7 @@ SYMBOL: error-stack
2dup [ position>> ] compare {
{ +lt+ [ nip ] }
{ +gt+ [ drop ] }
{ +eq+ [ messages>> over messages>> union [ position>> ] dip <parse-error> ] }
{ +eq+ [ merge-overlapping-errors ] }
} case
]
} cond ;
@ -40,7 +44,7 @@ SYMBOL: error-stack
drop
] if ;
: add-error ( remaining message -- )
: add-error ( position got message -- )
<parse-error> error-stack get push ;
SYMBOL: ignore
@ -333,9 +337,9 @@ TUPLE: token-parser symbol ;
: parse-token ( input string -- result )
#! Parse the string, returning a parse result
[ ?head-slice ] keep swap [
<parse-result> f f add-error
<parse-result> f f f add-error
] [
[ drop pos get "token '" ] dip append "'" append 1vector add-error f
[ seq>> pos get swap ] dip "'" "'" surround 1vector add-error f
] if ;
M: token-parser (compile) ( peg -- quot )