#Simple extensible RPN calculator
use strict;

#globals
my @queue;            #list of tokens from STDIN waiting to be processed
my @stack = qw( 0 );
my $lastx;

#magic words to break out of the exception handler in order to quit
my $exitSesame = "Exiting on request";

#RPN instructions stored as a hash of anonymous functions
#add more as needed
my %stdprocs = (
   '+' => sub { $lastx = shift @stack; $stack[0] += $lastx; },
   '-' => sub { $lastx = shift @stack; $stack[0] -= $lastx; },
   '*' => sub { $lastx = shift @stack;  $stack[0] *= $lastx; },
   '/' => sub { $lastx = shift @stack; ($stack[0] /= $lastx); },
   'drop' => sub { shift @stack; push @stack, 0 if @stack < 5; },
   'dup' => sub { unshift @stack, $stack[0]; },
   'lastx' => sub { unshift @stack, $lastx; },
   'ln' => sub { $lastx = $stack[0]; $stack[0] = log($stack[0]); },
   'quit' => sub { die "$exitSesame\n"; },
   'sqr' => sub { $lastx = $stack[0]; $stack[0] *= $stack[0]; },
   'sqrt' => sub { $lastx = $stack[0]; $stack[0] = sqrt($stack[0]); },
);

while (<>) {  #main loop
 chomp;
 @queue = tokenise($_);
 my $token;

 while (length ($token = shift @queue)) {
   if (isnumeric($token)) { #number
     unshift @stack, $token;
     next;
   }
   if (exists ($stdprocs{$token})) {
     execStdproc($token);
     next;
   }
   print "Unknown function $token!\n";
 }
 print "$stack[0]\n";
} # END of main routine

sub tokenise {
 #splits STDIN into a list of numbers and procs to execute
 my @queue = $_[0] =~ m/
     (?:-?(?:\d*\.?\d+|\d+\.?\d*)(?:[eE][+-]?\d+)?)   #integer or float
   |
     [-+\/\\*]             #operators
   |
     (?:\w+)               #a word
   /igx;
  return @queue;
}

sub isnumeric {
 if ($_[0] =~ m/^-?(\d*\.?\d+|\d+\.?\d*)([eE][+-]?\d+)?$/) {
   return 1
 } else {
   return 0
 }
}

sub execStdproc { #look up and execute sub from %stdprocs
 my $name = $_[0];
 eval { $stdprocs{$name}() };
 die "$exitSesame\n" if $@ =~ m/$exitSesame/ ;  #normal exit
 warn "Exception raised by built-in operator/function '$name':\n$@\n" if $@;
}