]>
Commit | Line | Data |
---|---|---|
f2acf80c AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT LIBRARY COMPONENTS -- | |
4 | -- -- | |
5 | -- A D A . C O N T A I N E R S . B O U N D E D _ H A S H E D _ S E T S -- | |
6 | -- -- | |
7 | -- S p e c -- | |
8 | -- -- | |
bc0b26b9 | 9 | -- Copyright (C) 2004-2022, Free Software Foundation, Inc. -- |
f2acf80c AC |
10 | -- -- |
11 | -- This specification is derived from the Ada Reference Manual for use with -- | |
12 | -- GNAT. The copyright notice above, and the license provisions that follow -- | |
13 | -- apply solely to the contents of the part following the private keyword. -- | |
14 | -- -- | |
15 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
16 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
17 | -- ware Foundation; either version 3, or (at your option) any later ver- -- | |
18 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |
19 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
20 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- | |
21 | -- -- | |
22 | -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
23 | -- additional permissions described in the GCC Runtime Library Exception, -- | |
24 | -- version 3.1, as published by the Free Software Foundation. -- | |
25 | -- -- | |
26 | -- You should have received a copy of the GNU General Public License and -- | |
27 | -- a copy of the GCC Runtime Library Exception along with this program; -- | |
28 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
29 | -- <http://www.gnu.org/licenses/>. -- | |
30 | -- -- | |
31 | -- This unit was originally developed by Matthew J Heaney. -- | |
32 | ------------------------------------------------------------------------------ | |
33 | ||
ffb35bbf | 34 | with Ada.Iterator_Interfaces; |
3c24c853 | 35 | |
f2acf80c | 36 | private with Ada.Containers.Hash_Tables; |
1f8f3e6e | 37 | with Ada.Containers.Helpers; |
f2acf80c | 38 | private with Ada.Streams; |
d8394e2a | 39 | private with Ada.Finalization; |
20922782 | 40 | private with Ada.Strings.Text_Buffers; |
f2acf80c AC |
41 | |
42 | generic | |
43 | type Element_Type is private; | |
44 | ||
45 | with function Hash (Element : Element_Type) return Hash_Type; | |
46 | ||
47 | with function Equivalent_Elements | |
48 | (Left, Right : Element_Type) return Boolean; | |
49 | ||
50 | with function "=" (Left, Right : Element_Type) return Boolean is <>; | |
51 | ||
3221be14 YM |
52 | package Ada.Containers.Bounded_Hashed_Sets with |
53 | SPARK_Mode => Off | |
54 | is | |
6031f544 | 55 | pragma Annotate (CodePeer, Skip_Analysis); |
f2acf80c AC |
56 | pragma Pure; |
57 | pragma Remote_Types; | |
58 | ||
ffb35bbf ES |
59 | type Set (Capacity : Count_Type; Modulus : Hash_Type) is tagged private |
60 | with Constant_Indexing => Constant_Reference, | |
61 | Default_Iterator => Iterate, | |
fe3463cc | 62 | Iterator_Element => Element_Type, |
3bb4836f | 63 | Aggregate => (Empty => Empty, |
70aec3a1 GD |
64 | Add_Unnamed => Include), |
65 | Preelaborable_Initialization | |
66 | => Element_Type'Preelaborable_Initialization; | |
ffb35bbf | 67 | |
70aec3a1 | 68 | type Cursor is private with Preelaborable_Initialization; |
f2acf80c AC |
69 | |
70 | Empty_Set : constant Set; | |
71 | -- Set objects declared without an initialization expression are | |
72 | -- initialized to the value Empty_Set. | |
73 | ||
3bb4836f ES |
74 | function Empty (Capacity : Count_Type := 10) return Set; |
75 | ||
f2acf80c AC |
76 | No_Element : constant Cursor; |
77 | -- Cursor objects declared without an initialization expression are | |
78 | -- initialized to the value No_Element. | |
79 | ||
ffb35bbf ES |
80 | function Has_Element (Position : Cursor) return Boolean; |
81 | -- Equivalent to Position /= No_Element | |
82 | ||
83 | package Set_Iterator_Interfaces is new | |
84 | Ada.Iterator_Interfaces (Cursor, Has_Element); | |
85 | ||
f2acf80c AC |
86 | function "=" (Left, Right : Set) return Boolean; |
87 | -- For each element in Left, set equality attempts to find the equal | |
88 | -- element in Right; if a search fails, then set equality immediately | |
89 | -- returns False. The search works by calling Hash to find the bucket in | |
90 | -- the Right set that corresponds to the Left element. If the bucket is | |
91 | -- non-empty, the search calls the generic formal element equality operator | |
92 | -- to compare the element (in Left) to the element of each node in the | |
93 | -- bucket (in Right); the search terminates when a matching node in the | |
94 | -- bucket is found, or the nodes in the bucket are exhausted. (Note that | |
95 | -- element equality is called here, not Equivalent_Elements. Set equality | |
96 | -- is the only operation in which element equality is used. Compare set | |
97 | -- equality to Equivalent_Sets, which does call Equivalent_Elements.) | |
98 | ||
99 | function Equivalent_Sets (Left, Right : Set) return Boolean; | |
100 | -- Similar to set equality, with the difference that the element in Left is | |
101 | -- compared to the elements in Right using the generic formal | |
102 | -- Equivalent_Elements operation instead of element equality. | |
103 | ||
104 | function To_Set (New_Item : Element_Type) return Set; | |
105 | -- Constructs a singleton set comprising New_Element. To_Set calls Hash to | |
106 | -- determine the bucket for New_Item. | |
107 | ||
108 | function Capacity (Container : Set) return Count_Type; | |
109 | -- Returns the current capacity of the set. Capacity is the maximum length | |
110 | -- before which rehashing in guaranteed not to occur. | |
111 | ||
112 | procedure Reserve_Capacity (Container : in out Set; Capacity : Count_Type); | |
113 | -- If the value of the Capacity actual parameter is less or equal to | |
114 | -- Container.Capacity, then the operation has no effect. Otherwise it | |
115 | -- raises Capacity_Error (as no expansion of capacity is possible for a | |
116 | -- bounded form). | |
117 | ||
118 | function Default_Modulus (Capacity : Count_Type) return Hash_Type; | |
119 | -- Returns a modulus value (hash table size) which is optimal for the | |
120 | -- specified capacity (which corresponds to the maximum number of items). | |
121 | ||
122 | function Length (Container : Set) return Count_Type; | |
123 | -- Returns the number of items in the set | |
124 | ||
125 | function Is_Empty (Container : Set) return Boolean; | |
126 | -- Equivalent to Length (Container) = 0 | |
127 | ||
128 | procedure Clear (Container : in out Set); | |
3aacb9ed RA |
129 | -- Removes all of the items from the set. This will deallocate all memory |
130 | -- associated with this set. | |
f2acf80c AC |
131 | |
132 | function Element (Position : Cursor) return Element_Type; | |
133 | -- Returns the element of the node designated by the cursor | |
134 | ||
135 | procedure Replace_Element | |
136 | (Container : in out Set; | |
137 | Position : Cursor; | |
138 | New_Item : Element_Type); | |
139 | -- If New_Item is equivalent (as determined by calling Equivalent_Elements) | |
140 | -- to the element of the node designated by Position, then New_Element is | |
141 | -- assigned to that element. Otherwise, it calls Hash to determine the | |
142 | -- bucket for New_Item. If the bucket is not empty, then it calls | |
143 | -- Equivalent_Elements for each node in that bucket to determine whether | |
144 | -- New_Item is equivalent to an element in that bucket. If | |
145 | -- Equivalent_Elements returns True then Program_Error is raised (because | |
146 | -- an element may appear only once in the set); otherwise, New_Item is | |
147 | -- assigned to the node designated by Position, and the node is moved to | |
148 | -- its new bucket. | |
149 | ||
150 | procedure Query_Element | |
151 | (Position : Cursor; | |
152 | Process : not null access procedure (Element : Element_Type)); | |
153 | -- Calls Process with the element (having only a constant view) of the node | |
ffb35bbf ES |
154 | -- designated by the cursor. |
155 | ||
156 | type Constant_Reference_Type | |
157 | (Element : not null access constant Element_Type) is private | |
158 | with Implicit_Dereference => Element; | |
159 | ||
160 | function Constant_Reference | |
161 | (Container : aliased Set; | |
ce72a9a3 | 162 | Position : Cursor) return Constant_Reference_Type; |
f2acf80c AC |
163 | |
164 | procedure Assign (Target : in out Set; Source : Set); | |
165 | -- If Target denotes the same object as Source, then the operation has no | |
d99ff0f4 | 166 | -- effect. If the Target capacity is less than the Source length, then |
f2acf80c AC |
167 | -- Assign raises Capacity_Error. Otherwise, Assign clears Target and then |
168 | -- copies the (active) elements from Source to Target. | |
169 | ||
170 | function Copy | |
171 | (Source : Set; | |
172 | Capacity : Count_Type := 0; | |
173 | Modulus : Hash_Type := 0) return Set; | |
174 | -- Constructs a new set object whose elements correspond to Source. If the | |
175 | -- Capacity parameter is 0, then the capacity of the result is the same as | |
176 | -- the length of Source. If the Capacity parameter is equal or greater than | |
177 | -- the length of Source, then the capacity of the result is the specified | |
178 | -- value. Otherwise, Copy raises Capacity_Error. If the Modulus parameter | |
179 | -- is 0, then the modulus of the result is the value returned by a call to | |
180 | -- Default_Modulus with the capacity parameter determined as above; | |
181 | -- otherwise the modulus of the result is the specified value. | |
182 | ||
183 | procedure Move (Target : in out Set; Source : in out Set); | |
184 | -- Clears Target (if it's not empty), and then moves (not copies) the | |
185 | -- buckets array and nodes from Source to Target. | |
186 | ||
187 | procedure Insert | |
188 | (Container : in out Set; | |
189 | New_Item : Element_Type; | |
190 | Position : out Cursor; | |
191 | Inserted : out Boolean); | |
192 | -- Conditionally inserts New_Item into the set. If New_Item is already in | |
193 | -- the set, then Inserted returns False and Position designates the node | |
194 | -- containing the existing element (which is not modified). If New_Item is | |
195 | -- not already in the set, then Inserted returns True and Position | |
196 | -- designates the newly-inserted node containing New_Item. The search for | |
197 | -- an existing element works as follows. Hash is called to determine | |
198 | -- New_Item's bucket; if the bucket is non-empty, then Equivalent_Elements | |
199 | -- is called to compare New_Item to the element of each node in that | |
200 | -- bucket. If the bucket is empty, or there were no equivalent elements in | |
201 | -- the bucket, the search "fails" and the New_Item is inserted in the set | |
202 | -- (and Inserted returns True); otherwise, the search "succeeds" (and | |
203 | -- Inserted returns False). | |
204 | ||
205 | procedure Insert (Container : in out Set; New_Item : Element_Type); | |
206 | -- Attempts to insert New_Item into the set, performing the usual insertion | |
207 | -- search (which involves calling both Hash and Equivalent_Elements); if | |
208 | -- the search succeeds (New_Item is equivalent to an element already in the | |
209 | -- set, and so was not inserted), then this operation raises | |
210 | -- Constraint_Error. (This version of Insert is similar to Replace, but | |
211 | -- having the opposite exception behavior. It is intended for use when you | |
212 | -- want to assert that the item is not already in the set.) | |
213 | ||
214 | procedure Include (Container : in out Set; New_Item : Element_Type); | |
215 | -- Attempts to insert New_Item into the set. If an element equivalent to | |
216 | -- New_Item is already in the set (the insertion search succeeded, and | |
217 | -- hence New_Item was not inserted), then the value of New_Item is assigned | |
218 | -- to the existing element. (This insertion operation only raises an | |
219 | -- exception if cursor tampering occurs. It is intended for use when you | |
220 | -- want to insert the item in the set, and you don't care whether an | |
221 | -- equivalent element is already present.) | |
222 | ||
223 | procedure Replace (Container : in out Set; New_Item : Element_Type); | |
224 | -- Searches for New_Item in the set; if the search fails (because an | |
225 | -- equivalent element was not in the set), then it raises | |
226 | -- Constraint_Error. Otherwise, the existing element is assigned the value | |
227 | -- New_Item. (This is similar to Insert, but with the opposite exception | |
228 | -- behavior. It is intended for use when you want to assert that the item | |
229 | -- is already in the set.) | |
230 | ||
231 | procedure Exclude (Container : in out Set; Item : Element_Type); | |
232 | -- Searches for Item in the set, and if found, removes its node from the | |
233 | -- set and then deallocates it. The search works as follows. The operation | |
234 | -- calls Hash to determine the item's bucket; if the bucket is not empty, | |
235 | -- it calls Equivalent_Elements to compare Item to the element of each node | |
236 | -- in the bucket. (This is the deletion analog of Include. It is intended | |
237 | -- for use when you want to remove the item from the set, but don't care | |
238 | -- whether the item is already in the set.) | |
239 | ||
240 | procedure Delete (Container : in out Set; Item : Element_Type); | |
241 | -- Searches for Item in the set (which involves calling both Hash and | |
242 | -- Equivalent_Elements). If the search fails, then the operation raises | |
243 | -- Constraint_Error. Otherwise it removes the node from the set and then | |
244 | -- deallocates it. (This is the deletion analog of non-conditional | |
245 | -- Insert. It is intended for use when you want to assert that the item is | |
246 | -- already in the set.) | |
247 | ||
248 | procedure Delete (Container : in out Set; Position : in out Cursor); | |
249 | -- Removes the node designated by Position from the set, and then | |
250 | -- deallocates the node. The operation calls Hash to determine the bucket, | |
251 | -- and then compares Position to each node in the bucket until there's a | |
252 | -- match (it does not call Equivalent_Elements). | |
253 | ||
254 | procedure Union (Target : in out Set; Source : Set); | |
255 | -- Iterates over the Source set, and conditionally inserts each element | |
256 | -- into Target. | |
257 | ||
258 | function Union (Left, Right : Set) return Set; | |
259 | -- The operation first copies the Left set to the result, and then iterates | |
260 | -- over the Right set to conditionally insert each element into the result. | |
261 | ||
262 | function "or" (Left, Right : Set) return Set renames Union; | |
263 | ||
264 | procedure Intersection (Target : in out Set; Source : Set); | |
265 | -- Iterates over the Target set (calling First and Next), calling Find to | |
266 | -- determine whether the element is in Source. If an equivalent element is | |
267 | -- not found in Source, the element is deleted from Target. | |
268 | ||
269 | function Intersection (Left, Right : Set) return Set; | |
270 | -- Iterates over the Left set, calling Find to determine whether the | |
271 | -- element is in Right. If an equivalent element is found, it is inserted | |
272 | -- into the result set. | |
273 | ||
274 | function "and" (Left, Right : Set) return Set renames Intersection; | |
275 | ||
276 | procedure Difference (Target : in out Set; Source : Set); | |
277 | -- Iterates over the Source (calling First and Next), calling Find to | |
278 | -- determine whether the element is in Target. If an equivalent element is | |
279 | -- found, it is deleted from Target. | |
280 | ||
281 | function Difference (Left, Right : Set) return Set; | |
282 | -- Iterates over the Left set, calling Find to determine whether the | |
283 | -- element is in the Right set. If an equivalent element is not found, the | |
284 | -- element is inserted into the result set. | |
285 | ||
286 | function "-" (Left, Right : Set) return Set renames Difference; | |
287 | ||
288 | procedure Symmetric_Difference (Target : in out Set; Source : Set); | |
289 | -- The operation iterates over the Source set, searching for the element | |
290 | -- in Target (calling Hash and Equivalent_Elements). If an equivalent | |
308e6f3a | 291 | -- element is found, it is removed from Target; otherwise it is inserted |
f2acf80c AC |
292 | -- into Target. |
293 | ||
294 | function Symmetric_Difference (Left, Right : Set) return Set; | |
295 | -- The operation first iterates over the Left set. It calls Find to | |
296 | -- determine whether the element is in the Right set. If no equivalent | |
297 | -- element is found, the element from Left is inserted into the result. The | |
298 | -- operation then iterates over the Right set, to determine whether the | |
299 | -- element is in the Left set. If no equivalent element is found, the Right | |
300 | -- element is inserted into the result. | |
301 | ||
302 | function "xor" (Left, Right : Set) return Set | |
303 | renames Symmetric_Difference; | |
304 | ||
305 | function Overlap (Left, Right : Set) return Boolean; | |
306 | -- Iterates over the Left set (calling First and Next), calling Find to | |
307 | -- determine whether the element is in the Right set. If an equivalent | |
308 | -- element is found, the operation immediately returns True. The operation | |
309 | -- returns False if the iteration over Left terminates without finding any | |
310 | -- equivalent element in Right. | |
311 | ||
312 | function Is_Subset (Subset : Set; Of_Set : Set) return Boolean; | |
313 | -- Iterates over Subset (calling First and Next), calling Find to determine | |
314 | -- whether the element is in Of_Set. If no equivalent element is found in | |
315 | -- Of_Set, the operation immediately returns False. The operation returns | |
316 | -- True if the iteration over Subset terminates without finding an element | |
317 | -- not in Of_Set (that is, every element in Subset is equivalent to an | |
318 | -- element in Of_Set). | |
319 | ||
320 | function First (Container : Set) return Cursor; | |
321 | -- Returns a cursor that designates the first non-empty bucket, by | |
322 | -- searching from the beginning of the buckets array. | |
323 | ||
324 | function Next (Position : Cursor) return Cursor; | |
325 | -- Returns a cursor that designates the node that follows the current one | |
326 | -- designated by Position. If Position designates the last node in its | |
327 | -- bucket, the operation calls Hash to compute the index of this bucket, | |
328 | -- and searches the buckets array for the first non-empty bucket, starting | |
329 | -- from that index; otherwise, it simply follows the link to the next node | |
330 | -- in the same bucket. | |
331 | ||
332 | procedure Next (Position : in out Cursor); | |
333 | -- Equivalent to Position := Next (Position) | |
334 | ||
335 | function Find | |
336 | (Container : Set; | |
337 | Item : Element_Type) return Cursor; | |
338 | -- Searches for Item in the set. Find calls Hash to determine the item's | |
339 | -- bucket; if the bucket is not empty, it calls Equivalent_Elements to | |
340 | -- compare Item to each element in the bucket. If the search succeeds, Find | |
341 | -- returns a cursor designating the node containing the equivalent element; | |
342 | -- otherwise, it returns No_Element. | |
343 | ||
344 | function Contains (Container : Set; Item : Element_Type) return Boolean; | |
345 | -- Equivalent to Find (Container, Item) /= No_Element | |
346 | ||
f2acf80c AC |
347 | function Equivalent_Elements (Left, Right : Cursor) return Boolean; |
348 | -- Returns the result of calling Equivalent_Elements with the elements of | |
349 | -- the nodes designated by cursors Left and Right. | |
350 | ||
351 | function Equivalent_Elements | |
352 | (Left : Cursor; | |
353 | Right : Element_Type) return Boolean; | |
354 | -- Returns the result of calling Equivalent_Elements with element of the | |
355 | -- node designated by Left and element Right. | |
356 | ||
357 | function Equivalent_Elements | |
358 | (Left : Element_Type; | |
359 | Right : Cursor) return Boolean; | |
360 | -- Returns the result of calling Equivalent_Elements with element Left and | |
361 | -- the element of the node designated by Right. | |
362 | ||
363 | procedure Iterate | |
364 | (Container : Set; | |
365 | Process : not null access procedure (Position : Cursor)); | |
366 | -- Calls Process for each node in the set | |
367 | ||
ce72a9a3 AC |
368 | function Iterate |
369 | (Container : Set) | |
370 | return Set_Iterator_Interfaces.Forward_Iterator'Class; | |
ffb35bbf | 371 | |
d0e4bdcd GM |
372 | -- Ada 2022 features: |
373 | ||
374 | function Has_Element (Container : Set; Position : Cursor) return Boolean; | |
375 | ||
376 | function Tampering_With_Cursors_Prohibited (Container : Set) return Boolean; | |
377 | ||
378 | function Element (Container : Set; Position : Cursor) return Element_Type; | |
379 | ||
380 | procedure Query_Element | |
381 | (Container : Set; | |
382 | Position : Cursor; | |
383 | Process : not null access procedure (Element : Element_Type)); | |
384 | ||
385 | function Next (Container : Set; Position : Cursor) return Cursor; | |
386 | ||
387 | procedure Next (Container : Set; Position : in out Cursor); | |
388 | ||
389 | ---------------- | |
390 | ||
f2acf80c AC |
391 | generic |
392 | type Key_Type (<>) is private; | |
393 | ||
394 | with function Key (Element : Element_Type) return Key_Type; | |
395 | ||
396 | with function Hash (Key : Key_Type) return Hash_Type; | |
397 | ||
398 | with function Equivalent_Keys (Left, Right : Key_Type) return Boolean; | |
399 | ||
400 | package Generic_Keys is | |
401 | ||
402 | function Key (Position : Cursor) return Key_Type; | |
403 | -- Applies generic formal operation Key to the element of the node | |
404 | -- designated by Position. | |
405 | ||
d0e4bdcd GM |
406 | function Key (Container : Set; Position : Cursor) return Key_Type is |
407 | (Key (Element (Container, Position))); | |
408 | ||
f2acf80c AC |
409 | function Element (Container : Set; Key : Key_Type) return Element_Type; |
410 | -- Searches (as per the key-based Find) for the node containing Key, and | |
411 | -- returns the associated element. | |
412 | ||
413 | procedure Replace | |
414 | (Container : in out Set; | |
415 | Key : Key_Type; | |
416 | New_Item : Element_Type); | |
417 | -- Searches (as per the key-based Find) for the node containing Key, and | |
418 | -- then replaces the element of that node (as per the element-based | |
419 | -- Replace_Element). | |
420 | ||
421 | procedure Exclude (Container : in out Set; Key : Key_Type); | |
422 | -- Searches for Key in the set, and if found, removes its node from the | |
423 | -- set and then deallocates it. The search works by first calling Hash | |
424 | -- (on Key) to determine the bucket; if the bucket is not empty, it | |
425 | -- calls Equivalent_Keys to compare parameter Key to the value of | |
426 | -- generic formal operation Key applied to element of each node in the | |
427 | -- bucket. | |
428 | ||
429 | procedure Delete (Container : in out Set; Key : Key_Type); | |
430 | -- Deletes the node containing Key as per Exclude, with the difference | |
431 | -- that Constraint_Error is raised if Key is not found. | |
432 | ||
433 | function Find (Container : Set; Key : Key_Type) return Cursor; | |
434 | -- Searches for the node containing Key, and returns a cursor | |
435 | -- designating the node. The search works by first calling Hash (on Key) | |
436 | -- to determine the bucket. If the bucket is not empty, the search | |
437 | -- compares Key to the element of each node in the bucket, and returns | |
438 | -- the matching node. The comparison itself works by applying the | |
439 | -- generic formal Key operation to the element of the node, and then | |
440 | -- calling generic formal operation Equivalent_Keys. | |
441 | ||
442 | function Contains (Container : Set; Key : Key_Type) return Boolean; | |
443 | -- Equivalent to Find (Container, Key) /= No_Element | |
444 | ||
445 | procedure Update_Element_Preserving_Key | |
446 | (Container : in out Set; | |
447 | Position : Cursor; | |
448 | Process : not null access | |
449 | procedure (Element : in out Element_Type)); | |
450 | -- Calls Process with the element of the node designated by Position, | |
451 | -- but with the restriction that the key-value of the element is not | |
452 | -- modified. The operation first makes a copy of the value returned by | |
453 | -- applying generic formal operation Key on the element of the node, and | |
454 | -- then calls Process with the element. The operation verifies that the | |
455 | -- key-part has not been modified by calling generic formal operation | |
456 | -- Equivalent_Keys to compare the saved key-value to the value returned | |
457 | -- by applying generic formal operation Key to the post-Process value of | |
458 | -- element. If the key values compare equal then the operation | |
459 | -- completes. Otherwise, the node is removed from the map and | |
460 | -- Program_Error is raised. | |
461 | ||
ffb35bbf ES |
462 | type Reference_Type (Element : not null access Element_Type) is private |
463 | with Implicit_Dereference => Element; | |
464 | ||
465 | function Reference_Preserving_Key | |
466 | (Container : aliased in out Set; | |
ce72a9a3 | 467 | Position : Cursor) return Reference_Type; |
ffb35bbf | 468 | |
c9423ca3 AC |
469 | function Constant_Reference |
470 | (Container : aliased Set; | |
471 | Key : Key_Type) return Constant_Reference_Type; | |
472 | ||
ffb35bbf ES |
473 | function Reference_Preserving_Key |
474 | (Container : aliased in out Set; | |
ce72a9a3 | 475 | Key : Key_Type) return Reference_Type; |
ffb35bbf ES |
476 | |
477 | private | |
2b4c962d AC |
478 | type Set_Access is access all Set; |
479 | for Set_Access'Storage_Size use 0; | |
480 | ||
14f73211 BD |
481 | package Impl is new Helpers.Generic_Implementation; |
482 | ||
2b4c962d | 483 | type Reference_Control_Type is |
14f73211 | 484 | new Impl.Reference_Control_Type with |
2b4c962d AC |
485 | record |
486 | Container : Set_Access; | |
487 | Index : Hash_Type; | |
488 | Old_Pos : Cursor; | |
489 | Old_Hash : Hash_Type; | |
490 | end record; | |
491 | ||
41a58113 | 492 | overriding procedure Finalize (Control : in out Reference_Control_Type); |
2b4c962d AC |
493 | pragma Inline (Finalize); |
494 | ||
495 | type Reference_Type (Element : not null access Element_Type) is record | |
496 | Control : Reference_Control_Type; | |
497 | end record; | |
ffb35bbf | 498 | |
c9423ca3 AC |
499 | use Ada.Streams; |
500 | ||
501 | procedure Read | |
502 | (Stream : not null access Root_Stream_Type'Class; | |
503 | Item : out Reference_Type); | |
504 | ||
505 | for Reference_Type'Read use Read; | |
506 | ||
507 | procedure Write | |
508 | (Stream : not null access Root_Stream_Type'Class; | |
509 | Item : Reference_Type); | |
510 | ||
511 | for Reference_Type'Write use Write; | |
512 | ||
f2acf80c AC |
513 | end Generic_Keys; |
514 | ||
515 | private | |
f2acf80c AC |
516 | pragma Inline (Next); |
517 | ||
518 | type Node_Type is record | |
c9423ca3 | 519 | Element : aliased Element_Type; |
f2acf80c AC |
520 | Next : Count_Type; |
521 | end record; | |
522 | ||
523 | package HT_Types is | |
524 | new Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type); | |
525 | ||
526 | type Set (Capacity : Count_Type; Modulus : Hash_Type) is | |
26349b6d BD |
527 | new HT_Types.Hash_Table_Type (Capacity, Modulus) |
528 | with null record with Put_Image => Put_Image; | |
529 | ||
530 | procedure Put_Image | |
20922782 | 531 | (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set); |
f2acf80c | 532 | |
14f73211 | 533 | use HT_Types, HT_Types.Implementation; |
f2acf80c AC |
534 | use Ada.Streams; |
535 | ||
3c24c853 MH |
536 | procedure Write |
537 | (Stream : not null access Root_Stream_Type'Class; | |
538 | Container : Set); | |
539 | ||
540 | for Set'Write use Write; | |
541 | ||
542 | procedure Read | |
543 | (Stream : not null access Root_Stream_Type'Class; | |
544 | Container : out Set); | |
545 | ||
546 | for Set'Read use Read; | |
547 | ||
f2acf80c AC |
548 | type Set_Access is access all Set; |
549 | for Set_Access'Storage_Size use 0; | |
550 | ||
d85fd922 AC |
551 | -- Note: If a Cursor object has no explicit initialization expression, |
552 | -- it must default initialize to the same value as constant No_Element. | |
553 | -- The Node component of type Cursor has scalar type Count_Type, so it | |
554 | -- requires an explicit initialization expression of its own declaration, | |
555 | -- in order for objects of record type Cursor to properly initialize. | |
556 | ||
f2acf80c AC |
557 | type Cursor is record |
558 | Container : Set_Access; | |
c54796e0 | 559 | Node : Count_Type := 0; |
f2acf80c AC |
560 | end record; |
561 | ||
562 | procedure Write | |
563 | (Stream : not null access Root_Stream_Type'Class; | |
564 | Item : Cursor); | |
565 | ||
566 | for Cursor'Write use Write; | |
567 | ||
568 | procedure Read | |
569 | (Stream : not null access Root_Stream_Type'Class; | |
570 | Item : out Cursor); | |
571 | ||
572 | for Cursor'Read use Read; | |
573 | ||
14f73211 BD |
574 | subtype Reference_Control_Type is Implementation.Reference_Control_Type; |
575 | -- It is necessary to rename this here, so that the compiler can find it | |
3bd783ec | 576 | |
ffb35bbf | 577 | type Constant_Reference_Type |
3bd783ec | 578 | (Element : not null access constant Element_Type) is |
db222ead AC |
579 | record |
580 | Control : Reference_Control_Type := | |
581 | raise Program_Error with "uninitialized reference"; | |
582 | -- The RM says, "The default initialization of an object of | |
583 | -- type Constant_Reference_Type or Reference_Type propagates | |
584 | -- Program_Error." | |
585 | end record; | |
ffb35bbf ES |
586 | |
587 | procedure Read | |
588 | (Stream : not null access Root_Stream_Type'Class; | |
589 | Item : out Constant_Reference_Type); | |
590 | ||
591 | for Constant_Reference_Type'Read use Read; | |
592 | ||
593 | procedure Write | |
594 | (Stream : not null access Root_Stream_Type'Class; | |
595 | Item : Constant_Reference_Type); | |
596 | ||
597 | for Constant_Reference_Type'Write use Write; | |
598 | ||
14f73211 BD |
599 | -- Three operations are used to optimize in the expansion of "for ... of" |
600 | -- loops: the Next(Cursor) procedure in the visible part, and the following | |
601 | -- Pseudo_Reference and Get_Element_Access functions. See Sem_Ch5 for | |
602 | -- details. | |
603 | ||
604 | function Pseudo_Reference | |
605 | (Container : aliased Set'Class) return Reference_Control_Type; | |
606 | pragma Inline (Pseudo_Reference); | |
607 | -- Creates an object of type Reference_Control_Type pointing to the | |
608 | -- container, and increments the Lock. Finalization of this object will | |
609 | -- decrement the Lock. | |
610 | ||
611 | type Element_Access is access all Element_Type with | |
612 | Storage_Size => 0; | |
613 | ||
614 | function Get_Element_Access | |
615 | (Position : Cursor) return not null Element_Access; | |
616 | -- Returns a pointer to the element designated by Position. | |
617 | ||
f2acf80c | 618 | Empty_Set : constant Set := |
ce72a9a3 | 619 | (Hash_Table_Type with Capacity => 0, Modulus => 0); |
f2acf80c | 620 | |
3c24c853 MH |
621 | No_Element : constant Cursor := (Container => null, Node => 0); |
622 | ||
d8394e2a | 623 | type Iterator is new Ada.Finalization.Limited_Controlled and |
e2441021 AC |
624 | Set_Iterator_Interfaces.Forward_Iterator with |
625 | record | |
626 | Container : Set_Access; | |
14f73211 BD |
627 | end record |
628 | with Disable_Controlled => not T_Check; | |
e2441021 AC |
629 | |
630 | overriding procedure Finalize (Object : in out Iterator); | |
631 | ||
632 | overriding function First (Object : Iterator) return Cursor; | |
633 | ||
634 | overriding function Next | |
635 | (Object : Iterator; | |
636 | Position : Cursor) return Cursor; | |
637 | ||
f2acf80c | 638 | end Ada.Containers.Bounded_Hashed_Sets; |