If executed from left-to-right,
4 - 5 + 6 = (4 - 5) + 6 = 5
If executed from right-to-left,
4 - 5 + 6 = 4 - (5 + 6) = -7
####
If executed from left-to-right,
4 ** 3 ** 2 = (4 ** 3) ** 2 = 4096
If executed from right-to-left,
4 ** 3 ** 2 = 4 ** (3 ** 2) = 262144
##
##
sum : sum /[+-]/ NUM
| NUM
##
##
pow : NUM '**' pow
| NUM
##
##
sum : sum '+' NUM { $item[1] + $item[3] }
| sum '-' NUM { $item[1] - $item[3] }
| NUM { $item[1] }
##
##
pow : NUM '**' sum { $item[1] ** $item[3] }
| NUM { $item[1] }
##
##
sum : sum /[+-]/ NUM { [ @item[2,1,3] ] }
| NUM { [ $item[1] ] }
##
##
pow : NUM '**' pow { [ @item[2,1,3] ] }
| NUM { [ $item[1] ] }
##
##
sum : NUM sum_ { [ $item[1], @{$item[2]} ] }
sum_ : /[+-]/ NUM sum_ { [ $item[1], $item[2], @{$item[3]} ] }
| { [] }
##
##
{
sub eval_sum {
my $acc = shift(@_);
while (@_) {
my $op = shift(@_);
if ($op eq '+') { $acc += shift(@_); }
elsif ($op eq '-') { $acc -= shift(@_); }
}
return $acc;
}
}
sum : NUM sum_ { eval_sum($item[1], @{$item[2]}) }
sum_ : /[+-]/ NUM sum_ { [ $item[1], $item[2], @{$item[3]} ] }
| { [] }
##
##
{
sub treeify {
my $t = shift(@_);
$t = [ shift(@_), $t, shift(@_) ]
while @_;
return $t;
}
}
sum : NUM sum_ { treeify($item[1], @{$item[2]}) }
sum_ : /[+-]/ NUM sum_ { [ $item[1], $item[2], @{$item[3]} ] }
| { [] }
##
##
{
sub eval_sum {
my $acc = shift(@_);
while (@_) {
my $op = shift(@_);
if ($op eq '+') { $acc += shift(@_); }
elsif ($op eq '-') { $acc -= shift(@_); }
}
return $acc;
}
}
sum : { eval_sum(@{$item[1]}) }
##
##
{
sub treeify {
my $t = shift(@_);
$t = [ shift(@_), $t, shift(@_) ]
while @_;
return $t;
}
}
sum : { treeify(@{$item[1]}) }
##
##
rule1: token rule2
rule2: token rule3
rule3: token
##
##
sum : NUM sum_[ $item[1] ]
sum_ : '+' NUM sum_[ $arg[0] + $item[2] ]
| '-' NUM sum_[ $arg[0] - $item[2] ]
| { $arg[0] }
##
##
sum : NUM sum_[ $item[1] ]
sum_ : '+' NUM sum_[ [ $item[1], $arg[0], $item[2] ] ]
| '-' NUM sum_[ [ $item[1], $arg[0], $item[2] ] ]
| { $arg[0] }
##
##
pow : NUM '**' pow
| NUM
##
##
pow : NUM pow_
pow_ : '**' pow
|
##
##
{
sub eval_pow {
my $acc = pop(@_);
while (@_) {
my $op = pop(@_);
$acc = pop(@_) ** $acc;
}
return $acc;
}
}
pow : NUM pow_ { eval_pow($item[1], @{$item[2]}) }
pow_ : '**' NUM pow_ { [ $item[1], $item[2], @{$item[3]} ] }
| { [] }
##
##
{
sub treeify_r {
my $t = pop;
$t = [ pop, pop, $t ]
while @_;
return $t;
}
}
pow : NUM pow_ { treeify_r($item[1], @{$item[2]}) }
pow_ : '**' NUM pow_ { [ $item[1], $item[2], @{$item[3]} ] }
| { [] }
##
##
{
sub eval_pow {
my $acc = pop(@_);
while (@_) {
my $op = pop(@_);
$acc = pop(@_) ** $acc;
}
return $acc;
}
}
pow : { eval_pow(@{$item[1]}) }
##
##
{
sub treeify_r {
my $t = pop;
$t = [ pop, pop, $t ]
while @_;
return $t;
}
}
pow : { treeify_r(@{$item[1]}) }
##
##
pow : NUM '**' pow { $item[1] ** $item[3] }
| NUM { $item[1] }
##
##
pow : NUM pow_
pow_ : '**' pow { <> ** $item[2] }
| { <> }
##
##
pow : NUM pow_[ $item[1] ]
pow_ : '**' pow { $arg[0] ** $item[2] }
| { $arg[0] }
##
##
pow : NUM pow_[ $item[1] ]
pow_ : '**' pow { [ $item[1], $arg[0], $item[2] ] }
| { $arg[0] }
##
##
Demonstrates left-associativity
4-5+6 = 5 got 5
(4-5)+6 = 5 got 5
4-(5+6) = -7 got -7
Demonstrates right-associativity
4**3**2 = 262144 got 262144
(4**3)**2 = 4096 got 4096
4**(3**2) = 262144 got 262144
##
##
use strict;
use warnings;
use Parse::RecDescent ();
my $grammar = <<'__END_OF_GRAMMAR__';
{
use strict;
use warnings;
}
parse : expr /^\Z/ { $item[1] }
# Just an alias
expr : pow
# vvv lowest precedence
# pow : sum '**' pow
# | sum
pow : sum pow_[ $item[1] ]
pow_ : '**' pow { $arg[0] ** $item[2] }
| { $arg[0] }
# sum : sum /[+-]/ term
# | term
sum : term sum_[ $item[1] ]
sum_ : '+' term sum_[ $arg[0] + $item[2] ]
| '-' term sum_[ $arg[0] - $item[2] ]
| { $arg[0] }
# ^^^ highest precedence
term : '(' expr ')' { $item[2] }
| /\d+/
__END_OF_GRAMMAR__
my $parser = Parse::RecDescent->new($grammar)
or die("Bad grammar\n");
foreach my $expr (
'4-5+6', # Demonstrates left-associativity
'(4-5)+6',
'4-(5+6)',
'4**3**2', # Demonstrates right-associativity
'(4**3)**2',
'4**(3**2)',
) {
my $expected = eval $expr;
my $got = $parser->parse($expr);
print("$expr = $expected got $got\n");
}
##
##
use strict;
use warnings;
use Parse::RecDescent ();
my $grammar = <<'__END_OF_GRAMMAR__';
{
use strict;
use warnings;
}
parse : expr /^\Z/ { $item[1] }
# Just an alias
expr : pow
# vvv lowest precedence
# pow : sum '**' pow
# | sum
pow : sum pow_[ $item[1] ]
pow_ : '**' pow { [ $item[1], $arg[0], $item[2] ] }
| { $arg[0] }
# sum : sum /[+-]/ term
# | term
sum : term sum_[ $item[1] ]
sum_ : /[+-]/ term sum_[ [ $item[1], $arg[0], $item[2] ] ]
| { $arg[0] }
# ^^^ highest precedence
term : '(' expr ')' { $item[2] }
| /\d+/ { [ @item ] }
__END_OF_GRAMMAR__
my $parser = Parse::RecDescent->new($grammar)
or die("Bad grammar\n");
my %eval = (
term => sub { $_[1] },
'+' => sub { eval_node($_[1]) + eval_node($_[2]) },
'-' => sub { eval_node($_[1]) - eval_node($_[2]) },
'**' => sub { eval_node($_[1]) ** eval_node($_[2]) },
);
sub eval_node {
my ($node) = @_;
$eval{$node->[0]}->(@$node);
}
foreach my $expr (
'4-5+6', # Demonstrates left-associativity
'(4-5)+6',
'4-(5+6)',
'4**3**2', # Demonstrates right-associativity
'(4**3)**2',
'4**(3**2)',
) {
my $expected = eval $expr;
my $tree = $parser->parse($expr);
my $got = eval_node($tree);
print("$expr = $expected got $got\n");
}