[Spoiler] RPN Calculator, Take 2

Well, putting more than 20 minutes into it, I came up with the solution 
below.

It fixes the atan2 issue Pr. West made me aware of. Also added the 
Math::Trig functions I mentioned the first time.

Biggest change: added support for complex numbers via Math::Complex.

-- Rod


#!/usr/bin/perl
use Math::Complex;
use Math::Trig;

 
sub spop {
  return pop @stack if @stack;
  print "Stack Underflow\n";
  return undef;
}

sub spushe {
  my $code = $_[0];
  my @x = eval $code;
  if ($@) {
    print "Error : $@\n";
  } else {
    push @stack, @x;
  }
}
 
@stack = ();

%cmds =
  (atan2   =>('defined($y = spop()) or last; defined($x = spop()) or 
last; ' .
          'spushe "atan2 \$x, \$y";'),

   drop    => 'defined(spop()) or last;',

   swap    =>('defined($y = spop()) or last; defined($x = spop()) or 
last; ' .
              'push @stack, $y, $x;'),

   clear   => '@stack = ();',

   dup     =>('defined($x = spop()) or last; ' .
              'push @stack, $x, $x;'),

   rolld   =>('defined($n = spop()) or last; ' .
          'if ($n > @stack) { print "Stack Underflow\n"; last; } ' .
          'defined($x = spop()) or last; ' .
          'splice(@stack, -$n, 0, $x); '),

   roll    =>('defined($n = spop()) or last; ' .
          'if ($n > @stack) { print "Stack Underflow\n"; last; } ' .
          'push @stack, splice(@stack, -$n-1, 1);'),
   );

@cmds{qw{ + - / * % ** << >> & ^ | }} = ('binary') x 11;

@cmds{qw{ ++ -- sin cos abs int exp log sqrt},
      qw{ tan csc sec cot asin acos atan acsc asec acot sinh cosh tanh },
      qw{ csch sech coth asinh acosh atanh acsch asech acoth }
    } = ('unary')  x (9+13+9);

@cmds{qw{ exit rand pi }} = ('func') x 3;

print "> ";
while (<>) {
  chomp;
  my @cmds = split;
  while (@cmds) {
    my $cmd = lc shift(@cmds);
   
    # push a number
    if (($cmd =~ m{^    ( [+-]?\d+ (?:\.\d*)? (?:e[+-]?\d+)? )
               (( [+-] \d* (?:\.\d*)? (?:e[+-]?\d+)? )i )? $ }ix ||
     $cmd =~ m{^() (( [+-]?\d* (?:\.\d*)? (?:e[+-]?\d+)? )i )  $ }ix )
    && length($cmd) > 0 ) {
      my $real = 0+$1;
      my $imag = $3;
      $imag = 1 if $2 =~ /^[+-]?i$/i;
      push @stack, Math::Complex->make($real, $imag)+0;
      next;
    }


    if (!$cmds{$cmd}) {
      print "Bad Command: $cmd\n";
      last;
    }

    if ($cmds{$cmd} eq 'binary') {
      defined($y = spop()) or last;
      defined($x = spop()) or last;
      spushe "\$x $cmd \$y";
      next;
    }
   
    if($cmds{$cmd} eq 'unary') {
      defined($x = spop()) or last;
      spushe "$cmd \$x";
      next;
    }

    if($cmds{$cmd} eq 'func') {
      spushe $cmd;
      next;
    }
       
    eval $cmds{$cmd};
  }

  # print stack
  for ($i = 0 ; $i <= $#stack  ; ++$i) {
    print $#stack-$i, ': ', $stack[$i], "\n";
  }
  print "> ";
}

 
__END__