How can I get this dispatching call to work?

Question

I am trying to familiarize myself with object orientation In Ada. Your site helped me with another O-O problem a couple of months ago and I hope that you will be willing to help again.

The situation: I have an abstract type “token” and 2 derived types “otoken” and “vtoken”. I want to put the 2 derived types in the same array and get them to dispatch properly.

My textbook recommended declaring the array as containing pointers to token’class, which forces me to work through points throughout. A stripped-down version of my program is below, but it won’t compile because the compiler says my dispatch calls are “ambiguous”

---------------------------------------------------------------------------------

--------------------------------------------
-- Tokensamp.ads
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Command_Line; use Ada.Command_Line;
package tokensamp is
    type token is abstract tagged record
    x: integer;
    end record;
    type otoken is new token with record
    y: integer;
    end record;
    type vtoken is new token with record
    z: integer;
    end record;

    type potoken is access otoken;
    type pvtoken is access vtoken;

end tokensamp;
------------------------------------------------------------------------------------------------------
-- Parsesamp.ads:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Command_Line; use Ada.Command_Line;
with tokensamp; 
package parsesamp is
    function rootOfTree( t: tokensamp.pvtoken) return integer;
    function rootOfTree( t: tokensamp.potoken) return integer;  
end parsesamp; 
-------------------------------------------
-- parsesamp.adb:
package body parsesamp is 
    function rootOfTree( t: tokensamp.pvtoken) return integer  is
    begin
       return   t.z * 2;
    end rootOfTree;

    function rootOfTree( t: tokensamp.potoken) return integer is
    begin
        return  t.y * 2;
    end rootOfTree;
    result: integer;
    type tarray is array (1..2) of access tokensamp.token'class ;
    tl: tarray;
begin
    for i in 1..2 loop
    result := rootOfTree(  tl(i) );
    end loop;

end parsesamp;
-------------------------------------------------------------

---

When I compile this with my GNAT Ada 95 compiler, I get the error messages:

C:\GNAT\2018\bin\ceblang>gnatmake   parsesamp.adb
gcc -c parsesamp.adb
parsesamp.adb:25:27: ambiguous expression (cannot resolve "rootOfTree")
parsesamp.adb:25:27: possible interpretation at parsesamp.ads:9
parsesamp.adb:25:27: possible interpretation at parsesamp.ads:8
gnatmake: "parsesamp.adb" compilation error

In other words, it’s failing to recognize the two functions as alternative dispatched calls. I’d be grateful if you could advise me as I’ve been stuck on this for several days.

Answer 1

For a start, you need to declare rootOfTree as an abstract operation of token:

type token is abstract tagged record
   x: integer;
end record;
function rootOfTree( t: tokensamp.token) return Integer is abstract;

(the primitive operation has to be declared before token is frozen, basically before any use is made of it as in declaring derived types).

Then declare the primitive operations of otoken and vtoken; they have to be declared in the same package as their corresponding type to be primitive, i.e. to be dispatchable to.

type otoken is new token with record
   y: integer;
end record;

type vtoken is new token with record
   z: integer;
end record;

function rootOfTree( t: tokensamp.vtoken) return integer;
function rootOfTree( t: tokensamp.otoken) return integer;

(it'd be more normal to declare each immediately after its parameter type, but since neither freezes the other this is OK).

Note that none of the rootOfTree operations take an access type parameter.

You don't need potoken, pvtoken, though you might consider declaring the class-wide pointer here:

type ptoken is access token'class;

You then need to declare a body for package tokensamp, containing the implementations of the two concrete rootOfTrees.

Considering parsesamp, you mustn't declare either rootOfTree here.

You could either write

result := tokensamp.rootOfTree (t1(i).all);

(t1(i) is a pointer-to-classwide, .all is a classwide value, and tokensamp.rootOfTree is a dispatchable operation, so this is a dispatching call)

.. or you could use the much prettier shorthand

result := t1(i).rootOfTree;

Answer 2

As an addendum to answers given by Jim Rogers and Simon Wright, if you would use Ada 2012, then you might consider using an indefinite holder to construct your array (see also RM A.18.18 and the Ada 2012 Rationale, section 8.5)

As stated in the rationale, a holder is a container that can hold (and manage) a single instance of an object. The object, when passed as an argument to the To_Holder subprogram (see example below), is copied into a heap instance, which in turn is destroyed when no longer needed (e.g. when it is replaced or when the holder goes out-of-scope). Hence, a holder container relieves you from managing memory manually as you would when using access types directly.

The (performance) cost is that the object passed to the To_Holder program is copied. You can "move" objects between holders (using the Move subprogram defined in the holder package), but you cannot "move" an object into a holder; you can only copy it into a holder.

token.ads (spec)

package Tokens is

   --  Abstract Root Type.

   type Token is abstract tagged private;   
   function Root_Of_Tree (T : Token) return Integer is abstract;

   --  First derived type.

   type OToken is new Token with private;         
   function Root_Of_Tree (T : OToken) return Integer;   
   function Create_OToken (X, Y : Integer) return OToken;

   --  Second derived type.

   type VToken is new Token with private;   
   function Root_Of_Tree (T : VToken) return Integer;   
   function Create_VToken (X, Z : Integer) return VToken;

private

   type Token is abstract tagged record
      X : Integer;
   end record;

   type OToken is new Token with record
      Y : Integer;
   end record;

   type VToken is new Token with record
      Z : Integer;
   end record;

end Tokens;

tokens.adb (body)

package body Tokens is   

   function Root_Of_Tree (T : OToken) return Integer is
   begin
      return T.X + 2 * T.Y;
   end Root_Of_Tree;   

   function Create_OToken (X, Y : Integer) return OToken is
   begin
      return OToken'(X, Y);
   end Create_OToken;   

   function Root_Of_Tree (T : VToken) return Integer is
   begin
      return T.X + 3 * T.Z;
   end Root_Of_Tree;

   function Create_VToken (X, Z : Integer) return VToken is
   begin
      return VToken'(X, Z);
   end Create_VToken;

end Tokens;

main.adb

with Ada.Text_IO; use Ada.Text_IO;
with Tokens;      use Tokens;

with Ada.Containers.Indefinite_Holders;

procedure Main is

   package Token_Holder is
     new Ada.Containers.Indefinite_Holders (Token'Class);
   use Token_Holder;

   type Token_Array is array (Integer range <>) of Holder;


   Tokens : Token_Array :=
     (To_Holder (Create_OToken (1, 2)),
      To_Holder (Create_OToken (5, 4)),
      To_Holder (Create_VToken (1, 2)),
      To_Holder (Create_VToken (5, 4)));

begin

   for T of Tokens loop
      Put_Line (Integer'Image (T.Element.Root_Of_Tree));
   end loop;

end Main;

Running valgrind shows that no memory is left allocated when the program has terminated:

$ valgrind ./main
==1392== Memcheck, a memory error detector
==1392== Copyright (C) 2002-2015, and GNU GPL'd, by Julian Seward et al.
==1392== Using Valgrind-3.12.0.SVN and LibVEX; rerun with -h for copyright info
==1392== Command: ./main
==1392== 
 5
 13
 7
 17
==1392== 
==1392== HEAP SUMMARY:
==1392==     in use at exit: 0 bytes in 0 blocks
==1392==   total heap usage: 8 allocs, 8 frees, 160 bytes allocated
==1392== 
==1392== All heap blocks were freed -- no leaks are possible
==1392== 
==1392== For counts of detected and suppressed errors, rerun with: -v
==1392== ERROR SUMMARY: 0 errors from 0 contexts (suppressed: 0 from 0)

Note [updated]: There are 8 allocations while the array contains only 4 elements/holders. This is because of how the holder is implemented for platforms that support atomic increment/decrements (e.g. Linux). For these platforms, the implementation creates another "shared holder" internally such to support a copy-on-write strategy (see source). For platforms that do not support atomic increment/decrements, the implementation will be more simple (see source) and only 4 allocations will be shown.

Answer 3

Your confusion appears to include both the use of packages and the way dispatching operations are defined in Ada. Dispatching operations must be define in the same package defining the tagged data type, but before any other types are defined.

package Tokens is
   type token is tagged private;
   function Root_Of_Tree(T : Token) return Integer;
   type Token_Access is access all Token'Class;
   type Token_Array is array (Positive range <>) of Token_Access;
private
   type Token is tagged record
      X : Integer := 1;
   end record;
end Tokens;

The package specification defines the tagged type Token and its dispatching operation Root_Of_Tree. The record type Token contains one integer data element named X. The body of the package is:

    package body Tokens is

       ------------------
       -- Root_Of_Tree --
       ------------------

       function Root_Of_Tree (T : Token) return Integer is
       begin
          return T.X;
       end Root_Of_Tree;

    end Tokens;

I have used child packages to define the Otoken and Vtoken types.

package Tokens.OTokens is
   type Otoken is new Token with private;
   function Root_Of_Tree(T : Otoken) return Integer;
private
   type Otoken is new Token with record
      Y : Integer := 2;
   end record;

end Tokens.OTokens;

The body of Tokens.OTokens is:

package body Tokens.OTokens is

   ------------------
   -- Root_Of_Tree --
   ------------------

   function Root_Of_Tree (T : Otoken) return Integer is
   begin
      return T.Y * 2;
   end Root_Of_Tree;

end Tokens.OTokens;

The Specification of Tokens.VTokens is:

package tokens.vtokens is
   type vtoken is new token with private;
   function Root_Of_Tree(T : vtoken) return Integer;
private
   type vtoken is new token with record
      Z : Integer := 3;
   end record;

end tokens.vtokens;

The body Tokens.Vtokens is:

package body tokens.vtokens is

   ------------------
   -- Root_Of_Tree --
   ------------------

   function Root_Of_Tree (T : vtoken) return Integer is
   begin
      return T.Z * 2;
   end Root_Of_Tree;

end tokens.vtokens;

A main procedure to create an array containing one otoken and one vtoken is:

with Ada.Text_IO; use Ada.Text_Io;
with Tokens; use Tokens;
with Tokens.OTokens; use Tokens.OTokens;
with tokens.vtokens; use tokens.vtokens;

procedure Main is
   Ot : token_Access := new Otoken;
   Vt : token_access := new vtoken;
   Ta : Token_Array := (Ot, Vt);
begin
   for tk of Ta loop
      Put_Line(Integer'Image(Root_of_Tree(tk.all)));
   end loop;
end Main;

It is good to remember that the type OToken contains two fields, X and Y. The type VToken contains two fields X and Z. The output of the main procedure is:

4
6