This summary was extracted from ANSI/ISO-IEC 8652:1995, unofficially refered to as the Ada Language Reference Manual. It is not intended to be 100% complete. Hopefully it will be useful as a memory aid in writing Ada programs.
Notation is kept as simple as possible.
-- DECLARATIONS means Ada declaration(s) can be inserted
\_ optional means this part or section is optional
/ ( all optional cases not necessarily shown)
... means more of the same allowed, use common sense
occasionally a statement will be shown in a structure,
this is just a reminder of something useful or required.
Comments in the language and this summary start with -- , two consecutive
minus signs. The rest of the line is a comment.
The end of a line is interpreted as a white space just like a space or tab.
The language is free form but is typically entered using indentation.
Reserved words will always be lower case.
Names that can be chosen by the programmer usually have a leading
upper case letter or may be all lower case letters. Names are
usually made descriptive and words in names are separated by
the underscore character, "_". White space is not allowed in names.
Compilation units are the structures that can be
compiled in a single compilation. Keep in mind that Ada
allows virtually unlimited nesting. Almost any structure
can be nested in almost any other structure. Every compilation
unit can be preceded by pragmas and context clauses.
procedure Name is -- structure of a main procedure (program)
-- DECLARATIONS
begin
-- EXECUTABLE STATEMENTS
return ; -- allowed, but not usually present
exception \_ optional
-- EXCEPTION HANDLERS /
end Name ;
procedure Name ( PARAMETER : in out TYPE ; ... ) is
-- DECLARATIONS
begin
-- EXECUTABLE STATEMENTS
return ; -- allowed
exception \_ optional
-- EXCEPTION HANDLERS /
end Name ;
function NAME ( PARAMETER : TYPEx ; ...) return TYPEy is
-- DECLARATIONS
begin
-- EXECUTABLE STATEMENTS
return OBJECT ; -- of TYPEy required
exception \_ optional
-- EXCEPTION HANDLERS /
end NAME ;
package NAME is
-- DECLARATIONS
private \_ optional
-- MORE DECLARATIONS /
end NAME ;
package body NAME is
-- DECLARATIONS _
begin \
-- EXECUTABLE STATEMENTS \_ optional
exceptions /
-- EXCEPTION HANDLERS _/
end NAME ;
package MY_NAME is
-- DECLARATIONS
procedure PROC ;
function FUNCT(PARAMETER:TYPEx;...) return TYPEy ;
end MY_NAME ;
package body MY_NAME is
-- DECLARATIONS
procedure PROC is
-- PROCEDURE STUFF
end PROC ;
function FUNCT(PARAMETER:TYPEx;...) return TYPEy is
-- FUNCTION STUFF
end FUNCT ;
end MY_NAME ;
package P_NAME is
task NAME is
--DECLARATIONS
entry LIKE_PROC(PARAMETER:TYPE;...) ;
...
end NAME ;
end P_NAME ;
package body P_NAME is
task body NAME is -- task body parallels package body
-- DECLARATIONS
begin
-- EXECUTABLE STATEMENTS
accept LIKE_PROC(PARAMETER:TYPE;...) do
-- EXECUTABLE STATEMENTS
end LIKE_PROC ;
-- EXECUTABLE STATEMENTS
...
exception \_ optional
-- EXCEPTION HANDLERS /
end NAME ;
end P_NAME ;
package body P_NAME is -- A more complicated body
task body NAME is
-- DECLARATIONS
begin
loop
select
accept LIKE_PROC(PARAMETER:TYPE;...) do
-- EXECUTABLE STATEMENTS
end LIKE_PROC ;
or
accept ...
end ...
end select ;
end loop ;
end NAME ;
end P_NAME ;
separate ( SOME_PACKAGE )
procedure SOME_PROCEDURE is
-- DECLARATIONS
begin
-- EXECUTABLE STATEMENTS
exception \_ optional
-- EXCEPTION HANDLERS /
end SOME_PROCEDURE ;
separate ( SOME_PACKAGE )
function SOME_FUNCTION return CHARACTER is
-- DECLARATIONS
begin
-- EXECUTABLE STATEMENTS
exception \_ optional
-- EXCEPTION HANDLERS /
end SOME_FUNCTION ;
separate ( SOME_PACKAGE )
task body SOME_TASK is
-- DECLARATIONS
begin
-- EXECUTABLE STATEMENTS
exception \_ optional
-- EXCEPTION HANDLERS /
end SOME_TASK ;
separate ( SOME_PACKAGE )
package body SOME_BODY is
-- DECLARATIONS
begin
-- EXECUTABLE STATEMENTS
exception \_ optional
-- EXCEPTION HANDLERS /
end SOME_BODY ;
separate( SOME_PACKAGE.SOME_BODY )
package body SUB_SUB_UNIT is
-- DECLARATIONS
begin
-- EXECUTABLE STATEMENTS
exception \_ optional
-- EXCEPTION HANDLERS /
end SOME_BODY ;
generic
-- FORMAL GENERIC PARAMETERS
procedure GENERIC_PROCEDURE is
-- DECLARATIONS
begin
-- EXECUTABLE STATEMENTS
exception \_ optional
-- EXCEPTION HANDLERS /
end GENERIC_PROCEDURE ;
generic
-- FORMAL GENERIC PARAMETERS
function GENERIC_FUNCTION is
-- DECLARATIONS
begin
-- EXECUTABLE STATEMENTS
exception \_ optional
-- EXCEPTION HANDLERS /
end GENERIC_FUNCTION ;
generic
-- FORMAL GENERIC PARAMETERS
package GENERIC_PACKAGE is
-- DECLARATIONS
private \_ optional
-- PRIVATE DECLARATIONS /
end GENERIC_PACKAGE ;
with GENERIC_PROCEDURE ;
procedure ACTUAL_PROCEDURE is new GENERIC_PROCEDURE ( TYPES ) ;
with GENERIC_FUNCTION ;
function ACTUAL_FUNCTION is new GENERIC_FUNCTION ( TYPES ) ;
with GENERIC_PACKAGE ;
package ACTUAL_PACKAGE is new GENERIC_PACKAGE ( TYPES ) ;
procedure JUST_SPECIFICATION ;
procedure SPECIFICATION ( Parameters... ) ;
function SPECIFICATION ( Parameters ... ) return TYPEy ;
a context clause precedes the first statement of a compilation unit. Any number of the following can be a context clause. with Library_Unit_Name ; -- this library unit can be referenced in this compilation unit with Name_1 , Name_2, ... ; -- "with" can take a list of compilation unit names with Name_1 ; use Name_1 ; -- Typical, a single "with" and associated "use" use Name_1 , Name_2, ... ; -- all "use" statement can follow all "with"
Any of the following may be used for EXECUTABLE STATEMENTS,
either singly or in groups or nested.
A := EXPRESSION ;
declare \_ optional
-- DECLARATIONS /
begin
-- EXECUTABLE STATEMENTS
return ; -- allowed, not typically used
exception \_ optional
-- EXCEPTION HANDLERS /
end ;
Loop_Name : -- optional name
loop
-- EXECUTABLE STATEMENTS
exit ; \
exit when A>B ; \_ optional in any loop
exit ANY_LOOP_NAME ; /
exit ANY_LOOP_NAME when A>B ; /
end loop Loop_Name ;
while A>B loop
-- EXECUTABLE STATEMENTS
end loop ;
for Variable in P..Q loop P <= Q for loop to be executed
-- EXECUTABLE STATEMENTS
end loop ;
for Variable in reverse P..Q loop -- still P <= Q
-- EXECUTABLE STATEMENTS
end loop ;
if BOOLEAN_EXPRESSION then
-- EXECUTABLE STATEMENTS
end if ;
if BOOLEAN_EXPRESSION then
-- EXECUTABLE STATEMENTS
elsif BOOLEAN_EXPRESSION2 then \_ optional
-- EXECUTABLE STATEMENTS /
...
else \_ optional
-- EXECUTABLE STATEMENTS /
end if ;
if BOOL_EXP1 and then BOOL_EXP2 ... then
-- EXECUTABLE STATEMENTS
elsif BOOL_EXP3 or else BOOL_EXP4 ... then
-- EXECUTABLE STATEMENTS
else
-- EXECUTABLE STATEMENTS
end if ;
case NAME is -- NAME is an object of a discrete type
when VALUE1 => -- VALUE's are legal for object NAME
-- EXECUTABLE STATEMENTS
when VALUE2 =>
-- EXECUTABLE STATEMENTS
when VALUE3 | VALUE5 | VALUE7 =>
-- EXECUTABLE STATEMENTS
when VALUE12 .. VALUE20 =>
-- EXECUTABLE STATEMENTS
...
when others => \_ optional
-- EXECUTABLE STATEMENTS /
end case ;
All of these must appear in a declarative region where the entity on the
right side of the renames declaration is visible.
The "existing" may be selected, e.g. SOME_PACKAGE.OBJECT_NAME_IN_PACKAGE
Renaming is sometimes used to allow a short name in a localized scope.
NEW_IDENTIFIER_NAME : SOME_TYPE_MARK renames EXISTING_OBJECT_NAME ;
NEW_EXCEPTION_NAME : exception renames EXISTING_EXCEPTION_NAME ;
package NEW_PACKAGE_NAME renames EXISTING_PACKAGE_NAME ;
procedure NEW_PROCEDURE_NAME ( formal ) renames EXISTING_PROCEDURE_NAME ;
procedure NEW_TASK_ENTRY_NAME ( formal ) renames EXISTING_TASK_ENTRY_NAME ;
function NEW_FUNCTION_NAME ( formal ) return TYPEX renames
EXISTING_FUNCTION_NAME ;
function NEW_ENUMERATION_LITERAL return EXISTING_ENUMERATION_TYPE renames
EXISTING_ENUMERATION_LITERAL ;
subtype NEW_TYPE_NAME is EXISTING_TYPE_NAME ; -- renaming a type
Note: The existing entity is still visible.
Either or both the new and existing function names may be quoted
operators, e.g. "+"
The ( formal ) can have different names for formal parameters but must
have the same number of parameters of the same type in the same order
as the existing entity.
Some restrictions apply.
Reserved words as the name implies are reserved for the language.
Reserved words must not be used as names of objects, types, procedures,
or anything else.
There are relatively few "reserved words" . But don't be complacent.
The next pages cover a lot of types, objects and other names that are
not technically reserved words but can create havoc if used in the
wrong place!
Some common pairs of reserved words are shown. Spaces are important in Ada.
Word use or some uses
____ ________________
abort Statement in a task, abort means kill the task
abs Function that returns absolute value
abstract Declare a type or subprogram to be abstract,
generic formal type abstract tagged limited private
accept Statement in a task, the executable entry point
access Used in defining access ( pointer ) types
aliased Declare a variable of an aliased type
all A selector. If XXX is an access variable then
XXX.all is the object pointed to
and Boolean binary operator
and then Conditional "short circuit"
array Used to define array types
at Used as part of representation specification
begin Always has pairing " end "
body Used in " package body " and " task body "
case Executable control structure and
in defining records
constant What follows can not be changed, attempt will cause error
declare Can precede " begin " in executable structure,
allows putting declarations in middle of executable code
delay Statement in tasking, allows other tasks to run, then
wakes up after delayed time has elapsed
delta Part of type declaration for fixed point
digits Part of type declaration for floating point
do Used in tasking " accept...do...end "
The FORTRAN " DO " is " for " in Ada
else Part of " if ... then ... else ... end if ; "
else Part of selective wait in tasks
else Part of conditional entry in tasks
elsif Watch the SPELLING! one word in Ada, means else if
end ; Ends a structure e.g. begin, procedure, package,
end USER_NAME ; task etc. Optional user name is allowed, thus must
always be followed by a semicolon
end case ; Ends " case " control structure
end loop ; Ends " loop " control structure
end if ; Ends " if " control structure
end record ; Ends definition of a record data structure
end select ; Ends " select " control structure in tasks
entry Task entry definition ( not procedure or function entry )
exception Statement in " begin ... exception ... end "
specifies a place to put executable code for exception
handlers
exception Used to define user created exceptions
exit Statement in a loop structure, 4 forms available
for Statement introducing one type of loop
for Used in type definitions
function Statement defining a function
generic Used in creating generic packages
goto One word! Use it sparingly, only when needed. There are
scope rules that apply
if Conditional statement
in Used in type definitions
in As in input parameter to a procedure
in Used with " for " in iteration such as
" for I in 1..N loop ... end loop "
in out As in both input and output parameter in a procedure
is Used in type,procedure,function, and package definitions
is new Used to get new type or generic instantiation
is access all Used as type Ptr is access all T; for aliased T's
limited Used with " private "
loop Executable structure, always closed by " end loop "
mod Binary modulo operator in expressions
mod (at mod) Rare usage in representation specifications
new (is new) Used in instantiation of generic packages
new Used to get more storage with " access " types
new (is new) Used to create new types
not Boolean unary operator
null ; The null statement, sometimes needed if code not finished
null Used in place of some values when needed but not known
of Used as part of a type definition, such as
" array(1..N) of INTEGER "
or Boolean binary operator
Statement in " select " tasking structure
or else Conditional expression " short circuit "
others Used where some cases are specified and all else
is lumped under others. Many forms
out As in output parameter of a procedure
package A container for declarations and code
package body A container that is used with a corresponding
package specification
pragma A directive to the compiler
private Statement between visible and private declarations
procedure First word of a procedure definition
protected Used on objects, subprograms, entries, types, bodies
declarations and units.
raise Statement to cause an exception to be raised
range Part of a type specification
record Start of a record data structure definition
rem Binary arithmetic operator, remainder after division
This is precisely defined in Ada
renames Used to help get around name hiding and to avoid
using selectors dot notation
requeue Used to requeue an entry
return Can be used in a procedure, not usually needed
return Value ; Must be used in a function for the returned value
reverse Used with " for " to get the loop to run backwards
select Statement in a task to control entry
separate Used for partial compilation, only needed in rare
cases. Separate compilation is normal with Ada and
usually does not need the reserved word " separate "
subtype Used in place of " type " when just constraining a type
tagged Created a record that is expandable, a tagged type
task Introduces a task definition
task type Introduces a task type definition
terminate Used on students that don't complete homework on time
and rarely needed in tasks
then Used in " if ... then ... else ..." structure
type Used to declare a user defined type
until Wait for a definition until ...
use Usually follows a " with "
Used in representation specification
when Statement in case and exception handlers
Usually of the form " when XXX => "
when others => Means else, e.g. all others
while Used to introduce a loop, user does initialization
and computing values that control the condition
with Makes a previously compiled package specification
available in this compilation
Usually " with XXX ; use XXX ; "
xor Boolean binary operator, exclusive or
The types defined in the package standard are always available ( unless
the user hides them by defining the same name ). Other types are listed
under the package that must be " withed " to make the types available.
The exact definition of some types is implementation defined. This means
the user may want to do some experiments when using a new Ada compiler.
type comment
____ _______
BOOLEAN objects of this type take values TRUE or FALSE
CHARACTER objects of this type are exactly one character. e.g. 'A'
DURATION this is a fixed point type used with the " delay "
statement in tasking and in the package CALENDAR
FLOAT objects of this type are represented by hardware
floating point numbers
INTEGER objects of this type are represented by hardware integers
the number of bits can vary. In some 16 bits while in
other compilers 32 or 64 bits.
NATURAL integer in range 0..INTEGER'LAST
POSITIVE integer in range 1..INTEGER'LAST
STRING objects of this type must be constrained by (1..N)
where N is a positive value. Watch out for null
filling, not blank filled. "this is a string literal"
strings are technically arrays of characters
optional types, may or may not be present
SHORT_SHORT_INTEGER -- in some compilers
SHORT_INTEGER
LONG_INTEGER -- in some compilers
SHORT_FLOAT -- in some compilers, 32 bit
LONG_FLOAT -- in most compilers, 64 bit
LONG_LONG_FLOAT -- in some compilers, 128 bit
from the package TEXT_IO
type comment
____ _______
COUNT e.g. page length, line length
FIELD e.g. width
FILE_MODE enumeration literal IN_FILE or OUT_FILE
FILE_TYPE e.g. type of file
NUMBER_BASE e.g. 2, 10, 16
POSITIVE_COUNT e.g. spacing amount
TYPE_SET enumeration literal LOWER_CASE or UPPER_CASE
from the package SYSTEM
type comment
____ _______
ADDRESS the type definition for address. not necessarily INTEGER
NAME enumeration type for target names
PRIORITY subtype of INTEGER for task priorities
from the package CALENDAR
type comment
____ _______
DAY_DURATION fixed point seconds in a day 0.0 .. 86_400.0
DAY_NUMBER days in month 1 .. 31
MONTH_NUMBER months in year 1 .. 12
TIME a private type ( usually a record ) holds date and time
YEAR_NUMBER year 1901 .. 2099
from the package UNCHECKED_DEALLOCATION
type comment
____ _______
OBJECT generic format parameter
NAME is access OBJECT pointer to what is deallocated
from the package UNCHECKED_CONVERSION
type comment
____ _______
SOURCE generic formal parameter
TARGET generic formal parameter
note: source object is usually required to be the same length
as the target object. This is implementation dependent.
This can be used to put a integer into a floating point
object or other similar atrocities.
The user may provide exception handlers for these exceptions but
should not declare local exceptions by these names. If the user
does not provide the exception handler, the Ada run time that " calls "
the main procedure will handle the exception. Usually with some message.
Only one or a few causes of each exception are listed.
CONSTRAINT_ERROR e.g. subscript out of range
PROGRAM_ERROR e.g. something illegal at run time
STORAGE_ERROR e.g. out of memory for this program
TASKING_ERROR e.g. calling a task that has terminated
An exception handler is of the form:
begin
...
exception
when NUMERIC_ERROR =>
... some executable code
end ;
from the package TEXT_IO
DATA_ERROR e.g. illegal data read by GET
DEVICE_ERROR e.g. input or output can not be completed
END_ERROR e.g. hit end of file
LAYOUT_ERROR e.g. bad line or page format. Too much of something
MODE_ERROR e.g. trying to write IN_FILE or read OUT_FILE
NAME_ERROR e.g. illegal file name
STATUS_ERROR e.g. trying to use unopened file
USE_ERROR e.g. improper use of a file
from package CALENDAR
TIME_ERROR e.g. not a legal date and/or time
Named numbers can be used any place a number of the corresponding type can be used. Named numbers are defined by the format " XXX : constant := ... ; " from the package SYSTEM FINE_DELTA -- smallest delta in fixed point range -1.0 .. 1.0 MAX_DIGITS -- largest number of digits in floating point constraint MAX_INT -- largest positive value of all integer types MAX_MANTISSA -- largest number of bits in fixed point model number MEMORY_SIZE -- number of storage units available somewhere MIN_INT -- most negative of all integer types STORAGE_UNIT -- number of bits in a storage unit SYSTEM_NAME -- the default target name TICK -- the basic clock period in seconds from the package TEXT_IO UNBOUNDED
See annex for definitions. CONTROLLED ELABORATE INLINE INTERFACE LIST MEMORY_SIZE OPTIMIZE PACK PAGE e.g. pragma PAGE ; PRIORITY e.g. pragma PRIORITY(5) ; SHARED STORAGE_UNIT SUPPRESS
Ada 95 Library Packages
Library Name and some renamed for compatibility with '83
Ada
Ada.Asynchronous_Task_Control
Ada.Calendar Calendar
Ada.Characters
Ada.Characters.Handling
Ada.Characters.Latin_1
Ada.Command_Line
Ada.Decimal
Ada.Direct_IO Direct_IO
Ada.Dynamic_Priorities
Ada.Exceptions
Ada.Finalization
Ada.Interrupts
Ada.Interrupts.Names
Ada.IO_Exceptions IO_Exceptions
Ada.Numerics
Ada.Numerics.Complex_Elementary_Functions
Ada.Numerics.Complex_Types
Ada.Numerics.Discrete_Random
Ada.Numerics.Elementary_Functions
Ada.Numerics.Float_Random
Ada.Numerics.Generic_Complex_Elementary_Functions
Ada.Numerics.Generic_Complex_Types
Ada.Numerics.Generic_Elementary_Functions
Ada.Numerics.Random_Numbers
Ada.Real_Time
Ada.Sequential_IO Sequential_IO
Ada.Storage_IO
Ada.Streams
Ada.Streams.Stream_IO
Ada.Strings
Ada.Strings.Bounded
Ada.Strings.Fixed
Ada.Strings.Maps
Ada.Strings.Maps.Constants
Ada.Strings.Unbounded
Ada.Strings.Wide_Bounded
Ada.Strings.Wide_Fixed
Ada.Strings.Wide_Maps
Ada.Strings.Wide_Maps.Wide_Constants
Ada.Strings.Wide_Unbounded
Ada.Synchronous_Task_Control
Ada.Tags
Ada.Task_Attributes
Ada.Task_Identification
Ada.Text_IO Text_IO
Integer_IO
Modular_IO
Float_IO
Fixed_IO
Decimal_IO
Enumeration_IO
Ada.Text_IO.Complex_IO
Ada.Text_IO.Editing
Ada.Text_IO.Text_Strings
Ada.Unchecked_Conversion Unchecked_Conversion
Ada.Unchecked_Deallocation Unchecked_Deallocation
Ada.Wide_Text_IO
Integer_IO
Modular_IO
Float_IO
Fixed_IO
Decimal_IO
Enumeration_IO
Ada.Wide_Text_IO.Complex_IO
Ada.Wide_Text_IO.Editing
Ada.Wide_Text_IO.Text_Strings
Interfaces
Interfaces.C
Interfaces.C.Pointers
Interfaces.C.Strings
Interfaces.COBOL
Interfaces.Fortran
System
System.Address_To_Access_Conversion
System.Machine_Code Machine_code
System.RPC
System.Storage_Elements
System.Storage_Pools
Note: most packages contain procedures and functions as well as
type and object definitions.
It is possible that the following chart will help clarify the terminology
related to Ada types. This is a chart showing classes of types.
|-- private [limited] [aliased]
|
type ---|
|-- composite --|-- record --|-- tagged ----|-- Users
| | |
| | |-- untagged --|-- Users
| |
| |-- array ---|-- constrained ----|-- Users
| | |
| | |-- unconstrained --|-- String
| | |-- Users
| |
| |-- task
| |-- tagged
| |-- protected
|
|
|-- scalar --|-- real --|-- floating --|-- Float
| | | |-- Users
| | |
| | |-- fixed -----|-- Duration
| | |-- Users binary
| | |-- Users decimal
| |
| |
| | |-- modular --|-- Users
| |-- discrete --|-- integer --|
| | |
| | |-- signed --|-- Integer
| | |-- Positive
| | |-- Natural
| | |-- Users
| |
| |- enumeration -|-- Character
| |-- Boolean
| |-- Users
|
|-- access --|-- access-to-object
|-- access-to-subprogram
The classes "real" and "integer" together form the class numeric types.
There is a long list of attributes defined in ISO 8652:1995 in Annex K
|-- null
|-- assignment
|-- procedure call
|-- sequential --|-- entry call
| |-- code
| |-- delay
| |-- abort
| |-- requeue
|
|-- simple ----|
| |
| | |-- exit
| |-- control -----|-- goto
| |-- raise
| |-- return
|
statement --|
|
| |-- if
| |-- case
| |-- sequential --|-- loop
| | |-- block
|-- compound --|
| |-- accept
|-- parallel ----|-- entry
|-- select
( Remember : types do not take up space in storage
types just define structures )
type of type
task type MINE ; -- task
type FOR_ME_ONLY is private ; -- private
type FOR_YOU_ONLY is limited private ; -- limited
type NODE ; -- define structure later
type LINK is access NODE ; -- LINK is an access type to NODE -- access
-- Composite
type NODE is -- record
record
X : INTEGER ;
Y : FLOAT ;
Z : STRING(1..10) ;
L : LINK ;
end record ;
type MY_ARRAY is array(0..5) of integer ; -- array
type COMPLEX_MATRIX is
array( INTEGER range <> , INTEGER range <> ) of complex ;
-- Scalar
-- Real
type HIS_FLOAT is new FLOAT ; -- floating
type HER_FLOAT is digits 6 range -3.0..1.1E30 ; -- floating
type OUR_FLOAT is digits 5 ; -- floating
type MY_FIXED is delta 0.001 range -0.5 .. 0.5 ; -- fixed
-- Discrete
type HIS_INTEGER is new INTEGER ; -- integer
type HER_INTEGER is range -7 .. 35 ; -- integer
type STATUS is ( ON , OFF , STAND_BY , READY ) ; -- enumeration
( Remember: objects take up storage and can have values
the object name is first, followed by a colon,
followed by the type name )
MY_FIRST : MINE ; -- a task object
MY_SECOND : MINE ; -- another task object
SOMETHING : FOR_ME_ONLY ; -- don't know structure
SOMETHING_ELSE : FOR_YOU_ONLY ; -- know even less
START : LINK ;
BOX_1 : NODE ;
BOX_2 : NODE ;
A : MY_ARRAY ;
C : COMPLEX_MATRIX(0..4,-2..21) ;
TARGET_X : HIS_FLOAT ;
TARGET_Y : HER_FLOAT ;
TARGET_Z : OUR_FLOAT ;
TARGET_RANGE : MY_FIXED ;
MY_RANGE : MY_FIXED ;
SCRATCH : HIS_INTEGER ;
TEMPORARY : HER_INTEGER ;
RECEIVE : STATUS ;
TRANSMIT : STATUS ;
Records with discriminants and variant parts
type MY_RECORD ( DISCRIM_1 : INTEGER := 3 ;
DISCRIM_2 : BOOLEAN := FALSE ) is
record
STUFF : INTEGER := DISCRIM_1 ;
WHICH : BOOLEAN := DISCRIM_2 ;
OTHER : FLOAT := 7.5 ;
end record ;
A_RECORD : MY_RECORD ( 7, TRUE ) ;
B_RECORD : MY_RECORD ;
type SHAPE is ( CIRCLE , TRIANGLE ) ;
type FIGURE ( WHICH : SHAPE ) is
record
case WHICH is
when CIRCLE =>
RADIUS : POSITIVE ;
when TRIANGLE =>
SIDE_1 : POSITIVE ;
SIDE_2 : POSITIVE ;
SIDE_3 : POSITIVE ;
when others =>
end case ;
end record ;
ROUND : FIGURE ( CIRCLE ) := ( CIRCLE, 7 ) ;
POINTED : FIGURE ( TRIANGLE ) := ( TRIANGLE , 4, 5, 7 ) ;
LONG : FIGURE ( WHICH => CIRCLE ) :=
( WHICH => CIRCLE ,
RADIUS => 9 ) ;
Control of tasks can be very complicated. The language provides
several structures for various cases. The skeletons below may be used
inside the task body after the task begin. For simplicity the "entry"
and "accept" are shown without the optional parameters.
package XXX is
task YYY is -- or task type YYY is
entry ZZZ ... ;
end YYY ;
end XXX ;
package body XXX is
task body YYY is
-- optional declarations
begin
*** STRUCTURES BELOW GO HERE ***
end YYY ;
end XXX ;
The user of a task then writes:
with XXX;
...
XXX.YYY.ZZZ ...; -- the user waits here til ZZZ rendezvous
1. A simple accept, one shot only then task terminates
accept ZZZ do accept ZZZ ;
-- statements -- statements
end ZZZ ;
-- statements
2. A simple accept, can be used many times, exists until sponsor dies
loop loop
accept ZZZ do accept ZZZ ;
-- statements -- statements
end ZZZ ;
-- statements
end loop ; end loop ;
3. A pair of entries that must go 1,2,1,2,1,2...
loop
accept ZZ1 do
-- statements
end ZZ1 ;
-- statements
accept ZZ2 do
-- statements
end ZZ2 ;
-- statements
end loop ;
4. A pair of entries that can be used in any order, may live forever
loop
select
accept ZZ1 do
-- statements
end ZZ1 ;
-- statements
or
accept ZZ2 do
-- statements
end ZZ2 ;
-- statements
end select ;
end loop ;
5. A pair of entries that can be used in any order, the task XXX
terminates when there is no possible callers for ZZ1 or ZZ2.
loop
select
accept ZZ1 do
-- statements
end ZZ1 ;
-- statements
or
accept ZZ2 do
-- statements
end ZZ2 ;
-- statements
or
terminate ;
end select ;
end loop ;
6. A pair of entries that can be used in any order, each time
through the loop, if neither ZZ1 nor ZZ2 has a caller waiting
the statements in the "else" part are executed. Watch out!
You have no control over the loop timing or the context switching
algorithm.
loop
select
accept ZZ1 do
-- statements
end ZZ1 ;
-- statements
or
accept ZZ2 do
-- statements
end ZZ2 ;
-- statements
else
-- statements
end select ;
end loop ;
7. A pair of entries that can be used in any order, If there are
no callers for ZZ1 or ZZ2 control goes to some other task.
After a delay of at least T seconds, this task comes around the
loop again.
loop
select
accept ZZ1 do
-- statements
end ZZ1 ;
-- statements
or
accept ZZ2 do
-- statements
end ZZ2 ;
-- statements
or
delay T ;
end select ;
end loop ;
8. Guards may be used inside the "select" structure on the "accept",
"terminate" and "delay", but not on the "else". Just one of the
cases from 5,6 or 7 may be used in any given structure. Guards
are of the form :
when BOOLEAN_EXPRESSION =>
If the BOOLEAN_EXPRESSION is true the normal action is taken. If false
it is as though the structure following the guard did not exists.
The three cases below use the "no rendezvous" form of the "accept" just
for brevity.
8a select
when BOOL1 =>
accept ZZ1 ;
-- statements
or
when BOOL2 =>
accept ZZ2 ;
-- statements
or
when BOOL3 =>
terminate ;
end select ;
8b select
when BOOL1 =>
accept ZZ1 ;
-- statements
or
when BOOL2 =>
accept ZZ2 ;
-- statements
or
when BOOL3 =>
delay T ;
end select ;
8c no guard is allowed after "else" in select
9. The following constructs can be used anywhere, not just in task bodies
delay number_of_seconds;
delay until value_of_type_time;
9.7.2 Timed Entry Call
select
some_task.some_entry; -- canceled if no rendezvous in 2.5 seconds
or
delay 2.5;
end select;
9.7.3 Conditional Entry call
select
some_task.some_entry; -- if no immediate rendezvous, do else part
else
-- EXECUTABLE STATEMENTS
end select;
9.7.4 Asynchronous Transfer of Control
select
some_task.some_entry; -- only run if lower part does not finish
-- EXECUTABLE STATEMENTS -- before rendezvous
then abort
-- EXECUTABLE STATEMENTS will run till rendezvous of above
end select;
select
delay 7.2;
-- EXECUTABLE STATEMENTS -- only run if lower part takes 7.2+ seconds
then abort
-- EXECUTABLE STATEMENTS -- killed after 7.2 seconds
end select;
10. To have a procedure PERIODIC called approximately every 1 second
and desiring no overall slippage over long time intervals, the
following task can be set up. Just for variety, the task is
defined in a procedure rather than in a package.
with Ada.Calendar ; use Ada.Calendar ;
procedure TEST is
task GO_PERIOD ; -- task specification
task body GO_PERIOD is
INTERVAL : constant DURATION := 1.0 ; -- seconds
NEXT_TIME : TIME ;
begin
NEXT_TIME := CLOCK ; -- now
loop
delay until NEXT_TIME;
-- do this about once per second
NEXT_TIME := NEXT_TIME + INTERVAL ;
end loop ;
end GO_PERIOD ;
begin -- task started just before "do something"
-- do something
end TEST ;
This is "GENERIC" summary information extracted from ISO 8652:1995
Generic packages, procedures and functions
definition
instantiation
1. GENERIC LIBRARY UNITS
The three structures for a generic library unit are:
generic
-- *** generic formal part goes here (see below)
package NAME is
-- typical package specification
-- DO NOT duplicate declarations given above in generic formal part
end NAME ;
package body NAME is
-- typical package body
begin \__ optional
-- package initialization code /
exception \__ optional
-- exception handlers /
end NAME ; -- <-- NAME will be the library unit name "withed"
and instantiated
generic
-- *** generic formal part goes here (see below)
procedure NAME(...) ;
procedure NAME(...) is
-- typical procedure declarations
-- DO NOT duplicate declarations given above in generic formal part
begin
-- typical procedure code
exception \__ optional
-- exception handlers /
end NAME ; -- <-- NAME will be the procedure name "withed"
and instantiated
generic
-- *** generic formal part goes here (see below)
function NAME(...) return TYPEX ;
function NAME(...) return TYPEX is
-- typical function declarations
-- DO NOT duplicate declarations given above in generic formal part
begin
-- typical function code
exception \__ optional
-- exception handlers /
end NAME ; -- <-- NAME will be the function name "withed"
and instantiated
2. GENERIC FORMAL PART
Listed below are the statements that can occur in the generic formal part.
Note: Upon generic instantiation the things denoted FORMAL can
be supplied as 1) positional actual generic parameters 2) named actual
generic parameters, or 3) not supplied because a default is provided.
The same rules apply for parameters in generic instantiation as for
procedure calls. The positional order of generic parameters is determined
by the sequential order in which the things denoted FORMAL ( a type ) or
FORMAL_OBJECT ( an object ) or FORMAL_SUBPROGRAM ( a procedure or function )
occur in the generic formal part.
*** generic formal part statements:
-- one form of formal generic object parameter
FORMAL_OBJECT : SOME_TYPE := default_value ; -- default is optional
Note: "SOME_TYPE" can be a language predefined type or a
previously defined formal type ( e.g. some FORMAL )
SOME_TYPE may be preceded by "in", "out", or "in out"
-- twenty forms of formal generic type parameters
type FORMAL is private ; -- class of all non limited types
type FORMAL is limited private ; -- class of all types
type FORMAL is tagged private ; -- class of all non limited tagged types
type FORMAL is tagged limited private ;-- class of all tagged types
type FORMAL is abstract tagged private;-- class of what is says
type FORMAL is abstract tagged limited private ; -- class of what it says
type FORMAL(...) is private ; -- record type,discriminant provided
type FORMAL is (<>) ; -- a discrete type,integer and enum
type FORMAL is range <> ; -- an integer type
type FORMAL is digits <> ; -- a floating type
type FORMAL is mod <> ; -- a modular type
type FORMAL is delta <> ; -- a fixed point type
type FORMAL is delta <> digits <>; -- a decimal fixed point type
type FORMAL is access SOME_TYPE ; -- an access type
type FORMAL is access all SOME_TYPE ; -- for aliased access types
type FORMAL is access constant SOME ; -- for access to a constant type
type FORMAL is new SOME_TYPE ; -- a derived type
type FORMAL is new SOME with private ; -- a derived tagged type
type FORMAL is access procedure ; -- a procedure
type FORMAL is access function return SOME ; -- a function
-- two forms of formal generic array type parameters
type FORMAL is array (SOME_TYPE range <> ) of SOME_TYPE_2 ; -- unconstrained
type FORMAL is array (SOME_DISCRETE_TYPE) of SOME_TYPE_2 ; -- constrained
-- three forms of formal generic procedure parameters
with procedure FORMAL_PROCEDURE(JUNK_NAME : SOME_TYPE ; ...) ; -- no default
with procedure FORMAL_PROCEDURE(JUNK_NAME : SOME_TYPE ; ...)
is DEFAULT_NAME ;
with procedure FORMAL_PROCEDURE(JUNK_NAME : SOME_TYPE ; ...) is <> ;
-- its own name is the default
-- three forms of formal generic function parameters
with function FORMAL_FUNCTION(JUNK_NAME : SOME_TYPE ; ...)
return SOME_TYPE_2 ; -- no default
with function FORMAL_FUNCTION(JUNK_NAME : SOME_TYPE ; ...)
return SOME_TYPE_2 is DEFAULT_NAME ;
with function FORMAL_FUNCTION(JUNK_NAME : SOME_TYPE ;...)
return SOME_TYPE_2 is <> ; -- its own name is the default
-- Note: FORMAL_SUBPROGRAM is written "+" or ">" for operators
-- two forms of formal generic packages
with package FORMAL_PACKAGE is new SOME_GENERIC_PACKAGE(ACTUAL_ARGUMENTS);
with package FORMAL_PACKAGE is new SOME_GENERIC_PACKAGE(<>);
Once instantiated, the above forms with the "FORMAL" and "SOME_TYPE" things
replaced by the actual generic parameters are put into the package
specification or procedure declarative section or the function declarative
section depending on the kind of generic unit.
3. GENERIC INSTANTIATION
Remember that the generic library unit must be "withed" but can not
have a "use".
A generic instantiation can occur any where a declaration can occur.
The three forms of generic instantiation are:
package YOUR_NAME is new GENERIC_PACKAGE_NAME( ACTUAL_GENERIC_PARAMETERS) ;
-- may be followed by " use YOUR_NAME ; "
procedure YOUR_NAME is new GENERIC_PROCEDURE_NAME
( ACTUAL_GENERIC_PARAMETERS ) ;
-- do not confuse the procedure parameters with the generic parameters !
function YOUR_NAME is new GENERIC_FUNCTION_NAME
( ACTUAL_GENERIC_PARAMETERS ) ;
4. REFERENCES
ISO 8652:1995 chapter 12
Barnes chapter 17
Last updated 9/21/98