In many situations, passing functions to other functions as parameters is the most suitable way to create flexible programs. Therefore, Ada95 supports type-safe function pointers or "access types for functions" in Ada parlance. Here is an implementation of the trapezoidal rule to compute the integral of a function.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Float_Text_IO; use Ada.Float_Text_IO;
procedure Main is
type Float_Function is access function (X: Float) return Float;
function Integrate(F: Float_Function; A, B: Float) return Float is
X: Float := A;
Y: Float := 0.0;
DeltaX: Float := 1.0e-5;
begin
loop
Y := Y + DeltaX * (F(A) + F(B)) / 2.0;
X := X + deltaX;
if X >= B then exit; end if;
end loop;
return Y;
end;
function Square(X: Float) return Float is
begin
return X*X;
end;
begin
Put(Integrate(Square'Access, 0.0, 2.0));
New_Line(1);
end;As with other values, we obtain the pointer (or access) to a function using the Access attribute. We can call the access function as if it were a regular function (as long as it has parameters - otherwise we need to user F.all).
Strong typing necessitates some mechanism to define types depending on other types. Ada lets us parametrize functions and packages with type, functions, values, and even other packages.
The following first example shows a generic Swap procedure using the Item type as a type parameter.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main is
generic
type Item is private;
procedure Swap(X, Y: in out Item);
procedure Swap(X, Y: in out Item) is
T: Item;
begin
T := X; X := Y; Y := T;
end;
procedure Integer_Swap is new Swap(Integer);
A: Integer := 55;
B: Integer := 66;
begin
Put(A); Put(B); New_Line(1);
Integer_Swap(A, B);
Put(A); Put(B); New_Line(1);
end;The procedure becomes generic by placing the declaration of the generic parameters between the generic and procedure keywords. When using generic constructs, we always have to separate the declaration of the generic entity (here the procedure Swap) from its definition. In contrast to C++, we do not have to repeat the generic part in the definition.
To use the generic procedure, we have to instantiate it with a generic parameter. In our example, we instantiate the generic Swap procedure with the Integer type. The generic parameters are passed just like any other function or procedure parameters.
As mentioned above, generics can be used with almost every construct in Ada. Here is a slightly more complex example defining a generic package implementing a stack.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main is
generic
Max: Positive;
type Item is private;
package Stack is
procedure Push(X: in Item);
function Pop return Item;
function Is_Empty return Boolean;
end Stack;
package body Stack is
Data: array(0 .. Max) of Item;
Top: Integer range 0 .. Max := 0;
procedure Push(X: in Item) is
begin
Data(Top) := X;
Top := Top + 1;
end Push;
function Pop return Item is
begin
Top := Top - 1;
return Data(Top);
end Pop;
function Is_Empty return Boolean is
begin
return Top = 0;
end Is_Empty;
end Stack;
package My_Stack is new Stack(10, Integer);
use My_Stack;
begin
Push(55);
Push(66);
while not Is_Empty loop
Put(Pop); New_Line(1);
end loop;
end;The approach is the same: we have to split declaration and definition and put the generic part ahead of the declaration. The example also demonstrates the use of two different kinds of generic parameters: the positive integer Max and the (arbitrary) type Item.
The example becomes more useful if we define a stack type inside a generic package. This way we can use multiple stacks.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main is
generic
type Item is private;
Max: Positive;
Default: Item;
package Stack_Of is
type Stack is private;
procedure Push(S: in out Stack; X: in Item);
procedure Pop(S: in out Stack; X: out Item);
function Is_Empty(S: in Stack) return Boolean;
private
type Stack_Data is array(0 .. Max) of Item;
type Stack is
record
Top: Integer range 0 .. Max := 0;
Data: Stack_Data := (others => Default);
end record;
end Stack_Of;
package body Stack_Of is
procedure Push(S: in out Stack; X: in Item) is
begin
S.Data(S.Top) := X;
S.Top := S.Top + 1;
end Push;
procedure Pop(S: in out Stack; X: out Item) is
begin
S.Top := S.Top - 1;
X := S.Data(S.Top);
end Pop;
function Is_Empty(S: in Stack) return Boolean is
begin
return S.Top = 0;
end Is_Empty;
end Stack_Of;
package My_Stack is new Stack_Of(Integer, 10, 0);
S: My_Stack.Stack;
X: Integer;
begin
My_Stack.Push(S, 55);
My_Stack.Push(S, 66);
while not My_Stack.Is_Empty(S) loop
My_Stack.Pop(S, X);
Put(X); New_Line(1);
end loop;
end;Once we have understood Ada's generic machinery, its application to more complex situations is straight forward.
Ada was clearly designed with safety as a first priority (that is, for "mission critical" applications in the sense of "space mission"). As an example, all numerical computations are checked for overflows. The following program would run happily forever using C, but stops rather quickly in Ada once the limit of the integer range is exceeded.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Int_Overflow is
X: Integer := 1;
begin
loop
X := 2 * X;
Put("X=");
Put(X);
New_Line(1);
end loop;
end;
output:
X= 2
X= 4
X= 8
...
X= 268435456
X= 536870912
X= 1073741824
raised CONSTRAINT_ERROR : int_overflow.adb:8Using the gnat compiler, we have to specify the -gnato option to experience the desired behavior, since gnat switches the overflow checking off by default.
Here is another example of Ada's nifty little features solving everyday programming problems: modular types. Who has not dealt with some cyclic integer type throughout his or her programming career coding the module arithmetic by hand? In Ada, we simply define the type as mod N where N is some positive integer.
with Ada.Text_IO; use Ada.Text_IO;
procedure Main is
N: constant Integer := 3;
type Ring is mod N;
X: Ring := 0;
package Ring_IO is new Modular_IO(Ring); use Ring_IO;
begin
for I in 0 .. 10 loop
Put(X);
X := X + 1;
end loop;
end;The modular type Ring consists of the numbers zero to two. All computations, such as adding on in the loop, are performed modulo three. Like enumerations, modular types have their own generic input/output package Modular_IO which we instantiate here as Ring_IO in order to be able to print the value of the modular variable X.
The standard package Interfaces (called this way because it is used to interface with other languages such as C) contains a number of modular types where the modulus N is a power of two, for example Unsigned_8 with modulus 256. Together with these types, the package also provides shift and rotate functions.
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces; use Interfaces;
procedure Main is
X: Unsigned_8 := 1;
package Unsigned_8_IO is new Modular_IO(Unsigned_8); use Unsigned_8_IO;
begin
for I in 0 .. 10 loop
Put(X);
X := Rotate_Right(X, 1);
end loop;
end;
output: 1 128 64 32 16 8 4 2 1 128 64Most modern programming languages support parallel programming with some multithreading API and sometimes additional primitives for synchronization such as Java's synchronized keyword. Ada uses a different approach and models typical patterns of defining and controlling parallel activities directly in the language.
The first tool is the task construct which allows us to define an activity which is run in parallel to the instructions of a procedure.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main is
task Sub;
task body Sub is
begin
for I in 1 .. 5 loop
Put("Sub: "); Put(I); New_Line(1);
delay 0.2;
end loop;
end Sub;
begin
for I in 1 .. 5 loop
Put("Main: "); Put(I); New_Line(1);
delay 0.1;
end loop;
end;The main procedure counts from one to five with a delay of 0.1 seconds. The task Sub also counts from one to five, but with a delay of 0.2 seconds. The resulting output shows how the two activities are executed in parallel. The procedure stops after all threads are done, that is, the main thread is waiting until the sub task is finished.
output: Main: 1 Sub: 1 Main: 2 Sub: 2 Main: 3 Main: 4 Sub: 3 Main: 5 Sub: 4 Sub: 5
A task allows us to run multiple activities in parallel, but to become useful they have to be able to communicate with each other. There are two way to accomplish this kind of communication in Ada: using shared data or sending messages.
Beginning with messages, we can define entry points which cause a task to wait until another task calls (sends a message to) the entry point. This mechanism is called a rendezvous. Apart from the different keywords (entry for the declaration and accept for the definition), an entry looks just like a procedure.
The following example defines the entry Wake_Up in the task Sub with a single integer argument. The task consists of a loop which processes Wake_Up messages until the argument is equal to zero.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main is
task Sub is
entry Wake_Up(I: Integer);
end Sub;
task body Sub is
Stop: Boolean := False;
begin
while not Stop loop
Put("Sub: Wait"); New_Line(1);
accept Wake_Up(I: Integer) do
Put("Sub: "); Put(I); New_Line(1);
if I = 0 then
Stop := True;
end if;
end Wake_Up;
end loop;
Put("Sub: Stop"); New_Line(1);
end Sub;
begin
for I in reverse 0 .. 3 loop
delay 0.1;
Put("Main: Send"); New_Line(1);
Sub.Wake_Up(I);
end loop;
Put("Main: Stop"); New_Line(1);
end;The main procedure sends Wake_Up messages counting from three down to zero. The statement Sub.Wake_Up(I) submitting the message looks like a method call. Here is corresponding output:
Sub: Wait Main: Send Sub: 3 Sub: Wait Main: Send Sub: 2 Sub: Wait Main: Send Sub: 1 Sub: Wait Main: Send Sub: 0 Main: Stop Sub: Stop
Of course, we are not retricted to a single entry. Here is an example of a buffer containing a single value. It is implemented as a task with the two entries Set and Get.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main is
task Buffer is
entry Set(X: in Integer);
entry Get(X: out Integer);
end;
task body Buffer is
Value: Integer;
begin
loop
accept Set(X: in Integer) do
Put("Buffer.Set: "); Put(X); New_Line(1);
Value := X;
end Set;
accept Get(X: out Integer) do
Put("Buffer.Get: "); Put(Value); New_Line(1);
X := Value;
end Get;
end loop;
end Buffer;
task Consumer;
task body Consumer is
I: Integer;
begin
loop
Buffer.Get(I);
Put("Consumer: "); Put(I); New_Line(1);
end loop;
end Consumer;
begin
for I in 0 .. 2 loop
Buffer.Set(I);
delay 1.0;
end loop;
end;The Consumer task continuously asks the buffer for the latest value and "consumes" it. The main procedure inserts the values zero to two into the buffer with a one second delay. Here is the resulting output:
Buffer.Set: 0 Buffer.Get: 0 Consumer: 0 Buffer.Set: 1 Buffer.Get: 1 Consumer: 1 Buffer.Set: 2 Buffer.Get: 2 Consumer: 2
Note how the buffer task and its entries make sure that the actions are carried out in the correct order.
In the previous example the consumer was fast and the producer (the main task) slow. The opposite case is often handled with a queue. In this situation, the task may receive both events (provided the queue is neither empty nor completely full). Ada supports this with the select statement and guarding conditions which can be associated with entries.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main is
task Queue is
entry Push(X: in Integer);
entry Pull(X: out Integer);
end;
task body Queue is
N: Integer := 10;
In_Ptr, Out_Ptr, Count : Integer := 0;
Values: array (Integer range 0 .. N - 1) of Integer;
begin
loop
select
when Count < N =>
accept Push(X: in Integer) do
Values(In_Ptr) := X;
In_Ptr := (In_Ptr + 1) mod N; Count := Count + 1;
end;
or
when Count > 0 =>
accept Pull(X: out Integer) do
X := Values(Out_Ptr);
Out_Ptr := (Out_Ptr + 1) mod N; Count := Count - 1;
end;
end select;
end loop;
end Queue;
task Consumer;
task body Consumer is
I: Integer;
begin
loop
delay 1.0;
Queue.Pull(I);
Put("Consumer: "); Put(I); New_Line(1);
end loop;
end Consumer;
task Producer;
task body Producer is
begin
for I in 10 .. 12 loop
delay 3.0;
Put("Producer: "); Put(I); New_Line(1);
Queue.Push(I);
end loop;
end Producer;
begin
for I in 0 .. 2 loop
Put("Main: "); Put(I); New_Line(1);
Queue.Push(I);
end loop;
end;To make things more interesting we added a second (slow) producer. This way we see some of the scenarios in the output:
Main: 0 Main: 1 Main: 2 Consumer: 0 Consumer: 1 Producer: 10 Consumer: 2 Consumer: 10 Producer: 11 Consumer: 11 Producer: 12 Consumer: 12
First, the fast main producer pushes the values zero to two on the queue. They are consumed by the consumer, while the slow producer starts pushing his values. In the end the consumer is faster than the producers.
For shared data access as the second way of communication between parallel tasks, Ada has so-called protected objects. Apart from the protected keyword they look like packages, but the data (which must be defined in the private section of the protected object's declaration) is protected from simultaneous access. The following example wraps a simple integer value in a protected object Shared_Data.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main is
protected Shared_Data is
function Get return Integer;
procedure Set(New_Value: Integer);
private
Value: Integer := 0;
end Shared_Data;
protected body Shared_Data is
function Get return Integer is
begin
return Value;
end Get;
procedure Set(New_Value: Integer) is
begin
Value := New_Value;
end Set;
end Shared_Data;
begin
Shared_Data.Set(55);
Put(Shared_Data.Get); New_Line(1);
end;In many cases we would like to define not just a single protected object, but a type which we can use to create as man protected objects as we want to. This is achieved by adding the type keyword to the declaration of the protected object. Here is a variation of the previous example using such a protected type.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main is
protected type Shared_Data is
function Get return Integer;
procedure Set(New_Value: Integer);
private
Value: Integer := 0;
end Shared_Data;
protected body Shared_Data is
function Get return Integer is
begin
return Value;
end Get;
procedure Set(New_Value: Integer) is
begin
Value := New_Value;
end Set;
end Shared_Data;
X: Shared_Data;
begin
X.Set(55);
Put(X.Get); New_Line(1);
end;As you can imagine, protected types are useful for the typical semaphore patterns.