Don't like ads? PRO users don't see any ads ;-)
Public Pastes
Guest

marpa jexl

By: chipkare on Oct 20th, 2012  |  syntax: Perl  |  size: 5.42 KB  |  hits: 4  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. #!/usr/bin/env perl
  2. use 5.010;
  3. use strict;
  4. use warnings;
  5. use Marpa::R2;
  6. use Data::Dumper;
  7.  
  8. my $grammar = Marpa::R2::Grammar->new(
  9.                                        {
  10.                                         start          => 'jexl_expr',
  11.                                         actions        => 'My_Actions',
  12.                                         default_action => 'print_tokens',
  13.                                         terminals => [qw/CHARSET DOT OPEN_PAREN CLOSE_PAREN LOGICAL_AND LOGICAL_OR LOGICAL_NOT
  14.                                         GT LT LE GE EQ NE
  15.                                         /],
  16.                                         rules          => [
  17.                                         {lhs => 'jexl_expr', rhs => [qw/logical_expr/] },
  18.                                         {lhs => 'logical_expr', rhs => [qw/OPEN_PAREN logical_expr CLOSE_PAREN/] },
  19.                                         {lhs => 'logical_expr', rhs => [qw/test_expr LOGICAL_AND test_expr/] },
  20.                                         {lhs => 'logical_expr', rhs => [qw/test_expr LOGICAL_OR test_expr/] },
  21.                                         {lhs => 'test_expr', rhs => [qw/method_call/] },
  22.                                         {lhs => 'test_expr', rhs => [qw/method_call test_operators LITERALS/] },
  23.                                         {lhs => 'test_expr', rhs => [qw/method_call test_operators method_call/] },
  24.                                         {lhs => 'test_operators', rhs => [qw/GT/] },
  25.                                         {lhs => 'test_operators', rhs => [qw/GE/] },
  26.                                         {lhs => 'test_operators', rhs => [qw/LT/] },
  27.                                         {lhs => 'test_operators', rhs => [qw/LE/] },
  28.                                         {lhs => 'test_operators', rhs => [qw/EQ/] },
  29.                                         {lhs => 'test_operators', rhs => [qw/NE/] },
  30.                                         {lhs => 'method_call', rhs => [qw/method/] },
  31.                                         {lhs => 'method_call', rhs => [qw/method OPEN_PAREN CLOSE_PAREN/] },
  32.                                         {lhs => 'method', rhs => [qw/identifier/] },
  33.                                         {lhs => 'method', rhs => [qw/identifier DOT obj_function/] },
  34.                                         {lhs => 'identifier', rhs => [qw/CHARSET/] },
  35.                                         {lhs => 'obj_function', rhs => [qw/CHARSET/] }
  36.                                         ]
  37.                                        }
  38.                                      );
  39.  
  40. $grammar->precompute();
  41.  
  42. say $grammar->show_symbols();
  43. say $grammar->show_rules();
  44.  
  45. my $text = q{ngp.equals()};
  46.  
  47. my @tokens;
  48. sub tokenizer {
  49.     #say "toks", @_;
  50.     push @tokens, [@_];
  51. }
  52.  
  53. my @initSplit = split /([a-zA-z0-9_]+)/, $text;
  54. #say "init split text:@initSplit";
  55. my @splitText = map { if (/[a-zA-z0-9_]/) {$_}else{ split //;} } @initSplit;
  56. #say "split text:@splitText";
  57.  
  58. while (@splitText) {
  59.     my $tok = shift @splitText;
  60.     #say "read tok:$tok";
  61.     if ( $tok =~ /\w+/ ) {
  62.         tokenizer( CHARSET => $tok );
  63.     }
  64.     elsif ( $tok eq "." ) {
  65.         tokenizer( 'DOT' );
  66.     }
  67.     elsif ( $tok eq "(" ) {
  68.         tokenizer( 'OPEN_PAREN');
  69.     }
  70.     elsif ( $tok eq ")" ) {
  71.         tokenizer( 'CLOSE_PAREN' );
  72.     }
  73.     elsif ( $tok eq "&" ) {
  74.         my $advtok = $splitText[0];
  75.         if ( $advtok eq "&" ) {
  76.             shift @splitText;
  77.             tokenizer( 'LOGICAL_AND' );
  78.         }
  79.         else {
  80.             say "unexpected token";
  81.         }
  82.     }
  83.     elsif ( $tok eq "|" ) {
  84.         my $advtok = $splitText[0];
  85.         if ( $advtok eq "|" ) {
  86.             shift @splitText;
  87.             tokenizer( 'LOGICAL_OR' );
  88.         }
  89.         else {
  90.             say "unexpected token";
  91.         }
  92.     }
  93.     elsif ( $tok eq ">" ) {
  94.         my $advtok = $splitText[0];
  95.         if ( $advtok eq "=" ) {
  96.             shift @splitText;
  97.             tokenizer( 'GE' );
  98.         }
  99.         else {
  100.             tokenizer( 'GT' );
  101.         }
  102.     }
  103.     elsif ( $tok eq "<" ) {
  104.         my $advtok = $splitText[0];
  105.         if ( $advtok eq "=" ) {
  106.             shift @splitText;
  107.             tokenizer( 'LE' );
  108.         }
  109.         else {
  110.             tokenizer( 'LT' );
  111.         }
  112.     }
  113.     elsif ( $tok eq "=" ) {
  114.         my $advtok = $splitText[0];
  115.         if ( $advtok eq "=" ) {
  116.             shift @splitText;
  117.             tokenizer( 'EQ' );
  118.         }
  119.         else {
  120.             say "unexpected token";
  121.         }
  122.     }
  123.     elsif ( $tok eq "!" ) {
  124.         my $advtok = $splitText[0];
  125.         if ( $advtok eq "=" ) {
  126.             shift @splitText;
  127.             tokenizer( 'NE' );
  128.         }
  129.         else {
  130.             say "unexpected token";
  131.         }
  132.     }
  133.     else {
  134.         say "unexpected token:<$tok>";
  135.     }
  136.  
  137. }
  138.  
  139. say Dumper(@tokens);
  140.  
  141. my $recce = Marpa::R2::Recognizer->new( { grammar => $grammar , trace_terminals => 1, trace_actions => 1,
  142.                                         trace_values => 1 } );
  143. foreach my $tok ( @tokens )
  144. {
  145.     say "reading: @$tok";
  146.     $recce->read( @$tok );
  147. }
  148. #$recce->read('CHARSET', "abc");
  149. #$recce->read('LOGICAL_AND');
  150. #$recce->read('CHARSET', "def");
  151.  
  152. my $value_ref = $recce->value;
  153. my $value = $value_ref ? ${$value_ref} : 'No Parse';
  154. say "value:$value";
  155.  
  156. #say "progress:\n", Dumper($recce->progress());
  157.  
  158.  
  159. sub My_Actions::print_tokens {
  160.     say Dumper(@_);
  161. }
create a new version of this paste RAW Paste Data