I am having trouble getting dynamic dispatching to work, even with this simple example. I believe the problem is in how i have set up the types and methods, but cannot see where!
with Ada.Text_Io;
procedure Simple is
type Animal_T is abstract tagged null record;
type Cow_T is new Animal_T with record
Dairy : Boolean;
end record;
procedure Go_To_Vet (A : in out Cow_T) is
begin
Ada.Text_Io.Put_Line ("Cow");
end Go_To_Vet;
type Cat_T is new Animal_T with record
Fur : Boolean;
end record;
procedure Go_To_Vet (A : in out Cat_T)
is
begin
Ada.Text_Io.Put_Line ("Cat");
end Go_To_Vet;
A_Cat : Cat_T := (Animal_T with Fur => True);
A_Cow : Cow_T := (Animal_T with Dairy => False);
Aa : Animal_T'Class := A_Cat;
begin
Go_To_Vet (Aa); -- ERROR This doesn't dynamically dispatch!
end Simple;
In computer science, dynamic dispatch is the process of selecting which implementation of a polymorphic operation (method or function) to call at run time. It is commonly employed in, and considered a prime characteristic of, object-oriented programming (OOP) languages and systems.
Ada supports inheritance and polymorphism, providing the programmer some effective techniques and building blocks.
Unlike many other OOP languages, Ada differentiates between a reference to a specific tagged type, and a reference to an entire tagged type hierarchy. While Root is used to mean a specific type, Root'Class — a class-wide type — refers to either that type or any of its descendants.
Two things:
The first is that you have to have an abstract specification of Go_To_Vet, so that delegation can take place (this has caught me a couple times as well :-):
procedure Go_To_Vet (A : in out Animal_T) is abstract;
And the second is that Ada requires the parent definition be in its own package:
package Animal is
type Animal_T is abstract tagged null record;
procedure Go_To_Vet (A : in out Animal_T) is abstract;
end Animal;
The type definitions in your Simple procedure then need to be adjusted accordingly (here I just withed and used the Animal package to keep it simple):
with Ada.Text_Io;
with Animal; use Animal;
procedure Simple is
type Cow_T is new Animal_T with record
Dairy : Boolean;
end record;
procedure Go_To_Vet (A : in out Cow_T) is
begin
Ada.Text_Io.Put_Line ("Cow");
end Go_To_Vet;
type Cat_T is new Animal_T with record
Fur : Boolean;
end record;
procedure Go_To_Vet (A : in out Cat_T)
is
begin
Ada.Text_Io.Put_Line ("Cat");
end Go_To_Vet;
A_Cat : Cat_T := (Animal_T with Fur => True);
A_Cow : Cow_T := (Animal_T with Dairy => False);
Aa : Animal_T'Class := A_Cat;
begin
Go_To_Vet (Aa); -- ERROR This doesn't dynamically dispatch! DOES NOW!! :-)
end Simple;
Compiling:
[17] Marc say: gnatmake -gnat05 simple
gcc -c -gnat05 simple.adb
gcc -c -gnat05 animal.ads
gnatbind -x simple.ali
gnatlink simple.ali
And finally:
[18] Marc say: ./simple
Cat
how to assign A_Cow to Aa ? (Aa := A_Cow; complains!)
You can't and shouldn't. Although they share a common base class, they are two different types. By comparison to Java, an attempt to convert a cat to a cow would cause a ClassCastException
at run time. Ada precludes the problem at compile time, much as a Java generic declaration does.
I've expanded @Marc C's example to show how you can invoke base class subprograms. Note the use of prefixed notation in procedure Simple
.
Addendum: As you mention class wide programming, I should add a few points related to the example below. In particular, class wide operations, such as Get_Weight
and Set_Weight
, are not inherited, but the prefixed notation makes them available. Also, these subprograms are rather contrived, as the tagged record components are accessible directly, e.g. Tabby.Weight
.
package Animal is
type Animal_T is abstract tagged record
Weight : Integer := 0;
end record;
procedure Go_To_Vet (A : in out Animal_T) is abstract;
function Get_Weight (A : in Animal_T'Class) return Natural;
procedure Set_Weight (A : in out Animal_T'Class; W : in Natural);
end Animal;
package body Animal is
function Get_Weight (A : in Animal_T'Class) return Natural is
begin
return A.Weight;
end Get_Weight;
procedure Set_Weight (A : in out Animal_T'Class; W : in Natural) is
begin
A.Weight := W;
end Set_Weight;
end Animal;
with Ada.Text_IO; use Ada.Text_IO;
with Animal; use Animal;
procedure Simple is
type Cat_T is new Animal_T with record
Fur : Boolean;
end record;
procedure Go_To_Vet (A : in out Cat_T)
is
begin
Ada.Text_Io.Put_Line ("Cat");
end Go_To_Vet;
type Cow_T is new Animal_T with record
Dairy : Boolean;
end record;
procedure Go_To_Vet (A : in out Cow_T) is
begin
Ada.Text_Io.Put_Line ("Cow");
end Go_To_Vet;
A_Cat : Cat_T := (Weight => 5, Fur => True);
A_Cow : Cow_T := (Weight => 200, Dairy => False);
Tabby : Animal_T'Class := A_Cat;
Bossy : Animal_T'Class := A_Cow;
begin
Go_To_Vet (Tabby);
Put_Line (Tabby.Get_Weight'Img);
Go_To_Vet (Bossy);
Put_Line (Bossy.Get_Weight'Img);
-- feed Bossy
Bossy.Set_Weight (210);
Put_Line (Bossy.Get_Weight'Img);
end Simple;
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With