Práctica: Números de Línea, Errores, Cadenas y Comentarios

Extienda el analizador léxico para que:

Reescriba la expresión regular para las cadenas de manera que acepte comillas dobles escapadas \" en el interior de una cadena. Por ejemplo en "esta \"palabra\" va entre comillas".
Analice esta solución ¿Es correcta?:
```
 DB<1> $stringre = qr{"(\\.|[^\\"])*"}
 DB<2> print $& if '"esta \"palabra\" va entre comillas"' =~ $stringre
 "esta \"palabra\" va entre comillas"
```
Consuma comentarios a la Perl: cualesquiera caracteres después de una almohadilla hasta el final de la línea (# ...).

Consuma comentarios no anidados a la C (/* ... */.). Repase las secciones sobre expresiones regulares no ``greedy'' (p. ej. sección 1.1.1) y la sección 1.1.1. Recuerde que, en una expresión regular, la opción /s hace que el punto '.' empareje con un retorno de carro \n. Esto es, el punto ``casa'' con cualquier carácter.

Observe el siguiente ejemplo:

pl@nereida:~/src/perl/testing$ cat -n ccomments.pl
 1  #!/usr/bin/perl -w
 2  use strict;
 3
 4  sub showmatches {
 5   my ($x, $re) = @_;
 6
 7    for (my $i = 0; $x =~ /$re/gsx; $i++) {
 8      print "matching $i: $1\n";
 9      $i++;
10    }
11  }
12
13  my $x = <<'EOC';
14  if (x) {
15    /* a comment */ return x + 1; /* another comment */
16  }
17  else {
18    return x + 2; /* a last comment */
19  }
20  EOC
21
22  print "\n************************\n";
23
24  my $greedy = q{ (
25           /\*  # Abrir comentario
26           .*   # Consumir caracteres (greedy)
27           \*/  # Cerrar comentario
28           )
29  };
30  print "Greedy:\n";
31  showmatches($x, $greedy);
32
33  print "\n************************\n";
34
35  my $lazy = q{ (
36           /\*  # Abrir comentario
37           .*?  # Consumir caracteres (lazy)
38           \*/  # Cerrar comentario
39           )
40  };
41  print "Lazy:\n";
42  showmatches($x, $lazy);

Cuando se ejecuta produce:

pl@nereida:~/src/perl/testing$ ccomments.pl

************************
Greedy:
matching 0: /* a comment */ return x + 1; /* another comment */
}
else {
  return x + 2; /* a last comment */

************************
Lazy:
matching 0: /* a comment */
matching 2: /* another comment */
matching 4: /* a last comment */

Explique la conducta.

Números en punto flotante (como -1.32e-04 o .91). El siguiente ejemplo intenta ayudarle en la búsqueda de la solución:

lhp@nereida:~$ perl -de 0
  DB<1> print "Si" if  ('.5' =~ m{\d+})
Si
  DB<2> print "Si" if  ('.5' =~ m{^\d+})

  DB<3> print "Si" if  '0.7' =~ m{^\d+(\.\d+)?(e[+-]?\d+)?$}
Si
  DB<4> print "Si" if  '.7' =~ m{^\d+(\.\d+)?(e[+-]?\d+)?$}

  DB<5> print "Si" if  '1e2' =~ m{^\d+(\.\d+)?(e[+-]?\d+)?$}
Si
  DB<6> print "Si " while  'ababa' =~ m{a}g
Si Si Si
  DB<7> print "@a" if @a = 'ababa' =~ m{(a)}g
a a a

¿Sabría decir porque la respuesta al primer comando del depurador es si?.

Tenga presente el posible conflicto entre los terminales INT y FLOAT. Si la entrada contiene 3.5 el terminal debería ser (FLOAT, '3.5') y no (INT, 3), ('.', '.'), (INT, 5).
En esta práctica si lo desea puede instalar y usar el módulo Regexp::Common mantenido por Abigail el cual provee expresiones regulares para las situaciones mas comunes: números, teléfonos, IP, códigos postales, listas, etc. Puede incluso usarlo para encontrar soluciones a las cuestiones planteadas en esta práctica:
```
nereida:~/doc/casiano/PLBOOK/PLBOOK> perl -MRegexp::Common -e 'print "$RE{num}{int}\n"'
(?:(?:[+-]?)(?:[0123456789]+))
```
Podemos hacer uso directo del hash %RE directamente en las expresiones regulares aprovechando que estas interpolan las variables en su interior:
```
nereida:/tmp> cat -n prueba.pl
     1  #!/usr/bin/perl -w
     2  use strict;
     3  use Regexp::Common;
     4
     5  my $input = <>;
     6
     7  print "$&\n" if $input =~ /^$RE{num}{real}$/;
nereida:/tmp> ./prueba.pl
23.45
23.45
nereida:/tmp> ./prueba.pl
jshdf
nereida:/tmp>
```

Para mejorar la calidad de los mensajes de error extienda el par (terminal, valor) devuelto por el scanner a un par (terminal, [valor, número de línea ]) cuya segunda componente es un array anónimo conteniendo el valor y el número de línea en el que aparece el terminal.

El siguiente extracto de un analizador léxico muestra como hacerlo:

sub _Lexer {

  return('', undef) unless defined($input);

  #Skip blanks
      $input=~m{\G((?:
              \s+       # any white space char
          |   \#[^\n]*  # Perl like comments
          )+)}xsgc
    and do {
        my($blanks)=$1;

        #Maybe At EOF
            pos($input) >= length($input)
        and return('', undef);
        $tokenend += $blanks =~ tr/\n//;
    };
    
    $tokenbegin = $tokenend;

      $input=~/\G(and)/gc
    and return($1, [$1, $tokenbegin]);

      $input=~/\G(?:[A-Za-z_][A-Za-z0-9_]*::)*([A-Za-z_][A-Za-z0-9_]*)/gc
    and do {
      return('IDENT', [$1, $tokenbegin]);
    };

    ....................

        $input=~/\G{/gc
    and do {
        my($level,$from,$code);

        $from=pos($input);

        $level=1;
        while($input=~/([{}])/gc) {
                substr($input,pos($input)-1,1) eq '\\' #Quoted
            and next;
                $level += ($1 eq '{' ? 1 : -1)
            or last;
        }
            $level
        and  _SyntaxError("Not closed open curly bracket { at $tokenbegin");
        $code = substr($input,$from,pos($input)-$from-1);
        $tokenend+= $code=~tr/\n//;
        return('CODE', [$code, $tokenbegin]);
    };


    #Always return something
      $input=~/\G(.)/sg
    and do {
      $1 eq "\n" and ++$tokenend;
      return ($1, [$1, $tokenbegin]);
    };
    #At EOF
    return('', undef);
}

El operador tr ha sido utilizado para contar los retornos de carro (descrito en la sección 1.5). El operador, ademas de reemplazar devuelve el número de carácteres reeemplazados o suprimidos:

$cuenta = $cielo =~ tr/*/*/; # cuenta el numero de estrellas en cielo

Para aprender soluciones alternativas consulte perldoc -q 'substring'.

Mejore sus mensajes de error ahora que lleva la cuenta de los números de línea. En vez de usar las rutinas error y fatal introducidas en la sección anterior escriba una sola rutina que recibe el nivel de severidad del error (parámetro $level en el siguiente ejemplo) y ejecuta la acción apropiada. El código de _SyntaxError ilustra como hacerlo:

sub _SyntaxError {
  my($level,$message,$lineno)=@_;

  $message= "*".
      [ 'Warning', 'Error', 'Fatal' ]->[$level].
      "* $message, at ".
      ($lineno < 0 ? "eof" : "line $lineno")." at file $filename\n";

      $level > 1
  and die $message;

  warn $message;

  $level > 0 and ++$nberr;

      $nberr == $max_errors
  and die "*Fatal* Too many errors detected.\n"
}

Casiano Rodríguez León
2012-01-30