source: trunk/ada-2012/src/semantic/gela-plian_int_sets.adb@ 363

Last change on this file since 363 was 363, checked in by Maxim Reznik, 6 years ago

Express function_call overload resolution rules

New type of interpretation required for this: Tuple.
This interpretation used to gather interpretations of parameter_associations.
Tuples connect sets of interpretations of each param together.
Then we iterate over them and choose matched for function prefix.
Chosen interpretation them get index by call Get_Tuple_Index function.
This function return linked structure of tuples suitable to unwind
during traverse parameter_associations when propagating Down attribute.

File size: 7.5 KB
Line 
1with Gela.Int.Attr_Functions;
2with Gela.Int.Defining_Names;
3with Gela.Int.Expressions;
4with Gela.Int.Visiters;
5with Gela.Int.Tuples;
6
7package body Gela.Plian_Int_Sets is
8
9 ---------
10 -- Add --
11 ---------
12
13 not overriding procedure Add
14 (Self : access Interpretation_Set;
15 Index : in out Gela.Interpretations.Interpretation_Set_Index;
16 Item : Gela.Int.Interpretation_Access)
17 is
18 use type Gela.Interpretations.Interpretation_Set_Index;
19
20 procedure Update
21 (Key : Gela.Interpretations.Interpretation_Set_Index;
22 Element : in out Int_Lists.List);
23
24 ------------
25 -- Update --
26 ------------
27
28 procedure Update
29 (Key : Gela.Interpretations.Interpretation_Set_Index;
30 Element : in out Int_Lists.List)
31 is
32 pragma Unreferenced (Key);
33 begin
34 Element.Append (Item);
35 end Update;
36
37 Pos : Int_List_Maps.Cursor;
38 Ok : Boolean;
39 begin
40 if Index = 0 then
41 if Self.Set_From = Self.Set_To then
42 Self.Ids.Reserve_Indexes
43 (Gela.Int_Sets.Interpretation_Set_Access (Self),
44 Self.Set_From,
45 Self.Set_To);
46 end if;
47
48 Index := Self.Set_From;
49 Self.Set_From := Self.Set_From + 1;
50 Self.Map.Insert (Index, Int_Lists.Empty_List, Pos, Ok);
51 else
52 Pos := Self.Map.Find (Index);
53 end if;
54
55 Self.Map.Update_Element (Pos, Update'Access);
56 end Add;
57
58 ---------
59 -- Add --
60 ---------
61
62 not overriding procedure Add
63 (Self : access Interpretation_Set;
64 Index : out Gela.Interpretations.Interpretation_Index;
65 Item : Gela.Int.Interpretation_Access)
66 is
67 use type Gela.Interpretations.Interpretation_Index;
68 begin
69 if Self.Item_From = Self.Item_To then
70 Self.Ids.Reserve_Indexes
71 (Gela.Int_Sets.Interpretation_Set_Access (Self),
72 Self.Item_From,
73 Self.Item_To);
74 end if;
75
76 Index := Self.Item_From;
77 Self.Item_From := Self.Item_From + 1;
78 Self.Int_Map.Insert (Index, Item);
79 Item.Index := Index;
80 end Add;
81
82 -------------
83 -- Element --
84 -------------
85
86 overriding function Element
87 (Self : Interpretation_Set;
88 Index : Gela.Interpretations.Interpretation_Index)
89 return Gela.Int.Interpretation_Access is
90 begin
91 return Self.Int_Map.Element (Index);
92 end Element;
93
94 ----------------
95 -- Get_Cursor --
96 ----------------
97
98 overriding function Get_Cursor
99 (Self : access Interpretation_Set;
100 Index : Gela.Interpretations.Interpretation_Set_Index)
101 return Gela.Interpretations.Cursor'Class
102 is
103 begin
104 return Result : Cursor do
105
106 declare
107 procedure Get
108 (Key : Gela.Interpretations.Interpretation_Set_Index;
109 Element : Int_Lists.List);
110
111 ---------
112 -- Get --
113 ---------
114
115 procedure Get
116 (Key : Gela.Interpretations.Interpretation_Set_Index;
117 Element : Int_Lists.List)
118 is
119 pragma Unreferenced (Key);
120 begin
121 Result.Pos := Element.First;
122 end Get;
123
124 use type Gela.Interpretations.Interpretation_Set_Index;
125 begin
126 if Index /= 0 then
127 Int_List_Maps.Query_Element (Self.Map.Find (Index), Get'Access);
128 end if;
129
130 Result.Set := Self;
131 end;
132
133 end return;
134 end Get_Cursor;
135
136 ---------------
137 -- Get_Index --
138 ---------------
139
140 overriding function Get_Index
141 (Self : Cursor)
142 return Gela.Interpretations.Interpretation_Index
143 is
144 use type Gela.Interpretations.Interpretation_Index;
145
146 Item : constant Gela.Int.Interpretation_Access :=
147 Int_Lists.Element (Self.Pos);
148 Result : Gela.Interpretations.Interpretation_Index;
149 begin
150 if Item.Index /= 0 then
151 return Item.Index;
152 end if;
153
154 Self.Set.Add (Result, Item);
155
156 return Result;
157 end Get_Index;
158
159 -----------------
160 -- Has_Element --
161 -----------------
162
163 overriding function Has_Element (Self : Cursor) return Boolean is
164 begin
165 return Int_Lists.Has_Element (Self.Pos);
166 end Has_Element;
167
168 ----------
169 -- Hash --
170 ----------
171
172 function Hash
173 (Value : Gela.Interpretations.Interpretation_Index)
174 return Ada.Containers.Hash_Type is
175 begin
176 return Ada.Containers.Hash_Type (Value);
177 end Hash;
178
179 ----------
180 -- Hash --
181 ----------
182
183 function Hash
184 (Value : Gela.Interpretations.Interpretation_Set_Index)
185 return Ada.Containers.Hash_Type is
186 begin
187 return Ada.Containers.Hash_Type (Value);
188 end Hash;
189
190
191 ----------
192 -- Next --
193 ----------
194
195 overriding procedure Next (Self : in out Cursor) is
196 begin
197 Int_Lists.Next (Self.Pos);
198 end Next;
199
200 -----------
201 -- Visit --
202 -----------
203
204 overriding procedure Visit
205 (Self : Cursor;
206 Target : access Gela.Interpretations.Visiter'Class)
207 is
208 package Each is
209 type Visiter is new Gela.Int.Visiters.Visiter with null record;
210
211 overriding procedure Defining_Name
212 (Self : access Visiter;
213 Value : Gela.Int.Defining_Names.Defining_Name);
214
215 overriding procedure Expression
216 (Self : access Visiter;
217 Value : Gela.Int.Expressions.Expression);
218
219 overriding procedure Attr_Function
220 (Self : access Visiter;
221 Value : Gela.Int.Attr_Functions.Attr_Function);
222
223 overriding procedure Tuple
224 (Self : access Visiter;
225 Value : Gela.Int.Tuples.Tuple);
226
227 overriding procedure Chosen_Tuple
228 (Self : access Visiter;
229 Value : Gela.Int.Tuples.Chosen_Tuple);
230 end Each;
231
232 package body Each is
233
234 overriding procedure Defining_Name
235 (Self : access Visiter;
236 Value : Gela.Int.Defining_Names.Defining_Name)
237 is
238 pragma Unreferenced (Self);
239 begin
240 Target.On_Defining_Name
241 (Name => Value.Name,
242 Down => Value.Down);
243 end Defining_Name;
244
245 overriding procedure Expression
246 (Self : access Visiter;
247 Value : Gela.Int.Expressions.Expression)
248 is
249 pragma Unreferenced (Self);
250 begin
251 Target.On_Expression
252 (Tipe => Value.Expression_Type,
253 Down => Value.Down);
254 end Expression;
255
256 overriding procedure Attr_Function
257 (Self : access Visiter;
258 Value : Gela.Int.Attr_Functions.Attr_Function)
259 is
260 pragma Unreferenced (Self);
261 begin
262 Target.On_Attr_Function
263 (Kind => Value.Kind,
264 Down => Value.Down);
265 end Attr_Function;
266
267 overriding procedure Tuple
268 (Self : access Visiter;
269 Value : Gela.Int.Tuples.Tuple)
270 is
271 pragma Unreferenced (Self);
272 begin
273 Target.On_Tuple
274 (Value => Value.Value,
275 Down => (1 .. 0 => 0));
276 end Tuple;
277
278 overriding procedure Chosen_Tuple
279 (Self : access Visiter;
280 Value : Gela.Int.Tuples.Chosen_Tuple)
281 is
282 pragma Unreferenced (Self);
283 begin
284 Target.On_Tuple
285 (Value => (1 .. 0 => 0),
286 Down => Value.Down);
287 end Chosen_Tuple;
288
289 end Each;
290
291 V : aliased Each.Visiter;
292 begin
293 Int_Lists.Element (Self.Pos).Visit (V'Access);
294 end Visit;
295
296end Gela.Plian_Int_Sets;
Note: See TracBrowser for help on using the repository browser.