Re: Extending Nested Tagged Records

["Matthew Heaney" <matthew_heaney@acm.org>]

In article 
<84E639D0D9829A88.356169F32CD3866A.7936C8200D458BB1@lp.airnews.net> ,
rlove@antispam.neosoft.com (Robert B. Love ) wrote:

>
> Can a tagged record owning a tagged record type have the inner
> record extended?  In trying to understand how the type extension
> mechanism in Ada 95 works I'm replacing nested variant records with
> tagged types.
>
> Here is a code snippet--

[code snipped]

Here is one idea.  Basically, you let types in motorized_device'class
extend themselves with extensions of Telemetry_Type, but let clients of
the record get at the extension by calling a function that returns a
pointer to the telemetry component.

There's some code below that shows what I mean.

> Does this even make sense?  Or is a complete redesign
> the better way to go?

Do clients of the types use the unencapsulated record?  Or is the type
private, and clients call primitive operations of the type?

The code below assumes the former.  However, if clients call primitive
operations, then there's no real problem (because you can implement the
(private) type anyway you want, and clients are oblivious.)

Maybe a mixin approach can be used.  Or maybe record composition using
access discriminants.


--STX
package P is

   type root_motorized_device is
     abstract tagged record
         speed: Float;
         torque : Float;
         current_cmd : string (1..10);
     end record;

   type telemetry_type is
     tagged record
         speed: Float;
         error_flag: boolean;
      end record;

   type Telemetry_Access is access all Telemetry_Type'Class;

   function Telemetry (Device : access Root_Motorized_Device)
     return Telemetry_Access is abstract;


   type motorized_device is
     new root_motorized_device with record
        Telemetry : aliased Telemetry_Type;
     end record;

   function Telemetry (Device : access Motorized_Device)
     return Telemetry_Access;


   type Device_1_Telemetry_Type is
     new Telemetry_Type with record
        I : Integer;
     end record;

   type device_1 is new root_motorized_device with
        record
                shaft_position: Float;
                shaft_load : Float;
                telemetry: aliased Device_1_Telemetry_Type;
        end record;

   function Telemetry (Device : access Device_1)
     return Telemetry_Access;


   type Device_2_Telemetry_Type is
     new Telemetry_Type with record
        F : Float;
     end record;

   type device_2 is new root_motorized_device with
        record
                latch_angle: Float;
                end_of_travel_switch: boolean;
                 telemetry: aliased Device_2_Telemetry_Type;
        end record;

   function Telemetry (Device : access Device_2)
     return Telemetry_Access;

end P;


package body P is

   function Telemetry
     (Device : access Motorized_Device)
      return Telemetry_Access is
   begin
      return Device.Telemetry'Access;
   end Telemetry;

   function Telemetry
     (Device : access Device_1)
      return Telemetry_Access is
   begin
      return Device.Telemetry'Access;
   end Telemetry;

   function Telemetry
     (Device : access Device_2)
      return Telemetry_Access is
   begin
      return Device.Telemetry'Access;
   end Telemetry;

end P;