Por ejemplo, después de la llamada:
my $lex = Lexer->new('\s*', #espacios '\d+(\.\d+)?'=>'NUMBER', '#.*'=>'COMMENT', '"[^"]*"'=>'STRING', '\$[a-zA-Z_]\w*'=>'VAR', '[a-zA-Z_]\w*'=>'ID', '.'=>'OTHER');la variable
$lex
contendrá una referencia a una subrutina
que se creará dinámicamente y cuyo código
es similar al siguiente:
sub { $_[0] =~ s/\A\s*//; $_[0] =~ s/\A(\d+(\.\d+)?)// and return ("$1", 'NUMBER'); $_[0] =~ s/\A(#.*)// and return ("$1", 'COMMENT'); $_[0] =~ s/\A("[^"]*")// and return ("$1", 'STRING'); $_[0] =~ s/\A(\$[a-zA-Z_]\w*)// and return ("$1", 'VAR'); $_[0] =~ s/\A([a-zA-Z_]\w*)// and return ("$1", 'ID'); $_[0] =~ s/\A(.)// and return ("$1", 'OTHER'); $_[0] =~ s/(.|\n)// and return ("$1", ''); # 'tragamos' el resto return; # la cadena es vacía }Recordemos que el ancla
\A
casa con el comienzo de la cadena, incluso si
esta es multilínea. Esta metodología es descrita por Conway en [8].
Obsérvese que una vez mas, Perl se aparta de la ortodoxia: en otros lenguajes
un objeto suele adoptar la forma de un struct
o hash. En Perl cualquier
cosa que se bendiga puede ser promocionada a la categoría de objeto.
En este caso es una subrutina.
Veamos primero el código del constructor, situado en el
módulo Lexer.pm
:
package Lexer; $VERSION = 1.00; use strict; sub new { my $class = shift; # El nombre del paquete my $spaces = shift; # Los espacios en blanco a "tragar" my $end_sub =<<EOS; \$_[0] =~ s/(.|\\n)// and return ("\$1", ''); # 'tragamos' el resto return; # la cadena es vacía } EOS my $code = "sub {\n \$_[0] =~ s/\\A$spaces//;\n"; while (my ($regexp, $token) = splice @_, 0, 2) { my $lexer_line =<<EOL; \$_[0] =~ s/\\A($regexp)// and return ("\$1", '$token'); EOL $code .= $lexer_line; } $code .= $end_sub; my $sub = eval $code or die "Error en la definición de los terminales\n"; bless $sub, $class; }Obsérvese que, al bendecirla, estamos elevando la subrutina
$sub
a la categoría de objeto, facilitando de este modo
extract_next
que recibiendo como entrada
la cadena a analizar elimine de la misma el siguiente
terminal:
($val, $token) = $lex->extract_next($input);El código de dicho método será:
sub extract_next { &{$_[0]}($_[1]); # $lex->extract_next($data) <=> $lex($data) }pero es posible tener también un método
lookahead
que devuelva la misma información sin eliminar el terminal
(aunque en el siguiente código si que se eliminan los blancos iniciales)
de la cadena de entrada:
sub lookahead { my ($val, $token) = &{$_[0]}($_[1]); $_[1] = $val.$_[1]; return ($val, $token); }y asi, cuantos métodos hagan falta. Por ejemplo, podemos introducir un método
extract_all
que produzca la lista completa
de parejas (cadena, identificador-de-terminal)
sin destruir la entrada:
sub extract_all { my ($self, $input) = @_; # no destructivo my @tokens = (); while ($input) { push @tokens, &{$self}($input); } return @tokens; }Veamos un ejemplo de uso. El programa
uselexer.pl
hace uso del
package/clase, creando primero un objeto de la clase
Lexer
y utilizando después dos de sus métodos:
#!/usr/bin/perl -w use Lexer; my ($val, $token); my $lex = Lexer->new('\s*', #espacios '\d+(\.\d+)?'=>'NUMBER', '#.*'=>'COMMENT', '"[^"]*"'=>'STRING', '\$[a-zA-Z_]\w*'=>'VAR', '[a-zA-Z_]\w*'=>'ID', '.'=>'OTHER'); undef($/); #token a token; lectura destructiva my $input = <>; while (($val, $token) = $lex->extract_next($input)) { print "$token -> $val\n"; } # todos a la vez $input = <>; my @tokens = $lex->extract_all($input); print "@tokens\n";Ejemplo de ejecución:
$ ./uselexer.pl $a = 34; # comentariopulsamos
CTRl-D
y obtenemos la salida:
VAR -> $a OTHER -> = NUMBER -> 34 OTHER -> ; COMMENT -> # comentarioDe nuevo damos la misma entrada, pero ahora utilizaremos el método no destructivo
extract_all
:
$a = 34; #comentariopulsamos
CTRl-D
de nuevo y obtenemos la salida:
$a VAR = OTHER 34 NUMBER ; OTHER #comentario COMMENT