From f1d9201cb2e77279db3529668de9c809ba0d280c Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 27 Oct 2009 22:29:20 -0500
Subject: [PATCH] update peg for [let change

---
 basis/peg/ebnf/ebnf.factor | 16 +++++++-------
 basis/peg/peg.factor       | 44 ++++++++++++++------------------------
 2 files changed, 24 insertions(+), 36 deletions(-)

diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor
index 136007e7ce..7c71a6a85f 100644
--- a/basis/peg/ebnf/ebnf.factor
+++ b/basis/peg/ebnf/ebnf.factor
@@ -445,16 +445,16 @@ M: ebnf-sequence build-locals ( code ast -- code )
       drop 
     ] [ 
       [
-        "FROM: locals => [let* ; FROM: sequences => nth ; [let* | " %
-          dup length swap [
-            dup ebnf-var? [
+        "FROM: locals => [let ; FROM: sequences => nth ; [let " %
+          dup length [
+            over ebnf-var? [
+              " " % # " over nth :> " %
               name>> % 
-              " [ " % # " over nth ] " %
             ] [
               2drop
             ] if
           ] 2each
-          " | " %
+          " " %
           %  
           " nip ]" %     
       ] "" make 
@@ -463,9 +463,9 @@ M: ebnf-sequence build-locals ( code ast -- code )
 
 M: ebnf-var build-locals ( code ast -- )
   [
-    "FROM: locals => [let* ; FROM: kernel => dup nip ; [let* | " %
-    name>> % " [ dup ] " %
-    " | " %
+    "FROM: locals => [let ; FROM: kernel => dup nip ; [let " %
+    " dup :> " % name>> %
+    " " %
     %  
     " nip ]" %     
   ] "" make ;
diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor
index 9e777b86af..db45c3b766 100644
--- a/basis/peg/peg.factor
+++ b/basis/peg/peg.factor
@@ -172,9 +172,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
   l lrstack get (setup-lr) ;
 
 :: lr-answer ( r p m -- ast )
-  [let* |
-          h [ m ans>> head>> ]
-        |
+    m ans>> head>> :> h
     h rule-id>> r rule-id eq? [
       m ans>> seed>> m (>>ans)
       m ans>> failed? [
@@ -184,14 +182,11 @@ TUPLE: peg-head rule-id involved-set eval-set ;
       ] if
     ] [
       m ans>> seed>>
-    ] if
-  ] ; inline
+    ] if ; inline
 
 :: recall ( r p -- memo-entry )
-  [let* |
-          m [ p r rule-id memo ]
-          h [ p heads at ]
-        |
+    p r rule-id memo :> m
+    p heads at :> h
     h [
       m r rule-id h involved-set>> h rule-id>> suffix member? not and [
         fail p memo-entry boa
@@ -207,15 +202,12 @@ TUPLE: peg-head rule-id involved-set eval-set ;
       ] if
     ] [
       m
-    ] if
-  ] ; inline
+    ] if ; inline
 
 :: apply-non-memo-rule ( r p -- ast )
-  [let* |
-          lr  [ fail r rule-id f lrstack get left-recursion boa ]
-          m   [ lr lrstack set lr p memo-entry boa dup p r rule-id set-memo ]
-          ans [ r eval-rule ]
-        |
+    fail r rule-id f lrstack get left-recursion boa :> lr
+    lr lrstack set lr p memo-entry boa dup p r rule-id set-memo :> m
+    r eval-rule :> ans
     lrstack get next>> lrstack set
     pos get m (>>pos)
     lr head>> [
@@ -226,8 +218,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
     ] [
       ans m (>>ans)
       ans
-    ] if
-  ] ; inline
+    ] if ; inline
 
 : apply-memo-rule ( r m -- ast )
   [ ans>> ] [ pos>> ] bi pos set
@@ -622,20 +613,17 @@ PRIVATE>
 ERROR: parse-failed input word ;
 
 SYNTAX: PEG:
-  (:)
-  [let | effect [ ] def [ ] word [ ] |
+    (:) :> effect :> def :> word
     [
       [
-        [let | compiled-def [ def call compile ] |
-          [
-            dup compiled-def compiled-parse
-            [ ast>> ] [ word parse-failed ] ?if
-          ]
-          word swap effect define-declared
+        def call compile :> compiled-def
+        [
+          dup compiled-def compiled-parse
+          [ ast>> ] [ word parse-failed ] ?if
         ]
+        word swap effect define-declared
       ] with-compilation-unit
-    ] over push-all
-  ] ;
+    ] over push-all ;
 
 USING: vocabs vocabs.loader ;