From af9e27823a3840438ab1ba0b74a7bb899e38ff84 Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Sun, 30 Mar 2008 17:17:31 +1300
Subject: [PATCH] Add => action rule for an entire sequence

---
 extra/peg/ebnf/ebnf-tests.factor | 17 +++++++++++++++++
 extra/peg/ebnf/ebnf.factor       | 23 ++++++++++++++++++-----
 2 files changed, 35 insertions(+), 5 deletions(-)

diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor
index c2c0a50a59..7aa61e84da 100644
--- a/extra/peg/ebnf/ebnf-tests.factor
+++ b/extra/peg/ebnf/ebnf-tests.factor
@@ -144,6 +144,23 @@ IN: peg.ebnf.tests
   "Z" [EBNF foo=[^A-Z] EBNF] call  
 ] unit-test
 
+{ V{ "1" "+" "foo" } } [
+  "1+1" [EBNF foo='1' '+' '1' [[ drop "foo" ]] EBNF] call parse-result-ast
+] unit-test
+
+{ "foo" } [
+  "1+1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] EBNF] call parse-result-ast
+] unit-test
+
+{ "foo" } [
+  "1+1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] | '1' '-' '1' => [[ drop "bar" ]] EBNF] call parse-result-ast
+] unit-test
+
+{ "bar" } [
+  "1-1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] | '1' '-' '1' => [[ drop "bar" ]] EBNF] call parse-result-ast
+] unit-test
+
+
 { V{ V{ 49 } "+" V{ 49 } } } [ 
   #! Test direct left recursion. 
   #! Using packrat, so first part of expr fails, causing 2nd choice to be used  
diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index c1e2ce8546..af61c3aae0 100644
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -111,7 +111,10 @@ C: <ebnf> ebnf
       'range-parser' ,
       'any-character' ,
     ] choice* ,
-    "=" syntax ensure-not ,
+    [
+      "=" syntax ensure-not ,
+      "=>" syntax ensure ,
+    ] choice* ,
   ] seq* [ first ] action ;
 
 DEFER: 'choice'
@@ -176,7 +179,10 @@ DEFER: 'choice'
     'repeat0' sp ,
     'repeat1' sp ,
     'optional' sp , 
-  ] choice* ;  
+  ] choice* ;
+
+: 'action' ( -- parser )
+   "[[" 'factor-code' "]]" syntax-pack ;
 
 : 'sequence' ( -- parser )
   #! A sequence of terminals and non-terminals, including
@@ -184,15 +190,21 @@ DEFER: 'choice'
   [
     [ 
       ('sequence') ,
-      "[[" 'factor-code' "]]" syntax-pack ,
+      'action' ,
     ] seq* [ first2 <ebnf-action> ] action ,
     ('sequence') ,
   ] choice* repeat1 [ 
      dup length 1 = [ first ] [ <ebnf-sequence> ] if
   ] action ;
+
+: 'actioned-sequence' ( -- parser )
+  [
+    [ 'sequence' , "=>" syntax , 'action' , ] seq* [ first2 <ebnf-action> ] action ,
+    'sequence' ,
+  ] choice* ;
   
 : 'choice' ( -- parser )
-  'sequence' sp "|" token sp list-of [ 
+  'actioned-sequence' sp "|" token sp list-of [ 
     dup length 1 = [ first ] [ <ebnf-choice> ] if
   ] action ;
  
@@ -200,7 +212,8 @@ DEFER: 'choice'
   [
     'non-terminal' [ symbol>> ] action  ,
     "=" syntax  ,
-    'choice'  ,
+    ">" token ensure-not ,
+    'choice' ,
   ] seq* [ first2 <ebnf-rule> ] action ;
 
 : 'ebnf' ( -- parser )