#! perl -slw
use strict;
use List::Util qw[ reduce ]; $a=$b;

our $XLATE ||= 0;

sub rpn2exp {
    my %tops = map{ $_ => undef } qw[ % MOD + ADD * MULT / DIV ** POW 
+- SUB ];
    my @stack;
    my $expr;
    while( @_ ) {
        my $item = shift @_;
        push( @stack, $item ), next
            unless exists $tops{ $item } or $item =~ m[\(\)$];
        if( exists $tops{ $item } ) {
            my $arg2 = pop @stack;
            my $arg1 = pop @stack;
            push @stack, "( $arg1 $item $arg2 )";
        }
        elsif( my( $func ) = $item =~ m[^(.*)\(\)$] ) {
            my $args = pop @stack;
            my @args = map{ pop @stack } 1 .. $args;
            push @stack, $func . '( ' . join( ', ', reverse @args ) . 
+' )';
        }
    }
    return "@stack";
}

sub nestedOk{
    index( $_[ 0 ], '(' ) <= index( $_[ 0 ], ')' ) and
    0 == reduce{
        $a + ( $b eq '(' ) - ( $b eq ')' )
    } 0, split'[^()]*', $_[ 0 ]
}

my $re_var   = qr[ [a-zA-Z]\w* ]x;
my $re_subex = qr[ \{\d+\} ]x;
my $re_func  = qr[ $re_var $re_subex ]x;
my $re_num   = qr[ -? \d+ (?: \. \d+ )? (?: [Ee] [+-]? \d+ )? ]x;
my $re_term  = qr[ $re_num | $re_func | $re_subex | $re_var ]x;
my $re_op    = qr[\*\*|[,*%+/^-]];
my %ops = ( qw[ % MOD + ADD * MULT / DIV ** POW - SUB ] );

my @varargs;
sub exp2rpn {
    my( $exp, $aStack, $aBits ) = @_;
    die "Unbalanced parens: '$exp'" unless nestedOk $exp;
    if( $exp =~ m[^$re_term$] and $exp !~ m[\{\d+\}] ) {
        push @$aStack, $exp;
    }
    else {{
        my( $left, $op, $right, $rest ) = $exp =~ m[
            ^ (?: ( $re_term )? ( $re_op ) )? ( $re_term ) ( .* ) $
        ]x or die "malformed (sub)expression '$exp'";
#{ no warnings; print "'$exp' => L'$left' O'$op' R'$right' >'$rest'"; 
+}

        $varargs[ -1 ]++ if $op and $op eq ',' and @varargs;
       
        for ( $left, $right ) {
            next unless $_;
            if( my( $func, $subex ) = m[^ ( $re_var )? \{ ( \d+ ) \} $
+]x ) {
                push @varargs, 1 if $func;
                exp2rpn( $aBits->[ $subex ], $aStack, $aBits );
                push @$aStack, pop( @varargs ), "$func()" if $func;
            }
            else{
                push( @$aStack, $_  );
            }
        }
        push @$aStack, $XLATE ? $ops{ $op } : $op
            if $op and $op ne ',';
        $exp = $rest, redo if $rest;
    }}
    return $aStack;
}

sub parseExp {
    my( $exp ) = @_;
    return warn "Unbalanced parens: '$exp'" unless nestedOk $exp;
    $exp =~ s[\s+][]g;
    my( $n, @bits )= ( 1, $exp );
    
    for ( reverse @bits ) {
        s[\( ( [^()]+ )  \)]{ push @bits, $1; "{${ \( $n++ ) }}"; }ex 
+while m[[()]];
    }
    
    s[([^,]+)(,?)] { push @bits, $1; "{${ \( $n++ ) }}$2" }eg for reve
+rse @bits;
    
    for ( reverse @bits ) {
        1 while s[( $re_term (?:\*\*)          $re_term )]{ push @bits
+, $1; "{${ \( $n++ ) }}"; }gex;
        1 while s[( $re_term (?:[*/%])         $re_term )]{ push @bits
+, $1; "{${ \( $n++ ) }}"; }gex;
        1 while s[( $re_term (?:(?<![eE])[+-]) $re_term )]{ push @bits
+, $1; "{${ \( $n++ ) }}"; }gex;
    }
    return @{ exp2rpn $bits[ 0 ], [], \@bits };
}

while( chomp( my $exp = <DATA> || '' ) ) {
    my @rpn = parseExp $exp;
    $exp =~ s[\s+][]g;
    my $reversed = rpn2exp @rpn;
    printf "%s\n%s\n%s\n\n", $exp, join(', ', @rpn), $reversed ;
}

__DATA__
Func_1( 1, Func_2( Func3( 1 + 2 * 3) * aFunc( 3 ) ) + FuNc( 4, 5, 6 ),
+ -2, e, -10, 2e10 ) + 1
func( 1, 2+3*4/5**6, 7/8 )
a+b*c/2
abc+def+Efg_hij
2.0+1e-2/0.01E-21
max( a, b, c, d ) * atan( pi*4, -1 )
sin( cos( x ) - tan( y ) ) + f( g( z ) )
2*(somevar+other) + max(this, that)
A+(B*C-D)/E
(a*(b)-c**(3.4e-2))
5**((-2e-3+x)*sin(p+4.0)/fred)
sin(a) + sin(ab) + sin( a, b )
Func_2( Func3( 1* 2 * 3) * aFunc( 3 ) ) + FuNc( 4, 5, 6 )
func( 1, 2+3*4/5**6, 7/8 )
Func_1( 1, xx, -2, e, -10, -2e-10 ) + 1
[download]