Адское программирование.

Copyright (C) А.Гавва V-0.4w май 2004

3. Общие приемы программирования

3.1 Абстракция стека

В качестве простого примера, который демонстрирует использование пакета для реализации абстрактного типа данных, рассмотрим стек. Следует заметить, что клинтам этого пакета абсолютно безразлично каким образом выполнена внутренняя реализация стека, то есть клиенты не нуждаются в информации о том, что стек реализован с помошью массива или связанного списка. Шаблоном подобной абстракции может служить следующее:
package Stacks is

    Max : constant  := 10;

    subtype Count is Integer range 0..Max;
    subtype Index is range 1..Max;

    type List is array(Index) of Integer;

    type Stack is
        record
            Values : List;
            Top    : Count;
        end record;

    Overflow  : exception;
    Underflow : exception;        

    procedure Push(Item : in out Stack; Value : in Integer);
    procedure Pop(Item : in out Stack; Value : out Integer);

    function Full(Item : Stack) return Boolean;
    function Empty(Item : Stack) return Boolean;

    -- возвращает пустой проинициализированный стек
    function Init return Stack;

end Stacks;
Однако, в данном случае детали реализации достаточно очевидны, то есть кроме того, что клиенту пакета доступно то, что пакет предоставляет в качестве сервиса, клиенту пакета также доступно и то, как этот сервис реализован. Такую ситуацию можно достаточно просто изменить переместив все, в чем клиент не будет нуждаться, в приватную секцию спецификации пакета:
package Stacks is
        
    type Stack is private;
    -- неполное описание типа Stack.
    -- это делает информацию о деталях реализации недоступной.

    Overflow  : exception;
    Underflow : exception;

    procedure Push(Item : in out Stack; Value : in Integer);
    procedure Pop(Item : in out Stack; Value : out Integer);

    function Full(Item : Stack) return Boolean;
    function Empty(Item : Stack) return Boolean;

    -- возвращает пустой проинициализированный стек
    function Init return Stack;

private
    -- полное описание типа, вместе с другими приватными деталями.
    Max : constant  := 10;
    subtype Count is Integer range 0..Max;
    subtype Index is range 1..Max;

    type List is array(Index) of Integer;

    type Stack is
        record
            Values : List;
            Top    : Count;
        end record;
end Stacks;
Следует заметить, что хотя программист использующий такую абстракцию, имеет возможность увидеть все детали реализации (при наличии исходных текстов кода), он не может написать свою собственную программу, которая будет использовать эту информацию. Также очевидно, что такое разделение вынуждает лучше понять, что для абстракции важно, а что нет.

В качестве альтернативы, можно изменить приватную секцию в соответствии с реализацией стека на связанном списке:
package Stacks is
        
    type Stack is private;
    -- неполное описание типа Stack.
    -- это делает информацию о деталях реализации недоступной.

    Overflow  : exception;
    Underflow : exception;

    procedure Push(Item : in out Stack; Value : in Integer);
    procedure Pop(Item : in out Stack; Value : out Integer);

    function Full(Item : Stack) return Boolean;
    function Empty(Item : Stack) return Boolean;

    -- возвращает пустой проинициализированный стек
    function Init return Stack;

private
    type Stack;

    type Ptr is access Stack;

    type Stack is
        record
            Value  : Integer;
            Next   : Ptr;
        end record;
end Stacks;
Программа-клиент может использовать оба варианта пакета следующим образом:
with Stacks;        use Stacks;

procedure Demo is

    A    : Stack := Init;
    B    : Stack := Init;
    Temp : Integer;

begin
    for I in 1..10 loop
        Push(A, I);
    end loop;

    while not Empty(A) loop
        Pop(A, Temp);
        Push(B, Temp);
    end loop;
end Demo;
Примечательно, что оба варианта реализации стека достаточно отличаются один от другого. Таким образом, показанные выше примеры наглядно демонстрируют использование идеи возможности подстановки различной реализации, или, более точно, использование программой-клиентом только того, что предоставляет публичный интерфейс. Напомним, что этот принцип очень важен при построении надежных систем.

Рассмотрим еще один пример использования рассмотренной абстракции стека:
with Stacks;        use Stacks;

procedure Not_Quite_Right is

    A, B : Stack

begin
        Push(A, 1);
        Push(A, 2);

        B := A;
end Not_Quite_Right;
Не трудно заметить, что при копировании реализация стека с использованием массива будет работать корректно, а реализация стека с использованием связанного списка скопирует только указатель на "голову" списка, после чего A и B будут указывать на один и тот же связанный список. Действительно, поскольку внимание текущего обсуждения больше посвящено теме абстракции данных, показанная выше реализация стека на связанном списке максимально упрощена. Для того чтобы избавиться от подобных "сюрпризов" в практической реализации стека на связанном списке необходимо использовать средства, которые предоставляют контролируемые типы Ады.

3.2 Приватное наследование

3.2.1 Абстракция очереди

Очень важно определить различие между тем какие сервисы предусматривает тип, и как этот тип их реализует. Например, абстракция списка, которая имеет соответствующие подпрограммы и сама может быть реализована как связанный список или как массив, может быть использована для реализации абстракции очереди. Абстракция очереди будет иметь только несколько операций:
Add_To_Tail
Remove_From_Head
Full
Empty
Init
Необходимо убедиться, что в программе существует четкое различие между используемой абстракцией и реализацией. Кроме того, желательно возложить на компилятор проверку правильности осуществления вызова подпрограмм реализации, чтобы автоматически предотвратить непреднамеренные обращения к подпрограммам используемой абстракции.

Ниже приведен пример пакета использование которого может привести к проблемам:
package Lists is

    type List is private;

    procedure Add_To_Head(Item : in out List; Value : in Integer);
    procedure Remove_From_Head(Item : in out List; Value : out Integer);

    procedure Add_To_Tail(Item : in out List; Value : in Integer);
    procedure Remove_From_Tail(Item : in out List; Value : out Integer);

    function Full(Item : List) return Boolean;
    function Empty(Item : List) return Boolean;

    function Init return List;

private
    type List is ... -- полное описание типа

end Lists;



with Lists;        use Lists;        -- абстракция списка Lists

package Queues is

    type Queue is new List;
    -- наследует операции типа List
    -- то есть, следующее описано "автоматически" (неявно)
    --
    -- procedure Add_To_Head(Item : in out Queue; Value : in Integer);
    -- procedure Remove_From_Head(
    --        Item  : in out Queue;
    --        Value :    out Integer);
    -- и т.д.
        
end Queues;
Здесь, тип очереди (Queue) наследует все операции типа список (List), даже те, которые для него не предназначены (например Remove_From_Tail). При такой реализации типа Queue, клиенты абстракции могут легко нарушить очередь, которая должна разрешать только вставку в конец очереди и удаление из начала очереди.

Например, клиент пакета Queues может легко сделать следующее:
with Queues;        use Queues;

procedure Break_Abstraction is

    My_Q : Queue;

begin
    Add_To_Head(My_Q, 5);
    Add_To_Tail(My_Q, 5);

    -- очередь должна разрешать вставку в конец очереди
    -- и удаление из начала очереди,
    -- или наоборот

end Break_Abstraction;
Для решения подобной проблемы при создании абстракции очереди необходимо использовать абстракцию списка приватно:
with Lists;        -- это используется только приватной секцией

package Queues is

    type Queue is private;

    procedure Remove_From_Head(Item : in out Queue; Value : out Integer);
    procedure Add_To_Tail(Item : in out Queue; Value : Integer);

    function Full(Item : Queue) return Boolean;
    function Empty(Item : Queue) return Boolean;

    function Init return Queue;

private
    type Queue is new Lists.List;

end Queues;



package body Queues is

    -- выполняем конверсию типов (из Queue в List), а затем,
    -- выполняем вызов соответствующей подпрограммы List

    use Lists;

    --------------------------------------------------------------------
    procedure Remove_From_Head(Item : in out Queue; Value : out Integer) is
    begin
        Lists.Remove_From_Head(List(Item), Value);
    end Remove_From_Head;

    --------------------------------------------------------------------
    function Full(Item : Queue) return Boolean is
    begin
        return Lists.Full(List(Item));
    end Full;

        . . .

    function Init return Queue is
    begin
        return Queue(Lists.Init);
    end Init;

end Queues;
3.2.2 Еще один пример стека

Предположим, что мы хотим создать пакет стека, но при этом, мы не хотим переписывать все подпрограммы. Мы уже имеем реализацию связанного списка, которая может служить основой для организации стека. Заметим, что пакет Lists сохраняет значения типа Integer.

Допустим, что существует пакет Lists, который описан следующим образом:
package Lists is

    type List is private;

    Underflow : exception;

    procedure Insert_At_Head(Item : in out List; Value : in Integer);
    procedure Remove_From_Head(Item : in out List; Value : out Integer);

    procedure Insert_At_Tail(Item : in out List; Value : in Integer);
    procedure Remove_From_Tail(Item : in out List; Value : out Integer);

    function Full(Item : List) return Boolean;
    function Empty(Item : List) return Boolean;

    -- возвращает пустой проинициализированный список
    function Init return List;

private

    . . .

end Lists;
Позже можно будет использовать возможность Ады, которая позволяет скрыть полное описание типа в приватной секции. В данном случае, описывается абсолютно новый тип (поскольку в этом заинтересован клиент), который реально реализован как производный тип. В результате, клиент не может это "увидеть", и детали реализации остаются надежно спрятанными "под капотом".

Таким образом, реализация стека осуществляется следующим образом:
with Lists;

package Stacks is

    type Stack is private;

    Underflow : exception;

    procedure Push(Item : in out Stack; Value : in Integer);
    procedure Pop(Item : in out Stack; Value : out Integer);

    function Full(Item : Stack) return Boolean;
    function Empty(Item : Stack) return Boolean;

    -- возвращает пустой проинициализированный стек
    function Init return Stack;

private
    -- создаем новый тип, производя его от уже существующего
    -- это остается спрятанным от клиента, который будет
    -- использовать наш новый тип

    type Stack is new Lists.List;

    -- тип Stack наследует все операции типа List
    -- это неявно описывается как
    --
    -- procedure Insert_At_Head(Item : in out Stack; Value : in Integer);
    -- procedure Remove_From_Head(Item : in out Stack;
    --                            Value :    out Integer);
    --     . . .
    -- function Full(Item : Stack) return Boolean;
    -- function Empty(Item : Stack) return Boolean;
    -- function Init return Stack;

end Stacks;
Теперь нам необходимо установить связь между неявно описанными подпрограммами (унаследованными от типа List), и подпрограммами, которые должны быть публично доступны. Это достаточно просто выполняется с помощью механизма "транзитного вызова".
package body Stacks is

    procedure Push(Item : in out Stack; Value : in Integer) is
    begin
        Insert_At_Head(Item, Value);
    end Push;
    -- эту процедуру можно сделать более эффективной, используя:
    pragma Inline(Push);


    procedure Pop(Item : in out Stack; Value : out Integer) is
    begin
        Remove_From_Head(Item, Value);
    exception =>
        when Lists.Underflow =>
            raise Stacks.Underflow;
    end Pop;

        . . .

end Stacks;
Следует заметить, что все это справедливо для публично описанных подпрограмм, имена которых отличаются от имен неявно описанных подпрограмм (тех, которые унаследованы от типа List). Однако, в спецификации пакета, присутствуют две функции Full, которые имеют профиль:
function Full(Item : Stack) return Boolean;
В данном случае, одна функция описана в публично доступной секции, а вторая, неявно описана в приватной секции. Что же происходит на самом деле? Спецификация первой функции в публично доступной секции пакета - это только обещание предоставить эту функцию. Таким образом, это еще не реализованая функция, ее реализация будет выполнена где-то в теле пакета. Кроме этой функции существует другая, неявно описанная функция, которая, по-случаю, имеет такие же имя и профиль. Компилятор Ады может обнаружить, что обе функции имеют одинаковые имя и профиль, но он ничего не предполагает о том, что публично описанная функция должна быть реализована приватной функцией.

Например, предположим, что Lists.Full всегда возвращает "ложь" (False), для индикации того, что связанный список никогда не заполнен полностью и всегда может увеличиваться. Разработчику стекового пакета может понадобиться принудительное ограничение размера стека. Например, так чтобы стек мог содержать максимум 100 элементов. После чего разработчик стекового пакета соответствующим образом пишет функцию Stacks.Full. Это будет не корректно для реализации функции Full по-умолчанию, которая наследуется от реализации связанного списка.

Согласно правил видимости Ады, явное публичное описание полностью скрывает неявное приватное описание, и, таким образом, приватное описание становится вообще не доступным. Единственным способом вызвать функцию Full пакета Lists, будет явный вызов этой функции.
package body Stacks is

    function Full(Item : Stack) return Boolean is
    begin
        -- вызов оригинальной функции Full из другого пакета
        return Lists.Full(Lists.List(Item));
                          -- конверсия типа параметра
    end Full;

        . . .

end Stacks;
Все это выглядит ужасающе, но в чем заключается смысл таких требований Ады? Оказывается, обнаружение подобного рода проблем заключается в сущности конструирования программ с независимыми пространствами имен, или, выражаясь точнее, в разделении различных областей действия имен, где одинаковые имена не конфликтуют между собой. Таким образом, Ада просто предусматривает решение проблемы, которая является неизбежным последствием наличия различных пространств имен. Вариант языка в котором отсутствуют пространства имен - еще хуже чем такое решение. Поэтому, "не надо выключать пейджер, только потому, что не нравятся сообщения". Это очень существенное замечание, и не следует двигаться дальше, пока суть этого замечания не понятна.

Вид всего тела пакета Stacks может быть следующим:
use Lists;

package body Stacks is

    procedure Push(Item : in out Stack; Value : in Integer) is
    begin
        Insert_At_Head(Item, Value);
    end Push;


    procedure Pop(Item : in out Stack; Value : out Integer) is
    begin
        Remove_From_Head(Item, Value);

    exception =>
        when Lists.Underflow =>
            raise Stacks.Underflow;
    end Pop;
    -- примечательно, что исключение объявленное в другом пакете
    -- "транслируется" в исключение описанное внутри этого пакета


    function Full(Item : Stack) return Boolean is
    begin
        return Lists.Full(List(Item));
    end Full;


    function Empty(Item : Stack) return Boolean is
    begin
        return Lists.Empty(List(Item));
    end Empty;


    -- возвращает пустой проинициализированный стек
    function Init return Stack is
    begin
        return Stack(Lists.Init);
    end Init;

end Stacks;
3.3 Использование настраиваемых модулей

3.3.1 Создание абстракций из настраиваемых абстракций

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

Предположим, что существует пакет Generic_Lists спецификация которого имеет следующий вид:
generic
    type Element is private;

package Generic_Lists is

    type List is private;

    Underflow : exception;

    procedure Insert_At_Head(Item : in out List; Value : in Element);
    procedure Remove_From_Head(Item : in out List; Value : out Element);

    procedure Insert_At_Tail(Item : in out List; Value : in Element);
    procedure Remove_From_Tail(Item : in out List; Value : out Element);

    function Full(Item : List) return Boolean;
    function Empty(Item : List) return Boolean;

    -- возвращает пустой инициализированный список
    function Init return List;

private

    . . .

end Generic_Lists;
Мы можем конкретизировать этот настраиваемый модуль для создания экземпляра нового пакета, который будет сохранять для нас значения типа Integer. Необходимо обратить внимание на то, что конкретизацию такого настраиваемого модуля следует осуществлять в приватной секции пакета. Это позволяет избежать нарушения абстракции и предотвращает возможность появления каких-либо дополнительных трудностей разработки.

После этого, настраиваемый модуль может быть использован следующим образом:
with Generic_Lists;

package Stacks is

    type Stack is private;

    Underflow : exception;

    procedure Push(Item : in out Stack; Value : in Integer);
    procedure Pop(Item : in out Stack; Value : out Integer);

    function Full(Item : Stack) return Boolean;
    function Empty(Item : Stack) return Boolean;

    -- возвращает пустой инициализированный стек
    function Init return Stack;


private

    -- конкретизация настраиваемого модуля для получения нового пакета
    package Lists is new Generic_Lists(Integer);


    type Stack is new Lists.List;
    -- как и раньше, тип Stack наследует все операции типа List

end Stacks;
Тело пакета Stack будет таким же как и описывалось ранее. Следует заметить, что в данном случае мы можем навязать приватность без изменения того, что тип выполняет для клиента.

3.3.2 Настраиваемый модуль как параметр настройки

Настраиваемый модуль может быть конкретизирован с помощью использования настраиваемого модуля в качестве формального параметра настройки. В таком случае спецификация формального параметра может быть выполнена следующим образом:
generic
  with package P is new P_G (<>);  -- фактический параметр для P_G определяется
package Module_G is ...            -- в P_G как обычно, а также (new) в Module_G
Такой вид формального параметра настройки значительно упрощает импортирование целой абстракции. При этом нет необходимости указывать тип и делать полное перечисление необходимых подпрограмм, с соответственным указанием их профилей (параметр/результат). Следовательно, вся абстракция типа данных, которая описывается настраиваемым пакетом, может быть импортирована очень просто.

Такой механизм подразумевает построение одной настраиваемой абстракции из другой настраиваемой абстракции или расширение уже существующей абстракции. Например, так может быть построен пакет двунаправленного связанного списка (экспортируя Insert, Delete и Swap) при описании операции Sort, выполняющей сортировку при вставке.

В качестве иллюстрации данного подхода рассмотрим спецификации двух взаимосвязанных абстрактных типов данных: комплексные числа и матрицы комплексных чисел. Абстрактный тип данных комплексных чисел - это настраиваемый модуль с формальным параметром вещественного типа:
generic
  type Float_Type is digits <>;
package Complex_Numbers_G is
  type Complex_Type is private;
  function Value (Re, Im : Float_Type) return Complex_Type;
  function "+" (Left, Right : Complex_Type) return Complex_Type;
  ... -- другие операции

private
  type Complex_Type is record
    Re, Im : Float_Type;
  end record;
end Complex_Numbers_G;
Абстрактный тип данных матрицы комплексных чисел - это настраиваемый модуль с формальным параметром абстрактного типа данных комплексных чисел (то есть с любой конкретизацией настраиваемого пакета показанного выше):
with Complex_Numbers_G;
generic
  with package Complex_Numbers is
    new Complex_Numbers_G (<>);
  use Complex_Numbers;
package Complex_Matrices_G is
  type Matrix_Type is
    array (Positive range <>, Positive range <>) of
      Complex_Type;
  function "*" (Left : Complex_Type; Right : Matrix_Type)
    return Matrix_Type;
  ... -- другие операции
end Complex_Matrices_G;
Следующий пример показывает две типичные конкретизации абстрактных типов данных для выполнения вычислений с комплексными числами и матрицами:
package Complex_Numbers is
  new Complex_Numbers_G (Float);
package Complex_Matrices is
  new Complex_Matrices_G (Complex_Numbers);



package Long_Complex_Numbers is
  new Complex_Numbers_G (Long_Float);
package Long_Complex_Matrices is
  new Complex_Matrices_G (Long_Complex_Numbers);
3.3.3 Тэговый тип как параметр настройки

Поскольку стандарт Ada95 различает два вида типов: тэговые и не тэговые, - то бывают случаи когда при работе с настраиваемыми модулями их необходимо различать. Подобная необходимость более точного указания свойств ожидаемого формального параметра настройки (формальный тип тэговый или нет) может возникнуть при желании более строгого определения контрактной модели настраиваемых модулей. Указание тэгового типа как формального параметра настройки может иметь следующий вид:
generic
  type T is tagged private;
package Module_G is ...
В случае использования тэговых типов как формальных параметров настройки особый интерес представляют конструкции для расширения типа и для надклассового программирования. Конструкция для расширения типа позволяет добавлять новые компоненты, и является основой для множественного наследования. Конструкции для надклассового программирования позволяют предоставить подпрограммы, которые применимы к T'Class, или описать типы надклассовых ссылок (подобные описания будут точно адаптированы для любого типа в указанном классе наследования при конкретизации).
generic
  type T is tagged private;
package Module_G is
  type NT is new T  -- расширение типа
    with record
      B : Boolean;
    end record;

  function Equals (Left, Right : T'Class)  -- надклассовая подпрограмма
    return Boolean;

  type T_Poly_Ref is  -- тип надклассовой ссылки
    access T'Class;
end Module_G;
3.3.4 Производный тип как параметр настройки

Использование производного типа как формального параметра настройки подобно использованию в качестве формального параметра настройки настраиваемого модуля. В этом случае, формальный параметр описывается как тип, производный от указанного предка, подразумевая, что он совпадает с любым типом в классе наследования, корнем которого будет указанный предок. Следует учитывать, что синтаксис для тэговых и не тэговых типов различен.

Указание производного не тэгового типа в качестве формального параметра настройки может иметь следующий вид:
generic                 -- внутри Module_G, известными для T операциями являются
  type NT is new T;     -- операции для объектов типа NT с неявным
package Module_G is ... -- преобразованием представления T в NT
Указание производного тэгового типа в качестве формального параметра настройки может иметь следующий вид:
generic             -- внутри Module_G, известные операции для T индицируют
  type NT is new T  -- диспетчеризуемые операции доступные для объектов типа NT
    with private;   -- причем, все вызовы используют NT-реализацию операций
package Module_G is ...
Формальный параметр производного типа осуществляет параметризацию настраиваемого модуля типом и его примитивными операциями не смотря на то, что указанный тип предка не известен. Подобным образом, в случае передачи настраиваемого абстрактного типа данных как формального параметра настройки (при использовании в качестве формального параметра настройки настраиваемого модуля), множество известных операций связывается вместе с фактическим типом.

В качестве примера рассмотрим тэговый абстрактный тип данных для рациональных чисел. Кто-либо может предусмотреть ввод/вывод таких чисел также как для любого другого типа, производного от этого абстрактного типа данных (например, кому-то может потребоваться оптимизация действий, выполняемых какими-либо знаками операций). Вариантом решения может служить настраиваемый пакет ввода/вывода, чьим формальным параметром настройки будет параметр производного типа, а абстрактный тип данных будет указан как тип предок. Тогда требуемые операции не будут нуждаться в перечислении, как дополнительные формальные параметры настройки, поскольку они определяются типом предка.

Спецификация абстрактного типа данных для рациональных чисел может иметь следующий вид:
package Rational_Numbers is
  type Rational_Type is tagged private;
  function To_Ratio (Numerator, Denominator : Integer)
    return Rational_Type;
  -- возбуждает Constraint_Error когда Denominator = 0

  function Numerator (Rational : Rational_Type) return Integer;
  function Denominator (Rational : Rational_Type) return Positive;
  -- результат не нормализован к множителю общих делителей

  ... -- другие операции: "+", "-", "*", "/", ...
private
  ...
end Rational_Numbers;
Спецификация настраиваемого пакета ввода/вывода для типов, производных от Rational_Type:
with Rational_Numbers, Text_IO;
generic
  type Num_Type is
    new Rational_Numbers.Rational_Type with private;
package Rational_IO is
  procedure Get (File : in Text_IO.File_Type; Item : out Num_Type);
  procedure Put (File : in Text_IO.File_Type; Item : in Num_Type);
end Rational_IO;
Такой вид параметров настраиваемого модуля будет полезен при комбинировании абстракций и построении настраиваемых частей кода, которые будут адаптироваться к любому типу входящему в класс наследования, опираясь на базис свойств, которые применимы ко всем типам класса наследования (то есть известны для корневого типа класса наследования).

3.4 Построение абстракции путем композиции

Абстракция данных может быть построена с помощью композиции, когда новый абстрактный тип данных составляется из нескольких уже существующих абстрактных типов данных. В таком случае, новый тип данных описывается как запись (или тэговая запись) полями которой являются уже существующие типы данных. Функциональность нового типа данных обеспечивается путем перенаправления вызовов подпрограмм к соответствующим компонентам этого типа. Рассмотрим следующий пример:
with Lists;        use Lists;

package Queues is

    type Queue is private;

    procedure Remove_From_Head(Item : in out Queue; Value : out Integer);
    procedure Add_To_Tail(Item : in out Queue; Value : Integer);

    function Full(Item : Queue) return Boolean;
    function Empty(Item : Queue) return Boolean;

    function Init return Queue;

private
    -- очередь состоит из следующих элементов:

    type Queue is record
        Values         : List;
        No_Of_Elements : Integer;
    end record;
end Queues;



package body Queues is

    procedure Remove_From_Head(Item : in out Queue; Value : out Integer) is
    begin
        Remove_From_Head(Item.Values, Value);
        Item.No_Of_Elements := Item.No_Of_Elements - 1;
    end Remove_From_Head;


    procedure Add_To_Tail(Item : in out Queue; Value : Integer) is
    begin
        Add_To_Tail(Item.Values, Value);
        Item.No_Of_Elements := Item.No_Of_Elements + 1;
    end Add_To_Tail;


    procedure Reset (Item : in out Queue) is ...


    function Full(Item : Queue) return Boolean is
    begin
        return Full(Item.Values);
    end Full;

    function Empty(Item : Queue) return Boolean is
    begin
        return Item.No_Of_Elements = 0;
    end Empty;

end Queues;
В этом примере вызовы подпрограмм, обращенные к типу очереди Queue, будут "перенаправлены" к компоненту список (List), на который возлагается ответственность за реализацию некоторых аспектов абстракции очереди (в данном случае - это основная часть).

3.5 Абстрагирование общей функциональности

Показанные ранее реализации стека, предусматривали общее множество подпрограмм, таких как Push, Pop, и т.д. В Аде, мы можем установить общность используя общий тип. Общий тип описывает какие должны быть предусмотрены подпрограммы и какие профили должны иметь эти подпрограммы. При этом, он не указывает как реализовать эти подпрограммы. Тогда, тип, производный от такого общего типа, вынужден представить свою собственную реализацию каждой подпрограммы. Такой общий тип называют абстрактным типом, и он является абстракцией абстракции. Смысл этого заключается в том, чтобы указать клиентам абстракции, что выбор конкретной реализации абстракции не имеет значения. Клиенты всегда получат, как минимум, ту функциональность, которая описана абстрактным типом. Рассмотрим следующий пример:
package Stacks is

    type Stack is abstract tagged null record;
    -- абстрактный тип, который не имеет полей, и не имеет "реальных" операций.
    -- Ада требует "tagged"-описание для абстрактных типов.

    Underflow : exception;
    Overflow  : exception;

    procedure Push(Item : in out Stack; Value : in Integer) is abstract;
    procedure Pop(Item : in out Stack; Value : out Integer) is abstract;

    function Full(Item : Stack) return Boolean is abstract;
    function Empty(Item : Stack) return Boolean is abstract;

    function Init return Stack is abstract;

end Stacks;
В данном случае, в пакете Stacks описан абстрактный тип стека Stack. Причем, в этом пакете приводится только перечень подпрограмм, которые будут реализованы каким-либо типом, производным от абстрактного типа Stack. Примечательно, что тип Stack может быть приватным:
package Stacks is

    type Stack is abstract tagged private;

    -- подпрограммы
        . . .

private

    type Stack is abstract tagged null record;

end Stacks;
В этом же пакете или, что более типично, в другом пакете, можно описать расширение типа Stack и создать производный тип, который реализует указанную функциональность абстрактного типа:
with Lists;
with Stacks;

package Unbounded_Stacks is

    type Unbounded_Stack is new Stacks.Stack with private;
    -- тип Unbounded_Stack, производный от пустой записи стек,
    -- с небольшим расширением, добавленным как описано в приватной
    -- секции

    procedure Push(Item : in out Unbounded_Stack; Value : in Integer);
    procedure Pop(Item : in out Unbounded_Stack; Value : out Integer);

    function Full(Item : Unbounded_Stack) return Boolean;
    function Empty(Item : Unbounded_Stack) return Boolean;

    -- возвращает пустой инициализированный Unbounded_Stack
    function Init return Unbounded_Stack;

private

    -- Расширяет пустую запись Stacks.Stack на одно поле.
    -- Все вызовы будут перенаправлены к внутреннему
    -- связанному списку.

    type Unbounded_Stack is new Stacks.Stack with
        record
            Values : Lists.List;
        end record;

end Unbounded_Stacks;
В данном случае, для реализации функциональности, которая задана абстрактным типом Stack, необходимо чтобы вызовы подпрограмм, обращенные к типу Unbounded_Stack, были соответствующим образом перенаправлены к связанному списку. Таким образом, тело пакета Unbounded_Stacks будет иметь следующий вид:
package body Unbounded_Stacks is

    procedure Push(Item : in out Unbounded_Stack; Value : in Integer) is
    begin
        Lists.Insert_At_Head(Item.Values, Value);
    end Push;

    procedure Pop(Item : in out Unbounded_Stack; Value : out Integer) is
    begin
        Lists.Remove_From_Head(Item.Values, Value);
    exception
        when Lists.Underflow =>
            raise Stacks.Underflow;
    end Pop;

        . . .

end Unbounded_Stacks;
3.6 Многоуровневые абстракции

При построении новой абстракции из другой абстракции, новая абстракция может нуждаться в доступе к приватным описаниям уже существующей абстракции. Например, повсеместные "widgets", использующиеся для программирования в X Window System, имеют спецификации (такие как "labels"), которые зависят от их реализации в приватном представлении "widgets".

Описание абстрактного типа данных Widget_Type для X Window System может иметь следующий вид:
with X_Defs; use X_Defs;
package Xtk is
  type Widget_Type is tagged private;
  procedure Show (W : in Widget_Type);
private
  type Widget_Ref is access all Widget_Type'Class;
  type Widget_Type is
    record
      Parent        : Widget_Ref;
      Class_Name    : X_String;
      X, Y          : X_Position;
      Width, Height : X_Dimension;
      Content       : X_Bitmap;
    end record;
end Xtk;
В данном случае, построение абстракции Label_Type поверх Widget_Type удобно осуществить с помощью создания дочернего модуля Xtk.Labels, который может выглядеть следующим образом:
with X_Defs; use X_Defs;
package Xtk.Labels is
  type Label_Type is new Widget_Type with private;
  procedure Show (L : in Label_Type);
  -- необходим доступ к приватным описаниям Xtk (например, позиция label)
private
  type Label_Type is new Widget_Type
    with record
      Label : X_String;
      Color : X_Color_Type;
    end record;
end Xtk.Labels;
Следует заметить, что в подобных случаях, иерархия модулей, как правило, параллельна иерархии абстракций представленных в этих модулях.

3.7 Комбинирование абстракций, множественное наследование

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

Следует также заметить, что поддержка множественного наследования значительно усложняет язык программирования. Она требует введения различных дополнительных правил для "разборок" с патологическими случаями. Примером такого случая может служить повторяющееся наследование, то есть, ситуация, когда наследование выполняется от различных абстракций, которые имеют одного общего предка.

Основываясь на этом, Ада не предусматривает встроенных механизмов поддержки множественного наследования. Следует заметить, что это не является недостатком, поскольку задачи, которые требуют использование множественного наследования в других языках программирования, как правило, могут быть решены другими средствами Ады. Кроме того, Ада предусматривает средства с помощью которых можно построить множественное наследование "вручную".

В отличие от языков программирования для которых единственным используемым понятием абстракции данных является класс, а наследование является главенствующим механизмом комбинирования абстракций и управления пространством имен, при программировании на языке Ада нет необходимости использовать множественное наследование вне задач классификации. Например, сборку новых объектов из других, уже существующих объектов, легче осуществить путем композиции, а не путем использования множественного наследования. Руководство по хорошо известному объектно-ориентированному языку программирования предлагает описать тип Apple_Pie (яблочный пирог) путем наследования от типов Apple (яблоко) и Cinnamon (корица). Это типичный случай ошибочного использования множественного наследования: производный тип наследует все свойства своих предков, хотя не все эти свойства применимы к производному типу. В данном примере, бессмысленно производить Apple_Pie (яблочный пирог) от Apple (например, Apple_Pie - не растет на дереве и не имеет кожуры). Ада не требует использования множественного наследования для управления пространством имен. Это выполняется не зависимо от классов и достигается путем использования соответствующих спецификаторов контекста (with и/или use).

Зависимость реализации, когда спецификация наследуется от одного типа, а реализация - от другого, может быть выражена без использования множественного наследования. Например, тип Bounded_Stack может быть построен путем наследования от абстрактного типа Stack, который описывает интерфейс (операции Push, Pop, ...) и конкретного типа Array, который будет предусматривать реализацию. Однако, такая форма множественного наследования будет правильной только в том случае, если все операции унаследованные от реализующего типа будут иметь смысл для производного типа. В этом случае, операции, которые предоставляют доступ к элементам массива, должны быть скрыты от пользователей типа Bounded_Stack, поскольку только тот элемент, который находится на вершине стека, должен быть доступен клиентам. Вместо всего этого, в Аде, новая абстракция может использовать простое наследование для описания спецификации и обычную композицию для реализации.

3.7.1 Смешанное наследование

Смешанное наследование является формой множественного наследования при котором одна или две комбинированных абстракции выступают в роли шаблонов (subpattern). Любой подобный шаблон предоставляет множество свойств (компонентов и операций) способных присутствовать в различных, иначе не связанных, типах, самостоятельное использование которых не достаточно для описания более чем одного абстрактного типа.

Построение шаблонов может быть выполнено без явного множественного наследования, путем использования одиночного наследования и средств предоставляемых настраиваемыми модулями:

Шаблон абстрагируется в производную абстракцию посредством сборки множества свойств, то есть добавлением значений в расширение типа. Такой смешанный тип (mixin type) может быть использован для специализации общего поведения типа.

Настраиваемый пакет используется как смешанный пакет (mixin package), который инкапсулирует смешанный тип. Этот пакет имеет формальный параметр настройки тэгового типа, который, в свою очередь, играет роль типа-предка к которому добавляются новые свойства.

Смешивание достигается при конкретизации смешанного пакета путем расширения фактического параметра тэгового типа производным абстрактным типом. При множественном наследовании, производная абстракция установится в обратном направлении иерархии наследования, как тип предок (абстрактный) от которого производится наследование. Этот способ называют смешанным наследованием (mixin inheritance).

Например, не смотря на множество свойств, которые описывают степень образованности, хорошо известно, что "образованность" сама по себе - не существует. Подобный шаблон может быть применен по отношению к людям, которые полностью закончили обучение в каком-либо учебном заведении, что и определяет степень (degree) образованности (graduation). Очевидно, что по отношению к людям, понятие "степень образованности" являться свойством, но самостоятельное использование понятия "степень образованности" - бессмысленно. Свойства, которые описывают степень образованности, могут быть упакованы в смешанный пакет Graduate_G:
with Degrees; use Degrees;  -- экспортирует тип Degree

generic
    type Person is tagged private;

package Graduate_G is

    -- тип Graduate содержит Degree
    type Graduate is new Person with private;

    procedure Give (G: in out Graduate;
                    D: in     Degree);
    function Degree_of (G: Graduate) return Degree;

private

    type Graduate is new Person with
        record
            Given_Degree: Degree;
        end record;

end Graduate_G;
При конкретизации этого пакета с формальным параметром настройки тэгового типа Woman, будет создан новый тип, производный от типа указанного при конкретизации. Этот новый тип будет обладать желаемыми свойствами:
package Graduate_Women is new Graduate_G (Woman);

Anne  : Graduate_Women.Graduate;  -- тип полученный в результате
                                  -- конкретизации Graduate_G
D     : Degrees.Degree :=...

Christen  (Somebody, "Anne");   -- операция типа Woman
Give      (Somebody, Degree);   -- операция типа Graduate
Свойства обоих типов, типа-предка Woman и смешанного типа Graduate, будут доступны для нового типа Graduate_Woman.Graduate.

Тип-предок для смешанного типа (тип формального параметра настройки) может быть ограничен принадлежностью к иерархии наследования какого-либо класса. Такое ограничение осуществляется для обеспечения гарантии того, что тип-предок обладает требуемым множеством свойств, которые необходимы для реализации смешанного типа, или для гарантирования логичности смешанного типа. Например, будет абсолютно бессмысленно создавать стек степени образованности.

Ограничение для типа предка может быть выражено указанием класса наследования к которому обязан принадлежать производный тип формального параметра настройки (вместо тэгового типа формального параметра настройки). Следующий пример демонстрирует, что только тип Human и его потомки могут быть использованы для конкретизации смешанного настраиваемого модуля:
with Degrees; use Degrees;

generic
    type Person is new Human with private;

package Graduate_G is

    type Graduate is new Person with private;

    ... -- описания Give и Degree_of те же, что и в предыдущем примере

    function Title_of (G: Graduate) return String;
            -- переопределение функции Title_of
            -- для получения требуемого заголовка

private
    ...
end Graduate_G;
Поскольку свойства типа предка известны, то позже, в случае необходимости, ограниченный смешанный тип может быть переопределен. Так, например, функция Title_of переопределяется для предоставления более подходящей реализации.

3.7.2 Родственное наследование

В дополнение к показанному выше способу, можно использовать несколько специализированный способ родственного наследования (sibling inheritance), с применением ссылочных дискриминантов. Такой способ используется в случаях когда тип действительно является производным от более чем одного типа предка, или когда клиенты типа требуют представление этого типа как их предка или какого-либо потомка их типа предка.

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

В терминах типов, такая идея рассматривает концептуальный тип C, производный от двух типов A и B, как множество типов C_A и C_B, соответственно производных от A и B. Объекты концептуального типа C создаются путем совместной генерации множества объектов типа C_A и типа C_B. Такие объекты называют родственными объектами (sibling objects) или сдвоенными объектами (twin objects). Они взаимосвязаны между собой таким образом, что множество объектов может управляться так будто они являются одним объектом, и так, что один объект обладает доступом к свойствам другого сдвоенного объекта. Они также доступны индивидуально. Таким образом, легко доступно частичное представление множества, которое соответствует отдельному объекту.

В качестве примера, рассмотрим создание концептуального типа Controlled_Humans, производного от стандартного типа Controlled и типа Human. Компонент First_Name - это ссылочный тип, а не строка фиксированной длины. Таким образом, имя может иметь динамически изменяемую длину. В данном случае используются средства контролируемых объектов для освобождения памяти ассоциируемой с First_Name при разрушении объекта типа Human. Спецификация типа Human может иметь подобный вид:
package Dynamic_Humanity is

    type String_Ptr is access String;
    type Human is tagged limited
        record
            First_Name: String_Ptr;
        end record;

    procedure Christen (H: in out Human; N: in String_Ptr);
    -- устанавливает имя для Human

    ...
end Dynamic_Humanity;
Для построения комбинации из этих двух типов, необходимо создать два родственных типа Human_Sibling и Controlled_Sibling, путем соответственного производства от Human и Limited_Controlled. Два этих типа, вместе формируют концептуальный тип Controlled_Humans:
with Dynamic_Humanity, Ada.Finalization;

package Controlled_Human is

    type Human_Sibling;
      -- ввиду взаимозависимости типов, необходимо использование
      -- неполного описания типа


    type Controlled_Sibling (To_Human_Sibling: access Human_Sibling) is
        new Ada.Finalization.Limited_Controlled with null record;
      -- тип To_Human_Sibling является связкой с Human_Sibling
      
    procedure Finalize (C: in out Controlled_Sibling);

  
    type Human_Sibling is new Dynamic_Humanity.Human with
        record
            To_Controlled_Sibling: Controlled_Sibling (Human_Sibling'Access); 
              -- To_Controlled_Sibling является связкой с Controlled_Sibling.
              -- Этот компонент автоматически инициализируется ссылкой
              -- на текущее значение экземпляра Human_Sibling
        end record;

    -- примитивные операции типа Human (могут быть переопределены)

end Controlled_Human;
Таким образом, эти типы - взаимосвязаны, и для обращения от одного сдвоенного объекта к другому:

Human_Sibling обладает компонентом связки с To_Controlled_Sibling который подходит к типу Controlled_Sibling.

Controlled_Sibling обладает компонентом связки с To_Human_Sibling который подходит к типу Human_Sibling.

Следует заметить, что эти связки имеют различную природу. Связка To_Controlled_Sibling - это связка членства: любой объект типа Controlled_Sibling заключен в каждый объект типа Human_Sibling. Связка, To_Human_Sibling - это ссылочная связка: To_Human_Sibling обозначает Human_Sibling.

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

Хотя требуются некоторые дополнительные затраты (такие как, получение значения объекта, к которому отсылает ссылочное значение), такой подход обеспечивает всю функциональность, которая требуется от множественного наследования:

Последовательная генерация объектов

Поскольку To_Controlled_Sibling- это компонент Human_Sibling, любой объект типа Controlled_Siblingкаждый раз создается автоматически при создании объекта типа Human_Sibling. Связка To_Controlled_Siblingавтоматически инициализируется ссылкой на заключенный объект, поскольку атрибут 'Accessприменяется к имени типа записи, внутри описания, автоматически обозначая текущий экземпляр типа. Как результат, описание:
  CH: Human_Sibling;
автоматически объявляет объект концептуального типа Controlled_Human
Переопределение операций
Примитивные операции могут быть переопределены тем сдвоенным типом который их реализует (например, Finalize). Например, для предотвращения утечки памяти, мы переопределяем Finalizeдля автоматической очистки памяти, используемой First_Name, когда Humanстановится не доступным:
package body Controlled_Human is

    procedure Free is new Unchecked_Deallocation (String_Ptr);

    procedure Finalize (C: in out Controlled_Sibling) is
    -- overrides Finalize inherited from Controlled
    begin
        Free (C.To_Human_Sibling.all.First_Name);
    end Finalize;

end Controlled_Human;
Доступ ко всем компонентам и операциям

Компоненты каждого сдвоенного объекта могут быть выбраны и использованы любым из сдвоенных объектов, используя связки. Например, операция Finalize(описанная для Controlled_Sibling) может использовать компонент First_Name(описанный для Human_Sibling).
Примитивные операции могут быть вызваны тем же самым способом.

Добавление свойств

К концептуальному типу могут быть легко добавлены новые свойства, компоненты и операции, путем расширения любого из сдвоенных объектов. Для сохранения инкапсуляции, сдвоенные типы могут быть также описаны в приватной части расширения.

Расширение типа

Концептуальный тип может быть использован как предок для других типов. Это важно при производстве от сдвоенного типа Human_Sibling, который содержит компоненты другого сдвоенного типа. Свойства другого сдвоенного типа также доступны для производства через связку To_Human_Sibling.

Проверка принадлежности
Проверка принадлежности объекта к любому из типов предков выполняется путем использования согласованного (надклассового) представления любого из сдвоенных объектов:
declare

    CH: Human_Sibling;  -- simultaneous object generation

begin
    ... CH in Human'Class              ... -- True
    ... CH.To_Controlled_Sibling.all
           in Limited_Controlled'Class ... -- True
end;
Присваивание

Любой объект концептуального типа может быть присвоен объекту обоих типов предков обычным образом, то есть, путем выбора в концептуальном объекте сдвоенного объекта, который совпадает по типу с требуемым предком (используя преобразование представления), и присваивая этот сдвоенный объект назначению операции присваивания.

Такая модель может быть легко расширена для управления множественным наследованием от более чем двух типов.

3.8 Пример программирования посредством расширения

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

Представим себе функцию, которая читает до 20 сообщений с какого-либо интерфейса, обрабатывает статистику и генерирует какой-либо итоговый результат. Для остальной части системы непосредственно необходим только итоговый результат, и ее не заботят входные сообщения или работа интерфейса. В таком случае, простым решением будет помещение в самостоятельный пакет функции Summarizer, вычисляющей итоговый результат, вместе с перечислением переменных, которые указывают этой функции на то, какой интерфейс необходимо использовать:
package Simple_Approach is
    type Interfaces is (Disk_File, Serial_Interface, ...);

    type Summary_Type is
        record
            . . .
        end record;

    function Summarizer (Interface_To_Use: Interfaces)
        return Summary_Type;

end Simple_Approach;
Естественно, что в результате такого простого решения, при необходимоти добавить какой-либо новый интерфейс потребуется переписать заново тип Interfaces и функцию Summarizer, после чего, перекомпилировать все модули которые указывают пакет Simple_Approach в спецификаторе withs.

Необходимо заметить, что Ада очень часто используется в жизненно-критических системах (например, в авиационном оборудовании), где каждый программный модуль должен пройти длительный и дорогостоящий цикл тестирования скомпилированного объектного кода. Следовательно, после перекомпиляции модуля этот цикл тестирования должен быть пройден заново даже в случае отсутствия изменений в исходном тексте.

Программирование путем расширения позволяет избавиться от подобных переписываний и перекомпиляций. Первым вопросом, в этом случае, является: "что необходимо расширять?". В этом случае, необходима возможность расширения операций по получению сообщений от интерфейса. Таким образом, следует создать процедуру Get, которая получает сообщение от интерфейса основываясь на тэговом типе, что обеспечит ее полиморфность:
with Message;
package Generic_Interface is

    type Flag is tagged null record;

    procedure Get (Which_Interface: Flag;
                   Data: Message.Data_Type);

end Generic_Interface;
Теперь можно написать функцию Summarizer как надклассовую, которая, для получения сообщений от различных интерфейсов, использует соответствующую диспетчеризацию:
   with Generic_Interface;
   package Extension_Approach is

      function Summarizer
         (Interface_To_Use: Generic_Interface.Flag'Class)
         return Summary_Type;

   end Extension_Approach;
   - - - - - -
   with Messages;
   package body Extension_Approach is

      function Summarizer
         (Interface_To_Use: Generic_Interface.Flag'Class)
         return Summary_Type
      is
         Data: array (1..20) of Message.Data_Type;
      begin
         for I in 1 .. 20 loop
            Get (Interface_To_Use, Data (I));
            exit when Data (I).Last_Message;
         end loop;
         ...
Тело процедуры Get, в пакете Generic_Interface, может возвращать исключение, или получать сообщение от интерфейса по умолчанию (в этом случае пакет, наверное, должен быть назван Default_Interface).

Для расширения Summarizer с целью получения сообщений от какого-либо нового интерфейса, необходимо просто расширить тип Generic_Interface.Flag и переопределить его процедуру Get:
with Message;
with Generic_Interface;
package Disk_Interface is

    type Flag is new Generic_Interface.Flag with null record;

    procedure Get (Which_Interface: Flag;
                   Data: Message.Data_Type);

end Disk_Interface;
В результате этого, тип Flag способен хранить различные фактические данные для любых случаев.

Теперь мы можем обеспечить, чтобы Summarizer получал сообщения от диска и возвращал нам итоговый результат:
Summary := Extension_Approach.Summarizer
              (Disk_Interface.Flag'(null record));
Благодаря этому, даже в случае написания Disk_Interface после Summarizer, не возникает нужды переписывать Summarizer.

Затратив несколько больше усилий, можно запрограммировать почти все пользовательские системы так, что они не будут нуждаться в перепрограммировании или даже перекомпиляции для работы с любым новым интерфейсом. Сначала необходимо добавить описания к Generic_Interface, что позволяет пользователю сохранить переменную флага Flag:
    type Interface_Selector is access constant Flag'Class;
end Generic_Interface;
Константа Selected помещается в каждый пакет интерфейса, избавляя пользователя от необходимости использования синтаксиса, имеющего вид "TYPENAME'(null record)". Кроме того, в каждый пакет интерфейса помещается ссылочная константа для обозначения Selected, которая может быть сохранена в переменной типа Interface_Selector.
    Selected: constant Flag := Flag'(null record);

    Selection: constant Generic_Interface.Interface_Selector
        := Selected'Access;

end Disk_Interface;
Следует заметить, что эти добавления к пакетам _Interface являются простыми соглашениями. Пользовательский код может осуществлять такие описания самостоятельно.

Теперь, для точного указания используемого интерфейса, код может содержать:
with Disk_Interface;
with Extension_Approach;     use Extension_Approach;

procedure User is
    Sum: Summary_Type;
begin
    Sum := Summarizer (Disk_Interface.Selected);
Для инкапсуляции сведений об интерфейсах в одиночном пакете, код может иметь следующий вид:
package Interfaces is
   Current: Generic_Interface.Interface_Selector;
end Interfaces;
- - - - -
with Interfaces;
with Extension_Approach;      use Extension_Approach;
procedure User is
    Sum: Summary_Type;
begin
    Sum := Summarizer (Interfaces.Current);
. . .
Теперь, для расширения процедуры User, необходимо добавить еще один класс и немного кода (возможно, помещенного в интерфейс пользователя), который потребуется изменить так, чтобы он мог установить Interfaces.Current в New_Interface.Selection. Все остальные части системы не будут нуждаться в изменении и даже перекомпиляции.

Еще одна особенность программирования посредством расширения в Ada95 заключается в том, что при производстве нового типа, производного от тэгового, можно повторно использовать подпрограммы типа-предка, если они подходят для использования с производным типом. Например, предположим, что некоторые интерфейсы должны явно запускаться и останавливаться. Тогда код может иметь следующий вид:
with Message;
package Generic_Interface is
    type Flag is tagged null record;

    procedure Get (Which_Interface: Flag;
                   Data: Message.Data_Type);

    procedure Start (Which_Interface: Flag);  -- ничего не выполняет
    procedure Stop  (Which_Interface: Flag);  -- ничего не выполняет
    . . .

- - - - - -
with Message;
package Disk_Interface is
    type Flag is new Generic_Interface.Flag with null record;

    procedure Get (Which_Interface: Flag;
                   Data: Message.Data_Type);

    -- нам нет нужды запускать или останавливать диск, таким образом, Start
    -- ничего не наследует от Generic_Interface
    . . .

- - - - - -
with Message;
package Serial_Interface is
    type Flag is new Generic_Interface.Flag with null record;

    procedure Get (Which_Interface: Flag;
                   Data: Message.Data_Type);

    -- запуск и остановка последовательного интерфейса
    procedure Start (Which_Interface: Flag);
    procedure Stop  (Which_Interface: Flag);
    . . .
При этом код пользователя может иметь вид подобный следующему:
with Interfaces;
with Extension_Approach;     use Extension_Approach;
procedure User is
   Sum: Summary_Type;
begin
   Start (Interfaces.Current);
   Sum := Summarizer (Interfaces.Current);
   Stop (Interfaces.Current);
. . .
Рассмотренный пример демонстрирует преимущества средств Ada95 для программирования посредством расширения. Он представляет своеобразный вид "бесконечного варианта" для получения которого были использованы тэговые типы. Очевидно, что этот пример несколько искуственный. Следовательно этот пример может быть не полностью корректен для порождения реального кода.

Copyright (C) А.Гавва V-0.4w май 2004