next up previous contents index PLPL moodlepserratamodulosperlmonksperldocapuntes LHPgoogleetsiiullpcgull
Sig: Práctica: Calculadora con Regexp::Grammars Sup: Análisis Sintáctico con Regexp::Grammars Ant: Simplificando el AST Err: Si hallas una errata ...

Subsecciones



Reciclando una Regexp::Grammar

Ejecución

El siguiente programa calculator.pl recibe como entrada una expresión en infijo.

La ejecución consta de dos bucles. En la primera parte se inyecta a la jerarquía de clases de los AST generados para las expresiones en infijo una semántica que permite evaluar la expresión:

    58  require EvalCalc;
    59
    60  test_calc(
    61    'Evaluating infix arithmetic expressions (CTRL-D to end in unix) ',
    62    sub { print &Data::Dumper::Dumper(shift()) },
    63  );
En esta primera parte mostraremos además el AST construido para la expresión infija de entrada.
pl@nereida:~/Lregexpgrammars/demo$ ./calculator.pl
Evaluating infix arithmetic expressions (CTRL-D to end in unix)
8-4-2
$VAR1 = bless( {
  'operands' => [
    bless( {
      'operands' => [
        bless( {
          'operands' => [
            bless( {
              'operands' => [
                bless( {
                  'operands' => [
                    bless( { '' => '8', 'val' => '8' }, 'factor' )
                  ],
                  '' => '8'
                }, 'factorial' )
              ],
              '' => '8'
            }, 'power' )
          ],
          '' => '8'
        }, 'uneg' )
      ],
      '' => '8'
    }, 'term' ),
    bless( {
      'operands' => [
        bless( {
          'operands' => [
            bless( {
              'operands' => [
                bless( {
                  'operands' => [
                    bless( { '' => '4', 'val' => '4' }, 'factor' )
                  ],
                  '' => '4'
                }, 'factorial' )
              ],
              '' => '4'
            }, 'power' )
          ],
          '' => '4'
        }, 'uneg' )
      ],
      '' => '4'
    }, 'term' ),
    bless( {
      'operands' => [
        bless( {
          'operands' => [
            bless( {
              'operands' => [
                bless( {
                  'operands' => [
                    bless( { '' => '2', 'val' => '2' }, 'factor' )
                  ],
                  '' => '2'
                }, 'factorial' )
              ],
              '' => '2'
            }, 'power' )
          ],
          '' => '2'
        }, 'uneg' )
      ],
      '' => '2'
    }, 'term' )
  ],
  '' => '8-4-2',
  'operators' => [
    '-',
    '-'
  ]
}, 'expr' );
2
Observamos que la asociatividad es la correcta. El 2 final es el resultado de la evaluación de 8-4-2.

La estructura del árbol se corresponde con la de la gramática:

 8  my $rbb = do {
 9      use Regexp::Grammars;
10
11      qr{
12        \A<expr>\z
13
14        <objrule: expr>      <[operands=term]> ** <[operators=addop]>
15
16        <objrule: term>      <[operands=uneg]> ** <[operators=mulop]>
17
18        <objrule: uneg>      <[operators=minus]>* <[operands=power]>
19
20        <objrule: power>     <[operands=factorial]> ** <[operators=powerop]>
21
22        <objrule: factorial> <[operands=factor]>  <[operators=(!)]>*
23
24        <objrule: factor>    <val=([+-]?\d+(?:\.\d*)?)>
25                           | \( <MATCH=expr> \)
26
27        <token: addop>        [+-]
28
29        <token: mulop>        [*/]
30
31        <token: powerop>      \*\*|\^
32
33        <token: minus>        - <MATCH=(?{ 'NEG' })>
34
35      }x;
36  };

Ahora, en una segunda parte sobreescribimos los métodos sem que describen la semántica para producir una traducción de infijo a postfijo:

 66  require PostfixCalc;
 67  test_calc('Translating expressions to postfix (CTRL-D to end in unix) ');
Ahora al proporcionar la entrada 6--3! obtenemos:
Translating expressions to postfix (CTRL-D to end in unix)
6--3!
6 3 ! ~ -
Aquí ~ es el operador de negación unaria y ! es el operador factorial.

Estructura de la aplicación

Estos son los ficheros que integran la aplicación:

pl@nereida:~/Lregexpgrammars/demo/calculator$ tree
.
|-- EvalCalc.pm            # Soporte para la evaluación de la expresión: sem
|-- Operator.pm            # Soporte a las clases nodo: recorridos
|-- PostfixCalc.pm         # Soporte para la traducción a postfijo: sem
`-- calculator.pl          # programa principal

Programa principal

En el programa principal definimos la gramática y escribimos una subrutina test_calc que realiza el parsing.

pl@nereida:~/Lregexpgrammars/demo/calculator$ cat -n calculator.pl
    1   #!/usr/bin/env perl5.10.1
    2   use strict;
    3   use warnings;
    4   use 5.010;
    5   use Data::Dumper;
    6   $Data::Dumper::Indent = 1;
    7 
    8   my $rbb = do {
    9       use Regexp::Grammars;
   10 
   11       qr{
   12         \A<expr>\z
   13 
   14         <objrule: expr>      <[operands=term]> ** <[operators=addop]>
   15 
   16         <objrule: term>      <[operands=uneg]> ** <[operators=mulop]>
   17 
   18         <objrule: uneg>      <[operators=minus]>* <[operands=power]>
   19 
   20         <objrule: power>     <[operands=factorial]> ** <[operators=powerop]>
   21 
   22         <objrule: factorial> <[operands=factor]>  <[operators=(!)]>*
   23 
   24         <objrule: factor>    <val=([+-]?\d+(?:\.\d*)?)>
   25                            | \( <MATCH=expr> \)
   26 
   27         <token: addop>        [+-]
   28 
   29         <token: mulop>        [*/]
   30 
   31         <token: powerop>      \*\*|^
   32 
   33         <token: minus>        - <MATCH=(?{ 'NEG' })>
   34 
   35       }x;
   36   };
   37 
   38   sub test_calc {
   39     my $prompt = shift;
   40     my $handler = shift;
   41 
   42     say $prompt;
   43     while (my $input = <>) {
   44         chomp($input);
   45         if ($input =~ m{$rbb}) {
   46             my $tree = $/{expr};
   47             $handler->($tree) if $handler;
   48 
   49             say $tree->ceval;
   50 
   51         }
   52         else {
   53             say("does not match");
   54         }
   55     }
   56   }
   57 
   58   require EvalCalc;
   59 
   60   test_calc(
   61     'Evaluating infix arithmetic expressions (CTRL-D to end in unix) ',
   62     sub { print &Data::Dumper::Dumper(shift()) },
   63   );
   64 
   65 
   66   require PostfixCalc;
   67   test_calc('Translating expressions to postfix (CTRL-D to end in unix) ');

Los nodos del AST poseen un método ceval que se encarga de realizar la traducción del nodo.

Las Clases de nodos del AST

pl@nereida:~/Lregexpgrammars/demo/calculator$ cat -n Operator.pm
   1  #   Class hierarchy diagram:
   2  #  $ vgg -t 'Operator(LeftBinaryOp(expr,term),RightBinaryOp(power),PreUnaryOp(uneg),PostUnaryOp(factorial))'
   3  #                           +--------+
   4  #                           |Operator|
   5  #                           +--------+
   6  #          .---------------.----^--------.-------------.
   7  #    +------------+ +-------------+ +----------+ +-----------+
   8  #    |LeftBinaryOp| |RightBinaryOp| |PreUnaryOp| |PostUnaryOp|
   9  #    +------------+ +-------------+ +----------+ +-----------+
  10  #      .---^--.        |              |               |
  11  #    +----+ +----+  +-----+         +----+       +---------+
  12  #    |expr| |term|  |power|         |uneg|       |factorial|
  13  #    +----+ +----+  +-----+         +----+       +---------+
  14  #
  15  #
  16  # NOTE: package "factor" actually implements numbers and is
  17  #       outside this hierarchy
  18  #
  19  package Operator;
  20  use strict;
  21  use Carp;
  22
  23  sub Operands {
  24    my $self = shift;
  25
  26    return () unless exists $self->{operands};
  27    return @{$self->{operands}};
  28  }
  29
  30  sub Operators {
  31    my $self = shift;
  32
  33    return () unless exists $self->{operators};
  34    return @{$self->{operators}};
  35  }
  36
  37  sub sem {
  38    confess "not defined sem";
  39  }
  40
  41  sub make_sem {
  42    my $class = shift;
  43    my %semdesc = @_;
  44
  45    for my $class (keys %semdesc) {
  46      my %sem = %{$semdesc{$class}};
  47
  48      # Install 'sem' method in $class
  49      no strict 'refs';
  50      no warnings 'redefine';
  51      *{$class."::sem"} = sub {
  52        my ($self, $op) = @_;
  53        $sem{$op}
  54      };
  55    }
  56  }
  57
  58  package LeftBinaryOp;
  59  use base qw{Operator};
  60
  61  sub ceval {
  62    my $self = shift;
  63
  64    # recursively evaluate the children first
  65    my @operands = map { $_->ceval } $self->Operands;
  66
  67    # then combine them
  68    my $s = shift @operands;
  69    for ($self->Operators) {
  70      $s = $self->sem($_)->($s, shift @operands);
  71    }
  72    return $s;
  73  }
  74
  75  package RightBinaryOp;
  76  use base qw{Operator};
  77
  78  sub ceval {
  79    my $self = shift;
  80
  81    # recursively evaluate the children first
  82    my @operands = map { $_->ceval } $self->Operands;
  83
  84    # then combine them
  85    my $s = pop @operands;
  86    for (reverse $self->Operators) {
  87      $s = $self->sem($_)->(pop @operands, $s);
  88    }
  89    return $s;
  90  }
  91
  92  package PreUnaryOp;
  93  use base qw{Operator};
  94
  95  sub ceval {
  96    my $self = shift;
  97
  98    # recursively evaluate the children first
  99    my @operands = map { $_->ceval } $self->Operands;
 100
 101    # then combine them
 102    my $s = shift @operands;
 103    for (reverse $self->Operators) {
 104      $s = $self->sem($_)->($s);
 105    }
 106    return $s;
 107  }
 108
 109  package PostUnaryOp;
 110  use base qw{Operator};
 111
 112  sub ceval {
 113    my $self = shift;
 114
 115    # recursively evaluate the children first
 116    my @operands = map { $_->ceval } $self->Operands;
 117
 118    # then combine them
 119    my $s = shift @operands;
 120    for ($self->Operators) {
 121      $s = $self->sem($_)->($s);
 122    }
 123    return $s;
 124  }
 125
 126  package term;
 127  use base qw{LeftBinaryOp};
 128
 129  package expr;
 130  use base qw{LeftBinaryOp};
 131
 132  package power;
 133  use base qw{RightBinaryOp};
 134
 135  package uneg;
 136  use base qw{PreUnaryOp};
 137
 138  package factorial;
 139  use base qw{PostUnaryOp};
 140
 141  package factor;
 142
 143  sub ceval {
 144    my $self = shift;
 145
 146    return $self->{val};
 147  }
 148
 149  1;

Definiendo sem para la evaluación de la expresión

pl@nereida:~/Lregexpgrammars/demo/calculator$ cat -n EvalCalc.pm
 1  package EvalCalc;
 2  use strict;
 3  use Carp;
 4
 5  use Operator;
 6
 7  ####
 8  sub f {
 9    $_[0]>1?$_[0]*f($_[0]-1):1;
10  }
11
12  sub fac {
13    my $n = shift;
14
15    confess "Not valid number" unless $n =~ /^\d+$/;
16    f($n);
17  };
18
19  my $s = sub { shift() **  shift() };
20
21  Operator->make_sem(
22     expr => {
23        '+' => sub { shift()  +  shift() },
24        '-' => sub { shift()  -  shift() },
25     },
26     term => {
27       '*' => sub { shift()  *  shift() },
28       '/' => sub { shift()  /  shift() },
29     },
30     power => {
31        '^'  => $s,
32        '**' => $s,
33     },
34     uneg => {
35        'NEG' => sub { -shift() },
36     },
37     factorial => {
38        '!' => \&fac,
39     },
40  );
41
42  1;

Definiendo sem para la traducción a postfijo

pl@nereida:~/Lregexpgrammars/demo/calculator$ cat -n PostfixCalc.pm
 1  package PostfixCalc;
 2  use strict;
 3
 4  use Operator;
 5
 6  # Modify semantics: now translate to postfix
 7  my $powers = sub { shift().' '.shift().' **' };
 8
 9  Operator->make_sem(
10     expr => {
11        '+' => sub { shift().' '.shift().' +'  },
12        '-' => sub { shift().' '.shift().' -' },
13      },
14      term => {
15        '*' => sub { shift().' '.shift().' *'  },
16        '/' => sub { shift().' '.shift().' /' },
17      },
18      power => {
19        '^'  => $powers,
20        '**' => $powers,
21      },
22      uneg => {
23         # use ~ for unary minus
24        'NEG' => sub { shift().' ~' },
25      },
26      factorial => {
27        '!' => sub { shift().' !'},
28      },
29  );
30
31  1;

Ejercicio 3.11.2  


next up previous contents index PLPL moodlepserratamodulosperlmonksperldocapuntes LHPgoogleetsiiullpcgull
Sig: Práctica: Calculadora con Regexp::Grammars Sup: Análisis Sintáctico con Regexp::Grammars Ant: Simplificando el AST Err: Si hallas una errata ...
Casiano Rodríguez León
2012-05-22