with Unchecked_Deallocation;

  package body Generic_Stack is

    type Stack_Node is record
           Data : Item;
           Next : Stack_Node_Access;
        end record;

    procedure Free is new Unchecked_Deallocation(Stack_Node, Stack_Node_Access);


    procedure Swap(Left : in out Stack; Right : in out Stack) is
      Old_Left_Start : Stack_Node_Access := Left.Start;
      -- Реализовано с помощью перемены местами ссылок на начальный элемент.
    begin
      Left.Start := Right.Start;
      Right.Start := Old_Left_Start;
    end Swap;

    procedure Push(S : in out Stack; I : in  Item) is
      New_Node : Stack_Node_Access := new Stack_Node;
    begin
      New_Node.Data := I;
      New_Node.Next := S.Start;
      S.Start := New_Node;
    end Push;

    procedure Pop (S : in out Stack; I : out Item) is
      Node_To_Remove : Stack_Node_Access := S.Start;
    begin
     if Is_Empty(S) then
       raise Constraint_Error;
     end if;
     I := S.Start.Data;
     S.Start := S.Start.Next;
     Free(Node_To_Remove);
    end Pop;

    procedure Top (S : in out Stack; I : out Item) is
    begin
     if Is_Empty(S) then
       raise Constraint_Error;
     end if;
     I := S.Start.Data;
    end Top;

    procedure Empty(S : in out Stack) is
      Node_To_Remove : Stack_Node_Access := S.Start;
      Next_Node_To_Remove : Stack_Node_Access;
    begin
      S.Start := null; -- "Отвязываем" от данных.
      -- и удаляем каждый элемент из старого стека.
      while Node_To_Remove /= null loop
        Next_Node_To_Remove := Node_To_Remove.Next;
        Node_To_Remove.Next := null;
        Free(Node_To_Remove);
        Node_To_Remove := Next_Node_To_Remove;
      end loop;
    end Empty;

    function Is_Empty(S : in Stack) return Boolean is
    begin
      if S.Start = null then
        return True;
      else
        return False;
      end if;
    end Is_Empty;

    function "="(Left : in Stack; Right : in Stack) return Boolean is
      Left_Node  : Stack_Node_Access := Left.Start;
      Right_Node : Stack_Node_Access := Right.Start;
    begin
      while (Left_Node /= null) and (Right_Node /= null) loop
        if Left_Node.Data /= Right_Node.Data then
          return False;  -- Данные различны.
        end if;
        Left_Node  := Left_Node.Next;
        Right_Node := Right_Node.Next;
      end loop;
      --Длины стеков одинаковы
      --если оба элемента равны null (при выходе из цикла хотя бы один должен
      --равняться null)

      return Left_Node = Right_Node;
    end "=";


    function Length(S : in Stack) return Natural is
      Count : Natural := 0;
      Current : Stack_Node_Access := S.Start;
    -- Эта подпрограмма подсчитывает длину стека "по требованию". Если запрос длины
    -- большого стека является часто выполняемой операцией,
    -- лучше всего "кэшировать" эту информацию в самом типе.
    begin
      while Current /= null loop
        Count := Count + 1;
        Current := Current.Next;
      end loop;
      return Count;
    end Length;

  -- Поскольку "Stack" был описан наследником типа Controlled, то
  -- у нас имеются операции Initialize, Adjust (для присваивания) и
  -- Finalize; можно переопределить любую из них.

  -- Мы не будем переопределять Initialize, поскольку инициализация по умолчанию
  -- нам вполне подходит. По умолчанию все ссылочные величины будут 
  -- инициализированы null, что в нашей реализации интерпретируется
  -- как пустой стек. Тем не менее нам необходимо переопределить
  -- Adjust и Finalize.

  procedure Adjust(Object : in out Stack) is
    Current_Source_Node      : Stack_Node_Access := Object.Start;
    First_Destination_Node   : Stack_Node_Access;
    Current_Destination_Node : Stack_Node_Access;
  -- Переопределение "Adjust". Инструкция присваивания по умолчанию только коприрует
  -- содержимое "Stack", а это приведет к тому, что две ссылки будут указывать
  -- на один и тот же элемент с данными.
  -- Эта процедура Adjust создает две разные копии каждого элемента с данными.
  -- Так как мы копируем все внутренние данные, то это называется "глубоким копированием".
  -- Это вполне естественный подход при присваивании, однако при необходимости
  -- его можно оптимизировать и свести к копированию ссылок.
  begin
    if Current_Source_Node /= null then
      -- Есть данные, которые нужно копировать. Первый элемент обрабатывается отдельно.
      First_Destination_Node := new Stack_Node;
      First_Destination_Node.Data := Current_Source_Node.Data;
      Current_Destination_Node := First_Destination_Node;

      -- Копирование всех элементов с данными после первого.
      while Current_Source_Node.Next /= null loop
        Current_Destination_Node.Next := new Stack_Node;
        Current_Destination_Node.Next.Data := Current_Source_Node.Next.Data;
        -- Данные скопированы, переход к следующему элементу.
        Current_Source_Node := Current_Source_Node.Next;
        Current_Destination_Node := Current_Destination_Node.Next;
      end loop;
      Current_Destination_Node.Next := null;
      Object.Start := First_Destination_Node;
    end if;
  end Adjust;

  procedure Finalize(Object : in out Stack) is
  -- Переопределение подпрограммы по умолчанию для освобождения
  -- всех элементов с данными.
  begin
    Empty(Object);
  end Finalize;

  end Generic_Stack;