being rude to bryce http://forrst.com/posts/Weekend_Coding_Challenge_Calculator-z3c

gistfile1.txt

$ pbpaste | perl -Minteger -pe'1 while s!(?:\(\s*(?:\d+\s*[\+\-\*/]\s*)+\d+\s*\))|(?:\d+\s*[\+\-\*/]\s*)+\d+!$&!ee'
8
6
16
47
57
64
39

readable.pl

while (<>) {
  my $ops = qr{[\+\-\*/]};
  my $expr = qr{(\d+ $ops )+\d+};
  1 while s/(?:\( $expr \))|$expr/$&/ee;
  print;
}

tree_parse.pl

#!/usr/bin/env perl
# Now with less cheating

use 5.12.0;
use warnings;
use integer;

while (<>) {
  my @tokens = split;

  my $tree = parse(@tokens);
  say evaluate($tree);
}

sub evaluate {
  my $node = shift;

  given ($node->{value}) {
    return $_ when /\d+/;
    return evaluate($node->{left}) + evaluate($node->{right}) when '+';
    return evaluate($node->{left}) - evaluate($node->{right}) when '-';
    return evaluate($node->{left}) * evaluate($node->{right}) when '*';
    return evaluate($node->{left}) / evaluate($node->{right}) when '/';
    default { die "Spurious tokens in input.\n" }
  }
}

sub parse {
  my @output;
  my @ops;

  for my $token (@_) {
    given ($token) {
      # if num, create new leaf node
      when (/\d+/) {
        push @output, { value => $token };
      }
      # if it's an operator
      when ([qw(+ - * /)]) {
        # while there are ops on the stack, and the precedence of the current
        # op is <= the op at the top of the stack
        while (@ops && (prec($_) <= prec($ops[-1]))) {
          # take the operator at the top and its operands
          # and place the new node in the output
          push @output, {
            value => pop @ops,
            right => pop @output,
            left  => pop @output,
          };
        }
        # finally, put the current op on the stack
        push @ops, $_;
      }
      when ('(') {
        push @ops, $_;
      }
      when (')') {
        my $balanced = 0;
        while(my $op = pop @ops) {
          if ($op eq '(') {
            $balanced = 1;
            last;
          }
          # note that this is just like the end of the routine: 
          # removing all the operators from the stack (that were in parens)
          push @output, {
            value => $op,
            right => pop @output,
            left  => pop @output,
          };
        }
        die "Mismatched parentheses\n"
          unless $balanced;
      }
      default {
        die "Unrecognized token: '$_'\n";
      }
    }
  }

  while (@ops) {
    push @output, {
      value => pop @ops,
      right => pop @output,
      left  => pop @output,
    };
  }

  # left with a list containing one root node, so just return the node
  return pop @output;
}

sub prec {
  my $op = shift;
  return 2 if $op ~~ [qw(* /)];
  return 1 if $op ~~ [qw(+ -)];
  return 0;
}