Introduction to Ada  95

      Compact summary of Ada


                          Page
  
  Language structures        1

  Executable statements      6

  Reserved words             9

  Types and subtypes        13

  Exceptions defined        15

  Named numbers             16

  Library units             17

  Types of types            19

  Examples declaring types  21

  Declaring objects         22

  Tasking                   24

  Generics                  28



  SUMMARY OF Ada LANGUAGE STRUCTURES and other information              1

     This summary was extracted from ANSI/ISO/IEC-8652:1995.
  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.


COMPILATION UNITS: These 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 ;

                                                                       2
   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 ;

                                                                        3
   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 ;

                                                                        4
   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 ) ;


                                                                         5
   procedure JUST_SPECIFICATION ;

   procedure SPECIFICATION ( Parameters... ) ;

   function SPECIFICATION ( Parameters ... ) return TYPEy ;


CONTEXT CLAUSEs  any number of the following.

   with LIBRARY_UNIT_NAME ;

   with NAME_1 , NAME_2, ... ;

   with NAME_1 ; use NAME_1 ;

   use  NAME_1 , NAME_2, ... ;



                                                                        6
  EXECUTABLE STATEMENT STRUCTURES


   declare                                     \_ optional
        -- DECLARATIONS                        /
   begin
        -- EXECUTABLE STATEMENTS
           return ;  -- allowed
   exception                                   \_ optional
        -- EXCEPTION HANDLERS                  /
   end ;


   LOOP_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 ;



   while A>B loop
        -- EXECUTABLE STATEMENTS
   end loop ;



   for NAME in P..Q loop
        -- EXECUTABLE STATEMENTS
   end loop ;



   for NAME in reverse P..Q loop    -- P <= Q
        -- EXECUTABLE STATEMENTS
   end loop ;

                                                                         7
   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 ;
 
                                                                         8
          Renaming declarations

  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                                                           9

  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, trying causes 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       10

  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 definition
  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 "  11

  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 no other code
  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      12
  return VALUE ;        Must be used in a function for the returned value

  reverse               Used with " for " to get the loop to run backward

  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

TYPES AND SUBTYPES DEFINED IN ISO 8652:1995                               13

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                                                   14

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.

SOME EXCEPTIONS DEFINED IN ISO 8652:1995                                  15

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

SOME NAMED NUMBERS DEFINED IN ISO 8652:1995                                16

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


SOME PRAGMAS DEFINED IN ISO 8652:1995 ( see annexes 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

LIBRARY UNITS DEFINED IN ISO 8652:1995                                     17
  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_Randon
  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                        18
              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. 

TYPES OF TYPES                                                            19

  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

                                                                          20
  Types of executable statements

                                              |-- 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

EXAMPLES DECLARING VARIOUS TYPES OF TYPES :                               21
    ( 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

DECLARING OBJECTS OF THE TYPES GIVEN ABOVE :                               22

     ( 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 ;


                                                                          23
 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 ) ;

  STRUCTURES RELATED TO TASKING.                                          24

     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     25

            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         26
     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  27
     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        28

  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                                                  29

  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 nonlimited types
  type FORMAL is limited private ;       -- class of all types
  type FORMAL is tagged private ;        -- class of all nonlimited 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                     30

  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