Changeset 22909 for src

Timestamp:

11/07/08 05:20:25 (2 months ago)

Author:

lwall

Message:

[gimme5] move more boilerplate out of normal matcher methods

Location:

src/perl6

Files:

• Cursor.pmc (modified) (7 diffs)
• gimme5 (modified) (9 diffs)

src/perl6/Cursor.pmc

@@ -292 +292 @@
                     for my $method (sort $class->meta->get_method_list) {
                         if (substr($method,0,$protolen) eq $protopat) {
-                            my $callname = $class . '::' . $method;
+                            next if substr($method,-6,6) eq '__PEEK';
+                            my $callname = $class . '::' . $method . '__PEEK';
                             my $peeklex = $peek->$callname();
                             if ($peeklex and $peeklex->{PATS}) {
@@ -918 +919 @@
 };
 
+sub ${mangle}__PEEK { \$_[0]->_AUTOLEXpeek('$mangle',\$retree) }
 sub $mangle {
     my \$self = shift;
     local \$CTX = \$self->callm() if \$::DEBUG & DEBUG::trace_call;
-    if (\$self->{_peek}) {
-        return \$self->_AUTOLEXpeek('$mangle',\$retree)
-    }
     my %args = \@_;
     my \$sym = \$args{sym} // q$sym;
@@ -1285 +1284 @@
 }
 
+sub ws__PEEK { ''; }
 sub ws {
     my $self = shift;
 
-    if ($self->{_peek}) {
-        return;
-    }
     local $CTX = $self->callm() if $DEBUG & DEBUG::trace_call;
     my @stub = return $self if exists $::MEMOS[$self->{_pos}]{ws};
@@ -1356 +1353 @@
     local $CTX = $self->callm($names ? "@$names" : "") if $DEBUG & DEBUG::trace_call;
     lazymap(sub { $self->cursor_bind($names, $_[0])->retm() },
-        $block->($self));
+        $block->($self->cursor_fresh()));
 }
 
@@ -1364 +1361 @@
 
     local $CTX = $self->callm($names ? "@$names" : "") if $DEBUG & DEBUG::trace_call;
-    my ($var) = $block->($self) or return ();
+    my ($var) = $block->($self->cursor_fresh()) or return ();
     $self->cursor_bind($names, $var)->retm();
 }
@@ -2108 +2105 @@
             {
                 local $PREFIX = "";
+                $name .= '__PEEK';
                 $lexer = eval { $C->cursor_peek->$name() };
             }
@@ -2147 +2145 @@
             }
             else {
+                $name .= '__PEEK';
                 my $lexer = $C->cursor_peek->$name($re);
                 my @pat = @{$lexer->{PATS}};

src/perl6/gimme5

@@ -90 +90 @@
         $f =~ s!^(".*?")!!                      and $t .= $1, next;
         $f =~ s!^ self\.WHAT!!                  and $t .= ' (ref($self)||$self)', next;
-        $f =~ s!^self\.pos!!                    and $t .= '$self->{_pos}', next;
-        $f =~ s!^\$¢\.pos!!                     and $t .= '$C->{_pos}', next;
+        $f =~ s!^ self\.pos\b!!                 and $t .= ' $self->{_pos}', next;
+        $f =~ s!^\$¢\.pos\b!!                   and $t .= '$C->{_pos}', next;
         $f =~ s!^//!!                           and $t .= "//", next;   # default operator
         $f =~ s!^m:p5(\W)(.+?)\1/!!             and $t .= "m$1$2$1", next;
@@ -138 +138 @@
         $f =~ s/^\.pos\b//                      and $t .= qq/->{_pos}/, next;
         $f =~ s/^self\.orig\b//                 and $t .= qq/\$::ORIG/, next;
+        $f =~ s!^\.pos\b!!                      and $t .= '->{_pos}', next;
+        $f =~ s/^(\$\w+)\.pos//                 and $t .= $1 . '->{_pos}', next;
         $f =~ s/^(\$\w+)\.//                    and $t .= qq/$1->/, next;
         $f =~ s/^(\$\w+)\(/(/                   and $t .= qq/$1->/, next;
@@ -169 +171 @@
         $f =~ s/^\bTrue\b//                     and $t .= qq/1/, next;
         $f =~ s/^\bFalse\b//                    and $t .= qq/0/, next;
-        $f =~ s/^([^\$])self\.//                and $t .= qq/$1\$self->/, next;
-        $f =~ s/^([^\$])self\b//                and $t .= qq/$1\$self/, next;
+        $f =~ s/^\$?self\.pos\b//               and $t .= qq/\$self->{_pos}/, next;
+        $f =~ s/^\$?self\.//                    and $t .= qq/\$self->/, next;
+        $f =~ s/^\$?self\b//                    and $t .= qq/\$self/, next;
         $f =~ s/^\.panic//                      and $t .= qq/->panic/, next;
         $f =~ s/^(\s)\+&(\s)/$2/                and $t .= qq/$1&/, next;
@@ -317 +320 @@
             $protosig{$name} = $5;
             $out .= <<"END";
+sub ${name}__PEEK { \$_[0]->_AUTOLEXpeek('$name:*',\$retree); }
 sub $name {
     my \$self = shift;
@@ -322 +326 @@
 
     local \$CTX = \$self->callm() if \$::DEBUG & DEBUG::trace_call;
-    if (\$self->{_peek}) {
-        return \$self->_AUTOLEXpeek('$name:*',\$retree);
-    }
 
     my \$C = \$self;
@@ -586 +587 @@
             $re->remember_alts();
 
-            $out .= <<"END";
+            my $body = <<"END";
+sub$ws${NAME}__PEEK { <<PEEK>> }
 sub$ws$NAME {
     my \$self = shift;
 END
             if ($NEEDORIGARGS) {
-                $out .= "    my \@origargs = \@_;\n";
-            }
-            my $body = <<'END';
+                $body .= "    my \@origargs = \@_;\n";
+            }
+            $body .= <<'END';
     local $CTX = $self->callm() if $::DEBUG & DEBUG::trace_call;
-    if ($self->{_peek}) {
-        return <<PEEK>>
-    }
 <<DECL>>
 
@@ -646 +645 @@
             }
             else {
-                $body =~ s/<<PEEK>>/\$self->_AUTOLEXpeek('<<NAME>>',\$retree)/;
+                $body =~ s/<<PEEK>>/\$_[0]->_AUTOLEXpeek('<<NAME>>',\$retree)/;
             }
             $body =~ s/<<PKG>>/$PKG/g;
@@ -1557 +1556 @@
         $re = "\$C->_SUBSUME$ratchet([" .
             join(',', map {"'$_'"} @BINDINGS) .
-            "], sub {\n" . ::indent("my \$C = shift()->cursor_fresh;\n" . $re) . "\n})";
+            "], sub {\n" . ::indent("my \$C = shift;\n" . $re) . "\n})";
         @BINDINGS = ();
         $re;
@@ -1929 +1928 @@
     sub walk {
         my $self = shift;
+        local $NEEDMATCH = 0;
         my $rest = ::un6($$self{rest}) // '';
         my $name = $$self{name};