[SPOILER] RPN calculator

This was my 20 minute perl solution. Not documented, but should be 
fairly easy to follow.

I think it does all the extra features except the hex/oct/bin items.

One should be able to add a 'use Math::Trig;' and then expand the 
@perl_unary_ops accordingly if they wanted more trig functions.

-- Rod


#!/usr/bin/perl

my @stack     = ();
my @perl_binary_ops   = qw{ + - / * % ** << >> & ^ | };
my @perl_unary_ops    = qw{ ++ -- sin cos abs int exp log sqrt atan2 rand };

print "> ";
while (<>) {
  chomp;
  my @cmds = split;
  while (@cmds) {
    local $_ = my $cmd = lc shift(@cmds);
   
    # push numbers
    /^[+-]?\d+(?:\.\d+)?$/ and do {
      push @stack, $_;
      next; };
   
    # perl binary ops
    if (grep $_ eq $cmd, @perl_binary_ops) {
      defined($y = spop()) or last;
      defined($x = spop()) or last;
      push @stack, eval "$x $_ $y";
      next;
    }
   
    # perl unary ops
    if(grep $_ eq $cmd, @perl_unary_ops) {
      defined($x = spop()) or last;
      push @stack, eval "$_ $x";
      next;
    }
   
   
    # misc commands
    /^drop$/ and do {
      defined(spop()) or last;
      next; };

    /^swap$/ and do {
      defined($x = spop()) or last;
      defined($y = spop()) or last;
      push @stack, $x, $y;
      next; };

    /^clear$/ and do {
      @stack = ();
      next; };

    /^dup$/ and do {
      defined($y = spop()) or last;
      push @stack, $y, $y;
      next; };

    /^rolld$/ and do {
      defined($n = spop()) or last;
      if ($n > @stack) {
    print "Stack Underflow\n";
    @stack = ();
    last;
      }
      defined($x = spop()) or last;
      splice(@stack, -$n, 0, $x);
      next; };

    /^roll$/ and do {
      defined($n = spop()) or last;
      if ($n > @stack) {
    print "Stack Underflow\n";
    @stack = ();
    last;
      }
      push @stack, splice(@stack, -$n-1, 1);
      next; };

   
    /^q/ and do {
      exit; };

    print "Bad Command: $_\n";
    last;
  }

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



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