The brightest highlights of Ada 95 are its inherent reliability and its ability to provide abstraction through the package and private type. These features already exist in Ada 83 and so in a real sense Ada 83 already contains the best of Ada 95. Indeed, Ada 83 is already a very good language. However, time and technology do not stand still, and Ada 95 is designed to meet increased requirements which have arisen from three directions. These are: feedback from the use of existing paradigms; additional market requirements to match evolving hardware capability; and increased fundamental understanding which has introduced new paradigms. As we will see, Ada 95 follows on from the tradition of excellence of Ada 83 and meets these additional requirements in an outstanding manner.
The key idea of programming by extension is the ability to declare a new type that refines an existing parent type by inheriting, modifying or adding to both the existing components and the operations of the parent type. A major goal is the reuse of existing reliable software without the need for recompilation and retesting.
type Object is tagged record X_Coord: Float; Y_Coord: Float; end record;
The other types of geometrical objects will be derived (directly or indirectly) from this type. For example we could have
type Circle is new Object with record Radius: Float; end record;
and the type Circle then has the three components X_Coord, Y_Coord and Radius. It inherits the two coordinates from the type Object and the component Radius is added explicitly.
type Point is new Object with null record;
type Shape is tagged private;
and the full type declaration must then (ultimately) be a tagged record
type Shape is tagged record ...
or derived from a tagged record such as Object. On the other hand we might wish to make visible the fact that the type Shape is derived from Object and yet keep the additional components hidden. In this case we would write
package Hidden_Shape is type Shape is new Object with private; -- client view ... private type Shape is new Object with -- server view record -- the private components end record; end Hidden_Shape;
function Distance(O: in Object) return Float is begin return Sqrt(O.X_Coord**2 + O.Y_Coord**2); end Distance;
function Area(O: in Object) return Float is begin return 0.0; end Area;
which returns zero since a raw object has no area. This would also be inherited by the type Circle but would be inappropriate; it would be more sensible to explicitly declare
function Area(C: in Circle) return Float is begin return Pi*C.Radius**2; end Area;
which will override the inherited operation.
O: Object := (1.0, 0.5); C: Circle := (0.0, 0.0, 12.2); ... O := Object(C);
which effectively ignores the third component. However, conversion in the other direction requires the provision of a value for the extra component and this is done by an extension aggregate thus
where the expression O is extended after with by the values of the extra components written just as in a normal aggregate. In this case we only had to give a value for the radius.
with Calendar; package Alert_System is type Priority is (Low, Medium, High); type Device is (Teletype, Console, Big_Screen); type Alert(P: Priority) is record Time_Of_Arrival: Calendar.Time; Message: Text; case P is when Low => null; when Medium | High => Action_Officer: Person; case P is when Low | Medium =>null; when High => Ring_Alarm_At: Calendar.Time; end case; end case; end record; procedure Display(A: in Alert; On: in Device); procedure Handle(A: in out Alert); procedure Log(A: in Alert); procedure Set_Alarm(A: in Alert); end Alert_System;
procedure Handle(A: in out Alert) is begin A.Time_Of_Arrival := Calendar.Clock; Log(A); Display(A, Teletype); case A.P is when Low => null; -- nothing special when Medium | High => A.Action_Officer := Assign_Volunteer; Display(A, Console); case A.P is when Low | Medium => null; when High => Display(A, Big_Screen); Set_Alarm(A); end case; end case; end Handle;
with Calendar; package New_Alert_System is type Device is (Teletype, Console, Big_Screen); type Alert is tagged record Time_Of_Arrival: Calendar.Time; Message: Text; end record; procedure Display(A: in Alert; On: in Device); procedure Handle(A: in out Alert); procedure Log(A: inAlert); type Low_Alert is new Alert with null record; type Medium_Alert is new Alert with record Action_Officer: Person; end record; -- now override inherited operation procedure Handle(MA: in out Medium_Alert); type High_Alert is new Medium_Alert with record Ring_Alarm_At: Calendar.Time; end record; procedure Handle(HA: in out High_Alert); procedure Set_Alarm(HA: in High_Alert); end New_Alert_System;
package body New_Alert_System is procedure Handle(A: in out Alert) is begin A.Time_Of_Arrival := Calendar.Clock; Log(A); Display(A, Teletype); end Handle; procedure Handle(MA: in out Medium_Alert) is begin Handle(Alert(MA)); -- handle as plain alert MA.Action_Officer := Assign_Volunteer; Display(MA, Console); end Handle; procedure Handle(HA: in out High_Alert) is begin Handle(Medium_Alert(HA)); -- conversion Display(HA, Big_Screen); Set_Alarm(HA); end Handle; procedure Display(A: in Alert; On: in Device) is separate; procedure Log(A: in Alert) is separate; procedure Set_Alarm(HA: in High_Alert) is separate; end New_Alert_System;
with New_Alert_System; package Emergency_Alert_System is type Emergency_Alert is new New_Alert_System.Alert with private; procedure Handle(EA: in out Emergency_Alert); procedure Display(EA: in Emergency_Alert; On: in New_Alert_System.Device); procedure Log(EA: in Emergency_Alert); private ... end Emergency_Alert_System;
The facilities we have seen so far have allowed us to define a new type as an extension of an existing one. We have introduced the different kinds of alerts as distinct but related types. What we also need is a means to manipulate any kind of alert and to process it accordingly. We do this through the introduction of the notion of class-wide types.
Alert | | +-------------------+--------------------+ | | | Low_Alert | Emergency_Alert | | Medium_Alert | | | High_Alert Figure 2-1: A Tree of Types
A value of any of the alert types can be implicitly converted to Alert'Class. Note carefully that Medium_Alert'Class is not the same as Alert'Class; the former consists just of Medium_Alert and High_Alert.
procedure Process_Alerts(AC: in out Alert'Class) is ... begin ... Handle(AC); -- dispatch according to tag ... end Process_Alerts;
and the central routine could manipulate the alerts directly from such a queue
procedure Process_Alerts is Next_Alert: Alert_Ptr; begin ... Next_Alert := -- get next alert ... Handle(Next_Alert.all); -- dispatch to appropriate Handle ... end Process_Alerts;
The final topic to be introduced in this brief introduction to the Object Oriented features of Ada 95 is the concept of abstract tagged types and abstract subprograms. These are marked as abstract in their declaration. The purpose of an abstract type is to provide a common foundation upon which useful types can be built by derivation. An abstract subprogram is a sort of place holder for an operation to be provided (it does not have a body).
package Base_Alert_System is type Alert is abstract tagged null record; procedure Handle(A: in out Alert) is abstract; end Base_Alert_System;
in which we declare the type Alert as a tagged null record with just the procedure Handle as an abstract subprogram; this does not have a body. (Note the abbreviated form for a null record declaration which saves us having to write record null; end record;)
with Calendar; with Base_Alert_System; package Normal_Alert_System is type Device is (Teletype, Console, Big_Screen); type Low_Alert is new Base_Alert_System.Alert with record Time_Of_Arrival: Calendar.Time; Message: Text; end record; -- now provide actual subprogram for abstract one procedure Handle(LA: in out Low_Alert); procedure Display(LA: in Low_Alert; On: in Device); procedure Log(LA: in Low_Alert); type Medium_Alert is new Low_Alert with record Action_Officer: Person; end record; procedure Handle(MA: in out Medium_Alert); type High_Alert is new Medium_Alert with record Ring_Alarm_At: Calendar.Time; end record; procedure Handle(HA: in out High_Alert); procedure Set_Alarm(HA: in High_Alert); end Normal_Alert_System;
procedure Handle(LA: in out Low_Alert) is begin LA.Time_Of_Arrival := Calendar.Clock; Log(LA); Display(LA, Teletype); end Handle; procedure Handle(MA: in out Medium_Alert) is begin Handle(Low_Alert(MA)); -- handle as low alert MA.Action_Officer := Assign_Volunteer; Display(MA, Console); end Handle;
The key points we have seen are as follows.
In the previous section we mentioned late binding; this simply means that the procedure to be called is identified late in the compile-link-run process. All procedure calls were bound early in Ada 83 and this was one reason why the language felt so static; even the generic mechanism only deferred binding to instantiation which is still essentially a compile time process.
type Trig_Function is access function(F: Float) return Float; T: Trig_Function; X, Theta: Float;
and T can then "point to" functions such as Sin, Cos and Tan. We can then assign an appropriate access-to-subprogram value to T by for example
and later indirectly call the subprogram currently referred to by T as expected
which is really an abbreviation for
type Integrand is access function(X: Float) return Float; function Integrate(F: Integrand; From, To: Float; Accuracy: Float := 1.0E-7) return Float;
and we might then write
which will compute the area under the curve for log(x) from 1.0 to 2.0. Within the body of the function Integrate there will be calls of the actual subprogram passed as a parameter; this is a simple form of call-back.
type Action is access procedure; Action_Sequence: array(1 .. N) of Action; ... -- build the array -- and then obey it for I in Action_Sequence'Range loop Action_Sequence(I).all; end loop;
package Push_Buttons is type Button is private; type Button_Response is access procedure(B: in out Button); function Create(...) return Button; procedure Push(B: in out Button); procedure Set_Response(B: in out Button; R: in Button_Response); procedure Default_Response(B: in out Button); ... private type Button is record Response: Button_Response := Default_Response'Access; ... -- other aspects of the button end record; end Push_Buttons;
A button is represented as a private record containing a number of components describing properties of the button (position on screen for example). One component is an access to a procedure which is the action to be executed when the button is pushed. Note carefully that the button value is passed to this procedure as a parameter so that the procedure can obtain access to the other components of the record describing the button. The procedure Create fills in these other components and other functions (not shown) provide access to them. The procedure Push invokes the action of clicking the mouse and an appropriate default procedure is provided which warns the user if the button has not been set. The body might be as follows
package body Push_Buttons is procedure Push(B: in out Button) is begin B.Response(B); -- indirect call end Push; procedure Set_Response(B: in out Button; R: in Button_Response) is begin B.Response := R; -- set procedure value in record end Set_Response; procedure Default_Response(B: in out Button) is begin Put("Button not set"); Monitor.Beep; end Default_Response; ... end Push_Buttons;
Big_Red_Button: Button; procedure Emergency(B: in out Button) is begin -- call fire brigade etc end Emergency; ... Set_Response(Big_Red_Button, Emergency'Access); ... Push(Big_Red_Button);
We have just seen how access types in Ada 95 have been extended to provide a means of manipulating subprogram values. Access types have also been extended to provide more flexible access to objects.
and we can then assign the "address" of any variable of type Integer to a variable of type Int_Ptr provided that the designated variable is marked as aliased. So we can write
and we can then read and update the variable I through the access variable IP. Note once more the use of 'Access. Note also that aliased is another new reserved word.
CIP := I'Access; -- access to a variable, or
CIP := C'Access; -- access to a constant
type Ref_Count is access constant Integer range 0 .. 1; type Ref_Count_Array is array (Integer range <>) of Ref_Count; type Cell is record Life_Count: aliased Integer range 0 .. 1; Total_Neighbor_Count: Integer range 0 .. 8; Neighbor_Count: Ref_Count_Array(1 .. 8); ... end record;
and then the heart of the computation which computes the sum of the life counts in the neighbors might be
C.Total_Neighbor_Count := 0; for I in C.Neighbor_Count'Range loop C.Total_Neighbor_Count := C.Total_Neighbor_Count + C.Neighbor_Count(I).all; end loop;
One of the great strengths of Ada is the library package where the distinct specification and body decouple the user interface to a package (the specification) from its implementation (the body). This enables the details of the implementation and the clients to be recompiled separately without interference provided the specification remains stable.
package Complex_Numbers is type Complex is private; function "+" (Left, Right: Complex) return Complex; ... -- similarly "-", "*" and "/" function Cartesian_To_Complex(Real, Imag: Float) return Complex; function Real_Part(X: Complex) return Float; function Imag_Part(X: Complex) return Float; private ... end Complex_Numbers;
package Complex_Numbers.Polar is function Polar_To_Complex(R, Theta: Float) return Complex; function "abs" (Right: Complex) return Float; function Arg(X: Complex) return Float; end Complex_Numbers.Polar;
and within the body of this package we can access the private type Complex itself.
package body Complex_Numbers.Polar is -- bodies of Polar_To_Complex etc end Complex_Numbers.Polar;
with Complex_Numbers.Polar; package Client is ...
and then within Client we can access the various subprograms in the usual way by writing Complex_Numbers.Real_Part or Complex_Numbers.Polar.Arg and so on.
now allows us to refer to the subprograms as Real_Part and Polar.Arg respectively.
and we would then be able to refer to the subprogram Polar.Arg as just Arg.
package XTK is type Widget is tagged private; type Widget_Access is access Widget'Class; ... private type Widget is tagged record Parent: Widget_Access; ... end record; end XTK; -- now extend the Widget package XTK.Color is type Colored_Widget is new Widget with private; ... private type Colored_Widget is new Widget with record Color: ... end record; end XTK.Color;
package New_Alert_System.Emergency is type Emergency_Alert is new Alert with private; ... end New_Alert_System.Emergency;
In the previous section we introduced the concept of hierarchical child packages and showed how these allowed extension and continued privacy of private types without recompilation. However, the whole idea was based on the provision of additional facilities for the client. The specifications of the additional packages were all visible to the client.
package OS is -- parent package defines types used throughout the system type File_Descriptor is private; ... private type File_Descriptor is new Integer; end OS; package OS.Exceptions is -- exceptions used throughout the system File_Descriptor_Error, File_Name_Error, Permission_Error: exception; end OS.Exceptions; with OS.Exceptions; package OS.File_Manager is type File_Mode is (Read_Only, Write_Only, Read_Write); function Open(File_Name: String; Mode: File_Mode) return File_Descriptor; procedure Close(File: in File_Descriptor); ... end OS.File_Manager; procedure OS.Interpret(Command: String); private package OS.Internals is ... end OS.Internals; private package OS.Internals_Debug is ... end OS.Internals_Debug;
generic type Float_Type is digits <>; package Complex_Numbers is ... end Complex_Numbers; generic package Complex_Numbers.Polar is ... end Complex_Numbers.Polar;
and then the instantiations might be
with Complex_Numbers; package Real_Complex_Numbers is new Complex_Numbers(Real); with Complex_Numbers.Polar; package Real_Complex_Numbers.Real_Polar is new Real_Complex_Numbers.Polar;
The rendezvous model of Ada 83 provided an advanced high level approach to task synchronization which avoided the methodological difficulties encountered by the use of low-level primitives such as semaphores and signals. As is well-known, such low-level primitives suffer from similar problems as gotos; it is obvious what they do and they are trivial to implement but in practice easy to misuse and can lead to programs which are difficult to maintain.
protected Variable is function Read return Item; procedure Write(New_Value: Item); private Data: Item; end Variable; protected body Variable is function Read return Item is begin return Data; end Read; procedure Write(New_Value: Item) is begin Data := New_Value; end Write; end Variable;
X := Variable.Read; ... Variable.Write(New_Value => Y);
protected type Bounded_Buffer is entry Put(X: in Item); entry Get(X: out Item); private A: Item_Array(1 .. Max); I, J: Integer range 1 .. Max := 1; Count: Integer range 0 .. Max := 0; end Bounded_Buffer; protected body Bounded_Buffer is entry Put(X: in Item) when Count < Max is begin A(I) := X; I := I mod Max + 1; Count := Count + 1; end Put; entry Get(X: out Item) when Count > 0 is begin X := A(J); J := J mod Max + 1; Count := Count - 1; end Get; end Bounded_Buffer;
protected type Counting_Semaphore(Start_Count: Integer := 1) is entry Secure; procedure Release; function Count return Integer; private Current_Count: Integer := Start_Count; end Counting_Semaphore; protected body Counting_Semaphore is entry Secure when Current_Count > 0 is begin Current_Count := Current_Count - 1; end Secure; procedure Release is begin Current_Count := Current_Count + 1; end Release; function Count return Integer is begin return Current_Count; end Count; end Counting_Semaphore;
protected Event is entry Wait; entry Signal; private entry Reset; Occurred: Boolean := False; end Event; protected body Event is entry Wait when Occurred is begin null; -- note null body end Wait; entry Signal when True is -- barrier is always true begin if Wait'Count > 0 then Occurred := True; requeue Reset; end if; end Signal; entry Reset when Wait'Count = 0 is begin Occurred := False; end Reset; end Event;
Tasks indicate that they wish to wait for the event by the call
and the happening of the event is notified by some task calling
whereupon all the waiting tasks are allowed to proceed and the event is reset so that future calls of Wait work properly.
A criticism of Ada 83 has been that its scheduling rules are unsatisfactory especially with regard to the rendezvous. First-in-first-out queuing on entries and the arbitrary selection from several open alternatives in a select statement lead to conflict with the normal preemptive priority rules. For example, priority inversion occurs when a high priority task is on an entry queue behind a lower priority task.
which is intended to stop the task until the time given by the variable Next_Time, is not foolproof. The problem is that there is a race condition. Between calling the function Clock and issuing the delay statement, it is possible for the task to be preempted by a higher priority task. The result is that when the delay is finally issued, the Duration value will be inappropriate and the task will be delayed for too long.
and all will be well.
select delay 5.0; -- triggering alternative Put_Line("Calculation did not complete"); then abort Invert_Giant_Matrix(M); -- abortable part end select;
The generic facility in Ada 83 has proved very useful for developing reusable software particularly with regard to its type parameterization capability. However, there were a few anomalies which have been rectified in Ada 95. In addition a number of further parameter models have been added to match the object oriented facilities.
generic type T is private; package P is ... package body P is X: T; ...
then in Ada 83 we could instantiate this with a type such as Integer which was fine. However we could also supply an unconstrained type such as String and this failed because when we came to declare the object T we found that there were no constraints and we could not declare an object as an unconstrained array. The problem was that the error was not detected through a mismatch in the instantiation mechanism but as an error in the body itself. But the whole essence of the contract model is that if the actual parameter satisfies the requirements of the formal then any body which matches the formal specification will work. The poor user might not have had access to the source of the body but nevertheless found errors reported in it despite the instantiation apparently working.
generic type T(<>) is private; package P ...
requires that the actual type be tagged.
generic type Float_Type is digits <>; package Generic_Complex_Numbers is type Complex is private; function "+" (Left, Right: Complex) return Complex; function "-" (Left, Right: Complex) return Complex; -- etc end Generic_Complex_Numbers; generic type Float_Type is digits <>; type Complex is private; with function "+" (Left, Right: Complex) return Complex is <>; with function "-" (Left, Right: Complex) return Complex is <>; -- and so on package Generic_Complex_Vectors is -- types and operations on vectors end Generic_Complex_Vectors;
and we can then instantiate these two packages by for example
package Long_Complex is new Generic_Complex_Numbers(Long_Float); use Long_Complex; package Long_Complex_Vectors is new Generic_Complex_Vectors(Long_Float, Complex);
and then the actual parameter corresponding to P must be any package which has been obtained by instantiating Q which must itself be a generic package.
with Generic_Complex_Numbers; generic with package Complex_Numbers is new Generic_Complex_Numbers (<>); package Generic_Complex_Vectors is -- as before end Generic_Complex_Vectors;
where the actual package must be any instantiation of Generic_Complex_Numbers. Hence our previous instantiations can now be simplified and we can write
package Long_Complex is new Generic_Complex_Numbers(Long_Float); package Long_Complex_Vectors is new Generic_Complex_Vectors(Long_Complex);
We have now covered most of the major improvements which give Ada 95 so much extra power over Ada 83. But the discussion has not been complete; we have omitted important facilities such as the introduction of controlled types giving initialization, finalization and user defined assignment and the use of access discriminants to give the functionality of multiple inheritance.
and any constraints imposed by the actual parameter will not then apply to the working variable Local. This is important for certain numeric algorithms where we wish to be unconstrained in intermediate computations.
was not allowed in Ada 83. It is allowed in Ada 95.
and then within our package we can use the operators belonging to the type Complex in infix notation. Other identifiers in Complex_Numbers will still have to use the full dotted notation so we can see from which package they come. Predefined operators such as "=" are also made directly visible by an appropriate use type clause.
which avoids having to write the tedious
package P is type T is private; private type T(N: Natural := 1) is ... end P;
when Event: others => Put_Line("Unexpected exception: " & Exception_Name(Event));
where the function Exception_Name returns the name of the exception as a string (such as "Constraint_Error"). Other functions provide further useful diagnostic information regarding the cause of the exception.
There are many additional predefined packages in the standard library which has been restructured in order to take advantage of the facilities offered by the hierarchical library. As mentioned above, root library packages behave as children of Standard. There are just three such predefined child packages of Standard, namely System, Interfaces and Ada and these in turn have a number of child packages. Those of System are concerned with intrinsic language capability such as the control of storage. Those of Interfaces concern the interfaces to other languages. The remaining more general predefined packages are children of the package Ada.
package Ada is pragma Pure(Ada); -- as white as driven snow! end Ada;
where the pragma indicates that Ada has no variable state; (this concept is important for sharing in distributed systems).
package Ada.Numerics is pragma Pure(Numerics); Argument_Error: exception; Pi: constant := 3.14159_26535_ ... ; e: constant := 2.71828_18284_ ... ; end Ada.Numerics;
and includes the generic child package Ada.Numerics.Generic_Elementary_Functions which is similar to the corresponding standard ISO/IEC 11430:1994 for Ada 83 [ISO 94a]. There are also nongeneric versions such as Ada.Numerics.Elementary_Functions for the predefined types Float and so on. Facilities for manipulating complex types and complex elementary functions are provided by other child packages defined in the Numerics annex.