Merge branch 'master' of git://double.co.nz/git/factor

extra/peg/ebnf/ebnf-tests.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 !
-USING: kernel tools.test peg peg.ebnf words ;
+USING: kernel tools.test peg peg.ebnf words math math.parser ;
 IN: peg.ebnf.tests
 
 { T{ ebnf-non-terminal f "abc" } } [
@@ -160,6 +160,13 @@ IN: peg.ebnf.tests
   "1-1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] | '1' '-' '1' => [[ drop "bar" ]] EBNF] call parse-result-ast
 ] unit-test
 
+{ 6 } [
+  "4+2" [EBNF num=[0-9] => [[ digit> ]] foo=num:x '+' num:y => [[ drop x y + ]] EBNF] call parse-result-ast
+] unit-test
+
+{ 6 } [
+  "4+2" [EBNF foo=[0-9]:x '+' [0-9]:y => [[ drop x digit> y digit> + ]] EBNF] call parse-result-ast
+] unit-test
 
 { V{ V{ 49 } "+" V{ 49 } } } [ 
   #! Test direct left recursion. 

extra/peg/ebnf/ebnf.factor

@@ -3,7 +3,7 @@
 USING: kernel compiler.units parser words arrays strings math.parser sequences 
        quotations vectors namespaces math assocs continuations peg
        peg.parsers unicode.categories multiline combinators.lib 
-       splitting accessors effects ;
+       splitting accessors effects sequences.deep ;
 IN: peg.ebnf
 
 TUPLE: ebnf-non-terminal symbol ;
@@ -102,7 +102,7 @@ C: <ebnf> ebnf
     "]" syntax ,
   ] seq* [ first >string <ebnf-range> ] action ;
  
-: 'element' ( -- parser )
+: ('element') ( -- parser )
   #! An element of a rule. It can be a terminal or a 
   #! non-terminal but must not be followed by a "=". 
   #! The latter indicates that it is the beginning of a
@@ -120,6 +120,12 @@ C: <ebnf> ebnf
     ] choice* ,
   ] seq* [ first ] action ;
 
+: 'element' ( -- parser )
+  [
+    [ ('element') , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action ,
+    ('element') ,
+  ] choice* ;
+
 DEFER: 'choice'
 
 : grouped ( quot suffix  -- parser )
@@ -227,15 +233,17 @@ GENERIC: (transform) ( ast -- parser )
 
 SYMBOL: parser
 SYMBOL: main
+SYMBOL: vars
 
 : transform ( ast -- object )
-  H{ } clone dup dup [ parser set swap (transform) main set ] bind ;
+  H{ } clone dup dup [ parser set V{ } vars set swap (transform) main set ] bind ;
 
 M: ebnf (transform) ( ast -- parser )
   rules>> [ (transform) ] map peek ;
   
 M: ebnf-rule (transform) ( ast -- parser )
-  dup elements>> (transform) [
+  dup elements>> 
+  vars get clone vars [ (transform) ] with-variable [
     swap symbol>> set
   ] keep ;
 
@@ -270,12 +278,26 @@ M: ebnf-repeat1 (transform) ( ast -- parser )
 M: ebnf-optional (transform) ( ast -- parser )
   transform-group optional ;
 
+: build-locals ( string vars -- string )
+  dup empty? [
+    drop
+  ] [
+    [
+      "USING: locals namespaces ;  [let* | " %
+      [ dup % " [ \"" % % "\" get ] " % ] each
+      " | " %
+      %  
+      " ] with-locals" %     
+    ] "" make 
+  ] if ;
+
 M: ebnf-action (transform) ( ast -- parser )
   [ parser>> (transform) ] keep
-  code>> string-lines [ parse-lines ] with-compilation-unit action ;
+  code>> vars get build-locals string-lines [ parse-lines ] with-compilation-unit action ;
 
 M: ebnf-var (transform) ( ast -- parser )
-  parser>> (transform) ;
+  [ parser>> (transform) ] [ name>> ] bi 
+  dup vars get push [ dupd set ] curry action ;
 
 M: ebnf-terminal (transform) ( ast -- parser )
   symbol>> token sp ;
@@ -303,7 +325,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
 : ebnf>quot ( string -- hashtable quot )
   'ebnf' parse check-parse-result 
   parse-result-ast transform dup dup parser [ main swap at compile ] with-variable
-  [ compiled-parse ] curry ;
+  [ compiled-parse ] curry [ with-scope ] curry ;
 
 : [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing