What is the best way for implementing something similar to an interface with Ada 95?

Question

I want to implement something similar to an interface using Ada 95 (so the typical OO interfaces are not available). I've done it by using generics and a set of "pointer to method" within a record. The code is below.

EDIT: I know that it can be done by passing subprograms as formal parameters to the generic package, but I would like to avoid passing too many parameters to it.

I think that there must be a much better way for implementing what I want, so I would like if I'm right and, if so, I would like to see an example of code.

The "interface" is declared in a generic package called Drivers. There, there is a record which is meant to contain a variable of a generic type that represents the driver and a record which contains its operations:

drivers.ads

generic 
    type T is private;
    type Error is private;
    NOT_IMPLEMENTED_CODE : Error;

package Drivers is

    type Driver is private;

    -- Need to declare these types because I compile with Ada 95.
    type ToStringPtr is access function(self : in T) return String;
    type ReadLinePtr is access procedure(self : in T; buffer : out String; err : out Error);

    type DriverOps is
    record
        to_string_op : ToStringPtr := null;
        read_line_op : ReadLinePtr := null;
    end record;

    function create_driver(underlying : T; ops : DriverOps) return Driver;

    function to_string(self : in Driver) return String;

    procedure read_line(self : in Driver; buffer : out String; err : out Error);


    private
        type Driver is
        record
            underlying : T;
            ops : DriverOps;
        end record;

end Drivers;

drivers.adb

package body Drivers is

    function create_driver(underlying : T; ops : DriverOps) return Driver is
    begin
        return (underlying, ops);
    end create_driver;

    function to_string(self : in Driver) return String is
    begin
        if self.ops.to_string_op /= null then
            return self.ops.to_string_op(self.underlying);
        else
            return "";
        end if;
    end to_string;

    procedure read_line(self : in Driver; buffer : out String; err : out Error) is
    begin
        if self.ops.read_line_op /= null then
            self.ops.read_line_op(self.underlying, buffer, err);
        else
            err := NOT_IMPLEMENTED_CODE;
        end if;
    end read_line;

end Drivers;

main.adb

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Fixed; 

with Drivers;

procedure main is

    type Error is (SUCCESS, NOT_IMPLEMENTED, UNKNOWN);

    type MyInt is new Integer;

    function to_string(self : in MyInt) return String is
    begin
        return Integer'Image( Integer(self) ); --'
    end to_string;

    procedure read_line(self : in MyInt; buffer : out String; err : out Error) is
    begin
        Ada.Strings.Fixed.Move(
            Target => buffer,
            Source => "Lets suppose we have read this from a device" & ASCII.LF,
            Pad => ASCII.NUL); 
        err := SUCCESS;
    end read_line;


    package IntDrivers is new Drivers(MyInt, Error, NOT_IMPLEMENTED);
    use IntDrivers;


    underlying : MyInt := 25;

    int_driver_ops : DriverOps := (
        to_string_op => to_string'access, --'
        read_line_op => read_line'access  --'
    );

    my_driver : Driver := create_driver(underlying, int_driver_ops);
    buffer : String(1..256) := (others => Character'Val(0)); --'
    err : Error := SUCCESS;
begin
    Put_Line(to_string(my_driver));

    read_line(my_driver, buffer, err);
    Put(buffer);
    Put_Line(Error'Image(err)); --'
end main;

Answer 1

The only one I known of is described below, and may not be canonical. This is not strictly interface inheritance, but it can put you in the right direction. It requires to use a discriminant tagged record.

The trick is to define 2 tagged types. One is your classic class definition, the other is used as "interface" inheritance.

You can then manipulate an object that gives access to the interface contract and the class contract using discriminants. Declaring both in the same package should give you full visibility over private parts, to be confirmed.

In short :

type InterfaceX is abstract ....; -- abstract class and services

type ClassA is tagged ...; -- or is new ....
type Trick (component : ClassA) is new InterfaceX ...; -- this type gives you access to classA and interfaceX primitives

Trick object realizes your InterfaceX contract.

You will have to define instantiaton/accessors to either ClassA object or the Trick object. I think types should also be limited.

I always hear people call this "Rosen trick", guess it is named after J.-P. Rosen.

Maybe you will find some more precise answers here http://www.adaic.org/resources/add_content/standards/95rat/rat95html/rat95-p2-4.html#6

Answer 2

An interface is an abstract tagged null record in Ada 95:

package Abstract_Driver is

   type Instance is abstract tagged null record;
   subtype Class is Instance'Class; --' (defect syntax highlighter)

   function Image (Item : in Instance) return String is abstract;

   procedure Read_Line (Item   : in out Instance;
                        Buffer :    out String) is abstract;

end Abstract_Driver;

with Abstract_Driver;

package Text_IO_Driver is

   subtype Parent is Abstract_Driver.Instance;
   type Instance is new Parent with private;
   subtype Class is Instance'Class; --' (defect syntax highlighter)

   function Image (Item : in Instance) return String;

   Buffer_Too_Small : exception;

   procedure Read_Line (Item   : in out Instance;
                        Buffer :    out String);

private

   type Instance is new Parent with null record;

end Text_IO_Driver;

with Ada.Text_IO;

package body Text_IO_Driver is

   function Image (Item : in Instance) return String is
   begin
      return "Ada.Text_IO.Standard_Input";
   end Image;

   procedure Read_Line (Item   : in out Instance;
                        Buffer :    out String) is
      Last : Natural;
   begin
      Buffer := (Buffer'Range => ' '); --' (defect syntax highlighter)
      Ada.Text_IO.Get_Line (Item => Buffer,
                            Last => Last);
      if Last = Buffer'Last then --' (defect syntax highlighter)
         raise Buffer_Too_Small;
      end if;
   end Read_Line;

end Text_IO_Driver;