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