Object-Oriented Programming

Primitives

Todo

Complete section!

Overriding indicators

Relevant topics

  • Briefly discuss overriding and not overriding mentioned in Overriding Indicators

  • Mention that not overriding is not recommended.

Todo

Complete section!

Abstract types and subprograms

Todo

Complete section!

Interfaces

Todo

Complete section!

Null records vs. interfaces

Earlier on in the course, we discussed how to use null records to create a prototype. We could also consider using interfaces instead. However, as we've just learned, the consequences are that:

  • we can only create an API for the package specification, but we cannot use that interface type in an application in the same way as we do with null records;

  • we're forced to use object-oriented programming — which, depending on our goal, might be more complex than actually needed.

Let's revisit a previous example from the section on null records:

package Devices is type Device is private; function Create (Active : Boolean) return Device; procedure Reset (D : out Device) is null; procedure Process (D : in out Device) is null; procedure Activate (D : in out Device) is null; procedure Deactivate (D : in out Device) is null; private type Device is null record; function Create (Active : Boolean) return Device is (null record); end Devices;

We can easily rewrite this specification using interfaces:

package Devices is type Device is interface; function Create (Active : Boolean) return Device is abstract; procedure Reset (D : out Device) is null; procedure Process (D : in out Device) is null; procedure Activate (D : in out Device) is null; procedure Deactivate (D : in out Device) is null; end Devices;

These are the only changes we made:

  • Device is now an interface, and

  • Create is now an abstract function.

Keep in mind, however, that a null record isn't an abstract type, even though it looks abstract (as it doesn't store any information). This contrasts with interfaces, which are abstract and therefore more restricted. For example, as indicated above, we cannot use the interface from the Devices package in an application, as we cannot declare objects of an abstract type. The following application — which works fine when Device is a null record — doesn't compile when Device is an interface:

with Devices; use Devices; procedure Show_Device is A : Device; begin A := Create (Active => True); Process (A); Deactivate (A); Activate (A); Reset (A); end Show_Device;

A possible compromise is, of course, to reintroduce null records in our specification as a derived type. For example:

package Devices is type Abstract_Device is interface; function Create (Active : Boolean) return Abstract_Device is abstract; procedure Reset (D : out Abstract_Device) is null; procedure Process (D : in out Abstract_Device) is null; procedure Activate (D : in out Abstract_Device) is null; procedure Deactivate (D : in out Abstract_Device) is null; type Device is new Abstract_Device with private; private type Device is new Abstract_Device with null record; function Create (Active : Boolean) return Device is (null record); end Devices;
with Devices; use Devices; procedure Show_Device is A : Device; begin A := Create (Active => True); Process (A); Deactivate (A); Activate (A); Reset (A); end Show_Device;

Now, our interface was renamed to Abstract_Device and we're just using it to specify our API. We derive the Device from this interface type (Abstract_Device) as a null record. In a prototype — such as the Show_Device procedure — we can use the null record as expected.

Example: Extending Interfaces

Note

This section was originally written by Quentin Ochem and published as Gem #48: Extending Interfaces in Ada 2005.

Using new interfaces

Let's assume we have the following interface:

package Animals is type Animal is interface; procedure Eat (Beast : in out Animal) is abstract; end Animals;

All types implementing the Animal interface have to override the Eat operation:

package Animals.Cats is type Cat is new Animal with null record; procedure Eat (Beast : in out Cat); end Animals.Cats;
package body Animals.Cats is procedure Eat (Beast : in out Cat) is begin -- no implementation yet null; end Eat; end Animals.Cats;
with Animals.Cats; use Animals.Cats; procedure Show_Cat is C : Cat; begin C.Eat; end Show_Cat;

Now, after a while, the developer of Animal might feel the need to let animals eat something specific, and would like to add the following operation to the interface:

procedure Eat (Beast : in out Animal;
               Thing : in out A_Thing);

Unfortunately, there are hundreds of species of animals implementing this interface, and having to migrate everything will be too painful. Not to mention that most of them don't even need this new way of eating --- they're just happy eating some random amount of anonymous food. Extending this interface is just not the way to go --- so the extension has to be done separately, in a new interface, such as:

package Animals.Extensions is type Animal_Extension_1 is interface; type A_Thing is null record; -- no implementation yet procedure Eat (Beast : in out Animal_Extension_1; Thing : in out A_Thing) is abstract; end Animals.Extensions;

So now, Animals that need to rely on this new way of eating will need to be declared, such as:

with Animals.Extensions; use Animals.Extensions; package Animals.Cats is type Cat is new Animal and Animal_Extension_1 with null record; procedure Eat (Beast : in out Cat); procedure Eat (Beast : in out Cat; Thing : in out A_Thing); end Animals.Cats;
package body Animals.Cats is procedure Eat (Beast : in out Cat) is begin -- no implementation yet null; end Eat; procedure Eat (Beast : in out Cat; Thing : in out A_Thing) is begin -- no implementation yet null; end Eat; end Animals.Cats;
with Animals.Cats; use Animals.Cats; with Animals.Extensions; use Animals.Extensions; procedure Show_Cat is C : Cat; T : A_Thing; begin C.Eat (T); end Show_Cat;

Note that it's even possible to enforce the fact that an extension of Animal has to be an Animal in the first place, by writing:

type Animal_Extension_1 is interface and Animal;

which will lead to a simpler declaration for type Cat, as there's no longer a need to extend from two interfaces:

type Cat is new Animal_Extension_1 with null record;

The rest of the code will remain completely untouched thanks to this change. Calls to the new subprogram will require some additional amount of work though, as we'll first have to check that the type of an Animal that we're dealing with is indeed a descendant of Animal_Extension_1, and perform a conversion to that interface's class, before calling the new version of Eat:

with Animals; use Animals; with Animals.Cats; use Animals.Cats; with Animals.Extensions; use Animals.Extensions; procedure Show_Animal_Eat is C : Cat; T : A_Thing; A : Animal'Class := C; begin if A in Animal_Extension_1'Class then Animal_Extension_1'Class (A).Eat (T); end if; end Show_Animal_Eat;

Using null procedures

Since Ada 2005, we have the notion of null procedures. As discussed previously, a null procedure is a procedure that is declared using is null and logically has an empty body. Fortunately, null procedures are allowed in interface definitions — they define the default behavior of such a subprogram as doing nothing. Back to the Animal example, the programmer can declare the interface's Eat primitive as follows:

procedure Eat (Beast : in out Animal;
               Thing : in out A_Thing) is null;

This is adapted code:

package Animals is type Animal is interface; type A_Thing is null record; -- no implementation yet procedure Eat (Beast : in out Animal) is abstract; procedure Eat (Beast : in out Animal; Thing : in out A_Thing) is abstract; end Animals;
package Animals.Cats is type Cat is new Animal with null record; procedure Eat (Beast : in out Cat); procedure Eat (Beast : in out Cat; Thing : in out A_Thing); end Animals.Cats;
package body Animals.Cats is procedure Eat (Beast : in out Cat) is begin -- no implementation yet null; end Eat; procedure Eat (Beast : in out Cat; Thing : in out A_Thing) is begin -- no implementation yet null; end Eat; end Animals.Cats;

All of our hundreds of kinds of animals will automatically inherit from this procedure, but won't have to implement it. The addition of this declaration does not break source compatibility with the contract of the Animal interface. Moreover, as no new types are involved, it's a lot easier to make calls to this subprogram --- no more need to check membership or write a type conversion, and we can just write:

with Animals; use Animals; with Animals.Cats; use Animals.Cats; procedure Show_Animal_Eat is C : Cat; T : A_Thing; A : Animal'Class := C; begin A.Eat (T); end Show_Animal_Eat;

which will execute as a no-op except for animals that have explicitly overridden the primitive.

Calling inherited subprograms

Note

This section was originally written by Emmanuel Briot and published as blog post Calling inherited subprograms in Ada.

In object-oriented code, it is often the case that we need to call inherited subprograms. Some programing languages make it very easy by introducing a new keyword super (although this approach has its limits for languages that allow multiple inheritance of implementation).

In Ada, things are slightly more complicated. Let's take an example, using the traditional geometric classes that are often found in text books:

package Geometric_Forms is type Polygon is tagged private; procedure Initialize (Self : in out Polygon); type Square is new Polygon with private; overriding procedure Initialize (Self : in out Square); private type Polygon is tagged null record; type Square is new Polygon with null record; end Geometric_Forms;

Let's assume now that Square's Initialize needs to call Polygon's Initialize, in addition to doing a number of square specific setups. To do this, we need to use type conversions to change the view of Self, so that the compiler statically knows which Initialize to call. The code thus looks like:

package body Geometric_Forms is procedure Initialize (Self : in out Polygon) is begin null; end Initialize; overriding procedure Initialize (Self : in out Square) is begin Initialize (Polygon (Self)); -- calling inherited procedure -- ... square-specific setups end Initialize; end Geometric_Forms;
with Geometric_Forms; use Geometric_Forms; procedure Show_Geometric_Forms is S : Square; begin S.Initialize; end Show_Geometric_Forms;

The main issue with this code (apart from its relative lack of readability) is the need to hard-code the name of the ancestor class. If we suddenly realize that a Square is after all a special case of a Rectangle, and thus decide to add the new rectangle class, the code needs to be changed (and not just in the spec), as in:

package Geometric_Forms is type Polygon is tagged private; procedure Initialize (Self : in out Polygon); type Rectangle is new Polygon with private; -- NEW overriding procedure Initialize (Self : in out Rectangle); -- NEW type Square is new Rectangle with private; -- MODIFIED overriding procedure Initialize (Self : in out Square); private type Polygon is tagged null record; type Rectangle is new Polygon with null record; type Square is new Rectangle with null record; end Geometric_Forms;
package body Geometric_Forms is procedure Initialize (Self : in out Polygon) is begin null; end Initialize; overriding procedure Initialize (Self : in out Rectangle) is begin Initialize (Polygon (Self)); -- calling inherited procedure -- ... rectangle-specific setups end Initialize; procedure Initialize (Self : in out Square) is begin Initialize (Rectangle (Self)); -- MODIFIED -- ... square-specific setups end Initialize; end Geometric_Forms;
with Geometric_Forms; use Geometric_Forms; procedure Show_Geometric_Forms is S : Square; begin S.Initialize; end Show_Geometric_Forms;

The last change --- in the implementation of the Initialize procedure of the Square type --- is easy to forget when one modifies the inheritance tree, and its omission would result in not initializing the Rectangle specific data.

Let's look into how the code should best be organized to limit the risks here. An interesting idiom is the one that makes use of parent subtypes. The trick is to always define a Parent subtype every time one extends a type, and use that subtype when calling the inherited procedure. Here is a full example:

package Geo_Forms with Pure is end Geo_Forms;
package Geo_Forms.Polygons is type Polygon is tagged private; procedure Initialize (Self : in out Polygon); private type Polygon is tagged null record; end Geo_Forms.Polygons;
with Geo_Forms.Polygons; package Geo_Forms.Rectangles is subtype Parent is Geo_Forms.Polygons.Polygon; type Rectangle is new Parent with private; overriding procedure Initialize (Self : in out Rectangle); private type Rectangle is new Parent with null record; end Geo_Forms.Rectangles;
with Geo_Forms.Rectangles; package Geo_Forms.Squares is subtype Parent is Geo_Forms.Rectangles.Rectangle; type Square is new Parent with private; overriding procedure Initialize (Self : in out Square); private type Square is new Parent with null record; end Geo_Forms.Squares;
with Ada.Text_IO; use Ada.Text_IO; package body Geo_Forms.Polygons is procedure Initialize (Self : in out Polygon) is begin Put_Line ("Initializing Polygon type..."); end Initialize; end Geo_Forms.Polygons;
with Ada.Text_IO; use Ada.Text_IO; with Geo_Forms.Polygons; use Geo_Forms.Polygons; package body Geo_Forms.Rectangles is overriding procedure Initialize (Self : in out Rectangle) is begin Initialize (Parent (Self)); -- ... rectangle-specific setups Put_Line ("Initializing Rectangle type..."); end Initialize; end Geo_Forms.Rectangles;
with Ada.Text_IO; use Ada.Text_IO; with Geo_Forms.Rectangles; use Geo_Forms.Rectangles; package body Geo_Forms.Squares is procedure Initialize (Self : in out Square) is begin Initialize (Parent (Self)); -- ... square-specific setups Put_Line ("Initializing Square type..."); end Initialize; end Geo_Forms.Squares;
with Ada.Text_IO; use Ada.Text_IO; with Geo_Forms.Squares; use Geo_Forms.Squares; procedure Show_Geo_Forms is S : Square; begin Put_Line ("Initialize Square object:"); S.Initialize; end Show_Geo_Forms;

Now, if we want to add an extra Parallelogram class between Polygon and Rectangle, we just need to change the definition of the Parent subtype in the Rectangles package, and no change is needed for the body.

This is not a new syntax nor a new idiom, but is worth considering it when one is developing a complex hierarchy of types, or at least a hierarchy that is likely to change regularly in the future.

Dynamic Polymorphism

Todo

Complete section!

Controlled types

Todo

Complete section!

Ada.Tags package

Todo

Complete section!