Управление динамическими объектами - часть 2

with Ada.Finalization;

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;

private

-- обычные описания для списка

type Node; type Ptr is access Node;

type Node is

record

Value : Integer; Next : Ptr; end record;

-- только "голова" списка - "специальная"

type List is new Ada.Finalization.Controlled with

record

Head : Ptr; end record;

-- Initialize не нужна (указатели автоматически устанавливаются в null)

-- procedure Initialize(Item : in out List); procedure Adjust(Item : in out List); procedure Finalize(Item : in out List);

end Lists;

with Unchecked_Deallocation;

package body Lists is

-- подпрограмма освобождения памяти занимаемой узлом procedure Free is new Unchecked_Deallocation(Node, Ptr);

------------------------------------------------------------ -- реализация остальных внутренностей (Insert_At_Head, Remove_From_Head...)

. . .

-------------------------------------------------------------- -- дан указатель на список, подпрограмма будет размещать -- в памяти новый, идентичный первому, список function Copy_List(Item : Ptr) return Ptr is

begin

if Item = null then

return null; else return new Node'(Item.Value, Copy_List(Item.Next)); end if; end Copy_List;

------------------------------------------------------------ -- при присваивании B := A, B будет только переписано содержимым A. -- для связанного списка это подразумевает, что оба, A и B, -- указывают на один и тот же объект. -- теперь, необходимо сделать физическую копию узлов, на которые указывает B, -- и переставить указатель начала списка на начало копии списка, который мы -- только что сделали procedure Adjust(Item : in out List) is

begin

Item.Head := Copy_List(Item.Head); end Adjust;

------------------------------------------------------------ -- освободить всю память, занимаемую узлами списка, -- при разрушении списка procedure Finalize(Item : in out List) is

Upto : Ptr := Item.Head; Temp : Ptr; begin while Upto /= null loop

Temp := Upto; Upto := Upto.Next; Free(Temp); end loop;

Item.Head := null; end Finalize;

end Lists;