[ Table of Contents ]
A value of an access type is a "pointer" that designates values of another type or designates subprograms with a particular parameter profile. There are two categories:
Declaration of an access type always involves the reserved word access.
Access Type Declarations - General Forms |
||||||||||
|
||||||||||
where SI (subtype-indication) = subtype_name or = subtype_name constraint where PSi (parameter specification) = name : subtype_name or = name : subtype_name := default_value |
Example Program Illustrating a Pool-Specific Access Type
Our example creates and tests a template (generic package) for creating doubly linked lists. It is patterned after a singly-linked lists example described in Section 9.1 of Feldman's text on data structures [Feldman97]. This is an example of recursion in the declaration of a type -- in that the type is defined in terms of itself, using an access type pointing to values of itself.
The generic package declaration has both visible and private parts. The
access type, Position, is incompletely declared in the visible
part, and fully declared in the private
part as access to values of type Node. The package exports eleven operations to
clients. Its body implements these eleven as well as three additional, hidden operations.
One of these three, Allocate, is used to create a new
Node each time it is called by the exported procedure, AddToRear. The package depends upon
the predefined environment package, Ada.Unchecked_Deallocation.
The test procedure declares a generic instance called My_Lists_Pkg, and then creates, fills and displays a small list of characters. |
Our test procedure exercises only five of the exported operations: AddToRear, First, Retrieve, Is_Last, and GoAhead.
Source Code Listing
---------------------------------------------------------- -------------- Doubly_Linked_Lists_Generic --------------- -- This package provides a template for creating doubly -- linked lists. It is patterned after a singly-linked -- lists example described in [Feldman97] Section 9.1. ---------------------------------------------------------- generic type ElementType is private; package Doubly_Linked_Lists_Generic is type Position is private; type List is limited private; -- operations procedure Initialize(L : in out List); function First (L : List) return Position; function Last (L : List) return Position; function Retrieve (L : List; P : in Position) return ElementType; procedure Replace (L : in out List; X : in ElementType; P : in Position); procedure GoAhead (L : in List; P : in out Position); procedure GoBack (L : in List; P : in out Position); procedure AddToRear (L : in out List; X : in ElementType); procedure Delete (L : in out List; P : in Position); function Is_First (L : List; P : Position) return Boolean; function Is_Last (L : List; P : Position) return Boolean; private type Node; type Position is access Node; -- access type type Node is record Info : ElementType; Prev : Position; -- access value Next : Position; -- access value end record; type List is record Head : Position; -- access value Tail : Position; -- access value end record; end Doubly_Linked_Lists_Generic; ---------------------------------------------------------- -------- Doubly_Linked_Lists_Generic body -------------- ---------------------------------------------------------- with Unchecked_Deallocation; package body Doubly_Linked_Lists_Generic is ------------------------------------------------ -- hidden operations ------------------------------------------------ procedure Dispose is new Unchecked_Deallocation (Object => Node, Name => Position); ----------------------------------------------------- function Allocate (X : ElementType; P,Q : Position) return Position is Result : Position; begin Result := new Node'(Info => X, Prev => Q, Next => P); return Result; end Allocate; ------------------------------------------------------- procedure Deallocate (P : in out Position) is begin Dispose (X => P); end Deallocate; ------------------------------------------------- -- exported operations ------------------------------------------------- procedure Initialize(L : in out List) is Previous : Position; Current : Position; begin if L.Head /= null then Current := L.Head; while Current /= null loop Previous := Current; Current := Current.Next; Deallocate(Previous); end loop; L := (Head => null, Tail => null); end if; end Initialize; ------------------------------------------------ function First (L : in List) return Position is begin return L.Head; end First; ------------------------------------------------ function Last (L : List) return Position is begin return L.Tail; end Last; ------------------------------------------------ function Retrieve (L : in List; P : in Position) return ElementType is begin return P.Info; end Retrieve; ------------------------------------------------ procedure Replace (L : in out List; X : in ElementType; P : in Position) is begin P.Info := X; end Replace; ------------------------------------------------------- procedure GoAhead (L : in List; P : in out Position) is begin P := P.Next; end GoAhead; ------------------------------------------------------- procedure GoBack (L : in List; P : in out Position) is begin P := P.Prev; end GoBack; ------------------------------------------------------------ procedure AddToRear (L : in out List; X : in ElementType) is P,Q : Position; begin P := Allocate (X, null, null); if L.Head = null then -- empty list L.Head := P; -- new Head else Q := L.Tail; -- old Tail Q.Next := P; P.Prev := Q; end if; L.Tail := P; -- new Tail end AddToRear; --------------------------------------------------- procedure Delete (L : in out List; P : in Position) is Previous : Position; Current : Position; Following : Position; begin Current := P; if Is_First (L, Current) then -- must adjust Head L.Head := Current.Next; if L.Head = null then -- only one node L.Tail := null; else Following := Current; GoAhead(L, Following); Following.Prev := null; end if; elsif Is_Last (L, Current) then -- must adjust Tail Previous := Current; GoBack(L, Previous); Previous.Next := null; L.Tail := Current.Prev; else -- normal case Previous := Current; GoBack (L, Previous); Following := Current; GoAhead (L, Following); Previous.Next := Current.Next; Following.Prev := Current.Prev; end if; Deallocate (Current); end Delete; ------------------------------------------- function Is_First (L : List; P : Position) return Boolean is begin return (L.Head /= null) and (P = L.Head); end Is_First; ------------------------------------------- function Is_Last (L : List; P : Position) return Boolean is begin return (L.Tail /= null) and (P = L.Tail); end Is_Last; ------------------------------------------- end Doubly_Linked_Lists_Generic; ---------------------------------------------------------- ---------------------- Test_My_List ---------------------- -- This test procedure creates a list, fills it with -- three characters, and displays it. ---------------------------------------------------------- with Doubly_Linked_Lists_Generic; with Ada.Text_IO; procedure Test_My_List is package My_Lists_Pkg is -- instantiate generic new Doubly_Linked_Lists_Generic(Character); use My_Lists_Pkg; My_List : List; -- create list Current : Position; -- create pointer begin AddToRear(My_List, 'A'); -- fill list AddToRear(My_List, 'd'); AddToRear(My_List, 'a'); Current := First(My_List); -- display list loop Ada.Text_IO.Put(Retrieve(My_List, Current)); exit when Is_Last(My_List, Current); GoAhead(My_List, Current); end loop; end Test_My_List; ---------------------------------------------------------- |
The above program produces the following output:
Ada |
Related Topics
[ Back to top of page ]