The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

# An "almost-RPN-ish" calculator ...
use feature 'say';
use Lowu;

if (@ARGV) {
  say calc(join ' ', @ARGV)->join(" ");
  exit 0
}

[
  qq[Hi! I'm a RPN-ish calculator.],
  qq[ - The stack only persists for a single expression.],
  qq[ - Operations reduce the stack recursively.],
  qq[ - Commands (anywhere in an expression):],
  qq[   'q' quits],
  qq[   'p' prints the current stack],
  qq[   'pFORMAT applies FORMAT to each stack element via (s)printf],
]->map(sub { say $_ });

STDOUT->autoflush(1);

while (1) {
  print "Enter an expression:\n", "> ";
  my $expr = <STDIN>;
  say "result: " . calc($expr)->join(" ")
}

sub calc {
  my $stack = [];
  for my $item (split ' ', shift) {
    if ($item eq 'q' || $item eq 'quit') {
      exit 0
    }

    if ($item eq 'p' || $item eq 'print') {
      say "stack: " . $stack->join(" ");
      next
    }

    if (my ($format) = $item =~ /\Ap(?:rint)?(\S+)\Z/) {
      $stack->map(sub { say sprintf $format, $_ });
      next
    }

    if ($item =~ /\A[0-9]+\Z/) {
      $stack->push($item);
      next
    }

    next unless $stack->has_any;
    unless ($stack->count > 1) {
      warn "Not enough stack elements to perform operations\n";
      next
    }

    if ($item eq '+') {
      $stack = array( $stack->reduce(sub { shift() + shift() }) );
      next
    }
    if ($item eq '-') {
      $stack = array( $stack->reduce(sub { shift() - shift() }) );
      next
    }
    if ($item eq '*') {
      $stack = array( $stack->reduce(sub { shift() * shift() }) );
      next
    }
    if ($item eq '/') {
      $stack = array( $stack->reduce(sub { shift() / shift() }) );
      next
    }
    if ($item eq '^' || $item eq '**') {
      $stack = array( $stack->reduce(sub { shift() ** shift() }) );
      next
    }

    warn "Unknown token: $item\n"
  }

  $stack
}