C'è un modo per sovraccaricare l'operatore di regex binding `= ~` in Perl?

Question

Sto lavorando su un DSL piccolo che utilizza il fallback nomethod per il sovraccarico per acquisire gli operatori utilizzati sui valori sovraccaricati. È simile alla funzione di symbolic calculator descritta nella documentazione di overload.

Questo funziona bene per gli operatori di confronto standard, ma considerare quanto segue:

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

In questo caso, nomethod viene chiamato a stringa i $overloaded, e dopo che il sovraccarico è perduto. Ho pensato di restituire una variabile legata, che mi consentirà almeno di portare in giro l'oggetto originale sovraccarico, ma che comunque si perderà durante l'esecuzione della regex.

Così, l'ultima domanda è se c'è qualche modo per estendere idea overload 's di una calcolatrice simbolica per includere l'operatori =~ e !~ vincolante regex, in modo che il codice di esempio sopra chiamerebbe nomethod con ($overloaded, qr/regex/, 0, '=~') o qualcosa di simile?

Ho anche esaminato brevemente l'overloading dell'operatore smartmatch ~~ ma questo non sembra aver risolto il problema (è sempre il valore predefinito di regex matching piuttosto che overloading).

Modifica: ho esaminato più ~~ e ho trovato che my $ret = $overloaded ~~ q/regex/ funziona a causa delle regole di smartmatching. Chiudi, ma non una soluzione ideale, e mi piacerebbe che funzionasse pre 5.10, quindi accolgo con favore altre risposte.

Answer 1

Mi sembra che le DSL siano scritte meglio con source filters in perl. Puoi letteralmente fare TUTTO ciò che vuoi. ;-) Nel tuo esempio, puoi regex sostituire FOO = ~ BAR con myfunc (FOO, BAR) ed eseguire codice arbitrario.

Ecco una soluzione esempio:

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

ESEMPIO UTILIZZO

use MyLang nomethod => \&mywrap; 

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

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

Ora il precedente stamperà "foo \ n" dal momento che è ciò che è nel "$ a" variabile. Ovviamente potresti voler eseguire un parsing leggermente più intelligente per la sostituzione regex nel filtro, ma questa è una semplice dimostrazione di concetto.