Proposal for doing interfaces (and MI) in Ada95

Proposal for doing interfaces (and MI) in Ada95

[Corey Minyard]

I have been playing around with an idea for doing interfaces and
possible something closer to true MI than Ada95 currently supports.
Some of the idea is stolen from Java stuff, since I believe that
interfaces are a very useful language feature for implementing
flexible frameworks.  I am looking for criticisms and opinions from
more knowledgeable people than myself.

Anyway, my idea involves implementing an "Object" base class that
everything descends from (actually two baseclasses, one for normal
objects and one for limited objects).  The baseclass has functions for
casting that are polymorphic.  The baseclass might look something
like:

------------------------------------------------------------------------
with Ada.Finalization;
with Ada.Tags;

package Baseclass is

   type Object is abstract new Ada.Finalization.Controlled with private;
   type Object_Class is access all Object'Class;
   type Object_Ptr is access all Object;

   function Cast (To_Cast  : access Object;
		  New_Type : in Ada.Tags.Tag)
		  return Object_Class;

   function To_String (To_Convert : access Object)
		       return String;

   type Limited_Object is abstract new Ada.Finalization.Controlled
     with private;
   type Limited_Object_Class is access all Limited_Object'Class;
   type Limited_Object_Ptr is access all Limited_Object;

   function Cast (To_Cast  : access Limited_Object;
		  New_Type : in Ada.Tags.Tag)
		  return Limited_Object_Class;

   function To_String (To_Convert : access Limited_Object)
		       return String;

private

   type Object is abstract new Ada.Finalization.Controlled with null record;

   type Limited_Object is abstract new Ada.Finalization.Controlled
     with null record;

end Baseclass;

package body Baseclass is

   function Cast (To_Cast  : access Object;
		  New_Type : in Ada.Tags.Tag)
		  return Object_Class is
   begin
      return Object_Class(To_Cast);
   end Cast;

   function To_String (To_Convert : access Object)
		       return String is
   begin
      return "No String";
   end To_String;

   function Cast (To_Cast  : access Limited_Object;
		  New_Type : in Ada.Tags.Tag)
		  return Limited_Object_Class is
   begin
      return Limited_Object_Class(To_Cast);
   end Cast;

   function To_String (To_Convert : access Limited_Object)
		       return String is
   begin
      return "No String";
   end To_String;

end Baseclass;
------------------------------------------------------------------------

Then, a descendent class that wanted to implement an interface or
subclass two classes could do something like:

------------------------------------------------------------------------
with Baseclass; use Baseclass;
with Intf1; use Intf1;
with Ada.Tags;
with Unchecked_Deallocation;

package Impl1 is

   type I1 is new Object with private;
   subtype I1_Parent is Object_Ptr;
   type I1_Class is access all I1'Class;
   type I1_Ptr is access all I1;

   procedure P1 (A : access I1);

   procedure Free (A : in out I1_Class);

private

   type I1_F1 is new F1 with record
      I1_O : I1_Ptr;
   end record;
   subtype I1_F1_Parent is F1_Ptr;
   type I1_F1_Ptr is access all I1_F1;

   procedure P1 (A : access I1_F1);

   function P2 (A : access I1_F1) return String;

   function Cast (To_Cast  : access I1_F1;
		  New_Type : in Ada.Tags.Tag)
		  return Object_Class;

   type I1 is new Object with record
      I1_F1_O : I1_F1_Ptr;
   end record;

   function Cast (To_Cast  : access I1;
		  New_Type : in Ada.Tags.Tag)
		  return Object_Class;

   procedure Initialize (Object : in out I1);

   procedure Finalize (Object : in out I1);

   procedure Free is new Unchecked_Deallocation(I1, I1_Ptr);

end Impl1;

with Ada.Tags; use Ada.Tags;

package body Impl1 is

   procedure Free is new Unchecked_Deallocation(I1_F1,
						I1_F1_Ptr);

   procedure Free (A : in out I1_Class) is
      P : I1_Ptr;
   begin
      P := I1_Ptr(A);
      Free(P);
      A := null;
   end Free;

   function Cast (To_Cast  : access I1_F1;
		  New_Type : in Ada.Tags.Tag)
		  return Object_Class is
   begin
      if (New_Type = I1'Tag) then
	 return Object_Class(To_Cast.I1_O);
      else
	 return Cast(I1_F1_Parent(To_Cast), New_Type);
      end if;
   end Cast;

   procedure P1 (A : access I1_F1) is
   begin
      null;
   end P1;

   function P2 (A : access I1_F1) return String is
   begin
      return "P2: I1_F1";
   end P2;

   function Cast (To_Cast  : access I1;
		  New_Type : in Ada.Tags.Tag)
		  return Object_Class is
   begin
      if (New_Type = F1'Tag) then
	 return Object_Class(To_Cast.I1_F1_O);
      else
	 return Cast(I1_Parent(To_Cast), New_Type);
      end if;
   end Cast;

   procedure P1 (A : access I1) is
   begin
      null;
   end P1;

   procedure Initialize (Object : in out I1) is
   begin
      Initialize(Baseclass.Object(Object));
      Object.I1_F1_O := new I1_F1;
      Object.I1_F1_O.I1_O := Object'Unchecked_Access;
   end Initialize;

   procedure Finalize (Object : in out I1) is
   begin
      Finalize(Baseclass.Object(Object));
      Free(Object.I1_F1_O);
   end Finalize;

end Impl1;
------------------------------------------------------------------------

Then, to cast between the object (I1) and the interface (F1), the code
would be:

   F1_Interface := Intf1.F1_Class(Cast(I1_Object, F1'Tag));

Since Ada lets you take a tag and treat it like a data value, this is
possible in Ada.  This lets you do things you can't do in other
languages, such as return something with the same tag as this object,
but I'm not sure how useful that would be.

Also, having everything a descendent of one base class is handy for
doing some types of genericity, although Ada's powerful genericity
mechanisms mostly negate this.

Anyway, does anyone have any comments on this idea?  Is it unique, or
has someone else already proposed it and it has failed.  I have read
the Rationale's explanation of MI, but I don't completely understand
it and I may have some overlap with it.

I have a few criticisms of my own of the idea, including:

  - Having two base classes (one for normal and one for limited object)
    is rather clumsy.  In what is shown above, casts between limited
    and non-limited objects are not allowed.  Should they be?  How?
    Maybe everything should be limited.

  - Should they be controlled types?  I think yes.  Two more base
    classes could be provided, that were not controlled, but that
    would make things even more convoluted.

  - There is no way to tell if a tag is a parent class of an object
    so only strict tag checking (this is one of these) can be done,
    You can't say if this is a descendent of the tag, then return
    it.  Or maybe you can, but I couldn't find it in the RM.

  - The mechanism is a little clunky, but it is really not too bad,
    especially considering that it doesn't affect objects that don't
    use it.

I would have been really nice if Ada95 provided a way to override the
cast operator.  Also, a way to tell if a tag is a descendent of another
tag would be nice for this.  Maybe in Ada05 :-).

Thanks for any input.

-- 
Corey Minyard               Internet:  minyard@acm.org
  Work: minyard@nortel.ca       UUCP:  minyard@wf-rch.cirr.com