Ada：组件与父级重叠的派生记录
Ada: Derived record with components overlapping parent
我正在尝试为两个密切相关的不同设备定义一个硬件接口，但一个比另一个的功能稍微多一些。
作为问题的一个非常简化的版本，假设：
- 设备A有2个寄存器：R0未用，R1用
- 设备 B 有 2 个寄存器：同时使用 R0 和 R1
我试图通过多态定义重新使用代码和定义，例如：
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;
这会导致编译器错误，这在大多数情况下都很有意义：component overlaps parent field of "B_IO"（GNAT 社区 2019）。
我有替代方案，其中包括：
- 对每个设备使用相同的类型（con: 设备 A 会看到不应该显示的组件）
- 使用完全不同的类型，在使用共享代码时依靠通过访问类型的未经检查的转换来更改对象的视图（con: 将涉及重新定义一些相同的组件多次）
我想知道是否有一种可行的方法可以避免上述任何缺点。
我不知道这是不是一个错误。在7.1和7.2系列中编译正常，但在8.2和9.1中编译失败。
由于您愿意使用标记记录并让标记在位布局中占据 space，因此可能的解决方法是使用变体未标记记录并用变体替换标记。考虑：
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;
您可以调整尺寸以匹配您的实际标签尺寸。我只是扔了一些值。这会给你一个类似于标记记录的布局（当然减去大小差异）。
此外，如果您将 variant 参数设置为具有默认值，则可以在两个变体之间进行复制，而无需进行未经检查的转换，只要您在类型中定义它们时没有 variant 约束即可：
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);
输出：
2
3
以下是一些从 中汲取灵感并以此为基础的方法：
使用访问类型限制视图
- 与 Jere 一样，它使用一个记录，该记录将与两个依赖于定义重叠字段的变体的实现共享。
- 使用 Unchecked_Union 方面消除了存储变体的需要。
- 将硬件 IO 定义封装在标记记录中，允许在两个设备的实现之间进行继承和 OO。不管设备的软件实现是否需要保持内部状态而不仅仅是 IO 结构，都需要某种封装。
- 使用访问类型确保每个设备实现只能访问正确的组件（无需依赖未经检查的转换）。
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;
我不太相信这是一个好方法，但它是一个。
使用泛型限制视图
使用泛型，我们可以只访问某些视图，而无需涉及繁琐且可能有问题的访问类型（无需担心初始化或意外覆盖它们）。
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;
我正在尝试为两个密切相关的不同设备定义一个硬件接口，但一个比另一个的功能稍微多一些。
作为问题的一个非常简化的版本，假设：
- 设备A有2个寄存器：R0未用，R1用
- 设备 B 有 2 个寄存器：同时使用 R0 和 R1
我试图通过多态定义重新使用代码和定义，例如：
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;
这会导致编译器错误，这在大多数情况下都很有意义：component overlaps parent field of "B_IO"（GNAT 社区 2019）。
我有替代方案，其中包括：
- 对每个设备使用相同的类型（con: 设备 A 会看到不应该显示的组件）
- 使用完全不同的类型，在使用共享代码时依靠通过访问类型的未经检查的转换来更改对象的视图（con: 将涉及重新定义一些相同的组件多次）
我想知道是否有一种可行的方法可以避免上述任何缺点。
我不知道这是不是一个错误。在7.1和7.2系列中编译正常，但在8.2和9.1中编译失败。
由于您愿意使用标记记录并让标记在位布局中占据 space，因此可能的解决方法是使用变体未标记记录并用变体替换标记。考虑：
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;
您可以调整尺寸以匹配您的实际标签尺寸。我只是扔了一些值。这会给你一个类似于标记记录的布局（当然减去大小差异）。
此外，如果您将 variant 参数设置为具有默认值，则可以在两个变体之间进行复制，而无需进行未经检查的转换，只要您在类型中定义它们时没有 variant 约束即可：
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);
输出：
2
3
以下是一些从
使用访问类型限制视图
- 与 Jere 一样，它使用一个记录，该记录将与两个依赖于定义重叠字段的变体的实现共享。
- 使用 Unchecked_Union 方面消除了存储变体的需要。
- 将硬件 IO 定义封装在标记记录中，允许在两个设备的实现之间进行继承和 OO。不管设备的软件实现是否需要保持内部状态而不仅仅是 IO 结构，都需要某种封装。
- 使用访问类型确保每个设备实现只能访问正确的组件（无需依赖未经检查的转换）。
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;
我不太相信这是一个好方法，但它是一个。
使用泛型限制视图
使用泛型，我们可以只访问某些视图，而无需涉及繁琐且可能有问题的访问类型（无需担心初始化或意外覆盖它们）。
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;