Refactor satisfy peg parser
parent
a6b160c447
commit
8b16816bf8
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2007, 2008 Chris Double.
|
! Copyright (C) 2007, 2008 Chris Double.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel sequences strings 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 ;
|
||||||
|
@ -282,21 +282,20 @@ TUPLE: satisfy-parser quot ;
|
||||||
|
|
||||||
MATCH-VARS: ?quot ;
|
MATCH-VARS: ?quot ;
|
||||||
|
|
||||||
: satisfy-pattern ( -- quot )
|
: parse-satisfy ( input quot -- result )
|
||||||
[
|
swap dup empty? [
|
||||||
input-slice dup empty? [
|
2drop f
|
||||||
drop f
|
|
||||||
] [
|
] [
|
||||||
unclip-slice dup ?quot call [
|
unclip-slice rot dupd call [
|
||||||
<parse-result>
|
<parse-result>
|
||||||
] [
|
] [
|
||||||
2drop f
|
2drop f
|
||||||
] if
|
] if
|
||||||
] if
|
] if ; inline
|
||||||
] ;
|
|
||||||
|
|
||||||
M: satisfy-parser (compile) ( parser -- quot )
|
M: satisfy-parser (compile) ( parser -- quot )
|
||||||
quot>> \ ?quot satisfy-pattern match-replace ;
|
quot>> '[ input-slice , parse-satisfy ] ;
|
||||||
|
|
||||||
TUPLE: range-parser min max ;
|
TUPLE: range-parser min max ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue