expr := value ( op value )*

##</code><code>##

sub parse_expr {
    my($value, @stack);
    while(1) {
        $value = parse_value or die "Parse error";
        my $op = parse_operator or last;
        $value = process(\@stack, $value, $op);  # intermediate processing
        push @stack, { value => $value, op => $op };  # store for the next round 
    }
    $value = process(\@stack, $value);  # final processing
    return $value;
}

##</code><code>##

value := '(' expr ')'

##</code><code>##

#!perl -w
use strict;
my %var;

my %op = (
  '+'  => { prec => 10, assoc => 'L', exec => sub { $_[0] + $_[1] }},
  '-'  => { prec => 10, assoc => 'L', exec => sub { $_[0] - $_[1] }},
  '*'  => { prec => 20, assoc => 'L', exec => sub { $_[0] * $_[1] }},
  '/'  => { prec => 20, assoc => 'L', exec => sub { $_[0] / $_[1] }},
  '%'  => { prec => 20, assoc => 'L', exec => sub { $_[0] % $_[1] }},
  '**' => { prec => 30, assoc => 'R', exec => sub { $_[0] ** $_[1] }},
);

# fields
use constant VALUE => 0;
use constant OP => 1;

sub parse_expr {
    my @stack;
    while (1) {
        trace();
        my($value) = parse_value() or die "Parse error at " . where();
        trace("value=$value");
        if(/\G\s*(\*\*|[+\-*\/%\\])/gc) {  # operator
            my $op = $1;
            trace("op=$op");
            while (@stack and (($op{$op}{prec} < $op{$stack[-1][OP]}{prec})
              or ($op{$op}{prec} == $op{$stack[-1][OP]}{prec})
               and $op{$stack[-1][OP]}{assoc} eq "L")) {
                my($lhs, $op) = @{pop @stack};
                trace("popping $lhs $op");
                $value = $op{$op}{exec}->($lhs, $value);
                trace("result = $value");
            }
            trace("pushing $value $op");
            push @stack, [ $value, $op ];
        } else {  # no more
            while(@stack) {
                my($lhs, $op) = @{pop @stack};
                trace("popping $lhs $op");
                $value = $op{$op}{exec}->($lhs, $value);
                trace("result = $value");
            }
            trace("returning $value");
            return $value;
        }
    }
}

sub parse_value {
    /\G\s+/gc;
    if(/\G\+/gc) {  #  '+' value
        trace("Unary plus");
        return parse_value();
    }
    if(/\G-/gc) {  #  '-' value
        trace("Unary minus");
        return -parse_value();
    }
    if(/\G((?:\d+\.?\d*|\.\d+)(?i:E[+-]?\d+)?)/gc) {  # number
        return $1;
    }
    if(/\G((?i:[a-z]\w*))/gc) {  # variable
        return $var{$1};
    }
    if(/\G\(/gc) {  #  '(' expr ')'
        my $value = parse_expr();
        /\G\s*/gc;
        /\G\)/gc or die "Parse error: ')' expected at: " . where() ;
        return $value;
    }
    return;
}

sub evaluate {
    local $_ = shift;
    my $value = parse_expr();
    /\G\s+/gc;
    /\G$/gc or die sprintf "Junk characters at end: \"%s\"", where();
    return $value;
}

sub where {  # debugging info
    my $s = $_;
    substr($s, pos || 0, 0) = "\267";
    return $s;
}

sub trace {
    my($pkg, $file, $line) = caller;
    printf STDERR "Line %d \"%s\" %s\n", $line, where(), @_ ? shift : "";
}

%var = ( a => 101, b => 7 );
$_ = "20+3*a+10*-b-5*(3 +2)*5";
$\ = "\n";
print evaluate($_);

##</code><code>##

#!perl -w
use strict;
my %var;

my %op = (
  '+'  => { prec => 10, assoc => 'L', exec => sub { $_[0] + $_[1] }},
  '-'  => { prec => 10, assoc => 'L', exec => sub { $_[0] - $_[1] }},
  '*'  => { prec => 20, assoc => 'L', exec => sub { $_[0] * $_[1] }},
  '/'  => { prec => 20, assoc => 'L', exec => sub { $_[0] / $_[1] }},
  '%'  => { prec => 20, assoc => 'L', exec => sub { $_[0] % $_[1] }},
  '**' => { prec => 30, assoc => 'R', exec => sub { $_[0] ** $_[1] }},
);

# fields
use constant VALUE => 0;
use constant OP => 1;

sub parse_expr {
    my @stack;
    while (1) {
        trace();
        my($value) = parse_value() or die "Parse error at " . where();
        trace("value=$value");
        if(/\G\s*(\*\*|[+\-*\/%\\])/gc) {  # operator
            my $op = $1;
            trace("op=$op");
            while (@stack and (($op{$op}{prec} < $op{$stack[-1][OP]}{prec})
              or ($op{$op}{prec} == $op{$stack[-1][OP]}{prec})
               and $op{$stack[-1][OP]}{assoc} eq "L")) {
                my($lhs, $op) = @{pop @stack};
                trace("popping $lhs $op");
                $value = $op{$op}{exec}->($lhs, $value);
                trace("result = $value");
            }
            trace("pushing $value $op");
            push @stack, [ $value, $op ];
        } else {  # no more
            while(@stack) {
                my($lhs, $op) = @{pop @stack};
                trace("popping $lhs $op");
                $value = $op{$op}{exec}->($lhs, $value);
                trace("result = $value");
            }
            trace("returning $value");
            return $value;
        }
    }
}

sub parse_value {
    /\G\s+/gc;
    if(/\G\+/gc) {  #  '+' value
        trace("Unary plus");
        return parse_value();
    }
    if(/\G-/gc) {  #  '-' value
        trace("Unary minus");
        return -parse_value();
    }
    if(/\G((?:\d+\.?\d*|\.\d+)(?i:E[+-]?\d+)?)/gc) {  # number
        return $1;
    }
    if(/\G((?i:[a-z]\w*))/gc) {  # variable
        return $var{$1};
    }
    if(/\G\(/gc) {  #  '(' expr ')'
        my $value = parse_expr();
        /\G\s*/gc;
        /\G\)/gc or die "Parse error: ')' expected at: " . where() ;
        return $value;
    }
    return;
}

sub evaluate {
    local $_ = shift;
    my $value = parse_expr();
    /\G\s+/gc;
    /\G$/gc or die sprintf "Junk characters at end: \"%s\"", where();
    return $value;
}

sub where {  # debugging info
    my $s = $_;
    substr($s, pos || 0, 0) = "\267";
    return $s;
}

sub trace {
    my($pkg, $file, $line) = caller;
    printf STDERR "Line %d \"%s\" %s\n", $line, where(), @_ ? shift : "";
}

%var = ( a => 101, b => 7 );
$_ = "20+3*a+10*-b-5*(3 +2)*5";
$\ = "\n";
print evaluate($_);

##</code><code>##

value := name '(' ( expr ( ',' expr ) * )? ')'