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
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
|
-------------------------------------------------------------------------------
-- (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 LexTokenStacks;
separate (Dictionary)
function GenerateSimpleName (Item : Symbol;
Separator : String) return E_Strings.T is
Name : E_Strings.T;
--------------------------------------------------------------------------------
-- Each protected own variable has an associated implicit in stream which is used for
-- volatile flow analysis of shared protected state. The names of these should never
-- apepar in Examienr output; however, if they are needed for diagnostic reasons they
-- can be constructed by this function. For a stream associated with P we return P__in.
function Get_Implicit_Protected_In_Stream_Name
(The_Implicit_In_Stream : RawDict.Implicit_In_Stream_Info_Ref)
return E_Strings.T
--# global in Dict;
--# in LexTokenManager.State;
is
Name : E_Strings.T;
begin
Name :=
LexTokenManager.Lex_String_To_String
(Lex_Str => RawDict.Get_Variable_Name
(The_Variable => Get_Own_Variable_Of_Protected_Implicit_In_Stream (The_Implicit_In_Stream => The_Implicit_In_Stream)));
E_Strings.Append_String (E_Str => Name,
Str => "__in");
return Name;
end Get_Implicit_Protected_In_Stream_Name;
--------------------------------------------------------------------------------
function Get_Loop_Name (The_Loop : Symbol) return E_Strings.T
--# global in Dict;
--# in LexTokenManager.State;
is
Name : E_Strings.T;
function Get_Loop_Number (The_Loop : Symbol) return Positive
--# global in Dict;
is
Loops : Iterator;
Number : Positive;
begin
Loops :=
First_Loop
(CompilationUnit => GetEnclosingCompilationUnit (Set_Visibility (The_Visibility => Local,
The_Unit => The_Loop)));
Number := 1;
while CurrentSymbol (Loops) /= The_Loop and then Number < Positive'Last loop
Loops := NextSymbol (Loops);
Number := Number + 1;
end loop;
return Number;
end Get_Loop_Number;
--------------------------------------------------------------------------------
function Image (Number : Positive) return E_Strings.T is
--# hide Image;
Signed_Image : constant String := Positive'Image (Number);
begin
return E_Strings.Copy_String (Str => Signed_Image (2 .. Signed_Image'Length));
end Image;
begin -- Get_Loop_Name
if LoopHasName (The_Loop) then
Name := LexTokenManager.Lex_String_To_String (Lex_Str => GetSimpleName (Item => The_Loop));
else
Name := E_Strings.Copy_String (Str => "LOOP__");
E_Strings.Append_Examiner_String (E_Str1 => Name,
E_Str2 => Image (Number => Get_Loop_Number (The_Loop => The_Loop)));
end if;
return Name;
end Get_Loop_Name;
--------------------------------------------------------------------------------
function Get_Package_Name (The_Package : RawDict.Package_Info_Ref;
Separator : String) return E_Strings.T
--# global in Dict;
--# in LexTokenManager.State;
is
Package_Local : RawDict.Package_Info_Ref;
Current_Token : LexTokenManager.Lex_String;
Stack : LexTokenStacks.Stacks;
Name : E_Strings.T;
begin
Name := E_Strings.Empty_String;
Package_Local := The_Package;
LexTokenStacks.Clear (Stack);
while Package_Local /= RawDict.Null_Package_Info_Ref loop
LexTokenStacks.Push (Stack, RawDict.Get_Package_Name (The_Package => Package_Local));
Package_Local := RawDict.Get_Package_Parent (The_Package => Package_Local);
end loop;
loop
LexTokenStacks.Pop (Stack, Current_Token);
E_Strings.Append_Examiner_String
(E_Str1 => Name,
E_Str2 => LexTokenManager.Lex_String_To_String (Lex_Str => Current_Token));
exit when LexTokenStacks.IsEmpty (Stack);
E_Strings.Append_String (E_Str => Name,
Str => Separator);
end loop;
return Name;
end Get_Package_Name;
--------------------------------------------------------------------------------
function Get_Record_Variable_Name (The_Record : RawDict.Subcomponent_Info_Ref;
Separator : String) return E_Strings.T
--# global in Dict;
--# in LexTokenManager.State;
is
Record_Local : Symbol;
Current_Token : LexTokenManager.Lex_String;
Stack : LexTokenStacks.Stacks;
Name : E_Strings.T;
begin
Name := E_Strings.Empty_String;
Record_Local := RawDict.Get_Subcomponent_Symbol (The_Record);
LexTokenStacks.Clear (Stack);
loop
-- we want to ignore any inherited fields for name generation purposes
if RawDict.GetSymbolDiscriminant (Record_Local) /= Subcomponent_Symbol
or else not RawDict.Get_Record_Component_Inherited_Field
(The_Record_Component => RawDict.Get_Subcomponent_Record_Component
(The_Subcomponent => RawDict.Get_Subcomponent_Info_Ref (Item => Record_Local))) then
LexTokenStacks.Push (Stack, GetSimpleName (Record_Local));
end if;
exit when RawDict.GetSymbolDiscriminant (Record_Local) /= Subcomponent_Symbol; -- entire record var
Record_Local :=
RawDict.Get_Subcomponent_Object (The_Subcomponent => RawDict.Get_Subcomponent_Info_Ref (Item => Record_Local));
end loop;
loop
LexTokenStacks.Pop (Stack, Current_Token);
E_Strings.Append_Examiner_String
(E_Str1 => Name,
E_Str2 => LexTokenManager.Lex_String_To_String (Lex_Str => Current_Token));
exit when LexTokenStacks.IsEmpty (Stack);
E_Strings.Append_String (E_Str => Name,
Str => Separator);
end loop;
return Name;
end Get_Record_Variable_Name;
--------------------------------------------------------------------------------
function Get_Loop_Entry_Variable_Name (The_Loop_Entry_Var : Symbol) return E_Strings.T
--# global in Dict;
--# in LexTokenManager.State;
is
Result : E_Strings.T;
Loop_Name : E_Strings.T;
begin
-- Loop on entry variable names are constructed from the original variable name
-- and the associated loop name
Result := LexTokenManager.Lex_String_To_String (Lex_Str => GetSimpleName (Item => The_Loop_Entry_Var));
Loop_Name := Get_Loop_Name (The_Loop => RawDict.GetLoopEntryVariableTheLoop (The_Loop_Entry_Var));
E_Strings.Append_String (E_Str => Result,
Str => "__entry__");
E_Strings.Append_Examiner_String (E_Str1 => Result,
E_Str2 => Loop_Name);
return Result;
end Get_Loop_Entry_Variable_Name;
--------------------------------------------------------------------------------
function Get_Parameter_Constraint_Name (The_Parameter_Constraint : RawDict.Parameter_Constraint_Info_Ref) return E_Strings.T
--# global in Dict;
--# in LexTokenManager.State;
is
Name : E_Strings.T;
begin
Name :=
LexTokenManager.Lex_String_To_String
(Lex_Str => Get_Parameter_Constraint_Simple_Name (The_Parameter_Constraint => The_Parameter_Constraint));
-- above line will return the name of the formal parameter associated with the constraint
E_Strings.Append_String (E_Str => Name,
Str => "__index__subtype__");
E_Strings.Append_Examiner_String
(E_Str1 => Name,
E_Str2 => Maths.ValueToString
(Num => Maths.IntegerToValue
(I => RawDict.Get_Parameter_Constraint_Dimension (The_Parameter_Constraint => The_Parameter_Constraint))));
return Name;
end Get_Parameter_Constraint_Name;
begin -- GenerateSimpleName
case RawDict.GetSymbolDiscriminant (Item) is
when LoopSymbol =>
Name := Get_Loop_Name (The_Loop => Item);
when Package_Symbol =>
Name := Get_Package_Name (The_Package => RawDict.Get_Package_Info_Ref (Item => Item),
Separator => Separator);
when Subcomponent_Symbol =>
Name :=
Get_Record_Variable_Name (The_Record => RawDict.Get_Subcomponent_Info_Ref (Item => Item),
Separator => Separator);
when Implicit_In_Stream_Symbol =>
Name :=
Get_Implicit_Protected_In_Stream_Name
(The_Implicit_In_Stream => RawDict.Get_Implicit_In_Stream_Info_Ref (Item => Item));
when LoopEntryVariableSymbol =>
Name := Get_Loop_Entry_Variable_Name (The_Loop_Entry_Var => Item);
when Parameter_Constraint_Symbol =>
Name :=
Get_Parameter_Constraint_Name (The_Parameter_Constraint => RawDict.Get_Parameter_Constraint_Info_Ref (Item => Item));
when Type_Symbol =>
Name := Fetch_Simple_Name (Type_Mark => RawDict.Get_Type_Info_Ref (Item => Item));
when others =>
Name := LexTokenManager.Lex_String_To_String (Lex_Str => GetSimpleName (Item => Item));
end case;
return Name;
end GenerateSimpleName;
|
