in reply to Backreference variables in code embedded inside Perl 5.10 regexps

I'm not familiar with 5.10's re improvements, so there could be a better way.
local our @stack; 'abc' =~ / (?{ [] }) (.) (?{ [ @{ $^R }, $^N ] }) (.) (?{ [ @{ $^R }, $^N ] }) (.) (?{ [ @{ $^R }, $^N ] }) (?{ push @stack, $^R }) /x; print "[$_]" for @{ $stack[0] }; # [a][b][c] print "\n";
  • Comment on Re: Backreference variables in code embedded inside Perl 5.10 regexps
  • Download Code

Replies are listed 'Best First'.
Re^2: Backreference variables in code embedded inside Perl 5.10 regexps
by casiano (Pilgrim) on Sep 09, 2009 at 22:03 UTC
    Thanks Ikegami!

    I look forward for something like that integrated in Perl 5.10 regexps. I am slowly processing your solutions. The general idea is to save the attributes of the previous parenthesis and for that I can use some local auxiliary variables. The following is a rewrite of the grammar above that is a more general solution. It does not pushes numbers unconditionally. It uses variable $op and an intermediate action to save the required attribute:

    pl@nereida:~/Lperltesting$ cat calc510withactions3.pl #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1 use v5.10; # Infix to postfix translator using 5.10 regexp # Original grammar: # exp -> exp [-+] term # | term # term -> term [*/] digits # | digits # Applying left-recursion elimination we have: # exp -> term re # re -> [+-] term re # | # empty # term -> digits rt # rt -> [*/] rt # | # empty my $input; sub echo { my $p = substr($input, 0, pos($input)); say $p .(" " x (length($input)-length($p))) ."\t".$_[0]; } my @stack; local our $op = ''; my $regexp = qr{ (?&exp) (?(DEFINE) (?<exp> (?&term) (?&re) (?{ echo "exp -> term re" }) ) (?<re> \s* ([+-]) (?&term) \s* (?{ push @stack, $^N }) (?& +re) (?{ echo "re -> [+-] term re" }) | # empty (?{ echo "re -> empty" }) ) (?<term> ((?&digits)) (?{ # intermediate action push @stack, $^N }) (?&rt) (?{ echo "term-> digits($^N) rt"; }) ) (?<rt> \s*([*/]) (?{ # intermediate action local $op = $^N; }) ((?&digits)) \s* (?{ # intermediate action push @stack, $^N, $op }) (?&rt) # end of <rt> definition (?{ echo "rt -> [*/] digits($^N) rt" }) | # empty (?{ echo "rt -> empty" }) ) (?<digits> \s* \d+ ) ) }xms; $input = <>; chomp($input); if ($input =~ $regexp) { say "matches: $&\nStack=(@stack)"; } else { say "does not match"; }
    The execution shows how a rightmost anti-derivation is built by the perl 5.10 engine:
    pl@nereida:~/Lperltesting$ ./calc510withactions3.pl 2-8*4/2/4-1 2 rt -> empty 2 term-> digits(2) rt 2-8*4/2/4 rt -> empty 2-8*4/2/4 rt -> [*/] digits(4) rt 2-8*4/2/4 rt -> [*/] digits(2) rt 2-8*4/2/4 rt -> [*/] digits(4) rt 2-8*4/2/4 term-> digits(8) rt 2-8*4/2/4-1 rt -> empty 2-8*4/2/4-1 term-> digits(1) rt 2-8*4/2/4-1 re -> empty 2-8*4/2/4-1 re -> [+-] term re 2-8*4/2/4-1 re -> [+-] term re 2-8*4/2/4-1 exp -> term re matches: 2-8*4/2/4-1 Stack=(2 8 4 * 2 / 4 / - 1 -)
      No good. Fails if any called production uses (?{}).
      use strict; use warnings; sub parser { local our @stack; local our @rv; my $parser = qr{ ^ (?&expr) (?&expr) \z (?{ @rv = @stack; }) (?(DEFINE) (?<expr> (?{ [] }) (.) (?{ [ @{ $^R }, $^N ] }) #(?&foo) #(?&bar) (.) (?{ [ @{ $^R }, $^N ] }) (?{ local @stack = ( @stack, join '|', @{ $^R } ); }) ) (?<foo> ) (?<bar> (?{ [] }) ) ) }x; return $_[0] =~ /$parser/ && \@rv; } my $rv = parser('abcd'); print("$_\n") for @$rv;

      Works with (?&foo) uncommented but not with (?&bar) uncommented.