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

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

Reuse interpretation index

Return the same value for each call of Get_Index with the same arg.

File size: 6.3 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 Item : constant Gela.Int.Interpretation_Access :=
122 Int_Lists.Element (Self.Pos);
123 Result : Gela.Interpretations.Interpretation_Index;
124 begin
125 if Item.Index /= 0 then
126 return Item.Index;
127 end if;
128
129 if Self.Set.Item_From = Self.Set.Item_To then
130 Self.Set.Ids.Reserve_Indexes
131 (Gela.Int_Sets.Interpretation_Set_Access (Self.Set),
132 Self.Set.Item_From,
133 Self.Set.Item_To);
134 end if;
135
136 Result := Self.Set.Item_From;
137 Self.Set.Item_From := Self.Set.Item_From + 1;
138 Self.Set.Int_Map.Insert (Result, Item);
139 Item.Index := Result;
140
141 return Result;
142 end Get_Index;
143
144 -----------------
145 -- Has_Element --
146 -----------------
147
148 overriding function Has_Element (Self : Cursor) return Boolean is
149 begin
150 return Int_Lists.Has_Element (Self.Pos);
151 end Has_Element;
152
153 ----------
154 -- Hash --
155 ----------
156
157 function Hash
158 (Value : Gela.Interpretations.Interpretation_Index)
159 return Ada.Containers.Hash_Type is
160 begin
161 return Ada.Containers.Hash_Type (Value);
162 end Hash;
163
164 ----------
165 -- Hash --
166 ----------
167
168 function Hash
169 (Value : Gela.Interpretations.Interpretation_Set_Index)
170 return Ada.Containers.Hash_Type is
171 begin
172 return Ada.Containers.Hash_Type (Value);
173 end Hash;
174
175
176 ----------
177 -- Next --
178 ----------
179
180 overriding procedure Next (Self : in out Cursor) is
181 begin
182 Int_Lists.Next (Self.Pos);
183 end Next;
184
185 -----------
186 -- Visit --
187 -----------
188
189 overriding procedure Visit
190 (Self : Cursor;
191 Target : access Gela.Interpretations.Visiter'Class)
192 is
193 package Each is
194 type Visiter is new Gela.Int.Visiters.Visiter with null record;
195
196 overriding procedure Defining_Name
197 (Self : access Visiter;
198 Value : Gela.Int.Defining_Names.Defining_Name);
199
200 overriding procedure Expression
201 (Self : access Visiter;
202 Value : Gela.Int.Expressions.Expression);
203
204 overriding procedure Attr_Function
205 (Self : access Visiter;
206 Value : Gela.Int.Attr_Functions.Attr_Function);
207
208 end Each;
209
210 package body Each is
211
212 overriding procedure Defining_Name
213 (Self : access Visiter;
214 Value : Gela.Int.Defining_Names.Defining_Name)
215 is
216 pragma Unreferenced (Self);
217 begin
218 Target.On_Defining_Name
219 (Name => Value.Name,
220 Down => Value.Down);
221 end Defining_Name;
222
223 overriding procedure Expression
224 (Self : access Visiter;
225 Value : Gela.Int.Expressions.Expression)
226 is
227 pragma Unreferenced (Self);
228 begin
229 Target.On_Expression
230 (Tipe => Value.Expression_Type,
231 Down => Value.Down);
232 end Expression;
233
234 overriding procedure Attr_Function
235 (Self : access Visiter;
236 Value : Gela.Int.Attr_Functions.Attr_Function)
237 is
238 pragma Unreferenced (Self);
239 begin
240 Target.On_Attr_Function
241 (Kind => Value.Kind,
242 Down => Value.Down);
243 end Attr_Function;
244
245 end Each;
246
247 V : aliased Each.Visiter;
248 begin
249 Int_Lists.Element (Self.Pos).Visit (V'Access);
250 end Visit;
251
252end Gela.Plian_Int_Sets;
Note: See TracBrowser for help on using the repository browser.