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