Re: Instantiating private types with discriminants?

[rick H <rik_nntp@dsl.pipex.com>]

Dmitry A. Kazakov <mailbox@dmitry-kazakov.de> wrote:
> On Wed, 10 May 2006 16:52:32 -0500, Rick H wrote:
> 
>> But all this has a side-effect that I haven't considered: the fact
>> that a variable declared as a class-wide type *requires* initialization
>> means that the compiler can determine the variable's type statically.
> 
> No. It only means that the type should be determinable at run-time. There
> are may ways to do it. You can call a function with a class-wide result.
> 
> It might be especially interesting to take a look at S'Class'Input
> attribute. It "dispatches" on a "bare" tag. [ Ada 2005 will offer a
> mechanism for fully user-defined things like this. See
> Generic_Dispatching_Constructor. ]
> 
>> This means that the following will raise a constraint error:
>> declare
>>    Var_A : General_T'Class := Get (10);  -- Type_A
>> begin
>>    Put (Var_A);
>>    Ada.Text_IO.New_Line;
>>    Var_A := Get (100.0);      -- Type_B - constraint error!
>>    Put (Var_A);
>> end;
> 
> Yes, but this is a different thing. You cannot change tag, either
> dynamically or statically determined. Type mutators are no-no in Ada's type
> system.
> 
Thanks Dmitry & Jeffrey.
Objects of class-wide types notwithstanding, I modified Ludovic's code
example to change Type_A and Type_B into linked-list elements.  That
meant no more objects of class-wide type, so I got rid of the Get
definitions.  The following code does exactly what I wanted from this
cut-down example: a list of either-Integer-or-Floats.  Next mystery:
what's the use of abstract subprograms? Put (X:in Type_A) and
Put (X:in Type_B) "feel" like just overloaded functions - why do they
"need" an abstract parent Put (X : in General_T)?  Since General_T
is abstract, the latter Put will never be called.  Or have I missed the
point again!?


with Ada.Float_Text_IO;
with Ada.Integer_Text_IO;
with Ada.Text_IO;
procedure Dispatch is
   package P is
      type General_T;
      type Linked_List_T is access all General_T'Class;
      type General_T is abstract tagged record
         Next : Linked_List_T;
      end record;

      procedure Put (Item : in General_T) is abstract;

      type Type_A is new General_T with record
         Data : Integer;
      end record;

      procedure Put (Item : in Type_A);

      type Type_B is new General_T with record
         Data : Float;
      end record;

      procedure Put (Item : in Type_B);
   end P;


   package body P is
      procedure Put (Item : in Type_A) is
      begin
         Ada.Text_IO.Put ("A: ");
         Ada.Integer_Text_IO.Put (Item.Data);
      end Put;

      procedure Put (Item : in Type_B) is
      begin
         Ada.Text_IO.Put ("B: ");
         Ada.Float_Text_IO.Put (Item.Data);
      end Put;
   end P;

   use P;
   My_List : Linked_List_T := null;
begin
      --  generate some data
      My_List := new Type_A'(Next => My_List, Data => 100);
      My_List := new Type_B'(Next => My_List, Data => 64.5);
      My_List := new Type_A'(Next => My_List, Data => 12);
      My_List := new Type_B'(Next => My_List, Data => 100.0);

   --  print it all out - dispatcher will choose the right "Put".
   declare
      Iterator : Linked_List_T := My_List;
   begin
      while Iterator /= null loop
         Put (Iterator.all);
         Ada.Text_IO.New_Line;
         Iterator := Iterator.all.Next;
      end loop;
   end;
end Dispatch;