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

Refactor repeat0 and repeat1 peg parsers

db4
Chris Double 2008-04-05 18:01:18 +13:00
parent 226d211342
commit d4897fa007
1 changed files with 15 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
extra/peg/peg.factor
View File

@ -351,48 +351,36 @@ M: choice-parser (compile) ( parser -- quot )
TUPLE: repeat0-parser p1 ;
MATCH-VARS: ?quot ;
: (repeat0) ( quot result -- result )
: (repeat) ( quot result -- result )
over call [
[ remaining>> swap (>>remaining) ] 2keep
ast>> swap [ ast>> push ] keep
(repeat0)
] [
(repeat)
] [
nip
] if* ; inline
: repeat0-pattern ( -- quot )
[
[ ?quot ] swap (repeat0)
] ;
M: repeat0-parser (compile) ( parser -- quot )
[
[ input-slice V{ } clone <parse-result> ] %
p1>> compiled-parser \ ?quot repeat0-pattern match-replace %
] [ ] make ;
p1>> compiled-parser 1quotation '[
input-slice V{ } clone <parse-result> , swap (repeat)
] ;
TUPLE: repeat1-parser p1 ;
: repeat1-pattern ( -- quot )
: repeat1-empty-check ( result -- result )
[
[ ?quot ] swap (repeat0) [
dup ast>> empty? [
drop f
] when
] [
f
] if*
] ;
dup ast>> empty? [ drop f ] when
] [
f
] if* ;
M: repeat1-parser (compile) ( parser -- quot )
[
[ input-slice V{ } clone <parse-result> ] %
p1>> compiled-parser \ ?quot repeat1-pattern match-replace %
] [ ] make ;
p1>> compiled-parser 1quotation '[
input-slice V{ } clone <parse-result> , swap (repeat) repeat1-empty-check
] ;
TUPLE: optional-parser p1 ;
MATCH-VARS: ?quot ;
: optional-pattern ( -- quot )
[