parantheses problem

marpa_test8

#!/usr/bin/perl
# Copyright 2012 Jeffrey Kegler
# This file is part of Marpa::R2. Marpa::R2 is free software: you can
# redistribute it and/or modify it under the terms of the GNU Lesser
# General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# Marpa::R2 is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser
# General Public License along with Marpa::R2. If not, see
# http://www.gnu.org/licenses/.
# $DB::single=2; # remember debug breakpoint

use 5.010;
use strict;
use warnings;
use English qw( -no_match_vars );
use Marpa::R2;
use Data::Dumper; # debug only

my $string;
my $grammar;
my $recce;

my $dsl = <<'END_OF_DSL';

:start ::= formula

:default ::= action => ::array

lexeme default = latm => 1

:discard ~ ws

formula               ::= '*IF' <condition_list>
                      |   '*IF' <condition_list> <until_clause>

<condition_list>      ::=  <condition>
                      |    '(' <condition_list> ')'
                      |    <condition_list> <logical_operator> <condition_list>

<logical_operator>    ::= '*AND' | '*OR'

<condition>           ::= <basic_condition>
                      |   <value_condition_in>

<basic_condition>     ::= <basic_function> <attribute> <comparison> <literal>   action => do_basic

<basic_function>      ::= '*VALUE' | '*COUNT'

<comparison>          ::= '*EQ' | '*GE' | '*GT' | '*LE' | '*LT' | '*NE'

<value_condition_in>  ::= '*VALUE' <attribute> '*IN' '(' <comma_separated_list> ')'   action => do_value_in

<literal>             ::= <quoted_string> | <null_string> | <number> | enum | <literal_word>

<attribute>           ::= idx'.' idx
                      | idx


<comma_separated_list> ::= <quoted_string>
                      |   <literal>
                      |   <quoted_string> ',' <comma_separated_list>

<situation>           ::= <id>

<until_clause>        ::= '*UNTIL' '(' <until_condition> ')'                    action => do_until

<until_condition>     ::= '*SIT' <situation>
                      |   '*TTL' <interval>
                      |   '*SIT' <situation> '*OR' '*TTL' <interval>


<quoted_string>        ~ <single_quoted_string> | <double_quoted_string>

<single_quoted_string> ~ <singlequote> <string_without_single_quote_or_vertical_space> <singlequote>

<null_string>          ~ <singlequote><singlequote>

<double_quoted_string> ~ <doublequote> <string_without_double_quote_or_vertical_space> <doublequote>

<singlequote>          ~ [']

<doublequote>          ~ ["]

<string_without_single_quote_or_vertical_space> ~ [^']+

<string_without_double_quote_or_vertical_space> ~ [^"]+


<enum>                 ~  [*\w]+

<digit>                ~ [\d]

<digits>               ~ [\d]+

<number>               ~ <digits> | <digits>'.'<digits>

<alpha>                ~ [A-Za-z]

<alphanump>            ~ [A-Za-z0-9_]*

<id>                   ~ <alpha><alphanump>

<idx>                  ~ [^\s\.]+

<literal_word>         ~ [\S]+

<digit2>               ~ [0-2]

<digit6>               ~ [0-6]

<interval>             ~ <digits>':'<digit2><digit>':'<digit6><digit>':'<digit6><digit>

ws                     ~ [\s]+


END_OF_DSL

#$DB::single=2;
$grammar = Marpa::R2::Scanless::G->new({ source => \$dsl,});
#$DB::single=2;
$recce = Marpa::R2::Scanless::R->new(
{ grammar => $grammar,
semantics_package => 'My_Actions',
trace_terminals => 1,
trace_values => 1,
});

#$DB::single=2;
my $pdt = <<'END_OF_PDT';
*IF *VALUE NT_Services.Current_State *NE Running *AND *VALUE NT_Services.Display_Name_U *IN ('MSSQL$SQL027301','SQLAgent$SQL027301','SQL Server Agent (SQL027303)','SQL Server (SQL027303)')
END_OF_PDT

#$DB::single=2;
$recce->read( \$pdt );

#$DB::single=2;
my $value_ref = $recce->value;
#$DB::single=2;
my $value = $value_ref ? ${$value_ref} : 'No Parse';
#$DB::single=2;
my $progress_report = $recce->show_progress( 0, -1 );
$DB::single=2;
exit 0;

sub My_Actions::do_basic {
    return undef;
}
sub My_Actions::do_value_in {
    return undef;
}