#!/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(@_); }