Méthodes Anonymes Delphi - John COLIBRI.

• résumé : présentation, capture de variables et clôture, Invoke, implémentation et analyse mémoire, exemple profiling, énumérateur filtré, traitement de pages téléchargées.
  
• mots clé : reference to, méthodes anonymes, Invoke, iEnumerator, iEnumerable, tThread, Synchronize
  
• logiciel utilisé : Windows XP personnel, Delphi Xe3
  
• matériel utilisé : Pentium 2.800 Mhz, 512 Meg de mémoire, 250 Giga disque dur
  
• champ d'application : Delphi 2009, Delphi 2010, Delphi Xe, Delphi Xe2, Delphi Xe3
  
• niveau : développeur Delphi
  
• plan :
  
  • Delphi Anonymous Methods
    
  • Premier exemple de Méthode Anonyme
    
  • Capture de variable - Clôture
    
  • Implémentation des méthodes anonymes
    
  • Exemples d'utilisation de méthodes anonymes
    
  • Télécharger le code source Delphi
    

1 - Delphi Anonymous Methods

Les traitements effectués par les méthodes anonymes peut fort bien être codé par les techniques traditionnelles. Néanmoins

• elles permettent un style de programmation qui s'approche un peu plus du style fonctionnel
  
• elles facilitent certains codes, allant du plus connu, tThread.Synchronize, aux exemples plus complexes comme les énumérateurs ou les delegates
  

2 - Premier exemple de Méthode Anonyme Delphi

2.1 - Appel de procédure normal

Une version plus encapsulée pourrait utiliser une procédure locale:

2.2 - Utilisation d'une méthode anonyme

Nous pouvons alors

• définir une variable du type procédure anonyme
  
• initialiser cette variable en fournissant les instructions qui composent cette méthode
  
• appeler cette méthode
  

A ce stade, nous avons remplacé deux procédures par un type et une seule procédure.

Une des difficultés est de trouver des exemples simples qui donneraient envie d'utiliser ces procédure anonymes. A la fin de cet article, nous tenterons d'en présenter quelques uns.

En attendant, voici quelques variations sur le même thème de l'opération binaire:

• nous définissons une Function anonyme, et effectuons des opérations différentes avec ce type:

  Type t_af_binary_operation= Reference To Function(p_one, p_two: Integer): Integer; Procedure TForm1.several_operations_Click(Sender: TObject);   Var l_one, l_two: Integer;       l_af_binary_operation: t_af_binary_operation;       l_result: Integer;   Begin     l_one:= 11; l_two:= 22;     l_af_binary_operation:= Function(p_one, p_two: Integer): Integer       Begin         Result:= p_one+ p_two;       End;     l_result:= l_af_binary_operation(l_one, l_two);     display(Format('%d + %d = %d ', [l_one, l_two, l_result]));     l_af_binary_operation:= Function(p_one, p_two: Integer): Integer       Begin         Result:= p_one* p_two;       End;     display(Format('%d * %d = %d ',         [l_one, l_two, l_af_binary_operation(l_one, l_two)]));   End; // several_operations_Click

• ou encore, nous avons une procédure qui se charge d'afficher le résultat d'une opération binaire, et nous appelons cette procédure en fournissant différents types d'opérations:

  Type t_af_binary_operation= Reference To Function(p_one, p_two: Integer): Integer; Procedure display_binary_operation(p_one, p_two: Integer;     p_operator: Char;     p_af_binary_operation: t_af_binary_operation);   Begin     display(Format('%d %s %d = %d ',         [p_one, p_operator, p_two, p_af_binary_operation(p_one, p_two)]));   End; // display_binary_operation Procedure TForm1.several_calls_Click(Sender: TObject);   Begin     display_binary_operation(11, 22, '+',         Function(p_one, p_two: Integer): Integer           Begin             Result:= p_one+ p_two;           End);     display_binary_operation(11, 22, '*',         Function(p_one, p_two: Integer): Integer           Begin             Result:= p_one* p_two;           End)   End; // several_calls_Click

  
  

2.3 - Types de sous-programmes Delphi

2.3.1 - Type Procédural

L'idée de WIRTH était de pouvoir créer une procédure effectuant un traitement complexe, comme une intégration symbolique, en laissait l'utilisateur définir la fonction à intégrer (et sans doute les bornes, dans cet exemple):

Dans cet exemple

• nous supposons nos fonctions définies par la RTL, ou nous aurions pu créer une fonction nous-mêmes
  
• la routine qui se charge de l'intégration reçoit comme paramètre la fonction à intégrer
  
• le programme appelant l'intégration fournit la fonction à utiliser comme paramètre
  

2.3.2 - Procedure Of Object - Evenements

Voici un exemple simple:

• nous définissons une Classe et un type Function Of Object:

  Type c_person=          Class            m_first_name: String;            m_age: integer;            Constructor create_person(                p_first_name: String; p_age: Integer);          End; // c_person      t_po_display_person= Procedure(p_c_person: c_person) Of Object;

• nous DEVONS mettre la véritable fonction dans "un" objet. Par exemple la Forme

  Type TForm1 =          Class(TForm)            // ooo            Private              Function display_person(p_c_person: c_person): String;          End; Procedure TForm1.display_person(p_c_person: c_person);   Begin     display(Format('person=%s, Self.Classname= %s',         [p_c_person.m_first_name, Self.ClassName]));   End; // display_person

• et nous pouvons déclarer des variables de type Procedure of Object, leur affecter l'adresse de n'importe quelle procédure d'un objet ayant la même signature (ici une c_person) et l'appeler en fournissant un objet c_person:

  Procedure TForm1.procedure_of_object_Click(Sender: TObject);   Var l_c_person: c_person;       l_po_display_person: t_po_display_person;   Begin     l_c_person:= c_person.create_person('joe', 33);     l_po_display_person:= display_person;     l_po_display_person(l_c_person);     l_c_person.Free;   End; // procedure_of_object_Click

  
  

• tous les événements Delphi sont des Procedure Of Object. Le plus connu est tNotifyEvent, utilisé pour OnClick, entre autres:

  // System.Classes TNotifyEvent = Procedure(Sender: TObject) Of Object; // Vcl.Controls TControl=     Class(tComponent)        FOnClick: TNotifyEvent;        // ooo        Property OnClick: TNotifyEvent read FOnClick write FOnClick // ooo     End; // tControl

  
  

2.3.3 - Les Méthodes Anonymes

3 - Capture de variable - Clôture

3.1 - Anonymous Method Closure - Exemple

Ce concept va à l'encontre de tout ce que nous connaissions des variables locales. Toutefois, ce n'est pas l'élément principal des anonymes, et si vous êtes mal à l'aise avec cette mécanique, n'utilisez pas la cloture, et vous pourrez tout de même tirer les trois quart des bénéfices des anonymes.

Voici tout d'abord un exemple simple, sans clôture, où nous créons sur un clic une variable pointant vers une méthode anonyme, et nous utilisons cette variable sur un autre clic:

A présent, voici un exemple où la définition de la méthode anonyme utilise une variable locale:

• nous définissons la méthode anonyme suivante :

  Type t_ap_integer = Reference To Procedure(p_integer: Integer);

• nous ajoutons une procédure qui appelle cette méthode anonyme:

  Procedure call_anon(p_ap_integer: t_ap_integer; p_integer: Integer);   Begin     p_ap_integer(p_integer);   End; // call_anon

• dans un clic nou appelons cette méthode en définissant la méthode anonyme:

  Procedure TForm1.capture_of_local_Click(Sender: TObject);   Var l_total: Integer;   Begin     l_total:= 100;     display(Format('initial_l_total  %4d', [l_total]));     call_anon(         Procedure(p_increment: Integer)           Begin             // -- will CHANGE the local             Inc(l_total, p_increment);             display(Format('captured_l_total %4d anon_param_p_increment %4d',                 [l_total, p_increment]));           End,         33);     display('local_after_call  '+ IntToStr(l_total));   End; // capture_of_local_Click

  
  

Rien de surprenant, chaque clic:

• réinitialise la locale à 100
  
• appelle la procédure anonyme qui modifie cette variable (133)
  

Voici à présent la capture de la locale, avec cumul à chaque appel

• nous déclarons une variable globale correspondant à notre type anonyme, et l'initialisons dans un premier clic (ce qui "capture" la locale:

  Var g_ap_call_and_increment_by: t_ap_integer= Nil; Procedure TForm1.initialize_anon_var_Click(Sender: TObject);   Var l_total: Integer;   Begin     l_total:= 100;     display(Format('initial_l_total  %4d', [l_total]));     g_ap_call_and_increment_by:=         Procedure(p_increment: Integer)           Begin             Inc(l_total, p_increment);             display(Format('captured_l_total %4d anon_param_p_increment %4d',                 [l_total, p_increment]));           End   End; // initialize_anon_var_Click

• nous appelons plusieurs fois cette méthode anonyme:

  Procedure TForm1.call_anon_with_capture_Click(Sender: TObject);   Begin     call_anon(g_ap_call_and_increment_by, 2);   End; // call_anon_with_capture_Click

• et voici le résultat de 3 appels :

  

  La LOCALE a bien été modifiée à chaque clic (100, 102, 104 ...)
  

• les instructions à exécuter (l'incrémentation et l'affichage)
  
• les variables locales inclues dans la définition (ici l_total)
  

4 - Implémentation des méthodes anonymes

4.1 - Objet Sous-Jacent

• le compilateur définit une Interface spéciale pour chaque définition de référence de méthode. Cette Interface a une seule méthode, qui est notre méthode anonyme
  
• lors de la création ou l'invocation, notre projet créé un objet
  
  • qui implémente cette Interface
    
  • qui capture l'environnement au moment de l'invocation
    

• ces Interfaces utilisent le comptage de référence COM, et l'objet est donc libéré automatiquement
  

Notons au passage que "méthodes" anonyme vient du fait que les anonymes sont en fait les méthodes d'une Classe implicite.

4.2 - Capture de l'adresse

Voici la définition d'une anonyme globale qui capture une local:

Puis nous appelons la méthode anonyme:

et voici le résultat :

Comme l'objet anonyme a été crée, il stocke dans son champ les valeurs successives de la variable capturée. Donc, même si, au moment de la capture, la locale a la valeur 33, l'affectation (au champ de l'objet anonyme) de 77 conserve cette valeur, qui est ensuite affichée.

Formulé autrement, les anonymes capturent l'adresse des variables de l'environnement, et ne capturent PAS les VALEURS des variables capturées

4.3 - Dump Anonymous

Nous nous appuyons ici sur les articles de Barry KELLY et Cosmin PRUND.

Nous avons placé dans une unité les méthodes de dump:

Et voici quelques exemples:

et voici le résultat:

Nous pouvons bien afficher les objets et les interfaces liés aux anonymes. L'interprétation des objets réellement créés reste à faire.

4.4 - Limitations

• une méthode anonyme ne peut PAS capturer l'indice d'une boucle For
  
• une méthode anonyme ne peut PAS capturer le Result d'une fonction englobante (le Result d'une Function anonyme, mais pas le Result d'une Function qui est en train de définir une anonyme
  
• nous avons aussi rencontré des interdiction au niveau de l'emboîtement de procédures utilisant des anonymes (cf ci-dessous le filtrage d'une tList<T>)
  

4.5 - () et Invoke

• de la définir avec des parenthèses vides ()
  
• de l'appeler avec des parenthèses vides ()
  

Lorsque nous utilisons une Function qui génère une méthode anonyme (Result est une méthode anonyme), il peut y avoir des ambiguités entre les parenthèses de l'appel de la fonction de génération et les parenthèses des paramètres de la procédure anonyme.

C'est un problème un peu similaire au déréférencement des pointeurs. Jadis, en PASCAL, nous avions l_pt_integer et l_pt_integer^ pour distinguer le pointeur et la valeur pointée. Comme Delphi utilise un modèle par référence, il a fallu utiliser le mot Assigned pour tester si un événement est NIL, car le test mon_événementNIL est impossible.

Pour soulager les problèmes, Delphi permet l'utilisation de Invoke pour provoquer l'appel d'une méthode anonyme et le distinguer de l'appel d'une fonction qui génère une anonyme.

Voici quelques exemples qui illustrent ces problèmes

• nos anonymes sont définies par:

  Type t_ap= Reference To Procedure;      t_ap_integer= Reference To Procedure(p_n: Integer);

• tout d'abord générateur sans paramètre, anonyme sans paramètre

  Function f_ap: t_ap;   Var l_integer: Integer;   Begin     l_integer:= 100;     Result:=         Procedure           Begin             l_integer:= l_integer;             display(IntToStr (l_integer));           End;   End; // f_ap Procedure TForm1.ap_Click(Sender: TObject);   Var l_ap: t_ap;   Begin     display('');     display('l_ap  NO'); (*     l_ap:= f_ap;     l_ap; *)     display('l_ap');     l_ap:= f_ap();     l_ap;     display('f_ap()');     f_ap();     display('f_ap()()');     f_ap()();     display('f_ap().Invoke');     f_ap().Invoke;     display('f_ap.Invoke');     f_ap.Invoke;   End; // ap_Click

• générateur avec paramètre, anonyme sans paramètre

  Function f_n_ap(p_total: Integer): t_ap;   Begin     Result:=         Procedure           Begin             p_total:= p_total+ 3;             display(IntToStr(p_total));           End;   End; // f_n_ap Procedure TForm1.n_ap_Click(Sender: TObject);   Var l_ap: t_ap;   Begin     display('');     display('l_ap  NO'); (*     l_ap:= f_n_ap;     l_ap; *)     display('l_ap(20)');     l_ap:= f_n_ap(20);     l_ap;     display('f_n_ap(20)');     f_n_ap(20);     display('f_n_ap(20)()');     f_n_ap(20)();     display('f_n_ap(20).Invoke');     f_n_ap(20).Invoke;     display('f_n_ap.Invoke NO'); (*     f_n_ap.Invoke; *)   End; // n_ap_Click

• générateur sans paramètre, anonyme avec paramètre

  Function f_ap_integer: t_ap_integer;   Var l_integer: Integer;   Begin     l_integer:= 100;     Result:=         Procedure (p_n: Integer)           Begin             l_integer:= l_integer + p_n;             display(IntToStr (l_integer));           End;   End; // f_ap_integer Procedure TForm1.ap_integer_Click(Sender: TObject);   Var l_ap_integer: t_ap_integer;   Begin     display('l_ap_integer(3)');     l_ap_integer:= f_ap_integer();     l_ap_integer(3);     display('f_ap_integer()');     f_ap_integer();     display('f_ap_integer()(3)');     f_ap_integer()(3);     display('f_ap_integer().Invoke(3)');     f_ap_integer().Invoke(3);     display('f_ap_integer.Invoke(3)');     f_ap_integer.Invoke(3);   End; // ap_integer_Click

• finalement générateur avec paramètre, anonyme avec paramètre

  Function f_n_ap_integer(p_total: Integer): t_ap_integer;   Begin     Result:=         Procedure (p_n: Integer)           Begin             p_total:= p_total + p_n;             display(IntToStr(p_total));           End;   End; // f_ap_integer Procedure TForm1.n_ap_integer_Click(Sender: TObject);   Var l_ap_integer: t_ap_integer;   Begin     display('l_ap_integer(3)');     l_ap_integer:= f_n_ap_integer(20);     l_ap_integer(3);     display('f_n_ap_integer(20)');     f_n_ap_integer(20);     display('f_n_ap_integer(20)(3)');     f_n_ap_integer(20)(3);     display('f_n_ap_integer(20).Invoke(3)');     f_n_ap_integer(20).Invoke(3);     display('f_n_ap_integer.Invoke(3) NO'); (*     f_n_ap_integer.Invoke(3); *)   End; // n_ap_integer_Click

  
  

4.6 - Erreurs de syntaxe

Voici un exemple avec un paramètre Const :

4.7 - Méthodes Anonymes pré-définies

Soulignons que pour les fonctions paramétrées, Result est, par convention, le dernier paramètre

5 - Exemples d'utilisation de méthodes anonymes

5.1 - Profiling

Habituellement, pour mesurer le temps d'exécution d'une procédure,

• nous sauvegardons l'heure (les ticks) initiale
  
• nous exécutons la procédure plusieurs fois
  
• nous mesurons l'heure finale, et calculons le temps moyen par exécution
  

Pour plus de précision, il faut effectuer plusieurs itérations, en éliminant autant que possible les temps de création, allocation etc.

Si la mise en oeuvre des mesure est plus lourde, il peut être intéressant d'inverser la mécanique:

• nous construisons une classe qui se charge des paramètres et calibrages
  
• nous fournissons à cette classe la procédure à mesurer, sous forme de méthode anonyme
  

Voici donc

• notre Classe de profiling:

  Type c_procedure_timer=          Class            m_initial_iterations: Integer;            m_iterations: Integer;            m_base_frequency: Int64;            Constructor Create;            Procedure read_hires_frequency;            Function f_measure_time_of(                p_pa_to_profile: TProc;                p_initial_iterations, p_iterations: Integer): Double;            Procedure measure_time(                Const p_title: string;                Const p_pa_to_profile: TProc); Overload;          End; // c_procedure_timer Constructor c_procedure_timer.Create;   Begin     read_hires_frequency;     m_initial_iterations:= k_default_overhead;     m_iterations:= k_default_iterations;     // -- try to eliminate initial setup time     f_measure_time_of(         Procedure           Begin           End,         100, 3);   End; // Create Procedure c_procedure_timer.read_hires_frequency;   Begin     QueryPerformanceFrequency(m_base_frequency)   End; // read_hires_frequency Function c_procedure_timer.f_measure_time_of(     p_pa_to_profile: TProc;     p_initial_iterations, p_iterations: Integer): Double;   Var l_start_ticks, l_stop_ticks: Int64;       l_iteration: Integer;   Begin     // -- try to eliminate initial setup time     For l_iteration:= 1 To p_initial_iterations Do       p_pa_to_profile;     QueryPerformanceCounter(l_start_ticks);     For l_iteration:= 1 To p_iterations Do       p_pa_to_profile;     QueryPerformanceCounter(l_stop_ticks);     Result:= (l_stop_ticks- l_start_ticks)/ m_base_frequency/ p_iterations* 1000;   End; // f_measure_time_of

• nous souhaitons tester la performance de divers types d'appels : virtuels, récursif, utilisant des objets ou des pointeurs d'Interface :

  Type i_my_interface=          Interface            Procedure const_interface_call(Const p_i_my_interface: i_my_interface; p_count: Integer);            Procedure interface_call(p_i_my_interface: i_my_interface; p_count: Integer);          End; // i_my_interface      c_my_class=          Class(TInterfacedObject, i_my_interface)            Procedure const_non_virtual_call(Const p_c_my_class: c_my_class; p_count: Integer);            Procedure non_virtual_call(p_c_my_class: c_my_class; p_count: Integer);            Procedure virtual_call(p_c_my_class: c_my_class; p_count: Integer); Virtual;            Procedure const_interface_call(Const p_i_my_interface: i_my_interface; p_count: Integer);            Procedure interface_call(p_i_my_interface: i_my_interface; p_count: Integer);          End; // c_my_class Procedure recursive_call(p_count: Integer); Type t_ap= Reference To Procedure(p_ap: t_ap; p_count: Integer); Type t_ap_const= Reference To Procedure(Const pk_ap: t_ap_const; p_count: Integer); Procedure recursive_call(p_count: Integer);   Begin     If p_count> 0       Then recursive_call(p_count- 1);   End; // recursive_call Procedure c_my_class.interface_call(p_i_my_interface: i_my_interface; p_count: Integer);   Begin     If p_count> 0       Then p_i_my_interface.interface_call(p_i_my_interface, p_count- 1);   End; // interface_call Procedure c_my_class.const_interface_call(Const p_i_my_interface: i_my_interface; p_count: Integer);   Begin     If p_count> 0       Then p_i_my_interface.const_interface_call(p_i_my_interface, p_count- 1);   End; // const_interface_call Procedure c_my_class.non_virtual_call(p_c_my_class: c_my_class; p_count: Integer);   Begin     If p_count> 0       Then non_virtual_call(p_c_my_class, p_count- 1);   End; // non_virtual_call Procedure c_my_class.const_non_virtual_call(Const p_c_my_class: c_my_class; p_count: Integer);   Begin     If p_count> 0       Then const_non_virtual_call(p_c_my_class, p_count- 1);   End; // const_non_virtual_call Procedure c_my_class.virtual_call(p_c_my_class: c_my_class; p_count: Integer);   Begin     If p_count> 0       Then virtual_call(p_c_my_class, p_count- 1);   End; // virtual_call

• voici l'utilisation de notre timer:

  Procedure TForm1.compare_calls_Click(Sender: TObject);   Const k_recursive_count= 10000;   Var l_c_procedure_timer: c_procedure_timer;       l_c_my_object: c_my_class;       l_i_my_interface: i_my_interface;   Begin     display('');     l_c_procedure_timer:= c_procedure_timer.Create;     Try       l_c_procedure_timer.m_initial_iterations:= 100;       l_c_procedure_timer.m_iterations:= 100;       l_c_my_object:= c_my_class.Create;       l_i_my_interface:= l_c_my_object;       display('');       l_c_procedure_timer.measure_time('procedure(n)',           Procedure             Begin               recursive_call(k_recursive_count);             End           );       display('');       l_c_procedure_timer.measure_time('l_c.method(p_c, n)',           Procedure             Begin               l_c_my_object.non_virtual_call(l_c_my_object, k_recursive_count);             End           );       l_c_procedure_timer.measure_time('l_c.method(const p_c, n)',           Procedure             Begin               l_c_my_object.const_non_virtual_call(l_c_my_object, k_recursive_count);             End           );       display('');       l_c_procedure_timer.measure_time('l_c.method(p_c, n) Virt',           Procedure             Begin               l_c_my_object.virtual_call(l_c_my_object, k_recursive_count);             End           );       display('');       l_c_procedure_timer.measure_time('l_i.method(p_i, n)',           Procedure             Begin               l_i_my_interface.interface_call(l_i_my_interface, k_recursive_count);             End           );       l_c_procedure_timer.measure_time('l_i.method(const p_i, n)',           Procedure             Begin               l_i_my_interface.const_interface_call(l_i_my_interface, k_recursive_count);             End           );     Finally       l_c_procedure_timer.Free;     End;   End; // compare_calls_Click

• et voici le résultat de l'exécution :

  
  

• voici le test

  Procedure TForm1.measure_anonymous_Click(Sender: TObject);   Const k_recursive_count= 10000;   Var l_c_procedure_timer: c_procedure_timer;       l_ap: t_ap;       l_ap_const: t_ap_const;   Begin     l_c_procedure_timer:= c_procedure_timer.Create;     Try       l_c_procedure_timer.m_initial_iterations:= 100;       l_c_procedure_timer.m_iterations:= 100;       l_ap:=           Procedure (p_ap: t_ap; p_count: Integer)             Begin               If p_count> 0                 Then p_ap(p_ap, p_count- 1);             End;       l_ap_const:=           Procedure (Const pk_ap: t_ap_const; p_count: Integer)             Begin               If p_count> 0                 Then pk_ap(pk_ap, p_count- 1);             End;       display('');       l_c_procedure_timer.measure_time('anon(p_anon, n)',           Procedure             Begin               l_ap(l_ap, k_recursive_count);             End           );       l_c_procedure_timer.measure_time('anon(const p_anon, n)',           Procedure             Begin               l_ap_const(l_ap_const, k_recursive_count);             End           );     Finally       l_c_procedure_timer.Free;     End;   End; // measure_anonymous_Click

• et son résultat :

  
  

• tout d'abord méfiez vous des essais de profiling et de benchmarking. Vous savez quand vous commencez, vous ne savez pas quand vous terminerez. Vous aurez toujours un doûte sur la technique utilisée, sur ce qu'il faudrait aussi analyser, ou mesurer autrement.
  
• dans notre exemple, il convient de bien comprendre ce que nous mesurons: les appels

  Procedure TForm1.measure_anonymous_Click(Sender: TObject);   Const k_recursive_count= 10000;   Var l_c_procedure_timer: c_procedure_timer;       l_ap: t_ap;       l_ap_const: t_ap_const;   Begin     l_c_procedure_timer:= c_procedure_timer.Create;     Try       l_c_procedure_timer.m_initial_iterations:= 100;       l_c_procedure_timer.m_iterations:= 100;       l_ap:=           Procedure (p_ap: t_ap; p_count: Integer)             Begin               If p_count> 0                 Then p_ap(p_ap, p_count- 1);             End;       l_ap_const:=           Procedure (Const pk_ap: t_ap_const; p_count: Integer)             Begin               If p_count> 0                 Then pk_ap(pk_ap, p_count- 1);             End;       display('');       l_c_procedure_timer.measure_time('anon(p_anon, n)',           Procedure             Begin               l_ap(l_ap, k_recursive_count);             End           );       l_c_procedure_timer.measure_time('anon(const p_anon, n)',           Procedure             Begin               l_ap_const(l_ap_const, k_recursive_count);             End           );     Finally       l_c_procedure_timer.Free;     End;   End; // measure_anonymous_Click

  ont pour but de tester des appels de méthode d'une Classe passée en paramètre. Cette méthode:

  • pousse le paramètre sur la pile
    
  • appelle une méthode de cet objet sur la pile
    
    
• concernant le résultat de ces mesures, le plus surprenant a été la différence entre les appels avec Const et sans Const
  
• quant à la technique, elle illustre effectivement que nous pouvons mesurer des fragments de code sans avoir à mettre en place à chaque fois les initialisations etc
  
• l'exemple complet de Barry KELLY, dont cet exemple s'inspire, démontre aussi comment utiliser la procédure d'affichage du résultat sous forme d'une procédure anonyme
  

5.2 - Enumerators et Anonymes

5.2.1 - Enumérateur classique

• mon_c_xxx.GetEnumerator fournit un objet énumérateur permettant d'accéder à tous les éléments de mon_c_xxx
  
• mon_c_enumerateur.MoveNext qui est True si la liste contient encore des éléments
  
• mon_c_enumerateur.Current retourne l'élément courant
  

et son utilisation:

5.2.2 - Utilisation d'une Interface

• pour l'énumérateur
  
• pour la fonction GetEnumerator qui fournit l'enumerator
  

• de créer une Classe qui implémente un énumérateur de notre structure de personnes
  
• d'implémenter iEnumerable pour notre liste de personnes.
  

Donc

• voici nos Interfaces

  Type i_enumerator<T> =          Interface            Function GetCurrent: T;            Function MoveNext: Boolean;            Procedure Reset;            Property Current: T read GetCurrent;          End; // i_enumerator<T>      i_enumerable<T> =          Interface            Function GetEnumerator: i_enumerator<T>;          End; // i_enumerable<T>

• notre liste de personne et leur énumérateur

  Type c_person_list_2=          Class(tInterfacedObject, i_enumerable<c_person>)            m_person_array: Array Of c_person;            m_person_count: integer;            Constructor create_person_list_2;            Procedure add_person(p_c_person: c_person);            // -- i_enumerable            Function GetEnumerator: i_enumerator<c_person>;            Destructor Destroy; Override;          End; // c_person_list_2      c_person_enumerator_2=          Class(tInterfacedObject, i_enumerator<c_person>)            m_c_person_list_ref: c_person_list_2;            m_current_index: integer;            Constructor create_person_enumerator_2(p_c_person_list_ref: c_person_list_2);            // -- i_enumerator            Function GetCurrent: c_person;            Function MoveNext: Boolean;            Procedure Reset;            Property Current: c_person read GetCurrent;          End; // c_person_enumerator_2 Constructor c_person_enumerator_2.create_person_enumerator_2(p_c_person_list_ref: c_person_list_2);   Begin     m_c_person_list_ref:= p_c_person_list_ref;     m_current_index:= -1;   End; // create_person_enumerator_2 Function c_person_enumerator_2.GetCurrent: c_person;   Begin     If m_current_index< m_c_person_list_ref.m_person_count       Then Result:= m_c_person_list_ref.m_person_array[m_current_index]       Else Raise Exception.Create('reached_end');   End; // GetCurrent Function c_person_enumerator_2.MoveNext: Boolean;   Begin     Inc(m_current_index);     Result:= m_current_index< m_c_person_list_ref.m_person_count;   End; // MoveNext Procedure c_person_enumerator_2.Reset;   Begin     m_current_index:= -1;   End; // Reset Constructor c_person_list_2.create_person_list_2;   Begin     SetLength(m_person_array, 16);   End; // create_person_list_2 Function c_person_list_2.GetEnumerator: i_enumerator<c_person>;   Begin     Result:= c_person_enumerator_2.create_person_enumerator_2(Self);   End; // GetEnumerator Procedure c_person_list_2.add_person(p_c_person: c_person);   Begin     If m_person_count= Length(m_person_array)       Then SetLength(m_person_array, 2* m_person_count);     m_person_array[m_person_count]:= p_c_person;     Inc(m_person_count);   End; // add_person Destructor c_person_list_2.Destroy;   Var l_person_index: Integer;   Begin     For l_person_index:= 0 To m_person_count- 1 Do       m_person_array[l_person_index].Free;     m_person_array:= Nil;     Inherited;   End; // Destroy

• et notre utilisation:

  Procedure TForm1.person_list_i_enumerator_Click(Sender: TObject);   Var l_i_enumerator: i_enumerator<c_person>;       l_c_current_person: c_person;   Begin     With c_person_list_2.create_person_list_2 Do     Begin       add_person(c_person.create_person('smith', 33));       add_person(c_person.create_person('joyce', 44));       add_person(c_person.create_person('allen', 55));       l_i_enumerator:= GetEnumerator;       While l_i_enumerator.MoveNext Do         With l_i_enumerator.Current As c_person Do           display(f_display_person);       Free;     End; // with c_person_list   End; // person_list_i_enumerator_Click

  
  

• le programme .ZIP contient aussi une version non générique qui utilise iEnumerator et iEnumerable
  
• ces Interfaces sont définies dans SYSTEM.PAS, et ont même des descendants génériques :

  mais nous ne sommes jamais arrivés à utiliser ces énumérateurs génériques. D'aucuns mettent en cause le fait que iEnumerator.GetCurrent soit un tObject et iEnumerator<T> soit un T.

• mentionnons aussi qu'avec notre c_person_list(iEnumerator), nous avons pu écrire

  Var l_i_enumerator: iEnumerator;     l_c_current_person: c_person;   With c_person_list.create_person_list Do     // ooo     While l_i_enumerator.MoveNext Do       With l_i_enumerator.Current As c_person Do         display(f_display_person);

  alors que l'Interface ne contient aucun GUID, qui est normalement nécessaire pour As

• par conséquent, nous avons donc préféré utiliser nos propres Interfaces
  

5.2.3 - Liste Filtrée

C'est là qu'interviennent les méthodes anonymes: il suffit de passer à la liste le filtre sous forme d'une fonction anonyme.

Au lieu de reprendre notre liste de personnes, nous allons définir une liste générique ayant cette possibilité de filtrage.

Les tList<T> sont déjà dotées d'énumérateurs. Toutefois

• l'énumérateur en question est défini dans GENERICS.COLLECTIONS et cette Classe n'a rien à voir avec les Interfaces de SYSTEM.PAS
  
• Delphi a prévu que nous puissions changer d'énumérateur en surtypant DoGetCurrent et DoMoveNext.
  

Au niveau du code

• notre énumérateur avec son filtre :

  Type t_af_filter<T> = Reference To Function (p_T: T): boolean;      c_filtered_enumerator<T>=             Class( TEnumerator<T> )               Private                 m_c_base_list: TList<T> ;                 m_af_filter: t_af_filter< T>;                 m_current_index: Integer;                 Function GetCurrent: T;                 Function f_accept_T: Boolean;               Protected                 Function DoGetCurrent: T; Override;                 Function DoMoveNext: Boolean; Override;               Public                 Constructor create_filtered_enumerator(p_c_base_list: tList< T> ;                     p_af_filter: t_af_filter< T> );                 Function MoveNext: Boolean;                 Property Current: T read GetCurrent;            End; // c_filtered_enumerator Constructor c_filtered_enumerator<T>.create_filtered_enumerator(     p_c_base_list: TList<T>;     p_af_filter : t_af_filter<T>);   Begin     Inherited Create;     m_c_base_list:= p_c_base_list;     m_af_filter:= p_af_filter;     m_current_index:= - 1;   End; // create_filtered_enumerator Function c_filtered_enumerator<T>.DoMoveNext: Boolean;   Begin     Result := MoveNext;   End; // DoMoveNext Function c_filtered_enumerator<T>.GetCurrent: T;   Begin     Result := m_c_base_list[m_current_index];   End; // GetCurrent Function c_filtered_enumerator<T>.f_accept_T: Boolean;   Begin     Result := True;     If Assigned(m_af_filter)       Then Result := m_af_filter(m_c_base_list[m_current_index]);   End; // f_accept_T Function c_filtered_enumerator<T>.MoveNext: Boolean;   Begin     If m_current_index= m_c_base_list.Count - 1       Then Exit(False);     Repeat       Inc(m_current_index);     Until (m_current_index>= m_c_base_list.Count) Or f_accept_T;     Result := m_current_index< m_c_base_list.Count;   End; // MoveNext Function c_filtered_enumerator<T>.DoGetCurrent: T;   Begin     Result := GetCurrent;   End; // DoGetCurrent

• voici notre liste générique avec filtrage:

  Type c_filtered_list<T: Class> =          Class( TObjectList<T> )            Private              m_c_filtered_enumerator: c_filtered_enumerator<T>;            Public              Procedure set_filtered_enumerator(                  p_c_filtered_enumerator: c_filtered_enumerator<T>);              Function GetEnumerator: c_filtered_enumerator<T>; Reintroduce;          End; Function c_filtered_list<T>.GetEnumerator: c_filtered_enumerator<T>;   Begin     Result:= m_c_filtered_enumerator;   End; // GetEnumerator Procedure c_filtered_list<T>.set_filtered_enumerator(     p_c_filtered_enumerator: c_filtered_enumerator<T>);   Begin     m_c_filtered_enumerator:= p_c_filtered_enumerator;   End; // set_enumerator_filter

• et un exemple d'utilisation

  Var g_c_person_list: c_filtered_list<c_person>= Nil; // ooo initialise la liste Procedure TForm1.filtered_list_Click(Sender: TObject);   Var l_c_filter_person_enumerator: c_filtered_enumerator<c_person>;       l_c_person: c_person;   Begin     l_c_filter_person_enumerator:= c_filtered_enumerator<c_person>.         create_filtered_enumerator(           g_c_person_list,           Function(p_c_person: c_person): Boolean             Begin               Result:= p_c_person.m_first_name> filter_edit_.Text             End)       ;     g_c_person_list.set_filtered_enumerator(l_c_filter_person_enumerator);     For l_c_person In g_c_person_list Do       display(l_c_person.f_display_person);   End; // filtered_list_Click

  
  

• la fonction f_accept_T ne PEUT PAS être nichée dans MoveNext (E2570)
  
• nous avons bien utilisé un FOR IN, qui fonctionne parce que nous avons un énumérateur
  

5.3 - Anonymes et Threads

5.4 - Synchronize

Synchronize a comme paramètre une procédure sans paramètre de t_my_thread. Et si nous souhaitons accéder à des locales de t_my_thread.Execute, il faut auparavant les sauvegarder comme "variables mailbox" dans t_my_thread

Schématiquement nous avons

ou, au niveau code:

5.5 - Synchronize(tProc)

L'exemple précédent pourrait donc devenir:

5.6 - Téléchargement et traitements

• voici la Classe qui télécharge une page dont nous fournissons l'URL, et appelle une procédure anonyme pour effectuer un traitement sur cette page:

  Type t_ap_process_donwload= Reference To Procedure (p_c_response_content_stream: TStringStream);      c_download_thread=          Class(TThread)            Private              m_url: string;              m_ap_process_donwload: t_ap_process_donwload;            Protected              Procedure Execute; Override;            Public              Constructor create_download_thread(Const p_url: string;                  p_handle_did_terminate: tNotifyEvent;                  p_ap_process_donwload: t_ap_process_donwload);          End; // c_download_thread Constructor c_download_thread.create_download_thread(Const p_url: string;     p_handle_did_terminate: tNotifyEvent;     p_ap_process_donwload: t_ap_process_donwload);   Begin     m_url:= p_url;     m_ap_process_donwload:= p_ap_process_donwload;     OnTerminate:= p_handle_did_terminate;     FreeOnTerminate:= True;     Inherited Create(False);   End; // create_download_thread Procedure c_download_thread.Execute;   Var l_c_id_http: TIdHttp;       l_c_response_content_stream: TStringStream;   Begin     Synchronize(Procedure       Begin         display('> url '+ m_url);       End);     l_c_id_http:= TIdHTTP.Create(Nil);     l_c_response_content_stream:= TStringStream.Create;     Try       l_c_id_http.Get(m_url, l_c_response_content_stream);       l_c_response_content_stream.Position:= 0;       m_ap_process_donwload(l_c_response_content_stream);     Finally       l_c_response_content_stream.Free;     End;     l_c_id_http.Free;     Synchronize(Procedure       Begin         display('< url '+ m_url);       End);   End; // Execute

• voici une utilisation pour afficher le texte .HTML dans un memo:

  Procedure TForm1.display_html_text_Click(Sender: TObject);   Begin     display('> display_page');     With c_download_thread.create_download_thread(         url_edit_.Text,         handle_thread_did_terminate,         Procedure (p_c_response_content_stream: TStringStream)           Begin             display(' '+ p_c_response_content_stream.DataString);           End         ) Do;     display('< display_page');   End; // display_html_text_Click

  
  

Voici comment extraire les liens:

• la méthode d'extraction est la suivante:

  Type t_ap_process_found_item= Reference To Procedure (Const strLink: string); Procedure extract_content_links(p_content_string: string;     p_ap_process_found_item: t_ap_process_found_item); Procedure extract_content_links(p_content_string: string;     p_ap_process_found_item: t_ap_process_found_item);   // -- extract all "<A HREF="http://xxx">   Var l_href_start_index, l_href_end_index: Integer;       l_link_url: string;   Begin     display('> extract_content_links');     p_content_string:= LowerCase(p_content_string);     l_href_start_index:= 1;     Repeat       l_href_start_index:= PosEx('href="http', p_content_string, l_href_start_index);       If l_href_start_index<> 0         Then Begin             l_href_start_index:= l_href_start_index+ 6;             l_href_end_index:= PosEx('"', p_content_string, l_href_start_index);             l_link_url:= Copy(p_content_string, l_href_start_index,                 l_href_end_index- l_href_start_index);             // -- display or whatever this link             p_ap_process_found_item(l_link_url);             l_href_start_index:= l_href_end_index+ 1;           End;     Until l_href_start_index= 0;     display('< extract_content_links');   End; // extract_content_links

• et voici un exemple d'utilisation:

  Procedure TForm1.extract_and_display_links_Click(Sender: TObject);   Begin     With c_download_thread.create_download_thread(         url_edit_.Text,         handle_thread_did_terminate,         Procedure (p_c_response_content_stream: TStringStream)           Begin             extract_content_links(p_c_response_content_stream.DataString,               Procedure (Const p_link_url: string)                 Begin                   Memo1.Lines.Add(p_link_url);                 End             );           End         ) Do;   End; // extract_and_display_links_Click

  
  

• la procédure d'extraction des liens est aussi dotée d'une procédure anonyme. Ici, le clic du bouton demande l'affichage, mais nous aurions aussi bien pu demander le stockage, le filtrage, la récursion du chargement etc
  

5.7 - Autres exemples

• les énumérateurs de tout poil (crible d'Eratosthène pour les nombres premiers)
  
• la programmation fonctionnelle (Map, Reduce etc)
  
• les chaînages de traitements, parallèles ou non. "Multicast Events" qui vise à simuler les delegates en est un exemple
  

6 - Commentaires

6.1 - Complexité

Cela ressemble un peu à "Inversion of Control" : la procédure ayant le paramètre anonyme ne sait pas du tout quel traitement de paramètre effectuera. C'est l'appelant qui spécifie ce qui sera calculé.

En revanche, certains exemples ont aussi montré que le style peut aussi apparaître plus complexe, plus difficile à comprendre et relire. Question d'habitude peut être.

6.2 - Encapsulation

Travaillant surtout en Delphi 6, nos Classes ne contiennent que des attributs et des méthodes.

En fait, depuis quelques versions déjà, nous pouvons inclure dans une Classe

• des Const
  
• des Type
  
• des Var
  

En Pascal, la structure de base est en-tête / bloc :

Schématiquement nous avons

Et pour les Classes, Barry KELLY a utilisé des CONST et VAR imbriqués:

et Malcolm GROVES a utilisé un énumérateur sous forme de Classe imbriquée :

Ces nouvelles possibilités augmentent l'encapsulation, mais compliquent peut-être un peu la lecture.

7 - Télécharger le code source Delphi

• anon_01_first_example.zip (8 K)
  
• anon_02_delphi_routines.zip (8 K)
  
• anon_10_local_variable_capture.zip (8 K)
  
• anon_20_anonymous_method_implementation.zip (12 K)
  
• anon_21_invoke.zip (8 K)
  
• anon_22_syntax_errors.zip (7 K)
  
• anon_30_profiling.zip (10 K)
  
• anon_31_filtered_enumerator.zip (15 K)
  
• anon_32_process_html_download.zip (12 K)
  

• nous vous remercions de nous signaler toute erreur, inexactitude ou problème de téléchargement en envoyant un e-mail à jcolibri@jcolibri.com. Les corrections qui en résulteront pourront aider les prochains lecteurs
  
• tous vos commentaires, remarques, questions, critiques, suggestion d'article, ou mentions d'autres sources sur le même sujet seront de même les bienvenus à jcolibri@jcolibri.com.
  
• plus simplement, vous pouvez taper (anonymement ou en fournissant votre e-mail pour une réponse) vos commentaires ci-dessus et nous les envoyer en cliquant "envoyer" :

  Nom :
  E-mail :
  Commentaires * :

• et si vous avez apprécié cet article, faites connaître notre site, ajoutez un lien dans vos listes de liens ou citez-nous dans vos blogs ou réponses sur les messageries. C'est très simple: plus nous aurons de visiteurs et de références Google, plus nous écrirons d'articles.
  

8 - Références

• Barry KELLY, qui a codé les génériques et les anonymes:
  
  • Fun with Generics and Anonymous
      exemple d'énumérateur répétable
    
• Allen BAUER - Delphi Chief Scientist
  
  • Capture de valeur et de variable
    

• Génériques Delphi : exemple avec une tList<T>, création d'une pile, règles de compatibilité de type, génération du code, types pouvant être génériques, contraintes Interface, Class, héritage, Constructor. Exemple Observateur et Calculateur. Interfacees et conteneurs génériques de la Vcl
  

9 - L'auteur