menu
  Home  ==>  articles  ==>  vcl_rtl  ==>  delphi_anonymous_methods   

Méthodes Anonymes Delphi - John COLIBRI.


1 - Delphi Anonymous Methods

Les méthodes anonymes, introduites avec Delphi 2009 permettent essentiellement de fournir en paramètre à une procédure les instructions que cette procédure doit utiliser, un peu comme une procédure locale.

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

Voici un exemple simple ou une clic appelle une procédure qui additionne deux nombre et affiche le résultat :

Procedure do_add(p_onep_twoIntegerVar pv_resultInteger);
  Begin
    pv_result:= p_onep_two;
  End// do_add

Procedure TForm1.procedure_call_Click(SenderTObject);
  Var l_onel_twol_resultInteger;
  Begin
    l_one:= 11; l_two:= 22;
    do_add(l_onel_twol_result);
    display(Format('%d + %d = %d ', [l_onel_twol_result]));
  End// procedure_call_Click



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

Procedure TForm1.local_procedure_Click(SenderTObject);
  Var l_onel_twol_resultInteger;

  Procedure do_add;
    Begin
      l_result:= l_onel_two;
    End// do_add

  Begin // local_procedure_Click
    l_one:= 11; l_two:= 22;
    do_add;
    display(Format('%d + %d = %d ', [l_onel_twol_result]));
  End// local_procedure_Click



2.2 - Utilisation d'une méthode anonyme

Pour utiliser les méthodes anonymes, nous DEVONS d'abord définir la signature de la méthode (Procedure ou Function) en utilisant Type:

Type t_ap_addReference To Procedure(p_onep_twoIntegerVar pv_resultInteger);



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
Procedure TForm1.using_anon_Click(SenderTObject);
  Var l_ap_addt_ap_add;
      l_onel_twol_resultInteger;
  Begin
    l_ap_add:= Procedure(p_onep_twoIntegerVar pv_resultInteger)
      Begin
        pv_result:= p_onep_two;
      End;
    l_one:= 11; l_two:= 22;
    l_ap_add(l_onel_twol_result);
    display(Format('%d + %d = %d ', [l_onel_twol_result]));
  End// using_anon_Click



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_operationReference To Function(p_onep_twoInteger): Integer;

    Procedure TForm1.several_operations_Click(SenderTObject);
      Var l_onel_twoInteger;
          l_af_binary_operationt_af_binary_operation;
          l_resultInteger;
      Begin
        l_one:= 11; l_two:= 22;

        l_af_binary_operation:= Function(p_onep_twoInteger): Integer
          Begin
            Result:= p_onep_two;
          End;
        l_result:= l_af_binary_operation(l_onel_two);
        display(Format('%d + %d = %d ', [l_onel_twol_result]));

        l_af_binary_operation:= Function(p_onep_twoInteger): Integer
          Begin
            Result:= p_onep_two;
          End;
        display(Format('%d * %d = %d ',
            [l_onel_twol_af_binary_operation(l_onel_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_operationReference To Function(p_onep_twoInteger): Integer;

    Procedure display_binary_operation(p_onep_twoInteger;
        p_operatorChar;
        p_af_binary_operationt_af_binary_operation);
      Begin
        display(Format('%d %s %d = %d ',
            [p_onep_operatorp_twop_af_binary_operation(p_onep_two)]));
      End// display_binary_operation

    Procedure TForm1.several_calls_Click(SenderTObject);
      Begin
        display_binary_operation(11, 22, '+',
            Function(p_onep_twoInteger): Integer
              Begin
                Result:= p_onep_two;
              End);

        display_binary_operation(11, 22, '*',
            Function(p_onep_twoInteger): Integer
              Begin
                Result:= p_onep_two;
              End)
      End// several_calls_Click




2.3 - Types de sous-programmes Delphi

2.3.1 - Type Procédural

Le dernier exemple est en fait dans la ligne droite des types procéduraux inclus par Niklaus WIRTH dans la spécification Pascal, mais qui n'était implémentée ni dans le compilateur P4, ni dans le Pascal de l'Apple ][. Turbo Pascal était l'un des premiers compilateurs à offrir une implémentation.

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):

Type t_ft_functionFunction(p_xDouble): Double:

Function f_integrate(p_ft_functiont_ft_functionp_ap_bDouble): Double;
  Begin
    // -- here, complex code for symbolic integration of the function
    // -- from p_a to p_b
  End// f_integrate

Function f_my_function(p_xDouble): Double;
  Begin
    // -- here computes f(xà
  End// f_my_function

Procedure TForm1.button_1_Click(SenderTObject);
  Var l_resultDouble;
  Begin
    l_result:= f_integrate(Sin, 1, 2);
    // ...
    l_result:= f_integrate(Gamma, 10, 20)
    // ...
    l_result:= f_integrate(f_x, 1.5, 3.14);
  End// button_1_Click



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

En programmation objet, chaque méthode a un paramètre muet Self qui est poussé sur la pile avant l'appel de cette méthode. Il a donc fallu créer un type procédural spécial, ce qui correspond à des Procedure Of Object ou Function of Object.

Voici un exemple simple:

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

    Type c_person=
             Class
               m_first_nameString;
               m_ageinteger;

               Constructor create_person(
                   p_first_nameStringp_ageInteger);
             End// c_person

         t_po_display_personProcedure(p_c_personc_personOf 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_personc_person): String;
             End;

    Procedure TForm1.display_person(p_c_personc_person);
      Begin
        display(Format('person=%s, Self.Classname= %s',
            [p_c_person.m_first_nameSelf.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(SenderTObject);
      Var l_c_personc_person;
          l_po_display_persont_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




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

    // System.Classes

    TNotifyEvent = Procedure(SenderTObjectOf Object;

    // Vcl.Controls

    TControl=
        Class(tComponent)
           FOnClickTNotifyEvent;
           // ooo
           Property OnClickTNotifyEvent read FOnClick write FOnClick // ooo
        End// tControl




2.3.3 - Les Méthodes Anonymes

Les méthodes anonymes sont le troisième type procédural, et se distinguent des deux précédentes par les mots clé Reference To:

Type t_ap_addReference To Procedure(p_onep_twoIntegerVar pv_resultInteger);




3 - Capture de variable - Clôture

3.1 - Anonymous Method Closure - Exemple

Les méthodes anonymes ont aussi la propriété de transporter avec elles les données locales qu'elles "capturent" lors de leur définition.

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:

Type t_ap_addReference To Procedure(p_onep_twoIntegerVar pv_resultInteger);



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_integerInteger);

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

    Procedure call_anon(p_ap_integert_ap_integerp_integerInteger);
      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(SenderTObject);
      Var l_totalInteger;
      Begin
        l_total:= 100;
        display(Format('initial_l_total  %4d', [l_total]));

        call_anon(
            Procedure(p_incrementInteger)
              Begin
                // -- will CHANGE the local
                Inc(l_totalp_increment);
                display(Format('captured_l_total %4d anon_param_p_increment %4d',
                    [l_totalp_increment]));
              End,
            33);

        display('local_after_call  'IntToStr(l_total));
      End// capture_of_local_Click


et voici un exemple d'exécution après 2 clics:

anonymous_local_varialble_capture

Rien de surprenant, chaque clic:

  • réinitialise la locale à 100
  • appelle la procédure anonyme qui modifie cette variable (133)
Chaque chaque clic fournit donc le même résultat.



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

    Procedure TForm1.initialize_anon_var_Click(SenderTObject);
      Var l_totalInteger;
      Begin
        l_total:= 100;
        display(Format('initial_l_total  %4d', [l_total]));

        g_ap_call_and_increment_by:=
            Procedure(p_incrementInteger)
              Begin
                Inc(l_totalp_increment);
                display(Format('captured_l_total %4d anon_param_p_increment %4d',
                    [l_totalp_increment]));
              End
      End// initialize_anon_var_Click

  • nous appelons plusieurs fois cette méthode anonyme:

    Procedure TForm1.call_anon_with_capture_Click(SenderTObject);
      Begin
        call_anon(g_ap_call_and_increment_by, 2);
      End// call_anon_with_capture_Click

  • et voici le résultat de 3 appels :

    anonymous_method_closure

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



Les appels successifs ont pu modifier la variable locale l_total, car au moment de la définition de la méthode anonyme, la globale g_ap_xxx a stocké
  • les instructions à exécuter (l'incrémentation et l'affichage)
  • les variables locales inclues dans la définition (ici l_total)
Les méthodes anonymes peuvent ainsi être décrites comme

  les méthodes anonymes permettent de créer le code d'une méthode dans un contexte




4 - Implémentation des méthodes anonymes

4.1 - Objet Sous-Jacent

Pour implémenter les procédures anonymes,
  • 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
    01_anonymous_method_implementation

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


Au niveau durée de vie, l'objet COM subsiste tant que quelqu'un référence cet objet. Si l'anonyme a capturé une variable, cet anonyme étend la durée de vie de cette variable, tant que quelqu'un utilise cet anonyme.



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

Comme le compilateur copie sur le tas les variables capturées, si nous modifions la valeur d'une locale capturée, c'est la dernière valeur qui est stockée dans la capture.

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

Type t_ap_integerReference To Procedure(p_integerInteger);

Var g_ap_integert_ap_integer;

Procedure TForm1.define_g_ap_and_capture_local_Click(SenderTObject);
  Var l_integerInteger;
  Begin
    l_integer:= 33;
    display(Format('initial_l_integer  %4d', [l_integer]));

    // -- capture the local
    g_ap_integer:=
        Procedure(p_incrementInteger)
          Begin
            Inc(l_integerp_increment);
            display(Format('captured_l_integer %4d anon_param_p_increment %4d',
                [l_integerp_increment]));
          End;

    // -- change the local "after" the capture
    l_integer:= 77;
  End// define_g_ap_and_capture_local_Click

Puis nous appelons la méthode anonyme:

Procedure TForm1.call_g_apClick(SenderTObject);
  Begin
    g_ap_integer(1000);
  End// call_g_apClick

et voici le résultat :

anonymous_local_capture



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

Pour vérifier toute ces assertions, nous pouvons afficher ces fameux objets et interfaces qui sont utilisés pour implémenter les anonymes.

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



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

Function f_invoke_address(Const pk_ap): String;
  Type t_vmt_arrayArray[0..3] Of Pointer;
       t_pt_vmt_array= ^t_vmt_array;
       t_pt_pt_vmt_array= ^t_pt_vmt_array;
  Begin
    // -- 3 is offset of Invoke, after QI, AddRef, Release
    Result:= Format('invoke=$%6x',
        [Integer(t_pt_pt_vmt_array(pk_ap)^^[3])]);
  End// f_invoke_address

Function f_anonymous_to_object(p_pt_anonymousPointer): tObject;
  Var l_i_interfaceiInterface;
  Begin
    l_i_interface := PUnknown(p_pt_anonymous)^;
    Result:= l_i_interface As TObject;
  End// f_anonymous_to_object

Procedure display_anonypous(p_titleStringp_pt_anonymousPointer);
  Var l_i_interfaceiInterface;
      l_c_objecttObject;

      l_c_rtti_contextTRttiContext;
      l_c_rtti_typeTRttiType;
      l_c_rtti_fieldTRttiField;
  Begin
    l_i_interface := PUnknown(p_pt_anonymous)^;
    l_c_object:= l_i_interface As TObject;
    display(Format('%s  [@=(sSelf)=%4x i=$%4x  o=$%4x %s]',
        [p_titleInteger(p_pt_anonymous), Integer(@l_i_interface), Integer(@l_c_object),
         f_invoke_address(p_pt_anonymous)]) );

    l_c_object:= f_anonymous_to_object(p_pt_anonymous);
    display('  ClassName        'l_c_object.ClassName);
    display('  Parent.ClassName 'l_c_object.ClassType.ClassParent.ClassName);

    l_c_rtti_type := l_c_rtti_context.GetType(l_c_object.ClassType);
    For l_c_rtti_field In l_c_rtti_type.GetFields Do
      display('  fields           'l_c_rtti_field.Name + ':' + l_c_rtti_field.FieldType.Name);
  End// display_anonypous



Et voici quelques exemples:

Function f_invoke_address(Const pk_ap): String;
  Type t_vmt_arrayArray[0..3] Of Pointer;
       t_pt_vmt_array= ^t_vmt_array;
       t_pt_pt_vmt_array= ^t_pt_vmt_array;
  Begin
    // -- 3 is offset of Invoke, after QI, AddRef, Release
    Result:= Format('invoke=$%6x',
        [Integer(t_pt_pt_vmt_array(pk_ap)^^[3])]);
  End// f_invoke_address

Function f_anonymous_to_object(p_pt_anonymousPointer): tObject;
  Var l_i_interfaceiInterface;
  Begin
    l_i_interface := PUnknown(p_pt_anonymous)^;
    Result:= l_i_interface As TObject;
  End// f_anonymous_to_object

Procedure display_anonypous(p_titleStringp_pt_anonymousPointer);
  Var l_i_interfaceiInterface;
      l_c_objecttObject;

      l_c_rtti_contextTRttiContext;
      l_c_rtti_typeTRttiType;
      l_c_rtti_fieldTRttiField;
  Begin
    l_i_interface := PUnknown(p_pt_anonymous)^;
    l_c_object:= l_i_interface As TObject;
    display(Format('%s  [@=(sSelf)=%4x i=$%4x  o=$%4x %s]',
        [p_titleInteger(p_pt_anonymous), Integer(@l_i_interface), Integer(@l_c_object),
         f_invoke_address(p_pt_anonymous)]) );

    l_c_object:= f_anonymous_to_object(p_pt_anonymous);
    display('  ClassName        'l_c_object.ClassName);
    display('  Parent.ClassName 'l_c_object.ClassType.ClassParent.ClassName);

    l_c_rtti_type := l_c_rtti_context.GetType(l_c_object.ClassType);
    For l_c_rtti_field In l_c_rtti_type.GetFields Do
      display('  fields           'l_c_rtti_field.Name + ':' + l_c_rtti_field.FieldType.Name);
  End// display_anonypous

et voici le résultat:

anonymous_dump

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

Au niveau utilisation, les anonymes sont aussi liés aux procédure Inline. Ils sont donc de ce fait limités ainsi:
  • 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

Pour Niklaus WIRTH, si une procédure ou une fonction n'a pas de paramètres, il n'est pas permis
  • de la définir avec des parenthèses vides ()
  • de l'appeler avec des parenthèses vides ()
Delphi, par analogie où toutes les routines, paramètres ou non, sont définies et invoquées avec des parenthèses, Delphi permet d'utiliser des parenthèses vides:

Procedure compute;
  Begin
  End// compute

Procedure process();
  Begin
  End// process

Procedure TForm1.procedure_Click(SenderTObject);
  Begin
    compute;
    compute();
    process;
    process();
  End// procedure_Click



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_apReference To Procedure;
         t_ap_integerReference To Procedure(p_nInteger);

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

    Function f_apt_ap;
      Var l_integerInteger;
      Begin
        l_integer:= 100;
        Result:=
            Procedure
              Begin
                l_integer:= l_integer;
                display(IntToStr (l_integer));
              End;
      End// f_ap

    Procedure TForm1.ap_Click(SenderTObject);
      Var l_apt_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_totalInteger): 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(SenderTObject);
      Var l_apt_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_integert_ap_integer;
      Var l_integerInteger;
      Begin
        l_integer:= 100;
        Result:=
            Procedure (p_nInteger)
              Begin
                l_integer:= l_integer + p_n;
                display(IntToStr (l_integer));
              End;
      End// f_ap_integer

    Procedure TForm1.ap_integer_Click(SenderTObject);
      Var l_ap_integert_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_totalInteger): t_ap_integer;
      Begin
        Result:=
            Procedure (p_nInteger)
              Begin
                p_total:= p_total + p_n;
                display(IntToStr(p_total));
              End;
      End// f_ap_integer

    Procedure TForm1.n_ap_integer_Click(SenderTObject);
      Var l_ap_integert_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

Mentionnons aussi qu'il faut être vigilant à utiliser la même signature pour la définition du type anonyme et la définition de cet anonyme.

Voici un exemple avec un paramètre Const :

Type t_ap_integerReference To Procedure(Const pk_nInteger);

Procedure TForm1.const_param_Click(SenderTObject);
  Var l_ap_integert_ap_integer;
  Begin
    l_ap_integer:=
        Procedure(Const pk_nInteger)
          Begin
            display(IntToStr(pk_n));
          End;
    l_ap_integer(33);

(*      "incopatible type"
    l_ap_integer:=
        Procedure(pk_n: Integer)
          begin
            display(IntToStr(pk_n));
          end;
*)

  End// const_param_Click



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

Delphi prédéfinit déjà dans SYSUTILS.PAS certains types références courants

Type TProc = Reference To Procedure;
     TProc<T> = Reference To Procedure (Arg1T);
     TProc<T1,T2> = Reference To Procedure (Arg1T1Arg2T2);
     TProc<T1,T2,T3> = Reference To Procedure (Arg1T1Arg2T2Arg3T3);
     TProc<T1,T2,T3,T4> = Reference To Procedure (Arg1T1Arg2T2Arg3T3Arg4T4);

     TFunc<TResult> = Reference To FunctionTResult;
     TFunc<T,TResult> = Reference To Function (Arg1T): TResult;
     TFunc<T1,T2,TResult> = Reference To Function (Arg1T1Arg2T2): TResult;
     TFunc<T1,T2,T3,TResult> = Reference To Function (Arg1T1Arg2T2Arg3T3): TResult;
     TFunc<T1,T2,T3,T4,TResult> = Reference To Function (Arg1T1Arg2T2Arg3T3Arg4T4): TResult;

     TPredicate<T> = Reference To Function (Arg1T): Boolean;

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

Notre premier exemple concerne le profiling: nous souhaitons chronométrer différentes façons de coder un traitement.

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
01_profiling

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
using_anonymous_methods



Voici donc

  • notre Classe de profiling:

    Type c_procedure_timer=
             Class
               m_initial_iterationsInteger;
               m_iterationsInteger;

               m_base_frequencyInt64;

               Constructor Create;

               Procedure read_hires_frequency;

               Function f_measure_time_of(
                   p_pa_to_profileTProc;
                   p_initial_iterationsp_iterationsInteger): Double;

               Procedure measure_time(
                   Const p_titlestring;
                   Const p_pa_to_profileTProc); 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_profileTProc;
        p_initial_iterationsp_iterationsInteger): Double;
      Var l_start_ticksl_stop_ticksInt64;
          l_iterationInteger;
      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_ticksl_start_ticks)/ m_base_frequencyp_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_interfacei_my_interfacep_countInteger);
               Procedure interface_call(p_i_my_interfacei_my_interfacep_countInteger);
             End// i_my_interface

         c_my_class=
             Class(TInterfacedObjecti_my_interface)
               Procedure const_non_virtual_call(Const p_c_my_classc_my_classp_countInteger);
               Procedure non_virtual_call(p_c_my_classc_my_classp_countInteger);
               Procedure virtual_call(p_c_my_classc_my_classp_countInteger); Virtual;
               Procedure const_interface_call(Const p_i_my_interfacei_my_interfacep_countInteger);
               Procedure interface_call(p_i_my_interfacei_my_interfacep_countInteger);
             End// c_my_class

    Procedure recursive_call(p_countInteger);

    Type t_apReference To Procedure(p_apt_app_countInteger);
    Type t_ap_constReference To Procedure(Const pk_apt_ap_constp_countInteger);

    Procedure recursive_call(p_countInteger);
      Begin
        If p_count> 0
          Then recursive_call(p_count- 1);
      End// recursive_call

    Procedure c_my_class.interface_call(p_i_my_interfacei_my_interfacep_countInteger);
      Begin
        If p_count> 0
          Then p_i_my_interface.interface_call(p_i_my_interfacep_count- 1);
      End// interface_call

    Procedure c_my_class.const_interface_call(Const p_i_my_interfacei_my_interfacep_countInteger);
      Begin
        If p_count> 0
          Then p_i_my_interface.const_interface_call(p_i_my_interfacep_count- 1);
      End// const_interface_call

    Procedure c_my_class.non_virtual_call(p_c_my_classc_my_classp_countInteger);
      Begin
        If p_count> 0
          Then non_virtual_call(p_c_my_classp_count- 1);
      End// non_virtual_call

    Procedure c_my_class.const_non_virtual_call(Const p_c_my_classc_my_classp_countInteger);
      Begin
        If p_count> 0
          Then const_non_virtual_call(p_c_my_classp_count- 1);
      End// const_non_virtual_call

    Procedure c_my_class.virtual_call(p_c_my_classc_my_classp_countInteger);
      Begin
        If p_count> 0
          Then virtual_call(p_c_my_classp_count- 1);
      End// virtual_call

  • voici l'utilisation de notre timer:

    Procedure TForm1.compare_calls_Click(SenderTObject);
      Const k_recursive_count= 10000;
      Var l_c_procedure_timerc_procedure_timer;
          l_c_my_objectc_my_class;
          l_i_my_interfacei_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_objectk_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_objectk_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_objectk_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_interfacek_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_interfacek_recursive_count);
                End
              );

        Finally
          l_c_procedure_timer.Free;
        End;
      End// compare_calls_Click

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

    method_call_profiling



Nous avons aussi profilé les méthodes anonymes:
  • voici le test

    Procedure TForm1.measure_anonymous_Click(SenderTObject);
      Const k_recursive_count= 10000;
      Var l_c_procedure_timerc_procedure_timer;
          l_apt_ap;
          l_ap_constt_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_apt_app_countInteger)
                Begin
                  If p_count> 0
                    Then p_ap(p_app_count- 1);
                End;

          l_ap_const:=
              Procedure (Const pk_apt_ap_constp_countInteger)
                Begin
                  If p_count> 0
                    Then pk_ap(pk_app_count- 1);
                End;
          display('');

          l_c_procedure_timer.measure_time('anon(p_anon, n)',
              Procedure
                Begin
                  l_ap(l_apk_recursive_count);
                End
              );
          l_c_procedure_timer.measure_time('anon(const p_anon, n)',
              Procedure
                Begin
                  l_ap_const(l_ap_constk_recursive_count);
                End
              );
        Finally
          l_c_procedure_timer.Free;
        End;
      End// measure_anonymous_Click

  • et son résultat :

    anonymous_call_profiling



Quelques remarques
  • 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(SenderTObject);
      Const k_recursive_count= 10000;
      Var l_c_procedure_timerc_procedure_timer;
          l_apt_ap;
          l_ap_constt_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_apt_app_countInteger)
                Begin
                  If p_count> 0
                    Then p_ap(p_app_count- 1);
                End;

          l_ap_const:=
              Procedure (Const pk_apt_ap_constp_countInteger)
                Begin
                  If p_count> 0
                    Then pk_ap(pk_app_count- 1);
                End;
          display('');

          l_c_procedure_timer.measure_time('anon(p_anon, n)',
              Procedure
                Begin
                  l_ap(l_apk_recursive_count);
                End
              );
          l_c_procedure_timer.measure_time('anon(const p_anon, n)',
              Procedure
                Begin
                  l_ap_const(l_ap_constk_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

Les énumérateurs sont définis par les éléments suivants:
  • 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


Voici un énumérateur explicitement dédié aux entiers:

Type c_integer_sequence_enumerator=
         Class
           Private
             FCurrentInteger;
             FCountInteger;
             FIncrementInteger;
             Function GetCurrentInteger;
           Public
             Constructor Create(StartIncrementCountInteger);
             Function MoveNextBoolean;
             Property CurrentInteger read GetCurrent;
         End// c_integer_sequence_enumerator

Constructor c_integer_sequence_enumerator.Create(StartIncrementCountInteger);
  Begin
    FCurrent:= Start;
    FCount:= Count;
    FIncrement:= Increment;
  End// Create

Function c_integer_sequence_enumerator.GetCurrentInteger;
  Begin
    Result:= FCurrent;
  End// GetCurrent

Function c_integer_sequence_enumerator.MoveNextBoolean;
  Begin
    If FCount<= 0
      Then Exit(False);
    Inc(FCurrentFIncrement);
    Dec(FCount);
    Result:= True;
  End// MoveNext

et son utilisation:

Procedure TForm1.integer_sequence_enumerator_Click(SenderTObject);
  Begin
    With c_integer_sequence_enumerator.create(10, 3, 5) Do
    Begin
      While MoveNext Do
        display(IntToStr(Current));
      Free;
    End// with c_integer_sequence_enumerator
  End// integer_sequence_enumerator_Click



5.2.2 - Utilisation d'une Interface

Pour avoir un énumérateur lié à des Classes, nous pouvons définir des Interface
  • pour l'énumérateur
  • pour la fonction GetEnumerator qui fournit l'enumerator
Pour énumérer une structure quelconque, comme une liste de c_person, il suffit alors
  • 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.
Ce qui peut se représenter par le diagramme de classe UML suivant :

enumerator_enumerator



Donc

  • voici nos Interfaces

    Type i_enumerator<T> =
             Interface
               Function GetCurrentT;
               Function MoveNextBoolean;
               Procedure Reset;
               Property CurrentT read GetCurrent;
             End// i_enumerator<T>

         i_enumerable<T> =
             Interface
               Function GetEnumeratori_enumerator<T>;
             End// i_enumerable<T>

  • notre liste de personne et leur énumérateur

    Type c_person_list_2=
             Class(tInterfacedObjecti_enumerable<c_person>)
               m_person_arrayArray Of c_person;
               m_person_countinteger;

               Constructor create_person_list_2;
               Procedure add_person(p_c_personc_person);

               // -- i_enumerable
               Function GetEnumeratori_enumerator<c_person>;

               Destructor DestroyOverride;
             End// c_person_list_2

         c_person_enumerator_2=
             Class(tInterfacedObjecti_enumerator<c_person>)
               m_c_person_list_refc_person_list_2;
               m_current_indexinteger;

               Constructor create_person_enumerator_2(p_c_person_list_refc_person_list_2);

               // -- i_enumerator
               Function GetCurrentc_person;
               Function MoveNextBoolean;
               Procedure Reset;

               Property Currentc_person read GetCurrent;
             End// c_person_enumerator_2

    Constructor c_person_enumerator_2.create_person_enumerator_2(p_c_person_list_refc_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.GetCurrentc_person;
      Begin
        If m_current_indexm_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.MoveNextBoolean;
      Begin
        Inc(m_current_index);
        Result:= m_current_indexm_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.GetEnumeratori_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_personc_person);
      Begin
        If m_person_countLength(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_indexInteger;
      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(SenderTObject);
      Var l_i_enumeratori_enumerator<c_person>;
          l_c_current_personc_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




Notez que
  • 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 :

    04_ienumerable

    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_enumeratoriEnumerator;
        l_c_current_personc_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

Pour filtrer une liste, il suffit de la doter d'un énumérateur en aménageant MoveNext pour n'accepter que les éléments satisfaisant une condition

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.
Voici le diagramme de classe UML correspondant :

filtered_list



Au niveau du code

  • notre énumérateur avec son filtre :

    Type t_af_filter<T> = Reference To Function (p_TT): boolean;

         c_filtered_enumerator<T>=
                ClassTEnumerator<T> )
                  Private
                    m_c_base_listTList<T> ;
                    m_af_filtert_af_filterT>;

                    m_current_indexInteger;

                    Function GetCurrentT;
                    Function f_accept_TBoolean;
                  Protected
                    Function DoGetCurrentTOverride;
                    Function DoMoveNextBooleanOverride;
                  Public
                    Constructor create_filtered_enumerator(p_c_base_listtListT> ;
                        p_af_filtert_af_filterT> );

                    Function MoveNextBoolean;
                    Property CurrentT read GetCurrent;
               End// c_filtered_enumerator

    Constructor c_filtered_enumerator<T>.create_filtered_enumerator(
        p_c_base_listTList<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>.DoMoveNextBoolean;
      Begin
        Result := MoveNext;
      End// DoMoveNext

    Function c_filtered_enumerator<T>.GetCurrentT;
      Begin
        Result := m_c_base_list[m_current_index];
      End// GetCurrent

    Function c_filtered_enumerator<T>.f_accept_TBoolean;
      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>.MoveNextBoolean;
      Begin
        If m_current_indexm_c_base_list.Count - 1
          Then Exit(False);

        Repeat
          Inc(m_current_index);
        Until (m_current_index>= m_c_base_list.CountOr f_accept_T;

        Result := m_current_indexm_c_base_list.Count;
      End// MoveNext

    Function c_filtered_enumerator<T>.DoGetCurrentT;
      Begin
        Result := GetCurrent;
      End// DoGetCurrent

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

    Type c_filtered_list<TClass> =
             ClassTObjectList<T> )
               Private
                 m_c_filtered_enumeratorc_filtered_enumerator<T>;
               Public
                 Procedure set_filtered_enumerator(
                     p_c_filtered_enumeratorc_filtered_enumerator<T>);
                 Function GetEnumeratorc_filtered_enumerator<T>; Reintroduce;
             End;

    Function c_filtered_list<T>.GetEnumeratorc_filtered_enumerator<T>;
      Begin
        Result:= m_c_filtered_enumerator;
      End// GetEnumerator

    Procedure c_filtered_list<T>.set_filtered_enumerator(
        p_c_filtered_enumeratorc_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_listc_filtered_list<c_person>= Nil;

    // ooo initialise la liste

    Procedure TForm1.filtered_list_Click(SenderTObject);
      Var l_c_filter_person_enumeratorc_filtered_enumerator<c_person>;
          l_c_personc_person;
      Begin
        l_c_filter_person_enumerator:= c_filtered_enumerator<c_person>.
            create_filtered_enumerator(
              g_c_person_list,
              Function(p_c_personc_person): Boolean
                Begin
                  Result:= p_c_person.m_first_namefilter_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




Notez que
  • 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

Les threads doivent utiliser Synchronize pour pouvoir accéder à des contrôles visuels de la VCL.

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

synchronize

ou, au niveau code:

Type c_my_thread=
         Class(tThread)
           Private
             m_indexInteger;
           Public
             Procedure do_display;
             Procedure ExecuteOverride;
         End// c_my_thread

Procedure c_my_thread.do_display;
  Begin
    Form1.Memo1.Lines.Add(IntTostr(m_index));
  End// do_display

Procedure c_my_thread.Execute;
  Var l_indexInteger;
  Begin
    For l_index:= 1 To 10 Do
    Begin
      m_index:= l_index;
      Synchronize(do_display);
    End// for l_index
  End// Execute



5.5 - Synchronize(tProc)

tThread a été doté en Delphi 2009 d'un autre méthode Syncrhonize qui accepte un paramètre de type procédure anonyme:

Type TThreadMethodProcedure Of Object;
     TThreadProcedureReference To Procedure;

     TThread=
         Class
           Procedure Synchronize(AMethodTThreadMethod); Overload;
           Procedure Synchronize(AThreadProcTThreadProcedure); Overload;
         End// TThread



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

Type c_my_thread=
         Class(tThread)
           Public
             Procedure ExecuteOverride;
         End// c_my_thread

Procedure c_my_thread.Execute;
  Var l_indexInteger;
  Begin
    l_index:= 1;
    Repeat
      Synchronize(
        Procedure
          Begin
            Form1.Memo1.Lines.Add(IntTostr(l_index));
          End);

      Inc(l_index);
    Until l_index> 10;
  End// Execute



5.6 - Téléchargement et traitements

Cet exemple montre comment utiliser des threads pour télécharger des pages Web et effectuer un traitement sur ces pages, comme la sauvegarde, l'extraction de liens etc
  • 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_donwloadReference To Procedure (p_c_response_content_streamTStringStream);

         c_download_thread=
             Class(TThread)
               Private
                 m_urlstring;
                 m_ap_process_donwloadt_ap_process_donwload;
               Protected
                 Procedure ExecuteOverride;
               Public
                 Constructor create_download_thread(Const p_urlstring;
                     p_handle_did_terminatetNotifyEvent;
                     p_ap_process_donwloadt_ap_process_donwload);
             End// c_download_thread

    Constructor c_download_thread.create_download_thread(Const p_urlstring;
        p_handle_did_terminatetNotifyEvent;
        p_ap_process_donwloadt_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_httpTIdHttp;
          l_c_response_content_streamTStringStream;
      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_urll_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(SenderTObject);
      Begin
        display('> display_page');
        With c_download_thread.create_download_thread(
            url_edit_.Text,
            handle_thread_did_terminate,
            Procedure (p_c_response_content_streamTStringStream)
              Begin
                display(' 'p_c_response_content_stream.DataString);
              End
            ) Do;
        display('< display_page');
      End// display_html_text_Click



Nous pouvons aussi appeler d'autres procédures qui effectuent des traitements sur le contenu d'une page.

Voici comment extraire les liens:

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

    Type t_ap_process_found_itemReference To Procedure (Const strLinkstring);

    Procedure extract_content_links(p_content_stringstring;
        p_ap_process_found_itemt_ap_process_found_item);

    Procedure extract_content_links(p_content_stringstring;
        p_ap_process_found_itemt_ap_process_found_item);
      // -- extract all "<A HREF="http://xxx">
      Var l_href_start_indexl_href_end_indexInteger;
          l_link_urlstring;
      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_stringl_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_stringl_href_start_index);
                l_link_url:= Copy(p_content_stringl_href_start_index,
                    l_href_end_indexl_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(SenderTObject);
      Begin
        With c_download_thread.create_download_thread(
            url_edit_.Text,
            handle_thread_did_terminate,
            Procedure (p_c_response_content_streamTStringStream)
              Begin
                extract_content_links(p_c_response_content_stream.DataString,
                  Procedure (Const p_link_urlstring)
                    Begin
                      Memo1.Lines.Add(p_link_url);
                    End
                );
              End
            ) Do;
      End// extract_and_display_links_Click



Notez que
  • 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

Parmi les autres exemples citons
  • 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
Ces exemples sont relativement longs ce qui explique que nous n'avons pu les présenter




6 - Commentaires

6.1 - Complexité

Les génériques évitent la création d'une fonction explicite, et permettent souvent de définir le traitement au moment de l'appel d'une procédure.

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

Nous avons aussi rencontré lors de nos explorations, des exemples d'encapsulation qui nous paraissent un peu extrèmes.

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 fait, la Classe devient en quelque sorte un mini bloc imbriqué.



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

Schématiquement nous avons

Program compute;
  Const
  Type
  Var

  Procedure process;
    Const
    Type
    Var

    Begin
    End;

  Begin
  End.



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

Type TBenchmarker =
         Class
           Private
             Const DefaultIterations = 3;
                   DefaultWarmups = 1;
             Var FReportSinkTProc<string,Double>;
                 FWarmupsInteger;
                 FIterationsInteger;
                 FOverheadDouble;
             Class Var FFreqInt64;
             Class Procedure InitFreq;
           Public
             Constructor Create(Const AReportSinkTProc<string,Double>);

             Class Function Benchmark(Const CodeTProc;
                 IterationsInteger = DefaultIterations;
                 WarmupsInteger = DefaultWarmups): DoubleOverload;

             Procedure Benchmark(Const NamestringConst CodeTProc); Overload;
             Function Benchmark<T>(Const NamestringConst CodeTFunc<T>): TOverload;

             Property WarmupsInteger read FWarmups write FWarmups;
             Property IterationsInteger read FIterations write FIterations;
           End// TBenchmarke

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

Type TFilteredList<T> =
         ClassTList<T> )
           Private
             FFilterFunctionTFilterFunctionT> ;
           Public
             Type TFilteredEnumerator=
                      ClassTEnumerator<T> )
                        Private
                          FListTFilteredList<T> ;
                          FIndexInteger;
                          FFilterFunctionTFilterFunctionT> ;
                          Function GetCurrentT;
                        Protected
                          Function DoGetCurrentTOverride;
                          Function DoMoveNextBooleanOverride;
                          Function IsLastBoolean;
                          Function IsEOLBoolean;
                          Function ShouldIncludeItemBoolean;
                        Public
                          Constructor Create(AListTFilteredListT> ;
                              AFilterFunctionTFilterFunctionT> );
                          Property CurrentT read GetCurrent;
                          Function MoveNextBoolean;
                     End// TFilteredEnumerator

             Procedure SetFilter(AFilterFunctionTFilterFunctionT> );

             Function GetEnumeratorTFilteredEnumeratorReintroduce;
             Procedure ClearFilter;
         End// TFilteredList

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




7 - Télécharger le code source Delphi

Vous pouvez télécharger:

Comme d'habitude:
  • 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

Citons

Pour les génériques, vous pouvez vous reporter à notre article
  • 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

John COLIBRI est passionné par le développement Delphi et les applications de Bases de Données. Il a écrit de nombreux livres et articles, et partage son temps entre le développement de projets (nouveaux projets, maintenance, audit, migration BDE, migration Xe_n, refactoring) pour ses clients, le conseil (composants, architecture, test) et la formation. Son site contient des articles avec code source, ainsi que le programme et le calendrier des stages de formation Delphi, base de données, programmation objet, Services Web, Tcp/Ip et UML qu'il anime personellement tous les mois, à Paris, en province ou sur site client.
Créé: feb-13. Maj: aou-15  148 articles, 471 sources .ZIP, 2.021 figures
Contact : John COLIBRI - Tel: 01.42.83.69.36 / 06.87.88.23.91 - email:jcolibri@jcolibri.com
Copyright © J.Colibri   http://www.jcolibri.com - 2001 - 2015
Retour:  Home  Articles  Formations  Développement Delphi  Livres  Pascalissime  Liens  Download
l'Institut Pascal

John COLIBRI

+ Home
  + articles_avec_sources
    + bases_de_donnees
    + web_internet_sockets
    + prog_objet_composants
    + office_com_automation
    + colibri_utilities
    + uml_design_patterns
    + graphique
    + delphi
    + outils
    + firemonkey
    + vcl_rtl
      – gestes_delphi
      – delphi_vcl_styles
      – anonymous_methods
      – ecran_tactile_delphi
    + colibri_helpers
    + colibri_skelettons
  + formations
  + developpement_delphi
  + présentations
  + pascalissime
  + livres
  + entre_nous
  – télécharger

contacts
plan_du_site
– chercher :

RSS feed  
Blog

Formation Bases de Données Delphi Gestion de bases de données : connexion, accès aux tables, édition d'états - 3 jours
Formation Delphi xe3 complete L'outil de développpement, le langage de programmation, les composants, les bases de données et la programmation Internet - 5 jours
Migration Delphi migration de versions Delphi, migration Unicode, migration BDE / base de données, migration Internet - Tél 01.42.83.69.36
Formation Perfectionnement Delphi Les techniques avancées : la programmation objet, l'écriture de composants, l'accès aux bases de données, Xml, le multi-tâche, la programmation Internet - 5 jours