Sig: Reciclando una Regexp::Grammar Sup: Análisis Sintáctico con Regexp::Grammars Ant: Mensajes de Warning Err: Si hallas una errata ...

Simplificando el AST

pl@nereida:~/Lregexpgrammars/demo$ cat -n exprdamian.pl
     1  use strict;
     2  use warnings;
     3  use 5.010;
     4  use Data::Dumper;
     5  $Data::Dumper::Indent = 1;
     6
     7  my $rbb = do {
     8      use Regexp::Grammars;
     9
    10      qr{
    11        \A<expr>\z
    12
    13        <objrule: expr>    <MATCH=term> (?! <addop> )                  # bypass
    14                         | <[operands=term]> ** <[operators=addop]>
    15
    16        <objrule: term>    <MATCH=factor> (?! <mulop> )                # bypass
    17                         | <[operands=factor]> ** <[operators=mulop]>
    18
    19        <objrule: factor>    <val=([+-]?\d+(?:\.\d*)?)>
    20                         | \( <MATCH=expr> \)
    21
    22        <token: addop> [+-]
    23
    24        <token: mulop> [*/]
    25
    26      }x;
    27  };
    28
    29  while (my $input = <>) {
    30      chomp($input);
    31      if ($input =~ m{$rbb}) {
    32          my $tree = $/{expr};
    33          say Dumper $tree;
    34          say $tree->ceval;
    35
    36      }
    37      else {
    38          say("does not match");
    39      }
    40  }
    41
    42  BEGIN {
    43
    44    package LeftBinaryOp;
    45    use strict;
    46    use base qw(Class::Accessor);
    47
    48    LeftBinaryOp->mk_accessors(qw{operators operands});
    49
    50    my %f = (
    51      '+' => sub { shift() + shift() },
    52      '-' => sub { shift() - shift() },
    53      '*' => sub { shift() * shift() },
    54      '/' => sub { shift() / shift() },
    55    );
    56
    57    sub ceval {
    58      my $self = shift;
    59
    60      # recursively evaluate the children first
    61      my @operands = map { $_->ceval } @{$self->operands};
    62
    63      # then combine them
    64      my $s = shift @operands;
    65      for (@{$self->operators}) {
    66        $s = $f{$_}->($s, shift @operands);
    67      }
    68      return $s;
    69    }
    70
    71    package term;
    72    use base qw{LeftBinaryOp};
    73
    74    package expr;
    75    use base qw{LeftBinaryOp};
    76
    77    package factor;
    78
    79    sub ceval {
    80      my $self = shift;
    81
    82      return $self->{val};
    83    }
    84
    85    1;
    86  }

Ejecuciones:

pl@nereida:~/Lregexpgrammars/demo$ perl5.10.1 exprdamian.pl
4-2-2
$VAR1 = bless( {
  'operands' => [
    bless( {
      '' => '4',
      'val' => '4'
    }, 'factor' ),
    bless( {
      '' => '2',
      'val' => '2'
    }, 'factor' ),
    bless( {
      '' => '2',
      'val' => '2'
    }, 'factor' )
  ],
  '' => '4-2-2',
  'operators' => [
    '-',
    '-'
  ]
}, 'expr' );

0
8/4/2
$VAR1 = bless( {
  'operands' => [
    bless( {
      '' => '8',
      'val' => '8'
    }, 'factor' ),
    bless( {
      '' => '4',
      'val' => '4'
    }, 'factor' ),
    bless( {
      '' => '2',
      'val' => '2'
    }, 'factor' )
  ],
  '' => '8/4/2',
  'operators' => [
    '/',
    '/'
  ]
}, 'term' );

1
3
$VAR1 = bless( {
  '' => '3',
  'val' => '3'
}, 'factor' );

3
2*(3+4)
$VAR1 = bless( {
  'operands' => [
    bless( {
      '' => '2',
      'val' => '2'
    }, 'factor' ),
    bless( {
      'operands' => [
        bless( {
          '' => '3',
          'val' => '3'
        }, 'factor' ),
        bless( {
          '' => '4',
          'val' => '4'
        }, 'factor' )
      ],
      '' => '3+4',
      'operators' => [
        '+'
      ]
    }, 'expr' )
  ],
  '' => '2*(3+4)',
  'operators' => [
    '*'
  ]
}, 'term' );

14

Sig: Reciclando una Regexp::Grammar Sup: Análisis Sintáctico con Regexp::Grammars Ant: Mensajes de Warning Err: Si hallas una errata ...