diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor index d95233b899..8c496a2b95 100644 --- a/extra/peg/peg-tests.factor +++ b/extra/peg/peg-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Chris Double. ! 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 { 0 1 2 } [ @@ -68,4 +68,28 @@ IN: temporary { f } [ "" 0 "a" token "b" token 2array choice parse -] unit-test \ No newline at end of file +] unit-test + +{ 0 } [ + "" 0 "a" token repeat0 parse parse-result-ast length +] unit-test + +{ 0 } [ + "b" 0 "a" token repeat0 parse parse-result-ast length +] unit-test + +{ "aaa" } [ + "aaab" 0 "a" token repeat0 parse parse-result-matched +] unit-test + +{ f } [ + "" 0 "a" token repeat1 parse +] unit-test + +{ f } [ + "b" 0 "a" token repeat1 parse +] unit-test + +{ "aaa" } [ + "aaab" 0 "a" token repeat1 parse parse-result-matched +] unit-test diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 7965424ddd..9bda5a358b 100644 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007 Chris Double. ! 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 TUPLE: parse-state input cache ; @@ -108,3 +108,37 @@ M: choice-parser parse ( state parser -- result ) : choice ( seq -- 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 ; + +M: repeat0-parser parse ( state parser -- result ) + repeat0-parser-p1 2dup parse [ + nipd clone-result (repeat-parser) + ] [ + drop "" V{ } clone + ] 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 ;