使用带有 $^R 的 perl 正则表达式解析嵌套元组

Question

我想学习如何使用带有嵌入式代码执行的 Perl 正则表达式为嵌套元组创建抽象语法树。我可以使用 Perl 6 语法轻松地进行编程，并且我知道使用解析模块会简化 Perl 5 中的任务，但我认为对于如此简单的任务，我应该能够通过学习如何从语法定义。我找不到取消引用 $^R 的方法，所以我尝试撤消 TUPLE 规则定义末尾的非自愿嵌套，但输出不正确，例如一些子串出现两次。

use v5.10;
use Data::Dumper;

while (<DATA>) {
    chomp;
    /(?&TUPLE)(?{$a = $^R})
    (?(DEFINE)
        (?<TUPLE>
            T \s (?&ELEM) \s (?&ELEM)
            (?{ [$^R->[0][0],[$^R->[0][1],$^R[1]]] })
        )
        (?<ELEM>
            (?: (a) (?{ [$^R,$^N] }) | \( (?&TUPLE) \) )
        )
    )/x;
    say Dumper $a;
}

__DATA__
T a a
T (T a a) a
T a (T a a)
T (T a a) (T a a)
T (T (T a a) a) (T a (T a a))

预期的输出数据结构是一个嵌套列表：

['a','a'];
['a',['a','a']];
[['a','a'],'a'];
[['a','a'],['a','a']];
[[['a','a'],'a'],['a',['a','a']]]

作为参考，我还将分享我的工作 Perl 6 代码：

grammar Tuple {
  token TOP { 'T ' <elem> ' ' <elem> }
  token elem { 'a' | '(' <TOP> ')'}
}
class Actions {
  method TOP($/) {make ($<elem>[0].made, $<elem>[1].made)}
  method elem($/) {make $<TOP> ?? $<TOP>.made !! 'a'}
}

Answer 1

试图弄清楚如何使用(?{ ... }) 构造几乎总是不值得付出努力。特别是，这可能会与回溯一起出现意想不到的行为。调试此类正则表达式也非常困难，因为控制流往往不明显。

相反，使用m//gc 风格的词法分析编写一个特别的递归下降解析器往往更容易：每个 Perl 字符串都存储它的最后一个匹配偏移量。在标量上下文中应用带有m/\G ... /gc 的正则表达式时，它可以锚定在最后一个偏移量并在匹配成功时推进偏移量。

这里：

use strict;
use warnings;
use Test::More;

sub parse {
  my ($str) = @_;
  pos($str) = 0;  # set match position to beginning
  return parse_tuple(\$str);
}

sub parse_tuple {
  my ($ref) = @_;
  $$ref =~ /\G T \s/gcx or die error($ref, "expected tuple start T");
  my $car = parse_element($ref);
  $$ref =~ /\G \s /gcx or die error($ref, "expected space between tuple elements");
  my $cdr = parse_element($ref);
  return [$car, $cdr];
}

sub parse_element {
  my ($ref) = @_;
  return 'a' if $$ref =~ /\G a /gcx;

  $$ref =~ /\G \( /gcx or die error($ref, "expected opening paren for nested tuple");
  my $tuple = parse_tuple($ref);
  $$ref =~ /\G \) /gcx or die error($ref, "expected closing paren after nested tuple");
  return $tuple;
}

sub error {
  my ($ref, $msg) = @_;
  my $snippet = substr $$ref, pos($$ref), 20;
  return "$msg just before '$snippet...'";
}

is_deeply parse('T a a'), ['a','a'];
is_deeply parse('T (T a a) a'), [['a','a'],'a'];
is_deeply parse('T a (T a a)'), ['a',['a','a']];
is_deeply parse('T (T a a) (T a a)'), [['a','a'],['a','a']];
is_deeply parse('T (T (T a a) a) (T a (T a a))'), [[['a','a'],'a'],['a',['a','a']]];
done_testing;

Answer 2

我修复了问题中的代码。结果我不小心写了$^R[1] 而不是$^R->[1]。所以现在我明白了为什么 amon 说这些构造很难调试 ;-)

use v5.10;
use Data::Dumper;

while (<DATA>) {
    chomp;
    /(?&TUPLE)(?{$a = $^R->[1]})
    (?(DEFINE)
        (?<TUPLE>
            T \s (?&ELEM) \s (?&ELEM)
            (?{ [$^R->[0][0],[$^R->[0][1],$^R->[1]]] })
        )
        (?<ELEM>
            (?: (a) (?{ [$^R,$^N] }) | \( (?&TUPLE) \) )
        )
    )/x;
    say Dumper $a;
}

__DATA__
T a a
T (T a a) a
T a (T a a)
T (T a a) (T a a)
T (T (T a a) a) (T a (T a a))