Types
Scalar Types
In general terms, scalar types are the most basic types that we can get. As we know, we can classify them as follows:
Category |
Discrete |
Numeric |
---|---|---|
Enumeration |
Yes |
No |
Integer |
Yes |
Yes |
Real |
No |
Yes |
Many attributes exist for scalar types. For example, we can use the
Image
and Value
attributes to convert between a given type and a
string type. The following table presents the main attributes for scalar types:
Category |
Attribute |
Returned value |
---|---|---|
Ranges |
|
First value of the discrete subtype's range. |
|
Last value of the discrete subtype's range. |
|
|
Range of the discrete subtype (corresponds
to |
|
Iterators |
|
Predecessor of the input value. |
|
Successor of the input value. |
|
Comparison |
|
Minimum of two values. |
|
Maximum of two values. |
|
String conversion |
|
String representation of the input value. |
|
Value of a subtype based on input string. |
We already discussed some of these attributes in the Introduction to Ada course (in the sections about range and related attributes and image attribute). In this section, we'll discuss some aspects that have been left out of the previous course.
In the Ada Reference Manual
Ranges
We've seen that the First
and Last
attributes can be used with
discrete types. Those attributes are also available for real types. Here's an
example using the Float
type and a subtype of it:
with Ada.Text_IO; use Ada.Text_IO; procedure Show_First_Last_Real is subtype Norm is Float range 0.0 .. 1.0; begin Put_Line ("Float'First: " & Float'First'Image); Put_Line ("Float'Last: " & Float'Last'Image); Put_Line ("Norm'First: " & Norm'First'Image); Put_Line ("Norm'Last: " & Norm'Last'Image); end Show_First_Last_Real;
This program displays the first and last values of both the Float
type
and the Norm
subtype. In the case of the Float
type, we see the
full range, while for the Norm
subtype, we get the values we used in the
declaration of the subtype (i.e. 0.0 and 1.0).
Predecessor and Successor
We can use the Pred
and Succ
attributes to get the predecessor
and successor of a specific value. For discrete types, this is simply the next
discrete value. For example, Pred (2)
is 1 and Succ (2)
is 3.
Let's look at a complete source-code example:
with Ada.Text_IO; use Ada.Text_IO; procedure Show_Succ_Pred_Discrete is type State is (Idle, Started, Processing, Stopped); Machine_State : constant State := Started; I : constant Integer := 2; begin Put_Line ("State : " & Machine_State'Image); Put_Line ("State'Pred (Machine_State): " & State'Pred (Machine_State)'Image); Put_Line ("State'Succ (Machine_State): " & State'Succ (Machine_State)'Image); Put_Line ("----------"); Put_Line ("I : " & I'Image); Put_Line ("Integer'Pred (I): " & Integer'Pred (I)'Image); Put_Line ("Integer'Succ (I): " & Integer'Succ (I)'Image); end Show_Succ_Pred_Discrete;
In this example, we use the Pred
and Succ
attributes for a
variable of enumeration type (State
) and a variable of Integer
type.
We can also use the Pred
and Succ
attributes with real types. In
this case, however, the value we get depends on the actual type we're using:
for fixed-point types, the value is calculated using the smallest value (
Small
), which is derived from the declaration of the fixed-point type;for floating-point types, the value used in the calculation depends on representation constraints of the actual target machine.
Let's look at this example with a decimal type (Decimal
) and a
floating-point type (My_Float
):
with Ada.Text_IO; use Ada.Text_IO; procedure Show_Succ_Pred_Real is subtype My_Float is Float range 0.0 .. 0.5; type Decimal is delta 0.1 digits 2 range 0.0 .. 0.5; D : Decimal; N : My_Float; begin Put_Line ("---- DECIMAL -----"); Put_Line ("Small: " & Decimal'Small'Image); Put_Line ("----- Succ -------"); D := Decimal'First; loop Put_Line (D'Image); D := Decimal'Succ (D); exit when D = Decimal'Last; end loop; Put_Line ("----- Pred -------"); D := Decimal'Last; loop Put_Line (D'Image); D := Decimal'Pred (D); exit when D = Decimal'First; end loop; Put_Line ("=================="); Put_Line ("---- MY_FLOAT ----"); Put_Line ("----- Succ -------"); N := My_Float'First; for I in 1 .. 5 loop Put_Line (N'Image); N := My_Float'Succ (N); end loop; Put_Line ("----- Pred -------"); for I in 1 .. 5 loop Put_Line (N'Image); N := My_Float'Pred (N); end loop; end Show_Succ_Pred_Real;
As the output of the program indicates, the smallest value (see
Decimal'Small
in the example) is used to calculate the previous and next
values of Decimal
type.
In the case of the My_Float
type, the difference between the current
and the previous or next values is 1.40130E-45 (or 2-149) on a
standard PC.
Scalar To String Conversion
We've seen that we can use the Image
and Value
attributes to
perform conversions between values of a given subtype and a string:
with Ada.Text_IO; use Ada.Text_IO; procedure Show_Image_Value_Attr is I : constant Integer := Integer'Value ("42"); begin Put_Line (I'Image); end Show_Image_Value_Attr;
The Image
and Value
attributes are used for the String
type specifically. In addition to them, there are also attributes for different
string types — namely Wide_String
and Wide_Wide_String
.
This is the complete list of available attributes:
Conversion type |
Attribute |
String type |
---|---|---|
Conversion to string |
|
|
|
|
|
|
|
|
Conversion to subtype |
|
|
|
|
|
|
|
We discuss more about Wide_String
and Wide_Wide_String
in
another section.
Width attribute
When converting a value to a string by using the Image
attribute, we get
a string with variable width. We can assess the maximum width of that string
for a specific subtype by using the Width
attribute. For example,
Integer'Width
gives us the maximum width returned by the Image
attribute when converting a value of Integer
type to a string of
String
type.
This attribute is useful when we're using bounded strings in our code to store
the string returned by the Image
attribute. For example:
with Ada.Text_IO; use Ada.Text_IO; with Ada.Strings; use Ada.Strings; with Ada.Strings.Bounded; procedure Show_Width_Attr is package B_Str is new Ada.Strings.Bounded.Generic_Bounded_Length (Max => Integer'Width); use B_Str; Str_I : Bounded_String; I : constant Integer := 42; J : constant Integer := 103; begin Str_I := To_Bounded_String (I'Image); Put_Line ("Value: " & To_String (Str_I)); Put_Line ("String Length: " & Length (Str_I)'Image); Put_Line ("----"); Str_I := To_Bounded_String (J'Image); Put_Line ("Value: " & To_String (Str_I)); Put_Line ("String Length: " & Length (Str_I)'Image); end Show_Width_Attr;
In this example, we're storing the string returned by Image
in the
Str_I
variable of Bounded_String
type.
Similar to the Image
and Value
attributes, the Width
attribute is also available for string types other than String
. In fact,
we can use:
the
Wide_Width
attribute for strings returned byWide_Image
; andthe
Wide_Wide_Width
attribute for strings returned byWide_Wide_Image
.
Base
The Base
attribute gives us the unconstrained underlying hardware
representation selected for a given numeric type. As an example, let's say we
declared a subtype of the Integer
type named One_To_Ten
:
package My_Integers is subtype One_To_Ten is Integer range 1 .. 10; end My_Integers;
If we then use the Base
attribute — by writing
One_To_Ten'Base
—, we're actually referring to the unconstrained
underlying hardware representation selected for One_To_Ten
. As
One_To_Ten
is a subtype of the Integer
type, this also means that
One_To_Ten'Base
is equivalent to Integer'Base
, i.e. they refer to
the same base type. (This base type is the underlying hardware type
representing the Integer
type — but is not the Integer
type
itself.)
For further reading...
The Ada standard defines that the minimum range of the Integer
type
is -2**15 + 1 .. 2**15 - 1
. In modern 64-bit systems —
where wider types such as Long_Integer
are defined — the range
is at least -2**31 + 1 .. 2**31 - 1
. Therefore, we could think of
the Integer
type as having the following declaration:
type Integer is
range -2 ** 31 .. 2 ** 31 - 1;
However, even though Integer
is a predefined Ada type, it's actually
a subtype of an anonymous type. That anonymous "type" is the hardware's
representation for the numeric type as chosen by the compiler based on the
requested range (for the signed integer types) or digits of precision (for
floating-point types). In other words, these types are actually subtypes of
something that does not have a specific name in Ada, and that is not
constrained.
In effect,
type Integer is
range -2 ** 31 .. 2 ** 31 - 1;
is really as if we said this:
subtype Integer is
Some_Hardware_Type_With_Sufficient_Range
range -2 ** 31 .. 2 ** 31 - 1;
Since the Some_Hardware_Type_With_Sufficient_Range
type is anonymous
and we therefore cannot refer to it in the code, we just say that
Integer
is a type rather than a subtype.
Let's focus on signed integers — as the other numerics work the same way. When we declare a signed integer type, we have to specify the required range, statically. If the compiler cannot find a hardware-defined or supported signed integer type with at least the range requested, the compilation is rejected. For example, in current architectures, the code below most likely won't compile:
package Int_Def is type Too_Big_To_Fail is range -2 ** 255 .. 2 ** 255 - 1; end Int_Def;
Otherwise, the compiler maps the named Ada type to the hardware "type", presumably choosing the smallest one that supports the requested range. (That's why the range has to be static in the source code, unlike for explicit subtypes.)
The following example shows how the Base
attribute affects the bounds of
a variable:
with Ada.Text_IO; use Ada.Text_IO; with My_Integers; use My_Integers; procedure Show_Base is C : constant One_To_Ten := One_To_Ten'Last; begin Using_Constrained_Subtype : declare V : One_To_Ten := C; begin Put_Line ("Increasing value for One_To_Ten..."); V := One_To_Ten'Succ (V); exception when others => Put_Line ("Exception raised!"); end Using_Constrained_Subtype; Using_Base : declare V : One_To_Ten'Base := C; begin Put_Line ("Increasing value for One_To_Ten'Base..."); V := One_To_Ten'Succ (V); exception when others => Put_Line ("Exception raised!"); end Using_Base; Put_Line ("One_To_Ten'Last: " & One_To_Ten'Last'Image); Put_Line ("One_To_Ten'Base'Last: " & One_To_Ten'Base'Last'Image); end Show_Base;
In the first block of the example (Using_Constrained_Subtype
), we're
asking for the next value after the last value of a range — in this case,
One_To_Ten'Succ (One_To_Ten'Last)
. As expected, since the last value of
the range doesn't have a successor, a constraint exception is raised.
In the Using_Base
block, we're declaring a variable V
of
One_To_Ten'Base
subtype. In this case, the next value exists —
because the condition One_To_Ten'Last + 1 <= One_To_Ten'Base'Last
is
true —, so we can use the Succ
attribute without having an
exception being raised.
In the following example, we adjust the result of additions and subtractions to avoid constraint errors:
package My_Integers is subtype One_To_Ten is Integer range 1 .. 10; function Sat_Add (V1, V2 : One_To_Ten'Base) return One_To_Ten; function Sat_Sub (V1, V2 : One_To_Ten'Base) return One_To_Ten; end My_Integers;-- with Ada.Text_IO; use Ada.Text_IO; package body My_Integers is function Saturate (V : One_To_Ten'Base) return One_To_Ten is begin -- Put_Line ("SATURATE " & V'Image); if V < One_To_Ten'First then return One_To_Ten'First; elsif V > One_To_Ten'Last then return One_To_Ten'Last; else return V; end if; end Saturate; function Sat_Add (V1, V2 : One_To_Ten'Base) return One_To_Ten is begin return Saturate (V1 + V2); end Sat_Add; function Sat_Sub (V1, V2 : One_To_Ten'Base) return One_To_Ten is begin return Saturate (V1 - V2); end Sat_Sub; end My_Integers;with Ada.Text_IO; use Ada.Text_IO; with My_Integers; use My_Integers; procedure Show_Base is type Display_Saturate_Op is (Add, Sub); procedure Display_Saturate (V1, V2 : One_To_Ten; Op : Display_Saturate_Op) is Res : One_To_Ten; begin case Op is when Add => Res := Sat_Add (V1, V2); when Sub => Res := Sat_Sub (V1, V2); end case; Put_Line ("SATURATE " & Op'Image & " (" & V1'Image & ", " & V2'Image & ") = " & Res'Image); end Display_Saturate; begin Display_Saturate (1, 1, Add); Display_Saturate (10, 8, Add); Display_Saturate (1, 8, Sub); end Show_Base;
In this example, we're using the Base
attribute to declare the
parameters of the Sat_Add
, Sat_Sub
and Saturate
functions.
Note that the parameters of the Display_Saturate
procedure are of
One_To_Ten
type, while the parameters of the Sat_Add
,
Sat_Sub
and Saturate
functions are of the (unconstrained) base
subtype (One_To_Ten'Base
). In those functions, we perform operations
using the parameters of unconstrained subtype and adjust the result — in
the Saturate
function — before returning it as a constrained value
of One_To_Ten
subtype.
The code in the body of the My_Integers
package contains lines that were
commented out — to be more precise, a call to Put_Line
call in the
Saturate
function. If you uncomment them, you'll see the value of the
input parameter V
(of One_To_Ten'Base
type) in the runtime output
of the program before it's adapted to fit the constraints of the
One_To_Ten
subtype.
Enumerations
We've introduced enumerations back in the Introduction to Ada course. In this section, we'll discuss a few useful features of enumerations, such as enumeration renaming, enumeration overloading and representation clauses.
In the Ada Reference Manual
Enumerations as functions
If you have used programming language such as C in the past, you're familiar with the concept of enumerations being constants with integer values. In Ada, however, enumerations are not integers. In fact, they're actually parameterless functions! Let's consider this example:
package Days is type Day is (Mon, Tue, Wed, Thu, Fri, Sat, Sun); -- Essentially, we're declaring -- these functions: -- -- function Mon return Day; -- function Tue return Day; -- function Wed return Day; -- function Thu return Day; -- function Fri return Day; -- function Sat return Day; -- function Sun return Day; end Days;
In the package Days
, we're declaring the enumeration type Day
.
When we do this, we're essentially declaring seven parameterless functions, one
for each enumeration. For example, the Mon
enumeration corresponds to
function Mon return Day
. You can see all seven function declarations in
the comments of the example above.
Note that this has no direct relation to how an Ada compiler generates machine code for enumeration. Even though enumerations are parameterless functions, a typical Ada compiler doesn't generate function calls for code that deals with enumerations.
Enumeration renaming
The idea that enumerations are parameterless functions can be used when we want
to rename enumerations. For example, we could rename the enumerations of the
Day
type like this:
package Enumeration_Example is type Day is (Mon, Tue, Wed, Thu, Fri, Sat, Sun); function Monday return Day renames Mon; function Tuesday return Day renames Tue; function Wednesday return Day renames Wed; function Thursday return Day renames Thu; function Friday return Day renames Fri; function Saturday return Day renames Sat; function Sunday return Day renames Sun; end Enumeration_Example;
Now, we can use both Monday
or Mon
to refer to Monday of the
Day
type:
with Ada.Text_IO; use Ada.Text_IO; with Enumeration_Example; use Enumeration_Example; procedure Show_Renaming is D1 : constant Day := Mon; D2 : constant Day := Monday; begin if D1 = D2 then Put_Line ("D1 = D2"); Put_Line (Day'Image (D1) & " = " & Day'Image (D2)); end if; end Show_Renaming;
When running this application, we can confirm that D1
is equal to
D2
. Also, even though we've assigned Monday
to D2
(instead
of Mon
), the application displays Mon = Mon
, since Monday
is just another name to refer to the actual enumeration (Mon
).
Hint
If you just want to have a single (renamed) enumeration visible in your application — and make the original enumeration invisible —, you can use a separate package. For example:
package Enumeration_Example is type Day is (Mon, Tue, Wed, Thu, Fri, Sat, Sun); end Enumeration_Example;with Enumeration_Example; package Enumeration_Renaming is subtype Day is Enumeration_Example.Day; function Monday return Day renames Enumeration_Example.Mon; function Tuesday return Day renames Enumeration_Example.Tue; function Wednesday return Day renames Enumeration_Example.Wed; function Thursday return Day renames Enumeration_Example.Thu; function Friday return Day renames Enumeration_Example.Fri; function Saturday return Day renames Enumeration_Example.Sat; function Sunday return Day renames Enumeration_Example.Sun; end Enumeration_Renaming;with Ada.Text_IO; use Ada.Text_IO; with Enumeration_Renaming; use Enumeration_Renaming; procedure Show_Renaming is D1 : constant Day := Monday; begin Put_Line (Day'Image (D1)); end Show_Renaming;
Note that the call to Put_Line
still display Mon
instead of
Monday
.
Enumeration overloading
Enumerations can be overloaded. In simple terms, this means that the same name can be used to declare an enumeration of different types. A typical example is the declaration of colors:
package Colors is type Color is (Salmon, Firebrick, Red, Darkred, Lime, Forestgreen, Green, Darkgreen, Blue, Mediumblue, Darkblue); type Primary_Color is (Red, Green, Blue); end Colors;
Note that we have Red
as an enumeration of type Color
and of type
Primary_Color
. The same applies to Green
and Blue
. Because
Ada is a strongly-typed language, in most cases, the enumeration that we're
referring to is clear from the context. For example:
with Ada.Text_IO; use Ada.Text_IO; with Colors; use Colors; procedure Red_Colors is C1 : constant Color := Red; -- Using Red from Color C2 : constant Primary_Color := Red; -- Using Red from Primary_Color begin if C1 = Red then Put_Line ("C1 = Red"); end if; if C2 = Red then Put_Line ("C2 = Red"); end if; end Red_Colors;
When assigning Red
to C1
and C2
, it is clear that, in the
first case, we're referring to Red
of Color
type, while in the
second case, we're referring to Red
of the Primary_Color
type.
The same logic applies to comparisons such as the one in
if C1 = Red
: because the type of C1
is defined
(Color
), it's clear that the Red
enumeration is the one of
Color
type.
Enumeration subtypes
Note that enumeration overloading is not the same as enumeration subtypes. For example, we could define the following subtype:
package Colors.Shades is subtype Blue_Shades is Colors range Blue .. Darkblue; end Colors.Shades;
In this case, Blue
of Blue_Shades
and Blue
of
Colors
are the same enumeration.
Enumeration ambiguities
A situation where enumeration overloading might lead to ambiguities is when we use them in ranges. For example:
package Colors is type Color is (Salmon, Firebrick, Red, Darkred, Lime, Forestgreen, Green, Darkgreen, Blue, Mediumblue, Darkblue); type Primary_Color is (Red, Green, Blue); end Colors;with Ada.Text_IO; use Ada.Text_IO; with Colors; use Colors; procedure Color_Loop is begin for C in Red .. Blue loop -- ^^^^^^^^^^^ -- ERROR: range is ambiguous! Put_Line (Color'Image (C)); end loop; end Color_Loop;
Here, it's not clear whether the range in the loop is of Color
type or
of Primary_Color
type. Therefore, we get a compilation error for this
code example. The next line in the code example — the one with the call
to Put_Line
— gives us a hint about the developer's intention to
refer to the Color
type. In this case, we can use qualification —
for example, Color'(Red)
— to resolve the ambiguity:
with Ada.Text_IO; use Ada.Text_IO; with Colors; use Colors; procedure Color_Loop is begin for C in Color'(Red) .. Color'(Blue) loop Put_Line (Color'Image (C)); end loop; end Color_Loop;
Note that, in the case of ranges, we can also rewrite the loop by using a range declaration:
with Ada.Text_IO; use Ada.Text_IO; with Colors; use Colors; procedure Color_Loop is begin for C in Color range Red .. Blue loop Put_Line (Color'Image (C)); end loop; end Color_Loop;
Alternatively, Color range Red .. Blue
could be used in a subtype
declaration, so we could rewrite the example above using a subtype (such as
Red_To_Blue
) in the loop:
with Ada.Text_IO; use Ada.Text_IO; with Colors; use Colors; procedure Color_Loop is subtype Red_To_Blue is Color range Red .. Blue; begin for C in Red_To_Blue loop Put_Line (Color'Image (C)); end loop; end Color_Loop;
Position and Internal Code
As we've said above, a typical Ada compiler doesn't generate function calls for code that deals with enumerations. On the contrary, each enumeration has values associated with it, and the compiler uses those values instead.
Each enumeration has:
a position value, which is a natural value indicating the position of the enumeration in the enumeration type; and
an internal code, which, by default, in most cases, is the same as the position value.
Also, by default, the value of the first position is zero, the value of the
second position is one, and so on. We can see this by listing each enumeration
of the Day
type and displaying the value of the corresponding position:
package Days is type Day is (Mon, Tue, Wed, Thu, Fri, Sat, Sun); end Days;with Ada.Text_IO; use Ada.Text_IO; with Days; use Days; procedure Show_Days is begin for D in Day loop Put_Line (Day'Image (D) & " position = " & Integer'Image (Day'Pos (D))); Put_Line (Day'Image (D) & " internal code = " & Integer'Image (Day'Enum_Rep (D))); end loop; end Show_Days;
Note that this application also displays the internal code, which, in this case, is equivalent to the position value for all enumerations.
We may, however, change the internal code of an enumeration using a representation clause. We discuss this topic in another section.
Definite and Indefinite Subtypes
Indefinite types were mentioned back in the Introduction to Ada course. In this section, we'll recapitulate and extend on both definite and indefinite types.
Definite types are the basic kind of types we commonly use when programming applications. For example, we can only declare variables of definite types; otherwise, we get a compilation error. Interestingly, however, to be able to explain what definite types are, we need to first discuss indefinite types.
Indefinite types include:
unconstrained arrays;
record types with unconstrained discriminants without defaults.
Let's see some examples of indefinite types:
package Unconstrained_Types is type Integer_Array is array (Positive range <>) of Integer; type Simple_Record (Extended : Boolean) is record V : Integer; case Extended is when False => null; when True => V_Float : Float; end case; end record; end Unconstrained_Types;
In this example, both Integer_Array
and Simple_Record
are
indefinite types.
As we've just mentioned, we cannot declare variable of indefinite types:
with Unconstrained_Types; use Unconstrained_Types; procedure Using_Unconstrained_Type is A : Integer_Array; R : Simple_Record; begin null; end Using_Unconstrained_Type;
As we can see when we try to build this example, the compiler complains about
the declaration of A
and R
because we're trying to use indefinite
types to declare variables. The main reason we cannot use indefinite types here
is that the compiler needs to know at this point how much memory it should
allocate. Therefore, we need to provide the information that is missing. In
other words, we need to change the declaration so the type becomes definite. We
can do this by either declaring a definite type or providing constraints in the
variable declaration. For example:
with Unconstrained_Types; use Unconstrained_Types; procedure Using_Unconstrained_Type is subtype Integer_Array_5 is Integer_Array (1 .. 5); A1 : Integer_Array_5; A2 : Integer_Array (1 .. 5); subtype Simple_Record_Ext is Simple_Record (Extended => True); R1 : Simple_Record_Ext; R2 : Simple_Record (Extended => True); begin null; end Using_Unconstrained_Type;
In this example, we declare the Integer_Array_5
subtype, which is
definite because we're constraining it to a range from 1 to 5, thereby
defining the information that was missing in the indefinite type
Integer_Array
. Because we now have a definite type, we can use it to
declare the A1
variable. Similarly, we can use the indefinite type
Integer_Array
directly in the declaration of A2
by specifying the
previously unknown range.
Similarly, in this example, we declare the Simple_Record_Ext
subtype,
which is definite because we're initializing the record discriminant
Extended
. We can therefore use it in the declaration of the R1
variable. Alternatively, we can simply use the indefinite type
Simple_Record
and specify the information required for the
discriminants. This is what we do in the declaration of the R2
variable.
Although we cannot use indefinite types directly in variable declarations, they're very useful to generalize algorithms. For example, we can use them as parameters of a subprogram:
with Unconstrained_Types; use Unconstrained_Types; procedure Show_Integer_Array (A : Integer_Array);with Ada.Text_IO; use Ada.Text_IO; procedure Show_Integer_Array (A : Integer_Array) is begin for I in A'Range loop Put_Line (Positive'Image (I) & ": " & Integer'Image (A (I))); end loop; Put_Line ("--------"); end Show_Integer_Array;with Unconstrained_Types; use Unconstrained_Types; with Show_Integer_Array; procedure Using_Unconstrained_Type is A_5 : constant Integer_Array (1 .. 5) := (1, 2, 3, 4, 5); A_10 : constant Integer_Array (1 .. 10) := (1, 2, 3, 4, 5, others => 99); begin Show_Integer_Array (A_5); Show_Integer_Array (A_10); end Using_Unconstrained_Type;
In this particular example, the compiler doesn't know a priori which range is
used for the A
parameter of Show_Integer_Array
. It could be a
range from 1 to 5 as used for variable A_5
of the
Using_Unconstrained_Type
procedure, or it could be a range from 1 to 10
as used for variable A_10
, or it could be anything else. Although the
parameter A
of Show_Integer_Array
is unconstrained, both calls to
Show_Integer_Array
— in Using_Unconstrained_Type
procedure
— use constrained objects.
Note that we could call the Show_Integer_Array
procedure above with
another unconstrained parameter. For example:
with Unconstrained_Types; use Unconstrained_Types; procedure Show_Integer_Array_Header (AA : Integer_Array; HH : String);with Ada.Text_IO; use Ada.Text_IO; with Show_Integer_Array; procedure Show_Integer_Array_Header (AA : Integer_Array; HH : String) is begin Put_Line (HH); Show_Integer_Array (AA); end Show_Integer_Array_Header;with Unconstrained_Types; use Unconstrained_Types; with Show_Integer_Array_Header; procedure Using_Unconstrained_Type is A_5 : constant Integer_Array (1 .. 5) := (1, 2, 3, 4, 5); A_10 : constant Integer_Array (1 .. 10) := (1, 2, 3, 4, 5, others => 99); begin Show_Integer_Array_Header (A_5, "First example"); Show_Integer_Array_Header (A_10, "Second example"); end Using_Unconstrained_Type;
In this case, we're calling the Show_Integer_Array
procedure with
another unconstrained parameter (the AA
parameter). However, although we
could have a long chain of procedure calls using indefinite types in their
parameters, we still use a (definite) object at the beginning of this chain.
For example, for the A_5
object, we have this chain:
A_5
==> Show_Integer_Array_Header (AA => A_5,
...);
==> Show_Integer_Array (A => AA);
Therefore, at this specific call to Show_Integer_Array
, even though
A
is declared as a parameter of indefinite type, the actual argument
is of definite type because A_5
is constrained — and, thus, of
definite type.
Note that we can declare variables based on parameters of indefinite type. For example:
with Unconstrained_Types; use Unconstrained_Types; procedure Show_Integer_Array_Plus (A : Integer_Array; V : Integer);with Show_Integer_Array; procedure Show_Integer_Array_Plus (A : Integer_Array; V : Integer) is A_Plus : Integer_Array (A'Range); begin for I in A_Plus'Range loop A_Plus (I) := A (I) + V; end loop; Show_Integer_Array (A_Plus); end Show_Integer_Array_Plus;with Unconstrained_Types; use Unconstrained_Types; with Show_Integer_Array_Plus; procedure Using_Unconstrained_Type is A_5 : constant Integer_Array (1 .. 5) := (1, 2, 3, 4, 5); begin Show_Integer_Array_Plus (A_5, 5); end Using_Unconstrained_Type;
In the Show_Integer_Array_Plus
procedure, we're declaring A_Plus
based on the range of A
, which is itself of indefinite type. However,
since the object passed as an argument to Show_Integer_Array_Plus
must
have a constraint, A_Plus
will also be constrained. For example, in the
call to Show_Integer_Array_Plus
using A_5
as an argument, the
declaration of A_Plus
becomes A_Plus : Integer_Array (1 .. 5);
.
Therefore, it becomes clear that the compiler needs to allocate five elements
for A_Plus
.
We'll see later how definite and indefinite types apply to formal parameters.
In the Ada Reference Manual
Constrained Attribute
We can use the Constrained
attribute to verify whether an object of
discriminated type is constrained or not. Let's start our discussion by reusing
the Simple_Record
type from previous examples. In this version of the
Unconstrained_Types
package, we're adding a Reset
procedure for
the discriminated record type:
package Unconstrained_Types is type Simple_Record (Extended : Boolean := False) is record V : Integer; case Extended is when False => null; when True => V_Float : Float; end case; end record; procedure Reset (R : in out Simple_Record); end Unconstrained_Types;with Ada.Text_IO; use Ada.Text_IO; package body Unconstrained_Types is procedure Reset (R : in out Simple_Record) is Zero_Not_Extended : constant Simple_Record := (Extended => False, V => 0); Zero_Extended : constant Simple_Record := (Extended => True, V => 0, V_Float => 0.0); begin Put_Line ("---- Reset: R'Constrained => " & R'Constrained'Image); if not R'Constrained then R := Zero_Extended; else if R.Extended then R := Zero_Extended; else R := Zero_Not_Extended; end if; end if; end Reset; end Unconstrained_Types;
As the name indicates, the Reset
procedure initializes all record
components with zero. Note that we use the Constrained
attribute to
verify whether objects are constrained before assigning to them. For objects
that are not constrained, we can simply assign another object to it — as
we do with the R := Zero_Extended
statement. When an object is
constrained, however, the discriminants must match. If we assign an object to
R
, the discriminant of that object must match the discriminant of
R
. This is the kind of verification that we do in the else
part
of that procedure: we check the state of the Extended
discriminant
before assigning an object to the R
parameter.
The Using_Constrained_Attribute
procedure below declares two objects of
Simple_Record
type: R1
and R2
. Because the
Simple_Record
type has a default value for its discriminant, we can
declare objects of this type without specifying a value for the discriminant.
This is exactly what we do in the declaration of R1
. Here, we don't
specify any constraints, so that it takes the default value
(Extended => False
). In the declaration of R2
, however, we
explicitly set Extended
to False
:
with Ada.Text_IO; use Ada.Text_IO; with Unconstrained_Types; use Unconstrained_Types; procedure Using_Constrained_Attribute is R1 : Simple_Record; R2 : Simple_Record (Extended => False); procedure Show_Rs is begin Put_Line ("R1'Constrained => " & R1'Constrained'Image); Put_Line ("R1.Extended => " & R1.Extended'Image); Put_Line ("--"); Put_Line ("R2'Constrained => " & R2'Constrained'Image); Put_Line ("R2.Extended => " & R2.Extended'Image); Put_Line ("----------------"); end Show_Rs; begin Show_Rs; Reset (R1); Reset (R2); Put_Line ("----------------"); Show_Rs; end Using_Constrained_Attribute;
When we run this code, the user messages from Show_Rs
indicate to us
that R1
is not constrained, while R2
is constrained.
Because we declare R1
without specifying a value for the Extended
discriminant, R1
is not constrained. In the declaration of
R2
, on the other hand, the explicit value for the Extended
discriminant makes this object constrained. Note that, for both R1
and
R2
, the value of Extended
is False
in the declarations.
As we were just discussing, the Reset
procedure includes checks to avoid
mismatches in discriminants. When we don't have those checks, we might get
exceptions at runtime. We can force this situation by replacing the
implementation of the Reset
procedure with the following lines:
-- [...]
begin
Put_Line ("---- Reset: R'Constrained => "
& R'Constrained'Image);
R := Zero_Extended;
end Reset;
Running the code now generates a runtime exception:
raised CONSTRAINT_ERROR : unconstrained_types.adb:12 discriminant check failed
This exception is raised during the call to Reset (R2)
. As see in the
code, R2
is constrained. Also, its Extended
discriminant is set
to False
, which means that it doesn't have the V_Float
component. Therefore, R2
is not compatible with the constant
Zero_Extended
object, so we cannot assign Zero_Extended
to
R2
. Also, because R2
is constrained, its Extended
discriminant cannot be modified.
The behavior is different for the call to Reset (R1)
, which works fine.
Here, when we pass R1
as an argument to the Reset
procedure, its
Extended
discriminant is False
by default. Thus, R1
is
also not compatible with the Zero_Extended
object. However, because
R1
is not constrained, the assignment modifies R1
(by changing
the value of the Extended
discriminant). Therefore, with the call to
Reset
, the Extended
discriminant of R1
changes from
False
to True
.
In the Ada Reference Manual
Incomplete types
Incomplete types — as the name suggests — are types that have missing information in their declaration. This is a simple example:
type Incomplete;
Because this type declaration is incomplete, we need to provide the missing
information at some later point. Consider the incomplete type R
in the
following example:
package Incomplete_Type_Example is type R; -- Incomplete type declaration! type R is record I : Integer; end record; -- type R is now complete! end Incomplete_Type_Example;
The first declaration of type R
is incomplete. However, in the second
declaration of R
, we specify that R
is a record. By providing
this missing information, we're completing the type declaration of R
.
It's also possible to declare an incomplete type in the private part of a package specification and its complete form in the package body. Let's rewrite the example above accordingly:
package Incomplete_Type_Example is private type R; -- Incomplete type declaration! end Incomplete_Type_Example;package body Incomplete_Type_Example is type R is record I : Integer; end record; -- type R is now complete! end Incomplete_Type_Example;
A typical application of incomplete types is to create linked lists using access types based on those incomplete types. This kind of type is called a recursive type. For example:
package Linked_List_Example is type Integer_List; type Next is access Integer_List; type Integer_List is record I : Integer; N : Next; end record; end Linked_List_Example;
Here, the N
component of Integer_List
is essentially giving us
access to the next element of Integer_List
type. Because the Next
type is both referring to the Integer_List
type and being used in the
declaration of the Integer_List
type, we need to start with an
incomplete declaration of the Integer_List
type and then complete it
after the declaration of Next
.
Incomplete types are useful to declare mutually dependent types, as we'll see later on. Also, we can also have formal incomplete types, as we'll discuss later.
In the Ada Reference Manual
Type view
Ada distinguishes between the partial and the full view of a type. The full
view is a type declaration that contains all the information needed by the
compiler. For example, the following declaration of type R
represents
the full view of this type:
package Full_View is -- Full view of the R type: type R is record I : Integer; end record; end Full_View;
As soon as we start applying encapsulation and information hiding — via
the private
keyword — to a specific type, we are introducing a
partial view and making only that view compile-time visible to clients. Doing
so requires us to introduce the private part of the package (unless already
present). For example:
package Partial_Full_Views is -- Partial view of the R type: type R is private; private -- Full view of the R type: type R is record I : Integer; end record; end Partial_Full_Views;
As indicated in the example, the type R is private
declaration is the
partial view of the R
type, while the type R is record [...]
declaration in the private part of the package is the full view.
Although the partial view doesn't contain the full type declaration, it contains very important information for the users of the package where it's declared. In fact, the partial view of a private type is all that users actually need to know to effectively use this type, while the full view is only needed by the compiler.
In the previous example, the partial view indicates that R
is a private
type, which means that, even though users cannot directly access any
information stored in this type — for example, read the value of the
I
component of R
—, they can use the R
type to
declare objects. For example:
with Partial_Full_Views; use Partial_Full_Views; procedure Main is -- Partial view of R indicates that -- R exists as a private type, so we -- can declare objects of this type: C : R; begin -- But we cannot directly access any -- information declared in the full -- view of R: -- -- C.I := 42; -- null; end Main;
In many cases, the restrictions applied to the partial and full views must match. For example, if we declare a limited type in the full view of a private type, its partial view must also be limited:
package Limited_Private_Example is -- Partial view must be limited, -- since the full view is limited. type R is limited private; private type R is limited record I : Integer; end record; end Limited_Private_Example;
There are, however, situations where the full view may contain additional requirements that aren't mentioned in the partial view. For example, a type may be declared as non-tagged in the partial view, but, at the same time, be tagged in the full view:
package Tagged_Full_View_Example is -- Partial view using non-tagged type: type R is private; private -- Full view using tagged type: type R is tagged record I : Integer; end record; end Tagged_Full_View_Example;
In this case, from a user's perspective, the R
type is non-tagged, so
that users cannot use any object-oriented programming features for this type.
In the package body of Tagged_Full_View_Example
, however, this type is
tagged, so that all object-oriented programming features are available for
subprograms of the package body that make use of this type. Again, the partial
view of the private type contains the most important information for users that
want to declare objects of this type.
In the Ada Reference Manual
Non-Record Private Types
Although it's very common to declare private types as record types, this is not the only option. In fact, we could declare any type in the full view — scalars, for example —, so we could declare a "private integer" type:
package Private_Integers is -- Partial view of private Integer type: type Private_Integer is private; private -- Full view of private Integer type: type Private_Integer is new Integer; end Private_Integers;
This code compiles as expected, but isn't very useful. We can improve it by adding operators to it, for example:
package Private_Integers is -- Partial view of private Integer type: type Private_Integer is private; function "+" (Left, Right : Private_Integer) return Private_Integer; private -- Full view of private Integer type: type Private_Integer is new Integer; end Private_Integers;package body Private_Integers is function "+" (Left, Right : Private_Integer) return Private_Integer is Res : constant Integer := Integer (Left) + Integer (Right); -- Note that we're converting Left -- and Right to Integer, which calls -- the "+" operator of the Integer -- type. Writing "Left + Right" would -- have called the "+" operator of -- Private_Integer, which leads to -- recursive calls, as this is the -- operator we're currently in. begin return Private_Integer (Res); end "+"; end Private_Integers;
Now, let's use the new operator in a test application:
with Private_Integers; use Private_Integers; procedure Show_Private_Integers is A, B : Private_Integer; begin A := A + B; end Show_Private_Integers;
In this example, we use the +
operator as if we were adding two common
integer variables of Integer
type.
Unconstrained Types
There are, however, some limitations: we cannot use unconstrained types such as arrays or even discriminants for arrays in the same way as we did for scalars. For example, the following declarations won't work:
package Private_Arrays is type Private_Unconstrained_Array is private; type Private_Constrained_Array (L : Positive) is private; private type Integer_Array is array (Positive range <>) of Integer; type Private_Unconstrained_Array is array (Positive range <>) of Integer; type Private_Constrained_Array (L : Positive) is array (1 .. 2) of Integer; -- NOTE: using an array type fails as well: -- -- type Private_Constrained_Array -- (L : Positive) is -- Integer_Array (1 .. L); end Private_Arrays;
Completing the private type with an unconstrained array type in the full view is not allowed because clients could expect, according to their view, to declare objects of the type. But doing so would not be allowed according to the full view. So this is another case of the partial view having to present clients with a sufficiently true view of the type's capabilities.
One solution is to rewrite the declaration of Private_Constrained_Array
using a record type:
package Private_Arrays is type Private_Constrained_Array (L : Positive) is private; private type Integer_Array is array (Positive range <>) of Integer; type Private_Constrained_Array (L : Positive) is record Arr : Integer_Array (1 .. 2); end record; end Private_Arrays;with Private_Arrays; use Private_Arrays; procedure Declare_Private_Array is Arr : Private_Constrained_Array (5); begin null; end Declare_Private_Array;
Now, the code compiles fine — but we had to use a record type in the full view to make it work.
Another solution is to make the private type indefinite. In this case, the client's partial view would be consistent with a completion as an indefinite type in the private part:
package Private_Arrays is type Private_Constrained_Array (<>) is private; function Init (L : Positive) return Private_Constrained_Array; private type Private_Constrained_Array is array (Positive range <>) of Integer; end Private_Arrays;package body Private_Arrays is function Init (L : Positive) return Private_Constrained_Array is PCA : Private_Constrained_Array (1 .. L); begin return PCA; end Init; end Private_Arrays;with Private_Arrays; use Private_Arrays; procedure Declare_Private_Array is Arr : Private_Constrained_Array := Init (5); begin null; end Declare_Private_Array;
The bounds for the object's declaration come from the required initial value
when an object is declared. In this case, we initialize the object with a call
to the Init
function.
Type conversion
An important operation when dealing with objects of different types is type
conversion, which we already discussed in the
Introduction to Ada course. In fact, we can
convert an object Obj_X
of an operand type X
to a similar,
closely related target type Y
by simply indicating the target type:
Y (Obj_X)
. In this section, we discuss type conversions for different
kinds of types.
Ada distinguishes between two kinds of conversion: value conversion and view conversion. The main difference is the way how the operand (argument) of the conversion is evaluated:
in a value conversion, the operand is evaluated as an expression;
in a view conversion, the operand is evaluated as a name.
In other words, we cannot use expressions such as 2 * A
in a view
conversion, but only A
. In a value conversion, we could use both forms.
In the Ada Reference Manual
Value conversion
Value conversions are possible for various types. In this section, we see some examples, starting with types derived from scalar types up to array conversions.
Root and derived types
Let's start with the conversion between a scalar type and its derived types.
For example, we can convert back-and-forth between the Integer
type and
the derived Int
type:
package Custom_Integers is type Int is new Integer with Dynamic_Predicate => Int /= 0; function Double (I : Integer) return Integer is (I * 2); end Custom_Integers;with Ada.Text_IO; use Ada.Text_IO; with Custom_Integers; use Custom_Integers; procedure Show_Conversion is Int_Var : Int := 1; Integer_Var : Integer := 2; begin -- Int to Integer conversion Integer_Var := Integer (Int_Var); Put_Line ("Integer_Var : " & Integer_Var'Image); -- Int to Integer conversion -- as an actual parameter Integer_Var := Double (Integer (Int_Var)); Put_Line ("Integer_Var : " & Integer_Var'Image); -- Integer to Int conversion -- using an expression Int_Var := Int (Integer_Var * 2); Put_Line ("Int_Var : " & Int_Var'Image); end Show_Conversion;
In the Show_Conversion
procedure from this example, we first convert
from Int
to Integer
. Then, we do the same conversion while
providing the resulting value as an actual parameter for the Double
function. Finally, we convert the Integer_Var * 2
expression from
Integer
to Int
.
Note that the converted value must conform to any constraints that the target
type might have. In the example above, Int
has a predicate that dictates
that its value cannot be zero. This (dynamic) predicate is checked at runtime,
so an exception is raised if it fails:
with Ada.Text_IO; use Ada.Text_IO; with Custom_Integers; use Custom_Integers; procedure Show_Conversion is Int_Var : Int; Integer_Var : Integer; begin Integer_Var := 0; Int_Var := Int (Integer_Var); Put_Line ("Int_Var : " & Int_Var'Image); end Show_Conversion;
In this case, the conversion from Integer
to Int
fails because,
while zero is a valid integer value, it doesn't obey Int
's predicate.
Numeric type conversion
A typical conversion is the one between integer and floating-point values. For example:
with Ada.Text_IO; use Ada.Text_IO; procedure Show_Conversion is F : Float := 1.0; I : Integer := 2; begin I := Integer (F); Put_Line ("I : " & I'Image); I := 4; F := Float (I); Put_Line ("F : " & F'Image); end Show_Conversion;