¿Cómo imprimo una expresión regular expandida en forma no expandida?

¿Es posible imprimir una expresión regular creada usando notación expandida ( qr/.../x) en forma no expandida? Por ejemplo:

my $decimal = qr/
  (?=\d|\.\d)  # look-ahead to ensure at least one of the optional parts matches
  \d*          # optional whole digits
  (?:\.\d*)?   # optional decimal point and fractional digits
/x;

say $decimal;

Quiero que esto se imprima como (?=\d|\.\d)\d*(?:\.\d*)?.

Podría escribir un analizador sintáctico para eliminar las partes no funcionales, pero eso sería replicar lo que ya hace Perl y probablemente me equivocaría en algunos de los casos no triviales.

(Sí, esto parece un poco tonto. Tengo un caso de uso en el que necesito imprimir una gran cantidad de mensajes matched <pattern>y me gustaría limitar los mensajes a una sola línea al tiempo que permitiré usar la notación expandida para los patrones).

Perl no proporciona esa utilidad. Analiza patrones de expresiones regulares; No los genera. La stringificación del objeto es la cadena exacta proporcionada al analizador, envuelta en una (?:...)que representa las banderas. La cadena proporcionada al analizador es el literal posterior a la interpolación menos los delimitadores. ^[1]

Dicho esto, esto sería trivial con un analizador de expresiones regulares.

Hay YAPE :: Regex , pero no se ha actualizado en mucho tiempo. Por ejemplo, no admite lo (?^:...)encontrado en la stringificación de expresiones regulares en la versión moderna de Perl.

También hay Regexp :: Parser . ¡Es más nuevo, pero tampoco es compatible (?^:...)! Pero si tuviéramos que solucionar eso, sería perfecto ya que, naturalmente, ignora los espacios en blanco y los comentarios. Todo lo que necesitamos hacer es analizar el patrón y obtener una cadena de caracteres del árbol de análisis.

Finalmente, está Regexp :: Parsertron . Es el más nuevo y es compatible (?^:...), pero no distingue espacios en blanco y comentarios de tokens de "coincidencias exactas".

Entonces usemos Regexp :: Parser. ^[2]

#!/usr/bin/perl
use strict;
use warnings;
use feature qw( say );

use Regexp::Parser qw( );

{
   @ARGV == 1
      or die("usage\n");

   my $re = $ARGV[0];

   # R::P doesn't support «(?^:...)», so we'll
   # provide a backwards-compatible stringification.
   $re =~ s{^\(\?\^(\w*):}{
      my %on = map { $_ => 1 } split //, $1;
      my $on  = join "", grep  $on{$_}, qw( i m s x );
      my $off = join "", grep !$on{$_}, qw( i m s x );
      "(?$on-$off:"
   }e;

   my $parser = Regexp::Parser->new($re);
   my $roots = $parser->root
      or die($parser->errmsg);

   say join "", map $_->visual, @$roots;
}

Prueba:

$ despace_re '(?^x:
   (?=\d|\.\d)  # look-ahead to ensure at least one of the optional parts matches
   \d*          # optional whole digits
   (?:\.\d*)?   # optional decimal point and fractional digits
)'
(?x-ims:(?=\d|\.\d)\d*(?:\.\d*)?)

1. \Q, \uy similares se realizan en la misma etapa en la interpolación. \N{...}se resuelve para \N{U+...}inmortalizar la configuración actual de nombres de caracteres. Otro escapa tales como \x27, \x{0000027}, \\y \/se conservan carácter a carácter.

2. Se utilizó una solución basada en YAPE :: Regex en una revisión anterior de esta respuesta.