Add parsing of proto regex statements to P6Grammar.

perl6 · Oct 18, 2009 · af458ca · af458ca
1 parent 5699969
commit af458ca
Show file tree

Hide file tree

Showing 2 changed files with 38 additions and 15 deletions.
diff --git a/src/Regex/P6Grammar/Actions.pm b/src/Regex/P6Grammar/Actions.pm
@@ -38,16 +38,36 @@ method regex_stmt($/, $key?) {
         @MODIFIERS.unshift(%h);
         return 0;
     }
-    my $rpast := $<nibbler>.ast;
-    my %capnames := Regex::P6Regex::Actions::capnames($rpast, 0);
-    %capnames{''} := 0;
-    $rpast := PAST::Regex.new(
-                  $rpast, 
-                  PAST::Regex.new( :pasttype('pass') ),
-                  :pasttype('concat'),
-                  :capnames(%capnames)
-    );
-    my $past := PAST::Block.new( $rpast, :name(~$<longname>), :blocktype('method'), :node($/) );
-    @MODIFIERS.shift;
+    my $name := ~$<longname>;
+    my $past;
+    if $<proto> {
+        $past := 
+            PAST::Block.new( :name($name),
+                PAST::Op.new( 
+                    PAST::Var.new( :name('self'), :scope('register') ),
+                    $name,
+                    :name('protoregex'),
+                    :pasttype('callmethod'),
+                ),
+                :blocktype('method'),
+                :lexical(0),
+                :node($/)
+            );
+    }
+    else {
+        my $rpast := $<nibbler>.ast;
+        my %capnames := Regex::P6Regex::Actions::capnames($rpast, 0);
+        %capnames{''} := 0;
+        $rpast := PAST::Regex.new(
+                      $rpast, 
+                      PAST::Regex.new( :pasttype('pass') ),
+                      :pasttype('concat'),
+                      :capnames(%capnames)
+        );
+        $past := PAST::Block.new( $rpast, :name($name), 
+                     :blocktype('method'), :node($/) );
+        @MODIFIERS.shift;
+    }
     make $past;
 }
+
diff --git a/src/Regex/P6Grammar/Grammar.pm b/src/Regex/P6Grammar/Grammar.pm
@@ -17,9 +17,12 @@ grammar Regex::P6Grammar::Grammar is Regex::P6Regex::Grammar;
     rule grammar_stmt { grammar <name> [ is <base=name> ]? ';' }
 
     rule regex_stmt {
-        $<sym>=[regex|token|rule]
-        <longname>
-        {*} #= open
-        '{'<nibbler>'}'
+        [
+        | $<proto>=[proto] [regex|token|rule] <longname> '{' '<...>' '}'
+        | $<sym>=[regex|token|rule]
+          <longname>
+          {*} #= open
+          '{'<nibbler>'}'
+        ]
     }