使用带有$ ^ R的perl regexp解析嵌套元组

Question

我想学习如何使用带有嵌入式代码执行的Perl regexp为嵌套元组创建抽象语法树.我可以使用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-style lexing 编写一个ad-hoc递归下降解析器往往更容易:每个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;