From c455336da6012d85cfc4b182b331d0f00e4e4e3f Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 28 Nov 2007 12:50:04 +1300
Subject: [PATCH 01/14] Add action rule to ebnf

---
 extra/peg/ebnf/ebnf.factor | 34 ++++++++++++++++++++++++++++------
 1 file changed, 28 insertions(+), 6 deletions(-)

diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index 8726581488..06e3c15163 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel parser words arrays strings math.parser sequences namespaces peg ;
+USING: kernel parser words arrays strings math.parser sequences vectors namespaces peg ;
 IN: peg.ebnf
 
 TUPLE: ebnf-non-terminal symbol ;
@@ -9,6 +9,7 @@ TUPLE: ebnf-choice options ;
 TUPLE: ebnf-sequence elements ;
 TUPLE: ebnf-repeat0 group ;
 TUPLE: ebnf-rule symbol elements ;
+TUPLE: ebnf-action quot ;
 TUPLE: ebnf rules ;
 
 C: <ebnf-non-terminal> ebnf-non-terminal
@@ -17,6 +18,7 @@ C: <ebnf-choice> ebnf-choice
 C: <ebnf-sequence> ebnf-sequence
 C: <ebnf-repeat0> ebnf-repeat0
 C: <ebnf-rule> ebnf-rule
+C: <ebnf-action> ebnf-action
 C: <ebnf> ebnf
 
 GENERIC: ebnf-compile ( ast -- quot )
@@ -62,6 +64,19 @@ M: ebnf-rule ebnf-compile ( ast -- quot )
     ebnf-rule-elements ebnf-compile , \ define-compound , 
   ] [ ] make ;
 
+M: ebnf-action ebnf-compile ( ast -- quot )
+  [
+    ebnf-action-quot , \ action , 
+  ] [ ] make ;
+
+M: vector ebnf-compile ( ast -- quot )
+  [
+    [ ebnf-compile % ] each 
+  ] [ ] make ;
+
+M: f ebnf-compile ( ast -- quot )
+  drop [ ] ;
+
 M: ebnf ebnf-compile ( ast -- quot )
   [
     ebnf-rules [
@@ -75,7 +90,7 @@ DEFER: 'rhs'
   CHAR: a CHAR: z range repeat1 [ >string <ebnf-non-terminal> ] action ;
 
 : 'terminal' ( -- parser )
-  "\"" token hide [ CHAR: " = not ] satisfy repeat1 "\"" token hide 3array seq [ first >string <ebnf-terminal> ] action ;
+  "'" token hide [ CHAR: ' = not ] satisfy repeat1 "'" token hide 3array seq [ first >string <ebnf-terminal> ] action ;
 
 : 'element' ( -- parser )
   'non-terminal' 'terminal' 2array choice ;
@@ -94,13 +109,20 @@ DEFER: 'rhs'
   "}" token sp hide 
   3array seq [ first <ebnf-repeat0> ] action ;
 
+: 'action' ( -- parser )
+  "=>" token hide
+  "[" token sp hide
+  "]." token ensure-not [ drop t ] satisfy 2array seq [ first ] action repeat1 [ >string ] action
+  "]" token "." token ensure 2array seq sp hide
+  4array seq [ "[ " swap first append " ]" append eval <ebnf-action> ] action ;
+
 : 'rhs' ( -- parser )
   'repeat0'
   'sequence'
   'choice'
-  'element' 
-  4array choice ;
-  
+  'element'
+  4array choice 'action' sp optional 2array seq ;
+ 
 : 'rule' ( -- parser )
   'non-terminal' [ ebnf-non-terminal-symbol ] action 
   "=" token sp hide 
@@ -117,4 +139,4 @@ DEFER: 'rhs'
     f
    ] if* ;
 
-: <EBNF "EBNF>" parse-tokens "" join ebnf>quot call ; parsing
\ No newline at end of file
+: <EBNF "EBNF>" parse-tokens " " join dup . ebnf>quot call ; parsing
\ No newline at end of file

From e5e430be4f8defcaf80480371a22c5d59ae78ca5 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 28 Nov 2007 12:52:05 +1300
Subject: [PATCH 02/14] Remove ebnf debug

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

diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index 06e3c15163..343679ab9a 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -139,4 +139,4 @@ DEFER: 'rhs'
     f
    ] if* ;
 
-: <EBNF "EBNF>" parse-tokens " " join dup . ebnf>quot call ; parsing
\ No newline at end of file
+: <EBNF "EBNF>" parse-tokens " " join ebnf>quot call ; parsing
\ No newline at end of file

From 35f96d1c8545ed38fb41dbf2349602ebca591201 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 28 Nov 2007 13:03:16 +1300
Subject: [PATCH 03/14] Use words instead of quotations in ebnf actions

---
 extra/peg/ebnf/ebnf.factor | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index 343679ab9a..cfbd4f9e23 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel parser words arrays strings math.parser sequences vectors namespaces peg ;
+USING: kernel parser words arrays strings math.parser sequences quotations vectors namespaces peg ;
 IN: peg.ebnf
 
 TUPLE: ebnf-non-terminal symbol ;
@@ -9,7 +9,7 @@ TUPLE: ebnf-choice options ;
 TUPLE: ebnf-sequence elements ;
 TUPLE: ebnf-repeat0 group ;
 TUPLE: ebnf-rule symbol elements ;
-TUPLE: ebnf-action quot ;
+TUPLE: ebnf-action word ;
 TUPLE: ebnf rules ;
 
 C: <ebnf-non-terminal> ebnf-non-terminal
@@ -66,7 +66,7 @@ M: ebnf-rule ebnf-compile ( ast -- quot )
 
 M: ebnf-action ebnf-compile ( ast -- quot )
   [
-    ebnf-action-quot , \ action , 
+    ebnf-action-word search 1quotation , \ action , 
   ] [ ] make ;
 
 M: vector ebnf-compile ( ast -- quot )
@@ -111,10 +111,8 @@ DEFER: 'rhs'
 
 : 'action' ( -- parser )
   "=>" token hide
-  "[" token sp hide
-  "]." token ensure-not [ drop t ] satisfy 2array seq [ first ] action repeat1 [ >string ] action
-  "]" token "." token ensure 2array seq sp hide
-  4array seq [ "[ " swap first append " ]" append eval <ebnf-action> ] action ;
+  [ blank? ] satisfy ensure-not [ drop t ] satisfy 2array seq [ first ] action repeat1 [ >string ] action sp
+  2array seq [ first <ebnf-action> ] action ;
 
 : 'rhs' ( -- parser )
   'repeat0'

From 28e9c0e6e062cab3a8ded3e0f1aa8b88b3956ebe Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 28 Nov 2007 13:05:53 +1300
Subject: [PATCH 04/14] Fix ebnf tests

---
 extra/peg/ebnf/ebnf-tests.factor | 38 ++++++++++++++++++--------------
 1 file changed, 22 insertions(+), 16 deletions(-)

diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor
index 0eeab7c4dc..37b4867d34 100644
--- a/extra/peg/ebnf/ebnf-tests.factor
+++ b/extra/peg/ebnf/ebnf-tests.factor
@@ -9,27 +9,33 @@ IN: temporary
 ] unit-test
 
 { T{ ebnf-terminal f "55" } } [
-  "\"55\"" 'terminal' parse parse-result-ast 
+  "'55'" 'terminal' parse parse-result-ast 
+] unit-test
+
+{
+  T{ ebnf-rule f 
+     "digit"
+     V{ 
+       T{ ebnf-choice f
+          V{ T{ ebnf-terminal f "1" } T{ ebnf-terminal f "2" } }
+       }
+       f
+     }
+  } 
+} [
+  "digit = '1' | '2'" 'rule' parse parse-result-ast
 ] unit-test
 
 {
   T{ ebnf-rule f 
      "digit" 
-     T{ ebnf-choice f
-        V{ T{ ebnf-terminal f "1" } T{ ebnf-terminal f "2" } }
+     V{
+       T{ ebnf-sequence f
+          V{ T{ ebnf-terminal f "1" } T{ ebnf-terminal f "2" } }
+       }
+       f
      }
-  } 
+  }   
 } [
-  "digit = \"1\" | \"2\"" 'rule' parse parse-result-ast
-] unit-test
-
-{
-  T{ ebnf-rule f 
-     "digit" 
-     T{ ebnf-sequence f
-        V{ T{ ebnf-terminal f "1" } T{ ebnf-terminal f "2" } }
-     }
-  } 
-} [
-  "digit = \"1\" \"2\"" 'rule' parse parse-result-ast
+  "digit = '1' '2'" 'rule' parse parse-result-ast
 ] unit-test
\ No newline at end of file

From 15b1533f20c91be419edd79f7fcef63775e1d243 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 28 Nov 2007 15:14:11 +1300
Subject: [PATCH 05/14] Fix precedence between choice/sequence in ebnf

---
 extra/peg/ebnf/ebnf-tests.factor | 13 +++++++++++++
 extra/peg/ebnf/ebnf.factor       | 17 +++++++++--------
 2 files changed, 22 insertions(+), 8 deletions(-)

diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor
index 37b4867d34..56f0d63445 100644
--- a/extra/peg/ebnf/ebnf-tests.factor
+++ b/extra/peg/ebnf/ebnf-tests.factor
@@ -38,4 +38,17 @@ IN: temporary
   }   
 } [
   "digit = '1' '2'" 'rule' parse parse-result-ast
+] unit-test
+
+{
+  T{ ebnf-choice f
+     V{ 
+       T{ ebnf-sequence f
+          V{ T{ ebnf-non-terminal f "one" } T{ ebnf-non-terminal f "two" } }
+       }
+       T{ ebnf-non-terminal f "three" }
+     }
+  } 
+} [
+  "one two | three" 'choice' parse parse-result-ast
 ] unit-test
\ No newline at end of file
diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index cfbd4f9e23..9723316b33 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -97,12 +97,15 @@ DEFER: 'rhs'
 
 : 'sequence' ( -- parser )
   'element' sp 
-  "|" token sp ensure-not 2array seq [ first ] action 
-   repeat1 [ <ebnf-sequence> ] action ;
-  
-: 'choice' ( -- parser )
-  'element' sp "|" token sp list-of [ <ebnf-choice> ] action ;
+   repeat1 [ 
+     dup length 1 = [ first ] [ <ebnf-sequence> ] if
+   ] action ;  
 
+: 'choice' ( -- parser )
+  'sequence' sp "|" token sp list-of [ 
+    dup length 1 = [ first ] [ <ebnf-choice> ] if
+   ] action ;
+  
 : 'repeat0' ( -- parser )
   "{" token sp hide
   [ 'rhs' sp ] delay
@@ -116,10 +119,8 @@ DEFER: 'rhs'
 
 : 'rhs' ( -- parser )
   'repeat0'
-  'sequence'
   'choice'
-  'element'
-  4array choice 'action' sp optional 2array seq ;
+  2array choice 'action' sp optional 2array seq ;
  
 : 'rule' ( -- parser )
   'non-terminal' [ ebnf-non-terminal-symbol ] action 

From 0ef96c87d9a4085f9da25a6330c09964144826f7 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 28 Nov 2007 15:26:25 +1300
Subject: [PATCH 06/14] Add grouping operators for ebnf

---
 extra/peg/ebnf/ebnf-tests.factor | 13 +++++++++++++
 extra/peg/ebnf/ebnf.factor       | 10 +++++++++-
 2 files changed, 22 insertions(+), 1 deletion(-)

diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor
index 56f0d63445..13d0ce887e 100644
--- a/extra/peg/ebnf/ebnf-tests.factor
+++ b/extra/peg/ebnf/ebnf-tests.factor
@@ -51,4 +51,17 @@ IN: temporary
   } 
 } [
   "one two | three" 'choice' parse parse-result-ast
+] unit-test
+
+{
+  T{ ebnf-sequence f
+     V{ 
+       T{ ebnf-non-terminal f "one" }
+       T{ ebnf-choice f
+          V{ T{ ebnf-non-terminal f "two" } T{ ebnf-non-terminal f "three" } }
+       }
+     }
+  } 
+} [
+  "one (two | three)" 'choice' parse parse-result-ast
 ] unit-test
\ No newline at end of file
diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index 9723316b33..4a1d7b341b 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -95,8 +95,16 @@ DEFER: 'rhs'
 : 'element' ( -- parser )
   'non-terminal' 'terminal' 2array choice ;
 
+DEFER: 'choice'
+
+: 'group' ( -- parser )
+  "(" token sp hide
+  [ 'choice' sp ] delay
+  ")" token sp hide 
+  3array seq [ first ] action ;
+
 : 'sequence' ( -- parser )
-  'element' sp 
+  'element' sp 'group' sp 2array choice 
    repeat1 [ 
      dup length 1 = [ first ] [ <ebnf-sequence> ] if
    ] action ;  

From 3372ad8f685b87fb2e73fc2593429b75108d5345 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 28 Nov 2007 15:27:35 +1300
Subject: [PATCH 07/14] Fix some peg breakage

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

diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index a9e08f6024..5fa9435470 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 vectors combinators.lib ;
+USING: kernel sequences strings namespaces math assocs shuffle vectors arrays combinators.lib ;
 IN: peg
 
 TUPLE: parse-result remaining ast ;

From d68a78c4a62c12552ca99aff83d5182ea1e0f23f Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 28 Nov 2007 15:32:04 +1300
Subject: [PATCH 08/14] fix grouping of repeat0 in ebnf

---
 extra/peg/ebnf/ebnf-tests.factor | 20 ++++++++++++++++++++
 extra/peg/ebnf/ebnf.factor       | 18 ++++++++----------
 2 files changed, 28 insertions(+), 10 deletions(-)

diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor
index 13d0ce887e..a19bc0188c 100644
--- a/extra/peg/ebnf/ebnf-tests.factor
+++ b/extra/peg/ebnf/ebnf-tests.factor
@@ -64,4 +64,24 @@ IN: temporary
   } 
 } [
   "one (two | three)" 'choice' parse parse-result-ast
+] unit-test
+
+{
+  T{ ebnf-sequence f
+     V{ 
+       T{ ebnf-non-terminal f "one" }
+       T{ ebnf-repeat0 f
+          T{ ebnf-sequence f
+             V{
+                T{ ebnf-choice f
+                   V{ T{ ebnf-non-terminal f "two" } T{ ebnf-non-terminal f "three" } }
+                }
+                T{ ebnf-non-terminal f "four" }
+             }
+          }
+        }
+     }
+  } 
+} [
+  "one {(two | three) four}" 'choice' parse parse-result-ast
 ] unit-test
\ No newline at end of file
diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index 4a1d7b341b..352390c5cc 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -103,8 +103,14 @@ DEFER: 'choice'
   ")" token sp hide 
   3array seq [ first ] action ;
 
+: 'repeat0' ( -- parser )
+  "{" token sp hide
+  [ 'choice' sp ] delay
+  "}" token sp hide 
+  3array seq [ first <ebnf-repeat0> ] action ;
+
 : 'sequence' ( -- parser )
-  'element' sp 'group' sp 2array choice 
+  'element' sp 'group' sp 'repeat0' sp 3array choice 
    repeat1 [ 
      dup length 1 = [ first ] [ <ebnf-sequence> ] if
    ] action ;  
@@ -114,21 +120,13 @@ DEFER: 'choice'
     dup length 1 = [ first ] [ <ebnf-choice> ] if
    ] action ;
   
-: 'repeat0' ( -- parser )
-  "{" token sp hide
-  [ 'rhs' sp ] delay
-  "}" token sp hide 
-  3array seq [ first <ebnf-repeat0> ] action ;
-
 : 'action' ( -- parser )
   "=>" token hide
   [ blank? ] satisfy ensure-not [ drop t ] satisfy 2array seq [ first ] action repeat1 [ >string ] action sp
   2array seq [ first <ebnf-action> ] action ;
 
 : 'rhs' ( -- parser )
-  'repeat0'
-  'choice'
-  2array choice 'action' sp optional 2array seq ;
+  'choice' 'action' sp optional 2array seq ;
  
 : 'rule' ( -- parser )
   'non-terminal' [ ebnf-non-terminal-symbol ] action 

From e0adc1a7fa609f325d0a7f53a842209ac5636a41 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 28 Nov 2007 15:49:14 +1300
Subject: [PATCH 09/14] Add optional to ebnf

---
 extra/peg/ebnf/ebnf-tests.factor | 14 +++++++++++++-
 extra/peg/ebnf/ebnf.factor       | 18 ++++++++++++++++--
 2 files changed, 29 insertions(+), 3 deletions(-)

diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor
index a19bc0188c..a308b9af52 100644
--- a/extra/peg/ebnf/ebnf-tests.factor
+++ b/extra/peg/ebnf/ebnf-tests.factor
@@ -84,4 +84,16 @@ IN: temporary
   } 
 } [
   "one {(two | three) four}" 'choice' parse parse-result-ast
-] unit-test
\ No newline at end of file
+] unit-test
+
+{
+  T{ ebnf-sequence f
+     V{ 
+         T{ ebnf-non-terminal f "one" } 
+         T{ ebnf-optional f T{ ebnf-non-terminal f "two" } }
+         T{ ebnf-non-terminal f "three" }
+     }
+  } 
+} [
+  "one [ two ] three" 'choice' parse parse-result-ast
+] unit-test
diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index 352390c5cc..00615ccb51 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -8,6 +8,7 @@ TUPLE: ebnf-terminal symbol ;
 TUPLE: ebnf-choice options ;
 TUPLE: ebnf-sequence elements ;
 TUPLE: ebnf-repeat0 group ;
+TUPLE: ebnf-optional elements ;
 TUPLE: ebnf-rule symbol elements ;
 TUPLE: ebnf-action word ;
 TUPLE: ebnf rules ;
@@ -17,6 +18,7 @@ C: <ebnf-terminal> ebnf-terminal
 C: <ebnf-choice> ebnf-choice
 C: <ebnf-sequence> ebnf-sequence
 C: <ebnf-repeat0> ebnf-repeat0
+C: <ebnf-optional> ebnf-optional
 C: <ebnf-rule> ebnf-rule
 C: <ebnf-action> ebnf-action
 C: <ebnf> ebnf
@@ -30,7 +32,8 @@ M: ebnf-terminal ebnf-compile ( ast -- quot )
 
 M: ebnf-non-terminal ebnf-compile ( ast -- quot )
   [
-    ebnf-non-terminal-symbol , \ in , \ get , \ lookup , \ execute ,
+    [ ebnf-non-terminal-symbol , \ search , \ execute , ] [ ] make 
+    , \ delay ,
   ] [ ] make ;
 
 M: ebnf-choice ebnf-compile ( ast -- quot )
@@ -58,6 +61,11 @@ M: ebnf-repeat0 ebnf-compile ( ast -- quot )
     ebnf-repeat0-group ebnf-compile % \ repeat0 , 
   ] [ ] make ;
 
+M: ebnf-optional ebnf-compile ( ast -- quot )
+  [
+    ebnf-optional-elements ebnf-compile % \ optional , 
+  ] [ ] make ;
+
 M: ebnf-rule ebnf-compile ( ast -- quot )
   [
     dup ebnf-rule-symbol , \ in , \ get , \ create , 
@@ -109,8 +117,14 @@ DEFER: 'choice'
   "}" token sp hide 
   3array seq [ first <ebnf-repeat0> ] action ;
 
+: 'optional' ( -- parser )
+  "[" token sp hide
+  [ 'choice' sp ] delay
+  "]" token sp hide 
+  3array seq [ first <ebnf-optional> ] action ;
+
 : 'sequence' ( -- parser )
-  'element' sp 'group' sp 'repeat0' sp 3array choice 
+  'element' sp 'group' sp 'repeat0' sp 'optional' sp 4array choice 
    repeat1 [ 
      dup length 1 = [ first ] [ <ebnf-sequence> ] if
    ] action ;  

From d3ac10aefc8aaaf61e4eca27492d625a8d68cb6f Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Wed, 28 Nov 2007 16:07:23 +1300
Subject: [PATCH 10/14] Redo PL/0 parser using ebnf

---
 extra/peg/ebnf/ebnf.factor |  4 +--
 extra/peg/pl0/pl0.factor   | 65 +++++++++++---------------------------
 2 files changed, 20 insertions(+), 49 deletions(-)

diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index 00615ccb51..4c4c8cd0cc 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -27,12 +27,12 @@ GENERIC: ebnf-compile ( ast -- quot )
 
 M: ebnf-terminal ebnf-compile ( ast -- quot )
   [
-    ebnf-terminal-symbol , \ token ,
+    ebnf-terminal-symbol , \ token , \ sp , 
   ] [ ] make ;
 
 M: ebnf-non-terminal ebnf-compile ( ast -- quot )
   [
-    [ ebnf-non-terminal-symbol , \ search , \ execute , ] [ ] make 
+    [ ebnf-non-terminal-symbol , \ search , \ execute , \ sp , ] [ ] make 
     , \ delay ,
   ] [ ] make ;
 
diff --git a/extra/peg/pl0/pl0.factor b/extra/peg/pl0/pl0.factor
index 8a01057bfb..b37009238d 100644
--- a/extra/peg/pl0/pl0.factor
+++ b/extra/peg/pl0/pl0.factor
@@ -1,58 +1,29 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel arrays strings math.parser sequences peg ;
+USING: kernel arrays strings math.parser sequences peg peg.ebnf ;
 IN: peg.pl0
 
 #! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0
-
-: 'ident' ( -- parser )
+: ident ( -- parser )
   CHAR: a CHAR: z range 
   CHAR: A CHAR: Z range 2array choice repeat1 
   [ >string ] action ;
 
-: 'number' ( -- parser )
+: number ( -- parser )
   CHAR: 0 CHAR: 9 range repeat1 [ string>number ] action ;
 
-DEFER: 'factor'
-
-: 'term' ( -- parser )
-  'factor' "*" token "/" token 2array choice sp 'factor' sp 2array seq repeat0 2array seq ;
-
-: 'expression' ( -- parser )
-  [ "+" token "-" token 2array choice sp optional 'term' sp 2dup 2array seq repeat0 3array seq ] delay ;
-
-: 'factor' ( -- parser )
-  'ident' 'number' "(" token hide 'expression' sp ")" token sp hide 3array seq 3array choice ;
-
-: 'condition' ( -- parser )
-  "odd" token 'expression' sp 2array seq
-  'expression' { "=" "#" "<=" "<" ">=" ">" } [ token ] map choice sp 'expression' sp 3array seq 
-  2array choice ;
-
-: 'statement' ( -- parser )
-  [
-    'ident' ":=" token sp 'expression' sp 3array seq
-    "call" token 'ident' sp 2array seq
-    "begin" token 'statement' sp ";" token sp 'statement' sp 2array seq repeat0 "end" token sp 4array seq
-     "if" token 'condition' sp "then" token sp 'statement' sp 4array seq
-     4array choice
-     "while" token 'condition' sp "do" token sp 'statement' sp 4array seq
-     2array choice optional
-  ] delay ;
-
-: 'block' ( -- parser )
- [
-  "const" token 'ident' sp "=" token sp 'number' sp 4array seq 
-    "," token sp 'ident' sp "=" token sp 'number' sp 4array seq repeat0
-  ";" token sp 3array seq optional
-  
-  "var" token 'ident' sp "," token sp 'ident' sp 2array seq repeat0 
-  ";" token sp 4array seq optional
-
-  "procedure" token 'ident' sp ";" token sp 'block' sp 4array seq ";" token sp 2array seq repeat0 'statement' sp 2array seq  
-
-  3array seq
- ] delay ;
-
-: 'program' ( -- parser )
-  'block' "." token sp 2array seq ;
+<EBNF
+program = block '.' .
+block = [ 'const' ident '=' number { ',' ident '=' number } ';' ]
+        [ 'var' ident { ',' ident } ';' ]
+        { 'procedure' ident ';' [ block ';' ] } statement .
+statement = [ ident ':=' expression | 'call' ident |
+              'begin' statement {';' statement } 'end' |
+              'if' condition 'then' statement |
+              'while' condition 'do' statement ] .
+condition = 'odd' expression |
+            expression ('=' | '#' | '<=' | '<' | '>=' | '>') expression .
+expression = ['+' | '-'] term {('+' | '-') term } .
+term = factor {('*' | '/') factor } .
+factor = ident | number | '(' expression ')'
+EBNF>

From 89bbd21362e4b268a0f55ef27a6e7d37b863ae52 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Thu, 29 Nov 2007 12:35:45 +1300
Subject: [PATCH 11/14] Add packrat caching to peg

---
 extra/peg/peg.factor | 64 +++++++++++++++++++++++++++++++++-----------
 1 file changed, 48 insertions(+), 16 deletions(-)

diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index 5fa9435470..8940fc87c6 100644
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -1,14 +1,16 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences strings namespaces math assocs shuffle vectors arrays combinators.lib ;
+USING: kernel sequences strings namespaces math assocs shuffle 
+       vectors arrays combinators.lib ;
 IN: peg
 
 TUPLE: parse-result remaining ast ;
 
-GENERIC: parse ( state parser -- result )
+GENERIC: (parse) ( state parser -- result )
 
 <PRIVATE
 
+SYMBOL: packrat-cache
 SYMBOL: ignore 
 
 : <parse-result> ( remaining ast -- parse-result )
@@ -24,18 +26,48 @@ TUPLE: parser id ;
 : init-parser ( parser -- parser )
   get-next-id parser construct-boa over set-delegate ;
 
+: from ( slice-or-string -- index )
+  dup slice? [ slice-from ] [ drop 0 ] if ;
+
+: get-cached ( input parser -- result )
+  [ from ] dip parser-id packrat-cache get at at ;
+
+: put-cached ( result input parser -- )
+  parser-id dup packrat-cache get at [ 
+    nip
+  ] [ 
+    H{ } clone dup >r swap packrat-cache get set-at r>
+  ] if* 
+  [ from ] dip set-at ;
+
+PRIVATE>
+
+: parse ( input parser -- result )
+  packrat-cache get [
+    2dup get-cached [
+      [ (parse) dup ] 2keep put-cached
+    ] unless* 
+  ] [
+    (parse)
+  ] if ;
+
+: packrat-parse ( input parser -- result )
+  H{ } clone packrat-cache [ parse ] with-variable ;
+
+<PRIVATE
+
 TUPLE: token-parser symbol ;
 
-M: token-parser parse ( state parser -- result )
+M: token-parser (parse) ( input parser -- result )
   token-parser-symbol 2dup head? [
     dup >r length tail-slice r> <parse-result>
   ] [
     2drop f
   ] if ;
-
+   
 TUPLE: satisfy-parser quot ;
 
-M: satisfy-parser parse ( state parser -- result )
+M: satisfy-parser (parse) ( state parser -- result )
   over empty? [
     2drop f 
   ] [
@@ -48,7 +80,7 @@ M: satisfy-parser parse ( state parser -- result )
 
 TUPLE: range-parser min max ;
 
-M: range-parser parse ( state parser -- result )
+M: range-parser (parse) ( state parser -- result )
   over empty? [
     2drop f
   ] [
@@ -77,7 +109,7 @@ TUPLE: seq-parser parsers ;
     drop   
   ] if ;
 
-M: seq-parser parse ( state parser -- result )
+M: seq-parser (parse) ( state parser -- result )
   seq-parser-parsers [ V{ } clone <parse-result> ] dip  (seq-parser) ;
 
 TUPLE: choice-parser parsers ;
@@ -93,7 +125,7 @@ TUPLE: choice-parser parsers ;
     ] if* 
   ] if ;
 
-M: choice-parser parse ( state parser -- result )
+M: choice-parser (parse) ( state parser -- result )
   choice-parser-parsers (choice-parser) ;
 
 TUPLE: repeat0-parser p1 ;
@@ -111,7 +143,7 @@ TUPLE: repeat0-parser p1 ;
   { parse-result-remaining parse-result-ast }
   get-slots 1vector  <parse-result> ;
 
-M: repeat0-parser parse ( state parser -- result )
+M: repeat0-parser (parse) ( state parser -- result )
      repeat0-parser-p1 2dup parse [ 
        nipd clone-result (repeat-parser) 
      ] [ 
@@ -120,17 +152,17 @@ M: repeat0-parser parse ( state parser -- result )
 
 TUPLE: repeat1-parser p1 ;
 
-M: repeat1-parser parse ( state parser -- result )
+M: repeat1-parser (parse) ( state parser -- result )
    repeat1-parser-p1 tuck parse dup [ clone-result (repeat-parser) ] [ nip ] if ;
 
 TUPLE: optional-parser p1 ;
 
-M: optional-parser parse ( state parser -- result )
+M: optional-parser (parse) ( state parser -- result )
    dupd optional-parser-p1 parse swap f <parse-result> or ;
 
 TUPLE: ensure-parser p1 ;
 
-M: ensure-parser parse ( state parser -- result )
+M: ensure-parser (parse) ( state parser -- result )
    dupd ensure-parser-p1 parse [
      ignore <parse-result>  
    ] [
@@ -139,7 +171,7 @@ M: ensure-parser parse ( state parser -- result )
 
 TUPLE: ensure-not-parser p1 ;
 
-M: ensure-not-parser parse ( state parser -- result )
+M: ensure-not-parser (parse) ( state parser -- result )
    dupd ensure-not-parser-p1 parse [
      drop f
    ] [
@@ -148,7 +180,7 @@ M: ensure-not-parser parse ( state parser -- result )
 
 TUPLE: action-parser p1 quot ;
 
-M: action-parser parse ( state parser -- result )
+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
@@ -165,12 +197,12 @@ M: action-parser parse ( state parser -- result )
 
 TUPLE: sp-parser p1 ;
 
-M: sp-parser parse ( state parser -- result )
+M: sp-parser (parse) ( state parser -- result )
   [ left-trim-slice ] dip sp-parser-p1 parse ;
 
 TUPLE: delay-parser quot ;
 
-M: delay-parser parse ( state parser -- result )
+M: delay-parser (parse) ( state parser -- result )
   delay-parser-quot call parse ;
 
 PRIVATE>

From f94c280e06250a21c1a9b180dcc745fa15376385 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Thu, 29 Nov 2007 12:49:51 +1300
Subject: [PATCH 12/14] Fix pl0 tests

---
 extra/peg/pl0/pl0-tests.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/extra/peg/pl0/pl0-tests.factor b/extra/peg/pl0/pl0-tests.factor
index e40c984660..cec7b24cd0 100644
--- a/extra/peg/pl0/pl0-tests.factor
+++ b/extra/peg/pl0/pl0-tests.factor
@@ -5,9 +5,9 @@ USING: kernel tools.test peg peg.pl0 ;
 IN: temporary
 
 { "abc" } [
-  "abc" 'ident' parse parse-result-ast 
+  "abc" ident parse parse-result-ast 
 ] unit-test
 
 { 55 } [
-  "55abc" 'number' parse parse-result-ast 
+  "55abc" number parse parse-result-ast 
 ] unit-test

From a4461ae40834ca48418f9117dca72b99c9535f76 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Thu, 29 Nov 2007 17:24:02 +1300
Subject: [PATCH 13/14] Tidy up ebnf compilation

---
 extra/peg/ebnf/ebnf.factor | 147 +++++++++++++++++++++----------------
 1 file changed, 85 insertions(+), 62 deletions(-)

diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index 4c4c8cd0cc..fea31ce94b 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel parser words arrays strings math.parser sequences quotations vectors namespaces peg ;
+USING: kernel parser words arrays strings math.parser sequences 
+       quotations vectors namespaces math assocs continuations peg ;
 IN: peg.ebnf
 
 TUPLE: ebnf-non-terminal symbol ;
@@ -23,74 +24,77 @@ C: <ebnf-rule> ebnf-rule
 C: <ebnf-action> ebnf-action
 C: <ebnf> ebnf
 
-GENERIC: ebnf-compile ( ast -- quot )
+SYMBOL: parsers
+SYMBOL: non-terminals
+SYMBOL: last-parser
 
-M: ebnf-terminal ebnf-compile ( ast -- quot )
+: reset-parser-generation ( -- ) 
+  V{ } clone parsers set 
+  H{ } clone non-terminals set 
+  f last-parser set ;
+
+: store-parser ( parser -- number )
+  parsers get [ push ] keep length 1- ;
+
+: get-parser ( index -- parser )
+  parsers get nth ;
+  
+: non-terminal-index ( name -- number )
+  dup non-terminals get at [
+    nip
+  ] [
+    f store-parser [ swap non-terminals get set-at ] keep
+  ] if* ;
+
+GENERIC: (generate-parser) ( ast -- id )
+
+: generate-parser ( ast -- id )
+  (generate-parser) dup last-parser set ;
+
+M: ebnf-terminal (generate-parser) ( ast -- id )
+  ebnf-terminal-symbol token sp store-parser ;
+
+M: ebnf-non-terminal (generate-parser) ( ast -- id )
   [
-    ebnf-terminal-symbol , \ token , \ sp , 
-  ] [ ] make ;
+    ebnf-non-terminal-symbol dup non-terminal-index , 
+    parsers get , \ nth , [ search ] [ 2drop f ] recover , \ or ,
+  ] [ ] make delay sp store-parser ;
 
-M: ebnf-non-terminal ebnf-compile ( ast -- quot )
-  [
-    [ ebnf-non-terminal-symbol , \ search , \ execute , \ sp , ] [ ] make 
-    , \ delay ,
-  ] [ ] make ;
+M: ebnf-choice (generate-parser) ( ast -- id )
+  ebnf-choice-options [
+    generate-parser get-parser 
+  ] map choice store-parser ;
 
-M: ebnf-choice ebnf-compile ( ast -- quot )
-  [
-    [
-      ebnf-choice-options [
-        ebnf-compile ,
-      ] each
-    ] { } make ,
-    [ call ] , \ map , \ choice , 
-  ] [ ] make ;
+M: ebnf-sequence (generate-parser) ( ast -- id )
+  ebnf-sequence-elements [
+    generate-parser get-parser
+  ] map seq store-parser ;
 
-M: ebnf-sequence ebnf-compile ( ast -- quot )
-  [
-    [
-      ebnf-sequence-elements [
-        ebnf-compile ,
-      ] each
-    ] { } make ,
-    [ call ] , \ map , \ seq , 
-  ] [ ] make ;
+M: ebnf-repeat0 (generate-parser) ( ast -- id )
+  ebnf-repeat0-group generate-parser get-parser repeat0 store-parser ;
 
-M: ebnf-repeat0 ebnf-compile ( ast -- quot )
-  [
-    ebnf-repeat0-group ebnf-compile % \ repeat0 , 
-  ] [ ] make ;
+M: ebnf-optional (generate-parser) ( ast -- id )
+  ebnf-optional-elements generate-parser get-parser optional store-parser ;
 
-M: ebnf-optional ebnf-compile ( ast -- quot )
-  [
-    ebnf-optional-elements ebnf-compile % \ optional , 
-  ] [ ] make ;
+M: ebnf-rule (generate-parser) ( ast -- id )
+  dup ebnf-rule-symbol non-terminal-index swap 
+  ebnf-rule-elements generate-parser get-parser ! nt-id body
+  swap [ parsers get set-nth ] keep ;
 
-M: ebnf-rule ebnf-compile ( ast -- quot )
-  [
-    dup ebnf-rule-symbol , \ in , \ get , \ create , 
-    ebnf-rule-elements ebnf-compile , \ define-compound , 
-  ] [ ] make ;
+M: ebnf-action (generate-parser) ( ast -- id )
+  ebnf-action-word search 1quotation 
+  last-parser get swap action generate-parser ;
 
-M: ebnf-action ebnf-compile ( ast -- quot )
-  [
-    ebnf-action-word search 1quotation , \ action , 
-  ] [ ] make ;
+M: vector (generate-parser) ( ast -- id )
+  [ generate-parser ] map peek ;
 
-M: vector ebnf-compile ( ast -- quot )
-  [
-    [ ebnf-compile % ] each 
-  ] [ ] make ;
+M: f (generate-parser) ( ast -- id )
+  drop last-parser get ;
 
-M: f ebnf-compile ( ast -- quot )
-  drop [ ] ;
-
-M: ebnf ebnf-compile ( ast -- quot )
-  [
-    ebnf-rules [
-      ebnf-compile %
-    ] each 
-  ] [ ] make ;
+M: ebnf (generate-parser) ( ast -- id )
+  ebnf-rules [
+    generate-parser 
+  ] map peek ;
 
 DEFER: 'rhs'
 
@@ -124,7 +128,12 @@ DEFER: 'choice'
   3array seq [ first <ebnf-optional> ] action ;
 
 : 'sequence' ( -- parser )
-  'element' sp 'group' sp 'repeat0' sp 'optional' sp 4array choice 
+  [ 
+    'element' sp ,
+    'group' sp , 
+    'repeat0' sp ,
+    'optional' sp , 
+   ] { } make  choice  
    repeat1 [ 
      dup length 1 = [ first ] [ <ebnf-sequence> ] if
    ] action ;  
@@ -133,12 +142,12 @@ DEFER: 'choice'
   'sequence' sp "|" token sp list-of [ 
     dup length 1 = [ first ] [ <ebnf-choice> ] if
    ] action ;
-  
+
 : 'action' ( -- parser )
   "=>" token hide
   [ blank? ] satisfy ensure-not [ drop t ] satisfy 2array seq [ first ] action repeat1 [ >string ] action sp
   2array seq [ first <ebnf-action> ] action ;
-
+  
 : 'rhs' ( -- parser )
   'choice' 'action' sp optional 2array seq ;
  
@@ -153,7 +162,21 @@ DEFER: 'choice'
 
 : ebnf>quot ( string -- quot )
   'ebnf' parse [
-     parse-result-ast ebnf-compile  
+     parse-result-ast [
+         reset-parser-generation
+         generate-parser drop
+         [
+             non-terminals get
+             [
+               get-parser [
+                 swap , \ in , \ get , \ create ,
+                 1quotation , \ define-compound , 
+               ] [
+                 drop
+               ] if*
+             ] assoc-each
+         ] [ ] make
+     ] with-scope
    ] [
     f
    ] if* ;

From b51e4f642eb9e2929a093fe5224044bb72540248 Mon Sep 17 00:00:00 2001
From: Chris Double <chris.double@double.co.nz>
Date: Thu, 29 Nov 2007 17:41:58 +1300
Subject: [PATCH 14/14] Fix broken ebnf actions

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

diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index fea31ce94b..e55ee9d852 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -83,7 +83,7 @@ M: ebnf-rule (generate-parser) ( ast -- id )
 
 M: ebnf-action (generate-parser) ( ast -- id )
   ebnf-action-word search 1quotation 
-  last-parser get swap action generate-parser ;
+  last-parser get get-parser swap action store-parser ;
 
 M: vector (generate-parser) ( ast -- id )
   [ generate-parser ] map peek ;