Re: Is the Writing on the Wall for Ada?

["Robert I. Eachus" <rieachus@attbi.com>]

Hyman Rosen wrote:
> "Robert I. Eachus" <rieachus@attbi.com> wrote in message news:<3F615341.4000100@attbi.com>...
> 
>>There is no way to directly inherit from two 
>>classes, unless one is a subclass of the other.
> 
> 
> I am well an truly puzzled at this remark.
> Let me give a C++ example, and you can tell me why you don't believe it.
> 
> struct Colorable
> {
>     virtual void setColor(int color) = 0;
>     virtual int getColor() = 0;
>     virtual ~Colorable() { }
> };
> struct ColorableAdapter : virtual Colorable
> {
>     void setColor(int color) { m_color = color; }
>     int getColor() { return m_color; }
>     ColorableAdapter(int color = 0) : m_color(color) { }
> private:
>     int m_color;
> };
> 
> struct Resizable
> {
>     virtual void setSize(double size) = 0;
>     virtual double getSize() = 0;
>     virtual ~Resizable() { }
> };
> struct ResizableAdapter : virtual Resizable
> {
>     void setSize(double size) { m_size = size; }
>     double getSize() { return m_size; }
>     ResizableAdapter(double size = 1) : m_size(size) { }
> private:
>     double m_size;
> };
> 
> struct MyObject : ColorableAdapter, ResizableAdapter
> {
>     MyObject(int color = 0, double size = 1)
>         : ColorableAdapter(color), ResizableAdapter(size)
>     { }
>     void doSomething();
> };

You inherit from two virtual classes, then use concrete mix-ins to 
implement the classes.  In Ada I would do this without the virtual clases:

with Ada.Text_IO; use Ada.Text_IO;
procedure Multiple is -- an example of multiple inheritance in Ada.

   type Color is new Integer; -- not normal Ada, but I am trying to
                              -- match the original example.
   generic
     type Object is tagged private;
   package Colors is
     type Colored_Object is new Object with private;
     procedure Set(Obj: in out Colored_Object; To: in Color := 0);
     function  Get(Obj: in Colored_Object) return Color;
   private
     type Colored_Object is new Object with record
       Color_Value: Color := 0;
     end record;
   end Colors;

   package body Colors is
     procedure Set(Obj: in out Colored_Object; To: in Color := 0) is
     begin Obj.Color_Value := To; end Set;

     function Get(Obj: in Colored_Object) return Color is
     begin return Obj.Color_Value; end Get;
   end Colors;

   type Size is new Long_Float; -- see comment above.

   generic
     type Object is tagged private;
   package Resize is
     type Resizeable_Object is new Object with private;
     procedure Set(Obj: in out Resizeable_Object; To: Size := 1.0);
     function  Get(Obj: in Resizeable_Object) return Size;
   private
     type Resizeable_Object is new Object with record
       Current_Size: Size := 1.0;
     end record;
   end Resize;

   package body Resize is
     procedure Set(Obj: in out Resizeable_Object; To: Size := 1.0) is
     begin Obj.Current_Size := To; end Set;

     function  Get(Obj: in Resizeable_Object) return Size is
     begin return Obj.Current_Size; end Get;
   end Resize;

   type Nothing is tagged null record;
   package My_Color is new Colors(Nothing);
   package My_Resize is new Resize(My_Color.Colored_Object);
   type Inherited is new My_Resize.Resizeable_Object with null record;
   -- all the MI magic occurs in these four lines  Nothing is the direct
   -- parent, there are two mix-ins, and the final type is just to make
   -- all the inherited operations visible without qualification.

   procedure Do_Something(Obj: in Inherited) is
     package Color_IO is new Integer_IO(Color);
     package Size_IO is new Float_IO(Size);
   begin
     Put(" Color is: ");
     Color_IO.Put(Get(Obj),1);
     Put(" Size is: ");
     Size_IO.Put(Get(Obj),1,2,0);
     New_Line;
   end Do_Something;

   MI: Inherited;

begin
   New_Line;
   Do_Something(MI);
   Set(MI, 42); -- Color.
   Set(MI, 9.43); -- Size.
   Do_Something(MI);
end Multiple;

I put this all in a single procedure to make it easy for anyone who 
wants to compile it.  The program goes to a lot of work to print a few 
lines, but it is an example of multiple inheritance using mix-ins in Ada.

E:\Ada\Misc>multiple
multiple

  Color is: 0 Size is: 1.00
  Color is: 42 Size is: 9.43

Notice that if Colors and Resize were library packages, they could be 
mixed in to any tagged type, including Controlled types.  I could have 
made the generic parameters limited so you could use them with limited 
types as well, but that was outside the bounds of the problem.

Incidently when you use mix-in style multiple inheritance in Ada, it is 
much more ususal for the stack of mix-ins to be in the private part of a 
package.  Then to use renaming to export only the operations that the 
author of the package thinks should be visible for the final type.  For 
example, if you built my example of Polar and Cartesian co-ordinates 
this way, you might export the Get functions directly, but implement 
only Set operations that take co-ordinate pairs, and immediately convert 
from Polar to Cartesian or vice-versa so that both sets of stored 
co-ordinates are always valid.  Or you might derive directly from a 
Cartesian type, mix-in the polar co-ordinates, and only compute the 
polor co-ordinates when necessary.  (So you would also need a valid bit.)

The real point is that multiple inheritance is alive and well in Ada 95. 
  We will probably add a second style of MI (interface inheritance) that 
will mix and match with the mix-in style seamlessly, and with one 
instance of direct inheritance.  Personally I prefer to use mix-ins, but 
there are some situations where interface inheritance is a better fit 
for the problem.

--
                                             Robert I. Eachus

"As far as I'm concerned, war always means failure." -- Jacques Chirac, 
President of France
"As far as France is concerned, you're right." -- Rush Limbaugh