1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
with Ada.Text_IO; use Ada.Text_IO;
procedure Types is
-----------------------------------------------------------------------------
-- Record initialization.
-----------------------------------------------------------------------------
procedure Test_Point is
type Point is record
X : Integer := 0;
Y : Integer := 0;
end record;
Origin_1 : Point; -- Default initialization.
Origin_2 : Point := (0, 0); -- Explicit, unnamed.
Origin_3 : Point := (X => 0, Y => 0); -- Explicit, named.
Origin_4 : Point := (X => <>, Y => <>); -- Explicit, using defaults.
Origin_5 : Point := (X | Y => 0); -- Initialize both values.
Origin_6 : Point := Point'(0,0); -- Qualified expression.
begin
Put_Line ("Origin: " & Integer'Image (Origin_5.X) & ", "
& Integer'Image (Origin_5.Y));
end Test_Point;
-----------------------------------------------------------------------------
-- Pointers.
-----------------------------------------------------------------------------
procedure Test_Pointer is
type Month_Type is (Jan, Feb, Mar, Apr, May, Jun,
Jul, Aug, Sep, Oct, Nov, Dec);
type Date is record
Day : Integer range 1 .. 31;
Month : Month_Type;
Year : Integer;
end record;
-- Access types are nominally typed, not structurally typed.
-- If we "own" a type X, we typically also declare an access type named
-- X_Acc, so that there is a canonical name for the access type to X.
type Date_Acc is access Date; -- Pointer to Date type.
type Different_Date_Acc is access Date; -- Different type.
Null_Date : Date_Acc := null;
-- Allocate values of the access type using the 'new' keyword.
D : Date_Acc := new Date;
-- Constraints can be given when instantiating the type.
Buffer : access String := new String(1 .. 5);
-- We can also initialize along with the allocation.
Hello_Str : access String := new String'("Hello");
procedure Test_Null (D : Date_Acc; Name : String) is
begin
-- Dereferencing of D happens implicitly. Here we can treat D as an
-- actual Date.
if D = null then
Put_Line (Name & " is null");
else
Put_Line (Name & " is not null");
end if;
end Test_Null;
begin
Test_Null (Null_Date, "Null_Date");
Test_Null (D, "D");
end Test_Pointer;
-----------------------------------------------------------------------------
-- Mutually recursive types.
--
-- Similar to C++, we can forward-declare a type to break the loop.
-----------------------------------------------------------------------------
procedure Test_MyList is
type MyList;
type MyList_Acc is access MyList;
type MyList is record
Value : Integer := 0;
Next : MyList_Acc := null;
end record;
function Cons (X : Integer; L : MyList_Acc) return MyList_Acc is
Head : MyList_Acc := new MyList;
begin
Head.Value := X;
Head.Next := L;
return Head;
end Cons;
procedure Print_List (L : access constant MyList) is
Node : access constant MyList := L;
begin
Put ("[");
while Node /= null loop
Put (Integer'Image (Node.Value) & " ");
Node := Node.next;
end loop;
Put_Line ("]");
end Print_List;
InitialList : MyList_Acc := new MyList'(4, null);
ModifiedList : MyList_Acc;
begin
ModifiedList := Cons (1, Cons (2, Cons (3, InitialList)));
Print_List (ModifiedList);
end Test_MyList;
begin
Test_Point;
Test_Pointer;
Test_MyList;
end Types;
|
