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

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

Let's not every interpretation has index.

Drop interpretation<->index. This should help when full set of
interpretation of actual_parameter_part has a lot of items due to
cartesian product. Now only selected interpretations get index by
explicit call of Cursor.Get_Index.

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