有没有办法在 Perl 中重载正则表达式绑定运算符 `=~`？

Question

我正在开发一个小型 DSL，它使用 nomethod 后备进行重载，以捕获用于重载值的运算符。这类似于overload<中描述的符号计算器的功能/code> 的文档。

这对于标准比较运算符来说效果很好，但请考虑以下情况：

my $ret = $overloaded =~ /regex/;

在这种情况下，会调用 nomethod 来字符串化 $overloaded，之后重载就会丢失。我考虑过返回一个绑定变量，这至少可以让我携带原始的重载对象，但在正则表达式的执行过程中它仍然会丢失。

因此，最终的问题是是否有任何方法可以扩展 overload 的符号计算器思想，以包含正则表达式绑定运算符 =~ 和 !~< /code>，以便上面的代码示例可以使用 ($overloaded, qr/regex/, 0, '=~') 或类似的内容调用 nomethod ？

我还简要研究了重载 smartmatch 运算符 ~~ 但这似乎也没有解决问题（始终默认为正则表达式匹配而不是重载）。

编辑：我进一步研究了 ~~ ，发现 my $ret = $overloaded ~~ q/regex/ 由于智能匹配规则而有效。接近，但不是一个理想的解决方案，我希望它能在 5.10 之前工作，所以我欢迎其他答案。

Answer 1

我觉得 DSL 最好用 Perl 中的 源过滤器 编写。你确实可以做任何你想做的事。 ;-) 在您的示例中，您可以使用正则表达式将 FOO =~ BAR 替换为 myfunc(FOO, BAR) 并运行任意代码。

下面是一个示例解决方案：

# THE "MyLang" SOURCE FILTER
package MyLang;
use strict;
use warnings;
use Filter::Util::Call;

sub import {
    my ($type, @args) = @_;
    my %p = @args;
    no strict 'refs';
    my $caller = caller;
    # Create the function to call
    *{"${caller}::_mylang_defaultmethod"} = sub {
        my ($a, $op, $b) = @_;
        $p{nomethod}->($a, $b, 0, $op);
    };
    my ($ref) = [];
    filter_add(bless $ref);
}

sub filter {
    my ($self) = @_;
    my ($status);
    if ($status = filter_read() > 0) {
        $_ =~ s/([^=]+)(=~)([^;]+)/ _mylang_defaultmethod($1,'$2',$3)/g;
    }
    $status;
}

1;

示例使用

use MyLang nomethod => \&mywrap;

my $a = "foo";
my $b = "bar";
$x = $a =~ $b;

sub mywrap {
   my ($a, $b, $inv, $op) = @_;
   print "$a\n";
}

现在上面将打印“foo\n”，因为它是“$a”变量中的内容。当然，您可能想要对过滤器中的正则表达式替换进行一些稍微更智能的解析，但这是一个简单的概念证明。