Previous

Contents

Next

Chapter 12:
Generics

I am made all things to all men.
— Corinthians I, 9:22


12.1 Generic packages
12.2 Generic parameters
12.3 Revising the diary package
12.4 A generic sorting procedure
12.5 Generics and general access types
Exercises

12.1 Generic packages

Linked lists as presented in the previous chapter are the sort of data structure that are useful in a wide variety of situations. We could take the linked list operations from the diary package to create a separate linked list package like this:

    package JE.Lists is
        type Appointment_Type is private;
        type List_Type is limited private;
        type List_Iterator is private;

        function  First  (List     : List_Type)     return List_Iterator;
        function  Last   (List     : List_Type)     return List_Iterator;
        function  Succ   (Iterator : List_Iterator) return List_Iterator;
        function  Pred   (Iterator : List_Iterator) return List_Iterator;
        function  Value  (Iterator : List_Iterator) return Appointment_Type;
        function  Size   (List     : List_Type)     return Natural;

        procedure Insert (Iterator : in List_Iterator;
                          Appt     : in Appointment_Type);
        procedure Delete (Iterator : in List_Iterator);

        Iterator_Error : exception;

    private
        ...        -- as in chapter 11
    end JE.Lists;

Unfortunately it wouldn’t be terribly useful since the lists it would define would be lists of diary appointments. We wouldn’t need lists of appointments that often, but lists of strings or integers or personnel details or playing cards could conceivably be useful. The actual list handling would be the same no matter what type of data the list actually held, so why not define a generic list management package which could be used to manage linked lists of any data type we happen to require?

At present, the linked list package uses Appointment_Type throughout as the type of the items to be stored in the lists. One way to generalise the package would be to include the following subtype declaration:

    subtype Item_Type is Appointment_Type;

This means that Item_Type is effectively a renaming of Appointment_Type. If the package is amended so that it uses Item_Type as the type of the items to store in the list, it’s easy to change the package to deal with items of a different type; all you have to do is make a copy of the package (and give it a new name), then change the declaration of Item_Type and recompile. However, Ada provides a mechanism for defining generic packages that can give you the same effect without any copying, editing or recompiling.

You’ve already met some generic packages; the package Ada.Text_IO contains several generic packages like Integer_IO which can be instantiated for use with any integer type and Enumeration_IO which can be instantiated for use with any enumerated type. If you look at the declaration of Ada.Text_IO in Appendix B, you’ll see that Integer_IO is declared inside it like this:

    generic
        type Num is range <>;
    package Integer_IO is
        -- subprograms with parameters of type Num
    end Integer_IO;

Before you can use this package, you have to instantiate it by supplying the name of the actual type you want to use as a parameter. The result of this is a brand new package:

    package My_Integer_IO is new Ada.Text_IO.Integer_IO (My_Integer_Type);

What effectively happens is that the compiler creates a new package called My_Integer_IO which is identical to Ada.Text_IO.Integer_IO except that all occurrences of the type Num have been replaced by My_Integer_Type. So where Ada.Text_IO.Integer_IO provides a procedure Put which takes a parameter of type Num, My_Integer_IO provides a procedure Put which takes a parameter of type My_Integer_Type instead. You can use a named parameter association when instantiating a generic package, just as you can for the parameters in a procedure call:

    package My_Integer_IO is new Ada.Text_IO.Integer_IO (Num => My_Integer_Type);

This shows explicitly that the type Num in Integer_IO is to be replaced by My_Integer_Type when the package is instantiated.

The specification of the parameter Num as ‘range <>’ shows that Num can be any integer type, since the reserved word range in a type declaration indicates that the type being declared is an integer type. All the normal integer operations can be used with type Num inside the package; the compiler will ensure that when the package is instantiated the actual type supplied as a parameter really is an integer type so that those operations are guaranteed to be legitimate. However, the actual range of values for Num is unspecified (as shown by the box symbol ‘<>’) so the package should be careful to avoid unwarranted assumptions. For example, putting anything like this in the package body would be a bad idea:

    X : Num := 0;   -- Argh! Can't assume 0 will always be a legal value of Num!

If an integer type that doesn’t include 0 in its range (e.g. Positive) is used to instantiate the package, the declaration above will raise a constraint error. Attributes like Num'First and Num'Last should always be used instead of specific values for safety.

Generics are not restricted to use with packages; generic procedures and functions can also be defined. For example, Ada.Unchecked_Deallocation (which was described in the previous chapter) is a generic procedure. In the case of a generic package, the generic parameter list goes before the package specification but not in front of the package body; the compiler knows about the generic parameters when it’s compiling the body because it’s already dealt with the specification. A similar thing is done with generic procedures and functions; a specification of the procedure or function must be given which gives the generic parameter list, and the procedure or function is then defined without repeating the generic parameter list.


12.2 Generic parameters

In the case of a linked list package, we want a linked list of any type. Linked lists of arrays, records, integers or any other type should be equally possible. The way to do this is to specify the item type in the package declaration as private, like this:

    generic
        type Item_Type is private;
    package JE.Lists is
        ...
    end JE.Lists;

The only operations that will be allowed in the package body are those appropriate to private types, namely assignment (:=) and testing for equality and inequality (= and /=). When the package is instantiated, any type that meets these requirements can be supplied as the actual parameter. This includes records, arrays, integers and so on; the only types excluded are limited types. Also, you must give a constrained type (so String would not be allowed, but a subtype of String which is constrained to a particular length would be); if you wanted to allow unconstrained types as well as constrained types to be used to instantiate the package, you would need to declare the generic parameter like this:

    generic
        type Item_Type(<>) is private;
    package JE.Lists is
        ...
    end JE.Lists;

The ‘(<>)’ after the type name means that unconstrained types are allowed as well as constrained types. One effect of this is that you would only be able to use Item_Type in ways which are allowed for unconstrained types; using Item_Type as a procedure parameter would be allowed but declaring an uninitialised Item_Type variable wouldn’t.

As you can see, the way you declare your generic type parameters puts restrictions on what operations you can perform on the type inside the package as well as what types you can supply as parameters. Specifying the parameter as ‘range <>’ allows the package to use all the standard operations on integer types but restricts you to supplying an integer type when you instantiate the package. Specifying the parameter as ‘private’ gives you greater freedom when you instantiate the package but reduces the range of operations that you can use inside the package itself. There are numerous ways of specifying generic parameters; the table below gives the complete list, the last half-a-dozen of which are related to tagged types (which will be described in chapter 14).

    limited private                 -- any type at all
    private                         -- any non-limited type
    (<>)                            -- any discrete (integer or enumeration) type
    range <>                        -- any signed integer type
    mod <>                          -- any modular integer type
    digits <>                       -- any floating point type
    delta <>                        -- any fixed point type
    delta <> digits <>              -- any decimal type
    access Y                        -- any access-to-Y type
    access all Y                    -- any "access all Y" type
    access constant Y               -- any "access constant Y" type
    array (Y range <>) of Z         -- any unconstrained array-of-Z type with a
                                       subtype of Y as its index subtype
    array (Y) of Z                  -- any constrained array-of-Z type with a
                                       subtype of Y as its index subtype
    new Y                           -- any type derived from Y
    new Y with private              -- any non-abstract tagged type derived from Y
    abstract new Y with private     -- any tagged type (abstract or not) derived from Y
    tagged private                  -- any non-abstract non-limited tagged type
    tagged limited private          -- any non-abstract tagged type
    abstract tagged private         -- any non-limited tagged type
    abstract tagged limited private -- any tagged type at all

For example, you can use ‘mod <>’ as a generic parameter, in which case you can use any modular type in your instantiation; inside the package you can use any of the standard operations on modular types (e.g. the 'Modulus attribute).

Something that the above table doesn’t show is that the generic parameter can also be specified as having discriminants, in which case the actual type you supply for the parameter must have matching discriminants:

    type X (Count : Integer) is private;
                    -- any non-limited type with an Integer discriminant

Also, as I mentioned above, you can specify for any generic parameter that its actual type may or may not have discriminants by putting ‘(<>)’ after the type name:

    type X (<>) is private;
                    -- any non-limited type with or without discriminants

Note that in the cases of access types and derived types you must specify X in terms of another specific type (called Y in the examples in the table above). This is so that the compiler knows what to do with the object that an X points to in the case of an access type, and so that it knows what the parent type is (and hence what operations are available) in the case of a derived type. Similarly, in array types you must specify the type of the individual items as well as the index subtype so that the compiler knows what operations are allowed on the index type and the individual array elements; also you cannot use a constrained array type for an unconstrained generic array parameter or an unconstrained array type for a constrained generic array parameter. Typically the specific types used in access, array and derived type parameters will be other generic parameters; for example, the standard procedure Ada.Unchecked_Deallocation (which was described in the previous chapter) is declared like this:

    generic
        type Object(<>) is limited private;
        type Name is access Object;
    procedure Ada.Unchecked_Deallocation (X : in out Name);

Here Name is an access type defined in terms of Object, which is also a generic parameter. Thus when you instantiate Unchecked_Deallocation you have to specify the access type that you want to deallocate as well as the type of object it points to. The declaration of Object allows this to be any type at all, either constrained or unconstrained.

Generic packages, like any other packages, can have child packages. Child packages of generic packages must also be generic:

    generic
        type Other_Type is private;
    package JE.Lists.Child is
        ...
    end JE.Lists.Child;

To instantiate JE.Lists.Child you have to instantiate the parent package first. The child package is then effectively a generic child of the instantiated parent package so that it can be instantiated like this:

    package Int_Lists is new JE.Lists (Item_Type => Integer);
    package Int_List_Child is new Int_Lists.Child (Other_Type => Boolean);

If you don’t need any extra generic parameters for the child package you can just leave them out, although the child package must still be specified as being generic:

    generic
        -- it's generic but there are no generic parameters
    package JE.Lists.Child is
        ...
    end JE.Lists.Child;

In this case, you would first need to instantiate JE.Lists as before, and then instantiate JE.Lists.Child without supplying any generic parameters:

    package Int_Lists is new JE.Lists (Item_Type => Integer);
    package Int_List_Child is new Int_Lists.Child;

Here’s what the linked list package from the beginning of the chapter (including the full version of the private part, which is taken from the previous chapter) looks like once it’s been modified to be a generic package:

    generic
        type Item_Type is private;
    package JE.Lists is
        type List_Type is limited private;
        type List_Iterator is private;

        function  First  (List     : List_Type)     return List_Iterator;
        function  Last   (List     : List_Type)     return List_Iterator;
        function  Succ   (Iterator : List_Iterator) return List_Iterator;
        function  Pred   (Iterator : List_Iterator) return List_Iterator;
        function  Value  (Iterator : List_Iterator) return Item_Type;
        function  Size   (List     : List_Type)     return Natural;

        procedure Insert (Iterator : in List_Iterator;
                          Item     : in Item_Type);
        procedure Delete (Iterator : in List_Iterator);

        Iterator_Error : exception;

    private
        type Item_Record;
        type Item_Access is access Item_Record;

        type Item_Record is
            record
                Item : Item_Type;
                Next : Item_Access;
                Pred : Item_Access;
            end record;

        type List_Header is
            record
                First : Item_Access;
                Last  : Item_Access;
                Count : Natural := 0;
            end record;

        type List_Access is access all List_Header;

        type List_Type is
            record
                List : List_Access := new List_Header;
            end record;

        type List_Iterator is
            record
                List    : List_Access;
                Current : Item_Access;
            end record;

    end JE.Lists;

The package body is exactly the same as it was before with the type names changed appropriately to match the new names used in the specification (Item_Type instead of Appointment_Type, List_Type instead of Diary_Type, List_Iterator instead of Diary_Iterator, Item_Access instead of Appointment_Access and so on).

Once the generic package has been compiled, using it is simply a matter of instantiating it with the item type you want to use:

    package Appointment_Lists is new JE.Lists (Item_Type => Appointment_Type);
    package Integer_Lists     is new JE.Lists (Item_Type => Integer);

The generic package doesn’t need changing or recompiling at all when you do this, but all the type safety checks are still enforced.


12.3 Revising the diary package

Now that we’ve got a generic linked list package, we can use it to reimplement the diary package from the previous chapter. The definition of Diary_Type in the private part of the specification will need changing to use the generic package:

    with JE.Appointments, JE.Times, JE.Lists;
    use  JE.Appointments;
    package JE.Diaries is
        type Diary_Type is limited private;
        ...        -- etc.

    private
        package Lists is new JE.Lists (Item_Type => Appointment_Type);

        type Diary_Type is
            limited record
                List : Lists.List_Type;
            end record;
    end JE.Diaries;

The subprograms in the package body will need minor changes to use operations from the list package rather than doing things ‘by hand’. For example, the definition of Size will need changing to use the Size operation from Lists (assuming that the package body includes a use clause for the package Lists declared in the package specification):

    function Size (Diary : Diary_Type) return Natural is
    begin
        return Size(Diary.List);
    end Size;

The implementation of Choose involves the same sort of minor changes. Compare this version with the previous version:

    function Choose (Diary : Diary_Type;
                     Appt  : Positive) return Appointment_Type is
        Iterator : List_Iterator;
    begin
        if Appt not in 1 .. Size(Diary.List) then
            raise Diary_Error;
        else
            Iterator := First(Diary.List);
            for I in 2 .. Appt loop
                Iterator := Succ(Iterator);
            end loop;
            return Value(Iterator);
        end if;
    end Choose;

Here are amended versions of the other subprograms:

    procedure Delete (Diary : in out Diary_Type;
                      Appt  : in Positive) is
        Iterator : List_Iterator;
    begin
        if Appt not in 1 .. Size(Diary.List) then
            raise Diary_Error;
        else
            Iterator := First(Diary.List);
            for I in 2 .. Appt loop
                Iterator := Succ(Iterator);
            end loop;
            Lists.Delete (Iterator);
        end if;
    end Delete;

    procedure Add (Diary : in out Diary_Type;
                   Appt  : in Appointment_Type) is
        use type JE.Times.Time_Type;        -- to allow use of ">"
        Iterator : List_Iterator;
    begin
        Iterator := First(Diary.List);
        while Iterator /= Last(Diary.List) loop
            exit when Value(Iterator).Time > Appt.Time;
            Iterator := Succ(Iterator);
        end loop;
        Insert (Iterator, Appt);
    exception
        when Storage_Error =>
            raise Diary_Error;
    end Add;

    procedure Load (Diary : out Diary_Type;
                    From  : in String) is
        File : Appt_IO.File_Type;
        Appt : Appointment_Type;
    begin
        while Size(Diary.List) > 0 loop
            Delete (First(Diary.List));
        end loop;

        Appt_IO.Open (File, In_File, From);
        while not Appt_IO.End_Of_File(File) loop
            Appt_IO.Read (File, Appt);
            Insert (Last(Diary.List), Appt);
        end loop;
        Appt_IO.Close (File);
    exception
        when Name_Error =>
            raise Diary_Error;
    end Load;

    procedure Save (Diary : in Diary_Type;
                    To    : in String) is
        File : Appt_IO.File_Type;
        I    : Iterator := First(Diary.List);
    begin
        Appt_IO.Create (File, In_File, To);
        while I /= Last(Diary.List) loop
            Appt_IO.Write (File, Lists.Value(I));
            I := Succ(I);
        end loop;
        Appt_IO.Close (File);
    end Save;

Appointment_Type wasn’t affected by any of the changes to Diary_Type, so none of the operations on Appointment_Type need any modifications.


12.4 A generic sorting procedure

The sorting procedure defined in chapter 6 is another obvious candidate for making generic. It doesn’t matter if we’re sorting integers or appointments, as long as we can compare them to determine their relative ordering. Here’s a possible declaration for a procedure Generic_Sort that can sort arrays of any discrete type:

    generic
        type Item_Type  is (<>);
        type Index_Type is (<>);
        type Array_Type is array (Index_Type range <>) of Item_Type;
    procedure Generic_Sort (X : in out Array_Type);

Here’s a possible instantiation of Generic_Sort:

    type Character_Count is array (Character) of Integer;

    procedure Sort is new Generic_Sort (Item_Type => Integer,
                                        Index_Type => Character,
                                        Array_Type => Character_Count);

Since Generic_Sort defines Item_Type to be a discrete type, we can use the comparison operator "<" to compare the relative ordering of items in the array. Unfortunately this rules out using this procedure to sort an array of appointments since Appointment_Type is a record type, not a discrete type, and there is no "<" operator defined for record types. The only way to define Item_Type which would allow it to be used with record types is as a private type, but this prevents us from using "<" for our comparisons since "<" is not a standard operation on private types (only assignment and tests for equality and inequality are allowed). However, you can also specify procedures, functions or packages as generic parameters. What you need to do is to supply a comparison function as a generic parameter:

    generic
        type Item_Type is private;
        type Index_Type is (<>);
        type Array_Type is array (Index_Type range <>) of Item_Type;
        with function Compare (Left, Right : Item_Type) return Boolean;
    procedure Generic_Sort (X : in out Array_Type);

Note that procedure, function and package parameters are preceded by ‘with’; if you left out ‘with’ in the example above the compiler would think that you were declaring a generic function called Compare.

Now when you instantiate it you just have to supply the name of a suitable function which has the right number and types of parameters and the right result type:

    type Character_Count is
        record
            Char  : Character;
            Count : Integer := 0;
        end record;

    type Count_Array is array (Character) of Character_Count;

    function Less (X, Y : Character_Count) return Boolean is
    begin
        return X.Count < Y.Count;
    end Less;

    -- Instantiation of Generic_Sort to sort Count_Arrays:
    procedure Sort is new Generic_Sort (Item_Type => Character_Count,
                                        Index_Type => Character,
                                        Array_Type => Count_Array,
                                        Compare => Less);

Here Sort will sort an array of records using the function Less to decide on the order of the array items. Supplying the comparison function as a generic parameter also has the advantage that you can supply any comparison function you like; for example, here are two instantiations which sort an array of integers into ascending and descending order:

    type Character_Count is array (Character) of Integer;

    procedure Ascending_Sort  is new Generic_Sort (Item_Type => Integer,
                                                   Index_Type => Character,
                                                   Array_Type => Character_Count,
                                                   Compare => "<");
    procedure Descending_Sort is new Generic_Sort (Item_Type => Integer,
                                                   Index_Type => Character,
                                                   Array_Type => Character_Count,
                                                   Compare => ">");

The first one uses "<" to compare the items so that they’ll be sorted into ascending order, the second uses ">" instead so that the ordering will be reversed.

In many cases, "<" will be the function we will want to use to do the comparisons. To avoid having to specify it as a parameter in every instantiation, it’s possible to provide a default value. Here’s how it’s done:

    generic
        type Item_Type is private;
        type Index_Type is (<>);
        type Array_Type is array (Index_Type range <>) of Item_Type;
        with function "<" (Left, Right : Item_Type) return Boolean is <>;
    procedure Generic_Sort (X : in out Array_Type);

The ‘is <>’ at the end of the function declaration means that you don’t need to provide a function for the parameter if a suitable function already exists with the same name as the parameter (in this case "<"). This means that we can now define Ascending_Sort like this:

    procedure Ascending_Sort is new Generic_Sort (Item_Type => Integer,
                                                  Index_Type => Character,
                                                  Array_Type => Character_Count);
‘Integer < Integer’ will be used to do the comparisons in Ascending_Sort.

So here, finally, is the sort procedure from chapter 6 generalised into a generic procedure. Remember that a separate specification is required for the procedure which is prefixed by the generic parameter list; the procedure definition is given separately without repeating the generic parameter list. A common mistake is to try and put the generic parameter list in front of the procedure definition and not bother with a specification, but the compiler won’t like it if you do this.

    -- Generic procedure specification
    generic
        type Item_Type  is private;
        type Index_Type is (<>);
        type Array_Type is array (Index_Type range <>) of Item_Type;
        with function "<" (Left, Right : Item_Type) return Boolean is <>;
    procedure Generic_Sort (X : in out Array_Type);

    -- Procedure definition
    procedure Generic_Sort (X : in out Array_Type) is
        Position : Index_Type;
        Value    : Item_Type;
    begin
        for I in Index_Type'Succ(X'First)..X'Last loop
            if X(I) < X(Index_Type'Pred(I)) then
                Value := X(I);
                for J in reverse X'First .. Index_Type'Pred(I) loop
                    exit when X(J) < Value;
                    Position := J;
                end loop;
                X(Index_Type'Succ(Position)..I) := X(Position..Index_Type'Pred(I));
                X(Position) := Value;
            end if;
        end loop;
    end Generic_Sort;

Notice how the attributes 'Succ, 'Pred, 'First and 'Last have been used throughout the procedure body to avoid making any assumptions about the index subtype of Array_Type. You have to be very careful about this sort of thing when writing generic code. Don’t take anything for granted, and test everything with unusual types (e.g. arrays whose bounds are 100 .. 200).

Note that as well as using types and subprograms as generic parameters, you can also use packages, constants or variables; the complete list of possibilities is shown in the following table:

    X : T;                          -- any object of type T
    X : in T;                       -- the same (any object of type T)
    X : in out T;                   -- any variable of type T
    with procedure X;               -- any procedure matching the specification of X
    with function X return T;       -- any function returning a result of type T
                                       which matches the specification of X
    with package X is new Y(<>);    -- any package which is an instantiation of Y
In the first two cases, you can also supply a default value like this:

    generic
        Size : Integer := 100;
    procedure Something_Or_Other;

When you instantiate this, you can omit specifying a value for Size:

    procedure X is new Something_Or_Other (Size => 100);
    procedure X is new Something_Or_Other;            -- same as above

12.5 Generics and general access types

As I mentioned in the previous chapter, you can also use generic packages to finesse your way out of the accessibility restrictions on general access types. If you declare a general access type as a package and then access it via a with clause, the scope of the type is the scope of the entire program and so you can only use it to point to objects whose scope is also the scope of the entire program; that is, only to objects declared in library packages (or to library subprograms). This is restrictive, but fortunately (by design!) the scope of a type declared in a generic package is the scope at the point it is instantiated. This means that you can ‘smuggle’ a package containing a general access type into an inner block by instantiating it in that inner block.

You can use this to design a general purpose menu package. The idea is to create a linked list containing a menu item, a character used to select it, and a pointer to a procedure to be executed when the menu item is selected. This reduces the amount of work involved in displaying menus, getting responses and validating them, and selecting the action to be performed. Here’s an outline of a possible specification for the package:

    with JE.Lists;
    generic
    package JE.Menus is
        type Action_Type is access procedure;
        type Menu_Type is limited private;
        ...            -- operations on Menu_Type go here
    private
        type Menu_Item_Type is
            record
                Title  : String (1..40);
                Length : Natural;
                Choice : Character;
                Action : Action_Type;
            end record;
        package Menu_Lists is new JE.Lists (Menu_Item_Type);
        type Menu_Type is
            limited record
                Menu_List : Menu_Lists.List_Type;
            end record;
    end JE.Menus;

This uses the private part of the package to define the types needed to support Menu_Type. Menu_Type is a limited record because it contains a list of menu items, and lists are limited types. Menu_Item_Type declares the structure of an individual menu item: a title to be displayed together with its length, a character used to select it and an action procedure to be called. The package as a whole is generic even though there are no generic parameters needed; this is so that we can ‘smuggle’ it into inner scopes as described above by instantiating it at the same scope as the action procedures we want to use:

    package Menus is new JE.Menus;

We’ll need operations to add new menu items to the menu and to allow the user to select menu choices:

    procedure Add    (Menu   : in out Menu_Type;
                      Title  : in String;
                      Key    : in Character;
                      Action : in Action_Type);

    function Execute (Menu   : Menu_Type) return Boolean;

The idea is that the Execute function will display the menu, get and validate the user’s choice and then call the selected procedure. It will provide a Q (Quit) option automatically and will return True if the user doesn’t select the Quit option, so that it can be used in a loop like this:

    while Execute(Menu) loop
        ...        -- do anything that needs doing between menu actions
    end loop;

Here’s what the body of Add will look like:

    procedure Add (Menu   : in out Menu_Type;
                   Title  : in String;
                   Key    : in Character;
                   Action : in Action_Type) is
        Item : Menu_Item_Type;
        use Menu_Lists;

    begin
        if Title'Length > Item.Title'Length then
            Item.Title  := Title (Title'First .. Item.Title'Length-Title'First+1);
            Item.Length := Item.Title'Length;
        else
            Item.Title (Item.Title'First .. Title'Length-Item.Title'First+1) := Title;
            Item.Length                                                      := Title'Length;
        end if;

        Item.Choice := Ada.Characters.Handling.To_Upper(Key);
        Item.Action := Action;
        Insert( Last(Menu.Menu_List), Item );
    end Add;

Notice how this procedure carefully avoids assuming anything about the length or index range of the Title parameter and the Title component of Item. It constructs the menu item from the parameters and then uses the linked list operation Insert to add the new item to the end of the list. Since case differences should be ignored, it uses a function called To_Upper from the package Ada.Characters.Handling (see Appendix B) which converts its parameter to upper case if it’s a lower case letter. The body of JE.Menus will need a with clause for Ada.Characters.Handling so that it can be referenced from Add.

Now for the body of Execute:

    function Execute (Menu : Menu_Type) return Boolean is
        Item   : Menu_Item_Type;
        Choice : Character;
        use Menu_Lists;
        I      : List_Iterator;

    begin
        loop
            New_Line (3);
            -- Display the menu
            I := First(Menu.Menu_List);
            while I /= Last(Menu.Menu_List) loop
                Item := Value(I);
                Put (" [");
                Put (Item.Choice);
                Put ("] ");
                Put_Line (Item.Title(1..Item.Length));
                I := Succ(I);
            end loop;

            -- Display the Quit option and prompt
            Put_Line (" [Q] Quit");
            Put ("Enter your choice: ");

             -- Get user's choice in upper case
            Get (Choice);
            Choice := Ada.Characters.Handling.To_Upper(Choice);

            if Choice = 'Q' then
                -- Quit chosen, so return
                return False;
            else
                -- Search menu for choice
                I := First(Menu.Menu_List);
                while I /= Last(Menu.Menu_List) loop
                    if Choice = Value(I).Choice then
                        -- Choice found, so call procedure and return
                        Value(I).Action.all;
                        return True;
                    end if;
                    I := Succ(I);
                end loop;
            end if;

            -- Choice wasn't found, so display error message and loop
            Put_Line ("Invalid choice -- please try again.");
        end loop;
    end Execute;

This uses procedures from Ada.Text_IO, so the package body for JE.Menus will need with and use clauses for Ada.Text_IO.

Here’s how the menu package could be used to display the menu for the electronic diary program:

    with JE.Menus, JE.Diaries;
    procedure Diary is
        package Diary_View is
            ...        -- user interface procedures
        end Diary_View;

        ...            -- declarations of the diary etc.

        procedure Add    is separate;
        procedure Delete is separate;
        procedure List   is separate;

        package Menus is new JE.Menus;
        Menu : Menus.Menu_Type;
    begin
        Menus.Add (Menu, "Add appointment",    'A', Add'Access);
        Menus.Add (Menu, "Delete appointment", 'D', Delete'Access);
        Menus.Add (Menu, "List appointments",  'L', List'Access);

        while Menus.Execute(Menu) loop
            null;
        end loop;
    end Diary;

Add, Delete and List would just be procedures to call the corresponding user interface procedures in the internal Diary_View package with the appropriate parameters.


Exercises

12.1 Convert the diary package and main program from the previous chapter to use JE.Menus and JE.Lists.

12.2 Produce a generic version of the calculator program from chapter 3 as a procedure which can be instantiated to work with any integer type and test it with some different integer types.

12.3 Write a generic procedure which will apply a function given as a generic parameter to each element of an array, so that for example it could be used to square every value in an array of integers or convert all lower case letters in a string to upper case.

12.4 Modify the dimensioned units package from exercise 9.3 so that the dimensions are specified by a discrete type supplied as a generic parameter. The dimensions can be represented as an array of integers whose index subtype is the supplied discrete type. For example, the original package used dimensions of mass, length and time; this could be handled by instantiating the new package with an enumeration type consisting of the three values (Mass, Length, Time).



Previous

Contents

Next

This file is part of Ada 95: The Craft of Object-Oriented Programming by John English.
Copyright © John English 2000. All rights reserved.
Permission is given to redistribute this work for non-profit educational use only, provided that all the constituent files are distributed without change.
$Revision: 1.2 $
$Date: 2001/11/17 12:00:00 $