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

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

Drop Cursor and Visiter for up interpretation set.

Replace it with Any_Cursor and iterator.

File size: 11.5 KB
Line 
1with Gela.Int.Attr_Functions;
2with Gela.Int.Categories;
3with Gela.Int.Defining_Names;
4with Gela.Int.Expressions;
5with Gela.Int.Symbols;
6
7package body Gela.Plain_Int_Sets.Cursors is
8
9 generic
10 type T is new Gela.Int.Interpretation with private;
11 procedure Step (Self : in out Base_Cursor'Class);
12
13 -----------------------
14 -- Generic_Iterators --
15 -----------------------
16
17 package body Generic_Iterators is
18
19 overriding function First (Self : Iterator) return Cursor'Class is
20 begin
21 return Self.Cursor;
22 end First;
23
24 overriding function Next
25 (Self : Iterator;
26 Position : Cursor'Class) return Cursor'Class
27 is
28 pragma Unreferenced (Self);
29 begin
30 return Result : Cursor'Class := Position do
31 Result.Next;
32 end return;
33 end Next;
34
35 end Generic_Iterators;
36
37 ----------
38 -- Step --
39 ----------
40
41 procedure Step (Self : in out Base_Cursor'Class) is
42 begin
43 while Int_Lists.Has_Element (Self.Pos) loop
44
45 exit when Int_Lists.Element (Self.Pos).all in T;
46
47 Int_Lists.Next (Self.Pos);
48 end loop;
49 end Step;
50
51 procedure Category_Step is new Step (Gela.Int.Categories.Category);
52 procedure Defining_Name_Step is
53 new Step (Gela.Int.Defining_Names.Defining_Name);
54 procedure Expression_Step is new Step (Gela.Int.Expressions.Expression);
55 procedure Symbol_Step is new Step (Gela.Int.Symbols.Symbol);
56 procedure Profile_Step is new Step (Gela.Int.Attr_Functions.Attr_Function);
57
58 --------------------
59 -- Attribute_Kind --
60 --------------------
61
62 overriding function Attribute_Kind
63 (Self : Profile_Cursor)
64 return Gela.Lexical_Types.Predefined_Symbols.Attribute
65 is
66 Item : constant Gela.Int.Interpretation_Access :=
67 Int_Lists.Element (Self.Pos);
68 begin
69 return Gela.Int.Attr_Functions.Attr_Function (Item.all).Kind;
70 end Attribute_Kind;
71
72 --------------------
73 -- Attribute_Kind --
74 --------------------
75
76 overriding function Attribute_Kind (Self : Any_Cursor)
77 return Gela.Lexical_Types.Predefined_Symbols.Attribute
78 is
79 Item : constant Gela.Int.Interpretation_Access :=
80 Int_Lists.Element (Self.Pos);
81 begin
82 return Gela.Int.Attr_Functions.Attr_Function (Item.all).Kind;
83 end Attribute_Kind;
84
85 ------------------------
86 -- Corresponding_Type --
87 ------------------------
88
89 overriding function Corresponding_Type
90 (Self : Profile_Cursor)
91 return Gela.Semantic_Types.Type_Index
92 is
93 Item : constant Gela.Int.Interpretation_Access :=
94 Int_Lists.Element (Self.Pos);
95 begin
96 return Gela.Int.Attr_Functions.Attr_Function (Item.all).Tipe;
97 end Corresponding_Type;
98
99 ------------------------
100 -- Corresponding_Type --
101 ------------------------
102
103 overriding function Corresponding_Type (Self : Any_Cursor)
104 return Gela.Semantic_Types.Type_Index
105 is
106 Item : constant Gela.Int.Interpretation_Access :=
107 Int_Lists.Element (Self.Pos);
108 begin
109 return Gela.Int.Attr_Functions.Attr_Function (Item.all).Tipe;
110 end Corresponding_Type;
111
112 -------------------
113 -- Defining_Name --
114 -------------------
115
116 overriding function Defining_Name
117 (Self : Defining_Name_Cursor)
118 return Gela.Elements.Defining_Names.Defining_Name_Access
119 is
120 Item : constant Gela.Int.Interpretation_Access :=
121 Int_Lists.Element (Self.Pos);
122 begin
123 return Gela.Int.Defining_Names.Defining_Name (Item.all).Name;
124 end Defining_Name;
125
126 -------------------
127 -- Defining_Name --
128 -------------------
129
130 overriding function Defining_Name (Self : Any_Cursor)
131 return Gela.Elements.Defining_Names.Defining_Name_Access
132 is
133 Item : constant Gela.Int.Interpretation_Access :=
134 Int_Lists.Element (Self.Pos);
135 begin
136 return Gela.Int.Defining_Names.Defining_Name (Item.all).Name;
137 end Defining_Name;
138
139 ---------------------
140 -- Expression_Type --
141 ---------------------
142
143 overriding function Expression_Type
144 (Self : Expression_Cursor)
145 return Gela.Semantic_Types.Type_Index
146 is
147 Item : constant Gela.Int.Interpretation_Access :=
148 Int_Lists.Element (Self.Pos);
149 begin
150 return Gela.Int.Expressions.Expression (Item.all).Expression_Type;
151 end Expression_Type;
152
153 ---------------------
154 -- Expression_Type --
155 ---------------------
156
157 overriding function Expression_Type (Self : Any_Cursor)
158 return Gela.Semantic_Types.Type_Index
159 is
160 Item : constant Gela.Int.Interpretation_Access :=
161 Int_Lists.Element (Self.Pos);
162 begin
163 return Gela.Int.Expressions.Expression (Item.all).Expression_Type;
164 end Expression_Type;
165
166 ---------------
167 -- Get_Index --
168 ---------------
169
170 overriding function Get_Index
171 (Self : Base_Cursor)
172 return Gela.Interpretations.Interpretation_Index
173 is
174 use type Gela.Interpretations.Interpretation_Index;
175
176 Item : constant Gela.Int.Interpretation_Access :=
177 Int_Lists.Element (Self.Pos);
178 Result : Gela.Interpretations.Interpretation_Index;
179 begin
180 if Item.Index /= 0 then
181 return Item.Index;
182 end if;
183
184 Self.Set.Add (Result, Item);
185
186 return Result;
187 end Get_Index;
188
189 -----------------
190 -- Has_Element --
191 -----------------
192
193 overriding function Has_Element (Self : Base_Cursor) return Boolean is
194 begin
195 return Int_Lists.Has_Element (Self.Pos);
196 end Has_Element;
197
198 ----------------
199 -- Initialize --
200 ----------------
201
202 not overriding procedure Initialize
203 (Self : out Category_Cursor;
204 Set : access Interpretation_Set;
205 Index : Gela.Interpretations.Interpretation_Set_Index) is
206 begin
207 Self := (Set, Set.Map (Index).First);
208 Category_Step (Self);
209 end Initialize;
210
211 ----------------
212 -- Initialize --
213 ----------------
214
215 not overriding procedure Initialize
216 (Self : out Defining_Name_Cursor;
217 Set : access Interpretation_Set;
218 Index : Gela.Interpretations.Interpretation_Set_Index) is
219 begin
220 Self := (Set, Set.Map (Index).First);
221 Defining_Name_Step (Self);
222 end Initialize;
223
224 ----------------
225 -- Initialize --
226 ----------------
227
228 not overriding procedure Initialize
229 (Self : out Expression_Cursor;
230 Set : access Interpretation_Set;
231 Index : Gela.Interpretations.Interpretation_Set_Index) is
232 begin
233 Self := (Set, Set.Map (Index).First);
234 Expression_Step (Self);
235 end Initialize;
236
237 ----------------
238 -- Initialize --
239 ----------------
240
241 not overriding procedure Initialize
242 (Self : out Profile_Cursor;
243 Set : access Interpretation_Set;
244 Index : Gela.Interpretations.Interpretation_Set_Index) is
245 begin
246 Self := (Set, Set.Map (Index).First);
247 Profile_Step (Self);
248 end Initialize;
249
250 ----------------
251 -- Initialize --
252 ----------------
253
254 not overriding procedure Initialize
255 (Self : out Symbol_Cursor;
256 Set : access Interpretation_Set;
257 Index : Gela.Interpretations.Interpretation_Set_Index) is
258 begin
259 Self := (Set, Set.Map (Index).First);
260 Symbol_Step (Self);
261 end Initialize;
262
263 ----------------
264 -- Initialize --
265 ----------------
266
267 not overriding procedure Initialize
268 (Self : out Any_Cursor;
269 Set : access Interpretation_Set;
270 Index : Gela.Interpretations.Interpretation_Set_Index) is
271 begin
272 Self := (Set, Set.Map (Index).First);
273 end Initialize;
274
275 ----------------------
276 -- Is_Defining_Name --
277 ----------------------
278
279 overriding function Is_Defining_Name (Self : Any_Cursor) return Boolean is
280 Item : constant Gela.Int.Interpretation_Access :=
281 Int_Lists.Element (Self.Pos);
282 begin
283 return Item.all in Gela.Int.Defining_Names.Defining_Name'Class;
284 end Is_Defining_Name;
285
286 -------------------
287 -- Is_Expression --
288 -------------------
289
290 overriding function Is_Expression (Self : Any_Cursor) return Boolean is
291 Item : constant Gela.Int.Interpretation_Access :=
292 Int_Lists.Element (Self.Pos);
293 begin
294 return Item.all in Gela.Int.Expressions.Expression'Class;
295 end Is_Expression;
296
297 ----------------------------
298 -- Is_Expression_Category --
299 ----------------------------
300
301 overriding function Is_Expression_Category
302 (Self : Any_Cursor) return Boolean
303 is
304 Item : constant Gela.Int.Interpretation_Access :=
305 Int_Lists.Element (Self.Pos);
306 begin
307 return Item.all in Gela.Int.Categories.Category'Class;
308 end Is_Expression_Category;
309
310 ----------------
311 -- Is_Profile --
312 ----------------
313
314 overriding function Is_Profile (Self : Any_Cursor) return Boolean is
315 Item : constant Gela.Int.Interpretation_Access :=
316 Int_Lists.Element (Self.Pos);
317 begin
318 return Item.all in Gela.Int.Attr_Functions.Attr_Function'Class;
319 end Is_Profile;
320
321 ---------------
322 -- Is_Symbol --
323 ---------------
324
325 overriding function Is_Symbol (Self : Any_Cursor) return Boolean is
326 Item : constant Gela.Int.Interpretation_Access :=
327 Int_Lists.Element (Self.Pos);
328 begin
329 return Item.all in Gela.Int.Symbols.Symbol'Class;
330 end Is_Symbol;
331
332 -------------
333 -- Matcher --
334 -------------
335
336 overriding function Matcher
337 (Self : Category_Cursor)
338 return Gela.Interpretations.Type_Matcher_Access
339 is
340 Item : constant Gela.Int.Interpretation_Access :=
341 Int_Lists.Element (Self.Pos);
342 begin
343 return Gela.Int.Categories.Category (Item.all).Match;
344 end Matcher;
345
346 -------------
347 -- Matcher --
348 -------------
349
350 overriding function Matcher (Self : Any_Cursor)
351 return Gela.Interpretations.Type_Matcher_Access
352 is
353 Item : constant Gela.Int.Interpretation_Access :=
354 Int_Lists.Element (Self.Pos);
355 begin
356 return Gela.Int.Categories.Category (Item.all).Match;
357 end Matcher;
358
359 ----------
360 -- Next --
361 ----------
362
363 overriding procedure Next (Self : in out Category_Cursor) is
364 begin
365 Int_Lists.Next (Self.Pos);
366 Category_Step (Self);
367 end Next;
368
369 ----------
370 -- Next --
371 ----------
372
373 overriding procedure Next (Self : in out Defining_Name_Cursor) is
374 begin
375 Int_Lists.Next (Self.Pos);
376 Defining_Name_Step (Self);
377 end Next;
378
379 ----------
380 -- Next --
381 ----------
382
383 overriding procedure Next (Self : in out Expression_Cursor) is
384 begin
385 Int_Lists.Next (Self.Pos);
386 Expression_Step (Self);
387 end Next;
388
389 ----------
390 -- Next --
391 ----------
392
393 overriding procedure Next (Self : in out Symbol_Cursor) is
394 begin
395 Int_Lists.Next (Self.Pos);
396 Symbol_Step (Self);
397 end Next;
398
399 ----------
400 -- Next --
401 ----------
402
403 overriding procedure Next (Self : in out Profile_Cursor) is
404 begin
405 Int_Lists.Next (Self.Pos);
406 Profile_Step (Self);
407 end Next;
408
409 ----------
410 -- Next --
411 ----------
412
413 overriding procedure Next (Self : in out Any_Cursor) is
414 begin
415 Int_Lists.Next (Self.Pos);
416 end Next;
417
418 ------------
419 -- Symbol --
420 ------------
421
422 overriding function Symbol
423 (Self : Symbol_Cursor)
424 return Gela.Lexical_Types.Symbol
425 is
426 Item : constant Gela.Int.Interpretation_Access :=
427 Int_Lists.Element (Self.Pos);
428 begin
429 return Gela.Int.Symbols.Symbol (Item.all).Get_Symbol;
430 end Symbol;
431
432 ------------
433 -- Symbol --
434 ------------
435
436 overriding function Symbol
437 (Self : Any_Cursor) return Gela.Lexical_Types.Symbol
438 is
439 Item : constant Gela.Int.Interpretation_Access :=
440 Int_Lists.Element (Self.Pos);
441 begin
442 return Gela.Int.Symbols.Symbol (Item.all).Get_Symbol;
443 end Symbol;
444
445end Gela.Plain_Int_Sets.Cursors;
Note: See TracBrowser for help on using the repository browser.