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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
-- Public License for more details. You should have received a copy of the GNU
-- General Public License distributed with the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================
with SLI;
separate (Sem)
procedure Wf_Array_Type_Definition
(Node : in STree.SyntaxNode;
Scope : in Dictionary.Scopes;
Ident_Node : in STree.SyntaxNode;
Dec_Loc : in LexTokenManager.Token_Position;
The_Array : out Dictionary.Symbol)
is
Root_Node, Type_Node, Next_Node : STree.SyntaxNode;
It : STree.Iterator;
Constrained : Boolean;
Type_Sym, The_Array_Index : Dictionary.Symbol;
Type_Pos : LexTokenManager.Token_Position;
begin
Root_Node := Child_Node (Current_Node => Node);
-- ASSUME Root_Node = unconstrained_array_definition OR constrained_array_definition
SystemErrors.RT_Assert
(C => Syntax_Node_Type (Node => Root_Node) = SP_Symbols.unconstrained_array_definition
or else Syntax_Node_Type (Node => Root_Node) = SP_Symbols.constrained_array_definition,
Sys_Err => SystemErrors.Invalid_Syntax_Tree,
Msg => "Expect Root_Node = unconstrained_array_definition OR constrained_array_definition in Wf_Array_Type_Definition");
Constrained := Syntax_Node_Type (Node => Root_Node) = SP_Symbols.constrained_array_definition;
Root_Node := Child_Node (Current_Node => Root_Node);
-- ASSUME Root_Node = unconstrained_array_definition_rep OR index_constraint
SystemErrors.RT_Assert
(C => Syntax_Node_Type (Node => Root_Node) = SP_Symbols.unconstrained_array_definition_rep
or else Syntax_Node_Type (Node => Root_Node) = SP_Symbols.index_constraint,
Sys_Err => SystemErrors.Invalid_Syntax_Tree,
Msg => "Expect Root_Node = unconstrained_array_definition_rep OR index_constraint in Wf_Array_Type_Definition");
Type_Node := Next_Sibling (Current_Node => Root_Node);
-- ASSUME Type_Node = type_mark
SystemErrors.RT_Assert
(C => Syntax_Node_Type (Node => Type_Node) = SP_Symbols.type_mark,
Sys_Err => SystemErrors.Invalid_Syntax_Tree,
Msg => "Expect Type_Node = type_mark in Wf_Array_Type_Definition");
Type_Pos := Node_Position (Node => Type_Node);
The_Array := Dictionary.GetUnknownTypeMark; -- default answer in case of errors
Wf_Type_Mark (Node => Type_Node,
Current_Scope => Scope,
Context => Dictionary.ProgramContext,
Type_Sym => Type_Sym);
if Dictionary.Is_Unconstrained_Array_Type_Mark (Type_Sym, Scope) then
ErrorHandler.Semantic_Error
(Err_Num => 39,
Reference => ErrorHandler.No_Reference,
Position => Node_Position (Node => Type_Node),
Id_Str => LexTokenManager.Null_String);
end if;
-- Check that the type is not a suspension object or protected type
if Dictionary.IsPredefinedSuspensionObjectType (Type_Sym) or else Dictionary.IsProtectedTypeMark (Type_Sym) then
ErrorHandler.Semantic_Error
(Err_Num => 906,
Reference => ErrorHandler.No_Reference,
Position => Node_Position (Node => Type_Node),
Id_Str => LexTokenManager.Null_String);
else
Dictionary.Add_Array_Type
(Name => Node_Lex_String (Node => Ident_Node),
Comp_Unit => ContextManager.Ops.Current_Unit,
Declaration => Dictionary.Location'(Start_Position => Dec_Loc,
End_Position => Dec_Loc),
Scope => Scope,
Context => Dictionary.ProgramContext,
Constrained => Constrained,
Component_Type => Type_Sym,
Component_Type_Reference => Dictionary.Location'(Start_Position => Type_Pos,
End_Position => Type_Pos),
The_Type => The_Array);
STree.Add_Node_Symbol (Node => Ident_Node,
Sym => The_Array);
if ErrorHandler.Generate_SLI then
SLI.Generate_Xref_Symbol
(Comp_Unit => ContextManager.Ops.Current_Unit,
Parse_Tree => Ident_Node,
Symbol => The_Array,
Is_Declaration => True);
end if;
-- now loop through all the index type marks
It := Find_First_Node (Node_Kind => SP_Symbols.type_mark,
From_Root => Root_Node,
In_Direction => STree.Down);
while not STree.IsNull (It) loop
Next_Node := Get_Node (It => It);
--# assert STree.Table = STree.Table~ and
--# Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.type_mark and
--# Next_Node = Get_Node (It);
Wf_Type_Mark (Node => Next_Node,
Current_Scope => Scope,
Context => Dictionary.ProgramContext,
Type_Sym => Type_Sym);
if not Dictionary.IsUnknownTypeMark (Type_Sym) then
if Dictionary.Types_Are_Equal (Left_Symbol => Type_Sym,
Right_Symbol => The_Array,
Full_Range_Subtype => False) then
-- Type of index is same as type of array being declared
ErrorHandler.Semantic_Error
(Err_Num => 750,
Reference => ErrorHandler.No_Reference,
Position => Node_Position (Node => Next_Node),
Id_Str => Dictionary.GetSimpleName (Type_Sym));
else -- no self-reference attempted
if not Dictionary.IsDiscreteTypeMark (Type_Sym, Scope) then
ErrorHandler.Semantic_Error
(Err_Num => 46,
Reference => ErrorHandler.No_Reference,
Position => Node_Position (Node => Next_Node),
Id_Str => LexTokenManager.Null_String);
end if;
if not Dictionary.TypeIsWellformed (Type_Sym) then
ErrorHandler.Semantic_Error
(Err_Num => 47,
Reference => 1,
Position => Node_Position (Node => Next_Node),
Id_Str => LexTokenManager.Null_String);
end if;
end if;
end if;
Dictionary.AddArrayIndex
(TheArrayType => The_Array,
IndexType => Type_Sym,
Comp_Unit => ContextManager.Ops.Current_Unit,
Declaration => Dictionary.Location'(Start_Position => Node_Position (Node => Next_Node),
End_Position => Node_Position (Node => Next_Node)),
TheArrayIndex => The_Array_Index);
STree.Add_Node_Symbol (Node => Next_Node,
Sym => The_Array_Index);
It := STree.NextNode (It);
end loop;
end if;
end Wf_Array_Type_Definition;
|
