marpa jexl

#!/usr/bin/env perl
use 5.010;
use strict;
use warnings;
use Marpa::R2;
use Data::Dumper;

my $grammar = Marpa::R2::Grammar->new(
                                       {
                                        start          => 'jexl_expr',
                                        actions        => 'My_Actions',
                                        default_action => 'print_tokens',
                                        terminals => [qw/CHARSET DOT OPEN_PAREN CLOSE_PAREN LOGICAL_AND LOGICAL_OR LOGICAL_NOT
                                        GT LT LE GE EQ NE
                                        /],
                                        rules          => [
                                        {lhs => 'jexl_expr', rhs => [qw/logical_expr/] },
                                        {lhs => 'logical_expr', rhs => [qw/OPEN_PAREN logical_expr CLOSE_PAREN/] },
                                        {lhs => 'logical_expr', rhs => [qw/test_expr LOGICAL_AND test_expr/] },
                                        {lhs => 'logical_expr', rhs => [qw/test_expr LOGICAL_OR test_expr/] },
                                        {lhs => 'test_expr', rhs => [qw/method_call/] },
                                        {lhs => 'test_expr', rhs => [qw/method_call test_operators LITERALS/] },
                                        {lhs => 'test_expr', rhs => [qw/method_call test_operators method_call/] },
                                        {lhs => 'test_operators', rhs => [qw/GT/] },
                                        {lhs => 'test_operators', rhs => [qw/GE/] },
                                        {lhs => 'test_operators', rhs => [qw/LT/] },
                                        {lhs => 'test_operators', rhs => [qw/LE/] },
                                        {lhs => 'test_operators', rhs => [qw/EQ/] },
                                        {lhs => 'test_operators', rhs => [qw/NE/] },
                                        {lhs => 'method_call', rhs => [qw/method/] },
                                        {lhs => 'method_call', rhs => [qw/method OPEN_PAREN CLOSE_PAREN/] },
                                        {lhs => 'method', rhs => [qw/identifier/] },
                                        {lhs => 'method', rhs => [qw/identifier DOT obj_function/] },
                                        {lhs => 'identifier', rhs => [qw/CHARSET/] },
                                        {lhs => 'obj_function', rhs => [qw/CHARSET/] }
                                        ]
                                       }
                                     );

$grammar->precompute();

say $grammar->show_symbols();
say $grammar->show_rules();

my $text = q{ngp.equals()};

my @tokens;
sub tokenizer {
    #say "toks", @_;
    push @tokens, [@_];
}

my @initSplit = split /([a-zA-z0-9_]+)/, $text;
#say "init split text:@initSplit";
my @splitText = map { if (/[a-zA-z0-9_]/) {$_}else{ split //;} } @initSplit;
#say "split text:@splitText";

while (@splitText) {
    my $tok = shift @splitText;
    #say "read tok:$tok";
    if ( $tok =~ /\w+/ ) {
        tokenizer( CHARSET => $tok );
    }
    elsif ( $tok eq "." ) {
        tokenizer( 'DOT' );
    }
    elsif ( $tok eq "(" ) {
        tokenizer( 'OPEN_PAREN');
    }
    elsif ( $tok eq ")" ) {
        tokenizer( 'CLOSE_PAREN' );
    }
    elsif ( $tok eq "&" ) {
        my $advtok = $splitText[0];
        if ( $advtok eq "&" ) {
            shift @splitText;
            tokenizer( 'LOGICAL_AND' );
        }
        else {
            say "unexpected token";
        }
    }
    elsif ( $tok eq "|" ) {
        my $advtok = $splitText[0];
        if ( $advtok eq "|" ) {
            shift @splitText;
            tokenizer( 'LOGICAL_OR' );
        }
        else {
            say "unexpected token";
        }
    }
    elsif ( $tok eq ">" ) {
        my $advtok = $splitText[0];
        if ( $advtok eq "=" ) {
            shift @splitText;
            tokenizer( 'GE' );
        }
        else {
            tokenizer( 'GT' );
        }
    }
    elsif ( $tok eq "<" ) {
        my $advtok = $splitText[0];
        if ( $advtok eq "=" ) {
            shift @splitText;
            tokenizer( 'LE' );
        }
        else {
            tokenizer( 'LT' );
        }
    }
    elsif ( $tok eq "=" ) {
        my $advtok = $splitText[0];
        if ( $advtok eq "=" ) {
            shift @splitText;
            tokenizer( 'EQ' );
        }
        else {
            say "unexpected token";
        }
    }
    elsif ( $tok eq "!" ) {
        my $advtok = $splitText[0];
        if ( $advtok eq "=" ) {
            shift @splitText;
            tokenizer( 'NE' );
        }
        else {
            say "unexpected token";
        }
    }
    else {
        say "unexpected token:<$tok>";
    }

}

say Dumper(@tokens);

my $recce = Marpa::R2::Recognizer->new( { grammar => $grammar , trace_terminals => 1, trace_actions => 1,
                                        trace_values => 1 } );
foreach my $tok ( @tokens )
{
    say "reading: @$tok";
    $recce->read( @$tok );
}
#$recce->read('CHARSET', "abc");
#$recce->read('LOGICAL_AND');
#$recce->read('CHARSET', "def");

my $value_ref = $recce->value;
my $value = $value_ref ? ${$value_ref} : 'No Parse';
say "value:$value";

#say "progress:\n", Dumper($recce->progress());


sub My_Actions::print_tokens {
    say Dumper(@_);
}