#!/usr/bin/perl

# http://perlmonks.org/?node_id=1139915

use strict; # recursive descent parser using /\G/gc and C generator
use warnings;

my $had = $_ = @ARGV ? "@ARGV" : '.not.foo(1,bar(2)+1,3).and.baz(4,5)';
my $want = '! foo[2][bar[1]][0] && baz[4][3]';

my $answer = expr();
/\G\s* \z /gcx or error(); # verify complete parse
#use YAML; print Dump $answer;

print "had  $had\nwant $want\ngot  ",  $answer->C, "\n";

sub AND::C { '((' . $_[0][0]->C . ') && (' . $_[0][1]->C . '))' }
sub PLUS::C { '((' . $_[0][0]->C . ') + (' . $_[0][1]->C . '))' }
sub NOT::C { '( !(' . $_[0][0]->C . '))' }
sub NUMBER::C { $_[0][0] }
sub ARRAY::C { $_[0][0] . $_[0][1]->C }
sub SUBS::C
  {
  return join '', map { '[(' . $_->C . ')-1]' } reverse @{ $_[0] };
  }

sub expr # left associative => term ([+-] term)*
  {
  my $left = term();
  $left = bless [ $left, term() ], 'AND' while /\G\s* \.and\. /gcx;
  return $left;
  }

sub term # left associative => item ([+] item)*
  {
  my $left = item();
  $left = bless [ $left, item() ], 'PLUS' while /\G\s* \+ /gcx;
  return $left;
  }

sub list
  {
  my $left = bless [ expr() ], 'SUBS';
  push @$left, expr() while /\G\s* , /gcx;
  return $left;
  }

sub item # number, unary minus or (expr)
  {
  /\G\s* (\d+) /gcx and return bless [$1], 'NUMBER';
  /\G\s* \.not\. /gcx and return bless [ item() ], 'NOT';
  /\G\s* (\w+) \s* \( /gcx and do{ # array
    my $arr = $1;
    my $value = list();
    /\G\s* \) /gcx or error();
    return bless [ $arr, $value ], 'ARRAY';
    };
  /\G\s* \( /gcx and # parens
    do{ my $value = expr(); /\G\s* \) /gcx or error(); return $value };
  error();
  }

sub error { die s/\G/ SYNTAX ERROR->/r, "\n" }

##</code><code>##

had  .not.foo(1,bar(2)+1,3).and.baz(4,5)
want ! foo[2][bar[1]][0] && baz[4][3]
got  ((( !(foo[(3)-1][(((bar[(2)-1]) + (1)))-1][(1)-1]))) && (baz[(5)-1][(4)-1]))