Precompiled grammars and Start-up Actions
[email protected] (Thomas Klausner) Thu, 17 Apr 2003 11:33:31 +0200
| Newsgroups | perl.recdescent |
|---|---|
| Message-ID | <[email protected]> |
Hi!
I recently had a problem with Parse::RecDescent, and I don't know if it is
some sort of bug, or if I'm doing something completly stupid (which might be
the case, as I do not have that much experience with writing parsers)
In a startup action, I define an array. Then, while parsing, I sometimes
want to add stuff to this array (because I do not need to parse the whole
input; I'm only after some bits of info hidden inside (i.e. i'm using
Parse::RecDescent as RegExs on steroids, or Perl6 rules ...)
Everything works fine, until I put the grammar into a precomplied grammar
(i.e. perl -MParse::RecDescent - grammar Yet::Another::Grammar)
If I now run the parser more than once in the same script, the array is not
reset. i.e. after the second run, the array holds the result of the first
run and the second run. Which is total obvious, as in the compiled grammar,
the startup action is inserted at the beginning and gets executed once on
load of the grammar.
I attached some code that ilustrates my problem.
("grammar" is the grammar, "TestGrammer" is the precompiled grammer, and
"parse_rec.pl" is a script running the praser three times)
I hacked around this problem by explicitly resetting the array after each
parser run (@Yet::Another::Grammar::array=(); ), but that's rather
hackerish..
So: Am I doing something completly stupid?
How should I do it properly?
Or is this some sort of bug in Parse::RecDescet?
--
#!/usr/bin/perl http://domm.zsi.at
for(ref bless{},just'another'perl'hacker){s-:+-$"-g&&print$_.$/}
grammar
(text/plain, 144 B)
{my @result}
start: parse this
{$return=join(' ',@result)}
parse: "parse" {push(@result,$item[1])}
this: "this" {push(@result,$item[1])}
TestGrammar.pm
(application/x-perl, 24.6 KB)
package TestGrammar;
use Parse::RecDescent;
{ my $ERRORS;
package Parse::RecDescent::TestGrammar;
use strict;
use vars qw($skip $AUTOLOAD );
$skip = '\s*';
my @result;
{
local $SIG{__WARN__} = sub {0};
# PRETEND TO BE IN Parse::RecDescent NAMESPACE
*Parse::RecDescent::TestGrammar::AUTOLOAD = sub
{
no strict 'refs';
$AUTOLOAD =~ s/^Parse::RecDescent::TestGrammar/Parse::RecDescent/;
goto &{$AUTOLOAD};
}
}
push @Parse::RecDescent::TestGrammar::ISA, 'Parse::RecDescent';
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::TestGrammar::this
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"this"};
Parse::RecDescent::_trace(q{Trying rule: [this]},
Parse::RecDescent::_tracefirst($_[1]),
q{this},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: ['this']},
Parse::RecDescent::_tracefirst($_[1]),
q{this},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{this});
%item = (__RULE__ => q{this});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: ['this']},
Parse::RecDescent::_tracefirst($text),
q{this},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "this"; 1 } and
substr($text,0,length($_tok)) eq $_tok and
do { substr($text,0,length($_tok)) = ""; 1; }
)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<<Didn't match terminal>>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $_tok . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING1__}=$_tok;
Parse::RecDescent::_trace(q{Trying action},
Parse::RecDescent::_tracefirst($text),
q{this},
$tracelevel)
if defined $::RD_TRACE;
$_tok = ($_noactions) ? 0 : do {push(@result,$item[1])};
unless (defined $_tok)
{
Parse::RecDescent::_trace(q{<<Didn't match action>> (return value: [undef])})
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched action<< (return value: [}
. $_tok . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $_tok;
$item{__ACTION1__}=$_tok;
Parse::RecDescent::_trace(q{>>Matched production: ['this']<<},
Parse::RecDescent::_tracefirst($text),
q{this},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<<Didn't match rule>>},
Parse::RecDescent::_tracefirst($_[1]),
q{this},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{this},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{this},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{this},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::TestGrammar::start
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"start"};
Parse::RecDescent::_trace(q{Trying rule: [start]},
Parse::RecDescent::_tracefirst($_[1]),
q{start},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [parse this]},
Parse::RecDescent::_tracefirst($_[1]),
q{start},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{start});
%item = (__RULE__ => q{start});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [parse]},
Parse::RecDescent::_tracefirst($text),
q{start},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::TestGrammar::parse($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<<Didn't match subrule: [parse]>>},
Parse::RecDescent::_tracefirst($text),
q{start},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [parse]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{start},
$tracelevel)
if defined $::RD_TRACE;
$item{q{parse}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying subrule: [this]},
Parse::RecDescent::_tracefirst($text),
q{start},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{this})->at($text);
unless (defined ($_tok = Parse::RecDescent::TestGrammar::this($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<<Didn't match subrule: [this]>>},
Parse::RecDescent::_tracefirst($text),
q{start},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [this]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{start},
$tracelevel)
if defined $::RD_TRACE;
$item{q{this}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying action},
Parse::RecDescent::_tracefirst($text),
q{start},
$tracelevel)
if defined $::RD_TRACE;
$_tok = ($_noactions) ? 0 : do {$return=join(' ',@result)};
unless (defined $_tok)
{
Parse::RecDescent::_trace(q{<<Didn't match action>> (return value: [undef])})
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched action<< (return value: [}
. $_tok . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $_tok;
$item{__ACTION1__}=$_tok;
Parse::RecDescent::_trace(q{>>Matched production: [parse this]<<},
Parse::RecDescent::_tracefirst($text),
q{start},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<<Didn't match rule>>},
Parse::RecDescent::_tracefirst($_[1]),
q{start},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{start},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{start},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{start},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::TestGrammar::parse
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"parse"};
Parse::RecDescent::_trace(q{Trying rule: [parse]},
Parse::RecDescent::_tracefirst($_[1]),
q{parse},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: ['parse']},
Parse::RecDescent::_tracefirst($_[1]),
q{parse},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{parse});
%item = (__RULE__ => q{parse});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: ['parse']},
Parse::RecDescent::_tracefirst($text),
q{parse},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "parse"; 1 } and
substr($text,0,length($_tok)) eq $_tok and
do { substr($text,0,length($_tok)) = ""; 1; }
)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<<Didn't match terminal>>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $_tok . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING1__}=$_tok;
Parse::RecDescent::_trace(q{Trying action},
Parse::RecDescent::_tracefirst($text),
q{parse},
$tracelevel)
if defined $::RD_TRACE;
$_tok = ($_noactions) ? 0 : do {push(@result,$item[1])};
unless (defined $_tok)
{
Parse::RecDescent::_trace(q{<<Didn't match action>> (return value: [undef])})
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched action<< (return value: [}
. $_tok . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $_tok;
$item{__ACTION1__}=$_tok;
Parse::RecDescent::_trace(q{>>Matched production: ['parse']<<},
Parse::RecDescent::_tracefirst($text),
q{parse},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<<Didn't match rule>>},
Parse::RecDescent::_tracefirst($_[1]),
q{parse},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{parse},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{parse},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{parse},
$tracelevel)
}
$_[1] = $text;
return $return;
}
}
package TestGrammar; sub new { my $self = bless( {
'_AUTOTREE' => undef,
'rules' => {
'this' => bless( {
'impcount' => 0,
'line' => '10',
'prods' => [
bless( {
'dircount' => 0,
'uncommit' => undef,
'patcount' => 0,
'strcount' => 1,
'number' => 0,
'error' => undef,
'line' => undef,
'items' => [
bless( {
'description' => '\'this\'',
'line' => '10',
'pattern' => 'this',
'hashname' => '__STRING1__',
'lookahead' => 0
}, 'Parse::RecDescent::InterpLit' ),
bless( {
'line' => '10',
'code' => '{push(@result,$item[1])}',
'hashname' => '__ACTION1__',
'lookahead' => 0
}, 'Parse::RecDescent::Action' )
],
'actcount' => 1
}, 'Parse::RecDescent::Production' )
],
'calls' => [],
'opcount' => 0,
'changed' => 0,
'vars' => '',
'name' => 'this'
}, 'Parse::RecDescent::Rule' ),
'start' => bless( {
'impcount' => 0,
'line' => '4',
'prods' => [
bless( {
'dircount' => 0,
'uncommit' => undef,
'patcount' => 0,
'strcount' => 0,
'number' => 0,
'error' => undef,
'line' => undef,
'items' => [
bless( {
'line' => '4',
'subrule' => 'parse',
'argcode' => undef,
'implicit' => undef,
'matchrule' => 0,
'lookahead' => 0
}, 'Parse::RecDescent::Subrule' ),
bless( {
'line' => '4',
'subrule' => 'this',
'argcode' => undef,
'implicit' => undef,
'matchrule' => 0,
'lookahead' => 0
}, 'Parse::RecDescent::Subrule' ),
bless( {
'line' => '5',
'code' => '{$return=join(\' \',@result)}',
'hashname' => '__ACTION1__',
'lookahead' => 0
}, 'Parse::RecDescent::Action' )
],
'actcount' => 1
}, 'Parse::RecDescent::Production' )
],
'calls' => [
'parse',
'this'
],
'opcount' => 0,
'changed' => 0,
'vars' => '',
'name' => 'start'
}, 'Parse::RecDescent::Rule' ),
'parse' => bless( {
'impcount' => 0,
'line' => '8',
'prods' => [
bless( {
'dircount' => 0,
'uncommit' => undef,
'patcount' => 0,
'strcount' => 1,
'number' => 0,
'error' => undef,
'line' => undef,
'items' => [
bless( {
'description' => '\'parse\'',
'line' => '8',
'pattern' => 'parse',
'hashname' => '__STRING1__',
'lookahead' => 0
}, 'Parse::RecDescent::InterpLit' ),
bless( {
'line' => '8',
'code' => '{push(@result,$item[1])}',
'hashname' => '__ACTION1__',
'lookahead' => 0
}, 'Parse::RecDescent::Action' )
],
'actcount' => 1
}, 'Parse::RecDescent::Production' )
],
'calls' => [],
'opcount' => 0,
'changed' => 0,
'vars' => '',
'name' => 'parse'
}, 'Parse::RecDescent::Rule' )
},
'namespace' => 'Parse::RecDescent::TestGrammar',
'_check' => {
'prevline' => '',
'prevcolumn' => '',
'thiscolumn' => '',
'prevoffset' => '',
'thisoffset' => '',
'itempos' => ''
},
'_AUTOACTION' => undef,
'localvars' => '',
'startcode' => ''
}, 'Parse::RecDescent' );
}
parse_rec.pl
(application/x-perl, 204 B)
#!/usr/bin/perl -w
use strict;
use Parse::RecDescent;
use TestGrammar;
my $parser=TestGrammar->new();
my $to_parse="parse this";
for (1..3) {
my $rv=$parser->start($to_parse);
print $rv,"\n";
}