]> gitweb.factorcode.org Git - factor.git/commitdiff
update peg for [let change
authorJoe Groff <arcata@gmail.com>
Wed, 28 Oct 2009 03:29:20 +0000 (22:29 -0500)
committerJoe Groff <arcata@gmail.com>
Wed, 28 Oct 2009 03:29:20 +0000 (22:29 -0500)
basis/peg/ebnf/ebnf.factor
basis/peg/peg.factor

index 136007e7ce01114371181ff21cb133a346e88805..7c71a6a85f521c78059518c74bb28427f0909301 100644 (file)
@@ -445,16 +445,16 @@ M: ebnf-sequence build-locals ( code ast -- code )
       drop \r
     ] [ \r
       [\r
-        "FROM: locals => [let* ; FROM: sequences => nth ; [let* | " %\r
-          dup length swap [\r
-            dup ebnf-var? [\r
+        "FROM: locals => [let ; FROM: sequences => nth ; [let " %\r
+          dup length [\r
+            over ebnf-var? [\r
+              " " % # " over nth :> " %\r
               name>> % \r
-              " [ " % # " over nth ] " %\r
             ] [\r
               2drop\r
             ] if\r
           ] 2each\r
-          " " %\r
+          " " %\r
           %  \r
           " nip ]" %     \r
       ] "" make \r
@@ -463,9 +463,9 @@ M: ebnf-sequence build-locals ( code ast -- code )
 \r
 M: ebnf-var build-locals ( code ast -- )\r
   [\r
-    "FROM: locals => [let* ; FROM: kernel => dup nip ; [let* | " %\r
-    name>> % " [ dup ] " %\r
-    " " %\r
+    "FROM: locals => [let ; FROM: kernel => dup nip ; [let " %\r
+    " dup :> " % name>> %\r
+    " " %\r
     %  \r
     " nip ]" %     \r
   ] "" make ;\r
index 9e777b86afe384e976a3774e7ef77a0e4916134f..db45c3b766560b18fa1900e09d4ad5f2dfe7ce6c 100644 (file)
@@ -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 ;