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

Refactor token peg parser

db4
Chris Double 2008-04-05 17:25:04 +13:00
parent 8b16816bf8
commit 80d11405a9
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
extra/peg/peg.factor
View File

@ -3,7 +3,7 @@
USING: kernel sequences strings fry namespaces math assocs shuffle USING: kernel sequences strings fry namespaces math assocs shuffle
vectors arrays combinators.lib math.parser match vectors arrays combinators.lib math.parser match
unicode.categories sequences.lib compiler.units parser unicode.categories sequences.lib compiler.units parser
words quotations effects memoize accessors locals effects ; words quotations effects memoize accessors locals effects splitting ;
IN: peg IN: peg
USE: prettyprint USE: prettyprint
@ -269,19 +269,17 @@ MATCH-VARS: ?token ;
: parse-token ( input string -- result ) : parse-token ( input string -- result )
#! Parse the string, returning a parse result #! Parse the string, returning a parse result
2dup head? [ dup >r ?head-slice [
dup >r length tail-slice r> <parse-result> r> <parse-result>
] [ ] [
2drop f r> 2drop f
] if ; ] if ;
M: token-parser (compile) ( parser -- quot ) M: token-parser (compile) ( parser -- quot )
[ \ input-slice , symbol>> , \ parse-token , ] [ ] make ; symbol>> '[ input-slice , parse-token ] ;
TUPLE: satisfy-parser quot ; TUPLE: satisfy-parser quot ;
MATCH-VARS: ?quot ;
: parse-satisfy ( input quot -- result ) : parse-satisfy ( input quot -- result )
swap dup empty? [ swap dup empty? [
2drop f 2drop f
@ -320,6 +318,8 @@ M: range-parser (compile) ( parser -- quot )
TUPLE: seq-parser parsers ; TUPLE: seq-parser parsers ;
MATCH-VARS: ?quot ;
: seq-pattern ( -- quot ) : seq-pattern ( -- quot )
[ [
dup [ dup [