From aacf88a72d67a47edc6b5cde8e139dcf4c124d64 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Tue, 20 Nov 2007 16:36:38 +1300
Subject: [PATCH 01/18] First cut at peg style packrat parser

---
 extra/peg/peg-docs.factor  | 11 +++++
 extra/peg/peg-tests.factor | 55 +++++++++++++++++++++++
 extra/peg/peg.factor       | 92 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 158 insertions(+)
 create mode 100644 extra/peg/peg-docs.factor
 create mode 100644 extra/peg/peg-tests.factor
 create mode 100644 extra/peg/peg.factor

diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor
new file mode 100644
index 0000000000..ec4a5d304d
--- /dev/null
+++ b/extra/peg/peg-docs.factor
@@ -0,0 +1,11 @@
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax peg ;
+
+HELP: token
+{ $values 
+  { "string" "a string" } }
+{ $description 
+    "A parser generator that returns a parser that matches the given string." }
+{ $example "\"begin foo end\" \"begin\" token parse" "result-here" } ;
+
diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor
new file mode 100644
index 0000000000..20e4206357
--- /dev/null
+++ b/extra/peg/peg-tests.factor
@@ -0,0 +1,55 @@
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+!
+USING: kernel tools.test strings namespaces arrays peg ;
+IN: temporary
+
+{ 0 1 2 } [
+  0 next-id set-global get-next-id get-next-id get-next-id 
+] unit-test
+
+{ "0123456789" } [
+  "0123456789" 0 <parse-state> 0 state-tail parse-state-input >string
+] unit-test
+
+{ "56789" } [
+  "0123456789" 5 <parse-state> 0 state-tail parse-state-input >string
+] unit-test
+
+{ "789" } [
+  "0123456789" 5 <parse-state> 2 state-tail parse-state-input >string
+] unit-test
+
+{ f } [
+  "endbegin" 0 <parse-state> "begin" token parse
+] unit-test
+
+{ "begin" "begin" "end" } [
+  "beginend" 0 <parse-state> "begin" token parse 
+  { parse-result-matched parse-result-ast parse-result-remaining } get-slots
+  parse-state-input >string
+] unit-test
+
+{ f } [
+  "" 0 <parse-state> CHAR: a CHAR: z range parse
+] unit-test
+
+{ f } [
+  "1bcd" 0 <parse-state> CHAR: a CHAR: z range parse
+] unit-test
+
+{ CHAR: a } [
+  "abcd" 0 <parse-state> CHAR: a CHAR: z range parse parse-result-ast
+] unit-test
+
+{ CHAR: z } [
+  "zbcd" 0 <parse-state> CHAR: a CHAR: z range parse parse-result-ast
+] unit-test
+
+{ f } [
+  "bad" 0 <parse-state> "a" token "b" token 2array seq parse
+] unit-test
+
+{ "go" } [
+  "good" 0 <parse-state> "g" token "o" token 2array seq parse parse-result-matched
+] unit-test
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
new file mode 100644
index 0000000000..f5c3f4ab3e
--- /dev/null
+++ b/extra/peg/peg.factor
@@ -0,0 +1,92 @@
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences strings namespaces math assocs combinators.lib ;
+IN: peg
+
+TUPLE: parse-state input cache ;
+
+: <parse-state> ( input index -- state )
+  tail-slice { set-parse-state-input } parse-state construct ;
+
+: get-cached ( pid state -- result )
+  tuck parse-state-cache at [
+    swap parse-state-input slice-from swap nth     
+  ] [ 
+    drop f
+  ] if* ;
+
+: state-tail ( state n -- state )
+  dupd [ parse-state-cache ] dipd
+  [ parse-state-input ] dip tail-slice 
+  { set-parse-state-cache set-parse-state-input } parse-state construct ; 
+
+TUPLE: parse-result remaining matched ast ;
+
+: <parse-result> ( remaining matched ast -- parse-result )
+  parse-result construct-boa ;
+
+SYMBOL: next-id 
+
+: get-next-id ( -- number )
+  next-id get-global 0 or dup 1+ next-id set-global ;
+
+TUPLE: parser id ;
+
+: init-parser ( parser -- parser )
+  get-next-id parser construct-boa over set-delegate ;
+
+GENERIC: parse ( state parser -- result )
+
+TUPLE: token-parser symbol ;
+
+M: token-parser parse ( state parser -- result )
+  token-parser-symbol 2dup >r parse-state-input r> head? [
+    dup >r length state-tail r>  dup <parse-result>
+  ] [
+    2drop f
+  ] if ;
+
+: token ( string -- parser )
+  token-parser construct-boa init-parser ;      
+
+TUPLE: range-parser min max ;
+
+M: range-parser parse ( state parser -- result )
+  over parse-state-input empty? [
+    2drop f
+  ] [
+    0 pick parse-state-input nth dup rot 
+    { range-parser-min range-parser-max } get-slots between? [
+      [ 1 state-tail ] dip dup <parse-result>
+    ] [
+      2drop f
+    ] if
+  ] if ;
+
+: range ( min max -- parser )
+  range-parser construct-boa init-parser ;
+
+TUPLE: seq-parser parsers ;
+
+: do-seq-parser ( result parser -- result )
+  [ dup parse-result-remaining ] dip 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
+  
+  ] [
+    drop f
+  ] if* ;
+
+: (seq-parser) ( result parsers -- result )
+  dup empty? not pick and [
+    unclip swap [ do-seq-parser ] dip (seq-parser)
+  ] [
+    drop   
+  ] if ;
+
+M: seq-parser parse ( state parser -- result )
+  seq-parser-parsers [ "" V{ } clone <parse-result> ] dip  (seq-parser) ;
+
+: seq ( seq -- parser )
+  seq-parser construct-boa init-parser ;

From 2d3fe08403e807febf7c62c6547d90bc2aec0926 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Tue, 20 Nov 2007 17:58:11 +1300
Subject: [PATCH 02/18] Add choice parser

---
 extra/peg/peg-tests.factor | 16 ++++++++++++++++
 extra/peg/peg.factor       | 22 ++++++++++++++++++++--
 2 files changed, 36 insertions(+), 2 deletions(-)

diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor
index 20e4206357..d95233b899 100644
--- a/extra/peg/peg-tests.factor
+++ b/extra/peg/peg-tests.factor
@@ -53,3 +53,19 @@ IN: temporary
 { "go" } [
   "good" 0 <parse-state> "g" token "o" token 2array seq parse parse-result-matched
 ] unit-test
+
+{ "a" } [
+  "abcd" 0 <parse-state> "a" token "b" token 2array choice parse parse-result-matched
+] unit-test
+
+{ "b" } [
+  "bbcd" 0 <parse-state> "a" token "b" token 2array choice parse parse-result-matched
+] unit-test
+
+{ f } [
+  "cbcd" 0 <parse-state> "a" token "b" token 2array choice parse 
+] unit-test
+
+{ f } [
+  "" 0 <parse-state> "a" token "b" token 2array choice parse 
+] unit-test
\ No newline at end of file
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index f5c3f4ab3e..7965424ddd 100644
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -72,8 +72,7 @@ TUPLE: seq-parser parsers ;
   [ dup parse-result-remaining ] dip 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
-  
+    parse-result-matched swap [ parse-result-matched swap append ] keep [ set-parse-result-matched ] keep  
   ] [
     drop f
   ] if* ;
@@ -90,3 +89,22 @@ M: seq-parser parse ( state parser -- result )
 
 : seq ( seq -- parser )
   seq-parser construct-boa init-parser ;
+
+TUPLE: choice-parser parsers ;
+  
+: (choice-parser) ( state parsers -- result )
+  dup empty? [
+    2drop f
+  ] [
+    unclip pick swap parse [
+      2nip 
+    ] [
+      (choice-parser)
+    ] if* 
+  ] if ;
+
+M: choice-parser parse ( state parser -- result )
+  choice-parser-parsers (choice-parser) ;
+
+: choice ( seq -- parser )
+  choice-parser construct-boa init-parser ;

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 03/18] 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 ;

From e9df13dad58a7a6cc25eaab61a15b80850849f81 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 21 Nov 2007 15:31:23 +1300
Subject: [PATCH 04/18] remove match from parse results

---
 extra/peg/peg-tests.factor | 20 ++++++++++----------
 extra/peg/peg.factor       | 24 +++++++++++-------------
 2 files changed, 21 insertions(+), 23 deletions(-)

diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor
index 8c496a2b95..82d993af3c 100644
--- a/extra/peg/peg-tests.factor
+++ b/extra/peg/peg-tests.factor
@@ -24,9 +24,9 @@ IN: temporary
   "endbegin" 0 <parse-state> "begin" token parse
 ] unit-test
 
-{ "begin" "begin" "end" } [
+{ "begin" "end" } [
   "beginend" 0 <parse-state> "begin" token parse 
-  { parse-result-matched parse-result-ast parse-result-remaining } get-slots
+  { parse-result-ast parse-result-remaining } get-slots
   parse-state-input >string
 ] unit-test
 
@@ -50,16 +50,16 @@ IN: temporary
   "bad" 0 <parse-state> "a" token "b" token 2array seq parse
 ] unit-test
 
-{ "go" } [
-  "good" 0 <parse-state> "g" token "o" token 2array seq parse parse-result-matched
+{ V{ "g" "o" } } [
+  "good" 0 <parse-state> "g" token "o" token 2array seq parse parse-result-ast
 ] unit-test
 
 { "a" } [
-  "abcd" 0 <parse-state> "a" token "b" token 2array choice parse parse-result-matched
+  "abcd" 0 <parse-state> "a" token "b" token 2array choice parse parse-result-ast
 ] unit-test
 
 { "b" } [
-  "bbcd" 0 <parse-state> "a" token "b" token 2array choice parse parse-result-matched
+  "bbcd" 0 <parse-state> "a" token "b" token 2array choice parse parse-result-ast
 ] unit-test
 
 { f } [
@@ -78,8 +78,8 @@ IN: temporary
   "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 
+{ V{ "a" "a" "a" } } [
+  "aaab" 0 <parse-state> "a" token repeat0 parse parse-result-ast 
 ] unit-test
 
 { f } [
@@ -90,6 +90,6 @@ IN: temporary
   "b" 0 <parse-state> "a" token repeat1 parse 
 ] unit-test
 
-{ "aaa" } [
-  "aaab" 0 <parse-state> "a" token repeat1 parse parse-result-matched 
+{ V{ "a" "a" "a" } } [
+  "aaab" 0 <parse-state> "a" token repeat1 parse parse-result-ast
 ] unit-test
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index 9bda5a358b..4a43c1b965 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 shuffle combinators.lib ;
+USING: kernel sequences strings namespaces math assocs shuffle vectors combinators.lib ;
 IN: peg
 
 TUPLE: parse-state input cache ;
@@ -20,9 +20,9 @@ TUPLE: parse-state input cache ;
   [ parse-state-input ] dip tail-slice 
   { set-parse-state-cache set-parse-state-input } parse-state construct ; 
 
-TUPLE: parse-result remaining matched ast ;
+TUPLE: parse-result remaining ast ;
 
-: <parse-result> ( remaining matched ast -- parse-result )
+: <parse-result> ( remaining ast -- parse-result )
   parse-result construct-boa ;
 
 SYMBOL: next-id 
@@ -41,7 +41,7 @@ TUPLE: token-parser symbol ;
 
 M: token-parser parse ( state parser -- result )
   token-parser-symbol 2dup >r parse-state-input r> head? [
-    dup >r length state-tail r>  dup <parse-result>
+    dup >r length state-tail r>  <parse-result>
   ] [
     2drop f
   ] if ;
@@ -57,7 +57,7 @@ M: range-parser parse ( state parser -- result )
   ] [
     0 pick parse-state-input nth dup rot 
     { range-parser-min range-parser-max } get-slots between? [
-      [ 1 state-tail ] dip dup <parse-result>
+      [ 1 state-tail ] dip <parse-result>
     ] [
       2drop f
     ] if
@@ -71,8 +71,7 @@ TUPLE: seq-parser parsers ;
 : do-seq-parser ( result parser -- result )
   [ dup parse-result-remaining ] dip 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  
+    parse-result-ast swap [ parse-result-ast push ] keep
   ] [
     drop f
   ] if* ;
@@ -85,7 +84,7 @@ TUPLE: seq-parser parsers ;
   ] if ;
 
 M: seq-parser parse ( state parser -- result )
-  seq-parser-parsers [ "" V{ } clone <parse-result> ] dip  (seq-parser) ;
+  seq-parser-parsers [ V{ } clone <parse-result> ] dip  (seq-parser) ;
 
 : seq ( seq -- parser )
   seq-parser construct-boa init-parser ;
@@ -114,22 +113,21 @@ 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 
+    parse-result-ast swap [ parse-result-ast push ] 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> ;
+  { parse-result-remaining parse-result-ast }
+  get-slots 1vector  <parse-result> ;
 
 M: repeat0-parser parse ( state parser -- result )
      repeat0-parser-p1 2dup parse [ 
        nipd clone-result (repeat-parser) 
      ] [ 
-       drop "" V{ } clone <parse-result> 
+       drop V{ } clone <parse-result> 
      ] if* ;
 
 : repeat0 ( parser -- parser )

From ffa71ef86f608e4a3f22dd3d146260a55727d13d Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 21 Nov 2007 15:50:47 +1300
Subject: [PATCH 05/18] add optional parser

---
 extra/peg/peg-tests.factor | 12 ++++++++++++
 extra/peg/peg.factor       | 10 +++++++++-
 2 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor
index 82d993af3c..b10fcb8e55 100644
--- a/extra/peg/peg-tests.factor
+++ b/extra/peg/peg-tests.factor
@@ -93,3 +93,15 @@ IN: temporary
 { V{ "a" "a" "a" } } [
   "aaab" 0 <parse-state> "a" token repeat1 parse parse-result-ast
 ] unit-test
+
+{ V{ "a" "b" } } [ 
+  "ab" 0 <parse-state> "a" token optional "b" token 2array seq parse parse-result-ast 
+] unit-test
+
+{ V{ f "b" } } [ 
+  "b" 0 <parse-state> "a" token optional "b" token 2array seq parse parse-result-ast 
+] unit-test
+
+{ f } [ 
+  "cb" 0 <parse-state> "a" token optional "b" token 2array seq parse  
+] unit-test
\ No newline at end of file
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index 4a43c1b965..e2f0cfd1b2 100644
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -136,7 +136,15 @@ M: repeat0-parser parse ( state parser -- result )
 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-p1 tuck parse dup [ clone-result (repeat-parser) ] [ nip ] if ;
 
 : repeat1 ( parser -- parser )
   repeat1-parser construct-boa init-parser ;
+
+TUPLE: optional-parser p1 ;
+
+M: optional-parser parse ( state parser -- result )
+   dupd optional-parser-p1 parse swap f <parse-result> or ;
+
+: optional ( parser -- parser )
+  optional-parser construct-boa init-parser ;

From 129f68d428f548bb20f28272718aa77074704510 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 21 Nov 2007 16:06:02 +1300
Subject: [PATCH 06/18] add ensure parser

---
 extra/peg/peg-tests.factor |  8 ++++++++
 extra/peg/peg.factor       | 16 +++++++++++++++-
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor
index b10fcb8e55..b7977285c4 100644
--- a/extra/peg/peg-tests.factor
+++ b/extra/peg/peg-tests.factor
@@ -104,4 +104,12 @@ IN: temporary
 
 { f } [ 
   "cb" 0 <parse-state> "a" token optional "b" token 2array seq parse  
+] unit-test
+
+{ V{ CHAR: a CHAR: b } } [
+  "ab" 0 <parse-state> "a" token ensure CHAR: a CHAR: z range dup 3array seq parse parse-result-ast
+] unit-test
+
+{ f } [
+  "bb" 0 <parse-state> "a" token ensure CHAR: a CHAR: z range 2array seq parse 
 ] unit-test
\ No newline at end of file
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index e2f0cfd1b2..239af02d26 100644
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -3,6 +3,8 @@
 USING: kernel sequences strings namespaces math assocs shuffle vectors combinators.lib ;
 IN: peg
 
+SYMBOL: ignore 
+
 TUPLE: parse-state input cache ;
 
 : <parse-state> ( input index -- state )
@@ -71,7 +73,7 @@ TUPLE: seq-parser parsers ;
 : do-seq-parser ( result parser -- result )
   [ dup parse-result-remaining ] dip parse [
     [ parse-result-remaining swap set-parse-result-remaining ] 2keep  
-    parse-result-ast swap [ parse-result-ast push ] keep
+    parse-result-ast dup ignore = [ drop ] [ swap [ parse-result-ast push ] keep ] if
   ] [
     drop f
   ] if* ;
@@ -148,3 +150,15 @@ M: optional-parser parse ( state parser -- result )
 
 : optional ( parser -- parser )
   optional-parser construct-boa init-parser ;
+
+TUPLE: ensure-parser p1 ;
+
+M: ensure-parser parse ( state parser -- result )
+   dupd ensure-parser-p1 parse [
+     ignore <parse-result>  
+   ] [
+     drop f
+   ] if ;
+
+: ensure ( parser -- parser )
+  ensure-parser construct-boa init-parser ;

From 2a464ea2c65bb14782066b00789b63567a77c308 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 21 Nov 2007 16:11:49 +1300
Subject: [PATCH 07/18] add ensure-not parser

---
 extra/peg/peg-tests.factor | 24 ++++++++++++++++++++++++
 extra/peg/peg.factor       | 12 ++++++++++++
 2 files changed, 36 insertions(+)

diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor
index b7977285c4..94f70d32ad 100644
--- a/extra/peg/peg-tests.factor
+++ b/extra/peg/peg-tests.factor
@@ -112,4 +112,28 @@ IN: temporary
 
 { f } [
   "bb" 0 <parse-state> "a" token ensure CHAR: a CHAR: z range 2array seq parse 
+] unit-test
+
+{ t } [
+  "a+b" 0 <parse-state>
+  "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
+  parse [ t ] [ f ] if
+] unit-test
+
+{ t } [
+  "a++b" 0 <parse-state>
+  "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
+  parse [ t ] [ f ] if
+] unit-test
+
+{ t } [
+  "a+b" 0 <parse-state>
+  "a" token "+" token "++" token 2array choice "b" token 3array seq
+  parse [ t ] [ f ] if
+] unit-test
+
+{ f } [
+  "a++b" 0 <parse-state>
+  "a" token "+" token "++" token 2array choice "b" token 3array seq
+  parse [ t ] [ f ] if
 ] unit-test
\ No newline at end of file
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index 239af02d26..82c4505ae7 100644
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -162,3 +162,15 @@ M: ensure-parser parse ( state parser -- result )
 
 : ensure ( parser -- parser )
   ensure-parser construct-boa init-parser ;
+
+TUPLE: ensure-not-parser p1 ;
+
+M: ensure-not-parser parse ( state parser -- result )
+   dupd ensure-not-parser-p1 parse [
+     drop f
+   ] [
+     ignore <parse-result>  
+   ] if ;
+
+: ensure-not ( parser -- parser )
+  ensure-not-parser construct-boa init-parser ;

From 167f2d716d323bff0a1c82ab8e5a1de6f9360306 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 21 Nov 2007 16:21:23 +1300
Subject: [PATCH 08/18] add action parser

---
 extra/peg/peg-tests.factor | 12 ++++++++++++
 extra/peg/peg.factor       | 13 +++++++++++++
 2 files changed, 25 insertions(+)

diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor
index 94f70d32ad..a60d1eaaf0 100644
--- a/extra/peg/peg-tests.factor
+++ b/extra/peg/peg-tests.factor
@@ -136,4 +136,16 @@ IN: temporary
   "a++b" 0 <parse-state>
   "a" token "+" token "++" token 2array choice "b" token 3array seq
   parse [ t ] [ f ] if
+] unit-test
+
+{ 1 } [
+  "a" 0 <parse-state> "a" token [ drop 1 ] action parse parse-result-ast 
+] unit-test
+
+{ V{ 1 1 } } [
+  "aa" 0 <parse-state> "a" token [ drop 1 ] action dup 2array seq parse parse-result-ast 
+] unit-test
+
+{ f } [
+  "b" 0 <parse-state> "a" token [ drop 1 ] action parse 
 ] unit-test
\ No newline at end of file
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index 82c4505ae7..2c985b68dc 100644
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -174,3 +174,16 @@ M: ensure-not-parser parse ( state parser -- result )
 
 : ensure-not ( parser -- parser )
   ensure-not-parser construct-boa init-parser ;
+
+TUPLE: action-parser p1 quot ;
+
+M: action-parser parse ( state parser -- result )
+   tuck action-parser-p1 parse dup [ 
+     dup parse-result-ast rot action-parser-quot call
+     swap [ set-parse-result-ast ] keep
+   ] [
+     nip
+   ] if ;
+
+: action ( parser quot -- parser )
+  action-parser construct-boa init-parser ;

From efde1afc2fcbb8420a9c99755afa79acd0c7f6b9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 25 Nov 2007 04:33:46 -0500
Subject: [PATCH 09/18] Improve no-edit-hook error, make it restartable

---
 extra/editors/editors.factor                | 29 ++++++++++++++++-----
 extra/ui/tools/operations/operations.factor |  2 ++
 2 files changed, 24 insertions(+), 7 deletions(-)

diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor
index 930a39dfdf..7d95c8ce8a 100644
--- a/extra/editors/editors.factor
+++ b/extra/editors/editors.factor
@@ -1,21 +1,36 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: parser kernel namespaces sequences definitions io.files
-inspector continuations tuples tools.crossref io prettyprint
-source-files ;
+inspector continuations tuples tools.crossref tools.browser 
+io prettyprint source-files assocs vocabs vocabs.loader ;
 IN: editors
 
 TUPLE: no-edit-hook ;
 
-M: no-edit-hook summary drop "No edit hook is set" ;
+M: no-edit-hook summary
+    drop "You must load one of the below vocabularies before using editor integration:" ;
 
 SYMBOL: edit-hook
 
+: available-editors ( -- seq )
+    "editors" all-child-vocabs
+    values concat [ vocab-name ] map ;
+
+: editor-restarts ( -- alist )
+    available-editors
+    [ "Load " over append swap ] { } map>assoc ;
+
+: no-edit-hook ( -- )
+    \ no-edit-hook construct-empty
+    editor-restarts throw-restarts
+    require ;
+
 : edit-location ( file line -- )
-    >r ?resource-path r>
-    edit-hook get dup [
-        \ no-edit-hook construct-empty throw
-    ] if ;
+    edit-hook get [
+        >r >r ?resource-path r> r> call
+    ] [
+        no-edit-hook edit-location
+    ] if* ;
 
 : edit ( defspec -- )
     where [ first2 edit-location ] when* ;
diff --git a/extra/ui/tools/operations/operations.factor b/extra/ui/tools/operations/operations.factor
index d2d7685f45..b7a59f5c28 100755
--- a/extra/ui/tools/operations/operations.factor
+++ b/extra/ui/tools/operations/operations.factor
@@ -64,6 +64,7 @@ V{ } clone operations set-global
     { +keyboard+ T{ key-down f { C+ } "E" } }
     { +primary+ t }
     { +secondary+ t }
+    { +listener+ t }
 } define-operation
 
 UNION: definition word method-spec link ;
@@ -72,6 +73,7 @@ UNION: editable-definition definition vocab vocab-link ;
 
 [ editable-definition? ] \ edit H{
     { +keyboard+ T{ key-down f { C+ } "E" } }
+    { +listener+ t }
 } define-operation
 
 UNION: reloadable-definition definition pathname ;

From 75d9329f066401d50572c81b59a780efdaab0ff2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 25 Nov 2007 04:35:16 -0500
Subject: [PATCH 10/18] 'watch' now respects effect-in/effect-out

---
 extra/tools/annotations/annotations.factor | 22 +++++++++++++++++-----
 1 file changed, 17 insertions(+), 5 deletions(-)

diff --git a/extra/tools/annotations/annotations.factor b/extra/tools/annotations/annotations.factor
index d24d60cef6..e97f292416 100644
--- a/extra/tools/annotations/annotations.factor
+++ b/extra/tools/annotations/annotations.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel words parser io inspector quotations sequences
-prettyprint continuations ;
+prettyprint continuations effects ;
 IN: tools.annotations
 
 : annotate ( word quot -- )
@@ -9,17 +9,29 @@ IN: tools.annotations
     swap define-compound do-parse-hook ;
     inline
 
-: entering ( str -- ) "! Entering: " write print .s flush ;
+: entering ( str -- )
+    "/-- Entering: " write dup .
+    stack-effect [
+        >r datastack r> effect-in length tail* stack.
+    ] [
+        .s
+    ] if* "\\--" print flush ;
 
-: leaving ( str -- ) "! Leaving: " write print .s flush ;
+: leaving ( str -- )
+    "/-- Leaving: " write dup .
+    stack-effect [
+        >r datastack r> effect-out length tail* stack.
+    ] [
+        .s
+    ] if* "\\--" print flush ;
 
-: (watch) ( str def -- def )
+: (watch) ( word def -- def )
     over [ entering ] curry
     rot [ leaving ] curry
     swapd 3append ;
 
 : watch ( word -- )
-    dup word-name swap [ (watch) ] annotate ;
+    dup [ (watch) ] annotate ;
 
 : breakpoint ( word -- )
     [ \ break add* ] annotate ;

From 286e261fb65cd418e3176e72e6bee609ee6ee46f Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <wayo.cavazos@gmail.com>
Date: Sun, 25 Nov 2007 13:37:05 -0600
Subject: [PATCH 11/18] Update factor.el

---
 misc/factor.el | 35 +++++++++++++++++++++++------------
 1 file changed, 23 insertions(+), 12 deletions(-)

diff --git a/misc/factor.el b/misc/factor.el
index 88af0a6dab..985e10e285 100644
--- a/misc/factor.el
+++ b/misc/factor.el
@@ -113,13 +113,6 @@
 (defvar factor-binary "/scratch/repos/Factor/factor")
 (defvar factor-image "/scratch/repos/Factor/factor.image")
 
-(defun run-factor ()
-  (interactive)
-  (switch-to-buffer
-   (make-comint-in-buffer "factor" nil factor-binary nil
-			  (concat "-i=" factor-image)
-			  "-run=listener")))
-
 (defun factor-telnet-to-port (port)
   (interactive "nPort: ")
   (switch-to-buffer
@@ -166,12 +159,30 @@
   (beginning-of-line)
   (insert "! "))
 
-(defun factor-refresh-all ()
-  (interactive)
-  (comint-send-string "*factor*" "refresh-all\n"))
-
 (define-key factor-mode-map "\C-c\C-f" 'factor-run-file)
 (define-key factor-mode-map "\C-c\C-r" 'factor-send-region)
 (define-key factor-mode-map "\C-c\C-s" 'factor-see)
-(define-key factor-mode-map "\C-ce" 'factor-edit)
+(define-key factor-mode-map "\C-ce"    'factor-edit)
 (define-key factor-mode-map "\C-c\C-h" 'factor-help)
+(define-key factor-mode-map "\C-cc"    'comment-region)
+(define-key factor-mode-map [return]   'newline-and-indent)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; factor-listener-mode
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-derived-mode factor-listener-mode comint-mode "Factor Listener")
+
+(define-key factor-listener-mode-map [f8] 'factor-refresh-all)
+
+(defun run-factor ()
+  (interactive)
+  (switch-to-buffer
+   (make-comint-in-buffer "factor" nil factor-binary nil
+			  (concat "-i=" factor-image)
+			  "-run=listener"))
+  (factor-listener-mode))
+
+(defun factor-refresh-all ()
+  (interactive)
+  (comint-send-string "*factor*" "refresh-all\n"))
\ No newline at end of file

From e167a6b9d54a6ca3ca310415468cd32554676453 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <wayo.cavazos@gmail.com>
Date: Sun, 25 Nov 2007 13:37:27 -0600
Subject: [PATCH 12/18] raptor updates

---
 extra/raptor/config.factor   | 5 ++++-
 extra/raptor/cronjobs.factor | 2 --
 extra/raptor/raptor.factor   | 6 ++++++
 3 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/extra/raptor/config.factor b/extra/raptor/config.factor
index ecdbf98f17..29e26d4381 100644
--- a/extra/raptor/config.factor
+++ b/extra/raptor/config.factor
@@ -44,7 +44,10 @@ IN: raptor
   ! rcS.d
 
   "mountvirtfs"                     start-service
-  "hostname.sh"			    start-service
+
+  ! "hostname.sh"			    start-service
+  "narodnik"                        set-hostname
+
   "keymap.sh"			    start-service
   "linux-restricted-modules-common" start-service
   "udev"                            start-service
diff --git a/extra/raptor/cronjobs.factor b/extra/raptor/cronjobs.factor
index 894e8e5ce7..91263a31d9 100644
--- a/extra/raptor/cronjobs.factor
+++ b/extra/raptor/cronjobs.factor
@@ -6,8 +6,6 @@ IN: raptor
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: fork-exec-args-wait ( args -- ) [ first ] [ ] bi fork-exec-wait ;
-
 : run-script ( path -- ) 1array [ fork-exec-args-wait ] curry in-thread ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor
index e6f960cd8d..ef5359c313 100644
--- a/extra/raptor/raptor.factor
+++ b/extra/raptor/raptor.factor
@@ -22,6 +22,8 @@ SYMBOL: networking-hook
 : fork-exec-wait ( pathname args -- )
   fork dup 0 = [ drop exec drop ] [ 2nip wait-for-pid drop ] if ;
 
+: fork-exec-args-wait ( args -- ) [ first ] [ ] bi fork-exec-wait ;
+
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : forever ( quot -- ) [ call ] [ forever ] bi ;
@@ -59,6 +61,10 @@ SYMBOL: swap-devices
 
 : start-networking ( -- ) networking-hook  get call ;
 
+: set-hostname ( name -- ) `{ "/bin/hostname" , } fork-exec-args-wait ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 : boot     ( -- ) boot-hook     get call ;
 : reboot   ( -- ) reboot-hook   get call ;
 : shutdown ( -- ) shutdown-hook get call ;

From 12599e03c4a195810d908c7d483e34068c186ad2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 25 Nov 2007 17:07:32 -0500
Subject: [PATCH 13/18] Clean up parser combinators

---
 .../parser-combinators.factor                 | 304 +++++++++---------
 1 file changed, 153 insertions(+), 151 deletions(-)

diff --git a/extra/parser-combinators/parser-combinators.factor b/extra/parser-combinators/parser-combinators.factor
index 199f0cb136..d6c44659a5 100755
--- a/extra/parser-combinators/parser-combinators.factor
+++ b/extra/parser-combinators/parser-combinators.factor
@@ -1,22 +1,23 @@
 ! Copyright (C) 2004 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: lazy-lists promises kernel sequences strings math io
-arrays namespaces splitting ;
+USING: lazy-lists promises kernel sequences strings math
+arrays splitting ;
 IN: parser-combinators
 
 ! Parser combinator protocol
-GENERIC: (parse) ( input parser -- list )
+GENERIC: parse ( input parser -- list )
 
-M: promise (parse) ( input parser -- list )
-  force (parse) ;
-
-: parse ( input parser -- promise )
-  (parse) ;
+M: promise parse ( input parser -- list )
+    force parse ;
 
 TUPLE: parse-result parsed unparsed ;
 
 : parse-1 ( input parser -- result )
-  parse car parse-result-parsed ;
+    parse dup nil? [
+        "Parse error" throw
+    ] [
+        car parse-result-parsed
+    ] if ;
 
 C: <parse-result> parse-result
 
@@ -24,105 +25,106 @@ TUPLE: token-parser string ;
 
 C: token token-parser ( string -- parser )
 
-M: token-parser (parse) ( input parser -- list )
-  token-parser-string swap over ?head-slice [
-    <parse-result> 1list
-  ] [
-    2drop nil
-  ] if ;
+M: token-parser parse ( input parser -- list )
+    token-parser-string swap over ?head-slice [
+        <parse-result> 1list
+    ] [
+        2drop nil
+    ] if ;
 
 TUPLE: satisfy-parser quot ;
 
 C: satisfy satisfy-parser ( quot -- parser )
 
-M: satisfy-parser (parse) ( input parser -- list )
-  #! A parser that succeeds if the predicate,
-  #! when passed the first character in the input, returns
-  #! true.
-  over empty? [
-    2drop nil
-  ] [
-    satisfy-parser-quot >r unclip-slice dup r> call [
-      swap <parse-result> 1list
+M: satisfy-parser parse ( input parser -- list )
+    #! A parser that succeeds if the predicate,
+    #! when passed the first character in the input, returns
+    #! true.
+    over empty? [
+        2drop nil
     ] [
-      2drop nil
-    ] if
-  ] if ;
+        satisfy-parser-quot >r unclip-slice dup r> call [
+            swap <parse-result> 1list
+        ] [
+            2drop nil
+        ] if
+    ] if ;
 
 LAZY: any-char-parser ( -- parser )
-  [ drop t ] satisfy ;
+    [ drop t ] satisfy ;
 
 TUPLE: epsilon-parser ;
 
 C: epsilon epsilon-parser ( -- parser )
 
-M: epsilon-parser (parse) ( input parser -- list )
-  #! A parser that parses the empty string. It
-  #! does not consume any input and always returns
-  #! an empty list as the parse tree with the
-  #! unmodified input.
-  drop "" swap <parse-result> 1list ;
+M: epsilon-parser parse ( input parser -- list )
+    #! A parser that parses the empty string. It
+    #! does not consume any input and always returns
+    #! an empty list as the parse tree with the
+    #! unmodified input.
+    drop "" swap <parse-result> 1list ;
 
 TUPLE: succeed-parser result ;
 
 C: succeed succeed-parser ( result -- parser )
 
-M: succeed-parser (parse) ( input parser -- list )
-  #! A parser that always returns 'result' as a
-  #! successful parse with no input consumed.
-  succeed-parser-result swap <parse-result> 1list ;
+M: succeed-parser parse ( input parser -- list )
+    #! A parser that always returns 'result' as a
+    #! successful parse with no input consumed.
+    succeed-parser-result swap <parse-result> 1list ;
 
 TUPLE: fail-parser ;
 
 C: fail fail-parser ( -- parser )
 
-M: fail-parser (parse) ( input parser -- list )
-  #! A parser that always fails and returns
-  #! an empty list of successes.
-  2drop nil ;
+M: fail-parser parse ( input parser -- list )
+    #! A parser that always fails and returns
+    #! an empty list of successes.
+    2drop nil ;
 
 TUPLE: and-parser parsers ;
 
 : <&> ( parser1 parser2 -- parser )
-  over and-parser? [
-    >r and-parser-parsers r> add
-  ] [
-    2array
-  ] if \ and-parser construct-boa ;
+    over and-parser? [
+        >r and-parser-parsers r> add
+    ] [
+        2array
+    ] if and-parser construct-boa ;
 
 : and-parser-parse ( list p1  -- list )
-  swap [
-    dup parse-result-unparsed rot parse
-    [
-      >r parse-result-parsed r>
-      [ parse-result-parsed 2array ] keep
-      parse-result-unparsed <parse-result>
-    ] lmap-with
-  ] lmap-with lconcat ;
+    swap [
+        dup parse-result-unparsed rot parse
+        [
+            >r parse-result-parsed r>
+            [ parse-result-parsed 2array ] keep
+            parse-result-unparsed <parse-result>
+        ] lmap-with
+    ] lmap-with lconcat ;
 
-M: and-parser (parse) ( input parser -- list )
-  #! Parse 'input' by sequentially combining the
-  #! two parsers. First parser1 is applied to the
-  #! input then parser2 is applied to the rest of
-  #! the input strings from the first parser.
-  and-parser-parsers unclip swapd parse [ [ and-parser-parse ] reduce ] 2curry promise ;
+M: and-parser parse ( input parser -- list )
+    #! Parse 'input' by sequentially combining the
+    #! two parsers. First parser1 is applied to the
+    #! input then parser2 is applied to the rest of
+    #! the input strings from the first parser.
+    and-parser-parsers unclip swapd parse
+    [ [ and-parser-parse ] reduce ] 2curry promise ;
 
 TUPLE: or-parser p1 p2 ;
 
 C: <|> or-parser ( parser1 parser2 -- parser )
 
-M: or-parser (parse) ( input parser1 -- list )
-  #! Return the combined list resulting from the parses
-  #! of parser1 and parser2 being applied to the same
-  #! input. This implements the choice parsing operator.
-  [ or-parser-p1 ] keep or-parser-p2 >r dupd parse swap r> parse lappend ;
+M: or-parser parse ( input parser1 -- list )
+    #! Return the combined list resulting from the parses
+    #! of parser1 and parser2 being applied to the same
+    #! input. This implements the choice parsing operator.
+    [ or-parser-p1 ] keep or-parser-p2 >r dupd parse swap r> parse lappend ;
 
 : left-trim-slice ( string -- string )
-  #! Return a new string without any leading whitespace
-  #! from the original string.
-  dup empty? [
-    dup first blank? [ 1 tail-slice left-trim-slice ] when
-  ] unless ;
+    #! Return a new string without any leading whitespace
+    #! from the original string.
+    dup empty? [
+        dup first blank? [ 1 tail-slice left-trim-slice ] when
+    ] unless ;
 
 TUPLE: sp-parser p1 ;
 
@@ -130,115 +132,115 @@ TUPLE: sp-parser p1 ;
 #! calling the original parser.
 C: sp sp-parser ( p1 -- parser )
 
-M: sp-parser (parse) ( input parser -- list )
-  #! Skip all leading whitespace from the input then call
-  #! the parser on the remaining input.
-  >r left-trim-slice r> sp-parser-p1 parse ;
+M: sp-parser parse ( input parser -- list )
+    #! Skip all leading whitespace from the input then call
+    #! the parser on the remaining input.
+    >r left-trim-slice r> sp-parser-p1 parse ;
 
 TUPLE: just-parser p1 ;
 
 C: just just-parser ( p1 -- parser )
 
-M: just-parser (parse) ( input parser -- result )
-  #! Calls the given parser on the input removes
-  #! from the results anything where the remaining
-  #! input to be parsed is not empty. So ensures a
-  #! fully parsed input string.
-  just-parser-p1 parse [ parse-result-unparsed empty? ] lsubset ;
+M: just-parser parse ( input parser -- result )
+    #! Calls the given parser on the input removes
+    #! from the results anything where the remaining
+    #! input to be parsed is not empty. So ensures a
+    #! fully parsed input string.
+    just-parser-p1 parse [ parse-result-unparsed empty? ] lsubset ;
 
 TUPLE: apply-parser p1 quot ;
 
 C: <@ apply-parser ( parser quot -- parser )
 
-M: apply-parser (parse) ( input parser -- result )
-  #! Calls the parser on the input. For each successfull
-  #! parse the quot is call with the parse result on the stack.
-  #! The result of that quotation then becomes the new parse result.
-  #! This allows modification of parse tree results (like
-  #! converting strings to integers, etc).
-  [ apply-parser-p1 ] keep apply-parser-quot
-  -rot parse [
-    [ parse-result-parsed swap call ] keep
-    parse-result-unparsed <parse-result>
-  ] lmap-with ;
+M: apply-parser parse ( input parser -- result )
+    #! Calls the parser on the input. For each successfull
+    #! parse the quot is call with the parse result on the stack.
+    #! The result of that quotation then becomes the new parse result.
+    #! This allows modification of parse tree results (like
+    #! converting strings to integers, etc).
+    [ apply-parser-p1 ] keep apply-parser-quot
+    -rot parse [
+        [ parse-result-parsed swap call ] keep
+        parse-result-unparsed <parse-result>
+    ] lmap-with ;
 
 TUPLE: some-parser p1 ;
 
 C: some some-parser ( p1 -- parser )
 
-M: some-parser (parse) ( input parser -- result )
-  #! Calls the parser on the input, guarantees
-  #! the parse is complete (the remaining input is empty),
-  #! picks the first solution and only returns the parse
-  #! tree since the remaining input is empty.
-  some-parser-p1 just parse-1 ;
-
+M: some-parser parse ( input parser -- result )
+    #! Calls the parser on the input, guarantees
+    #! the parse is complete (the remaining input is empty),
+    #! picks the first solution and only returns the parse
+    #! tree since the remaining input is empty.
+    some-parser-p1 just parse-1 ;
 
 : <& ( parser1 parser2 -- parser )
-  #! Same as <&> except discard the results of the second parser.
-  <&> [ first ] <@ ;
+    #! Same as <&> except discard the results of the second parser.
+    <&> [ first ] <@ ;
 
 : &> ( parser1 parser2 -- parser )
-  #! Same as <&> except discard the results of the first parser.
-  <&> [ second ] <@ ;
+    #! Same as <&> except discard the results of the first parser.
+    <&> [ second ] <@ ;
 
 : <:&> ( parser1 parser2 -- result )
-  #! Same as <&> except flatten the result.
-  <&> [ dup second swap first [ % , ] { } make ] <@ ;
+    #! Same as <&> except flatten the result.
+    <&> [ first2 add ] <@ ;
 
 : <&:> ( parser1 parser2 -- result )
-  #! Same as <&> except flatten the result.
-  <&> [ dup second swap first [ , % ] { } make ] <@ ;
+    #! Same as <&> except flatten the result.
+    <&> [ first2 swap add* ] <@ ;
 
 : <:&:> ( parser1 parser2 -- result )
-  #! Same as <&> except flatten the result.
-  <&> [ dup second swap first [ % % ] { } make ] <@ ;
+    #! Same as <&> except flatten the result.
+    <&> [ first2 append ] <@ ;
 
 LAZY: <*> ( parser -- parser )
-  dup <*> <&:> { } succeed <|> ;
+    dup <*> <&:> { } succeed <|> ;
 
 : <+> ( parser -- parser )
-  #! Return a parser that accepts one or more occurences of the original
-  #! parser.
-  dup <*> <&:> ;
+    #! Return a parser that accepts one or more occurences of the original
+    #! parser.
+    dup <*> <&:> ;
 
 LAZY: <?> ( parser -- parser )
-  #! Return a parser that optionally uses the parser
-  #! if that parser would be successfull.
-  [ 1array ] <@ f succeed <|> ;
+    #! Return a parser that optionally uses the parser
+    #! if that parser would be successfull.
+    [ 1array ] <@ f succeed <|> ;
 
 TUPLE: only-first-parser p1 ;
-LAZY: only-first ( parser -- parser )
-  \ only-first-parser construct-boa ;
 
-M: only-first-parser (parse) ( input parser -- list )
-  #! Transform a parser into a parser that only yields
-  #! the first possibility.
-  only-first-parser-p1 parse 1 swap ltake ;
+LAZY: only-first ( parser -- parser )
+    only-first-parser construct-boa ;
+
+M: only-first-parser parse ( input parser -- list )
+    #! Transform a parser into a parser that only yields
+    #! the first possibility.
+    only-first-parser-p1 parse 1 swap ltake ;
 
 LAZY: <!*> ( parser -- parser )
-  #! Like <*> but only return one possible result
-  #! containing all matching parses. Does not return
-  #! partial matches. Useful for efficiency since that's
-  #! usually the effect you want and cuts down on backtracking
-  #! required.
-  <*> only-first ;
+    #! Like <*> but only return one possible result
+    #! containing all matching parses. Does not return
+    #! partial matches. Useful for efficiency since that's
+    #! usually the effect you want and cuts down on backtracking
+    #! required.
+    <*> only-first ;
 
 LAZY: <!+> ( parser -- parser )
-  #! Like <+> but only return one possible result
-  #! containing all matching parses. Does not return
-  #! partial matches. Useful for efficiency since that's
-  #! usually the effect you want and cuts down on backtracking
-  #! required.
-  <+> only-first ;
+    #! Like <+> but only return one possible result
+    #! containing all matching parses. Does not return
+    #! partial matches. Useful for efficiency since that's
+    #! usually the effect you want and cuts down on backtracking
+    #! required.
+    <+> only-first ;
 
 LAZY: <!?> ( parser -- parser )
-  #! Like <?> but only return one possible result
-  #! containing all matching parses. Does not return
-  #! partial matches. Useful for efficiency since that's
-  #! usually the effect you want and cuts down on backtracking
-  #! required.
-  <?> only-first ;
+    #! Like <?> but only return one possible result
+    #! containing all matching parses. Does not return
+    #! partial matches. Useful for efficiency since that's
+    #! usually the effect you want and cuts down on backtracking
+    #! required.
+    <?> only-first ;
 
 LAZY: <(*)> ( parser -- parser )
     #! Like <*> but take shortest match first.
@@ -251,20 +253,20 @@ LAZY: <(+)> ( parser -- parser )
     dup <(*)> <&:> ;
 
 : pack ( close body open -- parser )
-  #! Parse a construct enclosed by two symbols,
-  #! given a parser for the opening symbol, the
-  #! closing symbol, and the body.
-  <& &> ;
+    #! Parse a construct enclosed by two symbols,
+    #! given a parser for the opening symbol, the
+    #! closing symbol, and the body.
+    <& &> ;
 
 : nonempty-list-of ( items separator -- parser )
-  [ over &> <*> <&:> ] keep <?> tuck pack ;
+    [ over &> <*> <&:> ] keep <?> tuck pack ;
 
 : list-of ( items separator -- parser )
-  #! Given a parser for the separator and for the
-  #! items themselves, return a parser that parses
-  #! lists of those items. The parse tree is an
-  #! array of the parsed items.
-  nonempty-list-of { } succeed <|> ;
+    #! Given a parser for the separator and for the
+    #! items themselves, return a parser that parses
+    #! lists of those items. The parse tree is an
+    #! array of the parsed items.
+    nonempty-list-of { } succeed <|> ;
 
 LAZY: surrounded-by ( parser start end -- parser' )
-  [ token ] 2apply swapd pack ;
+    [ token ] 2apply swapd pack ;

From 3a12daacfb4a7f9163d245a9eccac4752e9ec775 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <wayo.cavazos@gmail.com>
Date: Mon, 26 Nov 2007 16:11:32 -0600
Subject: [PATCH 14/18] x: Check for XOpenDisplay failure in "create" method of
 <display>

---
 extra/x/x.factor | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/extra/x/x.factor b/extra/x/x.factor
index e55dc3f5cd..8d9f869fa3 100644
--- a/extra/x/x.factor
+++ b/extra/x/x.factor
@@ -29,7 +29,8 @@ define-independent-class
 
 <display> "create" !( name <display> -- display ) [
   new-empty swap >>name
-  dup $name dup [ string>char-alien ] [ ] if XOpenDisplay >>ptr
+  dup $name dup [ string>char-alien ] [ ] if XOpenDisplay
+  dup [ >>ptr ] [ "XOpenDisplay error" throw ] if
   dup $ptr XDefaultScreen >>default-screen
   dup $ptr XDefaultRootWindow dupd <window> new >>default-root
   dup $ptr over $default-screen XDefaultGC >>default-gc

From 6476eb765ea4a7fe9cbfdb2943be305dae0b2ef9 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Tue, 27 Nov 2007 11:57:08 +1300
Subject: [PATCH 15/18] remove parse-state from peg

---
 extra/peg/peg-tests.factor | 74 ++++++++++++++++----------------------
 extra/peg/peg.factor       | 27 +++-----------
 2 files changed, 36 insertions(+), 65 deletions(-)

diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor
index a60d1eaaf0..9becc81b56 100644
--- a/extra/peg/peg-tests.factor
+++ b/extra/peg/peg-tests.factor
@@ -8,144 +8,132 @@ IN: temporary
   0 next-id set-global get-next-id get-next-id get-next-id 
 ] unit-test
 
-{ "0123456789" } [
-  "0123456789" 0 <parse-state> 0 state-tail parse-state-input >string
-] unit-test
-
-{ "56789" } [
-  "0123456789" 5 <parse-state> 0 state-tail parse-state-input >string
-] unit-test
-
-{ "789" } [
-  "0123456789" 5 <parse-state> 2 state-tail parse-state-input >string
-] unit-test
-
 { f } [
-  "endbegin" 0 <parse-state> "begin" token parse
+  "endbegin" "begin" token parse
 ] unit-test
 
 { "begin" "end" } [
-  "beginend" 0 <parse-state> "begin" token parse 
+  "beginend" "begin" token parse 
   { parse-result-ast parse-result-remaining } get-slots
-  parse-state-input >string
+  >string
 ] unit-test
 
 { f } [
-  "" 0 <parse-state> CHAR: a CHAR: z range parse
+  "" CHAR: a CHAR: z range parse
 ] unit-test
 
 { f } [
-  "1bcd" 0 <parse-state> CHAR: a CHAR: z range parse
+  "1bcd" CHAR: a CHAR: z range parse
 ] unit-test
 
 { CHAR: a } [
-  "abcd" 0 <parse-state> CHAR: a CHAR: z range parse parse-result-ast
+  "abcd" CHAR: a CHAR: z range parse parse-result-ast
 ] unit-test
 
 { CHAR: z } [
-  "zbcd" 0 <parse-state> CHAR: a CHAR: z range parse parse-result-ast
+  "zbcd" CHAR: a CHAR: z range parse parse-result-ast
 ] unit-test
 
 { f } [
-  "bad" 0 <parse-state> "a" token "b" token 2array seq parse
+  "bad" "a" token "b" token 2array seq parse
 ] unit-test
 
 { V{ "g" "o" } } [
-  "good" 0 <parse-state> "g" token "o" token 2array seq parse parse-result-ast
+  "good" "g" token "o" token 2array seq parse parse-result-ast
 ] unit-test
 
 { "a" } [
-  "abcd" 0 <parse-state> "a" token "b" token 2array choice parse parse-result-ast
+  "abcd" "a" token "b" token 2array choice parse parse-result-ast
 ] unit-test
 
 { "b" } [
-  "bbcd" 0 <parse-state> "a" token "b" token 2array choice parse parse-result-ast
+  "bbcd" "a" token "b" token 2array choice parse parse-result-ast
 ] unit-test
 
 { f } [
-  "cbcd" 0 <parse-state> "a" token "b" token 2array choice parse 
+  "cbcd" "a" token "b" token 2array choice parse 
 ] unit-test
 
 { f } [
-  "" 0 <parse-state> "a" token "b" token 2array choice parse 
+  "" "a" token "b" token 2array choice parse 
 ] unit-test
 
 { 0 } [
-  "" 0 <parse-state> "a" token repeat0 parse parse-result-ast length
+  "" "a" token repeat0 parse parse-result-ast length
 ] unit-test
 
 { 0 } [
-  "b" 0 <parse-state> "a" token repeat0 parse parse-result-ast length
+  "b" "a" token repeat0 parse parse-result-ast length
 ] unit-test
 
 { V{ "a" "a" "a" } } [
-  "aaab" 0 <parse-state> "a" token repeat0 parse parse-result-ast 
+  "aaab" "a" token repeat0 parse parse-result-ast 
 ] unit-test
 
 { f } [
-  "" 0 <parse-state> "a" token repeat1 parse 
+  "" "a" token repeat1 parse 
 ] unit-test
 
 { f } [
-  "b" 0 <parse-state> "a" token repeat1 parse 
+  "b" "a" token repeat1 parse 
 ] unit-test
 
 { V{ "a" "a" "a" } } [
-  "aaab" 0 <parse-state> "a" token repeat1 parse parse-result-ast
+  "aaab" "a" token repeat1 parse parse-result-ast
 ] unit-test
 
 { V{ "a" "b" } } [ 
-  "ab" 0 <parse-state> "a" token optional "b" token 2array seq parse parse-result-ast 
+  "ab" "a" token optional "b" token 2array seq parse parse-result-ast 
 ] unit-test
 
 { V{ f "b" } } [ 
-  "b" 0 <parse-state> "a" token optional "b" token 2array seq parse parse-result-ast 
+  "b" "a" token optional "b" token 2array seq parse parse-result-ast 
 ] unit-test
 
 { f } [ 
-  "cb" 0 <parse-state> "a" token optional "b" token 2array seq parse  
+  "cb" "a" token optional "b" token 2array seq parse  
 ] unit-test
 
 { V{ CHAR: a CHAR: b } } [
-  "ab" 0 <parse-state> "a" token ensure CHAR: a CHAR: z range dup 3array seq parse parse-result-ast
+  "ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse parse-result-ast
 ] unit-test
 
 { f } [
-  "bb" 0 <parse-state> "a" token ensure CHAR: a CHAR: z range 2array seq parse 
+  "bb" "a" token ensure CHAR: a CHAR: z range 2array seq parse 
 ] unit-test
 
 { t } [
-  "a+b" 0 <parse-state>
+  "a+b" 
   "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
   parse [ t ] [ f ] if
 ] unit-test
 
 { t } [
-  "a++b" 0 <parse-state>
+  "a++b" 
   "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
   parse [ t ] [ f ] if
 ] unit-test
 
 { t } [
-  "a+b" 0 <parse-state>
+  "a+b" 
   "a" token "+" token "++" token 2array choice "b" token 3array seq
   parse [ t ] [ f ] if
 ] unit-test
 
 { f } [
-  "a++b" 0 <parse-state>
+  "a++b" 
   "a" token "+" token "++" token 2array choice "b" token 3array seq
   parse [ t ] [ f ] if
 ] unit-test
 
 { 1 } [
-  "a" 0 <parse-state> "a" token [ drop 1 ] action parse parse-result-ast 
+  "a" "a" token [ drop 1 ] action parse parse-result-ast 
 ] unit-test
 
 { V{ 1 1 } } [
-  "aa" 0 <parse-state> "a" token [ drop 1 ] action dup 2array seq parse parse-result-ast 
+  "aa" "a" token [ drop 1 ] action dup 2array seq parse parse-result-ast 
 ] unit-test
 
 { f } [
-  "b" 0 <parse-state> "a" token [ drop 1 ] action parse 
+  "b" "a" token [ drop 1 ] action parse 
 ] unit-test
\ No newline at end of file
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index 2c985b68dc..34c17448fb 100644
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -5,23 +5,6 @@ IN: peg
 
 SYMBOL: ignore 
 
-TUPLE: parse-state input cache ;
-
-: <parse-state> ( input index -- state )
-  tail-slice { set-parse-state-input } parse-state construct ;
-
-: get-cached ( pid state -- result )
-  tuck parse-state-cache at [
-    swap parse-state-input slice-from swap nth     
-  ] [ 
-    drop f
-  ] if* ;
-
-: state-tail ( state n -- state )
-  dupd [ parse-state-cache ] dipd
-  [ parse-state-input ] dip tail-slice 
-  { set-parse-state-cache set-parse-state-input } parse-state construct ; 
-
 TUPLE: parse-result remaining ast ;
 
 : <parse-result> ( remaining ast -- parse-result )
@@ -42,8 +25,8 @@ GENERIC: parse ( state parser -- result )
 TUPLE: token-parser symbol ;
 
 M: token-parser parse ( state parser -- result )
-  token-parser-symbol 2dup >r parse-state-input r> head? [
-    dup >r length state-tail r>  <parse-result>
+  token-parser-symbol 2dup head? [
+    dup >r length tail-slice r> <parse-result>
   ] [
     2drop f
   ] if ;
@@ -54,12 +37,12 @@ M: token-parser parse ( state parser -- result )
 TUPLE: range-parser min max ;
 
 M: range-parser parse ( state parser -- result )
-  over parse-state-input empty? [
+  over empty? [
     2drop f
   ] [
-    0 pick parse-state-input nth dup rot 
+    0 pick nth dup rot 
     { range-parser-min range-parser-max } get-slots between? [
-      [ 1 state-tail ] dip <parse-result>
+      [ 1 tail-slice ] dip <parse-result>
     ] [
       2drop f
     ] if

From a9333780a024ef6d0019d1b99a9dd8a5b32b16c0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 26 Nov 2007 18:19:58 -0500
Subject: [PATCH 16/18] Add missing USE:

---
 extra/ui/x11/x11.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/ui/x11/x11.factor b/extra/ui/x11/x11.factor
index 2b1a5ba331..5984e3decd 100755
--- a/extra/ui/x11/x11.factor
+++ b/extra/ui/x11/x11.factor
@@ -5,7 +5,7 @@ ui.clipboards ui.gadgets.worlds assocs kernel math namespaces
 opengl sequences strings x11.xlib x11.events x11.xim x11.glx
 x11.clipboard x11.constants x11.windows io.utf8 combinators
 debugger system command-line ui.render math.vectors tuples
-opengl.gl ;
+opengl.gl threads ;
 IN: ui.x11
 
 TUPLE: x11-ui-backend ;

From 6b3db4f05d33e19c73e102c83b3ab9d79f2a18ae Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 26 Nov 2007 18:20:10 -0500
Subject: [PATCH 17/18] Fix infinite recursion

---
 extra/xml/data/data.factor | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/extra/xml/data/data.factor b/extra/xml/data/data.factor
index 56e34b7db2..1850171537 100644
--- a/extra/xml/data/data.factor
+++ b/extra/xml/data/data.factor
@@ -65,6 +65,8 @@ M: attrs set-at
 
 M: attrs assoc-size length ;
 M: attrs new-assoc drop V{ } new <attrs> ;
+M: attrs assoc-find >r delegate r> assoc-find ;
+M: attrs >alist delegate >alist ;
 
 : >attrs ( assoc -- attrs )
     V{ } assoc-clone-like

From 99b39e03511df0aa979cd1ad8daa0dd2f0e7561c Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Tue, 27 Nov 2007 12:22:33 +1300
Subject: [PATCH 18/18] Some help for pegs

---
 extra/peg/peg-docs.factor  | 108 +++++++++++++++++++++++++++++++++++--
 extra/peg/peg-tests.factor |   2 +-
 extra/peg/peg.factor       |  66 ++++++++++++-----------
 3 files changed, 141 insertions(+), 35 deletions(-)

diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor
index ec4a5d304d..40743132f3 100644
--- a/extra/peg/peg-docs.factor
+++ b/extra/peg/peg-docs.factor
@@ -2,10 +2,112 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: help.markup help.syntax peg ;
 
+HELP: parse
+{ $values 
+  { "string" "a string" } 
+  { "parse" "a parser" } 
+  { "result" "a <parse-result> or f" } 
+}
+{ $description 
+    "Given the input string, parse it using the given parser. The result is a <parse-result> object if "
+    "the parse was successful, otherwise it is f." } ;
+
 HELP: token
 { $values 
-  { "string" "a string" } }
+  { "string" "a string" } 
+  { "parser" "a parser" } 
+}
 { $description 
-    "A parser generator that returns a parser that matches the given string." }
-{ $example "\"begin foo end\" \"begin\" token parse" "result-here" } ;
+    "Returns a parser that matches the given string." } ;
+
+HELP: range
+{ $values 
+  { "min" "a character" } 
+  { "max" "a character" } 
+  { "parser" "a parser" } 
+}
+{ $description 
+    "Returns a parser that matches a single character that lies within the range of characters given, inclusive." }
+{ $example ": digit ( -- parser ) CHAR: 0 CHAR: 9 range ;" } ;
+
+HELP: seq
+{ $values 
+  { "seq" "a sequence of parsers" } 
+  { "parser" "a parser" } 
+}
+{ $description 
+    "Returns a parser that calls all parsers in the given sequence, in order. The parser succeeds if "
+    "all the parsers succeed, otherwise it fails. The AST produced is a sequence of the AST produced by "
+    "the individual parsers." } ;
+
+HELP: choice
+{ $values 
+  { "seq" "a sequence of parsers" } 
+  { "parser" "a parser" } 
+}
+{ $description 
+    "Returns a parser that will try all the parsers in the sequence, in order, until one succeeds. "
+    "The resulting AST is that produced by the successful parser." } ;
+
+HELP: repeat0
+{ $values 
+  { "p1" "a parser" } 
+  { "p2" "a parser" } 
+}
+{ $description 
+    "Returns a parser that parses 0 or more instances of the 'p1' parser. The AST produced is "
+    "an array of the AST produced by the 'p1' parser. An empty array indicates 0 instances were "
+    "parsed." } ;
+
+HELP: repeat1
+{ $values 
+  { "p1" "a parser" } 
+  { "p2" "a parser" } 
+}
+{ $description 
+    "Returns a parser that parses 1 or more instances of the 'p1' parser. The AST produced is "
+    "an array of the AST produced by the 'p1' parser." } ;
+
+HELP: optional
+{ $values 
+  { "p1" "a parser" } 
+  { "p2" "a parser" } 
+}
+{ $description 
+    "Returns a parser that parses 0 or 1 instances of the 'p1' parser. The AST produced is "
+    "'f' if 0 instances are parsed the AST produced is 'f', otherwise it is the AST produced by 'p1'." } ;
+
+HELP: ensure
+{ $values 
+  { "p1" "a parser" } 
+  { "p2" "a parser" } 
+}
+{ $description 
+    "Returns a parser that succeeds if the 'p1' parser succeeds but does not add anything to the "
+    "AST and does not move the location in the input string. This can be used for lookahead and "
+    "disambiguation, along with the " { $link ensure-not } " word." }
+{ $example "\"0\" token ensure octal-parser" } ;
+
+HELP: ensure-not
+{ $values 
+  { "p1" "a parser" } 
+  { "p2" "a parser" } 
+}
+{ $description 
+    "Returns a parser that succeeds if the 'p1' parser fails but does not add anything to the "
+    "AST and does not move the location in the input string. This can be used for lookahead and "
+    "disambiguation, along with the " { $link ensure } " word." }
+{ $example "\"+\" token \"=\" token ensure-not \"+=\" token 3array seq" } ;
+
+HELP: action
+{ $values 
+  { "p1" "a parser" } 
+  { "quot" "a quotation with stack effect ( ast -- ast )" } 
+}
+{ $description 
+    "Returns a parser that calls the 'p1' parser and applies the quotation to the AST resulting "
+    "from that parse. The result of the quotation is then used as the final AST. This can be used "
+    "for manipulating the parse tree to produce a AST better suited for the task at hand rather than "
+    "the default AST." }
+{ $example "CHAR: 0 CHAR: 9 range [ to-digit ] action" } ;
 
diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor
index 9becc81b56..7648819a8c 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 sequences peg ;
+USING: kernel tools.test strings namespaces arrays sequences peg peg.private ;
 IN: temporary
 
 { 0 1 2 } [
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index 34c17448fb..1fb8e7860d 100644
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -3,10 +3,14 @@
 USING: kernel sequences strings namespaces math assocs shuffle vectors combinators.lib ;
 IN: peg
 
-SYMBOL: ignore 
-
 TUPLE: parse-result remaining ast ;
 
+GENERIC: parse ( state parser -- result )
+
+<PRIVATE
+
+SYMBOL: ignore 
+
 : <parse-result> ( remaining ast -- parse-result )
   parse-result construct-boa ;
 
@@ -20,8 +24,6 @@ TUPLE: parser id ;
 : init-parser ( parser -- parser )
   get-next-id parser construct-boa over set-delegate ;
 
-GENERIC: parse ( state parser -- result )
-
 TUPLE: token-parser symbol ;
 
 M: token-parser parse ( state parser -- result )
@@ -31,9 +33,6 @@ M: token-parser parse ( state parser -- result )
     2drop f
   ] if ;
 
-: token ( string -- parser )
-  token-parser construct-boa init-parser ;      
-
 TUPLE: range-parser min max ;
 
 M: range-parser parse ( state parser -- result )
@@ -48,9 +47,6 @@ M: range-parser parse ( state parser -- result )
     ] if
   ] if ;
 
-: range ( min max -- parser )
-  range-parser construct-boa init-parser ;
-
 TUPLE: seq-parser parsers ;
 
 : do-seq-parser ( result parser -- result )
@@ -71,9 +67,6 @@ TUPLE: seq-parser parsers ;
 M: seq-parser parse ( state parser -- result )
   seq-parser-parsers [ V{ } clone <parse-result> ] dip  (seq-parser) ;
 
-: seq ( seq -- parser )
-  seq-parser construct-boa init-parser ;
-
 TUPLE: choice-parser parsers ;
   
 : (choice-parser) ( state parsers -- result )
@@ -90,9 +83,6 @@ TUPLE: choice-parser parsers ;
 M: choice-parser parse ( state parser -- result )
   choice-parser-parsers (choice-parser) ;
 
-: choice ( seq -- parser )
-  choice-parser construct-boa init-parser ;
-
 TUPLE: repeat0-parser p1 ;
 
 : (repeat-parser) ( parser result -- result )
@@ -115,25 +105,16 @@ M: repeat0-parser parse ( state parser -- result )
        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 ;
-
 TUPLE: optional-parser p1 ;
 
 M: optional-parser parse ( state parser -- result )
    dupd optional-parser-p1 parse swap f <parse-result> or ;
 
-: optional ( parser -- parser )
-  optional-parser construct-boa init-parser ;
-
 TUPLE: ensure-parser p1 ;
 
 M: ensure-parser parse ( state parser -- result )
@@ -143,9 +124,6 @@ M: ensure-parser parse ( state parser -- result )
      drop f
    ] if ;
 
-: ensure ( parser -- parser )
-  ensure-parser construct-boa init-parser ;
-
 TUPLE: ensure-not-parser p1 ;
 
 M: ensure-not-parser parse ( state parser -- result )
@@ -155,9 +133,6 @@ M: ensure-not-parser parse ( state parser -- result )
      ignore <parse-result>  
    ] if ;
 
-: ensure-not ( parser -- parser )
-  ensure-not-parser construct-boa init-parser ;
-
 TUPLE: action-parser p1 quot ;
 
 M: action-parser parse ( state parser -- result )
@@ -168,5 +143,34 @@ M: action-parser parse ( state parser -- result )
      nip
    ] if ;
 
+PRIVATE>
+
+: token ( string -- parser )
+  token-parser construct-boa init-parser ;      
+
+: range ( min max -- parser )
+  range-parser construct-boa init-parser ;
+
+: seq ( seq -- parser )
+  seq-parser construct-boa init-parser ;
+
+: choice ( seq -- parser )
+  choice-parser construct-boa init-parser ;
+
+: repeat0 ( parser -- parser )
+  repeat0-parser construct-boa init-parser ;
+
+: repeat1 ( parser -- parser )
+  repeat1-parser construct-boa init-parser ;
+
+: optional ( parser -- parser )
+  optional-parser construct-boa init-parser ;
+
+: ensure ( parser -- parser )
+  ensure-parser construct-boa init-parser ;
+
+: ensure-not ( parser -- parser )
+  ensure-not-parser construct-boa init-parser ;
+
 : action ( parser quot -- parser )
   action-parser construct-boa init-parser ;