source: trunk/ada-2012/src/semantic/gela-plain_int_sets.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.

  • Property svn:keywords set to Author Date Revision
File size: 7.7 KB
Line 
1with Gela.Plain_Int_Sets.Cursors;
2
3package body Gela.Plain_Int_Sets is
4
5 package Category_Iterators is new Cursors.Generic_Iterators
6 (Cursor => Gela.Interpretations.Category_Cursor,
7 Next => Gela.Interpretations.Next,
8 Some_Cursor => Cursors.Category_Cursor,
9 Iterators => Gela.Interpretations.Category_Iterators);
10
11 package Defining_Name_Iterators is new Cursors.Generic_Iterators
12 (Cursor => Gela.Interpretations.Defining_Name_Cursor,
13 Next => Gela.Interpretations.Next,
14 Some_Cursor => Cursors.Defining_Name_Cursor,
15 Iterators => Gela.Interpretations.Defining_Name_Iterators);
16
17 package Expression_Iterators is new Cursors.Generic_Iterators
18 (Cursor => Gela.Interpretations.Expression_Cursor,
19 Next => Gela.Interpretations.Next,
20 Some_Cursor => Cursors.Expression_Cursor,
21 Iterators => Gela.Interpretations.Expression_Iterators);
22
23 package Symbol_Iterators is new Cursors.Generic_Iterators
24 (Cursor => Gela.Interpretations.Symbol_Cursor,
25 Next => Gela.Interpretations.Next,
26 Some_Cursor => Cursors.Symbol_Cursor,
27 Iterators => Gela.Interpretations.Symbol_Iterators);
28
29 package Profile_Iterators is new Cursors.Generic_Iterators
30 (Cursor => Gela.Interpretations.Profile_Cursor,
31 Next => Gela.Interpretations.Next,
32 Some_Cursor => Cursors.Profile_Cursor,
33 Iterators => Gela.Interpretations.Profile_Iterators);
34
35 package Any_Iterators is new Cursors.Generic_Iterators
36 (Cursor => Gela.Interpretations.Any_Cursor,
37 Next => Gela.Interpretations.Next,
38 Some_Cursor => Cursors.Any_Cursor,
39 Iterators => Gela.Interpretations.Any_Iterators);
40
41 ---------
42 -- Add --
43 ---------
44
45 not overriding procedure Add
46 (Self : access Interpretation_Set;
47 Index : in out Gela.Interpretations.Interpretation_Set_Index;
48 Item : Gela.Int.Interpretation_Access)
49 is
50 use type Gela.Interpretations.Interpretation_Set_Index;
51
52 procedure Update
53 (Key : Gela.Interpretations.Interpretation_Set_Index;
54 Element : in out Int_Lists.List);
55
56 ------------
57 -- Update --
58 ------------
59
60 procedure Update
61 (Key : Gela.Interpretations.Interpretation_Set_Index;
62 Element : in out Int_Lists.List)
63 is
64 pragma Unreferenced (Key);
65 begin
66 Element.Append (Item);
67 end Update;
68
69 Pos : Int_List_Maps.Cursor;
70 Ok : Boolean;
71 begin
72 if Index = 0 then
73 if Self.Set_From = Self.Set_To then
74 Self.Ids.Reserve_Indexes
75 (Gela.Int_Sets.Interpretation_Set_Access (Self),
76 Self.Set_From,
77 Self.Set_To);
78 end if;
79
80 Index := Self.Set_From;
81 Self.Set_From := Self.Set_From + 1;
82 Self.Map.Insert (Index, Int_Lists.Empty_List, Pos, Ok);
83 else
84 Pos := Self.Map.Find (Index);
85 end if;
86
87 Self.Map.Update_Element (Pos, Update'Access);
88 end Add;
89
90 ---------
91 -- Add --
92 ---------
93
94 not overriding procedure Add
95 (Self : access Interpretation_Set;
96 Index : out Gela.Interpretations.Interpretation_Index;
97 Item : Gela.Int.Interpretation_Access)
98 is
99 use type Gela.Interpretations.Interpretation_Index;
100 begin
101 if Self.Item_From = Self.Item_To then
102 Self.Ids.Reserve_Indexes
103 (Gela.Int_Sets.Interpretation_Set_Access (Self),
104 Self.Item_From,
105 Self.Item_To);
106 end if;
107
108 Index := Self.Item_From;
109 Self.Item_From := Self.Item_From + 1;
110 Self.Int_Map.Insert (Index, Item);
111 Item.Index := Index;
112 end Add;
113
114 ----------------
115 -- Categories --
116 ----------------
117
118 overriding function Categories
119 (Self : access Interpretation_Set;
120 Index : Gela.Interpretations.Interpretation_Set_Index)
121 return Gela.Interpretations.Category_Iterators
122 .Forward_Iterator'Class
123 is
124 use type Gela.Interpretations.Interpretation_Set_Index;
125 begin
126 return Result : Category_Iterators.Iterator do
127 if Index /= 0 then
128 Result.Cursor.Initialize (Self, Index);
129 end if;
130 end return;
131 end Categories;
132
133 --------------------
134 -- Defining_Names --
135 --------------------
136
137 overriding function Defining_Names
138 (Self : access Interpretation_Set;
139 Index : Gela.Interpretations.Interpretation_Set_Index)
140 return Gela.Interpretations.Defining_Name_Iterators
141 .Forward_Iterator'Class
142 is
143 use type Gela.Interpretations.Interpretation_Set_Index;
144 begin
145 return Result : Defining_Name_Iterators.Iterator do
146 if Index /= 0 then
147 Result.Cursor.Initialize (Self, Index);
148 end if;
149 end return;
150 end Defining_Names;
151
152 -------------
153 -- Element --
154 -------------
155
156 overriding function Element
157 (Self : Interpretation_Set;
158 Index : Gela.Interpretations.Interpretation_Index)
159 return Gela.Int.Interpretation_Access is
160 begin
161 return Self.Int_Map.Element (Index);
162 end Element;
163
164 ----------
165 -- Each --
166 ----------
167
168 overriding function Each
169 (Self : access Interpretation_Set;
170 Index : Gela.Interpretations.Interpretation_Set_Index)
171 return Gela.Interpretations.Any_Iterators
172 .Forward_Iterator'Class
173 is
174 use type Gela.Interpretations.Interpretation_Set_Index;
175 begin
176 return Result : Any_Iterators.Iterator do
177 if Index /= 0 then
178 Result.Cursor.Initialize (Self, Index);
179 end if;
180 end return;
181 end Each;
182
183 -----------------
184 -- Expressions --
185 -----------------
186
187 overriding function Expressions
188 (Self : access Interpretation_Set;
189 Index : Gela.Interpretations.Interpretation_Set_Index)
190 return Gela.Interpretations.Expression_Iterators
191 .Forward_Iterator'Class
192 is
193 use type Gela.Interpretations.Interpretation_Set_Index;
194 begin
195 return Result : Expression_Iterators.Iterator do
196 if Index /= 0 then
197 Result.Cursor.Initialize (Self, Index);
198 end if;
199 end return;
200 end Expressions;
201
202 ----------
203 -- Hash --
204 ----------
205
206 function Hash
207 (Value : Gela.Interpretations.Interpretation_Index)
208 return Ada.Containers.Hash_Type is
209 begin
210 return Ada.Containers.Hash_Type (Value);
211 end Hash;
212
213 ----------
214 -- Hash --
215 ----------
216
217 function Hash
218 (Value : Gela.Interpretations.Interpretation_Set_Index)
219 return Ada.Containers.Hash_Type is
220 begin
221 return Ada.Containers.Hash_Type (Value);
222 end Hash;
223
224 --------------
225 -- Profiles --
226 --------------
227
228 overriding function Profiles
229 (Self : access Interpretation_Set;
230 Index : Gela.Interpretations.Interpretation_Set_Index)
231 return Gela.Interpretations.Profile_Iterators
232 .Forward_Iterator'Class
233 is
234 use type Gela.Interpretations.Interpretation_Set_Index;
235 begin
236 return Result : Profile_Iterators.Iterator do
237 if Index /= 0 then
238 Result.Cursor.Initialize (Self, Index);
239 end if;
240 end return;
241 end Profiles;
242
243 -------------
244 -- Symbols --
245 -------------
246
247 overriding function Symbols
248 (Self : access Interpretation_Set;
249 Index : Gela.Interpretations.Interpretation_Set_Index)
250 return Gela.Interpretations.Symbol_Iterators
251 .Forward_Iterator'Class
252 is
253 use type Gela.Interpretations.Interpretation_Set_Index;
254 begin
255 return Result : Symbol_Iterators.Iterator do
256 if Index /= 0 then
257 Result.Cursor.Initialize (Self, Index);
258 end if;
259 end return;
260 end Symbols;
261
262end Gela.Plain_Int_Sets;
Note: See TracBrowser for help on using the repository browser.