Re: Instantiating private types with discriminants?

["Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de>]

On Wed, 10 May 2006 13:44:00 GMT, rick H wrote:

> Ludovic Brenta <ludovic@ludovic-brenta.org> wrote:
>> rick H writes:
>>> Dmitry A. Kazakov <mailbox@dmitry-kazakov.de> wrote:
>>> > BTW, You should probably make Put a primitive operation of General_T. Then
>>> > the whole could look like simply:
>>> >
>>> >   Put (Var_A.all); -- Do what have to be done
>>>
>>> I'm still a bit new to Ada terminology - does "making Put a primitive
>>> operation" mean doing this kind of thing with a generic package...
>>>    type Fred is new Integer;
>>>    package Fred_IO is new Ada.Text_IO.Integer_IO (Fred);
>>>    use Fred_IO;
>>> If that's right - how would I do this in my example? I'm puzzled
>>> because Var_A.all.Data will resolve to either an Integer or a Float at
>>> run-time.  Have I got to declare two new packages - one against
>>> Integer_IO and one for Float_IO and let the dispatcher get it right
>>> at run-time?
>> 
>> A "primitive operation" of a type T is a subprogram that:
>> 
>> - takes a parameter of type T or "access T", or returns a result of
>> type T or "access T"
>> 
>> - is declared in the same package specification as T (same declarative
>> region, really)
>> 
>> If these conditions are met, then the operation is primitive.  If, in
>> addition, T is tagged, then a call to a primitive operation dispatches
>> dynamically at run time according to the exact type T. Essentially, the
>> compiler does the tag comparison and dispatching for you. So you could
>> write:
>> 
>> package P is
>>   type T is tagged null record;
>>   procedure Put (Item : in T); -- primitive operation
>> 
>>   type Type_A is new T with Data : Integer; end record;
>>   procedure Put (Item : in Type_A); -- primitive operation
>> 
>>   type Type_B is new T with Data : Float; end record;
>>   procedure Put (Item : in Type_B); -- also primitive
>> end P;
>> 
>> package body P is
>>   procedure Put (Item : in T) is
>>   begin
>>       null;
>>   end Put; -- we could also have declared this procedure abstract
>> 
>> procedure Put (Item : in Type_A) is
>> begin
>>   Ada.Integer_Text_IO.Put (Item.Data);
>> end Put;
>> 
>> procedure Put (Item : in Type_B) is
>> begin
>>   Ada.Float_Text_IO.Put (Item.Data);
>> end Put;
>> end P;
>> 
>> with P;
>> procedure Simple_Case is
>>   Var_A : P.T'Class := ...; --  class-wide type: could be T, Type_A or
>> Type_B
>> begin
>>   P.Put (Var_A); -- dynamic dispatch to suitable version of Put
>> end Simple_Case;
>> 
> Thanks, Ludovic.  Bearing in mind that, in my original example, Var_A is
> declared as an *access* to the class-wide type, I tried declaring the
> various Put procedures as you showed, and then simply dereferencing
> Var_A when calling Put:
>    Put (Var_A.all);
> However, the compiler (gnat) complained that I cannot use a class-wide
> argument in this case.

You should have tried it in the same body. Do it as Ludovic did, using
packages:

---------- Simple_Case_Types.ads
package Simple_Case_Types is
   type General_T is abstract tagged null 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 Simple_Case_Types;

---------- Simple_Case_Types.adb
with Ada.Integer_Text_IO;
with Ada.Float_Text_IO;

package body Simple_Case_Types is
   procedure Put (Item : in Type_A) is
   begin
      Ada.Integer_Text_IO.Put (Item.Data);
   end Put;

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

end Simple_Case_Types;

----------- Simple_Case.adb
with Simple_Case_Types;  use Simple_Case_Types;

procedure Simple_Case is
   type Access_T is access General_T'Class;
   Var_A : Access_T; -- could be "new Type_A" or a "new Type_B"
begin
   Var_A := new Type_B' (Data => 100.0);
   Put (Var_A.all);

end Simple_Case;

This will compile as expected.

BTW, I should use pointers only when needed. Differently to C++, in Ada you
can create class-wide objects on the stack.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de