#! 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 reverse @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 (?:(? || '' ) ) { 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