Re: Ada OO Mechanism

["Robert I. Eachus" <eachus@mitre.org>]

Hyman Rosen wrote:
 
> > 2) It therefore CANNOT be made virtual so you can't dispatch on it.
> 
> So you mean in Ada, I can write a dot(a,b) which will dispatch on
> either a or b? I wasn't aware that this was the case.

    Technically you can't, but in practice you can.  Ada allows both
classwide and dispatching parameters.  Multiple dispatching is done by
having a visible operation which is classwide for one or more
parameters, then sorting out the cases and dispatching on the second
parameter.  Huh?  Maybe this does take an example.  Let's say that we
need a matrix package that allows multiple representations of matrices. 
Some specialized to save storage such as identity matrices, tridiagonal
matrices, etc. and some representations which simplify further
operations while representing arbtrary matrices:  scaled matrices, LUP
decomposition, basis representation, etc.   In Ada, I create a package
which provides the basic operations of the type:

with Ada.Finalization;
package Matrices is

   type Matrix(X,Y: Integer := 0) is abstract tagged private;
   -- X and Y provide the bounds, the defualt value is to allow
different       -- sized values to be assigned to objects.
 
   function Create_Zero_Matrix (X,Y: Integer) return Matrix;
   procedure Set_Element(M: in out Matrix; X,Y: in Integer; To: Float);
 
   function "*" (L,R: Matrix'Class) return Matrix'Class;
   function "+" (L,R: Matrix'Class) return Matrix'Class;
   function "-" (L,R: Matrix'Class) return Matrix'Class;
   -- etc...

private
   ...
   type Matrix(X,Y: Integer := 0) is new Ada.Finalization.Controlled
            with null record;
   -- No data in abstract base type.
   function Multiply1(L: Matrix; R: Matrix'Class) return Matrix'Class;
   function Multiply2(L,R: Matrix) return Matrix'Class;
   function To_Standard_Rep(From: Matrix) return Matrix'Class;
   -- etc...
end Matrices;

-- Now we need some Child packages that declare the various actual --
representation.  Let's start with the unrestricted standard --
representation.

package Matrices.Standard is

   type Standard_Matrix is new Matrices.Matrix with private;

private
 
   procedure Adjust(Object: in out Standard_Matrix);
   procedure Finalize(Object: in out Standard_Matrix);
   -- overrides for the Controlled operations. 
   type Data_Array is array (Integer range <>, Integer range <>) of
Float;
   type Data_Pointer is access all Data;
   type Standard_Matrix is new Matrices.Matrix with record
     Data: Data_Pointer := new Data_Array'(1..X =>(1..Y => 0.0));
   end record;
   function Multiply1(L: Standard_Matrix; R: Matrix'Class)
        return Matrix'Class;
   function Multiply2(L,R: Standard_Matrix)
        return Matrix'Class;
   function ToStandard_Rep(From: Matrix) return Matrix'Class;
  
end Matrices.Standard;

-- Let's have at least two children...

package Matrices.Identity is

   type Identity_Matrix is new Matrices.Matrix with private;

   function Create_Identity_Matrix (Size: Integer) return
Identity_Matrix;

   function Create_Zero_Matrix (Size: Integer) return Identity_Matrix;

private
 
   procedure Initialize(Object: in out Identity_Matrix);
   -- Since there is no data we don't need a Adjust and Finalize,
   -- but I want to check that X = Y in Initialize.
 
   type Identity_Matrix is new Matrices.Matrix with null record;

   function Multiply1(L: Identity_Matrix; R: Matrix'Class)
        return Matrix'Class;
   function Multiply2(L,R: Identity_Matrix)
        return Matrix'Class;
   function To_Standard_Rep(From: Identity_Matrix) return Matrix'Class;
   ...

end Matrices.Identity;

-- might as well do the body for this one...

with Matrices.Standard;
package body Matrices.Identity is

    function Create_Identity_Matrix return Identity_Matrix is
       Result: Identity_Matrix(X,Y);
    begin return Result; end Create_Identity_Matrix;

    function Initialize(Object: in out Identity_Matrix) is
    begin if X /= Y then raise Constraint_Error; end Initialize;

     function Multipy1(L: Identity_Matrix; R: Matrix'Class)
          return Matrix'Class is
     begin return R; end Multiply1;

     function Multiply2(L,R: Identity_Matrix) return Matrix'Class is
     begin return R; end Multiply2;

     function To_Standard_Rep(From: Identity_Matrix) return Matrix'Class
is
        Result: Matrices.Standard.Standard_Matrix(From.X,From.Y);
     begin
        -- counts on the Standard_Matrix being intialized to all zeros.
        for I in 1..From.X loop
          Result.Data(I,I) := 1.0;
        end loop;
        return Result;
     end To_Standard_Rep;

end Matrices.Identity;

-- okay now part of the parent package body.

package body Matrices is

     ...
     function "*"(L,R: Matrix'Class) return Matrix'Class is
     begin
       if L.Y /= R.X raise Constraint_Error; end if;
       -- might as well do this in the classwide operation, since it is
       -- independent of representation.
       if L'Tag = R'Tag then return Multiply2(L,R);
       else return Multiply1(L,R);
       end if;
     end "*";
     ...

end Matrices;

    If this were a real implementation, I would probably make some of
the operations in Matrices explicitly abstract, and have more classwide
conversion functions such as to an LUP decomposition.  And of course, in
a real implementation the body of "*" would be much more complex,
preferring to call the Identity_Matrix operation even when the identity
matrix or tridiagonal matrix is the right parameter as well, etc.  But
the genenral idiom requires a minimum of one private dispatching
operation for each public classwide operation, which is very little
overhead compared to single dispatching.

    Also note that this is really double dispatching, but if you wanted
to declare "*" as:

    function "*"(L,R: Matrix'Class) return Matrix;

    The you would be doing triple dispatching, with the first dispatch
on the return type, without much more implementation effort.  Such a
package might be useful if most of your matrices were in either LUP or
basis form.

>                                                        I actually
> think that this is in fact *not* the case, in which case I have no
> trouble writing a dispatching version in C++ either - just have
> dot(a,b) call a.dot(b). In both Ada and C++, the apparent external
> symmetry will then hide the internal asymmetry.

    As you point out it is not impossible to do that in C++ as well. 
But notice Multiply2, which dispatches on both L and R, or for that
matter "*" doesn't dispatch on anything externally, even though it
effectively double dispatches.  (The difference is that in Multiply2
both parameters must be of the same type (subclass), while in "*" they
need not be types that know of each other.  One of the cute things you
can do with a complex dispatching case, is put an error handler on "*"
like so:

     function "*"(L,R: Matrix'Class) return Matrix'Class is
     begin
       if L.Y /= R.X raise Constraint_Error; end if;
       -- might as well do this in the classwide operation, since it is
       -- independent of representation.
       begin
         if L'Tag = R'Tag then return Multiply2(L,R);
         elsif ...
         else return Multiply1(L,R);
         end if;
       exception
         when Constraint_Error =>
              return Multipy2(To_Standard_Rep(L),To_Standard_Rep(R));
       end;
     end "*";

     Of course more likely is to recognize the unanticipated cases in
the various Multiply1 functions with:

     else return Multiply1(L,To_Standard_Rep(R));

(You don't have to do this as a recursive call, but it works cleanly,
and doesn't take much code for these presumably rare or unanticipated
cases.) 
 
> Once again, I will ask for an example demonstrating this, where
> something is more complicated to use in C++ generics than in Ada.
> This will make you the fourth person I have asked for this type
> of example, the others being Richard D. Riehle, Samuel Mize, and
> Robert Dewar. None of the others have chosen to post such an
> example.

     I've done one example (probably with a few typos and thinkos since
it is Friday afternoon), I'm not going to do this one too.  The reason
no one is anxious to demonstrate this is that reasonable examples take
several pages of code in Ada, and of course lots more in C++.
-- 

                                        Robert I. Eachus

with Standard_Disclaimer;
use  Standard_Disclaimer;
function Message (Text: in Clever_Ideas) return Better_Ideas is...