in reply to Solving lisp-style terms

I like this code.

Here are some improvements on the code. The most important is that it can handle negation of numbers, such as (- (+ 1 1)) which evaluates to -2. This version uses the first cmd-line argument as the expression. ;Updates: you notice the lack of spaces, don't you? 

#!/usr/bin/perl

use strict;
use warnings;

#use Data::Dumper;

my $operators = {
    'begin' => sub { pop },
    '+' => sub { my $i = 0; $i += $_ for @_; $i; },
    '-' => sub { my $i = shift @_; @_ or return -$i; $i -= $_ for @_; 
+$i; },
    '*' => sub { my $i = 1; $i *= $_ for @_; $i; },
    '/' => sub { my $i = shift @_; @_ or return 1/$i; $i /= $_ for @_;
+ $i; },
};

my $task = $ARGV[0];
print calculate( $task =~ m(([\w!$%&*+-./<=>?@^~]+|\S))g ), "\n";
exit;

sub solve {
    my ( $op, @vals ) = @_;
    die "solve(): wrong operator or to less values"
      unless ( exists $operators->{$op} );
    return $operators->{$op}(@vals);
}

sub calculate {
    my @ops = @_;
    @ops = @ops[ 1 .. $#ops - 1 ]
      if $ops[0]   eq '('
      and $ops[-1] eq ')';    # remove leading and trailing brackets

    my $marker = -1;
    my $begin  = undef;
    my $end    = undef;
    my @marked = ();

    for ( 0 .. $#ops ) {
        $begin = $_ if $ops[$_] eq '(' && ++$marker == 0;
        $end   = $_ if $ops[$_] eq ')' && $marker-- == 0;
        if ( defined $begin && defined $end ) {
            push @marked, { begin => $begin,
                end => $end };    # find balanced brackets on this lev
+el
            $marker = -1;
            $begin  = undef;
            $end    = undef;
        }
    }

    while (@marked) {
        my $current = pop @marked;
        splice @ops, $current->{begin},    # recursively solve inner b
+rackets
          $current->{end} - $current->{begin} + 1,
          calculate( @ops[ $current->{begin} .. $current->{end} ] );
    }

    #print Dumper \@ops;
    return solve(@ops);
}
__END__

[download]

In Section Cool Uses for Perl