add repeat0 and repeat1

release
Chris Double 2007-11-21 15:01:44 +13:00
parent 2d3fe08403
commit 691c62501f
2 changed files with 61 additions and 3 deletions

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
USING: kernel tools.test strings namespaces arrays peg ; USING: kernel tools.test strings namespaces arrays sequences peg ;
IN: temporary IN: temporary
{ 0 1 2 } [ { 0 1 2 } [
@ -69,3 +69,27 @@ IN: temporary
{ f } [ { f } [
"" 0 <parse-state> "a" token "b" token 2array choice parse "" 0 <parse-state> "a" token "b" token 2array choice parse
] unit-test ] unit-test
{ 0 } [
"" 0 <parse-state> "a" token repeat0 parse parse-result-ast length
] unit-test
{ 0 } [
"b" 0 <parse-state> "a" token repeat0 parse parse-result-ast length
] unit-test
{ "aaa" } [
"aaab" 0 <parse-state> "a" token repeat0 parse parse-result-matched
] unit-test
{ f } [
"" 0 <parse-state> "a" token repeat1 parse
] unit-test
{ f } [
"b" 0 <parse-state> "a" token repeat1 parse
] unit-test
{ "aaa" } [
"aaab" 0 <parse-state> "a" token repeat1 parse parse-result-matched
] unit-test

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 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 combinators.lib ; USING: kernel sequences strings namespaces math assocs shuffle combinators.lib ;
IN: peg IN: peg
TUPLE: parse-state input cache ; TUPLE: parse-state input cache ;
@ -108,3 +108,37 @@ M: choice-parser parse ( state parser -- result )
: choice ( seq -- parser ) : choice ( seq -- parser )
choice-parser construct-boa init-parser ; choice-parser construct-boa init-parser ;
TUPLE: repeat0-parser p1 ;
: (repeat-parser) ( parser result -- result )
2dup parse-result-remaining swap parse [
[ parse-result-remaining swap set-parse-result-remaining ] 2keep
[ parse-result-ast swap parse-result-ast push ] 2keep
parse-result-matched swap [ parse-result-matched swap append ] keep [ set-parse-result-matched ] keep
(repeat-parser)
] [
nip
] if* ;
: clone-result ( result -- result )
{ parse-result-remaining parse-result-matched parse-result-ast }
get-slots V{ } clone-like <parse-result> ;
M: repeat0-parser parse ( state parser -- result )
repeat0-parser-p1 2dup parse [
nipd clone-result (repeat-parser)
] [
drop "" V{ } clone <parse-result>
] if* ;
: repeat0 ( parser -- parser )
repeat0-parser construct-boa init-parser ;
TUPLE: repeat1-parser p1 ;
M: repeat1-parser parse ( state parser -- result )
repeat1-parser-p1 tuck parse dup [ clone-result (repeat-parser) ] [ nip ] if ;
: repeat1 ( parser -- parser )
repeat1-parser construct-boa init-parser ;