automatic tag conversion?

automatic tag conversion?

[Stephan Heinemann]

I would like to convert a Subtype of a tagged Supertype stored in a
variable of Supertype into a variable of Subtype. I do not want to
use the following:

if supervar'Tag = "Subtype" then
	polymorphic(Subtype(supervar));
elsif ...
else ...
end if;

Isn't there anything like:

t: Tag;
subvar: Subtype;
...
t := supervar'Tag;
subvar := t'convert(supervar); -- convert(t, supervar)
polymorphic(subvar);

?

It is because I would like to extend the Supertype and use dynamic
binding / polymorphism for the appropriate variable of Subtype without
having to do this String mess.

Thanks in advance,
Stephan

Re: automatic tag conversion?

[Stephan Heinemann]

Stephan Heinemann <zombie@cs.tu-berlin.de> wrote:

> t: Tag;
> subvar: Subtype;
> ...
> t := supervar'Tag;
> subvar := t'convert(supervar); -- convert(t, supervar)
> polymorphic(subvar);

Of course I don't know what the concrete Subtype is and I don't wanna
know. Therefore the code snippet is wrong. I meant:

polymorphic(t'convert(supervar))

or better and safer (because t may describe a Type not within Supertype)

polymorphic(supervar'TagType)

It is not my lazyness, but I'd like to extend my code without updating
conditionals on Strings. For every new Subtype of Supertype I not only
need to overload the polymorphic procedure but also a String comparation.

Thanks,
Stephan

Re: automatic tag conversion?

[Georg Bauhaus]

Stephan Heinemann <zombie@cs.tu-berlin.de> wrote:
: Stephan Heinemann <zombie@cs.tu-berlin.de> wrote:
: 
:> t: Tag;
:> subvar: Subtype;
:> ...
:> t := supervar'Tag;
:> subvar := t'convert(supervar); -- convert(t, supervar)
:> polymorphic(subvar);
: 
: Of course I don't know what the concrete Subtype is and I don't wanna
: know. Therefore the code snippet is wrong. I meant:

If I understand your wording correctly (in Ada, a subtype is
different from a derived type (subtypes add value constraints,
they do not extend)), it might be simpler.
I hope i don't tell matters of course, as I might have missed the
intent of your question.

Consider this small hierarchy.

package R is

   -- a tagged type

   type T is
     tagged record
        null;
     end record;

   function About(it: T) return String;



   type Switch_State is (on, off);
   -- an ad hoc Boolean type, used in the derived type TT

   -- a derived type, extended version of T (what you have called
   -- a subtype, I believe)

   type TT is new T
     with record
        toggle: Switch_State;
     end record;

   function About(it: TT) return String;

end R;

Then, for a variable to be able to represent objects of any type
in this hierarchy, it must either be class-wide, or it
must be an access type (pointer, or reference).

I have tried to make this distintion in the following
snippet:


with R; use R;

procedure U is

   VV: TT;  -- an instance of extended type TT


begin

objects:  -- as opposed to object pointers

    declare
       Current: T := T(VV);
       -- upward conversion, some VV-components gone!
    begin
       -- therefore, the next line doesn't compile, because
       -- it would mean a downward conversion (with missing
       -- TT-components):
       VV := TT(Current);


       -- however, these do compile, because there is a match for every
       -- component needed in a TT instance.

       VV := (Current with toggle => on);
       VV := TT'(Current with toggle => on);
    end objects;


object_pointers:

    declare
       type Poly is access T'class;
       -- Poly values may refer to T-objects or to TT-objects

       a_tt: Poly := new TT;
       a_t: Poly := new T;
    begin
       --  attempts to copy assumed TT values into vv
       vv := TT(a_tt.all);
       vv := TT(a_t.all);  -- tag check will fail at run time
    end object_pointers;

class_wide:    -- (this is probably a very incomplete overview)

    declare
       any1: T'class := TT'(toggle => off);
       any2: T'Class := T'(null record)
    begin
       any1 := any2;  -- run time exception (objects copied, not pointers)
       VV := TT(any1);
    end class_wide;

end U;


HTH,
georg

Re: automatic tag conversion?

[Stephan Heinemann]

Georg,

first of all, you are quite right: I should have used the term
"derived type" instead of "subtype". Further I did not explain what
the problem really is forcing you to write a lot of code - sorry
for that.

I actually was not talking about tagged types, access to tagged
types or even class-wide types but about access to all class-wide
types with a given type-identifier.
The problem for which I do not have a good solution until now is
the following:

I am using generic sets like this one:

generic

    type Element is private;

package CNAda.Utils.Sets is

    type Set is private;
    type LookProcedure is access procedure (e: in Element);
    type MapProcedure is access procedure (e: in out Element);

    procedure empty(s: in out Set);
    procedure insert(e: in Element; s: in out Set);
    procedure remove(e: in Element; s: in out Set);

    procedure look(lookp: in LookProcedure; s: in Set);
    procedure map(mapp: in MapProcedure; s: in Set);

private

    type SetElement is
        record
            content: Element;
            prev: Set;
            next: Set;
        end record;

    type Set is access SetElement;

end CNAda.Utils.Sets;

I use the following for instantiation of this package.

    type Node is abstract new Component with private;
    type NodeClassAccess is access all Node'Class;

package NodeClassAccessSets is new CNAda.Utils.Sets(NodeClassAccess);

NodeClassAccessSets.Set is a component within another tagged (record) 
type - a Net.
There are various derived types of Node like Transition, Place and
further Operation, Socket, Port and so on....

I want to apply a LookProcedure on the set for example to
print all elements of this set. There is a primitive operation print
defined on the types within the hierarchy:

procedure print(n: access Node) is abstract;
procedure print(t: access Transition);
procedure print(p: access Place);

...and so on. I want the system to dispatch to the most special variant
of the procedure for the apropriate derived type like:

NodeClassAccessSets.look(print'Access, s);

It is clearly possible to pass in a NodeClassAccess variable with any 
derived *ClassAccess value into a print procedure defined as above even if
the print procedure was not overridden by the new derived type.
The system would always dispatch the most special case, am I right?

But my compiler (gnat 3.13p) does not accept the last statement saying:
cnada-cnets-components.adb:43:38: expected type "LookProcedure" defined at 
cnada-utils-sets.ads:8, instance at cnada-cnets-components.ads:94
cnada-cnets-components.adb:43:38: found type access to "print" defined at 
line 43

So I changed the print procedures to:

procedure print(n: in NodeClassAccess);
procedure print(t: in TransitionClassAccess);
procedure print(p: in PlaceClassAccess);

Now the problematic statement compiles. The first procedure cannot
be abstract anymore because it is the procedure passed as the
LookProcedure. Now the problem is the following: Always the procedure
for the approprate local pointer type of the passed in actual parameter
is taken now.

(1) If I passed in a TransitionClassAccess actual parameter with a derived 
*ClassAccess value the procedure of the former is taken.

(2)
Further I could not pass in a derived *ClassAccess actual parameter 
without having defined a more special print procedure.

(1) forces me to always use the exact *ClassAccess variable for which
I want to apply a procedure. Further it forces me to implement the
procedure for NodeClassAccess which can be used as type for the passed 
in actual parameter (having to ask 'Tag for what is the appropriate
procedure because Node is still abstract and shall be - that was the
problem of my former posting).

(2) forces me to always overide the procedure I want to use.

There will be procedures for which the appropriate variant is much more
important than for print and it would be much less work. 

What can I do to get out of this mess?

Thanks,
Stephan

Re: automatic tag conversion?

[Dmitry A. Kazakov]

Stephan Heinemann wrote:

> I am using generic sets like this one:
> 
> generic
>     type Element is private;
> package CNAda.Utils.Sets is
> 
>     type Set is private;
>     type LookProcedure is access procedure (e: in Element);
>     type MapProcedure is access procedure (e: in out Element);
> 
>     procedure empty(s: in out Set);
>     procedure insert(e: in Element; s: in out Set);
>     procedure remove(e: in Element; s: in out Set);
> 
>     procedure look(lookp: in LookProcedure; s: in Set);
>     procedure map(mapp: in MapProcedure; s: in Set);
[...]
> I use the following for instantiation of this package.
> 
>     type Node is abstract new Component with private;
>     type NodeClassAccess is access all Node'Class;
> 
> package NodeClassAccessSets is new CNAda.Utils.Sets(NodeClassAccess);
> 
> NodeClassAccessSets.Set is a component within another tagged (record)
> type - a Net.
> There are various derived types of Node like Transition, Place and
> further Operation, Socket, Port and so on....
> 
> I want to apply a LookProcedure on the set for example to
> print all elements of this set. There is a primitive operation print
> defined on the types within the hierarchy:
> 
> procedure print(n: access Node) is abstract;
> procedure print(t: access Transition);
> procedure print(p: access Place);
> 
> ...and so on. I want the system to dispatch to the most special variant
> of the procedure for the apropriate derived type like:
> 
> NodeClassAccessSets.look(print'Access, s);
> 
> It is clearly possible to pass in a NodeClassAccess variable with any
> derived *ClassAccess value into a print procedure defined as above even if
> the print procedure was not overridden by the new derived type.
> The system would always dispatch the most special case, am I right?

No, Element is of NodeClassAccess which is different from anonymous "access 
Node" (that will dispatch). Thus LookProcedure.all is not dispatching at 
all. However it will be sort of "class-wide" when NodeClassAccess is 
class-wide, as it is. So you practically have everything to make it 
working. Just define a wrapper in the same package, where Node is defined:

procedure Print_Any (Ptr : NodeClassAccess) is
begin
   Print (Ptr); -- Dispatches
end Print_Any;

Then

NodeClassAccessSets.look (Print_Any'Access, s);

should work as expected.

-- 
Regards,
Dmitry A. Kazakov
www.dmitry-kazakov.de

Re: automatic tag conversion?

[Georg Bauhaus]

Dmitry A. Kazakov <mailbox@dmitry-kazakov.de> wrote:
:> The system would always dispatch the most special case, am I right?
: 
: No, Element is of NodeClassAccess which is different from anonymous "access 
: Node" (that will dispatch). Thus LookProcedure.all is not dispatching at 
: all. However it will be sort of "class-wide" when NodeClassAccess is 
: class-wide, as it is. So you practically have everything to make it 
: working. Just define a wrapper in the same package, where Node is defined:
: 
: procedure Print_Any (Ptr : NodeClassAccess) is
: begin
:   Print (Ptr); -- Dispatches
: end Print_Any;

Yes. I've made something similar, using a slightly modified set with
a generic "look" function,

    generic
       with procedure accessor(e: in Element);
    procedure look(s: in Set);

(and also deriving Node from a Printable abstract tagged type,

   type Printable is abstract tagged private;
   procedure print(p: access Printable) is abstract;
)
Maybe both the Booch components and the Charles library
might provide some ideas (in addition to code :)
of how iteration can be done.

The slight change results in

with Sets;
with nodes; use nodes;

procedure run is  -- testing

   package Node_Sets is new Sets(Element => Node_ptr);

   net: Node_sets.Set;

   procedure print_any(n: Node_ptr) is
   begin
      print(n.all'access);
   end print_any;

   procedure print_all is
      new node_sets.look(accessor => print_any);

begin
   node_sets.insert(new Transition, net);
   node_sets.insert(new Place, net);
   node_sets.insert(new Transition, net);
   node_sets.insert(new Transition, net);
   print_all(net);
end run;

$ ./run
a transition
a transition
a place
a transition
$


Georg

Re: automatic tag conversion?

[Georg Bauhaus]

Georg Bauhaus <sb463ba@d2-hrz.uni-duisburg.de> wrote:
: 
:   procedure print_any(n: Node_ptr) is
:   begin
:      print(n.all'access);
:   end print_any;

That should be

       print(n);


:   procedure print_all is
:      new node_sets.look(accessor => print_any);
: 
: begin
:   node_sets.insert(new Transition, net);
:   node_sets.insert(new Place, net);
And maybe: (Hyperway derived from Transition, not overriding print)
   node_sets.insert(new Hyperway, net);
:   node_sets.insert(new Transition, net);
:   print_all(net);
: end run;
 
Still:
: $ ./run
: a transition
: a transition
: a place
: a transition
: $

Re: automatic tag conversion?

[Stephan Heinemann]

Thank you Dmitry and Georg! That was exactly what I needed.