[SPOILER] Solution for QotW #25 (RPN calculator)

I liked this quiz for two reasons:
1) It looked simple and fun.
2) I've never really understood RPN notation, so it seemed like a good
   learning exercise. After this quiz, I just might be able to compute
   2 + 2 using an HP calculator.

I thought about using eval STRING, but decided against it. Instead, my 
solution is based around a dispatch table containing both functions and 
the number of stack arguments they expect. The functions' return value 
is added to the stack only when it's defined, so functions can return 
'undef' if they don't want that to happen.

I implemented all of the extras except the "N roll" commands, which 
seemed odd to me. In their place, I added a "rotate" command. I added a 
few things of my own, as well:

* ln     - base e logarithm (my 'log' is base 10)
* E      - base ten version of 'exp' (10 ** N).
* pi     - 3.14159...
* e      - 2.71828...
* fmt    - user defined formats for displaying the stack
* rotate - rotate the stack by N elements.
* ?      - provides a help listing of available commands
* q      - quit: exits the calculator.

#!/usr/bin/perl
BEGIN {require 5.006}
use strict;
use warnings;
use constant PI => 4 * atan2(1,1);
use constant E  => exp(1);

my @stack;
my $fmt = "%s";

my %op = (
	# arithmetic operators
	'_'    => {n => 1, f => sub {     - $_[0]    }},
	'+'    => {n => 2, f => sub { $_[0] +  $_[1] }},
	'-'    => {n => 2, f => sub { $_[0] -  $_[1] }},
	'*'    => {n => 2, f => sub { $_[0] *  $_[1] }},
	'/'    => {n => 2, f => sub { $_[0] /  $_[1] }},
	'%'    => {n => 2, f => sub { $_[0] %  $_[1] }},
	'**'   => {n => 2, f => sub { $_[0] ** $_[1] }},
	abs    => {n => 1, f => sub { abs($_[0])              }},
	int    => {n => 1, f => sub { int($_[0])              }},
	sqrt   => {n => 1, f => sub { sqrt($_[0])             }},
	sin    => {n => 1, f => sub { sin($_[0])              }},
	cos    => {n => 1, f => sub { cos($_[0])              }},
	tan    => {n => 1, f => sub { sin($_[0]) / cos($_[0]) }},
	atan2  => {n => 2, f => sub { atan2($_[0], $_[1])     }},
	ln     => {n => 1, f => sub { log($_[0])              }},
	log    => {n => 1, f => sub { log($_[0])/log(10)      }},
	exp    => {n => 1, f => sub { exp($_[0])              }},
	E      => {n => 1, f => sub { 10 ** $_[0]             }},
	rand   => {n => 1, f => sub { rand($_[0])             }},
	'&'    => {n => 2, f => sub { $_[0] & $_[1] }},
	'|'    => {n => 2, f => sub { $_[0] | $_[1] }},
	'^'    => {n => 2, f => sub { $_[0] ^ $_[1] }},
	'~'    => {n => 1, f => sub {    ~ $_[0]    }},

	# constants
	pi     => {n => 0, f => sub { PI }}, # 3.141592654...
	e      => {n => 0, f => sub { E  }}, # 2.718281828...

	# output formats
	dec    => {n => 0, f => sub { $fmt = "%s";   undef }},
	oct    => {n => 0, f => sub { $fmt = "0%o";  undef }},
	hex    => {n => 0, f => sub { $fmt = "0x%x"; undef }},
	bin    => {n => 0, f => sub { $fmt = "0b%b"; undef }},
	fmt    => {n => 1, f => sub { $fmt = $_[0];  undef }},

	# stack manipulation
	drop   => {n => 1, f => sub { undef }},
	swap   => {n => 2, f => sub { push @stack, @_;           undef }},
	clear  => {n => 0, f => sub { @stack = ();               undef }},
	dup    => {n => 1, f => sub { push @stack, $_[0], $_[0]; undef }},
	rotate => {n => 1, f => sub {
		unshift(@stack, splice(@stack, -$_[0]));
		undef;
	}},

	# program control
	q      => {n => 0, f => sub {exit}},
	'?'    => {n => 0, f => sub {help(); undef}},
);

$| = 1;
print "> ";
while (<>) {
	chomp;
	do_token($_) foreach (split);
	show_stack();
	print "> ";
}

sub do_token {
	my $t = shift;

	if (exists $op{$t}) {
		my $n = $op{$t}{n};

		unless (@stack >= $n) {
			print "ERROR: Not enough elements for operation.\n";
			return;
		}

		my @arg = $n ? splice(@stack, -$n) : ();
		my $rv  = $op{$t}{f}->(@arg);

		push @stack, $rv if defined $rv;
	}
	else {
		push @stack, ($t =~ /^0\w/) ? oct($t) : $t;
	}
}

sub show_stack {
	if (@stack) {
		my $i = $#stack;
		foreach (reverse @stack) {
			printf ("\r%2d: $fmt\n", $i--, $_);
		}
	}
	else {
		print "\r<empty>\n";
	}
}


sub help {
	print <<'EOT';
------------------------------------------------------------------------
Available Commands
------------------------------------------------------------------------

Arithmetic Operations:
    _         unary negation
    +         addition
    -         subtraction
    *         mulitplication
    /         division
    %         modulus
    **        exponentiation
    abs       absolute value
    int       integer truncation
    sqrt      square root
    sin       sine
    cos       cosine
    tan       tangent
    atan2     arctangent2
    ln        natural logarithm (base e)
    log       logarithm (base 10)
    exp       natural exponent (e ** N)
    E         base 10 exponent (10 ** N)
    rand      random number between 0 and N
    &         bitwise AND
    |         bitwise OR
    ^         bitwise XOR
    ~         bitwise NOT

Constants:
    pi        Pi (3.14159...)
    e         e  (natural logarithm base: 2.71828...)

Output Formatting:
    dec       Display stack in decimal     (base 10)
    oct       Display stack in octal       (base  8)
    hex       Display stack in hexadecimal (base 16)
    bin       Display stack in binary      (base  2)
    <X> fmt   Display stack formatted with <X> (sprintf() format).

Stack Manipulation:
    drop      Pops the top element off the stack.
    swap      Swaps the top two elements on the stack.
    clear     Clears the stack.
    dup       Duplicates the top element on the stack.
    rotate    Rotates the stack by N elements.

Program Control:
    q         Quit (Exit)
    ?         Prints this help message.
------------------------------------------------------------------------
EOT
}

__END__