Q: Primitive operation of a type

Q: Primitive operation of a type

[Van Snyder]

I've looked at Barnes's book, and Cohen's book, and I can't
decide whether it's possible for a procedure to be a primitive
operation of more than one type.

All they say is that a primitive operation of a type is a
procedure declared in the same package specification as the
type, and having an argument or result of the type.  The
question of other arguments is not discussed.

If it's not possible, please send me a reference to the
relevant parts of the LRM (or Barnes's book or Cohen's book),
so I can learn the precise rules that apply (and you might as
well ignore the remainder of this posting).

If it is possible, please explain how over-riding works in this
case:

Suppose T1 and T2 are tagged types, and T11 and T21 are
extensions thereof.  Suppose P12 is a procedure that has
arguments of types T1 and T2, P112 has arguments of types T11
and T2, and P121 has arguments of types T1 and T21, and suppose
that P12, P112 and P121 all have the same name, P -- so P112 and
P121 over-ride P12, but for different arguments and possibly for
different derivation classes.

Which procedure is used when P is invoked with arguments of
types T11 and T21?  Please refer me to sections of the LRM (or
Barnes's or Cohen's books) that explain the answer.

Thanks in advance for your help.

-- 
What fraction of Americans believe   |  Van Snyder
Wrestling is real and NASA is fake?  |  vsnyder@math.jpl.nasa.gov

Re: Q: Primitive operation of a type

[Matthew Heaney]

In article <5oq51h$t7u@netline.jpl.nasa.gov>, vsnyder@math.jpl.nasa.gov
(Van Snyder) wrote:

>I've looked at Barnes's book, and Cohen's book, and I can't
>decide whether it's possible for a procedure to be a primitive
>operation of more than one type.

It is, but an operation can only be primitive for one tagged type.  

For example, the operation Set_Col in package Ada.Text_IO is primitive for
both type File_Type and type Positive_Count.  But note that neither of
these types are tagged.

These issues are discussed in Mats Weber's PhD thesis.

>If it's not possible, please send me a reference to the
>relevant parts of the LRM. [snip]

No, it is not possible for an operation to be primitive for more than one
tagged type.

>Which procedure is used when P is invoked with arguments of
>types T11 and T21?  Please refer me to sections of the LRM (or
>Barnes's or Cohen's books) that explain the answer.

Be careful though, to not interpret "can't be primitive for more than one
type" to mean "can't have different tagged types as subprogram parameters." 
A operation can be primitive for one tagged type, but take additional
class-wide parameters of another type.  For example,

package P is

   type T1 is tagged private;

   type T2 is tagged private;

   procedure Op1 (O1 : T1; O2 : T2);  -- illegal

   procedure Op2 (O1 : T1; O2 : T2'Class);  -- AOK

   procedure Op3 (O1 : T1'Class; O2 : T2);  -- AOK2

   procedure Op4 (O : T1'Class);

   procedure Op5 (O : T2'Class);
 
   procedure Op6 (O1 : T1'Class; O2 : T2'Class);

   procedure Op7 (O1 : T1; O2 : T1);  -- OK
...
end P;

Op1 is illegal, because it takes more than one kind of tagged type as
parameters.

Op2 is a primitive operation of type T1, and it gets inherited by types
that derive from T1.

Op3 is a primitive opeation of type T2, and it gets inherited by types that
derive from T2.

Op2, because it takes an object of type T2'Class, is not a primitive
operation of type T2.

Op3, because it takes an object of type T1'Class, is not a primitive
operation of type T3.

Op4 is not a primitive operation of any type.  Ditto for Op5 and Op6.

Op7 is a primitive operation of type T1, and gets inherited by types that
derive from T1.  It's OK to have more than one parameter of a tagged type,
it's just that they have to have the same tag.

Op7 is interesting, because sometimes a run-time check will need to be made
to ensure that both objects really have the same tag.  For example,

procedure P (O1, O2 : T1'Class) is
begin
   Op7 (O1, O2);
end;

This will dispatch on the tag of the O1 and O2, but only if O1 and O2 have
the same tag, which can't be determined until run-time.  If the tag-check
fails, then an exception is raised (I forget which, either Constraint_Error
or Program_Error).

One exception to this must-be-same-tag rule is in the case of the equality
operator:

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.

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

Re: Q: Primitive operation of a type

[Mats Weber]

Matthew Heaney wrote:

> This will dispatch on the tag of the O1 and O2, but only if O1 and O2
> have
> the same tag, which can't be determined until run-time.  If the
> tag-check
> fails, then an exception is raised (I forget which, either
> Constraint_Error
> or Program_Error).

It's Constraint_Error.

> 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.

Re: Q: Primitive operation of a type

[Martin C. Carlisle]

In article <5oq51h$t7u@netline.jpl.nasa.gov>,
Van Snyder <vsnyder@math.jpl.nasa.gov> wrote:
>I've looked at Barnes's book, and Cohen's book, and I can't
>decide whether it's possible for a procedure to be a primitive
>operation of more than one type.

It is NOT possible for an operation to be primitive for more than
one tagged type.  In essence, you are attempting to do multiple inheritance,
which is not supported directly in Ada 95.  See section 12.4.4.3 of Cohen,
and LRM 3.9.2 (12-13).

For more information on how you might be able to simulate this, see
section 4.6 of the rationale, or you can download a handout I wrote 
regarding this (published in the proceedings of this year's ASEET symposium
at Monmouth Univ).  See http://www.usafa.af.mil/dfcs/papers/#carlisle

--Martin

-- 
Martin C. Carlisle, Computer Science, US Air Force Academy
mcc@cs.usafa.af.mil, http://www.usafa.af.mil/dfcs/bios/carlisle.html
DISCLAIMER:  This content in no way reflects the opinions, standard or 
policy of the US Air Force Academy or the United States Government.

Re: Q: Primitive operation of a type

[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

Re: Q: Primitive operation of a type

[Mats Weber]

Matthew Heaney wrote:

> 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);
> 
> ...

How about an iterator that is just a procedure ? That way, the iterator is
part of the primitive profile of the type and gets inherited (and I'll have to
convert all my Ada 83 iterator specifications based on generics :-().
Moreover, it's not always easy to implement an iterator that is a separate
type, e.g. if the structure is implemented as an AVL tree, you have to
remember the path from the root of the tree to the current node, which makes
your iterator less efficent.

generic
   type element_type is private;
package sets is

   type set is abstract tagged private;

   type action_procedure is
      access procedure (element : in element_type);

   procedure enumerate (the_set : in set; 
                        action  : in action_procedure);
   
   ...

end sets;

Re: Q: Primitive operation of a type

[Matthew Heaney]

In article <33C24D61.86746FC7@elca-matrix.ch>, Mats.Weber@elca-matrix.ch wrote:

>How about an iterator that is just a procedure ? That way, the iterator is
>part of the primitive profile of the type and gets inherited (and I'll have to
>convert all my Ada 83 iterator specifications based on generics :-().

Yes, it's very desirable to make the iteration a primitive operation
somehow, because that admits overriding the operation for the derived type.

However, the procedure solution seems to be fighting the language.  Note 85
in RM95 3.10.2 (37) specifically states that 

"The accessibility rules imply that is is not possible to use the Access
attribute to ... pass a more-nested subprogram as a parameter to a
less-nested subprogram, as might be desired for example for an iterator
abstraction."

So you might not want to convert your Ada 83 generic iterators, because the
next sentance says

"Instead, downward closures can be implemented using generic formal
subprograms."

Of course, if you're using GNAT, you can do what you want by using the
Unrestricted_Access attribute (I think).

If a passive form of iterator is more efficient, then can't we combine the
best of both techniques?

generic
   type Set_Item is private;
package Sets_G is

   type Root_Set is abstract tagged private;

   type Root_Set_Iterator is abstract tagged private;

   procedure Iterate
     (Set         : in        Root_Set; 
      Iterator : in out Root_Set_Iterator'Class) is abstract;

   procedure Process
     (Item      : in Set_Item; 
      Iterator : in Root_Set_Iterator) is abstract;

end;

generic
package Sets_G.AVL_G is
   
   type AVL_Set is new Root_Set with private;

   procedure Iterate
     (Set         : in        AVL_Set;
      Iterator : in out Root_Set_Iterator'Class);
...
end;

package body Sets_G.AVL_G is
 
   procedure Iterate
     (Set         : in        AVL_Set;
      Iterator : in out Root_Set_Iterator'Class) is
   
      <call Process (Item, Iterator) for each item in the avl tree>

   end Iterate;

end;


One issue with this solution is that it would be nice to write a generic
package to do some class-wide operations, but that would require derivation
inside a generic package, with isn't allowed (I think):

generic
   with function Image (Item : Set_Item) return String;
package Sets_G.Text_IO_G is

   procedure Put (Set : in Root_Set'Class);

end;

package body Sets_G.Text_IO_G is

   type Put_Iterator is new Root_Set_Iterator with null record;

   procedure Process
     (Item       : in        Set_Item;
      Iterator : in out Put_Iterator) is
   begin
      Ada.Text_IO.Put (Image (Item));
   end Process;

   procedure Put (Set : in Root_Set'Class) is
       Iterator : Put_Iterator;
   begin
       Iterate (Set, Iterator);
   end;

end;

Sadly, I don't think this will work, because Sets_G.Text_IO_G is a generic
package.

The solution you suggested will would work in this particular case, because
no local data is required to implement Put, so a library level callback can
be passed to the iterate operation.  However, in practice, many
abstractions that use iteration require data local to the subprogram, so a
callback can't be used (portably).

So I'm at a bit of an impass.  If you really want passive iteration, then
you have to use a non-portable attribute.  Or else you can use active
iteration, but at a cost of some loss of efficiency.

Even with the active-iterator-as-separate-type technique, I haven't come
with any good solutions to iterate over a class-wide object.  Perhaps I can
just simplify my life by using a cursor-based solution;  simultaneous
iteration over the same data structure isn't that common, in my experience.

Oh well.  If anyone has any brilliant ideas about iteration (active or
passive) over a class-wide object, please post them!

Matt

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