Ada
Ada is a very influential language, even if it never
gained the popularity it hoped to achieve. It did a lot of things right,
and is definitely worth learning.
Overview
Ada is the first internationally standardized object-oriented language (ISO 8652:1995). The language was designed to facilitate the design of large, long-lived, efficient, reliable software systems. You can use it in virtually every interesting area of Computer Science.
Online Resources
- The Ada "Home Page"
- Another Ada "Home Page"
- The Ada 95 Reference Manual
- Wikibook on Ada
- Wikibook on Ada 2005
- Ada Information Clearinghouse (lots of other links from this page)
The language seems complex because it was designed for complex tasks. Readability was an important design goal. It's actually a great language for writing code because many aspects of good software engineering are enforced by the language.
A First Program
The simplest kind of program is a simple parameterless procedure:
first.adb
------------------------------------------------------------------------------
-- This program writes and sums a sequence of integers. It illustrates the
-- basic format of a very small Ada program as well as:
--
-- the use of library packages (e.g. Ada.Text_IO)
-- the use of *overloaded* procedures (e.g. Ada.Text_IO.Put)
-- the use of procedures with default parameters (e.g. Ada.Text_IO.New_Line)
-- variable declarations, both with and without initializers
-- assignment statements
-- for-loop statements
-- type conversion
------------------------------------------------------------------------------
with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Float_Text_IO;
use Ada.Text_IO, Ada.Integer_Text_IO, Ada.Float_Text_IO;
procedure First is
Number_Of_Values: Integer; -- variable declaration
Sum: Integer := 0; -- variable declaration w/ initializer
begin
Put ("Enter an integer: "); -- put a string
Get (Number_Of_Values); -- get an integer
for I in 1..Number_Of_Values loop -- note the implicit declaration of I
Put (I); -- put an integer
Put (','); -- put a character
Sum := Sum + I;
end loop; -- variable I does not exist after loop
New_Line (2); -- call New_Line with an argument
Put ("The sum is "); -- put a string
Put (Sum);
New_Line; -- call New_Line with default argument
Put ("The average is ");
Put (Float(Sum) / Float(Number_Of_Values));
New_Line;
end First;
To compile, bind, and link:
gnatmake first.adb
This produces the executable file first on a Unix
system, or first.exe on a Windows system. (By the way,
gnatmake
is a script that runs gcc followed by gnatbind
followed by gnatlink.)
Language Structure
The Ada language is comprised of the
- Core Language (required of all implementations): Reference Manual 1-13, A, B, J; and the
- Specialized Needs Annexes (not required of an implementation): Reference Manual C,D,E,F,G,H
Reserved Words
abort begin elsif in others rem terminate abs body end is out renames then abstract case entry limited package requeue type accept constant exception loop pragma return until access declare entry mod private reverse use aliased delay for new procedure select when all delta function not protected separate while and digits generic null raise subtype with array do goto of range tagged xor at else if or record task
Symbols
+ - * / ** & < <= = /= >= > ( ) | . , : ; := <> >> << => .. ' " #
Program Structure
An Ada program is made up of a collection of program units, which can be either subprograms or packages. Ada units are designed to have well specified interfaces so they are highly reusable.
Types
In Ada, every object has a type. Types are grouped into classes. There are language-defined types (and classes) and users can define their own types. The language-defined classes form a hierarchy:
Statements
null Block conditional entry call assignment(:=) exit timed entry call procedure call goto asynchronous transfer of control if return accept case raise selective accept loop delay requeue while delay until abort for entry call code
Standard Library
Ada features a really cool and comprehensive standard library. There are three root library units: Ada, System, and Interfaces.
Ada Interfaces |_ Characters |_ C | |_Handling | |_ Pointers | `_Latin_1 | `_ Strings |_ Strings |_ Fortran | |_ Fixed `_ Cobol | |_ Bounded | |_ Unbounded | |_ Maps System | | `_ Constants |_ Storage_Elements | |_ Wide_Fixed |_ Storage_Pools | |_ Wide_Bounded |_ Address_To_Access_Conversions | |_ Wide_Unbounded |_ Machine_Code | `_ Wide_Maps `_ RPC | `_ Wide_Constants |_ Numerics | |_ Generic_Elementary_Functions | |_ Elementary_Functions | |_ Generic_Complex_Types | |_ Complex_Types | |_ Generic_Complex_Elementary_Functions | |_ Complex_Elementary_Functions | |_ Discrete_Random | `_ Float_Random |_ Decimal |_ Exceptions |_ Tags |_ Finalization |_ Task_Finalization |_ Task_Attributes |_ Synchronous_Task_Control |_ Asynchronous_Task_Control |_ Dynamic_Priorities |_ Real_Time |_ Unchecked_Conversion |_ Unchecked_Deallocation |_ Sequential_IO |_ Direct_IO |_ Text_IO | |_ Text_Streams | |_ Editing | `_ Complex_IO |_ Wide_Text_IO | |_ Text_Streams | |_ Editing | `_ Complex_IO |_ Integer_Text_IO |_ Float_Text_IO |_ Storage_IO |_ IO_Exceptions |_ Streams | `_ Stream_IO |_ Interrupts | `_ Names |_ Calendar `_ Command_Line
More Programs
Another Simple Application
triple.adb
------------------------------------------------------------------------------
-- triple.adb
--
-- This program writes out a table of all Pythagorean triples whose elements
-- are in the range 1..100. Each of the triples are written on a single line
-- of text with each value right-justified in a text field six characters
-- wide. The program illustrates:
--
-- the procedure Ada.Text_IO.Put_Line
-- the operator "**"
-- nested loops
-- the width parameter of Ada.Integer_Text_IO.Put
------------------------------------------------------------------------------
with Ada.Text_IO, Ada.Integer_Text_IO;
use Ada.Text_IO, Ada.Integer_Text_IO;
procedure Triple is
begin
Put_Line (" A B C");
Put_Line ("------------------");
for C in 1 .. 100 loop
for B in 1 .. C loop
for A in 1 .. B loop
if A ** 2 + B ** 2 = C ** 2 then
Put (A, 6);
Put (B, 6);
Put (C, 6);
New_Line;
end if;
end loop;
end loop;
end loop;
end Triple;
Three Prime Number Programs
primes1.adb
------------------------------------------------------------------------------
-- primes1.adb
--
-- This program computes and prints all prime numbers up to 10000 using an
-- inefficient version of Eratosthenes' method, then it prints how many prime
-- numbers it found. The program illustrates:
--
-- constant declarations
-- that underscores may appear in integer literals
-- arrays and array aggregates
-- that initializing expressions do not have to be static
-- the 'First and 'Last attribute for arrays
-- nested procedures (note that these are NOT allowed in C and C++)
-- parameters of mode 'in'
-- if statements and while-loop statements
------------------------------------------------------------------------------
with Ada.Text_IO, Ada.Integer_Text_IO;
use Ada.Text_IO, Ada.Integer_Text_IO;
procedure Primes1 is
Size : constant Integer := 10_000;
Sieve : array (2..Size) of Boolean := (2..Size => True);
Count : Integer := 0;
procedure Check_Off_Multiples (P: Integer) is
K: Integer := P;
begin
while K <= Size - P loop -- while there are more multiples
K := K + P; -- go to next multiple of P
Sieve(K) := False; -- mark it non-prime
end loop;
end Check_Off_Multiples;
procedure Report (Number_Found: Integer) is
begin
Put (Number_Found);
Put_Line (" primes found");
end Report;
begin
for I in Sieve'First .. Sieve'Last loop
if Sieve(I) then
Check_Off_Multiples (I);
if Count mod 12 = 0 then -- write twelve primes per row
New_Line;
end if;
Put (I, 6); -- write each in field of 6 chars
Count := Count + 1; -- found another one
end if;
end loop;
New_Line (2); -- make space before reporting
Report (Count);
end Primes1;
primes2.adb
------------------------------------------------------------------------------
-- primes2.adb
--
-- This program computes and prints all the prime numbers up to and including
-- a number which is input by the user in response to a prompt, and then re-
-- ports how many primes it found. The program illustrates:
--
-- the predefined subtype Natural
-- type declarations
-- unconstrained array definitions
-- blocks
-- parameter modes (in, out, and in out)
-- named parameter associations (these are great!)
-- the 'Range attribute for arrays
-- the array concatenation operator (&)
-- the 'Image attribute (defined for any discrete type)
------------------------------------------------------------------------------
with Ada.Text_IO, Ada.Integer_Text_IO;
use Ada.Text_IO, Ada.Integer_Text_IO;
procedure Primes2 is
Limit : Natural; -- will find primes up to this
How_Many : Natural := 0; -- how many primes were found
type Check_List is array (Natural range <>) of Boolean;
procedure Compute_Primes (Up_To: in Natural; Count: in out Natural) is
Sieve: Check_List(2..Up_To);
begin
Sieve := (others => True);
for I in Sieve'Range loop
if Sieve(I) then
Put (Width => 12, Item => I, Base => 10);
Count := Count + 1;
declare -- start a block
K: Natural := I; -- variable local to the block
begin
while K <= Sieve'Last - I loop
K := K + I; -- go to next multiple
Sieve(K) := False; -- check off this multiple
end loop;
end; -- after block, K does not exist
if Count mod 6 = 0 then -- write six primes per row
New_Line;
end if;
end if;
end loop;
New_Line (2);
end Compute_Primes;
begin
Put ("Find primes up to what number? ");
Get (Limit);
Compute_Primes (Up_To => Limit, Count => How_Many);
Put_Line ("I found" & Natural'Image(How_Many) & " primes.");
end Primes2;
primes3.adb
------------------------------------------------------------------------------
-- primes3.adb
--
-- This program computes and prints all the prime numbers up to and including
-- a number which is provided as the sole argument on the command line, or, if
-- no command line arguments are given, input by the user in response to a
-- prompt, and then reports how many primes it found. The program illustrates:
--
-- the predefined package Ada.Command_Line
-- the 'Value attribute for converting strings to natural numbers
-- handling an exception (in this case a built in one)
-- how not using a use clause can make code a bit more readable
------------------------------------------------------------------------------
with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Command_Line;
use Ada.Text_IO, Ada.Integer_Text_IO, Ada;
procedure Primes3 is
Limit : Natural; -- will find primes up to this
How_Many : Natural; -- how many primes were found
procedure Compute_Primes (Up_To: in Natural; Count: out Natural) is
Sieve: array (2 .. Up_To) of Boolean := (others => True);
begin
Count := 0;
for I in Sieve'Range loop
if Sieve(I) then
Put (Item => I, Width => 12, Base => 10);
Count := Count + 1;
declare -- start a block
K: Natural := I; -- variable local to the block
begin
while K <= Sieve'Last - I loop
K := K + I; -- go to next multiple
Sieve(K) := False; -- check off this multiple
end loop;
end; -- after the block K does not exist
if Count mod 6 = 0 then -- write six primes per row
New_Line;
end if;
end if;
end loop;
New_Line (2);
end Compute_Primes;
begin
if Command_Line.Argument_Count = 0 then
Put ("Find primes up to what number? ");
Get (Limit);
else
Limit := Natural'Value(Command_Line.Argument(1));
end if;
Compute_Primes (Up_To => Limit, Count => How_Many);
Put_Line ("I found" & Natural'Image(How_Many) & " primes.");
exception
when Data_Error => Put_Line ("I do not understand your input");
end Primes3;
Understanding Types
types.adb
------------------------------------------------------------------------------
-- types.adb
--
-- This program doesn't *do* anything useful; it just illustrates types and
-- objects in Ada. Among the features illustrated are:
--
-- array, record, and pointer declarations
-- incomplete declarations (to allow for recursive types)
-- array and record aggregates
-- default values on record fields
-- discriminants on records
-- strings (the type Standard.String - not one the fancy string types)
-- use of access values (a.k.a. "pointers")
-- enumerations containing characters
-- separation of subprogram specifications from bodies
------------------------------------------------------------------------------
with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Float_Text_IO;
use Ada.Text_IO, Ada.Integer_Text_IO, Ada.Float_Text_IO;
procedure Types is
-- Simple object declarations:
Sorted: Boolean; -- variable declaration
Count: Integer := 0; -- vars MAY have initializers
Pi: constant Float:= 3.1415926535897932; -- consts MUST have initializers
Two_Pi: constant Float := 2.0 * Pi; -- expressions allowed
K: constant Integer := 2 ** 10; -- 1K = 1024
-- Simple type declarations: constrained arrays, enumeration types,
-- user defined subtypes.
type Table is array (1..10) of Integer;
type Color is (Black, Blue, Green, Cyan, Red, Magenta, Yellow, White);
subtype Reddish is Color range Red..Yellow;
type Color_Chart is array (0..K-1) of Color;
type Day is (Mon, Tue, Wed, Thu, Fri, Sat, Sun);
subtype Weekday is Day range Mon..Fri;
type Time_Card is array (Day) of Float;
type Union_Time_Card is array (Weekday) of Float;
-- Unconstrained array type declarations are just fine. They MAY be
-- constrained in a subtype declaration; they MUST be constrained in
-- an object declaration.
type Matrix is array (Integer range <>, Integer range <>) of Float;
subtype Mat_33 is Matrix (1..3, 1..3);
Grid : Matrix (1..8, 1..8);
Ident : constant Mat_33 := ((1.0,0.0,0.0),(0.0,1.0,0.0),(0.0,0.0,1.0));
-- When declaring a subtype, you do not have to specify a range
-- constraint:
subtype Int is Integer;
-- Enumeration types may contain identifiers or character literals.
type Roman_Digit is ('I', 'V', 'X', 'L', 'C', 'D', 'M');
type Roman is array (Positive range <>) of Roman_Digit;
-- The following are predefined (i.e. they appear in package Standard):
--
-- subtype Positive is Integer range 1..Integer'Last
-- type String is array (Positive range <>) of Character;
--
-- Examples of arrays whose elements are character literals follow. Note
-- the convenient shorthand notation for specify array aggregates of
-- these types.
Prompt: String(1..50);
Greeting: constant String(1..5) := "Hello";
subtype Line is String(1..80);
C_Comment: Line := (1 => '/', 2..79 => '*', 80 => '/');
Ninety_Six: constant Roman := "XCVI";
-- Subprograms (procedures and functions) can be declared before their
-- body is given.
function Middle_Character (S: String) return Character;
-- Another enumeration type:
type Month_Name is (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
-- Here are some examples of record types:
type Date is record
Day: Positive range 1..31;
Month: Month_Name;
Year: Integer;
end record;
type Complex is record
Re: Float := 0.0; -- fields may have initial values
Im: Float := 0.0;
end record;
-- The following is an example of a record type with a discriminant.
-- An object S of type Square has two attributes: S.Side and S.Data.
-- The discriminant Side must be given a value when the object is
-- declared and is read only.
type Square (Side: Integer) is record
Data: Matrix(1..Side, 1..Side);
end record;
subtype Three_D_Xform is Square(4);
A_Funny_Thing: Square(2) := (2, ((1.0, 3.2), (9.9, 3.44E-26)));
-- You can specify a default for the discriminant:
type Buffer (Size: Positive := 256) is record
Position: Positive;
Value: String(1..Size);
end record;
-- If a value is specified for an object of a record type with a default
-- discriminant, then it is a normal constrained object...
K_Buffer: Buffer(1024); -- 1024 elements
-- ...but if no value is specified, the object is unconstrained (i.e.
-- you can actually change the discriminant at run time (provided
-- assignments are made to all fields simultaneously).
My_Buffer: Buffer; -- 256 elements but changeable
-- Arbitrary linked structures require mutually recursive types. Since
-- Ada elaborates declarations strictly in order some types must be
-- declared before they are defined.
type Node; -- incomplete type declaration
type Link is access Node; -- use of incomplete declaration
type Node is record -- completion
Value: Integer;
Previous: Link;
Next: Link;
end record;
type Gender is (Male, Female);
type Person (Sex: Gender); -- incomplete
type Car; -- incomplete
type Person_Pointer is access Person;
type Woman_Pointer is access Person(Female);
type Man_Pointer is access Person(Female);
type Car_Pointer is access Car;
type Car is record
VID: String(1..25);
Primary_Owner: Person_Pointer;
end record;
-- Here is an example of a record with a variant part. The variant
-- is controlled by the discriminant. Variant records are technically
-- unnecessary in Ada because type extension is a far superior way to
-- do what variant records to; however, type extension did not exist
-- in pre-1995 Ada. So you might see variant records from time to
-- time....
type Person (Sex: Gender) is record
Name: String(1..30);
Birthday: Date;
Weight: Float;
Favorite_Car: Car_Pointer;
case Sex is
when Male => Wife: Woman_Pointer;
when Female => Husband: Man_Pointer;
end case;
end record;
-- Here are some more variable declarations:
T: Time_Card;
D: Date;
P1: Person_Pointer;
P2: Person_Pointer;
C: Car_Pointer;
Lut: Color_Chart;
Z: Complex;
S: Link;
Q: Person(Female);
-- Here is the body of the function Middle_Character that we gave the
-- specification for a while back. Note that the respecification of
-- the header must match the previous declaration in terms of the
-- number, names, modes and types of its parameters, and if a function,
-- in terms of its return type as well.
function Middle_Character (S: String) return Character is
begin
return S((S'First + S'Last)/2);
end Middle_Character;
begin
Put (Two_Pi, Exp => 0);
New_Line;
Put (Two_Pi, Fore => 7, Aft => 6, Exp => 5);
New_Line;
T := (2.6, 10.2, 9.3, 8.0, 0.0, 0.0, 1.0);
Lut := (Black, Cyan, Red, Red, others => Magenta);
D := (1, Jul, 1991);
D := (Month => Jul, Day => 1, Year => 1991);
D := (1, Year => 1991, Month => Jul);
Put (D.Year);
New_Line;
Put (Greeting);
New_Line;
Put (C_Comment(68..80)); -- this is called a slice
New_Line;
Z.Re := 6.72;
Z := (3.0, -234.22);
C := new Car;
P1 := new Person(Female);
P1.Name := "Mary ";
P2 := new Person(Male);
P1.Favorite_Car := C;
C.Primary_Owner := P2;
S := new Node;
S.all.Value := 3;
S.Value := 3; -- ".all" is optional in middle
S.Next := new Node'(Value => 10, Next => null, Previous => S);
P2.Birthday.Year := 1967;
end Types;
Fibonacci Numbers
fib.adb
------------------------------------------------------------------------------
-- fib.adb
--
-- This program prints out Fibonacci numbers in octal, decimal and hexidecimal
-- in reverse order. The number of Fibonacci numbers that the user wants
-- to see is input on the command line, but if no arguments are given on the
-- command line then the program will prompt the user to input that value.
-- Features illustrated:
--
-- defining your own exceptions
-- enumerated types
-- the 'Pos attribute
-- reverse keyword in for loop range
-- the case statement
-- deep nesting of procedures
-- assignment to array slices
-- lots of useless mixing of positional and named associations.
------------------------------------------------------------------------------
with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Command_Line;
use Ada.Text_IO, Ada.Integer_Text_IO, Ada.Command_Line;
procedure Fib is
Number_Of_Values_Requested: Integer;
-- In Ada there are a number of predefined exceptions, but we can declare
-- our own. Too_Few will be raised if the user does not ask for at least
-- two Fibonacci numbers, and Bad_Argument will be raised if the program
-- can not make sense out of the user's input:
Too_Few, Bad_Argument: exception;
type Number_List is array (Integer range <>) of Integer;
type Number_System is (Octal, Decimal, Hexidecimal);
-- String_To_Natural (S) returns the natural number corresponding to
-- the string S. If S contains characters that are not digits, the
-- exception Bad_Argument is raised; if the string represents a
-- number larger than the system can represent, Constraint_Error
-- is raised. Note that this function could more easily have been
-- written as "return Natural'(Natural'Value(S));". In that case
-- the exception Data_Error would be raised if the string contained
-- non-digit characters.
function String_To_Natural (S: String) return Natural is
Result: Integer := 0;
begin
for I in S'Range loop
if S(I) not in '0'..'9' then
raise Bad_Argument;
end if;
Result := 10 * Result + (Character'Pos(S(I)) - Character'Pos('0'));
end loop;
return Result;
end String_To_Natural;
-- The function Get_User_Input returns the user's "input" as follows:
-- First it checks to see if any argument was entered on the command
-- line and if so attempts to convert that value to a natural number.
-- If the command line has no parameters the user is prompted for an
-- input. In either case, the value input must be greater than or
-- equal to 2; the function raises Too_Few if it is not.
function Get_User_Input return Integer is
Size: Integer;
begin
if Argument_Count > 0 then -- an argument was supplied
Size := String_To_Natural(Argument(1)); -- use the first argument
else
Put ("How many numbers do you want (minimum = 2)? ");
Get (Size);
end if;
if Size < 2 then
raise Too_Few;
end if;
return Size;
end Get_User_Input;
-- Compute (Size) finds and displays the first Size Fibonacci numbers.
-- It first allocates an array of just the right size to store the
-- numbers, then loads the array by performing the straightforward
-- calculations. Then the array is printed backwards three times
-- with different bases, using the helper function Display.
procedure Compute (Size: in integer) is
Fibs: Number_List(1..Size);
procedure Display (B: Number_System) is
begin
Put ("Fibonacci Numbers in " & Number_System'Image(B) & " backwards: ");
New_Line (2);
for I in reverse Fibs'Range loop
case B is
when Octal => Put (Fibs(I), Base => 8, Width => 20);
when Decimal => Put (Fibs(I), 16, 10);
when Hexidecimal => Put (Base => 16, Item => Fibs(I), Width => 20);
end case;
end loop;
New_Line (2);
end Display;
begin
Fibs(1..2) := (1,1); -- load the first two values
for I in 3..Size loop
Fibs(I) := Fibs(I - 1) + Fibs(I - 2);
end loop;
Display (Octal);
Display (Decimal);
Display (Hexidecimal);
end Compute;
begin
Number_Of_Values_Requested := Get_User_Input;
Compute (Size => Number_Of_Values_Requested);
Put_Line ("Program successfully completed");
exception
when Too_Few => Put_Line ("Not enough values requested");
when Bad_Argument => Put_Line ("Illegal command line argument");
when Constraint_Error => Put_Line ("I can't find that many");
when Data_Error => Put_Line ("That's not a decent response");
end Fib;
A Large Example
Here we'll make an abstract data type for stacks, using linked lists. We'll see generics, separate compilation, and child packages.
First we start with the package specification
unbounded_stacks.ads
------------------------------------------------------------------------------
-- unbounded_stacks.ads
--
-- A generic package for unbounded LIFO stacks. It exports a limited private
-- type 'Stack'.
--
-- Generic Parameters:
--
-- Element the desired type of the stack elements.
--
-- Operations:
--
-- Is_Empty (S) whether or not S is empty.
-- Is_Full (S) whether or not S is full.
-- Size (S) the number of elements in S.
-- Push (S, E) push E on top of S. Raise Overflow if there is no room
-- available in S.
-- Top (S) the top element of S. Raise No_Top if there is no top
-- element.
-- Pop (S) remove the top element of S. Raise Underflow if S is ini-
-- tially empty since no element can be popped.
-- Pop (S, E) remove the element from the top of S and assign it to E.
-- Raise Underflow if S is initially empty since no element
-- can be popped.
------------------------------------------------------------------------------
with Ada.Text_IO;
use Ada.Text_IO;
generic
type Element is private;
package Unbounded_Stacks is
type Stack is limited private;
Overflow, Underflow, No_Top: exception;
function Is_Empty (S: Stack) return Boolean;
function Size (S: Stack) return Natural;
procedure Push (S: in out Stack; E: Element);
function Top (S: Stack) return Element;
procedure Pop (S: in out Stack);
procedure Pop (S: in out Stack; E: out Element);
private
type Node;
type Stack is access Node;
type Node is record
Data : Element;
Link : Stack;
end record;
end Unbounded_Stacks;
The implementation of this package spec appears in a separate file:
unbounded_stacks.adb
------------------------------------------------------------------------------
-- unbounded_stacks.adb
--
-- Implementation of the unbounded stack ADT.
------------------------------------------------------------------------------
package body Unbounded_Stacks is
function Is_Empty (S: Stack) return Boolean is
begin
return S = null;
end Is_Empty;
function Size (S: Stack) return Natural is
begin
if S = null then
return 0;
else
return 1 + Size(S.Link);
end if;
end Size;
procedure Push (S: in out Stack; E: Element) is
begin
S := new Node'(E, S);
exception
when Storage_Error => raise Overflow;
end Push;
function Top (S: Stack) return Element is
begin
if Is_Empty (S) then
raise No_Top;
end if;
return S.Data;
end Top;
procedure Pop (S: in out Stack) is
begin
if Is_Empty (S) then
raise Underflow;
end if;
S := S.Link;
end Pop;
procedure Pop (S: in out Stack; E: out Element) is
begin
if Is_Empty (S) then
raise Underflow;
end if;
E := S.Data;
S := S.Link;
end Pop;
end Unbounded_Stacks;
Suppose we wanted to add I/O capability to our stacks. In Ada, you can put this additional functionality in a child package. It's a good idea not to put I/O in the basic stack package since that pollutes the original package with funcitonality that not everyone would want. Here is the spec:
unbounded_stacks-io.ads
------------------------------------------------------------------------------ -- unbounded_stacks-io.ads -- -- A generic child package which enables output for unbounded stacks. -- -- Generic Parameters: -- -- Put (F, E) procedure to display element E to file F. -- -- Operations: -- -- Put (F, S) write S to file F in the form <x1 x2 ... xn> FROM TOP TO -- BOTTOM. -- Put (S) Same as Put (Current_Output, S) ------------------------------------------------------------------------------ with Ada.Text_IO; use Ada.Text_IO; generic with procedure Put (F: File_Type; E: Element); package Unbounded_Stacks.IO is procedure Put (F: File_Type; S: Stack); procedure Put (S: Stack); end Unbounded_Stacks.IO;
...and the body
unbounded_stacks-io.adb
------------------------------------------------------------------------------
-- unbounded_stacks-io.adb
--
-- Implementation of the unbounded stack ADT ouput routines.
------------------------------------------------------------------------------
package body Unbounded_Stacks.IO is
procedure Put (F: File_Type; S: Stack) is
T: Stack := S;
begin
Put (F, "< ");
while T /= null loop
Put (F, T.Data);
Put (' ');
T := T.Link;
end loop;
Put (F, '>');
end Put;
procedure Put (S: Stack) is
begin
Put (Current_Output, S);
end Put;
end Unbounded_Stacks.IO;
To exercise the stack package, we write a little driver:
test_unbounded_stacks.adb
------------------------------------------------------------------------------
-- test_unbounded_stacks.adb
--
-- A program that tests the unbounded stack ADT package.
------------------------------------------------------------------------------
with Ada.Text_IO, Unbounded_Stacks, Unbounded_Stacks.IO;
use Ada.Text_IO;
procedure Test_Unbounded_Stacks is
package My_Stacks is new Unbounded_Stacks (Character);
use My_Stacks;
package My_Stacks_IO is new My_Stacks.IO (Put);
use My_Stacks_IO;
S: Stack;
procedure Test is
Option: Character;
Data: Character;
begin
loop
Put (S);
Put_Line (" Length =" & Integer'Image(Size(S)));
Put ("Empty pusH Pop Quit: ");
Get (Option);
New_Line;
case Option is
when 'h' =>
begin
Put ("push what? "); Get (Data); Push (S, Data);
exception
when Overflow => Put_Line ("Cannot push onto full stack");
end;
when 'p' =>
begin
Pop (S, Data); Put (Data); Put_Line (" popped");
exception
when Underflow => Put_Line ("Cannot pop from empty stack");
end;
when 'e' =>
if Is_Empty(S) then Put ("Empty");
else Put ("Not Empty");
end if;
when 'q' => exit;
when others => null;
end case;
New_Line;
end loop;
end Test;
begin
Test;
end Test_Unbounded_Stacks;
To compile, bind, and link, just enter
gnatmake test_unbounded_stacks.adb
and you have your executable. This is because gnatmake
automatically searches out all dependencies and compiles out of
date files when needed (assuming that subprogram and package names
are the same as the filename in which they are contained.
Even More Examples
If you like concurrent programming, you might find this page interesting.