Ideally, you'd want:
expr : bin_op_2 { $item[1] }
bin_op_2 : bin_op_2 /[+-]/ bin_op_1 { [ @item[2, 1, 3] ] }
| bin_op_1 { $item[1] }
bin_op_1 : bin_op_1 /[*\\\/%]/ term { [ @item[2, 1, 3] ] }
| term { $item[1] }
but the module doesn't allow left-recursive grammars. Here's how left-recursion is removed:
bin_op_2 : bin_op_1 bin_op_2_(s?)
{ treeify($item[1], map { @$_ } @{$item[2]}); }
bin_op_1 : term bin_op_1_(s?)
{ treeify($item[1], map { @$_ } @{$item[2]}); }
bin_op_2_ : /[+-]/ bin_op_1 { [ $item[1], $item[2] ] }
bin_op_1_ : /[*\\\/%]/ term { [ $item[1], $item[2] ] }
Since it returns a list, we need to spend extra effort making it into a tree again. treeify is defined as:
sub treeify {
my $t = shift;
$t = [ shift, $t, shift ]
while @_;
return $t;
}
Parse::RecDescent provides a shortcut in the form of <leftop>:
# Lowest precedence.
bin_op_2 : <leftop: bin_op_1 SUM bin_op_1 >
{ treeify(@{$item[1]}); }
bin_op_1 : <leftop: term PROD term >
{ treeify(@{$item[1]}); }
# Highest precedence.
SUM : '+' | '-'
PROD : '*' | '/' | '\\' | '%'
Here's the final product (with a couple of operators added for demonstration purposes):
use strict;
use warnings;
use Data::Dumper ();
use Parse::RecDescent ();
my $grammar = <<'__EOI__';
{
use strict;
use warnings;
sub treeify {
my $t = shift;
$t = [ shift, $t, shift ]
while @_;
return $t;
}
}
parse : expr EOF { $item[1] }
expr : assign { $item[1] }
# Lowest precedence.
assign : IDENT '=' assign { [ $item[2], $item[1], $item[3] ] }
| log_or { $item[1] }
log_or : <leftop: log_and LOG_OR log_and > {treeify(@{$item[1]})}
log_and : <leftop: sum LOG_AND sum > {treeify(@{$item[1]})}
sum : <leftop: prod SUM prod > {treeify(@{$item[1]})}
prod : <leftop: term PROD term > {treeify(@{$item[1]})}
# Highest precedence.
term : '(' expr ')' { $item[2] }
| NUMBER { [ $item[0], $item[1] ] }
# Tokens
NUMBER : /\d+/
IDENT : /\w+/
LOG_OR : '||'
LOG_AND : '&&'
SUM : '+' | '-'
PROD : '*' | '/' | '\\' | '%'
EOF : /^\Z/
__EOI__
# $::RD_HINT = 1;
# $::RD_TRACE = 1;
my $parser = Parse::RecDescent->new($grammar)
or die("Bad grammar\n");
foreach (
'1*2*3',
'1%2*3',
'1+2*3',
'a=b=c=1',
) {
print(Data::Dumper->Dump([ $parser->parse($_) ],
[ $_ ]));
print("\n");
}
You could use the following for assignment, but I think it's slower:
sub treeify_r {
my $t = pop;
$t = [ pop, pop, $t ]
while @_;
return $t;
}
assign : <rightop: IDENT ASSIGN assign >
{ treeify_r(@{$item[1]}); }
ASSIGN : '='
Update: Changed
expr : bin_op_5 { $item[1] }
to
expr : assign { $item[1] }
Changed
'\'
to
'\\'
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.