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