La programmation fonctionnelle en Perl

La première partie de ce tutoriel abordait les techniques d'utilisation des opérateurs de listes, qui ne sont pas à proprement parler des concepts de la programmation fonctionnelle, mais sont néanmoins dans une large mesure héritées des langages fonctionnels tels que Lisp.

La seconde partie de ce tutoriel abordait réellement les concepts de la programmation fonctionnelle en Perl. Perl n'est pas à la base un langage fonctionnel, mais il permet d'utiliser de nombreuses notions empruntées aux langages fonctionnels, tout comme il permet aussi de faire de la programmation orientée objet. Le point essentiel est que c'est vous qui décidez du modèle de programmation qui vous désirez choisir, ou même d'une éventuelle combinaison de différents modèles de programmation.

Après un bref rappel sur les références en général, la seconde partie de ce tutoriel montrait comment il est possible d'utiliser des références sur des fonctions (ou coderefs, comme nous les appellerons le plus souvent désormais conformément à l'usage défini dans la seconde partie du tutoriel) et comment cette idée permet par exemple de passer une (référence à une) fonction en paramètre à une autre fonction pour créer des fonctions de rappel (ou callback functions). Inversement, ce même mécanisme permet à une fonction de renvoyer une référence à une fonction à la fonction appelante pour constituer un générateur de fonctions (ou une usine à fonctions). Quand une fonction peut être l'argument d'appel ou le paramètre de retour d'une fonction, on parle souvent, en langage de programmation fonctionnelle, de fonctions d'ordre supérieur ou de fonctions de première classe.

Ces deux mécanismes permettent d'obtenir un niveau d'indirection inexistant ou presque en programmation procédurale ordinaire. Nous avons notamment construit une fonction générique de parcours récursif d'un répertoire : la fonction se contentait de lire les objets d'un répertoire et de s'appeler récursivement si cet objet était lui-même un répertoire ; si en revanche l'objet en question était un fichier, cette fonction appelait la fonction reçue en paramètre pour assurer la partie fonctionnelle du traitement (par exemple mesurer la taille prise sur le disque, archiver les fichiers vieux de plus d'une certaine date ou effacer les fichiers temporaires devenus inutiles).

Nous avons également étudié les tables de distribution, une structure de données (généralement une table de hachage, mais éventuellement un tableau ou autre chose) qui permet de stocker dans une table les actions à effectuer (c'est-à-dire les fonctions à appeler) en fonction de la valeur d'une variable.

Nous avons ensuite étudié les fermetures (closures), un mécanisme extrêmement puissant permettant de créer des fonctions gardant leur environnement d'exécution d'un appel à l'autre. Cela permet notamment de créer des itérateurs (une fonction renvoyant à chaque appel l'élément suivant d'une liste qui n'a pas été nécessairement précalculée) et des usines à fonctions (une fonction qui renvoie à la demande d'autres fonctions utilisables dans la suite du programme).

Nous avons donné de nombreux exemples d'utilisation de ces techniques dans des environnements réels et espérons avoir démontré leur puissance pour simplifier le travail du développeur averti.

Le présent troisième volet de ce tutoriel vise à généraliser ces idées, à montrer comment il est possible d'utiliser toutes ces notions pour étendre le langage Perl en créant de véritables bibliothèques de fonctions génériques abstraites rendant le langage bien plus puissant.

Supposons pour commencer que nous voulions implémenter my_map, notre propre version de l'opérateur map, écrite en Perl pur. Il faudra sans doute lui passer en arguments une référence à une fonction et une liste.

2-1-1. Fonction map : premiers essais▲

print join " ", my_map (sub{$_ * 2}, 1..5);

sub my_map {
    my $code_ref = shift;
    return map {$code_ref->($_)} @_;
}
# imprime 2 4 6 8 10

print join " ", my_map ({$_ * 2}, 1..5); # faux
# imprime le message d'erreur suivant: Not a CODE reference at my_map.pl line 6.

print join " ", my_map (sub{$_ * 2}, 1..5);

sub my_map {
    my $code_ref = shift;
    my @d ;
    while ($_ = shift ) {
        push @d, $code_ref->($_);
    }
    return @d;
}

print join " ", my_map (sub{$_ * 2}, 1..5);

sub my_map {
    my $code_ref = shift;
    my @d ;
    push @d, $code_ref->($_) for @_;
    return @d;
}

print join " ", my_map {$_ * 2} 1..5;

2-1-2. Les prototypes Perl▲

my @a = qw(toto titi);
sub count($@) { my $c = shift; return $c, "suivi de [@_]" }
say count(@a, "tutu", "tata");

2 suivi de [tutu tata]

use strict;
use warnings;

my @array = qw / 1 2 3 /;
push @array, 4, 5;
print "@array", "\n"; #imprime 1 2 3 4 5

use strict;
use warnings;
use Data::Dumper;

my @array = (1, 4, 9);
push_square(@array, 4, 5);
# print "@array", "\n"; 

sub push_square {
    print Dumper \@_;
    # code de la fonction à écrire
}

$ perl push_square.pl
$VAR1 = [
          1,
          4,
          9,
          4,
          5
        ];

my @array = (1, 4, 9);
@array = push_square(@array, 4, 5);
print "@array", "\n";  # imprime 1 4 9 16 25

sub push_square {
    my @valeurs = splice @_, $#_ - 1, 2; # retire et récupère les deux dernières valeurs de @_
    my @array = @_;
    $_ = $_ * $_ foreach @valeurs;
    push @array, @valeurs;
    return @array;
}

my @array = (1, 4, 9);
push_square(\@array, 4, 5);
print "@array", "\n";   # imprime 1 4 9 16 25

sub push_square {
    my $array_ref = shift; 
    push @$array_ref, map $_ ** 2, @_;
}

push_square(\@array, 4, 5);

push @array, 4, 5;

sub push_square;
my @array = (1, 4, 9);
push_square \@array, 4, 5;
print "@array", "\n";   # imprime 1 4 9 16 25

sub push_square {
    my $array_ref = shift; 
    push @$array_ref, map $_ ** 2, @_;
}

sub push_square(\@@);

my @array = (1, 4, 9);
push_square @array, 4, 5;
print "@array", "\n";   # imprime 1 4 9 16 25

sub push_square(\@@) {
    my $array_ref = shift; 
    push @$array_ref, map $_ ** 2, @_;
}

sub push_square(\@@) {
    my $array_ref = shift; 
    push @$array_ref, map $_ ** 2, @_;
}

my @array = (1, 4, 9);
push_square @array, 4, 5;
print "@array", "\n";   # imprime 1 4 9 16 25

$ perl push_square.pl
$VAR1 = [
          [
            1,
            4,
            9
          ],
          4,
          5
        ];
1 4 9 16 25

push_square @array, 4, 5;

2-1-3. Des fonctions my_map et my_grep fonctionnelles▲

sub my_map(&@);

# version avec proto et sans parenthèse
sub my_map(&@);  # le prototype doit figurer avant l'appel

my @tableau = 1..5;

print join " ", my_map {$_ * 2} @tableau;

sub my_map (&@){
    my $code_ref = shift;
    my @d;
    push @d, $code_ref->($_) for @_;
    return @d;
}
# imprime: 2 4 6 8 10

sub my_map(&@);  # le prototype doit figurer avant l'appel

my @tableau = 1..5;

print "Nouveau tableau: ", join " ", my_map {++$_} @tableau;
print "\nTableau d'origine: ", "@tableau", "\n";

sub my_map (&@){
    my $code_ref = shift;
    my @d = @_;
    $_ = $code_ref->($_) for @d;
    return @d;
}
# imprime:
# Nouveau tableau: 2 3 4 5 6
# Tableau d'origine: 1 2 3 4 5

sub my_grep (&@) {
    my $code_ref = shift;
    my @result;
    push @result, $code_ref->($_) ? $_: () for @_;
    return @result;
}
print join " ", my_grep {not $_ %2} (1..10);
# imprime 2 4 6 8 10

Depuis la version 5.8 de Perl, la fonction sort de Perl implémente par défaut l'algorithme de tri connu sous le nom de tri fusion (mergesort). Les versions antérieures de Perl utilisaient l'algorithme dit du tri rapide (quicksort). La raison principale de ce changement est que, même si le tri rapide est généralement un peu plus rapide que le tri fusion, il y a des cas particuliers pour lesquels le tri rapide est bien moins efficace que le tri fusion (notamment quand les données sont déjà presque triées, en sens direct ou inverse). Et ces cas particuliers sont statistiquement exceptionnels sur des données aléatoires, mais en fait loin d'être rares dans la vie réelle : on doit souvent retrier une liste déjà triée à laquelle on a ajouté quelques éléments ou dont on a modifié seulement quelques-unes des valeurs de tri.

En théorie algorithmique, on dit que, pour trier n éléments, le tri fusion et le tri rapide ont tous les deux une complexité moyenne en O(n log n), avec généralement un léger avantage de rapidité au tri rapide, mais que le tri rapide à une complexité dans le pire des cas en O(n²), alors que le tri fusion a une complexité dans le pire des cas restant en O(n log n). D'où l'avantage d'utiliser le tri fusion, qui reste efficace dans tous les cas.

Supposons maintenant que nous voulions mettre en œuvre un autre algorithme de tri, dont les propriétés seraient hypothétiquement jugées meilleures. Pour cet exemple, nous allons choisir l'algorithme un peu exotique dit du « tri à peigne » (combsort ou tri de Dobosiewicz), décrit par exemple dans cet article sur le tri à peigne de Wikipédia. Cet algorithme possède globalement de bonnes propriétés (généralement supérieures au tri fusion), mais est peu utilisé dans la pratique parce son analyse théorique est extrêmement malaisée (en particulier, il semble qu'il ait un bon comportement dans le pire des cas, mais personne n'a réussi à le démontrer formellement jusqu'à présent). En fait, peu nous importent ici les qualités réelles de ce tri, nous voulons seulement illustrer la mise en œuvre d'une fonction sort particulière utilisant un algorithme de tri différent, nous aurions pu aussi bien choisir un algorithme connu pour avoir généralement de mauvaises performances, comme le tri à bulles. Il n'y a de toute façon aucune chance que cette mise en œuvre en Perl pur du tri à peigne soit plus efficace que le sort interne, écrit en C et très soigneusement optimisé par ses auteurs.

Pour fonctionner de façon analogue à la fonction interne sort, une fonction de tri doit recevoir en paramètres la fonction de comparaison utilisée par le tri et le tableau à trier et cette fonction de comparaison doit utiliser les variables globales spéciales $a et $b. La fonction de tri à peigne peut être mise en œuvre avec la fonction suivante :(3)

sub comb_sort (&\@) {
    my $code_ref = shift;
    my $v_ref = shift;
    my $max = scalar (@$v_ref);
    my $gap = $max;
    while (1) {
        my $swapped = 0;
        $gap = int ($gap / 1.3);
        $gap = 1 if $gap < 1;
        my $lmax = $max - $gap - 1;
        foreach my $i (0..$lmax) {
            local ($a, $b) = ($$v_ref[$i], $$v_ref[$i+$gap]);
            ($$v_ref[$i], $$v_ref[$i+$gap], $swapped) = ($$v_ref[$i+$gap], $$v_ref[$i], 1)
                if $code_ref->($a, $b) > 0;
        }
        last if $gap == 1 and $swapped == 0;
    }
}

Nous affectons les valeurs à comparer aux variables globales spéciales $a et $b avant d'appeler la fonction de comparaison référencée par $code_ref reçue en paramètre (en prenant soin de les déclarer en local pour ne pas risquer d'altérer leur valeur globalement si elles sont utilisées ailleurs). Du coup, l'appel à la fonction comb_sort se fait avec exactement la même syntaxe qu'un appel à la fonction sort interne de Perl :

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

my @v;
my $max = 500;

$v[$_] = int rand(20000) foreach (0..$max);

comb_sort {$a<=>$b} @v;
print "@v";

Ce qui fonctionne et imprime une liste correctement triée :

$ perl   my_sort.pl
23 96 113 133 213 259 279 339 374 391 451 458 553 641 680 728 729 750 772 775 908 920 1034 1038 1096 1099 1134 1269 1293 1303 1588 1673 1738 1742 1809 1840 1882 1967 1985 2023 2068 2112 2131 2184 2206 2206 2216 2229 2277 2323 2369 2383 2414 2442 2445 2448 2635 2672 2686 2687 2840 2859 2884 2934 2988 2998 3055 3057 3113 3167 3239 3240 3314 3421 3430 3468 3528 3586 3606 3609 3649 3667 3670 3756 3764 3789 3921 3931 3951 4000 4033 4044 4077 4190 4248 4308 4346 4379 4459 4501 4519 4564 4596 4597 4609 4625 4641 4715 4747 4791 4824 4840 4949 5035 5081 5086 5101 5125 5310 5409 (...)

On peut désirer combiner la propriété principale de l'opérateur map, à savoir appliquer une certaine transformation à une liste présentée en entrée et renvoyer en sortie les données modifiées par cette transformation, et la propriété principale d'un itérateur, à savoir ne fournir les données en sortie qu'une par une, à la demande de l'appelant. Cette nouvelle fonction ne renverrait pas une liste, mais un seul élément, en sortie, et sa sémantique est donc clairement différente de la fonction map de Perl, on pourrait faire remarquer non sans raison que cette nouvelle fonction n'a plus grand-chose à voir avec map. D'un autre côté, on peut arguer que cette fonction fait bien fondamentalement la même chose, appliquer la transformation considérée aux éléments de la liste fournie en entrée, mais qu'elle le fait simplement de façon dite « paresseuse » (ou avec évaluation retardée), ne renvoyant des valeurs que sur demande. Pour refléter cette vision, nous appellerons cette fonction lazy_map.

Quel est l'intérêt d'une fonction lazy_map ? Imaginons que nous ayons en entrée de cette fonction une liste assez longue d'entiers. Imaginons en outre que, selon les circonstances, notre traitement principal n'utilisera le plus souvent que quelques valeurs produites à partir de cette liste, et, seulement dans quelques cas rares ou exceptionnels, une partie beaucoup plus substantielle de cette liste. Il est peut-être inefficace, voire très inefficace, d'appliquer le traitement de transformation d'un map à une longue liste si, dans la très grande majorité des cas, on n'utilisera en fait que quelques-unes des valeurs calculées. Ce sera particulièrement le cas si le traitement de transformation du map est gros consommateur de ressources. Dans ce genre de cas, nous voudrions que le map ne calcule que les valeurs nécessaires et s'arrête de traiter la liste en entrée dès que la recherche a été fructueuse. C'est exactement ce que ferait lazy_map et ce que ne sait pas faire le map de Perl ou la fonction my_map vue précédemmentDes fonctions my_map et my_grep fonctionnelles (alors que l'on sait facilement arrêter une boucle for ou foreach au bon moment, ce qui peut rendre celle-ci bien plus efficace que le map de Perl dans ce genre de cas).

Par exemple, si le traitement effectué par la fonction passée à map est une décomposition en facteurs premiers des nombres de la liste, cela peut devenir coûteux en temps de traitement, surtout si les nombres de la liste deviennent grands. Il est alors bien préférable de ne faire l'opération que quand elle est strictement nécessaire.

2-3-1. Le générateur d'itérateurs▲

my @tableau = 1..5;
my $iterateur = create_iter(@tableau);
for (1..4) { 
    my $val = $iterateur->(); 
    print $val, "\n" if defined $val;
}

sub create_iter {
    my @array = @_;
    return sub { shift @array}
}

sub create_iter(\@); # la déclaration avec le prototype doit figurer avant l'appel
my @tableau = 1..5;
my $iterateur = create_iter(@tableau);
for (1..4) { 
    my $val = $iterateur->(); 
    print $val, "\n" if defined $val;
}

sub create_iter(\@) {
    my $array_ref = shift;
    my $index = 0;
    return sub { $array_ref->[$index++];}
}

2-3-2. La fonction lazy_map▲

sub lazy_map(&$);  # le prototype doit figurer avant l'appel
sub create_iter(\@);

my @tableau = reverse 1..7;
my $iterateur = create_iter(@tableau);

for (1..5) {
    my $val = lazy_map {$_**2} $iterateur;
    print "Itération N° $_ : $val \n" if defined $val;
}

sub lazy_map (&$){
    my ($code_ref, $iter) = @_;
    local $_ = $iter->(); # lazy_map travaille sur $_ comme map
    return unless defined $_;
    return $code_ref->();
}

sub create_iter(\@) {
    my $array_ref = shift;
    my $index = 0;
    return sub { $array_ref->[$index++];}
}

$ perl  lazy_map.pl
Itération N° 1 : 49
Itération N° 2 : 36
Itération N° 3 : 25
Itération N° 4 : 16
Itération N° 5 : 9

use strict; 
use warnings;
use Benchmark;

my @tableau = ();# voir plus bas les deux cas;
my $iterateur = create_iter (@tableau);

sub lazy_map (&$){
    my ($code_ref, $iter) = @_;
    local $_ = $iter->(); # lazy_map travaille sur $_ comme map
    return unless defined $_;
    return $code_ref->();
}

sub create_iter {
    my $array_ref = \@_;
    my $index = 0;
    return sub { $array_ref->[$index++];}
}

sub try_map {
    my @c = grep {$_ == 15000} map { $_ * 2 } @tableau;
}
sub try_lazy_map {
    my $iterateur = create_iter(@tableau);
    while (1) {
        my $val = lazy_map {$_*2} $iterateur;
        last unless defined $val;
        last if $val == 15000;
    }
}

timethese ( 1000, {
                "map"         => sub { try_map(); },
                "lazy_map"     => sub { try_lazy_map() },
} );

my @tableau = 1..10000;

$ perl  bench_lazy_map.pl
Benchmark: timing 1000 iterations of lazy_map, map...
  lazy_map: 12 wallclock secs (11.58 usr +  0.00 sys = 11.58 CPU) @ 86.39/s (n=1000)
       map:  2 wallclock secs ( 2.28 usr +  0.00 sys =  2.21 CPU) @ 438.98/s (n=1000)

my @tableau = 1..100000;

$ perl  bench_lazy_map.pl
Benchmark: timing 1000 iterations of lazy_map, map...
  lazy_map: 13 wallclock secs (12.36 usr +  0.20 sys = 12.56 CPU) @ 79.63/s (n=1000)
       map: 22 wallclock secs (22.39 usr +  0.00 sys = 22.39 CPU) @ 44.67/s (n=1000)

2-3-3. Une fonction lazy_grep▲

my @tableau = reverse 1..10;
my $iterateur = create_iter(@tableau);

sub lazy_grep (&$){
    my ($code_ref, $iter) = @_;
    local $_ = $iter->(); 
    return unless defined $_;
    return $_ if $code_ref->();
    return;
}
for (1..9) {
    my $val = lazy_grep {$_%2} $iterateur;
    print "Itération N° $_ : $val \n" if defined $val;
}

$ perl  lazy_grep.pl
Itération N° 2 : 9
Itération N° 4 : 7
Itération N° 6 : 5
Itération N° 8 : 3

sub lazy_grep (&$){
    my ($code_ref, $iter) = @_;
    while (1) {
        local $_ = $iter->() ; 
        return unless defined $_; # éviter une boucle infinie
        return $_ if $code_ref->();
    }
}

my @tableau = reverse 1..10;
my $iterateur = create_iter(@tableau);

for my $i (1..8) {
    my $val = lazy_grep {$_%2} $iterateur;
    print "Itération N° $i : $val \n" if defined $val;
}

$ perl  lazy_grep.pl
Itération N° 1 : 9
Itération N° 2 : 7
Itération N° 3 : 5
Itération N° 4 : 3
Itération N° 5 : 1

2-3-4. Le problème du semi-prédicat▲

my @tableau = reverse 1..10;
@tableau[20..30] = (20..30);

Itération N° 1 : 9
Itération N° 2 : 7
Itération N° 3 : 5
Itération N° 4 : 3
Itération N° 5 : 1
Itération N° 16 : 21
Itération N° 17 : 23
Itération N° 18 : 25
Itération N° 19 : 27
Itération N° 20 : 29

sub create_iter(\@) {
    my $array_ref = shift;
    my $index = 0;
    my $max = $#{$array_ref}; # dernier élément du tableau
    return sub { 
        return undef if $index > $max;
        \$array_ref->[$index++];        
    }
}

2-3-5. Fonctions lazy_grep et lazy_map : versions finales▲

sub lazy_grep (&$){
    my ($code_ref, $iter) = @_;
    while (1) {
        my $iref = $iter->(); 
        return unless $iref; # sort si le tableau est épuisé
        local $_ = $$iref;
        next unless defined $_; # reboucle si la valeur n'est pas définie
        return $_ if $code_ref->();
    }
}

Itération N° 1 : 9
Itération N° 2 : 7
Itération N° 3 : 5
Itération N° 4 : 3
Itération N° 5 : 1
Itération N° 6 : 21
Itération N° 7 : 23
Itération N° 8 : 25
Itération N° 9 : 27
Itération N° 10 : 29

sub lazy_map (&$){
    my ($code_ref, $iter) = @_;
    local $_ = ${$iter->()}; 
    return unless defined $_;
    return $code_ref->();
}

L'itérateur utilisé ci-dessus pour la mise en œuvre des fonctions lazy_map et lazy_grep est très simple : il dépile de la source une seule valeur à la fois et renvoie au demandeur une seule valeur à la fois. C'est normal, c'est ce que l'on demande le plus souvent à un itérateur. Mais l'on peut imaginer des cas où il serait souhaitable que l'itérateur renvoie, par exemple, des couples ou des triplets de valeurs. On peut même imaginer des cas un peu plus complexes où l'on souhaite que l'itérateur renvoie deux valeurs, mais n'en dépile qu'une seule : par exemple, si la source des données est la suite des entiers naturels pairs supérieurs à 0, on peut vouloir recevoir à chaque appel un couple de valeurs de la suite suivante : (2,4), (4,6), (6,8), etc.

2-4-1. Consommer et renvoyer deux valeurs à chaque demande▲

sub create_iter_n($\@) {
    my ($nb_items, $array_ref) = @_;
    my $index = 0;
    my $max = $#{$array_ref} + 1; # dernier élément du tableau + 1 
                      # car on teste $index après l'incrémentation
    return sub { 
        my @return_array;
        push @return_array, $array_ref->[$index++] for 1..$nb_items;
        return undef if $index > $max;
        return @return_array;        
    }
}

my @input_array = 1..20;
my $get_2_items = create_iter_n 2, @input_array; # itérateur de paires
my $get_3_items = create_iter_n 3, @input_array; # itérateur de triplets
my $get_4_items = create_iter_n 4, @input_array; # itérateur de quadruplets

print "\nPaires:\n";
for (1..7) {
    print join " ", grep defined $_, $get_2_items->();
    print "\n";
}
print "\nTriplets:\n";
for (1..5) {
    print join " ", grep defined $_, $get_3_items->();
    print "\n";
}
print "\nQuadruplets:\n";
for (1..10) {
    print join " ", grep defined $_, $get_4_items->();
    print "\n";
}

$ perl iter_n.pl

Paires:
1 2
3 4
5 6
7 8
9 10
11 12
13 14

Triplets:
1 2 3
4 5 6
7 8 9
10 11 12
13 14 15

Quadruplets:
1 2 3 4
5 6 7 8
9 10 11 12
13 14 15 16
17 18 19 20

2-4-2. Consommer une valeur et en renvoyer deux (ou plus)▲

use strict;
use warnings;

sub create_iter_1_2(\@) {
    my $array_ref = shift;
    my $index = 0;
    my $max = $#{$array_ref} + 1; 
    return sub { 
        return undef if $index > $max;
        return ($array_ref->[$index++], $array_ref->[$index]);
    }
}

my @input_array = (1..5, 7, 11, 18, 34..39);
my $get_2_items = create_iter_1_2 @input_array; 

while (1) {
    my ($c, $d) = $get_2_items->();
    last unless defined $d;
    print "$c $d\n" and last if $d - $c > 5;
}

$ perl iter_1_2.pl
11 18

Supposons que nous voulions écrire une fonction calculant l'élément le plus grand d'une liste de nombres. Rien de bien compliqué :

sub max {
    my $max = shift; # initialise $max au 1er élément du tableau
    for (@_) { $max = $_ if $_ > $max; };
    return $max;
}

S'il nous faut également une fonction trouvant l'élément le plus petit d'une liste nous pouvons faire de même :

sub min {
    my $min = shift;
    for (@_) { $min = $_ if $_ < $min; };
    return $min;
}

Pour calculer la somme des éléments d'une liste :

sub somme {
    my $sum = shift;
    for (@_) { $sum += $_; };
    return $sum;
}

Comme lorsque nous voulions parcourir une arborescence de répertoire (voir la partie 2 de ce tutoriel)), nous nous retrouvons à nouveau à écrire plusieurs fois presque le même code. Et, en bons programmeurs que nous sommes ou avons l'ambition de devenir, quand ce genre de situation se présente, nous nous demandons comment nous pourrions éviter d'écrire plusieurs fois la même chose.

Le lecteur perspicace aura sans doute deviné que, pour résoudre ce genre de problème, nous désirons passer à la fonction une fonction de rappel, donc une référence à une autre fonction.

3-1-1. Essais avec une fonction de rappel▲

use strict;
use warnings;

my @c = 1..10;
my $sum_ref = sub {my $value = shift; for (@_) { $value += $_; }; return $value;};
my $somme = traite($sum_ref, @c);

sub traite {
    my $code_ref = shift;
    return $code_ref->(@_);
}
print "\n $somme \n";

use strict;
use warnings;

my @c = 1..10;
my $sum_ref = sub {$value += $_; }; # ne marche pas
my $somme = traite ($sum_ref, @c);

sub traite {
    my $code_ref = shift;
    my $value = shift;
    code_ref->($_) for (@_) 
    return $value;
}
print "\n $somme \n";

3-1-2. Un générateur de fermetures anonymes▲

use strict;
use warnings;

my @c = 1..10;
my $somme = sum(@c);

sub traite {
    my $code_ref = shift;
    local $a = $code_ref->($_) for @_;
    return $a;
}

sub sum {
    return traite (sub { $a += $_ }, @_);
}
print "\n $somme \n";

sub max {
    local $a = shift;
    return traite (sub { $a = $_ if $_ > $a }, @_);
}

Forts de ce que nous avons fait pour écrire des versions purement Perl des fonctions map ou grep, nous n'avons guère de difficulté pour écrire une fonction reduce fondée sur le même modèle :

sub reduce(&@) {
    my $code_ref = shift;
    my $result = shift;
    $result = $code_ref->($result, $_) for  @_;
    return $result;
}

Le prototype de la fonction indique qu'elle reçoit une coderef et une liste. La fonction dépile la coderef et le premier élément de la liste, puis applique la coderef aux autres éléments de la liste, et renvoie le résultat final. Plus précisément, le premier élément de la liste devient le résultat provisoire, et la coderef est appelée, pour chaque élément de la liste, avec pour paramètres ce résultat provisoire et un nouvel élément de la liste, et la coderef renvoie le nouveau résultat provisoire. Une fois les éléments de la liste épuisés, le résultat provisoire devient le résultat définitif et est renvoyé à l'appelant de la fonction reduce.

L'élément le plus grand d'une liste numérique peut maintenant être trouvé comme suit :

my $max = reduce {
     my ($result, $new_val) = @_; 
     return $result if $result > $new_val;
     return $new_val;
     } @tableau;

L'utilisation directe du tableau @_ des paramètres passés à la fonction et de l'opérateur ternaire « ?: » va permettre d'obtenir une syntaxe bien plus compacte. Par exemple, pour trouver le minimum, le maximum et la somme des éléments d'une liste de nombres de 1 à 20, il est maintenant possible d'appeler la fonction reduce comme suit :

sub reduce(&@);

my $max = reduce {$_[0] > $_[1] ? $_[0] : $_[1]} 1..20; 
my $min = reduce {$_[0] > $_[1] ? $_[1] : $_[0]} 1..20; 
my $sum = reduce {$_[0] + $_[1]} 1..20;

L'objectif recherché est atteint : il n'y a plus de code dupliqué. Et le code utilisé est parfaitement générique et fonctionnera avec une liste numérique quelconque. Si bien que, tant qu'à avoir défini le code pour trouver le maximum, le minimum et la somme des éléments d'une liste, autant mettre ce code dans des fonctions réutilisables :

sub reduce(&@);

sub max { reduce {$_[0] > $_[1] ? $_[0] : $_[1]} @_}
sub min { reduce {$_[0] > $_[1] ? $_[1] : $_[0]} @_} 
sub sum { reduce {$_[0] + $_[1]} @_}

Arrêtons-nous un instant pour réfléchir à ce que nous venons de faire. Nous avons d'abord créé une fonction reduce recevant en paramètres une coderef et une liste. Puis nous avons utilisé cette fonction reduce pour créer de nouvelles fonctions à la demande. Nous venons de découvrir une nouvelle façon de créer dynamiquement de nouvelles fonctions.

Tout cela est bien beau, mais il reste un petit problème : si nous devons demander à l'utilisateur de notre fonction reduce d'utiliser une syntaxe un peu cryptique du genre :

{$_[0] > $_[1] ? $_[0] : $_[1]}

Il n'est pas sûr que nous arrivions à le convaincre. Essayons donc de simplifier l'interface.

Le lecteur se souviendra sans doute des variables spéciales $a et $b utilisées par la fonction sort, pas seulement par la fonction sort interne de Perl, mais aussi par celle que nous avons implémentée en Perl pur avec l'algorithme un peu exotique du tri à peigneÉcrire une fonction sort originale. Nous sommes ici dans un cas assez similaire : nous aimerions utiliser deux variables, l'une contenant le résultat courant et l'autre la nouvelle valeur à tester. Notre fonction reduce sera un peu plus complexe, mais l'interface offerte à l'utilisateur de notre fonction sera quant à elle plus simple (ce qui va généralement dans la bonne direction si l'on désire voir beaucoup de personnes utiliser nos modules).

3-3-1. Code de la nouvelle version de reduce▲

sub reduce(&@) {
    my $code_ref = shift;
    my $result = shift;
    $result = $code_ref->($result, $_) for  @_;
    return $result;
}

sub reduce (&@) {
    my $code_ref = shift;
    my $result = shift;
    for (@_ ) {
        local ($a, $b) = ($result, $_ );
        $result = $code_ref->($a, $b )
    }
    return $result;
}

my $max = reduce {$_[0] > $_[1] ? $_[0] : $_[1]}, @_;

my $max = reduce { $a > $b ? $a : $b } @_;

3-3-2. Le problème de la liste vide▲

my @a = 1..10;
print join " ", max(@a), sum(@a);

sub max { reduce { $a > $b ? $a : $b } @_; }
sub sum { reduce { $a + $b } @_; }

Use of uninitialized value in join or string at ...
Use of uninitialized value in join or string at ...

my @a = ();
my $maximum = max(@a);
print $maximum, "\n" if defined $maximum;

sub max { reduce { $a > $b ? $a : $b } @_; }

sub sum { 
     return 0 unless scalar @_;
     reduce { $a + $b } @_;
}

my @a = ();
print sum(@a);

sub sum { reduce { $a + $b } 0, @_; }

my @a = 1..10;
print scalar @a;  # imprime 10

my $nr_elmnts = count (1..10);
print "$nr_elmnts \n"; # imprime 10

sub count { reduce { $a + 1 } @_; };

my $nr_elmnts = count (reverse 1..10);

my $nr_elmnts = count (reverse 1..10);
print "$nr_elmnts \n";

sub count { reduce { $a + 1 } 0, @_; };

3-4-1. Fonctions de listes simples▲

sub max {
    reduce { $a > $b ? $a : $b } @_; 
}
sub min {
    reduce { $a > $b ? $b : $a } @_; 
}
sub sum {
    reduce { $a + $b } 0, @_; 
}
sub product {
    reduce { $a * $b } @_; 
}
sub avg {      # moyenne
    return undef unless @_; # éviter une division par 0
    sum (@_)/scalar @_;
}
sub variance {
    return undef unless @_; # éviter une division par 0
    my $moyenne = avg (@_);
    sum ( map {($_ - $moyenne)**2} @_ )/ scalar @_;
    # cette dernière ligne pourrait s'écrire plus simplement:
    # avg ( map {($_ - $moyenne)**2} @_ );
}
sub std_dev {      # écart-type
    sqrt variance (@_);
}
sub maxstr {
    reduce { $a gt $b ? $a : $b } @_; 
}
sub minstr {
    reduce { $a gt $b ? $b : $a } @_; 
}
sub longest_str {
    reduce { length $a > length $b ? $a : $b } @_;
}
sub shortest_str {
    reduce { length $a > length $b ? $b : $a } @_;
}
sub concatenate {
    return reduce { $a . $b } @_;
    # si l'on préfère considérer que la concaténation d'une 
    # liste vide est une chaîne vide, mettre plutôt :
    # return reduce { $a . $b } "", @_;
}

3-4-2. Fonctions de listes composées▲

print "true\n" if any(sub { $_> 10 }, qw /6 4 5 7/); # n'imprime rien
print "true\n" if any(sub { $_> 10 }, qw /12 4 5 7/); # imprime "true"

sub any {
    my $code_ref = shift;
    reduce { $a or $code_ref->(local $_ = $b) } @_;
}

sub any {
    my $code_ref = shift;
    reduce { $a or $code_ref->(local $_ = $b) } @_;
}
sub all {
    my $code_ref = shift;
    reduce { $a and $code_ref->(local $_ = $b) } @_;
}
sub none {
    my $code_ref = shift;
    reduce { $a and not $code_ref->(local $_ = $b) } @_;
}
sub notall {
    my $code_ref = shift;
    reduce { $a or not $code_ref->(local $_ = $b) } @_;
}

sub any(&@) {
    my $code_ref = shift;
    reduce { $a or $code_ref->(local $_ = $b) } @_;
}

print "true\n" if any { $_> 11 } qw /3 4 5 7/;

print "true\n" if any { $_> 11 } 0, qw /3 4 5 7/; # n'imprime rien
print "true\n" if any { $_> 11 } 0, qw /3 12 4 5 7/; # imprime "true"

sub any(&@) {
    my $code_ref = shift;
    reduce { $a or $code_ref->(local $_ = $b) } 0, @_;
}

sub all(&@) {
    my $code_ref = shift;
    reduce { $a and $code_ref->(local $_ = $b) } 1, @_;
}
sub none(&@) {
    my $code_ref = shift;
    reduce { $a and not $code_ref->(local $_ = $b) } 1, @_;
}
sub notall(&@) {
    my $code_ref = shift;
    reduce { $a or not $code_ref->(local $_ = $b) } 0, @_;
}

La curryfication consiste à remplacer une fonction ayant plusieurs arguments par une fonction n'acceptant qu'un seul argument et renvoyant une autre fonction (généralement une fermeture) chargée de traiter les autres arguments.

L'exemple classique est une fonction d'ajout. Soit une fonction add(x, y) qui prend deux arguments et en renvoie la somme. Une fois curryfiée, on aurait une fonction add(x) qui prend un argument et renvoie une fonction qui prend le deuxième argument. La curryfication permet de réaliser une application partielle : si on appelle la fonction curryfiée avec l'argument 2, on reçoit en retour une fonction unaire qui ajoute 2 à son argument.Voici un exemple en Caml :

let add x y = x + y;; (* définit la fonction add *)
let add_two = add 2;; (* la fonction add_two ajoute 2 à son argument *) 
add_two 3;;  (* applique add_two à 3 et retourne 5 *)

Le mécanisme de la fermeture permet de faire la même chose très simplement en Perl :

sub add { 
    my $ajout = shift; 
    return sub {$ajout + shift}
};
my $add_2 =  add(2);
print $add_2->(3); # imprime 5

Ici, la coderef $add_2 est une version curryfiée de la fonction add. On peut bien sûr en créer une autre (ou autant que l'on veut) :

my $add_3 =  add(3);
print $add_3->(5); # imprime 8

À vrai dire, il n'y a pas grand-chose de bien nouveau dans ce que nous venons de faire.

Plusieurs des fonctions étudiées aux chapitres 3.3 à 3.5 de la partie 2 de ce tutoriel faisaient déjà à peu près le même chose et étaient pour certaines implicitement curryfiées (partiellement ou totalement). Simplement, nous ne l'avons pas dit à l'époque parce que notre objectif était alors autre : expliquer le mécanisme de fonction retournant des fonctions (ou d' « usine à fonctions »). Cette idée était suffisamment nouvelle pour ne pas l'encombrer de considérations théoriques supplémentaires. Implicitement, dès que l'on crée une fermeture qui stocke une partie de ses paramètres dans son environnement d'exécution, on pratique une forme (primaire et peut-être incomplète) de curryfication, même si ce n'est pas le but premier.

Essayons cependant d'utiliser cette notion de façon plus explicite, pour réellement transformer des fonctions à plusieurs arguments en une chaîne de fonctions à un seul argument.

Vous vous souvenez de la fonction parcours_dir qui nous a permis d'introduire la notion de fonction de rappel au début de la seconde partie de ce tutoriel ? Il s'agissait de parcourir une arborescence de répertoires sur un disque dur et d'appliquer une fonction de rappel passée en paramètre aux objets trouvés dans ce répertoire. Celle-ci s'écrivait à peu près comme suit :

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

my $dir_depart = $ARGV[0];
chomp $dir_depart;

my $imprime_fic = sub { print $_[0], "\n"; };
parcours_dir($imprime_fic, $dir_depart);

sub parcours_dir {
    my ($code_ref, $path) = @_;
    my @dir_entries = glob("$path/*");
    foreach my $entry (@dir_entries) {
        $code_ref->($entry) if -f $entry;
        parcours_dir($code_ref, $entry) if -d $entry;
    }
}

Il n'est pas bien difficile de créer une version curryfiée :

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

sub create_func {
    my $code_ref = shift;
    my $func;
    $func  = sub {
        my $path = shift;
        my @dir_entries = glob("$path/*");
        foreach my $entry (@dir_entries) {
            $code_ref->($entry) if -f $entry;
            $func->($entry) if -d $entry;
        }
    }
}
my $print_dir = create_func(sub { print shift, "\n"; });
$print_dir->($ARGV[0]);

Cela marche, mais l'intérêt de l'opération ne saute pas sans doute aux yeux pour l'instant : le code est sans doute un peu plus complexe à comprendre et un peu plus long. Peut-être est-ce marginalement plus rapide parce que la fonction récursive $func prend un paramètre de moins, mais ce n'est même pas sûr et la différence est de toute façon au mieux minime.

Cela nous permet de résoudre en partie le problème de la variable globale que nous utilisions pour mesurer la taille des fichiers présents dans l'arborescence du répertoire :

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

sub create_func {
    my ($code_ref, $tot_size_ref) = @_;
    my $func;
    $func  = sub {
        my $path = shift;
        my @dir_entries = glob("$path/*");
        foreach my $entry (@dir_entries) {
            $func->($entry) and next if -d $entry;
            $code_ref->($tot_size_ref, $entry) if -f $entry;
        }
    }
}
my $tot_size = 0;
my $size_dir_func_ref = create_func(
    sub {my $size_ref = shift; $$size_ref += (-s shift)}, \$tot_size);
$size_dir_func_ref->($ARGV[0]);
print $tot_size, "\n";

Cette version fonctionne, mais est à la vérité un peu maladroite et peu satisfaisante, parce que la fonction create_func n'est plus générique (il faut lui passer un paramètre supplémentaire, la taille), l'appel récursif à $code_ref nécessite également un paramètre supplémentaire et deux des fonctions prennent deux paramètres et ne sont donc pas réellement curryfiées.

En fait, la coderef $func doit être une fermeture sur la coderef de la fonction de rappel, mais n'a pas besoin de se fermer sur la taille, qu'elle n'a pas réellement besoin de connaître. C'est la coderef ($size_dir_func_ref) de la fonction de rappel qui aurait besoin de se fermer sur la taille. Voici donc une nouvelle version répondant à ces besoins et contenant trois fermetures et des fonctions réellement curryfiées :

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

sub create_func {
    my $code_ref = shift;
    my $func;
    $func  = sub {
        my $path = shift;
        my @dir_entries = glob("$path/*");
        foreach my $entry (@dir_entries) {
            $func->($entry) and next if -d $entry;
            $code_ref->($entry) if -f $entry;
        }
    }
}

sub parcours_dir {
    my $tot_size = 0;
    my $size_dir_func_ref = create_func( sub { $tot_size += (-s shift)} );
    $size_dir_func_ref->($_[0]);
    return $tot_size, "\n";
}
print parcours_dir($ARGV[0]);

Cette fois, nous avons atteint tous nos objectifs :

• la fonction create_func est redevenue complètement générique et abstraite, elle peut être réutilisée sans changement pour n'importe quel autre parcours de répertoire, c'est la fonction de rappel qui assure entièrement la logique fonctionnelle à employer ;
• il n'y a plus de variable globale contenant la taille du répertoire et, plus généralement, toutes les variables ne sont accessibles que là où elles ont besoin de l'être ;
• toutes les fonctions ne prennent qu'un seul argument et sont bien complètement curryfiées, il n'y a plus de passage répétitif du même paramètre.

La fonction reduce étudiée précédemment présente encore un petit défaut : la fonction utilisatrice (max, par exemple) reçoit en paramètre une liste et doit repasser cette liste à reduce. N'y a-t-il pas moyen de simplifier cette syntaxe ? Il ne s'agit pas simplement d'ajouter du sucre syntaxique : accessoirement, n'est-il pas possible d'éviter ce double passage de paramètres, qui peut être gourmand en mémoire et en temps CPU ? Est-ce que la curryfication de cette fonction ne pourra pas améliorer les choses ?

Essayons une première tentative :

use strict;
use warnings;

sub reduce (&) {
    my $code_ref = shift;
    my $func = sub {        
        my $result = shift;
        for (@_ ) {
            local ($a, $b) = ($result, $_ );
            $result = $code_ref->($a, $b );
        }
        return $result;
    };
    return $func;
}

my $max = sub { reduce { $a > $b ? $a : $b } }; 
my $maximum = $max->()->(1..10);
print "Le max est: $maximum \n";

L'écriture de la fonction reduce curryfiée ne présente pas de difficulté particulière. Elle peut être simplifiée comme suit :

sub reduce (&) {
    my $code_ref = shift;
    return sub {        
        my $result = shift;
        for (@_ ) {
            local ($a, $b) = ($result, $_ );
            $result = $code_ref->($a, $b );
        }
        return $result;
    };
}

Mais le problème est que l'on ne peut pas vraiment dire que l'appel de la coderef $max :

my $maximum = $max->()->(1..10);

soit simplifié, en raison de la double indirection des coderefs. Bref, on est bien loin du sucre syntaxique.

Les syntaxes d'appel alternatives sont à peine plus encourageantes. Par exemple, la syntaxe d'appel suivante :

my $max = sub { reduce { $a > $b ? $a : $b } }; 
my $maximum = &$max->(1..10);

fonctionne également, mais n'est pas beaucoup plus lisible.

La syntaxe suivante :

sub max { reduce { $a > $b ? $a : $b } }; 
my $maximum = max->(1..10);

est déjà un peu plus lisible mais reste assez lourde.

Nous pouvons utiliser un peu de magie blanche et écrire directement dans la table des symboles(5) :

use strict;
use warnings;

sub reduce (&@) {
    my $code_ref = shift;
    return sub {        
        my $result = shift;
        for (@_ ) {
            local ($a, $b) = ($result, $_ );
            $result = $code_ref->($a, $b );
        }
        return $result;
    };
}
*max = reduce { $a > $b ? $a : $b }; 
my $maximum = max(1..10);
print "Le max est: $maximum \n";  # imprime "Le max est:  10"

La syntaxe d'appel de la fonction max devient très simple, le résultat recherché est atteint, mais expliquer l'utilisation des typeglobs (il s'agit d'utiliser le sigil « * » pour écrire directement des entrées dans la table des symboles du programme) ferait appel à des notions avancées de Perl qui sortiraient du cadre de ce tutoriel. Le but pour nous est de chercher à étendre le langage, ce qui justifie ici d'utiliser la magie des typeglobs, il n'est vraiment pas conseillé de les utiliser pour de la programmation courante.

En tout état de cause, il devient possible d'écrire une bibliothèque de fonctions utilisant cette version de reduce et plus simple que celle que nous avions décrite plus haut :

*max reduce { $a > $b ? $a : $b };
*min reduce { $a > $b ? $b : $a };
*product reduce { $a * $b }; 
# etc.

Si la syntaxe d'appel des fonctions curryfiées nous a posé quelques problèmes de simplification, la curryfication d'une fonction existante est assez simple. La fonction reduce curryfiée est à peine plus complexe que la version de base de reduce. Il suffit d'ajouter une fonction intermédiaire qui se charge de passer les paramètres de façon satisfaisante. Ne serait-il pas possible de le faire de façon automatique ?

Considérons pour commencer le cas simple, étudié au début de ce chapitre, de la fonction add:

sub add {
     my ($c, $d) = @_;
     return $c + $d;
}

Nous pouvons écrire une fonction curry qui transforme automatiquement cette fonction en fonction curryfiée :

use strict;
use warnings;

sub curry (\&@) { 
     my $code = shift;
     my @args = @_;
     sub {
          unshift @_, @args;
          goto &$code;
     };
}

my $curried_add = curry(&add, 6);
print $curried_add->(5);  # imprime 11

sub add {
     my ($c, $d) = @_;
     return $c + $d;
}

S'agissant de curryfier la fonction add, le prototype de la fonction curry pourrait être simplement (\&$), au lieu de (\&@). Mais nous désirons que la fonction curry soit généraliste et puisse curryfier des fonctions ayant plus de paramètres.

Ici encore, nous utilisons un peu de magie (blanche). La ligne suivante :

          goto &$code;

est un peu particulière. Nous ne succombons pas ici au plaisir rebelle de transgresser les principes établis par Edsger Dijkstra dans son célèbre article « Go To Statement Considered Harmful » (6) (« L'instruction Go To considérée comme nuisible »), publiée dans les ACM en 1968. Perl possède cette forme de goto critiquée à juste titre par Dijkstra et beaucoup d'autres et permettant de brancher inconditionnellement le programme sur une autre instruction, mais non seulement je ne l'ai jamais utilisée personnellement en Perl, mais je ne l'ai presque jamais vue utilisée ailleurs (du moins en Perl). La forme de goto utilisée ici est très particulière et bien différente. Comme le dit la documentation officielle de Perl : « La forme goto &name est hautement magique et est suffisamment éloignée des formes ordinaires de goto pour exonérer ses utilisateurs de l'opprobre qui leur est habituellement réservé. Cet appel substitue la sous-routine nommée par un appel à la fonction fournie ».

Pour dire toute la vérité, nous écrivons à nouveau dans la table des symboles en sorte que, quand le programme appelle la fonction add, c'est en réalité la version curryfiée de cette fonction qui est appelée.

Il est possible d'utiliser la même fonction curry pour curryfier une fonction subtract:

sub subtract {
    my ($c, $d) = @_;
    return $c - $d;
}

my $curried_subtr = curry(&subtract, 6);
print $curried_subtr->(5); # imprime 1

Cela fonctionne, mais peut-être pas vraiment comme on pourrait le souhaiter. Le deuxième paramètre passé à la fonction curry est le nombre (le « diminuende ») dont on retranche la valeur (le « diminuateur ») passée à la fonction curried_subtr, alors que l'on pourrait souhaiter l'inverse : que la fonction curryfiée subtract_1, par exemple, retranche 1 de la valeur qui lui est passée en paramètre. Ce comportement est dû à la non-commutativité de la soustraction. On peut facilement contourner ce problème en redéfinissant l'ordre des paramètres passés à la fonction subtract :

sub subtract {
    my ($c, $d) = @_;
    return $d - $c;
}

my $subtract_1 = curry(&subtract, 1);
print $subtract_1->(4); # imprime 3

La fonction curry permet de curryfier automatiquement la fonction comb_sort étudiée au § 2.22Écrire une fonction sort originale ci-dessus :

my @v;
my $max = 500;
$v[$_] = int rand(20000) foreach (0..$max);

my $curried_comb_sort = curry (&comb_sort, sub {$a<=>$b});
$curried_comb_sort->(\@v);
print "@v";

Ce qui imprime bien une liste correctement triée :

$ perl curried_sort.pl
3 25 111 227 241 250 274 280 297 326 334 463 557 585 597 598 605 701 732 734 739 739 797 830 859 864 1063 1081 1108 1118 1145 1167 1170 1222 1243 1302 1321 1337 1346 1379 1424 1470 1492 1511 1517 1542 1543 1628 1649 1718 1719 1721 1721 1723 1727 1842 1892 1950 2000 2050 2079 2094 2124 2165 2194 2298 2311 ...

Il a cependant fallu faire une petite modification syntaxique pour que cela fonctionne correctement. La fonction comb_sort utilisait les prototypes pour permettre l'appel suivant :

comb_sort {$a<=>$b} @v;

Le paramètre @v était transformé en référence au tableau grâce au prototype de la fonction comb_sort. Dans la version curryfiée, comme la fonction intermédiaire curry n'impose pas la transformation en référence au tableau, nous avons dû passer une référence au tableau :

$curried_comb_sort->(\@v);

mais, d'un autre côté, nous avons gagné le fait de ne plus devoir passer le bloc de code assurant le tri numérique.

Ceci n'est qu'un exemple, mais, plus généralement, la curryfication automatique s'accommode parfois assez mal des fonctions prototypées parce que l'interposition d'une fonction anonyme entre la fonction de base et la version curryfiée bat en brèche le but des prototypes. D'un autre côté, on pourrait écrire des fonctions curry distinctes adaptées aux différents prototypes, mais on perdrait alors la généralité d'une fonction curry générique. Bref, il y a une forme d'opposition entre le caractère général recherché pour une fonction générique telle que curry, et le caractère très particulier et coercitif d'un prototype ; on peut trouver assez facilement des solutions, comme le simple passage d'une référence au tableau @v ci-dessus, mais il faut savoir que la cohabitation des deux notions entraîne parfois des contradictions ou difficultés et nécessite parfois un peu de réflexion. On n'est plus, dans ce cas particulier, dans du « tout automatique ».(7)

Cette (petite) limitation pourrait constituer une raison supplémentaire de limiter l'utilisation des prototypes aux fonctions pour lesquelles ils amènent une réelle simplification syntaxique. Cela dit, il faut relativiser, tout le monde n'a pas forcément besoin de la curryfication automatique, une curryfication manuelle ou semi-automatique « sur mesure » peut suffire dans bien des cas.

Il est assez fréquent de devoir utiliser membre à membre deux listes ou deux tableaux différents, par exemple pour les comparer ou les combiner. Il est assez courant d'appeler combine une fonction générique abstraite réalisant ce genre d'opération.

Contrairement à ce que nous avons fait précédemment, nous n'allons plus, cette fois, proposer une première approche naïve, constater qu'elle aboutit à une duplication de code ou à des erreurs syntaxiques et arriver progressivement à la solution générique permettant d'éviter cette duplication. Le lecteur est maintenant habitué à la méthode et aux techniques qu'elle emploie, nous pouvons nous lancer directement dans le grand bain et essayer de créer directement une fonction générique abstraite combine (ce qui n'empêche cependant pas d'améliorer le résultat progressivement).

5-1-1. La fonction combine▲

sub combine (&\@\@) {
    my ($code_ref, $l1_ref, $l2_ref) = @_;
    my @result;
    while (1) { 
        local ($a, $b);
        ($a, $b) = (shift @$l1_ref, shift @$l2_ref);
        return @result unless defined $a and defined $b;
        push @result, $code_ref->($a, $b);
    }
}

sub add2 (\@\@) {
    my ($l1, $l2) = @_;
    return combine {$a + $b} @$l1, @$l2;
} 

sub avg2(\@\@) {
    my ($l1, $l2) = @_;
    return combine {($a + $b) /2} @$l1, @$l2;
}

use strict;
use warnings;
use Combine qw/combine add2/;

my @list1 = qw /1 5 7 98 32/;
my @list2 = grep $_%2, 1..10; # nombres impairs entre 1 et 10

print join " ", add2(@list1, @list2), "\n";

$ perl add2.pl
2 8 12 105 41

$ perl avg2.pl
1 4 6 52.5 20.5

sub combine (&\@\@) {
    my ($code_ref, $l1_ref, $l2_ref) = @_;
    my @result;
    my $i = 0;
    while (1) { 
        local ($a, $b) = ($l1_ref->[$i], $l2_ref->[$i++]);
        return @result unless defined $a and defined $b;
        push @result, $code_ref->($a, $b);
    }
}

Nous voudrions cependant aller plus loin dans la simplification et trouver une syntaxe encore plus simple. La solution peut être de créer une fonction intermédiaire de création de fonctions. Celle-ci peut avoir la forme suivante :

sub generate_function2 {
    my $code_ref = shift;
    return sub { 
        my ($l1_ref, $l2_ref) = @_;
        return combine {&$code_ref} @$l1_ref, @$l2_ref;
    }
}

On peut également l'écrire un peu plus brièvement comme suit :

sub generate_function2(&) {
    my $code_ref = shift;
    return sub  { 
        return combine {&$code_ref} @{$_[0]}, @{$_[1]};
    }
}

Ou même :

sub generate_function2 {
    my $code_ref = shift;
    sub  { combine {&$code_ref} @{$_[0]}, @{$_[1]};
    }
}

Cela marche parfaitement :

my $add2 = generate_function2(sub {$a + $b});

my @list1 = qw /1 5 7 98 32/;
my @list2 = grep $_%2, 1..10;

print join " ", $add2->(\@list1, \@list2), "\n";

sub generate_function2 {
    my $code_ref = shift;
    sub  { combine {&$code_ref} @{$_[0]}, @{$_[1]};
    }
}

Ce qui imprime :

$ perl  generate.pl
2 8 12 105 41

5-2-1. Créer une bibliothèque de fonctions▲

my $add2       = generate_function2( sub { $a + $b } );
my $avg2       = generate_function2( sub { ( $a + $b ) / 2 } );
my $substr2    = generate_function2( sub { $a - $b } );
my $diff2      = generate_function2( sub { abs( $a - $b ) } );
my $mult2      = generate_function2( sub { $a * $b } );
my $equal_nr   = generate_function2( sub { $a if $a == $b } );
my $equal_str  = generate_function2( sub { $a if $a eq $b } );
my $each_array = generate_function2( sub { $a, $b } );

# ...

my @list1 = qw /1 32 5 7 98/;
my @list2 = grep $_%2, 1..10;

print join " ", $add2->(\@list1, \@list2), "\n";
print join " ", $avg2->(\@list1, \@list2), "\n";
print join " ", $substr2->(\@list1, \@list2), "\n";
print join " ", $diff2->(\@list1, \@list2), "\n";
print join " ", $mult2->(\@list1, \@list2), "\n";
print join " ", $equal_nr->(\@list1, \@list2), "\n";
print join " ", $equal_str->(\@list1, \@list2), "\n";
print join " ", $each_array->(\@list1, \@list2), "\n";

$ perl  generate.pl
2 35 10 14 107
1 17.5 5 7 53.5
0 29 0 0 89
0 29 0 0 89
1 96 25 49 882
1  5 7
1  5 7
1 1 32 3 5 5 7 7 98 9

5-2-2. Simplification syntaxique▲

my @list1 = qw /1 5 7 98 32/;
my @list2 = grep $_ % 2, 1 .. 10;
my @sum   = $add2->( @list1, @list2 );

sub add2 (\@\@) {
     my ($list1, $list2) = @_;
     return $add2->(\@list1, \@list2);
}

my @list1 = qw /1 32 5 7 98/;
my @list2 = grep $_%2, 1..10;

print join " ", add2(@list1, @list2), "\n";

$ perl  generate.pl
2 35 10 14 107

Voici une mise en œuvre possible de gather et take:

use strict;
use warnings;

{
    my @result;

    sub gather(&) {
        my $code_ref = shift;
        @result = ();
        $code_ref->();
        return @result;
    }

    sub take(@) {
        my @caller = caller 2;
        die "Appel à take pas à l'intérieur d'un bloc gather" unless $caller[3] =~ /gather/;
        push @result, @_;
        return scalar @result;
    }
}

Qu'avons-nous ? Nous avons d'abord un tableau lexical @result global aux deux fonctions gather et take (mais local au bloc de code englobant gather et take). La fonction gather reçoit en paramètre une coderef, initialise le tableau @result à vide, appelle la coderef reçue en paramètre qui se charge de remplir le tableau (en appelant pour ce faire la fonction take) et renvoie le tableau.

La fonction take reçoit en paramètre un tableau, vérifie qu'elle a bien été appelée dans le contexte d'un gather (8) (on pourrait s'en passer dans une version minimaliste, mais mieux vaut vérifier que l'utilisateur ne fait pas n'importe quoi), ajoute le tableau reçu en paramètre à @result, et renvoie accessoirement le nombre d'éléments du tableau @result. Pour notre explication du fonctionnement de gather et take, la fonction take pourrait se réduire à la définition minimaliste suivante :

sub take(@) {
   push @result, @_;
}

Soit, direz-vous, mais la fonction take n'est même pas appelée par gather. Quel est le lien entre les deux ? En fait, si, la fonction take est (éventuellement) appelée dans la coderef reçue en paramètre et exécutée par gather.

Par exemple, nous pouvons appeler ces deux fonctions avec la simple ligne de code suivante pour simuler la fonction map et renvoyer le double de chacun des nombres d'une liste en entrée :

print join " ", gather {take $_ * 2 for (1..10)};

Ce qui imprime bien :

$ perl gather_simple.pl
2 4 6 8 10 12 14 16 18 20

Nous pouvons de même simuler un grep et retourner par exemple les nombres impairs d'une liste en entrée:

print join " ", gather {$_ % 2 and take $_ for (1..10)};
# imprime 1 3 5 7 9

On le voit, notre paire de fonctions gather et take simule facilement aussi bien map que grep.

Nous pouvons même combiner les fonctionnalités de map et de grep, filtrer et transformer la liste en entrée. Si par exemple nous désirons obtenir le cube des nombres impairs de la liste en entrée :

print join " ", gather {$_ % 2  and take $_ ** 3 for  (1..10)};
# imprime 1 27 125 343 729

Nous pouvons maintenant utiliser gather et take pour construire des fonctions plus complexes.

À titre d'exemple, considérons cette nouvelle implémentation de my_map utilisant gather et take :

sub my_map (&@) {
   my $coderef = shift;
   my @list = @_;
   return gather {
      take $coderef->($_) for @list;
   };
}

print join " ", my_map {$_ * 2} 1..10;
print "\n";

Ce qui imprime bien le résultat attendu :

$ perl gather_map.pl
2 4 6 8 10 12 14 16 18 20

Comme dans la version précédente, la fonction my_map reçoit en paramètres une coderef et un tableau. Mais elle appelle cette fois la fonction gather et lui passe en argument une coderef appelant la fonction take sur la valeur de retour de la coderef reçue en paramètre appliquée à chaque élément du tableau. Reconnaissons-le franchement : nous n'avons pas vraiment simplifié les choses par rapport à notre précédente version de my_map, mais nous avons créé un nouvel outil plus flexible et plus riche fonctionnellement.

Nous pouvons de même proposer une nouvelle version de my_grep utilisant gather et take :

sub my_grep (&@) {
   my $coderef = shift;
   my @list = @_;
   return gather {
      $coderef->($_) and take $_ for @list;
   };
}

print join " ", my_grep {$_ % 2} 1..20;

Ce qui imprime le résultat attendu :

$ perl gather_grep.pl
1 3 5 7 9 11 13 15 17 19

On souhaiterait parfois combiner les comportements de map et de grep, c'est-à-dire à la fois filtrer et transformer les données en une seule opération, comme nous l'avons fait avec le dernier exemple des utilisations simples de gather et take (§ 6.2Exemples d'utilisation simple). Voyons, à titre d'exercice de style, si nos fonctions génériques gather et take nous permettent de le faire en une seule opération. Essayons par exemple d'écrire un petit script qui affiche les carrés des nombres impairs d'une liste. Nous pouvons créer une fonction grep_and_map et faire ceci :

sub grep_and_map {
   my $coderef_grep = shift;
   my $coderef_map = shift;
   my @list = @_;
   return gather {
      $coderef_grep->($_) and take $coderef_map->($_) for @list;
   };
}

print join " ", grep_and_map ( sub {$_ % 2}, sub {$_ ** 2}, 0..20);
print "\n";
# affiche: 1 9 25 49 81 121 169 225 289 361

Cela fonctionne et nous pourrions de même écrire facilement une fonction map_and_grep qui commence par appliquer une transformation aux données en entrée puis filtre le résultat. Mais ceci n'est pas très utile, car nous sommes conduits à créer des fonctions trop spécialisées qui nous font perdre la généralité et l'expressivité que fournit l'abstraction des fonctions map et grep. Il est surtout tellement facile de remplacer notre fonction grep_and_map ci-dessus par un simple enchaînement des deux opérateurs dans un pipe-line comme nous l'avons fait dans la première partie de ce tutoriel :

print join " ", map {$_ ** 2} grep {$_ % 2} 0..20;
print "\n";
# affiche: 1 9 25 49 81 121 169 225 289 361

ou même par un simple map sans le grep :

print join " ", map {$_ % 2 ? $_ ** 2 : ()} 0..20;
print "\n";
# affiche: 1 9 25 49 81 121 169 225 289 361

que nos fonctions grep_and_map et map_and_grep ne seront donc guère utiles. Nous n'irons pas plus loin dans cette voie. Comme nous l'avons dit, il s'agissait uniquement d'un exercice de style destiné à montrer comment les fonctions gather et take permettent de créer un nouveau comportement sur une liste et l'on voit que ça marche, le seul problème est juste que créer ce genre de fonctions n'amène pas grand-chose, nous étions dans une fausse voie.

Si nous pouvons créer facilement les fonctions map et grep grâce à gather/take, nous devrions pouvoir créer d'autres fonctions de listes utiles, telles que certaines de celles que nous avons vues précédemment. La seule limite est notre imagination : tant que nous n'avons pas pris un peu l'habitude de les utiliser, tant que nous ne nous les sommes pas vraiment appropriées, nous ne sommes pas trop sûrs de ce que l'on pourrait en faire. Si, comme nous l'espérons, Perl 6 voit le jour prochainement, nous ne doutons pas que, d'ici quelques années, les développeurs Perl 6 auront certainement trouvé des tas d'usages utiles à ces fonctions, mais nous sommes aujourd'hui un peu dans la situation d'une poule ayant trouvé une paire de ciseaux et se demandant à quoi cela peut servir. Peu importe de ne pas avoir un usage immédiat, après tout, on peut aussi très bien mettre cet instrument dans sa boîte à outils et se dire qu'il ne tardera sans doute pas à servir si l'on sait rester vigilant et y penser au bon moment.

Le point important est que la fonction map prend une liste en entrée et applique des transformations à cette liste pour générer une autre liste. La fonction grep prend une liste en entrée et filtre les éléments de cette liste. Avec gather et take, nous pouvons maintenant faire des choses plus variées ou plus complexes sur notre liste en entrée. Les fonctions map et grep ne sont que des cas particuliers limités de gather et take.