Как вернуть копию общеклассового объекта с модификацией базового типа в Аде

Question

У меня есть базовый тип, работа которого заключается в ведении списка предметов.Он имеет функцию не диспетчеризации для добавления элементов в него, а также для получения списка элементов из него.

Типы, полученные из этого базового типа, используют элементы в некоторых диспетчерских подпрограммах.Я уже могу реализовать это, имея базовый тип, содержащий вектор элементов, однако я хотел бы, чтобы массив был статическим, если это возможно.Вот что у меня есть:

base.ads:

package Bases is
    type Base (<>) is tagged private; -- I want to hide the size
    type Int_List is array (Positive range <>) of Integer; -- as an example

    function Create return Base; -- returns an empty Base

    function Add_To (This : Base'Class; I : Integer) return Base'Class; -- Append
    function Image (This : Base) return String; -- Dispatching example
    function List (This : Base'Class) return Int_List; -- Get the data for internal use
private
    type Base (Size : Natural) is tagged record
        Ints : Int_List (1 .. Size);
    end record;
end Bases;

base.adb:

package body Bases is
    function Create return Base is (Size => 0, Ints => (others => 0));
    function Add_To (This : Base'Class; I : Integer) return Base'Class is
        -- This is where I have trouble: "aggregate cannot be of a class-wide type"
        Copy : Base'Class := (This with Size => This.Size + 1, Ints => This.Ints & I);
    begin
        return Copy;
    end Add_To;
    function Image (This : Base) return String is ("BASE");
    function List (This : Base'Class) return Int_List is (This.Ints);
end Bases;

производные .ads:

with Bases;
package Deriveds is
    type Derived is new Bases.Base with null record;
    function Create return Derived;
    function Image (This : Derived) return String;
end Deriveds;

производные.adb:

with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
package body Deriveds is
    function Create return Derived is (Bases.Create with null record);
    function Image (This : Derived) return String is
        Result : Unbounded_String;
        Ints : Bases.Int_List := This.List;
    begin
        for I in Ints'Range loop
            Result := Result & Integer'Image (Ints (I));
        end loop;

        return To_String (Result);
    end Image;
end Deriveds;

Опять же, я знаю, что если я просто удаляю дискриминант и использую управляемый тип для хранения массива, то я могу просто создать копию как Copy : Base'Class := This; имутируйте его перед возвратом.Однако я чувствую, что должен быть способ сделать это только со статической памятью, что является желательным.Единственный другой обходной путь, о котором я мог подумать, - это создать еще один теговый тип, который будет представлять собой запись, содержащую список и данные Base'Class и чьи операции будут скрывать Base диспетчерские операции, передавая их через,

Нет ли способа создать Copy в Add_To, чтобы его дискриминант был на 1 больше и имел дополнительный элемент, использующий только статическую память?

Answer 1

Я знаю, что это требует немного больше работы, но вы также можете изменить Add_To, чтобы использовать Base вместо Base'Class.Затем вам придется переопределить его для любых производных типов с расширением, превышающим нулевое значение, но вы получите желаемый результат статического массива.Производные реализации будут похожи на то, как вы реализуете Create.

Пример (я изменил производный класс, чтобы иметь расширение не нулевой записи, чтобы компилятор требовал, чтобы вы производили операцию:

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

procedure Hello is

    package Bases is
        type Base (<>) is tagged private; -- I want to hide the size
        type Int_List is array (Positive range <>) of Integer; -- as an example

        function Create return Base; -- returns an empty Base

        function Add_To (This : Base; I : Integer) return Base; -- Append
        function Image (This : Base) return String; -- Dispatching example
        function List (This : Base'Class) return Int_List; -- Get the data for internal use
    private
        type Base (Size : Natural) is tagged record
            Ints : Int_List (1 .. Size);
        end record;
    end Bases;

    package body Bases is
        function Create return Base is (Size => 0, Ints => (others => 0));
        function Add_To (This : Base; I : Integer) return Base is
            -- This is where I have trouble: "aggregate cannot be of a class-wide type"
            Copy : Base := (Size => This.Size + 1, Ints => This.Ints & I);
        begin
            return Copy;
        end Add_To;
        function Image (This : Base) return String is ("BASE");
        function List (This : Base'Class) return Int_List is (This.Ints);
    end Bases;

    package Deriveds is
        type Derived is new Bases.Base with  record
            Value : Integer;
        end record;
        function Create return Derived;
        function Add_To(This : Derived; I : Integer) return Derived;
        function Image (This : Derived) return String;
    end Deriveds;

    package body Deriveds is
        function Create return Derived is (Bases.Create with Value => 0);
        function Image (This : Derived) return String is
            Result : Unbounded_String;
            Ints : Bases.Int_List := This.List;
        begin
            for I in Ints'Range loop
                Result := Result & Integer'Image (Ints (I));
            end loop;

            return To_String (Result);
        end Image;
        function Add_To(This : Derived; I : Integer) return Derived is
        begin
            return (Bases.Base(This).Add_To(I) with Value => This.Value);
        end Add_To;
    end Deriveds;

    use Deriveds;

    d0 : Derived := Create;
    d1 : Derived := d0.Add_To(1).Add_To(3);
    d2 : Derived := d1.Add_To(2);

begin
  Put_Line(d2.Image);
end Hello;

Answer 2

Думаю, проблема в том, что Bases.Add_To не имеет приятного, стандартного способа узнать, что добавить к записи Base (с увеличением Size) для репликации фактических данных, специфичных для класса, в This.

Полагаю, вы могли бы обойтись без неконтролируемого преобразования и построить запись, используя, возможно, Ada.Tags.Generic_Dispatching_Constructor ( здесь , здесь );но это кажется плохой идеей.