#!/usr/bin/perl
#
# eg8: RPN evaluator, version 3, variable no of inputs
#

use strict;
use warnings;
use Function::Parameters qw(:strict);

# arithmetic operators and how to do them..
my %op = (
	'+'      => [ 2, fun ($x,$y) { return $x + $y } ],
	'-'      => [ 2, fun ($x,$y) { return $x - $y } ],
	'*'      => [ 2, fun ($x,$y) { return $x * $y } ],
	'/'      => [ 2, fun ($x,$y) { return $x / $y } ],
	'%'      => [ 2, fun ($x,$y) { return $x % $y } ],
	'^'      => [ 2, fun ($x,$y) { return $x ** $y } ],
	'>'      => [ 2, fun ($x,$y) { return $x > $y ? 1 : 0 } ], # in case we print value
	'swap'   => [ 2, fun ($x,$y) { return ($y, $x) } ],
	'neg'    => [ 1, fun ($x) { return - $x } ],
	'sqrt'   => [ 1, fun ($x) { return sqrt( $x ) } ],
	'ifelse' => [ 3, fun ($x,$y,$z) { return $x ? $y : $z } ],
);

#
# my $n = eval_rpn( @atom ):
#	Given an array @atom of atomic expression
#	elements (numbers or operands) in reverse
#	polish notation (rpn), evaluate the expression
#	and return the answer $n.
#
fun eval_rpn(@atom)                             # each atom: operator or number
{
	my @stack;                              # evaluation stack
	foreach my $atom (@atom)
	{
		if( $atom =~ /^\d+$/ )          # number?
		{
			push @stack, $atom;
		} else				# operator?
		{
			die "eval_rpn: bad atom $atom\n"
				unless exists $op{$atom};
			my( $nargs, $func ) = @{$op{$atom}};
			my $depth = @stack;
			die "eval_rpn: stack depth $depth when $nargs needed\n"
				if $depth < $nargs;
			my @args = reverse map { pop @stack } 1..$nargs;
			push @stack, $func->( @args );
		}
	}
	my $depth = @stack;
	die "eval_rpn: @ end, stack depth $depth, should be 1\n"
				if $depth != 1;
	return pop @stack;
}

my @exprs = (
	"7 5 * 4 8 * > 1 neg 2 neg ifelse",
	"7 4 * 4 8 * > 1 neg 2 neg ifelse"
);
foreach my $str (@exprs)
{
	my $n = eval_rpn( split( /\s+/, $str ) );
	print "rpn: $str\n     result: $n\n";
}
