CHAPTER 12: Generic Units

12.3 The Use of Generic Units

12.3.1 Examples of Generic Functions

generic
  type ELEM is private;
  with function OPER(LEFT, RIGHT :  ELEM) return ELEM;
function POWER(E :  ELEM;  N :  POSITIVE) return ELEM;

function POWER(E :  ELEM;  N :  POSITIVE) return ELEM is
  RESULT :  ELEM  :=  E;
begin
  for J in 2 .. N loop
    RESULT :=  OPER(RESULT, E);
  end loop;
  return RESULT;
end POWER;

This generic function can be used to define exponentiation for types for which a multiplication operation is known. For example:

function "**" is new POWER(ELEM => RATIONAL, OPER => "*"); function "**" is new POWER(ELEM => MATRIX, OPER => MULT);

Each of these declarations defines an overloading of the operator **, obtained by generic instantiation. For example, the first declaration defines a function with the following specification:

    function "**" (E :  RATIONAL;  N :  POSITIVE) return RATIONAL;

It can be used to exponentiate rational numbers by repeated application of the multiplication operation defined for this type. Note also that the generic function can be used to apply any meaningful operation repeatedly, for example multiplication of a rational by a positive integer performed by repeated addition:

    function "*" is new POWER(ELEM =>  RATIONAL,  OPER =>  "+");

or repeated catenation of strings:

function "*" is new POWER(ELEM => STRING, OPER => "&"); RULER : constant := "!--+--" * 5;

so that

    RULER =  "!--+--!--+--!--+--!--+--!--+--"

The generic function body can be expressed more briefly in the following recursive form:

function POWER(E : ELEM; N : POSITIVE) return ELEM is begin if N = 1 then return E; else return OPER(POWER(E, N - 1), E); end if; end;

which eliminates the local declaration and is thus easier to maintain.

We next consider a variation of the preceding generic function, repeatedly applying a unary operation:

generic type ELEM is private; with function NEXT(X : ELEM) return ELEM; function INVOLUTION(E : ELEM; N : NATURAL) return ELEM; function INVOLUTION(E : ELEM; N : NATURAL) return ELEM is RESULT : ELEM := (E); begin for J in 1 .. N loop RESULT := NEXT(RESULT); end loop; return RESULT; end INVOLUTION;

or the briefer recursive form:

function INVOLUTION(E : ELEM; N : NATURAL) return ELEM is begin if N = 0 then return E; else return NEXT(INVOLUTION(E, N - 1)); end if; end;

This generic function can be used to apply any unary function repeatedly, for example, to produce the nth successor or predecessor of an enumeration value

function SUCC is new INVOLUTION(ELEM => COLOR, NEXT => COLOR'SUCC); function PRED is new INVOLUTION(ELEM => COLOR, NEXT => COLOR'PRED);

Again, these generic instantiations declare functions, whose specifications are:

function SUCC(E : COLOR; N : POSITIVE) return COLOR; function PRED(E : COLOR; N : POSITIVE) return COLOR;

Similar functions can be instantiated to find the nth successor or predecessor of an item in a list, where the successor and predecessor are defined by the unary functions:

function SUCC(X : LIST) return LIST is begin return X.SUCC; end; function PRED(X : LIST) return LIST is begin return X.PRED; end; function SUCC is new INVOLUTION(ELEM => LIST, NEXT => SUCC); function PRED is new INVOLUTION(ELEM => LIST, NEXT => PRED);

Note that these involutions overload (but do not hide) the functions SUCC and PRED. Actually, the immediate successor of an element can be obtained in three ways:

X.SUCC -- using the component SUCC SUCC(X) -- the unary function SUCC(X,1) -- the involution

12.3.2 An Example of a Generic Package

Here is the specification of the generic package QUEUE_OF :

generic -- the formal parameters are: type ITEM is private; -- the type of the items in the queues MAX_LENGTH : in POSITIVE := 400; -- the maximum length for all the queues package QUEUE_OF is type LENGTH is new INTEGER range 1 .. MAX_LENGTH; type QUEUE(SIZE : LENGTH := MAX_LENGTH) is limited private -- the only operations that will be available on queues are -- the operations declared in this visible part: procedure ADD(X : in ITEM; Q : in out QUEUE); -- adds an item to a queue procedure REDUCE(Q : in out QUEUE); -- removes the first item from the queue function EMPTY(Q : in QUEUE) return BOOLEAN -- returns TRUE if the queue is empty function FRONT(Q : in QUEUE) return ITEM; -- returns the first item of the queue (not removed) OVERFLOW, UNDERFLOW : exception; -- raised when illegal operations are attempted private -- this part will not be available to users type VECTOR is array(LENGTH range <>) of ITEM; type QUEUE(SIZE : LENGTH := MAX_LENGTH) is record POOL : VECTOR(1 .. SIZE); -- the queued items in a circular list COUNT : NATURAL := 0; -- their number IN_INDEX : LENGTH := 1; -- position of next in OUT_INDEX : LENGTH := 1: -- position of next out end record; end QUEUE_OF;

The package body provides the bodies of the functions and procedures promised in the specification:

package body QUEUE_OF is function NEXT(Q : in QUEUE; INDEX : in LENGTH) return LENGTH is -- returns the position that follows INDEX in queue Q begin return (INDEX mod Q.SIZE) + 1; end NEXT; procedure ADD(X : in ITEM; Q : in out QUEUE) is -- adds item X at the end of queue Q, -- or raises OVERFLOW if Q is full begin if Q.COUNT < Q.SIZE then Q.POOL(Q.IN_INDEX) := X; Q.IN_INDEX := NEXT(Q, Q.IN_INDEX); Q.COUNT := Q.COUNT + 1; else raise OVERFLOW; end if; end ADD; procedure REDUCE(Q : in out QUEUE) is -- removes the first item from queue Q, -- or raises UNDERFLOW if Q is empty begin if Q.COUNT > 0 then Q.OUT_INDEX := NEXT(Q, Q.OUT_INDEX); Q.COUNT := Q.COUNT - 1; else raise UNDERFLOW; end if; end REDUCE; function EMPTY(Q : in QUEUE) return BOOLEAN is -- returns TRUE if Q is empty begin return Q.COUNT = 0; end EMPTY; function FRONT(Q : in QUEUE) return ITEM is -- returns the first item in queue Q -- but does not remove it begin if Q.COUNT > 0 then return Q.POOL(Q.OUT_INDEX); else raise UNDERFLOW; end if; end FRONT; end QUEUE_OF;

Having defined QUEUE_OF, it is now possible to instantiate two packages that deal respectively with queues of integers and queues of reals:

package ANY_INT_QUEUE is new QUEUE_OF(ITEM => INTEGER, MAX_LENGTH => 200); package ANY_REAL_QUEUE is new QUEUE_OF(ITEM => REAL); -- default maximum length

In effect, these two declarations have created two packages (two ordinary nongeneric packages). In the present case, a compiler may be able to reuse the same code for the procedures of the two packages if reals and integers are represented with the same number of bits.

A block dealing with real queues may appear as below:

declare use ANY_REAL_QUEUE; QA : QUEUE(SIZE => 100); QB : QUEUE(SIZE => 200); begin ADD(3.14, QA); ... if FRONT(QA) = FRONT(QB) then REDUCE(QA); ADD(FRONT(QB) + 1.0, QA); end if; ... end ;

With the use clause for ANY_REAL_QUEUE, the type QUEUE is made directly visible and can be used to declare the queues of reals QA and QB.

A slight difficulty exists if we want to use both ANY_REAL_QUEUE and ANY_INT_QUEUE in the same block, since both declare a type QUEUE. The name conflict can be resolved by the use of expanded names for the type names:

declare use ANY_REAL_QUEUE, ANY_INT_QUEUE; QC : ANY_REAL_QUEUE.QUEUE(SIZE => 50); QD : ANY_INT_QUEUE.QUEUE(SIZE => 40); begin ... ADD(3.0E5, QC); REDUCE(QD); ... ADD(15, QD); ... end;

Using expanded names for the type names will usually be sufficient (repeated use can be avoided by declaring corresponding subtypes). Thereafter, subprograms (such as ADD) appear as overloaded subprograms, and no confusion is possible. For example, the expanded specifications of ADD correspond to

procedure ADD(X : in REAL; Q : in out ANY_REAL_QUEUE.QUEUE); procedure ADD(X : in INTEGER; Q : in out ANY_INT_QUEUE.QUEUE);

In the case of the exceptions OVERFLOW and UNDERFLOW, overloading is of no help and either expanded names or renaming declarations must be used.

A final word on these two exceptions: the bodies of ADD, REDUCE, and FRONT are written so that no damage occurs to the queue if either exception occurs. In consequence it is possible to provide a local handler for these exceptions:

declare use ANY_REAL_QUEUE, ANY_INT_QUEUE; subtype INT_QUEUE is ANY_INT_QUEUE.QUEUE; -- INT_QUEUE defined as an abbreviation INTQ_ERROR : exception renames ANY_INT_QUEUE.OVERFLOW; QA : INT_QUEUE(SIZE => 100); ... begin ... ADD(3, QA); ... exception when INTQ_ERROR => -- actions to be performed if QA overflows. end;

12.3.3 A Generic Package with Tasks

generic
  type ITEM is private;
  SIZE :  POSITIVE  :=  400;
package ON_BUFFERS is
  task type BUFFER is
    entry READ(C :  out ITEM);
    entry WRITE(C :  in ITEM);
  end;
end ON_BUFFERS;

package body ON_BUFFERS is
  type LENGTH is new INTEGER range 1 .. SIZE;
  type VECTOR is array (LENGTH range <>) of ITEM;
  task body BUFFER is
    POOL   :  VECTOR(1 .. SIZE);
    COUNT  :  NATURAL  :=  0;
    IN_INDEX, OUT_INDEX :  LENGTH  :=  1;
  begin
    loop
      select
        when COUNT < SIZE =>
          accept WRITE(C :  in ITEM) do
            POOL(IN_INDEX) :=  C;
          end;
          IN_INDEX :=  (IN_INDEX mod SIZE) + 1;
          COUNT :=  COUNT + 1;
      or
        when COUNT > 0 =>
          accept READ(C :  out ITEM) do
            C :=  POOL(OUT_INDEX);
          end;
          OUT_INDEX :=  (OUT_INDEX mod SIZE) + 1;
          COUNT :=  COUNT - 1;
      or
        terminate;
      end select;
    end loop;
  end BUFFER;
end ON_BUFFERS;

A task equivalent to that given in the Reference Manual is obtained by the generic instantiation:

package CHARACTER_BUFFERING is new ON_BUFFERS(ITEM => CHARACTER, SIZE => 100);

followed by the declaration of a task object:

    A_BUFFER :  CHARACTER_BUFFERING.BUFFER;

Use of the generic formulation permits the same strategy to be employed in a variety of different applications; for example:

package MESSAGE_BUFFERING is new ON_BUFFERS(ITEM => MESSAGE, SIZE => BACKLOG);

where MESSAGE is assumed to be a previously declared type and BACKLOG yields an estimate for a reasonable buffer size.

It is interesting to observe that the logic of the queuing strategy, shown by the example in the previous section, and that of the buffering strategy, presented above, are in many respects identical. The essential difference between the two approaches is that overflow and underflow are treated as exceptions in the former case, whereas in the latter case they merely result in some parallel task waiting until it can proceed.

12.3.4 A More Complicated Example

generic
  type LEAF_TYPE is private;
  type NODE_TYPE is private;
package BINARY_TREES is
  type FORM is (INTERMEDIATE, TERMINAL);

  type TREE(KIND :  FORM);
  type LINK is access TREE;

  type TREE(KIND :  FORM) is
    record
      case KIND is
        when TERMINAL =>
          LEAF :  LEAF_TYPE;

        when INTERMEDIATE =>
          NODE  :  NODE_TYPE;
          LEFT   :  LINK;
          RIGHT :  LINK;
      end case;
    end record;

  -- specifications of standard operations on binary trees

end BINARY_TREES;

A number of standard operations associated with binary trees would normally be included within the generic package given above; for simplicity, they will not be detailed here. Instead, we shall illustrate the typical ways in which binary trees are processed. These generally involve a recursive traversal (or walk) of the tree in one of a few characteristic orders (namely, prefix order, infix order, or postfix order). These orders can be expressed as generic operations.

The commonest of these orders is used in the example below. This is the postfix walk, where a certain operation is applied to each leaf, while another operation is applied to each node, as well as to the results of previously processed left and right branches. The desired generic function might be defined within the package BINARY_TREES as follows:

generic type RESULT is private; with function LEAF_ACTION(L : LEAF_TYPE) return RESULT; with function NODE_ACTION(N : NODE_TYPE; L, R : RESULT) return RESULT; function POST_WALK(T : LINK) return RESULT; function POST_WALK(T : LINK) return RESULT is begin case T.KIND is when TERMINAL => return LEAF_ACTION(T.LEAF); when INTERMEDIATE => return NODE_ACTION(N => T.NODE, L => POST_WALK(T.LEFT), R => POST_WALK(T.RIGHT)); end case; end POST_WALK;

Note that the recursive invocations of POST_WALK within this function cause no confusion (or infinite loop during instantiation) since, within an instantiation of a generic function body, the name of the generic function refers to the name of the current instantiation.

A number of useful utility functions on binary trees follow the pattern of a postfix walk. Some of these might well be included within the package BINARY_TREES itself. For example, given the functions ONE, SUM, SUM_PLUS_ONE, and MAX:

function ONE(L : LEAF_TYPE) return INTEGER is begin return 1; end; function SUM(N : NODE_TYPE; L, R : INTEGER) return INTEGER is begin return L + R; end; function SUM_PLUS_ONE(N : NODE_TYPE; L, R : INTEGER) return INTEGER is begin return L + R + 1; end; function MAX(N : NODE_TYPE; L, R : INTEGER) return INTEGER is begin if L < R then return R; else return L; end if; end;

- where a dummy parameter of node type or leaf type has been provided in order to match the generic functions - then the usual tree functions COUNT, DEPTH, and WIDTH are obtained by generic instantiation:

function COUNT is new POST_WALK(RESULT => INTEGER, LEAF_ACTION => ONE, NODE_ACTION => SUM_PLUS_ONE); -- the number of leaves and nodes function DEPTH is new POST_WALK(RESULT => INTEGER, LEAF_ACTION => ONE, NODE_ACTION => MAX); -- the length of the longest path from root to leaf function WIDTH is new POST_WALK(RESULT => INTEGER, LEAF_ACTION => ONE, NODE_ACTION => SUM); -- the number of leaves

The advantages of using the generic facility in this fashion to formulate a basic pattern for several similar definitions are obvious. Another application of such definitions involves the use of binary trees to represent simple arithmetic expressions, where the leaves are integer values and the nodes correspond to the usual operators:

    type OPERATOR is (ADD, SUB, MUL, DIV);

The appropriate definition can be obtained by instantiating the generic package

package EXPRESSION_TREES is new BINARY_TREES(LEAF_TYPE => INTEGER, NODE_TYPE => OPERATOR);

In an application, a use clause would be provided for this package and, to introduce a name more appropriate to the application, the tree type would be renamed by a subtype declaration:

use EXPRESSION_TREES; subtype EXPRESSION is EXPRESSION_TREES.TREE;

One may then introduce the specific operations associated with the type of tree in question. The most obvious is the evaluation function

    function EVAL(E :  EXPRESSION) return INTEGER;

This, however, exactly follows the pattern of a postfix walk, and may therefore be obtained directly by instantiation:

function EVAL is new POST_WALK(RESULT => INTEGER, LEAF_ACTION => VALUE, NODE_ACTION => INTERPRET);

where the requisite definitions of VALUE and INTERPRET are as follows:

function VALUE(I : INTEGER) return INTEGER is begin return I; end; function INTERPRET(OP : OPERATOR; L, R : INTEGER) return INTEGER is begin case OP is when ADD => return L + R; when SUB => return L - R; when MUL => return L * R; when DIV => return L / R; end case; end ;

Once again, the desired function is obtained by merely providing the appropriate operations for each leaf and node, while the details of the recursive tree walk are encapsulated within the generic function POST_WALK.

The binary tree example of this subsection presents a rather sophisticated structure, namely a generic recursive function (the function is recursive but there is of course no recursive instantiation), the declaration of which is itself nested within a generic package! While this example shows why such complicated formulations are occasionally desirable (see also [VH 75]), a word of warning is in order with regard to generic packages. Dependence between generic units in the form of mutual instantiation is not allowed since such a structure could yield an infinite loop during instantiation:

generic ... package A is ... end; generic ... package B is ... end; package body A is ... package NEW_B is new B( ... ); -- THIS ALONE IS LEGAL ... end A; package body B is ... package NEW_A is new A( ... ); -- BUT NOT TOGETHER WITH THIS! ... end B;