ada

Dynamic Dispatching with Generic Packages in Ada


I am having trouble getting dynamic dispatching to work with Ada generics. Is there an elegant way (something better than conditions such as if X in A then ...) to have the generic Print procedure in package Test_Generics call the corresponding more specific Print procedures of the child objects?

with Ada.Text_IO;

procedure Test is

   type Object is
      abstract tagged limited null record;

   type A is
      limited new Object with null record;

   type B is
      limited new Object with null record;

   generic
      type T is abstract tagged limited private;
      with procedure Print (X : access T'Class);
   package Test_Generics is
      
      procedure Call_Print (X : access T'Class);

   end Test_Generics;

   package body Test_Generics is

      procedure Call_Print (X : access T'Class) is
      begin
         X.Print;
      end Call_Print;

   end Test_Generics;

   procedure Print (X : access Object'Class) is
   begin
      X.Print; -- dispatch procedure call to one of the next two
   end Print;

   procedure Print (X : access A) is
   begin
      Ada.Text_IO.Put_Line ("Print A");
   end Print;

   procedure Print (X : access B) is
   begin
      Ada.Text_IO.Put_Line ("Print B");
   end Print;

   package Impl is new Test_Generics (Object, Print);

   A1 : access A := new A;
   B1 : access B := new B;

begin
   Impl.Call_Print (A1);
end Test;

Error message

raised STORAGE_ERROR : test.adb:34 infinite recursion


Solution

  • You can’t dispatch without inheritance, and you can’t dispatch to an inherited subprogram without a subprogram to inherit from.

    Abstract subprograms need to be declared in a package, which can be inside your Test procedure:

       package Base is
          type Object is
            abstract tagged limited null record;
          procedure Print (X : Object) is abstract;
       end Base;
       use Base;
    

    Then, you want to derive a concrete type and the corresponding subprogram; right next to each other is best, to make sure that the Print is a "primitive subprogram" (in this context, one that can be dispatched to) of the type:

       type A is
          limited new Object with null record;
       procedure Print (X : A) is
       begin
          Ada.Text_IO.Put_Line ("Print A");
       end Print;
    

    You can tell the generic that there’s a Print, and it’s OK for it to be a dispatching subprogram:

       generic
          type T is abstract tagged limited private;
          with procedure Print (X : T) is abstract;
       package Test_Generics is
          procedure Call_Print (X : access T'Class);
       end Test_Generics;
    

    Remember, the instantiation has to be done with a concrete instance of Object, which has to have either its own Print or an inherited one.


    I hadn’t known that you could create a dispatching subprogram with only the body - I’d thought you needed a spec.

    That’s the first time I’ve written a generic with an abstract subprogram parameter.