The included patch, a result of a bit of time with Devel::Profiler, speeds
up RecDescent by almost a factor of two on a grammar of mine by doing two
things:
(1) Caching Rule::expected() results;
(2) Inlining Expectation::is() and Expectation::at().
There's also a third change, removing a "my " where it gave me a syntax
error in precompiled grammars. I've got the latest Data::Dumper
installed, so I'm not sure why this would be a problem only for me.
Please let me know if this seems like a good idea, or if some of you see
other similar improvements.
/s
--- lib/Parse/RecDescent.pm Fri Jan 19 10:02:51 2001
+++ /usr/local/lib/perl5/site_perl/5.6.1/Parse/RecDescent.pm Thu Jul 4 12:10:13
+2002
@@ -78,7 +78,8 @@ sub Precompile
print OUT $self->_code();
print OUT "}\npackage $class; sub new { ";
- print OUT "my ";
+# SEAN: this is bad.
+# print OUT "my ";
require Data::Dumper;
print OUT Data::Dumper->Dump([$self], [qw(self)]);
@@ -260,6 +261,7 @@ sub leftmostsubrules($)
sub expected($)
{
my $self = shift;
+ return $self->{"expected"} if exists($self->{"expected"});
my @expected = ();
my $prod;
@@ -272,7 +274,7 @@ sub expected($)
}
}
- return join ', or ', @expected;
+ return $self->{"expected"} = join ', or ', @expected;
}
sub _contains($@)
@@ -297,6 +299,7 @@ sub addprod($$)
my ( $self, $prod ) = @_;
push @{$self->{"prods"}}, $prod;
$self->{"changed"} = 1;
+ delete $self->{"expected"};
$self->{"impcount"} = 0;
$self->{"opcount"} = 0;
$prod->{"number"} = $#{$self->{"prods"}};
@@ -382,7 +385,7 @@ sub ' . $namespace . '::' . $self->{"nam
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
- $expectation->at($_[1]);
+ $expectation->{lastunexpected} = $_[1];
'. ($parser->{_check}{thisoffset}?'
my $thisoffset;
tie $thisoffset, q{Parse::RecDescent::OffsetCounter}, \$text, $thisparser;
@@ -1099,8 +1102,9 @@ my $code = '
q{' . $rule->{name} . '})
if defined $::RD_TRACE;
$lastsep = "";
- $expectation->is(q{' . ($rule->hasleftmost($self) ? ''
- : $self->describe ) . '})->at($text);
+ $expectation->{lastexpected} = q{' . ($rule->hasleftmost($self) ? ''
+ : $self->describe ) . '};
+ $expectation->{lastunexpected} = $text;
' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) . '
' . ($self->{"lookahead"}<0?'if':'unless')
@@ -1170,8 +1174,9 @@ my $code = '
q{' . $rule->{name} . '})
if defined $::RD_TRACE;
$lastsep = "";
- $expectation->is(q{' . ($rule->hasleftmost($self) ? ''
- : $self->describe ) . '})->at($text);
+ $expectation->{lastexpected} = q{' . ($rule->hasleftmost($self) ? ''
+ : $self->describe ) . '};
+ $expectation->{lastunexpected} = $text;
' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) . '
' . ($self->{"lookahead"}<0?'if':'unless')
@@ -1239,8 +1244,9 @@ my $code = '
q{' . $rule->{name} . '})
if defined $::RD_TRACE;
$lastsep = "";
- $expectation->is(q{' . ($rule->hasleftmost($self) ? ''
- : $self->describe ) . '})->at($text);
+ $expectation->{lastexpected} = q{' . ($rule->hasleftmost($self) ? ''
+ : $self->describe ) . '};
+ $expectation->{lastunexpected} = $text;
' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) . '
' . ($self->{"lookahead"}<0?'if':'unless')
@@ -1321,9 +1327,10 @@ sub code($$$$)
q{' . $rule->{"name"} . '})
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
- $expectation->is(' . ($rule->hasleftmost($self) ? 'q{}'
- # WAS : 'qq{'.$self->describe.'}' ) . ')->at($text);
- : 'q{'.$self->describe.'}' ) . ')->at($text);
+ $expectation->{lastexpected} = ' . ($rule->hasleftmost($self) ? 'q{}'
+ # WAS : 'qq{'.$self->describe.'}' ) . ')->($text);
+ : 'q{'.$self->describe.'}' ) . ';
+ $expectation->{lastunexpected} = $text;
' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' )
. ($self->{"lookahead"}<0?'if':'unless')
. ' (defined ($_tok = '
@@ -1434,9 +1441,9 @@ sub code($$$$)
Parse::RecDescent::_tracefirst($text),
q{' . $rule->{"name"} . '})
if defined $::RD_TRACE;
- $expectation->is(' . ($rule->hasleftmost($self) ? 'q{}'
- # WAS : 'qq{'.$self->describe.'}' ) . ')->at($text);
- : 'q{'.$self->describe.'}' ) . ')->at($text);
+ $expectation->{lastexpected} = ' . ($rule->hasleftmost($self) ? 'q{}'
+ : 'q{'.$self->describe.'}' ) . ';
+ $expectation->{lastunexpected} = $text;
' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) .'
unless (defined ($_tok = $thisparser->_parserepeat($text, '
. $self->callsyntax($namespace.'::')
@@ -1529,9 +1536,9 @@ sub code($$$$)
Parse::RecDescent::_tracefirst($text),
q{' . $rule->{"name"} . '})
if defined $::RD_TRACE;
- $expectation->is(' . ($rule->hasleftmost($self) ? 'q{}'
- # WAS : 'qq{'.$self->describe.'}' ) . ')->at($text);
- : 'q{'.$self->describe.'}' ) . ')->at($text);
+ $expectation->{lastexpected} = ' . ($rule->hasleftmost($self) ? 'q{}'
+ : 'q{'.$self->describe.'}' ) . ';
+ $expectation->{lastunexpected} = $text;
$_tok = undef;
OPLOOP: while (1)
@@ -1642,16 +1649,6 @@ sub new ($)
};
}
-sub is ($$)
-{
- $_[0]->{lastexpected} = $_[1]; return $_[0];
-}
-
-sub at ($$)
-{
- $_[0]->{lastunexpected} = $_[1]; return $_[0];
-}
-
sub failed ($)
{
return unless $_[0]->{lastexpected};
@@ -2767,7 +2764,8 @@ sub _parserepeat($$$$$$$$$$) # RETURNS A
my $reps;
for ($reps=0; $reps<$max;)
{
- $_[6]->at($text); # $_[6] IS $expectation FROM CALLER
+ # $_[6] IS $expectation FROM CALLER
+ $_[6]->{lastunexpected} = ($text);
my $_savetext = $text;
my $prevtextlen = length $text;
my $_tok;
