use Getopt::Long;
use strict;
use warnings;

sub permutations
{
    my $accum_ar = shift;
    my $bells_ar = shift;
    if ( @$bells_ar == 0 ) # we've reached a "leaf"
    {
        local( $\, $, ) = ( "\n", " " );
        push @$accum_ar, [ @_ ];
        return;
    }
    for my $i ( 0 .. $#{$bells_ar} )
    {
        my @bells = @{$bells_ar};
        my $bell = splice @bells, $i, 1;
        permutations( $accum_ar, \@bells, @_, $bell );
    }
}

sub combinations
{
    @_ or return [];
    my $l = shift;
    map
    {
        my $n = $_;
        map { [ $n, @$_ ] } combinations(@_)
    }
    @$l
}


my %op = (
    '+' => sub { $_[1] + $_[0] },
    '-' => sub { $_[1] - $_[0] },
    '*' => sub { $_[1] * $_[0] },
    '/' => sub { $_[1] / $_[0] },
);

sub uniqv(@)
{
    my %seen;
    grep { !$seen{"@$_"}++ } @_
}


my $quiet;    sub output { $quiet or  print @_ }
my $debug;    sub report { $debug and print @_ }
my $goal;
my $format = '%.6g';

my $Usage_statement = <<EOF;
Usage: $0  A B ... [-goal G]  [-debug] [-quiet] [-format FORMAT]

-goal G  (where G is a number) : only print the results when the resul
+t of the evaluation equals G.
         If you do not specify a goal value, the results of all succes
+sful evaluations will be printed.
-quiet : Do not print the results of any successful evaluations.
-debug : Also print any errors encountered, such as division by zero, 
+and popping from an empty stack.

-format FORMAT  (where FORMAT is a sprintf-compatible format string) :
+ When results are printed, this
         format will be used for the numeric result of the evaluation.
+  It should contain exactly one
     numeric format specifier.  The default is "$format"

EOF

sub Usage { die "@_\n$Usage_statement" }

GetOptions(
    'goal=f' => \$goal,
    'debug!' => \$debug,
    'quiet!' => \$quiet,
    'format=s' => \$format,
) or die $Usage_statement;

@ARGV >= 2 or die $Usage_statement;

=pod

Given N numbers input, which will be the operands of each "program",
each formula will have placeholders for N operands, and N-1 operators.
However, for sanity, the first two terms (i.e. the bottom) in each for
+mula
will invariantly be operands, and the last term (i.e. the top) will be
+ an
operator.  
So the variant part in the middle will have N-2 operands, and (N-1)-1 
+operators.
(Even with this heuristic, some formulae will be invalid, e.g. 1 1 a a
+ 1 1 a.)

In formulae, '1' = operand, 'a' = operator.

=cut

my $agnd = @ARGV - 2;
my @formulae;  # initially, just the variant parts:
permutations( \@formulae, [ ( ('1') x $agnd ), ( ('a') x $agnd ) ] );
@formulae = uniqv @formulae;
# now add the invariant parts:
for ( @formulae ) { @$_ = ( '1', '1', @$_, 'a' ) }


my @operand_permuts;
permutations( \@operand_permuts, [@ARGV] );
@operand_permuts = uniqv @operand_permuts;

my @operator_combos = combinations( ( [keys %op] ) x (@ARGV-1) );
@operator_combos = uniqv @operator_combos;


FORMULA:
for my $form_v ( @formulae )
{
    for my $arg_v ( @operand_permuts )
    {
        INPUTS:
        for my $op_v ( @operator_combos )
        {
            report( "(@$form_v) (@$arg_v) (@$op_v) \n" );
            my @arg  = @$arg_v;
            my @op   = @$op_v;
            my @form = @$form_v;
            my @stack;
            my @expr;
            while ( @form )
            {
                my $t = shift @form;
                if ( $t eq '1' ) # operand
                {
                    my $arg = shift @arg;
                    push @expr, $arg;
                    push @stack, $arg;
                }
                elsif ( $t eq 'a' ) # operator
                {
                    if ( @stack < 2 ) { report( "(@$form_v) is bad for
+mula - stack underflow \n" ); next FORMULA; }
                    my $op = shift @op;
                    push @expr, $op;
                    eval { push @stack, $op{$op}->( pop @stack, pop @s
+tack ); };
                    my $p = @expr == @$form_v ? '' : ' (partial)';
                    if ( $@ ) { report( "Other error? $@    expr=(@exp
+r)$p" ); next INPUTS; }
                }
                else
                {
                    warn "Unrecognized formula term '$t' ";
                    exit 1;
                }
            }
            if ( @stack != 1 ) { report( "(@$form_v) is bad formula - 
+stack overflow \n" ); next FORMULA; }
            my $r = pop @stack;
            if ( !defined($goal) || $r == $goal )
            {
                $r = sprintf $format, $r;
                output( "$r = @expr\n" );
            }
        }
    }
}
[download]