source: trunk/ada-2012/src/semantic/gela-property_getters.adb@ 552

Last change on this file since 552 was 512, checked in by Maxim Reznik, 5 years ago

Separate Property_Reset and Property_Getter

from Gela.Instantiation to their-own packages.

File size: 7.2 KB
Line 
1package body Gela.Property_Getters is
2
3 --------------
4 -- On_Index --
5 --------------
6
7 overriding procedure On_Index
8 (Self : in out Getter;
9 Element : Gela.Elements.Element_Access;
10 Value : Gela.Lexical_Types.Token_Count)
11 is
12 pragma Unreferenced (Element);
13 begin
14 Self.Index := Value;
15 end On_Index;
16
17 ---------------
18 -- On_Env_In --
19 ---------------
20
21 overriding procedure On_Env_In
22 (Self : in out Getter;
23 Element : Gela.Elements.Element_Access;
24 Value : Gela.Semantic_Types.Env_Index)
25 is
26 pragma Unreferenced (Element);
27 begin
28 Self.Env_In := Value;
29 end On_Env_In;
30
31 ----------------
32 -- On_Env_Out --
33 ----------------
34
35 overriding procedure On_Env_Out
36 (Self : in out Getter;
37 Element : Gela.Elements.Element_Access;
38 Value : Gela.Semantic_Types.Env_Index)
39 is
40 pragma Unreferenced (Element);
41 begin
42 Self.Env_Out := Value;
43 end On_Env_Out;
44
45 -------------
46 -- On_Down --
47 -------------
48
49 overriding procedure On_Down
50 (Self : in out Getter;
51 Element : Gela.Elements.Element_Access;
52 Value : Gela.Interpretations.Interpretation_Index)
53 is
54 pragma Unreferenced (Element);
55 begin
56 Self.Down := Value;
57 end On_Down;
58
59 ---------------
60 -- On_Errors --
61 ---------------
62
63 overriding procedure On_Errors
64 (Self : in out Getter;
65 Element : Gela.Elements.Element_Access;
66 Value : Gela.Semantic_Types.Error_Set_Index)
67 is
68 pragma Unreferenced (Element);
69 begin
70 Self.Errors := Value;
71 end On_Errors;
72
73 -----------
74 -- On_Up --
75 -----------
76
77 overriding procedure On_Up
78 (Self : in out Getter;
79 Element : Gela.Elements.Element_Access;
80 Value : Gela.Interpretations.Interpretation_Tuple_Index)
81 is
82 pragma Unreferenced (Element);
83 begin
84 Self.Up_Tuple := Value;
85 end On_Up;
86
87 -----------
88 -- On_Up --
89 -----------
90
91 overriding procedure On_Up
92 (Self : in out Getter;
93 Element : Gela.Elements.Element_Access;
94 Value : Gela.Interpretations.Interpretation_Tuple_List_Index)
95 is
96 pragma Unreferenced (Element);
97 begin
98 Self.Up_Tuple_List := Value;
99 end On_Up;
100
101 ------------------
102 -- On_Name_List --
103 ------------------
104
105 overriding procedure On_Name_List
106 (Self : in out Getter;
107 Element : Gela.Elements.Element_Access;
108 Value : Gela.Lexical_Types.Symbol_List)
109 is
110 pragma Unreferenced (Element);
111 begin
112 Self.Name_List := Value;
113 end On_Name_List;
114
115 --------------------------
116 -- On_Limited_With_List --
117 --------------------------
118
119 overriding procedure On_Limited_With_List
120 (Self : in out Getter;
121 Element : Gela.Elements.Element_Access;
122 Value : Gela.Lexical_Types.Symbol_List)
123 is
124 pragma Unreferenced (Element);
125 begin
126 Self.Limited_With_List := Value;
127 end On_Limited_With_List;
128
129 ------------------
130 -- On_With_List --
131 ------------------
132
133 overriding procedure On_With_List
134 (Self : in out Getter;
135 Element : Gela.Elements.Element_Access;
136 Value : Gela.Lexical_Types.Symbol_List)
137 is
138 pragma Unreferenced (Element);
139 begin
140 Self.With_List := Value;
141 end On_With_List;
142
143 -----------
144 -- On_Up --
145 -----------
146
147 overriding procedure On_Up
148 (Self : in out Getter;
149 Element : Gela.Elements.Element_Access;
150 Value : Gela.Interpretations.Interpretation_Set_Index)
151 is
152 pragma Unreferenced (Element);
153 begin
154 Self.Up_Set := Value;
155 end On_Up;
156
157 ---------------------
158 -- On_Static_Value --
159 ---------------------
160
161 overriding procedure On_Static_Value
162 (Self : in out Getter;
163 Element : Gela.Elements.Element_Access;
164 Value : Gela.Semantic_Types.Value_Index)
165 is
166 pragma Unreferenced (Element);
167 begin
168 Self.Static_Value := Value;
169 end On_Static_Value;
170
171 ------------------------------
172 -- On_Chosen_Interpretation --
173 ------------------------------
174
175 overriding procedure On_Chosen_Interpretation
176 (Self : in out Getter;
177 Element : Gela.Elements.Element_Access;
178 Value : Gela.Interpretations.Interpretation_Kinds)
179 is
180 pragma Unreferenced (Element);
181 begin
182 Self.Chosen_Interpretation := Value;
183 end On_Chosen_Interpretation;
184
185 ----------------------
186 -- On_Defining_Name --
187 ----------------------
188
189 overriding procedure On_Defining_Name
190 (Self : in out Getter;
191 Element : Gela.Elements.Element_Access;
192 Value : Gela.Elements.Defining_Names.Defining_Name_Access)
193 is
194 pragma Unreferenced (Element);
195 begin
196 Self.Defining_Name := Value;
197 end On_Defining_Name;
198
199 ------------------
200 -- On_Full_Name --
201 ------------------
202
203 overriding procedure On_Full_Name
204 (Self : in out Getter;
205 Element : Gela.Elements.Element_Access;
206 Value : Gela.Lexical_Types.Symbol)
207 is
208 pragma Unreferenced (Element);
209 begin
210 Self.Full_Name := Value;
211 end On_Full_Name;
212
213 ---------------------------
214 -- On_Declarative_Region --
215 ---------------------------
216
217 overriding procedure On_Declarative_Region
218 (Self : in out Getter;
219 Element : Gela.Elements.Element_Access;
220 Value : Gela.Semantic_Types.Env_Index)
221 is
222 pragma Unreferenced (Element);
223 begin
224 Self.Declarative_Region := Value;
225 end On_Declarative_Region;
226
227 --------------------------------------
228 -- On_Corresponding_Generic_Element --
229 --------------------------------------
230
231 overriding procedure On_Corresponding_Generic_Element
232 (Self : in out Getter;
233 Element : Gela.Elements.Element_Access;
234 Value : Gela.Elements.Element_Access)
235 is
236 pragma Unreferenced (Element);
237 begin
238 Self.Corresponding_Generic_Element := Value;
239 end On_Corresponding_Generic_Element;
240
241 ---------------------------
242 -- On_Corresponding_View --
243 ---------------------------
244
245 overriding procedure On_Corresponding_View
246 (Self : in out Getter;
247 Element : Gela.Elements.Element_Access;
248 Value : Gela.Elements.Element_Access)
249 is
250 pragma Unreferenced (Element);
251 begin
252 Self.Corresponding_View := Value;
253 end On_Corresponding_View;
254
255 -------------------
256 -- On_Type_Index --
257 -------------------
258
259 overriding procedure On_Type_Index
260 (Self : in out Getter;
261 Element : Gela.Elements.Element_Access;
262 Value : Gela.Semantic_Types.Type_Index)
263 is
264 pragma Unreferenced (Element);
265 begin
266 Self.Type_Index := Value;
267 end On_Type_Index;
268
269 ---------------------------
270 -- On_Corresponding_Type --
271 ---------------------------
272
273 overriding procedure On_Corresponding_Type
274 (Self : in out Getter;
275 Element : Gela.Elements.Element_Access;
276 Value : Gela.Elements.Element_Access)
277 is
278 pragma Unreferenced (Element);
279 begin
280 Self.Corresponding_Type := Value;
281 end On_Corresponding_Type;
282
283 -----------------
284 -- On_Expanded --
285 -----------------
286
287 overriding procedure On_Expanded
288 (Self : in out Getter;
289 Element : Gela.Elements.Element_Access;
290 Value : Gela.Elements.Element_Access)
291 is
292 pragma Unreferenced (Element);
293 begin
294 Self.Expanded := Value;
295 end On_Expanded;
296
297end Gela.Property_Getters;
Note: See TracBrowser for help on using the repository browser.