optimized calc switching code

rpnc

@@ -12,7 +12,7 @@ my $term      = Term::ReadLine->new('rpn calc');
 my $debug     = 0;
 my $showstack = 1;
 my $tty       = 1;
-my $VERSION   = '1.00';
+my $VERSION   = '1.01';
 my $sub       = 0;
 my $op;
 
@@ -54,26 +54,53 @@ if ($op) {
   exit;
 }
 
+# management commands
 my %commands = (
                 q   => sub { exit; },
                 '?' => sub { help(); },
                 s   => sub { dumpstack(); },
                 c   => sub { clearstack(); },
-                d   => sub {
+                d   => sub { $debug ^= 1; },
-                  if ($debug) {
+                u   => sub { undo(); dumpstack(); },
-                    $debug = 0;
-                  }
-                  else {
-                    $debug = 1;
-                  }
-                },
-                u   => sub { undo();  dumpstack(); },
                 r   => sub { reversestack(); },
                 R   => sub { rotatestack(); },
                 '(' => sub { $sub = 1 },
                 ')' => sub { $sub = 0 },
                );
 
+# executed 1:1, or aliased
+my %alias   = qw(^ ** x ^ < << > >> + + - - / / * * & & | |);
+
+# hand coded functions
+my %func    = (
+               '%' => sub {
+                       if (scalar @_ == 2) {
+                         my ($a, $b) = @_;
+                         return "($a / 100) * $b";
+                       }
+                       else {
+                         print "percent only possible with 2 values\n";
+                         undo();
+                         return 0;
+                       }
+                     },
+               'V' => sub {
+                 if (scalar @_ == 2) {
+                   my ($a, $b) = @_;
+                   return "$a ** (1 / $b)";
+                 }
+                 else {
+                   my $a = pop @_;
+                   return "$a ** (1 / 2)";
+                 }
+               },
+               'pr' => sub {
+                 # parallel resistance, maybe add ~/.rpncrc support
+                 # where to add such custom functions...
+                 return "1 / (" . join(' + ', map { "1 / $_"} @_) . ")";
+               }
+              );
+
 my $OUT = $term->OUT || \*STDOUT;
 while ( defined ($_ = $term->readline(prompt())) ) {
   foreach my $tok (split /\s+/) {
@@ -83,10 +110,10 @@ while ( defined ($_ = $term->readline(prompt())) ) {
       dumpstack();
     }
     else {
-      if ($tok =~ /^[\(\)csdrRuq\?]+?$/) {
+      if (exists $commands{$tok}) {
         cmd($tok);
       }
-      elsif ($tok =~ /^[V<>x\%\|\&\^+\-\*\/]$/) {
+      else {
         print calc($tok);
       }
     }
@@ -241,45 +268,19 @@ sub calc {
   my @last = getlast();
 
   if (@last) {
-    # map operators
+    if (exists $alias{$op}) {
-    if ($op eq '^') {
+      $op = $alias{$op};
-      $op = '**';
+      $code = join(" $op ",  @last);
     }
-    elsif ($op eq 'x') {
+    elsif (exists $func{$op}) {
-      $op = '^';
+      my $sub = $func{$op};
-    }
+      $code = &$sub(@last);
-    elsif ($op eq '<') {
+      return unless $code;
-      $op = '<<';
-    }
-    elsif ($op eq '>') {
-      $op = '>>';
-    }
-
-    # direct and special ops
-    if ($op eq '%') {
-      if (scalar @last == 2) {
-        my ($a, $b) = @last;
-        $code = "($a / 100) * $b";
-      }
-      else {
-        print "percent only possible with 2 values\n";
-        undo();
-        return;
-      }
-    }
-    elsif ($op eq 'V') {
-      if (scalar @last == 2) {
-        my ($a, $b) = @last;
-        $code = "$a ** (1 / $b)";
-      }
-      else {
-        my $a = pop @last;
-        $code = "$a ** (1 / 2)";
-      }
     }
     else {
-      # rpn op
+      print "syntax error or unknown command!\n";
-      $code = join(" $op ",  @last);
+      undo();
+      return;
     }
 
     # execute