Comment utiliser des décorateurs en Perl

Considérons une fonction importante ou complexe dont nous souhaitons tracer les appels ou en décompter le nombre. Notre première fonction, très simple, affiche la réponse à la grande question sur la vie, l'univers et le reste :

use strict;
use warnings;
use feature 'say';

affiche_la_reponse();

sub affiche_la_reponse {
    say "42";
}

Si nous désirons créer une fonction wrapper qui trace les appels à la fonction affiche_la_reponse, sans en modifier le code, nous pourrions écrire une fonction trace_appels imprimant les informations voulues et appelant ensuite affiche_la_reponse :

my $count = 0;
sub trace_appels {
    $count++;
    say "Appel numéro $count de la fonction surveillée";
    affiche_la_reponse();
}
trace_appels() for 1..3;

Ceci va bien afficher les trois appels de fonction :

$ perl trace_appels.pl
Appel numéro 1 de la fonction surveillée
42
Appel numéro 2 de la fonction surveillée
42
Appel numéro 3 de la fonction surveillée
42

Mais cela n'est pas très satisfaisant. Si nous désirons surveiller les appels d'une autre fonction, nous devons écrire une nouvelle version de trace_appels, avec l'appel de l'autre fonction. Nous voudrions donc une fonction générique qui puisse tracer les appels d'une fonction quelconque. Il est par conséquent souhaitable de passer en paramètre la fonction à surveiller. C'est ce que fait la fonction enrichit ci-dessous :

my $count = 0;
sub enrichit {
    my $fonction = shift;
    $count++;
    say "Appel numéro $count de la fonction surveillée";
    $fonction->();
}
enrichit(\&affiche_la_reponse) for 1..3;

L'argument \&affiche_la_reponse passé à la fonction enrichit est une référence à la fonction affiche_la_reponse, c'est-à-dire une variable scalaire contenant l'adresse de la fonction appelée. On appelle souvent ce genre de variable une coderef (une référence à du code). Et une fonction ainsi passée en paramètre à une autre fonction pour y être éventuellement appelée est généralement nommée fonction de rappel (callback function). Ce mécanisme est décrit plus en détail dans le chapitre Les références vers des fonctions de la deuxième partie de mon tutoriel sur la programmation fonctionnelle en Perl.

Quand une fonction peut être passée en paramètre à une autre fonction, ou être renvoyée comme valeur de retour d'une autre fonction, on parle souvent de fonctions d'ordre supérieur. On dit parfois aussi que les fonctions sont des citoyennes de première classe.

Dans la fonction enrichit, le code récupère l'argument passé (la coderef), incrémente le compteur (comme précédemment), affiche la trace et appelle la coderef reçue en paramètre avec la syntaxe $fonction->(). Même si la syntaxe est nouvelle pour vous, cela n'a rien de bien mystérieux : la fonction enrichit reçoit en paramètre une référence vers une fonction et appelle cette fonction.

Ce programme affiche la même chose que précédemment, mais nous avons maintenant une fonction décoratrice générique qui peut prendre une autre fonction qu'affiche_la_reponse en paramètre :

sub hello_world {
    say "Hello world";
}
# ... même définition de la fonction enrichit que précédemment

enrichit(\&hello_world) for 1..3;

Ce qui affiche :

$ perl enrichit.pl
Appel numéro 1 de la fonction surveillée
Hello world
Appel numéro 2 de la fonction surveillée
Hello world
Appel numéro 3 de la fonction surveillée
Hello world

À vrai dire, notre fonction enrichit est encore un peu squelettique et ne permet en particulier pas le passage de paramètres à la fonction surveillée (puisque nous n'en avions pas besoin dans nos deux exemples). Il n'est guère difficile d'ajouter cette fonctionnalité :

sub enrichit {
    my $fonction = shift;
    $count++;
    say "Appel numéro $count de la fonction surveillée";
    $fonction->(@_);
}
enrichit(\&fonction_surveillee, $param1, $param2);

Maintenant, le premier paramètre passé à enrichit est dépilé du tableau @_ par l'appel à la fonction shift, et les autres paramètres sont passés à la fonction surveillée.

Nous avons donc bien progressé, puisque nous pouvons maintenant tracer les appels d'une fonction quelconque, mais nous n'avons pas réellement modifié le comportement de la fonction à tracer, nous avons seulement fait en sorte d'encapsuler son appel dans du code se chargeant d'afficher les traces d'appel.

Surtout, nous devons pour l'instant appeler la fonction surveillante (enrichit) chaque fois que nous voulons tracer les appels de la fonction surveillée (affiche_la_reponse), alors que nous aimerions modifier le comportement de la fonction surveillée. En effet, si la fonction surveillée est appelée à de multiples endroits dans le code, nous devons pour l'instant modifier chaque appel de cette fonction, ce qui n'est pas pleinement satisfaisant. J'avais initialement appelé decorateur la fonction enrichit, mais j'ai préféré abandonner ce premier nom pour l'instant, car nous ne sommes pas encore en présence d'un vrai décorateur. Nous verrons plus loin dans ce tutoriel (section 3.4) comment modifier réellement le comportement de la fonction surveillée, mais nous allons d'abord examiner un autre exemple dans lequel nous pourrions désirer enrichir dynamiquement une fonction existante.

Considérons une fonction de calcul de la suite de Fibonacci. Une suite de Fibonacci est une suite de nombres telle que chaque nombre est la somme des deux nombres qui le précèdent, par exemple : 1, 1, 2, 3, 5, 8, 13, 21... (Selon les définitions, les deux premiers nombres sont généralement soit 1 et 1, soit 0 et 1 ; mais on pourrait très bien définir une telle suite avec 4 et 7 comme premiers nombres, ce qui donnerait la suite 4, 7, 11, 18….)

En notation mathématique, on peut décrire la suite de Fibonacci comme suit :

F₁ = 1, F₂ = 1, et F_n = F_n-1 + F_n-2

2-2-1. Mise en œuvre récursive▲

use strict;
use warnings;
use feature 'say';

sub fibo {
    my $n = shift;
    if ($n < 2) {
        return $n;
    } else {
        return fibo ($n-1) + fibo ($n-2);
    }
}
say fibo $_ for 6..8;  # Affiche 8, 13, 21

2-2-2. Problème de performance▲

say fibo shift;

$ time perl fibo.pl 20
6765

real    0m0.073s
user    0m0.000s
sys     0m0.030s

$ time perl fibo.pl 30
832040

real    0m1.151s
user    0m1.093s
sys     0m0.000s

$ time perl fibo.pl 40
102334155

real    2m6.626s
user    2m6.328s
sys     0m0.030s

2-2-3. Pourquoi cette explosion exponentielle ?▲

Pour comprendre pourquoi cette fonction devient aussi lente quand le nombre de Fibonacci à calculer croît (même modérément), considérons l'arbre d'appels du programme avec n = 4 :

Pour n = 4, la fonction fibo appelle deux fois la fonction fibo avec les valeurs 3 et 2. Pour n = 2, fibo est encore appelée deux fois. Pour n = 3, on appelle encore deux fois fibo, avec les valeurs 1 et 2. Et pour n = 2, la fonction est encore appelée deux fois. Au total, la fonction est appelée neuf fois, deux fois avec la valeur 0, trois fois avec la valeur 1, deux fois avec la valeur 2, et une fois pour les valeurs 3 et 4. Donc, on recalcule plusieurs fois la même chose, ce qui n'est pas très efficace. Plus on recherche un nombre de Fibonacci élevé, plus le nombre de calculs inutiles augmente, et il augmente très rapidement.

Considérons le nombre total d'appels de la fonction fibo pour les premiers nombres de Fibonacci :

Nombre de Fibonacci à calculer	Utilise fibo(n-1)	Utilise fibo(n-2)	Nombre total d'appels de fibo : 1 + fibo(n-1) + fibo (n-2)	Rapport avec le nombre d'appels précédent
0	-	-	1
1	-	-	1	1
2	1	0	3	3
3	2	1	5	1,66666667
4	3	2	9	1,80000000
5	4	3	15	1,66666667
6	5	4	25	1,6666667
…	…	…	...
28	27	26	1028457	1,61803493
29	28	27	1664079	1,61803459
30	29	287	2692537	1,61803436
…	…	…	…	...
50	49	48	40730022147	1,61803399

Si l'on divise le nombre d'appels pour fibo(29) par celui pour fibo(28), on obtient 1,61803459 (colonne de droite dans le tableau ci-dessus). Entre fibo(30) et fibo(29) le rapport est 1,61803436. On constate qu'à chaque étape, le nombre d'appels de la fonction fibo est multiplié par environ 1,618 (du moins dès que l'on s'éloigne des très petits nombres). On est donc en présence d'une progression géométrique (approximative au début) dont la raison est assez rapidement de l'ordre de 1,61803.

Le rapport entre deux nombres successifs d'appels converge assez vite vers le nombre 1,6180339887499, qui se trouve être ce que l'on appelle généralement le nombre d'or. Au sujet du nombre d'or et de ses relations avec la suite de Fibonacci, voir l'Annexe : le nombre d'or (ou divine proportion) à la fin de ce document.

2-2-4. Corriger ce problème de performance▲

use strict;
use warnings;
use feature 'say';

my @cache = qw /0 1/; # deux valeurs de départ pour fibo(0) et fibo(1) 

sub fibo {
    my $n = shift;
    $cache[$n] = fibo($n-1) + fibo($n-2) unless defined $cache[$n];
    return $cache[$n];
}
say fibo shift;

$ time perl fibo.pl 10
55

real    0m0.057s
user    0m0.000s
sys     0m0.015s

$ time perl fibo.pl 20
6765

real    0m0.063s
user    0m0.000s
sys     0m0.015s

$ time perl fibo.pl 90
2880067194370816120

real    0m0.065s
user    0m0.000s
sys     0m0.015s

Le code du décorateur lui-même pour ajouter des traces de débogage ressemblerait à ceci :

use strict;
use warnings;
use feature 'say';

sub triplement {
    return 3 * shift;
}

my $triplement_decore = decorateur(\&triplement);
say $triplement_decore->($_) for 10, 15, 20;

sub decorateur { 
    my $coderef = shift; 
    return sub { 
        say "Appel de la fonction avec les arguments: @_"; 
        my $resultat = $coderef->(@_); 
        say "Valeur de retour: $resultat."; 
        return $resultat; 
    } 
}

La fonction decorateur prend en entrée une référence à une fonction (ici, la fonction triplement) et renvoie une nouvelle fonction qui utilise la fonction d'origine, mais ajoute de nouvelles fonctionnalités « autour d'elle » (avant et après son appel).

Si vous désirez de plus amples informations sur les fonctions retournant des fonctions, vous pouvez consulter le chapitre sur les Usines à fonction de la deuxième partie de mon tutoriel sur la programmation fonctionnelle en Perl.

À l'exécution, cela donne :

$ perl decorateur.pl
Appel de la fonction avec les arguments: 10
Valeur de retour: 30.
30
Appel de la fonction avec les arguments: 15
Valeur de retour: 45.
45
Appel de la fonction avec les arguments: 20
Valeur de retour: 60.
60

Nous avons maintenant avec $triplement_decore une référence vers une fonction anonyme qui assure à la fois les tâches de la fonction triplement de départ et celles de traçage des appels.

Nous pouvons enrichir notre fonction decorateur pour numéroter les appels :

sub decorateur { 
    my $coderef = shift;
    my $num_appel = 1;
    return sub { 
        say "Appel numéro $num_appel de la fonction avec les arguments: @_"; 
        $num_appel++;
        my $resultat = $coderef->(@_); 
        say "Valeur de retour: $resultat."; 
        return $resultat; 
    } 
}

Par rapport à la précédente version, nous avons ajouté la déclaration et l'initialisation d'un compteur, $num_appel, dans le code de préparation de decorateur, et ajouté l'utilisation de ce compteur et son incrémentation dans la fonction anonyme renvoyée par le décorateur. Cette fonction anonyme devient ce que l'on appelle une fermeture (closure). Lorsqu'une fonction anonyme est définie de cette façon, elle garde la trace des variables qui existaient lors de sa définition (si ces variables sont utilisées dans le corps de ladite fonction anonyme). C'est ce qui permet à la variable num_appel de conserver sa valeur d'un appel de la fonction anonyme au suivant. Pour plus d'informations à ce sujet, voir le chapitre sur les fermetures de mon tutoriel susmentionné.

À l'exécution, on obtient les traces enrichies suivantes :

$ perl decorateur.pl
Appel numéro 1 de la fonction avec les arguments: 10
Valeur de retour: 30.
30
Appel numéro 2 de la fonction avec les arguments: 15
Valeur de retour: 45.
45
Appel numéro 3 de la fonction avec les arguments: 20
Valeur de retour: 60.
60

Le décorateur vu précédemment supposait que la fonction à décorer renvoyait une valeur scalaire. Il est facile de l'adapter pour une fonction comme multiplie234 renvoyant une liste :

sub multiplie234 {
    return $_[0] * 2, $_[0] * 3, $_[0] * 4;
}

my $multiplie_decore = decorateur(\&multiplie234);
say $_ for $multiplie_decore->(20);

sub decorateur { 
    my $coderef = shift;
    my $num_appel = 1;
    return sub { 
        say "Appel numéro $num_appel de la fonction avec les arguments: @_"; 
        $num_appel++;
        my @resultat = $coderef->(@_); 
        say "Valeurs de retour: @resultat."; 
        return @resultat; 
    } 
}

Ce qui affiche :

$ perl decorateur.pl
Appel numéro 1 de la fonction avec les arguments: 20
Valeurs de retour: 40 60 80.
40
60
80

Cette nouvelle version de decorateur fonctionne à la fois en contexte scalaire et de liste et nous permet de décorer aussi bien la fonction multiplie234 que la fonction triplement :

my $multiplie_decore = decorateur(\&multiplie234);
say $_ for $multiplie_decore->(20);
my $triplement_decore = decorateur(\&triplement);
say $triplement_decore->($_) for 5, 10, 15;

Ce qui affiche :

Appel numéro 1 de la fonction avec les arguments: 20
Valeur de retour: 40 60 80.
40
60
80
Appel numéro 1 de la fonction avec les arguments: 5
Valeur de retour: 15.
15
Appel numéro 2 de la fonction avec les arguments: 10
Valeur de retour: 30.
30
Appel numéro 3 de la fonction avec les arguments: 15
Valeur de retour: 45.
45

Dans la pratique, concevoir des décorateurs qui renvoient des listes de résultats et non de simples valeurs scalaires est souvent plus souple. Mais ce n'est pas une règle absolue : dans certains cas, on aura besoin de plusieurs décorateurs pour faire face aux différentes situations. C'est donc une décision de conception qui devra être prise par le développeur.

Nous avons un peu retardé ce moment légèrement délicat, mais il faut bien y venir. Jusqu'à maintenant, toutes nos fonctions d'enrichissement ou de décoration créaient une autre fonction apportant de nouvelles fonctionnalités, mais ne remplaçaient pas vraiment la fonction d'origine.

Un vrai décorateur doit modifier le comportement de la fonction d'origine, et nous arrivons à cette étape essentielle de notre projet.

3-4-1. Et hop, un petit tour de magie blanche▲

my $triplement_decore = decorateur(\&triplement);
say $triplement_decore->($_) for 10, 15, 20;

*main::triplement = decorateur(\&triplement);
say triplement($_) for 10, 15;

$ perl decorateur.pl
Subroutine main::triplement redefined at decorateur.pl line 10.
Appel numéro 1 de la fonction avec les arguments: 10
Valeur de retour: 30.
30
Appel numéro 2 de la fonction avec les arguments: 15
Valeur de retour: 45.
45

# Remplacer les apostrophes par des guillemets sous Windows
$ perl -E 'say for keys %main::'

$ perl -E '$toto = 1; @toto = (2, 3); 
> say $main::toto; say "@main::toto"; '
1
2 3

$  perl -E '$toto = 1; @toto = (2, 3);
> $titi = *toto{SCALAR}; say $$titi;
> $tata = *toto{ARRAY}; say "@$tata";'
1
2 3

$ perl -E '$toto = "scalaire"; @toto = 1..5;
> *titi = *toto; say $titi; say "@titi";'
scalaire
1 2 3 4 5

$ perl -E '$toto = "scalaire"; @toto = 1..5; $tata = 5;
> *titi = *toto; *titi = \$tata;
>  say $titi; say "@titi"; say $toto;'
5
1 2 3 4 5
5

$ perl -E 'use strict; our $toto = 42; our @toto = 1..5;
> my $tata = 5; our ($titi, @titi);
> *titi = *toto; *titi = \$tata;
> say $titi; say "@titi"; say $toto;'
5
1 2 3 4 5
5

$ perl -Mstrict -E ' our $toto = 42; our  @toto = 1..5;
> my $tata = 5; *titi = *toto; *titi = \$tata;
> { no strict "vars"; say $titi; say "@titi"; }
>  say $toto;'
5
1 2 3 4 5
5

$ perl -Mstrict -E 'sub square {
>     my $arg = shift; return $arg * $arg;
> }
> *carre = *square;
> say carre(10); '
100

3-4-2. Suppression de l'avertissement de redéfinition▲

Subroutine main::triplement redefined at decorateur.pl line 10

{   
    no warnings 'redefine';
    *main::triplement = decorateur(\&triplement);
}
say triplement($_) for 15, 30;

$ perl decorateur.pl
Appel numéro 1 de la fonction avec les arguments: 15
Valeur de retour: 45.
45
Appel numéro 2 de la fonction avec les arguments: 30
Valeur de retour: 90.
90

3-4-3. La table des symboles d'un module particulier▲

#!/usr/bin/perl

package Multiplie;

use strict;
use warnings;

require Exporter;
our @ISA = qw/Exporter/;
our @EXPORT = qw (quadruplement);

sub quadruplement {
    return 4 * shift;
};
# ... autres fonctions éventuelles
1;

#!/usr/bin/perl

use strict;
use warnings;
use feature 'say';
use Multiplie;

say quadruplement($_) for 5, 15;

{   
    no warnings 'redefine';
    *{Multiplie::quadruplement} = decorateur(\&quadruplement);
}

sub quadruplement {
    return 4 * shift;
};

sub decorateur { 
    my $coderef = shift;
    my $num_appel = 1;
    return sub { 
        say "Appel n° $num_appel de la fonction avec les arguments: @_"; 
        $num_appel++;
        my $resultat = $coderef->(@_); 
        say "Valeur de retour: $resultat."; 
        return $resultat; 
    } 
}

$ perl quadruple.pl
Appel n° 1 de la fonction avec les arguments: 5
Valeur de retour: 20.
20
Appel n° 2 de la fonction avec les arguments: 15
Valeur de retour: 60.
60

{   
    no warnings 'redefine';
    no strict 'refs';
    *{__PACKAGE__ . "::quadruplement"} = decorateur(\&quadruplement);
}

{   
    no warnings 'redefine';
    *main::quadruplement = decorateur(\&quadruplement);
}

say quadruplement($_) for 5, 15;


sub decorateur { 
    my $coderef = shift;
    my $num_appel = 1;
    return sub { 
        say "Appel numéro $num_appel de la fonction avec les arguments: @_"; 
        $num_appel++;
        my $resultat = $coderef->(@_); 
        say "Valeur de retour: $resultat."; 
        return $resultat; 
    } 
}

Tout le monde n'aime pas manipuler directement la table des symboles (moi le premier).

On peut créer une fonction decore pour s'en occuper à notre place :

sub decore {
    my ($sub_name, $decorator) = @_;
    no warnings 'redefine';
    no strict 'refs';
    *{"main::$sub_name"} = $decorator->(\&{$sub_name});
}

# la mise en place de la décoration est maintenant très simple:
decore ("triplement", \&decorateur);
say triplement($_) for 15, 30;

Cela marche comme précédemment et affiche le même type de résultat.

Vous pouvez maintenant mettre la fonction decore dans un module permettant d'exporter cette fonction et oublier les menues entorses aux règles usuelles de bonne pratique qu'elle se permet exceptionnellement de faire. Il existe de nombreux modules faisant ce genre de choses et que vous utilisez probablement assez régulièrement.

Rappelez-vous seulement qu'il faut lui passer le nom de la fonction à décorer (sous la forme d'une chaîne de caractères) et une référence vers le décorateur.

Nous pouvons maintenant laisser la fonction d'origine intacte et utiliser un décorateur pour effectuer la mise en cache des valeurs connues. Appelons cache notre décorateur :

sub cache {
    my $code_ref = shift;
    my @memo = (0, 1);
    return sub {
        my $n = shift;
        $memo[$n] = $code_ref->($n) unless defined $memo[$n];
        return $memo[$n];
    }
}

La fonction fibo d'origine (référée par $code_ref) n'est appelée que si le nombre en entrée n'est pas défini dans le tableau @memo.

Nous pouvons maintenant installer la fonction décorée à l'aide de decore et l'appeler :

decore("fibo", \&cache);
say fibo(shift);

Et les durées d'exécution sont tout à fait satisfaisantes :

$ time perl fibo_decoree.pl 10
55

real    0m0.214s
user    0m0.015s
sys     0m0.015s

$ time perl fibo_decoree.pl 20
6765

real    0m0.191s
user    0m0.015s
sys     0m0.015s

$ time perl fibo_decoree.pl 30
832040

real    0m0.241s
user    0m0.015s
sys     0m0.046s

$ time perl fibo_decoree.pl 40
102334155

real    0m0.202s
user    0m0.000s
sys     0m0.046s

$ time perl fibo_decoree.pl 90
2880067194370816120

real    0m0.250s
user    0m0.031s
sys     0m0.046s

Les durées d'exécution sont un peu plus longues que pour la version avec le cache codé en dur de la section 2.2.4, mais cela est dû au fait que l'instruction time du shell mesure aussi la durée de compilation du programme, qui est plus longue avec l'utilisation du décorateur (cache) et l'importation de la fonction decore de notre module externe. Nous pouvons calculer presque instantanément un nombre de Fibonacci assez grand.

Ajouter un cache à une fonction est une opération suffisamment courante pour qu'il vaille la peine de l'automatiser pleinement et de la rendre générique. Modifions d'abord légèrement le décorateur cache :

sub cache {
    my $code_ref = shift;
    my %memo;
    return sub {
        my $n = shift;
        $memo{$n} = $code_ref->($n) unless defined $memo{$n};
        return $memo{$n};
    }
}

Par rapport à la version précédente, nous avons utilisé un hachage (%memo) au lieu d'un tableau pour le cache. Un tableau suffisait pour les nombres de Fibonacci parce nous utilisions en entrée des entiers positifs consécutifs. Utiliser un hachage permet l'utilisation de clefs bien plus générales que des entiers consécutifs.

Avec la fonction fibo, cela fonctionne comme précédemment. Mais nous pouvons maintenant ajouter un cache à une autre fonction, selon nos besoins, même si les données en entrée sont des chaînes de caractères ou des nombres quelconques.

Ajouter un cache à une fonction n'est pas très difficile. Les changements à faire sont essentiellement les mêmes pour toute fonction. La transformation automatique d'une fonction pour lui ajouter un cache s'appelle la mémoïsation (on parle bien de mémoïsation, et non de mémorisation, rappelez-vous que le terme mémo est à peu près synonyme de cache), et la fonction ainsi modifiée est mémoïsée. Le décorateur cache de la section précédente, associé à la fonction decore, assure la mémoïsation de la fonction qui lui est passée en paramètre.

Nous pouvons écrire une fonction memoize qui se charge entièrement de cette mémoïsation automatique :

use strict;
use warnings;
use feature 'say';


sub fibo {
    my $n = shift;
    return $n if $n < 2; 
    return fibo ($n-1) + fibo ($n-2);
}

sub memoize {
    my $sub_name = shift;
    my %memo;
    my $code_ref = \&{$sub_name};
    my $new_func = sub {
        my $n = shift;
        $memo{$n} = $code_ref->($n) unless defined $memo{$n};
        return $memo{$n};
    };
    no warnings 'redefine';
    no strict 'refs';
    *{"main::$sub_name"} = $new_func;
}

memoize("fibo");
say fibo(shift);

La fonction générique memoize se charge maintenant de tout. Il suffit de lui passer le nom de la fonction à mémoïser (sous la forme d'une chaîne de caractères) pour obtenir le résultat escompté.

Un petit avertissement ici : toutes fonctions ne se prêtent par à la mémoïsation. En particulier, on ne peut en principe mémoïser que des fonctions « pures », c'est-à-dire des fonctions dont la valeur de retour ne dépend que des arguments d'appel. Une fonction dont la valeur de retour dépendrait d'une variable globale ou de la date système ne peut probablement pas être mémoïsée, car elle risquerait de renvoyer des résultats faux. Et il ne sert à rien de mémoïser une fonction qui est déjà très rapide, par exemple parce qu'elle effectue un calcul simple : la version mémoïsée risque alors d'être plus lente.

L'objectif, dans cette section, était seulement de montrer comment peut marcher une fonction de mémoïsation calquée sur le fonctionnement de nos décorateurs. Il resterait beaucoup à faire pour qu'elle puisse traiter tous les cas de figure. Nous n'irons pas plus loin ici, parce que ce n'est pas l'objet principal de ce tutoriel et surtout parce qu'il existe un module standard (donc présent par défaut dans toute distribution ordinaire de Perl, vous n'avez rien à installer), Memoize, écrit par Mark-Jason Dominus, qui fait tout cela. C'est évidemment ce module que vous devriez utiliser si vous désirez mémoïser une fonction. Son utilisation est très simple :

use Memoize;
memoize('fonction_lente');
fonction_lente(arguments);    # Plus rapide qu'avant (en principe)

La technique consistant à écrire directement dans la table des symboles peut fournir une forme parfois utile de « sucre syntaxique ». La présente section 4.3 a été ajoutée dans cet article suite à la demande d'un lecteur désirant employer les techniques présentées ici sans avoir besoin à proprement parler d'un décorateur.

Considérons l'exemple d'une usine à fonctions qui crée dynamiquement des fermetures agissant comme des itérateurs. Prenons un cas très simple de deux itérateurs, respectivement sur des nombres pairs et impairs. Nous pouvons écrire l'usine à fonctions suivante :

sub cree_iter {
    my $val = shift;
    return sub { return $val += 2;}
}
my $iter_pair = cree_iter(0);
my $iter_impair = cree_iter(1);

Appelons maintenant 5 fois l'itérateur de nombres pairs, 15 fois celui de nombres impairs et 5 fois celui des nombres pairs :

print $iter_pair->(), " " for 1..5;          print "\n";
print $iter_impair->(), " " for 1..15;       print "\n";
print $iter_pair->(), " " for 1..5;          print "\n";

À l'exécution, cela fonctionne parfaitement, nos itérateurs fonctionnent bien et indépendamment l'un de l'autre :

$ perl iter_pair_impair.pl
2 4 6 8 10
3 5 7 9 11 13 15 17 19 21 23 25 27 29 31
12 14 16 18 20

Le seul problème est que la syntaxe :

print $iter_pair->();

peut manquer quelque peu de convivialité pour un programmeur débutant. De plus, dans certaines entreprises, avoir une « fonction » dont le nom commence par le sigil $ est contraire aux normes de codage. Du coup, cette société ne pourra peut-être pas utiliser le beau module dans lequel nous avions logé ces itérateurs. Qu'à cela ne tienne. Il est possible dans un tel cas d'utiliser un peu de sucre syntaxique pour remédier à cette petite difficulté. Le code de notre module pourra contenir ce qui suit :

#!/usr/bin/perl
use warnings;
use strict;

sub cree_iter {
    my $val = shift;
    return sub { return $val += 2;}
}

*main::iter_pair = cree_iter(0);
*main::iter_impair = cree_iter(1);

Et le code utilisateur sera maintenant plus simple et conforme aux normes de codage de l'entreprise :

print iter_pair(), " " for 1..5;          print "\n";
print iter_impair(), " " for 1..15;       print "\n";
print iter_pair(), " " for 1..5;          print "\n";

Ce qui affichera la même chose que précédemment.

Bien sûr, le nom des fonctions créées dans la table des symboles est ici codé en dur, ce qui manque singulièrement de souplesse d'utilisation. Mais nous pouvons facilement créer une fonction de création d'itérateurs bien plus générique, prenant en paramètre le nom de la fonction à créer, le pas d'incrémentation de l'itérateur et sa valeur initiale et implantant directement l'itérateur voulu dans la table des symboles :

sub cree_iter_quelconque {
    my ($name, $multiple, $start_val) = @_;
    no strict "refs";
    *{"main::$name"} = sub { return $start_val += $multiple;}
}

Maintenant, l'utilisateur de cette fonction peut créer lui-même ses propres itérateurs et les employer sans avoir à connaître le petit tour de magie blanche effectué dans la fonction :

cree_iter_quelconque("iter_pair", 2, 0);
cree_iter_quelconque("iter_impair", 2, 1);
cree_iter_quelconque("iter_triples", 3, 0);

print iter_pair(), " " for 1..5;          print "\n";
print iter_impair(), " " for 1..15;       print "\n";
print iter_triples(), " " for 1..5;       print "\n";

Ce qui imprime :

2 4 6 8 10
3 5 7 9 11 13 15 17 19 21 23 25 27 29 31
3 6 9 12 15