Hlavní navigace

Perličky: pokročilé přetěžování operátorů

Michal Svoboda

Pokračováním tématu o přetěžování operátorů se dostáváme k poněkud netradičním možnostem jazyka Perl. Dnes se budeme zabývat přetěžováním konstant, které nám dává do rukou možnost zpracovat libovolnou konstantu v kódu ještě před jejím použitím. Dále také zmíníme přetížení operátoru dereference a další triky.

Přetěžování numerických konstant

Modul IntervalFloat z minulého dílu sice pokryl většinu aritmetických potřeb, ale inicializaci proměnných bylo stále nutné provádět „ručně“: my $n = IntervalFloat->new(1.7) namísto my $n = 1.7. Přetěžování operátoru = (přiřazení) by bylo „proti velbloudí srsti“, tudíž takové přetížení není možné.

Výraz my $n = 1.7  je možné přimět k potřebné funkci, tj. naplnění $n objektem třídy IntervalFloat, pomocí dvou různých mechanismů. Jedním z nich je tie, jakýsi komplementární (a možná i konfliktní) mechanismus k přetěžování operátorů, o kterém pohovoříme v některém z příštích dílů. Druhou možností je použít přetížení konstant, čímž dostaneme do ruky možnost převést všechny konstanty v kódu na objekty naší třídy, případně dle libosti na něco jiného.

Vlastní přetížení konstant se provede pomocí volání funkce overload::con­stant. Obvyklá praktika je umístit toto volání do funkce import, která se spustí, je-li náš modul importován pomocí use IntervalFloat. Funkce overload::con­stant přijímá argumenty ve formátu typ => funkce, přičemž akceptované typy jsou: integerfloat pro přetěžování numerických konstant, binary pro přetěžování konstant v jiné než desítkové soustavě, q pro řetězce a  qr pro regulární výrazy.

sub import {
        overload::constant(float => \&convert_const);
}

Pomocí volání remove_constant ve funkci unimport můžeme po sobě uklidit (a tudíž omezit přetížení konstant pouze na nějaký blok kódu).

sub unimport {
        overload::remove_constant(float => \&convert_const);
}

Funkce convert_const se zavolá při běhu programu ve chvíli, kdy interpret narazí na konstantu daného typu. Ve funkci obdržíme tři parametry: přesný řetězec konstanty, jak byla zadána ve zdrojovém kódu, interpretaci konstanty a jako třetí parametr jemnější rozlišení typu konstanty, což je zatím užitečné pouze u řetězcových a regexpových konstant. Pro ilustraci rozdílu mezi prvními dvěma parametry si je můžeme nechat vypsat společně s jejich převodem na objekt třídy IntervalFloat.

sub convert_const {
        print 'converting constant: [', join('] [', @_[0, 1]), '] => ';
        my $r = IntervalFloat->new(shift);
        print $r, "\n";
        return $r;
}

Nový modul použijeme takto:

use strict;
use warnings;

use feature qw/say/;

{
    use IntervalFloat;

    my $n = 1.7000 + 2.9;
    say $n;
}

my $x = 1.6;
say $x;

A výstupem bude:

converting constant: [1.7000] [1.7] => 1.7 (+/-1.08420217248550443e-19)
converting constant: [2.9] [2.9] => 2.9 (+/-2.16840434497100887e-19)
4.6 (+/-6.5052130349130266e-19)
1.6

V prvním řádku jsme informováni o převodu konstanty 1.7000, která je perlem interpretována jako 1.7. Našemu modulu je celkem jedno, zda vezme interpretovanou hodnotu rovnou, či zda vezme řetězec, který se vzápětí převede na číslo při výpočtu intervalu, bereme tedy první parametr čili řetězec. Lze si ale představit modul, který by například bral v potaz nuly na konci čísla a podle toho nastavil přesnost při výpočtech. Druhý řádek vypovídá totéž o konstantě 2.9. Posléze je provedeno sečtení takto vzniklých objektů již v rámci našeho přetíženého sčítání a výpis výsledku. Poslední řádek výpisu ukazuje, že konstanty se nepřevádí mimo blok, ve kterém platí přetížení. Tudíž proměnná $x nemá s našimi objekty nic společného, jedná se o normální číslo.

Přetěžování řetězcových konstant

Jak bylo řečeno v předchozím odstavci, pomocí typů qqr lze dostat moc také nad řetězcovými konstantami. Zároveň ve třetím parametru volané funkce dostáváme podrobnější informace o kontextu, v jakém se konstanta vyskytla. Pro ukázku použijeme následující modul:

use strict;
use warnings;

package FunWithStrings;

use overload;

sub string_const {
    my $type = shift;
    print "$type constant [", join('] [', @_), "]\n";
    return $_[1];
}

sub qr_const {
    unshift @_, 'qr';
    goto &string_const;
}

sub q_const {
    unshift @_, 'q';
    goto &string_const;
}

sub import {
    overload::constant(qr => \&qr_const, q => \&q_const);
}

sub unimport {
    overload::remove_constant(qr => \&qr_const, q => \&q_const);
}

1;

Tento modul nedělá nic jiného, než že přetíží řetězcové a regexpové konstanty a vypíše patřičné informace. Abychom poznali, co je co, obě funkce přidají extra parametr a pak poměrně nečistou (ale zajímavou) konstrukcí goto splynou v jednu. Všimněme si, že z funkce vracíme jako výsledek druhý argument, tedy interpretovanou konstantu. Důvod bude patrný z příkladu. Modul použijeme pro ukázku všech možností takto:

use strict;
use warnings;

use FunWithStrings;

my $m = 'Zapd';
$m =~ s/d$/ho$& Beeblebrox/;
$m =~ y/A-Z/a-z/;
print <<"_KONEC" if $m =~ /^zaphod/;
Jsem $m.
_KONEC

Výstupem bude:

q constant [Zapd] [Zapd] [q]
qr constant [d$] [d$] [qq]
q constant [ho] [ho] [s]
q constant [ Beeblebrox] [ Beeblebrox] [s]
q constant [A-Z] [ABCDEFGHIJKLMNOPQRSTUVWXYZ] [tr]
q constant [a-z] [abcdefghijklmnopqrstuvwxyz] [tr]
q constant [Jsem ] [Jsem ] [qq]
q constant [.
] [.
] [qq]
qr constant [^zaphod] [^zaphod] [qq]
Jsem zaphod beeblebrox.

Takže co to tady všechno máme? První řádek vypovídá o zpracování konstanty 'Zapd'. Jedná se o řetězcovou konstantu, která je volána v kontextu obyčejného a neinterpolovaného řetězce. Třetí parametr přetěžovací funkce je tedy  q.

Další tři řádky jsou generovány výrazem $m =~ s/d$/ho$& Beeblebrox/. První část operátoru s/// je zpracována regexpovým přetížením, přičemž třetí parametr přetěžovací funkce je nastaven na qq, což je taková univerzální hodnota, znamenající „žádný z ostatních případů“. Druhá část s/// je zpracována jako řetězec. Jelikož je uvnitř řetězce interpolována proměnná $&, je řetezec nejprve rozdělen jako 'ho' . $& . ' Beeblebrox', a dále jsou konstantní kusy přetíženy. Jako třetí parametr máme s, což signalizuje kontext v rámci druhé části operátoru s///. K podobnému rozkouskování interpolovaných řetězců dochází ve všech případech a přetěžujeme-li řetězce na nějaké svoje objekty, je vhodné mít také připraveno správně fungující přetížení operace . (spojení řetězců).

Další dva řádky vypovídají o dalším (a posledním) typu kontextu, a to v rámci operátoru tr///, neboli zkráceně y///. Zde je nejvíce patrný rozdíl mezi čistě řetězcovou a interpretovanou formou konstanty.

Konečně, poslední skupina řádků demonstruje fungování přetížení i v here-docech, opět ilustruje mechanizmus interpolace (všimněme si, že u interpolovaného řetězce máme jako třetí parametr univerzální qq, nikoliv jednoduché q) a opět ilustruje zpracování regexpové konstanty v rámci operátoru m//. Úplně poslední řádek je kontrolní výpis, zda naše řetězce jsou ještě stále funkční.

Příklad přetěžování řetězců

Praktické využití přetěžování řetězcových konstant poskytuje následující modul, který vznikl na základě inspirace modulem DBIx::InterpolationBinding. Náš modul dělá prostou věc: převádí interpolovaný řetězec typu "hello $world to $everyone" na „formátový“ řetězec "hello % to %" a pole parametrů ($world, $everyone).

Princip převodu je prostý. Víme, že řetězcová konstanta "hello $world to $everyone" bude interpretována jako 'hello ' . $world . ' to ' . $everyone. Dále jednotlivé konstantní části budou předány naší funkci, která z nich vyrobí jednoduchý objekt. Konečně, operace ., ve které je zainteresovaný náš objekt, může být přetížena, a tudíž máme kontrolu nad všemi částmi interpolovaného řetězce. Následují pouze podstatné funkce modulu, zbytek je možné stáhnout přes odkaz na konci článku.

use strict;
use warnings;

package ArgumentExtractor;

use Class::InsideOut qw/:std/;

use overload (
    q/./ => \&catenate,
);

private content => my %content_of;
private args => my %args_of;

sub string_const {
    # convert string to our object if it is interpolated ...
    my ($exact, $interpreted, $mode) = @_;
    return $interpreted unless $mode eq 'qq';
    print 'const [', $interpreted, "]\n";
    return ArgumentExtractor->new($interpreted);
}

sub catenate {
    my ($left, $right, $reversed) = @_;

    print 'catenate [', $left, '] (object) . [', $right, '] ',
        UNIVERSAL::isa($right, __PACKAGE__) ? '(object)' : '(plain)',
        ' ',
        $reversed ? '(rev)' : '', "\n";
    # create a new blank object...
    my $result = __PACKAGE__->new(q//);

    if (UNIVERSAL::isa($right, __PACKAGE__)) {
        # if both args are objects, it's easy, just merge the
        # two string and args parts...
        ($left, $right) = ($right, $left) if $reversed;
        $content_of{id $result}
            = $content_of{id $left}
            . $content_of{id $right};
        $args_of{id $result} = [
            @{$args_of{id $left}},
            @{$args_of{id $right}}
        ];
    } else {
        # if the right arg is not an object then create a
        # placeholder in the string part and add it to args...
        if ($reversed) {
            # to the left...
            $content_of{id $result}
                = '%' . $content_of{id $left};
            $args_of{id $result} = [
                $right,
                @{$args_of{id $left}}
            ];
        } else {
            # or to the right...
            $content_of{id $result}
                = $content_of{id $left} . '%';
            $args_of{id $result} = [
                @{$args_of{id $left}},
                $right
            ];
        }
    }
    return $result;
}

sub import {
    overload::constant(q => \&string_const);
}

Každý objekt má separátně vedenou řetězcovou část (např. hello %) a seznam parametrů jako odkaz na pole. Funkce, která obstarává přetížení konstant, je jednoduchá – převede konstantu na objekt, kde je pouze řetězec a žádné argumenty. Složitější je funkce pro spojení řetězců, to ale jen kvůli velkému množství alternativ, které obsluhuje. Spojení dvou objektů je jednoduché, řetězce se spojí normálně a parametry sloučí do jednoho pole. Spojení objektu s čímkoliv jiným přidá do řetězce zástupný znak % a přidá parametr do pole parametrů. V obou případech je nutné rozlišit, zda se funkce volá s normálním, nebo obráceným pořadím parametrů. Modul můžeme vyzkoušet takto:

use strict;
use warnings;

use ArgumentExtractor;

my $lets = q/let's say/;
my $world = 'world';
my $everyone = 'everyone!';

my $string = "$lets hello $world to $everyone";

Což nám vypíše vizualizaci zpracování řetězce $string:

const [ hello ]
const [ to ]
catenate [ hello ] (object) . [let's say] (plain) (rev)
catenate [% hello ] (object) . [world] (plain)
catenate [% hello %] (object) . [ to ] (object)
catenate [% hello % to ] (object) . [everyone!] (plain)

… čímž si můžeme udělat představu o tom, jak to celé funguje. Všimněme si, že neinterpolované řetězce ( 'world') se nezpracují, jelikož jsou naší funkci předány s  kontextovým parametrem q, o který nemáme zájem.

Přetížení dereference

Dalšími netradičními operátory, které lze přetížit, jsou dereference na různé typy objektů: ${} pro skaláry, @{} pro pole, %{} pro hashe, &{} pro kód a  *{} pro glob. Jedním z možných použití je právě v našem ukázkovém modulu ArgumentExtractor  –přetížením konverze na řetězec můžeme dát k dispozici řetězcovou část a přetížením dereference odkazu na pole můžeme zviditelnit její parametry.

use overload (
        q/""/ => \&stringify,
        q/@{}/ => \&array_deref,
);

sub stringify {
        # just return the string part ...
        my $self = shift;
        return $content_of{id $self};
}

sub array_deref {
        # return an array with all the args...
        my $self = shift;
        return [@{$args_of{id $self}}];
}

Nyní můžeme použít proměnnou $string jako řetězec nebo jako odkaz na pole:

use feature qw/say/;
say '[', join('][', ($string, @{$string})), ']';

A dostaneme kýžený výsledek:

[% hello % to %][let's say][world][everyone!]

Co se sem nevešlo, shrnutí a závěr

Implementace přetížení operátorů v jazyce Perl umožňuje přetížení běžných operací známé z ostatních objektově orientovaných jazyků, a to v podobném duchu. Pokud nezadefinujeme některou operaci explicitně, existují celkem mocná pravidla na odvození příslušného operátoru z již existujících (například $x += $y jako $x = $x + $y). Tuto automatickou funkci lze vypnout.

Přetížit lze také několik aritmetických funkcí: atan2, cos, sin, exp, abs, log, sqrt. Pro přetížení všech operací porovnání ve většině případů stačí přetížit univerzální operátor <=>, respektive cmp. Ve verzi Perlu 5.10 lze přetížit smart-match operátor ~~.

Přetížit nelze operátor přiřazení =. V souvislosti s přiřazením je potřeba si dát pozor na to, že se ve skutečnosti kopírují pouze reference na tentýž objekt. Ve většině případů to nevadí, neboť modifikující operace (například ++), jsou-li generovány automaticky, tento problém umí vyřešit ad-hoc duplikací objektu (tj. ne v okamžiku přiřazení). Pokud je potřeba přetěžovat tyto operace explicitně, například z důvodu optimalizace, doporučuji se řídit pokyny v dokumentaci k  overload.

Pro usnadnění práce s konstantami (a k dalším trikům) lze „přetížit konstanty“, tj. mít možnost zpracování konstanty před jejím použitím v kódu.

Za účelem konverze objektu lze přetížit konverzi na booleovskou hodnotu ( bool), číslo ( 0+), celé číslo ( int), řetězec ( "") a na všechny druhy referencí ( ${}, @{}, %{}, &{}*{}).

Nezmíněný zůstává operátor iterace <>. Jeho běžné použití je při čtení souboru po řádcích, nicméně zachováme-li stejnou sémantiku, lze jím iterovat jakýkoliv objekt.

Konečně, modul overload poskytuje několik extra funkcí, kterými lze zjistit, má-li objekt nějakou operaci přetíženu, případně získat referenci na příslušnou funkci.

Příklady ke stažení: IntervalFloat, FunWithStrings, ArgumentExtrac­tor.

Našli jste v článku chybu?
Podnikatel.cz: Změny v cestovních náhradách 2017

Změny v cestovních náhradách 2017

120na80.cz: 5 nejčastějších mýtů o kondomech

5 nejčastějších mýtů o kondomech

Lupa.cz: Kdo pochopí vtip, může jít do ČT vyvíjet weby

Kdo pochopí vtip, může jít do ČT vyvíjet weby

Podnikatel.cz: K EET. Štamgast už peníze na stole nenechá

K EET. Štamgast už peníze na stole nenechá

Vitalia.cz: Jmenuje se Janina a žije bez cukru

Jmenuje se Janina a žije bez cukru

Vitalia.cz: Když přijdete o oko, přijdete na rok o řidičák

Když přijdete o oko, přijdete na rok o řidičák

DigiZone.cz: Rádio Šlágr má licenci pro digi vysílání

Rádio Šlágr má licenci pro digi vysílání

Vitalia.cz: Proč vás každý zubař posílá na dentální hygienu

Proč vás každý zubař posílá na dentální hygienu

120na80.cz: Na ucho teplý, nebo studený obklad?

Na ucho teplý, nebo studený obklad?

Vitalia.cz: Pamlsková vyhláška bude platit jen na základkách

Pamlsková vyhláška bude platit jen na základkách

Vitalia.cz: Potvrzeno: Pobyt v lese je skvělý na imunitu

Potvrzeno: Pobyt v lese je skvělý na imunitu

Lupa.cz: Propustili je z Avastu, už po nich sahá ESET

Propustili je z Avastu, už po nich sahá ESET

Podnikatel.cz: Snížení DPH na 15 % se netýká všech

Snížení DPH na 15 % se netýká všech

120na80.cz: Co všechno ovlivňuje ženskou plodnost?

Co všechno ovlivňuje ženskou plodnost?

Měšec.cz: Zdravotní a sociální pojištění 2017: Připlatíte

Zdravotní a sociální pojištění 2017: Připlatíte

Lupa.cz: Teletext je „internetem hipsterů“

Teletext je „internetem hipsterů“

Měšec.cz: Kdy vám stát dá na stěhování 50 000 Kč?

Kdy vám stát dá na stěhování 50 000 Kč?

Měšec.cz: Jak vymáhat výživné zadarmo?

Jak vymáhat výživné zadarmo?

Měšec.cz: Jak levně odeslat balík přímo z domu?

Jak levně odeslat balík přímo z domu?

Podnikatel.cz: Udávání kvůli EET začalo

Udávání kvůli EET začalo