Re: Cumbersome Polymorphism

[Richard Irvine <irv@eurocontrol.fr>]

As usual, many thanks for your reply.

My basic point is that in order to make  simple use of polymorphism
the user of tagged types has to allocate and deallocate storage.
If, due to programming errors, deallocation is not done or not done
in the right place, the consequence can be memory leaks or dangling
references. (One of Ada's fortes is its static type checking, which
commends it for use in systems which must be highly reliable. The static
type checking is an important contribution to reliability, but I can
undo all the benefit to be gained from this, if I forget to deallocate
something or deallocate it in the wrong place). Also, by requiring the
routine use of access types, one might end up going down the slippery
road of passing access types around a program without being sure 
where or when they should be deallocated.
 
It would be good if the memory management associated with a tagged type
could be taken care of in the (single) package in which the type is 
defined, not in the (multiple) places where it is used, if not, every
polymorphic use of the type is an invitation to make deallocation
errors.
If I have a variable which holds a shape of some kind, I want to be able
to assign a triangle or a square to it without having to think about
allocation or deallocation, and without having the opportunity to get it
wrong.
   
In his posting, Robert Dewar gives the example of Ada.Unbounded.Strings.
The user of Unbounded_String does not have to allocate or deallocate the
String which Unbounded_String actually points to. I can assign one
Unbounded_String to another, oblivious to the fact that storage is
allocated and deallocated in the process. 
This certainly shows how to hide allocation and deallocation which gives
me an idea: why not put the allocation and deallocation in a generic 
controlled wrapper, e.g.


with Ada.Finalization;
use  Ada.Finalization; 

generic

   type User_Type (<>) is private;

package Controlled_Wrapper_P is

   type Controlled_Wrapper is private;

   function  Wrap
           ( The_User_Type          : User_Type          )
   return                             Controlled_Wrapper;

   function  Unwrap
           ( The_Controlled_Wrapper : Controlled_Wrapper )
   return                             User_Type;
 
private

   type Access_User_Type is access User_Type;

   type Controlled_Wrapper
      is new Controlled
      with record
         Reference : Access_User_Type;
      end record;

   procedure Initialize ( Object : in out Controlled_Wrapper );
   procedure Adjust     ( Object : in out Controlled_Wrapper );
   procedure Finalize   ( Object : in out Controlled_Wrapper );

end;


Renaming the types given before to something more homely:


package Shapes is

  type Shape is abstract tagged null record;

  procedure Do_Something_To( The_Shape    : Shape    )
  is abstract;

  type Triangle is new Shape with null record;
  procedure Do_Something_To( The_Triangle : Triangle );

  type Square   is new Shape with null record;
  procedure Do_Something_To( The_Square   : Square   );

end;


and instantiating the generic for Shape'Class


with Shapes;
use  Shapes; 
with Controlled_Wrapper_P;

package Shape_Wrapper_P
   is new Controlled_Wrapper_P(User_Type => Shape'Class);


Now I can make use of polymorphism with the allocation and deallocation
done by the controlled wrapper, i.e., 


with Shapes;
use  Shapes;
with Shape_Wrapper_P;
use  Shape_Wrapper_P;

procedure Main_Procedure

is

   The_Triangle : Triangle;
   The_Square   : Square;

   type Shape_Wrapper is new Shape_Wrapper_P.Controlled_Wrapper;

   The_Wrapped_Triangle : Shape_Wrapper := Wrap(The_Triangle);
   The_Wrapped_Square   : Shape_Wrapper := Wrap(The_Square  );

   The_Wrapped_Shape    : Shape_Wrapper;

begin

   The_Wrapped_Shape := The_Wrapped_Triangle;
   Do_Something_To(The_Shape => Unwrap(The_Wrapped_Shape));
   -- calls Do_Something_To for Triangle

   The_Wrapped_Shape := The_Wrapped_Square;
   Do_Something_To(The_Shape => Unwrap(The_Wrapped_Shape));
   -- calls Do_Something_To for Square

end;