Re: Q: Primitive operation of a type

[mheaney@ni.net (Matthew Heaney)]

In article <33BA43CC.E27C69CC@elca-matrix.ch>, Mats.Weber@elca-matrix.ch wrote:


>> procedure P (O1, O2 : T1'Class) is
>> begin
>>    if O1 = O2 then
>> 
>> This will dispatch on the equality operator, if the tags are the same.
>> If
>> the tags are different, then obviously the objects can't be the same,
>> so no
>> exception is raised (thankfully) and the function just returns False.
>
>I'm not so sure we should be thankful for this one. In the following
>situation, for instance, you may want "=" to return True even it the tags
are different:
>
>   type Root_Set is abstract tagged private;
>
>   type AVL_Tree_Set is new Root_Set with private;
>
>   type Boolean_Array_Set is new Root_Set with private;
>
>   A : AVL_Tree_Set;
>   B : Boolean_Array_Set;
>
>   procedure P (X, Y : Root_Set'Class) is 
>   begin
>      if X = Y then ...
>   end P;
>
>   P(A, B);
>
>now X => A and Y => B have different tags, but I would like "=" to return True
>iff A and B have the same elements, not the same elements and implementation.


One technique I like to use is to provide a primitive copy operation and
equality operator that takes an class-wide parameter as an argument:

   type Root_Stack is abstract tagged private;

   procedure Copy (From : in Root_Stack'Class; To : in out Root_Stack);

   function "=" (Left : Root_Stack'Class; Right : Root_Stack) return Boolean;

For most data structures, a copy operation that takes 2 class-wide
parameters is good enough.  Stacks are a pain because you have to populate
the target stack in reverse order of traversal of the source stack.  You
can only really do that if you have access to the representation of the
type, thus the necessity of making copy (for stacks) primitive.

(And you need a Copy operation because you can't do assignment unless the
tags of the left and right hand sides are the same.  So you have to have a
copy operation (and by extension a comparison operation) that you know is
for use with class-wide objects.)

As for equality, I suppose making one (it doesn't matter, Left or Right) of
the specific type at least gives you the opportunity for a more efficient
implementation.  (To be honest, I don't remember if I've done this yet.) 
Of course, you could just make both parameters class-wide too.

There might be an issue with ambiguity, however.  If I did this

procedure P (L, R : Root_Stack'Class) is
begin
   if L = R then

How would the compiler know which operator to call:

function "=" (L, R : Root_Stack) return Boolean;

or 

function "=" (L : Root_Stack'Class; R : Root_Stack) return Boolean;

(See, I told you I haven't done this yet...)

Perhaps a fix is to just use another name for the class-wide version:

function Is_Equal (L : Root_Stack'Class; R : Root_Stack) return Boolean;

So that 

procedure P (L, R : Root_Stack'Class) is
begin
   if Is_Equal (L, R) then 

and we therefore know we're comparing any stack (L) to the specific type of R.

This would appear to be a solution to your set comparison problem.  Each
type that derives from Root_Set overrides the Is_Equal operation so that it
can compare itself to any other set.  (Come to think of it maybe I did do
this...)

To implement this, you'll need a class-wide iterator, so that you can
iterate over any set (or stack or whatever); Is_Equal would use this to
iterate over its Left parameter.  One way to do that is to have factory
method that returns an iterator appropriate for the type (this is
documented in the GOF book), for example

function Is_Equal (L : Root_Stack'Class; R : AVL_Tree_Set) return Boolean is

   The_Iterator : Root_Set_Iterator'Class := New_Iterator (L'Unchecked_Access);
begin
   while not Is_Done (The_Iterator) loop

So the set package would really export 2 tagged types:

package Sets_G is

   type Root_Set is abstract tagged private;

   type Root_Set_Iterator is abstract tagged private;

   function New_Iterator (Set : access Root_Set)
      return Root_Set_Iterator'Class;

   function Is_Done (Iterator : Root_Set_Iterator) return Boolean;
 
   procedure Advance (Iterator : in out Root_Set_Iterator);

   function Is_Equal (L : Root_Set'Class; R : Root_Set) return Boolean;

   procedure Copy (From : Root_Set'Class; To : in out Root_Set);

...

You use the iterator to implement Copy too.

You may have to declare the class-wide parameters (L and From) access
parameters, or perhaps use a named access-to-constant type.  (I really,
really hope I can say

function New_Iterator (Set : access constant Root_Set)
   return Root_Set_Iterator'Class;

in Ada 0X.)

There's another way to do the iteration (I think) using a cursor-based
approach; I haven't tried it yet, but it uses a double-dispatch technique
(I think).

You could even make the iterator indefinate, to force the user to remember
to initialize it:

type Root_Set_Iterator (<>) is abstract tagged private;

I think I have code lying around that does this sort of thing, and I may
have discussed it in one of my posts to the SIGAda Patterns WG list. (Which
I will be getting back to as soon as my new disk drive arrives...)

--------------------------------------------------------------------
Matthew Heaney
Software Development Consultant
<mailto:matthew_heaney@acm.org>
(818) 985-1271