Gibt es eine Möglichkeit, den Regex-Bindeoperator `= ~` in Perl zu überladen?

Question

Ich arbeite an einer kleinen DSL, die das nomethod Fallback für Überladung verwendet, um die Operatoren zu erfassen, die auf den überladenen Werten verwendet werden. Dies ist ähnlich der Funktion der symbolic calculator beschrieben in overload 's Dokumentation.

Dies funktioniert für die Standardvergleichsoperatoren in Ordnung, aber die folgenden Punkte beachten:

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

In diesem Fall wird nomethod genannt $overloaded stringify und nach, dass die Überlastung verloren. Ich dachte daran, eine gebundene Variable zurückzugeben, die mir zumindest erlauben würde, das ursprünglich überladene Objekt herumzutragen, aber das wird während der Ausführung der Regex noch verloren gehen.

So ist die ultimative Frage, ob es eine Möglichkeit ist overload ‚s Idee eines symbolischen Rechners umfasst die Regex Bindung Operatoren =~ und !~, so dass das obige Codebeispiel nomethod ähnlich mit ($overloaded, qr/regex/, 0, '=~') oder etwas nennen würde zu verlängern?

Ich habe auch kurz in die Überladung des Smartmatch-Operators ~~ geschaut, aber das schien auch nicht den Trick zu tun (immer standardmäßig Regex Matching statt überladen).

Edit: Ich schaute in ~~ mehr, und festgestellt, dass my $ret = $overloaded ~~ q/regex/ funktioniert aufgrund Smartmatching-Regeln. Schließen, aber keine ideale Lösung, und ich würde es gerne vor 5.10 arbeiten, also begrüße ich andere Antworten.

Answer 1

Ich fühle, als ob DSLs am besten mit source filters in Perl geschrieben sind. Sie können buchstäblich alles tun, was Sie wollen. ;-) In deinem Beispiel kannst du FOO = ~ BAR mit myfunc (FOO, BAR) regex ersetzen und beliebigen Code ausführen.

Hier ist ein Beispiel Lösung:

# 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; 

Beispiel USE

use MyLang nomethod => \&mywrap; 

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

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

nun über dem wird "foo \ n" drucken, da es ist, was ist in der Variablen "$ a". Natürlich möchten Sie vielleicht etwas intelligenteres Parsen für die Regex-Ersetzung im Filter durchführen, aber das ist ein einfacher Beweis für das Konzept.