Ada: Derived record with components overlapping parent

Question

I'm trying to define a hardware interface for two different devices that are closely related, but one has slightly more functionality than the other.

As a very simplified version of the problem, let's say:

• device A has 2 registers: R0 is unused and R1 is used
• device B has 2 registers: uses both R0 and R1

I was attempting to get fancy with code and definitions re-use with a polymorphic definition like:

   Tag_Length : constant := Standard'Address_Size / System.Storage_Unit;

   type A_IO is tagged record
      --  RO precedes, is unused but the space is reserved
      R1 : Byte;
   end record;
   for A_IO use record
      R1 at Tag_Length + 1 range 0 .. 7;
   end record;
   
   type B_IO is new A_IO with record
      R0 : Byte;
      --  R1 would follow as defined by the parent record
   end record;
   for B_IO use record
      R0 at Tag_Length + 0 range 0 .. 7;
   end record;

This results in a compiler error that would make a lot of sense in most scenarios: component overlaps parent field of "B_IO" (GNAT Community 2019).

I have alternatives to this, which would involve either:

• using the same type for each device (con: device A will see components that shouldn't be visible)
• using an entirely different type, rely on Unchecked Conversion through an access type to change the view of the object when using shared code (con: will involve re-defining some of the same components multiple times)

I was wondering if there could be a viable approach without any of the mentioned cons.

Answer 1

Here are some approaches that draw some inspiration from Jere's answer and builds on top of it:

Using Access Types to limit the View

• Like Jere's, it uses a record that will be shared with both implementations that relies on a variant to define the overlapping fields.
• Uses the Unchecked_Union aspect to remove the need to store the variant.
• Encapsulates the hardware IO definitions within tagged records, allowing for inheritance and OO between the two device's implementations. Some sort of encapsulation would have been needed regardless as the software implementation of the devices that this is meant for needs to keep an internal state and not just the IO structure.
• Uses access types to ensure that each device implementation can only access the right components (no need to rely on Unchecked Conversion).

   package Devices is
      type Record_Select is (A_IO, B_IO);
      type Shared_IO (S : Record_Select) is record
         R1 : Byte;
         case S is
            when A_IO => null;
            when B_IO => R0 : Byte;
         end case; 
      end record with Unchecked_Union;
      for Shared_IO use record
         R0 at 0 range 0 .. 7;
         R1 at 1 range 0 .. 7;
      end record;

      type Root is abstract tagged private;
      
      type IO_Access is access all Shared_IO;
      
      function Get_IO_Access (R : in out Root) return IO_Access;
   private
      type Root is abstract tagged record
         IO : aliased Shared_IO (B_IO); -- Could be either A_IO/B_IO
      end record;
   end Devices;
      
   package A is
      
      type Device is new Devices.Root with private;
      
      procedure Test (Dev : in out Device);
      
   private
      
      type A_IO_Access is access all Devices.Shared_IO (Devices.A_IO);
   
      type Device is new Devices.Root with record
         IO : A_IO_Access;
      end record;
      
   end A;
   
   package B is
      
      type Device is new A.Device with private;
      
      overriding
      procedure Test (Dev : in out Device);
      
   private
      
      type B_IO_Access is access all Devices.Shared_IO (Devices.B_IO);
   
      type Device is new A.Device with record
         IO : B_IO_Access;
      end record;
      
   end B;
   
   package body Devices is
      function Get_IO_Access (R : in out Root) return IO_Access is
      begin
         return R.IO'Unchecked_Access;
      end Get_IO_Access;
   end Devices;
   
   package body A is
      procedure Test (Dev : in out Device) is
      begin
         --  This assignment would typically be done upon object initialization
         Dev.IO := A_IO_Access (Get_IO_Access (Dev));
         --  Visibility tests
         Dev.IO.R0 := 0; --  Triggers compiler warning (GOOD! Unsure why that wouldn't be a compile time error though)
         Dev.IO.R1 := 1; --  Legal
      end Test;
   end A;
   
   package body B is
      overriding
      procedure Test (Dev : in out Device) is
      begin
         --  This assignment would typically be done upon object initialization
         Dev.IO := B_IO_Access (Get_IO_Access (Dev));
         --  Visibility tests
         Dev.IO.R0 := 0; --  Legal
         Dev.IO.R1 := 1; --  Legal
      end Test;
   end B;

I'm not quite convinced it's a good approach, but it's one.

Using Generics to limit the view

Using generics we can make only certain views accessible without the need to involve cumbersome and potentially problematic access types (no need to worry about initializing or accidentally overwriting them).

   type IO_Select is (A_IO, B_IO);
   type Shared_IO (S : IO_Select) is record
      R1 : Byte;
      case S is
         when A_IO => null;
         when B_IO => R0 : Byte;
      end case;
   end record with Unchecked_Union;
   for Shared_IO use record
      R0 at 2 range 0 .. 7;
      R1 at 3 range 0 .. 7;
   end record;

   generic
      S : IO_Select;
   package Common is
      type Common_Device is tagged record
         IO : Shared_IO (S);
      end record;
         
      procedure Test (Dev : in out Common_Device);
   end Common;
   
   package body Common is
      procedure Test (Dev : in out Common_Device) is
      begin
         Dev.IO.R0 := 0; -- Will trigger warning upon generic instantiation with IO_Select (A_IO)
         Dev.IO.R1 := 0; -- Will work fine on either generic instantiation
      end Test;
   end Common;
   
   package A is
      package Common_A is new Common (A_IO);
      
      type Device_A is new Common_A.Common_Device with null record;
      
      overriding procedure Test (Dev : in out Device_A);
   end A;
   
   package body A is
      overriding procedure Test (Dev : in out Device_A) is
      begin
         Dev.IO.R0 := 0; -- Triggers compiler warning
         Dev.IO.R1 := 0; -- Works fine
      end Test;
   end A;
   
   package B is
      package Common_B is new Common (B_IO);
      
      type Device_B is new Common_B.Common_Device with null record;
      
      overriding procedure Test (Dev : in out Device_B);
   end B;
   
   package body B is
      overriding procedure Test (Dev : in out Device_B) is
      begin
         Dev.IO.R0 := 0; -- Works fine
         Dev.IO.R1 := 0; -- Works fine
      end Test;
   end B;

Answer 2

I don't know if that is a bug or not. In the 7.1 and 7.2 series it compiles fine, but in 8.2 and 9.1 it fails to compile.

Since you are willing to use a tagged record and have the tag take up space in your bit layout, then a potential workaround is to use a variant untagged record and replace the tag with the variant. Consider:

type Record_Select is (A_IO, B_IO);
type Shared_Record(S : Record_Select) is record
    R1 : Byte;
    case S is
        when A_IO => null;
        when B_IO => R0 : Byte;
    end case; 
end record;
for Shared_Record use record
    S  at 0 range 0 .. 15;
    R0 at 2 range 0 .. 7;
    R1 at 3 range 0 .. 7;
end record;
for Shared_Record'Size use 32;

You can adjust the size to match your actual tag size. I just tossed some values in. This would give you a similar layout to a tagged record (minus the size difference of course).

Additionally, if you set the variant parameter to have a default value, you can potentially copy between the two variants without needing an unchecked conversion as long as you define them without the variant constraint in the type:

   type Record_Select is (A_IO, B_IO);

   -- Note the default value for S
   type Shared_Record(S : Record_Select := B_IO) is record
      R1 : Byte;
      case S is
         when A_IO => null;
         when B_IO => R0 : Byte;
      end case; 
   end record;
   for Shared_Record use record
      S  at 0 range 0 .. 15;
      R0 at 2 range 0 .. 7;
      R1 at 3 range 0 .. 7;
   end record;
   for Shared_Record'Size use 32;

   -- Note the unconstrained type definitions
   A : Shared_Record := (S => A_IO, R1 => 3);
   B : Shared_Record := (S => B_IO, R0 => 1, R1 => 2);
begin
   Put_Line(B.R1'Image);
   B := A;
   Put_Line(B.R1'Image);

output:

 2
 3