From 691c62501f71ae4163ccda89751b27a4ba720f6d Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 21 Nov 2007 15:01:44 +1300
Subject: [PATCH] add repeat0 and repeat1

---
 extra/peg/peg-tests.factor | 28 ++++++++++++++++++++++++++--
 extra/peg/peg.factor       | 36 +++++++++++++++++++++++++++++++++++-
 2 files changed, 61 insertions(+), 3 deletions(-)

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 <parse-state> "a" token "b" token 2array choice parse 
-] unit-test
\ No newline at end of file
+] 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
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 <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 ;