4.10 Access Types - 1

[ Table of Contents ] Prev ] Chapter Overview ] Next ] [ Glossary/Index ]

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

Pool-Specific Access to Object
type PSA is access SI;
General Access to Variable
type GAV is access all SI;
General Access to Constant
type GAC is access constant SI;
General Access to Procedure
type GAP is access procedure(PS1; PS2; .. );
General Access to Function
type GAF is access function(PS1; PS2; .. )
           return subtype_name;
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.

Im4-11.gif (7339 bytes)

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

4.1 Type System Overview

[ Back to top of pagePrev ] Next ]