Есть ли способ перегрузить оператор привязки regex `= ~` в Perl?

Я работаю над небольшим DSL, который использует резервную копию nomethod для перегрузки для захвата операторов, используемых для перегруженных значений. Это похоже на функцию символического калькулятора , описанного в документации overload.

Это отлично подходит для стандартных операторов сравнения, но учтите следующее:

В этом случае nomethod вызывается для строки $overloaded, после чего перегрузка теряется. Я думал о возврате привязанной переменной, которая, по крайней мере, позволит мне переносить оригинальный перегруженный объект, но это все равно будет потеряно во время выполнения регулярного выражения.

Итак, конечный вопрос заключается в том, есть ли способ расширить идею overload символического калькулятора, чтобы включить операторы привязки regex =~ и !~, чтобы приведенный выше пример кода вызывал nomethod с ($overloaded, qr/regex/, 0, '=~') или что-то подобное?

Я также кратко рассмотрел перегрузку оператора smartmatch ~~, но это тоже не показалось трюком (всегда по умолчанию используется соответствие регулярному выражению, а не перегрузка).

Изменить: я просмотрел еще ~~ и обнаружил, что my $ret = $overloaded ~~ q/regex/ работает из-за правил smartmatching. Закрыть, но не идеальное решение, и я бы хотел, чтобы он работал до 5.10, поэтому я приветствую другие ответы.

Ответы

Ответ 1

Мне кажется, что DSL лучше всего писать с помощью исходных фильтров в perl. Вы можете буквально делать ВСЕ, что хотите.;-) В вашем примере вы можете regex заменить 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". Конечно, вам может понадобиться немного более интеллектуальный синтаксический анализ для замены регулярных выражений в фильтре, но это простое доказательство концепции.