]>
Commit | Line | Data |
---|---|---|
4c2d6a70 AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT LIBRARY COMPONENTS -- | |
4 | -- -- | |
8704d4b3 | 5 | -- A D A . C O N T A I N E R S . O R D E R E D _ M U L T I S E T S -- |
4c2d6a70 AC |
6 | -- -- |
7 | -- S p e c -- | |
8 | -- -- | |
748086b7 | 9 | -- Copyright (C) 2004-2009, Free Software Foundation, Inc. -- |
4c2d6a70 | 10 | -- -- |
4c2d6a70 AC |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
748086b7 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
4c2d6a70 AC |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
748086b7 JJ |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
17 | -- -- | |
18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
19 | -- additional permissions described in the GCC Runtime Library Exception, -- | |
20 | -- version 3.1, as published by the Free Software Foundation. -- | |
21 | -- -- | |
22 | -- You should have received a copy of the GNU General Public License and -- | |
23 | -- a copy of the GCC Runtime Library Exception along with this program; -- | |
24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
25 | -- <http://www.gnu.org/licenses/>. -- | |
4c2d6a70 AC |
26 | -- -- |
27 | -- This unit was originally developed by Matthew J Heaney. -- | |
28 | ------------------------------------------------------------------------------ | |
29 | ||
1ed69f61 AC |
30 | -- The ordered multiset container is similar to the ordered set, but with the |
31 | -- difference that multiple equivalent elements are allowed. It also provides | |
32 | -- additional operations, to iterate over items that are equivalent. | |
2a6b365a MH |
33 | |
34 | private with Ada.Containers.Red_Black_Trees; | |
35 | private with Ada.Finalization; | |
36 | private with Ada.Streams; | |
4c2d6a70 AC |
37 | |
38 | generic | |
39 | type Element_Type is private; | |
40 | ||
41 | with function "<" (Left, Right : Element_Type) return Boolean is <>; | |
42 | with function "=" (Left, Right : Element_Type) return Boolean is <>; | |
43 | ||
44 | package Ada.Containers.Ordered_Multisets is | |
009186e0 | 45 | pragma Preelaborate; |
f97ccb3a | 46 | pragma Remote_Types; |
4c2d6a70 | 47 | |
2368f04e | 48 | function Equivalent_Elements (Left, Right : Element_Type) return Boolean; |
1ed69f61 AC |
49 | -- Returns False if Left is less than Right, or Right is less than Left; |
50 | -- otherwise, it returns True. | |
2368f04e | 51 | |
4c2d6a70 | 52 | type Set is tagged private; |
9b832db5 | 53 | pragma Preelaborable_Initialization (Set); |
4c2d6a70 AC |
54 | |
55 | type Cursor is private; | |
9b832db5 | 56 | pragma Preelaborable_Initialization (Cursor); |
4c2d6a70 AC |
57 | |
58 | Empty_Set : constant Set; | |
1ed69f61 AC |
59 | -- The default value for set objects declared without an explicit |
60 | -- initialization expression. | |
4c2d6a70 AC |
61 | |
62 | No_Element : constant Cursor; | |
1ed69f61 AC |
63 | -- The default value for cursor objects declared without an explicit |
64 | -- initialization expression. | |
4c2d6a70 AC |
65 | |
66 | function "=" (Left, Right : Set) return Boolean; | |
1ed69f61 AC |
67 | -- If Left denotes the same set object as Right, then equality returns |
68 | -- True. If the length of Left is different from the length of Right, then | |
69 | -- it returns False. Otherwise, set equality iterates over Left and Right, | |
70 | -- comparing the element of Left to the element of Right using the equality | |
71 | -- operator for elements. If the elements compare False, then the iteration | |
72 | -- terminates and set equality returns False. Otherwise, if all elements | |
73 | -- compare True, then set equality returns True. | |
4c2d6a70 | 74 | |
8704d4b3 | 75 | function Equivalent_Sets (Left, Right : Set) return Boolean; |
1ed69f61 AC |
76 | -- Similar to set equality, but with the difference that elements are |
77 | -- compared for equivalence instead of equality. | |
8704d4b3 | 78 | |
2368f04e | 79 | function To_Set (New_Item : Element_Type) return Set; |
1ed69f61 | 80 | -- Constructs a set object with New_Item as its single element |
2368f04e | 81 | |
4c2d6a70 | 82 | function Length (Container : Set) return Count_Type; |
1ed69f61 | 83 | -- Returns the total number of elements in Container |
4c2d6a70 AC |
84 | |
85 | function Is_Empty (Container : Set) return Boolean; | |
1ed69f61 | 86 | -- Returns True if Container.Length is 0 |
4c2d6a70 AC |
87 | |
88 | procedure Clear (Container : in out Set); | |
1ed69f61 | 89 | -- Deletes all elements from Container |
4c2d6a70 AC |
90 | |
91 | function Element (Position : Cursor) return Element_Type; | |
1ed69f61 AC |
92 | -- If Position equals No_Element, then Constraint_Error is raised. |
93 | -- Otherwise, function Element returns the element designed by Position. | |
4c2d6a70 | 94 | |
2368f04e MH |
95 | procedure Replace_Element |
96 | (Container : in out Set; | |
97 | Position : Cursor; | |
98 | New_Item : Element_Type); | |
1ed69f61 AC |
99 | -- If Position equals No_Element, then Constraint_Error is raised. If |
100 | -- Position is associated with a set different from Container, then | |
101 | -- Program_Error is raised. If New_Item is equivalent to the element | |
102 | -- designated by Position, then if Container is locked (element tampering | |
103 | -- has been attempted), Program_Error is raised; otherwise, the element | |
104 | -- designated by Position is assigned the value of New_Item. If New_Item is | |
105 | -- not equivalent to the element designated by Position, then if the | |
106 | -- container is busy (cursor tampering has been attempted), Program_Error | |
107 | -- is raised; otherwise, the element designed by Position is assigned the | |
108 | -- value of New_Item, and the node is moved to its new position (in | |
109 | -- canonical insertion order). | |
2368f04e | 110 | |
4c2d6a70 AC |
111 | procedure Query_Element |
112 | (Position : Cursor; | |
113 | Process : not null access procedure (Element : Element_Type)); | |
1ed69f61 AC |
114 | -- If Position equals No_Element, then Constraint_Error is |
115 | -- raised. Otherwise, it calls Process with the element designated by | |
116 | -- Position as the parameter. This call locks the container, so attempts to | |
117 | -- change the value of the element while Process is executing (to "tamper | |
118 | -- with elements") will raise Program_Error. | |
4c2d6a70 | 119 | |
2368f04e | 120 | procedure Move (Target : in out Set; Source : in out Set); |
1ed69f61 AC |
121 | -- If Target denotes the same object as Source, the operation does |
122 | -- nothing. If either Target or Source is busy (cursor tampering is | |
123 | -- attempted), then it raises Program_Error. Otherwise, Target is cleared, | |
124 | -- and the nodes from Source are moved (not copied) to Target (so Source | |
125 | -- becomes empty). | |
4c2d6a70 AC |
126 | |
127 | procedure Insert | |
128 | (Container : in out Set; | |
129 | New_Item : Element_Type; | |
130 | Position : out Cursor); | |
1ed69f61 AC |
131 | -- Insert adds New_Item to Container, and returns cursor Position |
132 | -- designating the newly inserted node. The node is inserted after any | |
133 | -- existing elements less than or equivalent to New_Item (and before any | |
134 | -- elements greater than New_Item). Note that the issue of where the new | |
135 | -- node is inserted relative to equivalent elements does not arise for | |
136 | -- unique-key containers, since in that case the insertion would simply | |
137 | -- fail. For a multiple-key container (the case here), insertion always | |
138 | -- succeeds, and is defined such that the new item is positioned after any | |
139 | -- equivalent elements already in the container. | |
4c2d6a70 AC |
140 | |
141 | procedure Insert | |
142 | (Container : in out Set; | |
143 | New_Item : Element_Type); | |
1ed69f61 AC |
144 | -- Inserts New_Item in Container, but does not return a cursor designating |
145 | -- the newly-inserted node. | |
4c2d6a70 | 146 | |
2368f04e MH |
147 | -- TODO: include Replace too??? |
148 | -- | |
149 | -- procedure Replace | |
150 | -- (Container : in out Set; | |
151 | -- New_Item : Element_Type); | |
152 | ||
153 | procedure Exclude | |
154 | (Container : in out Set; | |
155 | Item : Element_Type); | |
1ed69f61 | 156 | -- Deletes from Container all of the elements equivalent to Item |
2368f04e | 157 | |
4c2d6a70 AC |
158 | procedure Delete |
159 | (Container : in out Set; | |
160 | Item : Element_Type); | |
1ed69f61 AC |
161 | -- Deletes from Container all of the elements equivalent to Item. If there |
162 | -- are no elements equivalent to Item, then it raises Constraint_Error. | |
4c2d6a70 | 163 | |
4c2d6a70 AC |
164 | procedure Delete |
165 | (Container : in out Set; | |
166 | Position : in out Cursor); | |
1ed69f61 AC |
167 | -- If Position equals No_Element, then Constraint_Error is raised. If |
168 | -- Position is associated with a set different from Container, then | |
169 | -- Program_Error is raised. Otherwise, the node designated by Position is | |
170 | -- removed from Container, and Position is set to No_Element. | |
4c2d6a70 AC |
171 | |
172 | procedure Delete_First (Container : in out Set); | |
1ed69f61 | 173 | -- Removes the first node from Container |
4c2d6a70 AC |
174 | |
175 | procedure Delete_Last (Container : in out Set); | |
1ed69f61 | 176 | -- Removes the last node from Container |
4c2d6a70 | 177 | |
4c2d6a70 | 178 | procedure Union (Target : in out Set; Source : Set); |
1ed69f61 AC |
179 | -- If Target is busy (cursor tampering is attempted), the Program_Error is |
180 | -- raised. Otherwise, it inserts each element of Source into | |
181 | -- Target. Elements are inserted in the canonical order for multisets, such | |
182 | -- that the elements from Source are inserted after equivalent elements | |
183 | -- already in Target. | |
4c2d6a70 AC |
184 | |
185 | function Union (Left, Right : Set) return Set; | |
1ed69f61 AC |
186 | -- Returns a set comprising the all elements from Left and all of the |
187 | -- elements from Right. The elements from Right follow the equivalent | |
188 | -- elements from Left. | |
4c2d6a70 AC |
189 | |
190 | function "or" (Left, Right : Set) return Set renames Union; | |
191 | ||
192 | procedure Intersection (Target : in out Set; Source : Set); | |
1ed69f61 AC |
193 | -- If Target denotes the same object as Source, the operation does |
194 | -- nothing. If Target is busy (cursor tampering is attempted), | |
195 | -- Program_Error is raised. Otherwise, the elements in Target having no | |
196 | -- equivalent element in Source are deleted from Target. | |
4c2d6a70 AC |
197 | |
198 | function Intersection (Left, Right : Set) return Set; | |
1ed69f61 AC |
199 | -- If Left denotes the same object as Right, then the function returns a |
200 | -- copy of Left. Otherwise, it returns a set comprising the equivalent | |
201 | -- elements from both Left and Right. Items are inserted in the result set | |
202 | -- in canonical order, such that the elements from Left precede the | |
203 | -- equivalent elements from Right. | |
4c2d6a70 AC |
204 | |
205 | function "and" (Left, Right : Set) return Set renames Intersection; | |
206 | ||
207 | procedure Difference (Target : in out Set; Source : Set); | |
1ed69f61 AC |
208 | -- If Target is busy (cursor tampering is attempted), then Program_Error is |
209 | -- raised. Otherwise, the elements in Target that are equivalent to | |
210 | -- elements in Source are deleted from Target. | |
4c2d6a70 AC |
211 | |
212 | function Difference (Left, Right : Set) return Set; | |
1ed69f61 AC |
213 | -- Returns a set comprising the elements from Left that have no equivalent |
214 | -- element in Right. | |
4c2d6a70 AC |
215 | |
216 | function "-" (Left, Right : Set) return Set renames Difference; | |
217 | ||
218 | procedure Symmetric_Difference (Target : in out Set; Source : Set); | |
1ed69f61 AC |
219 | -- If Target is busy, then Program_Error is raised. Otherwise, the elements |
220 | -- in Target equivalent to elements in Source are deleted from Target, and | |
221 | -- the elements in Source not equivalent to elements in Target are inserted | |
222 | -- into Target. | |
4c2d6a70 AC |
223 | |
224 | function Symmetric_Difference (Left, Right : Set) return Set; | |
1ed69f61 AC |
225 | -- Returns a set comprising the union of the elements from Target having no |
226 | -- equivalent in Source, and the elements of Source having no equivalent in | |
227 | -- Target. | |
4c2d6a70 AC |
228 | |
229 | function "xor" (Left, Right : Set) return Set renames Symmetric_Difference; | |
230 | ||
231 | function Overlap (Left, Right : Set) return Boolean; | |
1ed69f61 AC |
232 | -- Returns True if Left contains an element equivalent to an element of |
233 | -- Right. | |
4c2d6a70 AC |
234 | |
235 | function Is_Subset (Subset : Set; Of_Set : Set) return Boolean; | |
1ed69f61 AC |
236 | -- Returns True if every element in Subset has an equivalent element in |
237 | -- Of_Set. | |
4c2d6a70 | 238 | |
4c2d6a70 | 239 | function First (Container : Set) return Cursor; |
1ed69f61 AC |
240 | -- If Container is empty, the function returns No_Element. Otherwise, it |
241 | -- returns a cursor designating the smallest element. | |
4c2d6a70 AC |
242 | |
243 | function First_Element (Container : Set) return Element_Type; | |
1ed69f61 | 244 | -- Equivalent to Element (First (Container)) |
4c2d6a70 AC |
245 | |
246 | function Last (Container : Set) return Cursor; | |
1ed69f61 AC |
247 | -- If Container is empty, the function returns No_Element. Otherwise, it |
248 | -- returns a cursor designating the largest element. | |
4c2d6a70 AC |
249 | |
250 | function Last_Element (Container : Set) return Element_Type; | |
1ed69f61 | 251 | -- Equivalent to Element (Last (Container)) |
4c2d6a70 AC |
252 | |
253 | function Next (Position : Cursor) return Cursor; | |
1ed69f61 AC |
254 | -- If Position equals No_Element or Last (Container), the function returns |
255 | -- No_Element. Otherwise, it returns a cursor designating the node that | |
256 | -- immediately follows (as per the insertion order) the node designated by | |
257 | -- Position. | |
4c2d6a70 | 258 | |
4c2d6a70 | 259 | procedure Next (Position : in out Cursor); |
1ed69f61 | 260 | -- Equivalent to Position := Next (Position) |
4c2d6a70 | 261 | |
8704d4b3 | 262 | function Previous (Position : Cursor) return Cursor; |
1ed69f61 AC |
263 | -- If Position equals No_Element or First (Container), the function returns |
264 | -- No_Element. Otherwise, it returns a cursor designating the node that | |
265 | -- immediately precedes (as per the insertion order) the node designated by | |
266 | -- Position. | |
8704d4b3 | 267 | |
4c2d6a70 | 268 | procedure Previous (Position : in out Cursor); |
1ed69f61 | 269 | -- Equivalent to Position := Previous (Position) |
4c2d6a70 | 270 | |
2368f04e | 271 | function Find (Container : Set; Item : Element_Type) return Cursor; |
1ed69f61 AC |
272 | -- Returns a cursor designating the first element in Container equivalent |
273 | -- to Item. If there is no equivalent element, it returns No_Element. | |
2368f04e MH |
274 | |
275 | function Floor (Container : Set; Item : Element_Type) return Cursor; | |
1ed69f61 AC |
276 | -- If Container is empty, the function returns No_Element. If Item is |
277 | -- equivalent to elements in Container, it returns a cursor designating the | |
278 | -- first equivalent element. Otherwise, it returns a cursor designating the | |
279 | -- largest element less than Item, or No_Element if all elements are | |
280 | -- greater than Item. | |
2368f04e MH |
281 | |
282 | function Ceiling (Container : Set; Item : Element_Type) return Cursor; | |
1ed69f61 AC |
283 | -- If Container is empty, the function returns No_Element. If Item is |
284 | -- equivalent to elements of Container, it returns a cursor designating the | |
285 | -- last equivalent element. Otherwise, it returns a cursor designating the | |
286 | -- smallest element greater than Item, or No_Element if all elements are | |
287 | -- less than Item. | |
2368f04e MH |
288 | |
289 | function Contains (Container : Set; Item : Element_Type) return Boolean; | |
1ed69f61 | 290 | -- Equivalent to Container.Find (Item) /= No_Element |
2368f04e | 291 | |
4c2d6a70 | 292 | function Has_Element (Position : Cursor) return Boolean; |
1ed69f61 | 293 | -- Equivalent to Position /= No_Element |
4c2d6a70 AC |
294 | |
295 | function "<" (Left, Right : Cursor) return Boolean; | |
1ed69f61 | 296 | -- Equivalent to Element (Left) < Element (Right) |
4c2d6a70 AC |
297 | |
298 | function ">" (Left, Right : Cursor) return Boolean; | |
1ed69f61 | 299 | -- Equivalent to Element (Right) < Element (Left) |
4c2d6a70 AC |
300 | |
301 | function "<" (Left : Cursor; Right : Element_Type) return Boolean; | |
1ed69f61 | 302 | -- Equivalent to Element (Left) < Right |
4c2d6a70 AC |
303 | |
304 | function ">" (Left : Cursor; Right : Element_Type) return Boolean; | |
1ed69f61 | 305 | -- Equivalent to Right < Element (Left) |
4c2d6a70 AC |
306 | |
307 | function "<" (Left : Element_Type; Right : Cursor) return Boolean; | |
1ed69f61 | 308 | -- Equivalent to Left < Element (Right) |
4c2d6a70 AC |
309 | |
310 | function ">" (Left : Element_Type; Right : Cursor) return Boolean; | |
1ed69f61 | 311 | -- Equivalent to Element (Right) < Left |
4c2d6a70 AC |
312 | |
313 | procedure Iterate | |
314 | (Container : Set; | |
315 | Process : not null access procedure (Position : Cursor)); | |
1ed69f61 AC |
316 | -- Calls Process with a cursor designating each element of Container, in |
317 | -- order from Container.First to Container.Last. | |
4c2d6a70 AC |
318 | |
319 | procedure Reverse_Iterate | |
320 | (Container : Set; | |
321 | Process : not null access procedure (Position : Cursor)); | |
1ed69f61 AC |
322 | -- Calls Process with a cursor designating each element of Container, in |
323 | -- order from Container.Last to Container.First. | |
4c2d6a70 AC |
324 | |
325 | procedure Iterate | |
326 | (Container : Set; | |
327 | Item : Element_Type; | |
328 | Process : not null access procedure (Position : Cursor)); | |
1ed69f61 AC |
329 | -- Call Process with a cursor designating each element equivalent to Item, |
330 | -- in order from Container.Floor (Item) to Container.Ceiling (Item). | |
4c2d6a70 AC |
331 | |
332 | procedure Reverse_Iterate | |
333 | (Container : Set; | |
334 | Item : Element_Type; | |
335 | Process : not null access procedure (Position : Cursor)); | |
1ed69f61 AC |
336 | -- Call Process with a cursor designating each element equivalent to Item, |
337 | -- in order from Container.Ceiling (Item) to Container.Floor (Item). | |
4c2d6a70 AC |
338 | |
339 | generic | |
2368f04e | 340 | type Key_Type (<>) is private; |
4c2d6a70 AC |
341 | |
342 | with function Key (Element : Element_Type) return Key_Type; | |
343 | ||
2368f04e | 344 | with function "<" (Left, Right : Key_Type) return Boolean is <>; |
4c2d6a70 AC |
345 | |
346 | package Generic_Keys is | |
347 | ||
2368f04e | 348 | function Equivalent_Keys (Left, Right : Key_Type) return Boolean; |
1ed69f61 AC |
349 | -- Returns False if Left is less than Right, or Right is less than Left; |
350 | -- otherwise, it returns True. | |
4c2d6a70 AC |
351 | |
352 | function Key (Position : Cursor) return Key_Type; | |
1ed69f61 | 353 | -- Equivalent to Key (Element (Position)) |
4c2d6a70 AC |
354 | |
355 | function Element (Container : Set; Key : Key_Type) return Element_Type; | |
1ed69f61 | 356 | -- Equivalent to Element (Find (Container, Key)) |
4c2d6a70 | 357 | |
4c2d6a70 | 358 | procedure Exclude (Container : in out Set; Key : Key_Type); |
1ed69f61 | 359 | -- Deletes from Container any elements whose key is equivalent to Key |
4c2d6a70 | 360 | |
2368f04e | 361 | procedure Delete (Container : in out Set; Key : Key_Type); |
1ed69f61 AC |
362 | -- Deletes from Container any elements whose key is equivalent to |
363 | -- Key. If there are no such elements, then it raises Constraint_Error. | |
2368f04e MH |
364 | |
365 | function Find (Container : Set; Key : Key_Type) return Cursor; | |
1ed69f61 AC |
366 | -- Returns a cursor designating the first element in Container whose key |
367 | -- is equivalent to Key. If there is no equivalent element, it returns | |
368 | -- No_Element. | |
4c2d6a70 | 369 | |
2368f04e | 370 | function Floor (Container : Set; Key : Key_Type) return Cursor; |
1ed69f61 AC |
371 | -- If Container is empty, the function returns No_Element. If Item is |
372 | -- equivalent to the keys of elements in Container, it returns a cursor | |
373 | -- designating the first such element. Otherwise, it returns a cursor | |
374 | -- designating the largest element whose key is less than Item, or | |
375 | -- No_Element if all keys are greater than Item. | |
4c2d6a70 | 376 | |
2368f04e | 377 | function Ceiling (Container : Set; Key : Key_Type) return Cursor; |
1ed69f61 AC |
378 | -- If Container is empty, the function returns No_Element. If Item is |
379 | -- equivalent to the keys of elements of Container, it returns a cursor | |
380 | -- designating the last such element. Otherwise, it returns a cursor | |
381 | -- designating the smallest element whose key is greater than Item, or | |
382 | -- No_Element if all keys are less than Item. | |
4c2d6a70 | 383 | |
2368f04e | 384 | function Contains (Container : Set; Key : Key_Type) return Boolean; |
1ed69f61 | 385 | -- Equivalent to Find (Container, Key) /= No_Element |
4c2d6a70 | 386 | |
1ed69f61 | 387 | procedure Update_Element -- Update_Element_Preserving_Key ??? |
4c2d6a70 AC |
388 | (Container : in out Set; |
389 | Position : Cursor; | |
390 | Process : not null access | |
2368f04e | 391 | procedure (Element : in out Element_Type)); |
1ed69f61 AC |
392 | -- If Position equals No_Element, then Constraint_Error is raised. If |
393 | -- Position is associated with a set object different from Container, | |
394 | -- then Program_Error is raised. Otherwise, it makes a copy of the key | |
395 | -- of the element designated by Position, and then calls Process with | |
396 | -- the element as the parameter. Update_Element then compares the key | |
397 | -- value obtained before calling Process to the key value obtained from | |
398 | -- the element after calling Process. If the keys are equivalent then | |
399 | -- the operation terminates. If Container is busy (cursor tampering has | |
400 | -- been attempted), then Program_Error is raised. Otherwise, the node | |
401 | -- is moved to its new position (in canonical order). | |
4c2d6a70 AC |
402 | |
403 | procedure Iterate | |
404 | (Container : Set; | |
405 | Key : Key_Type; | |
406 | Process : not null access procedure (Position : Cursor)); | |
1ed69f61 AC |
407 | -- Call Process with a cursor designating each element equivalent to |
408 | -- Key, in order from Floor (Container, Key) to | |
409 | -- Ceiling (Container, Key). | |
4c2d6a70 AC |
410 | |
411 | procedure Reverse_Iterate | |
412 | (Container : Set; | |
413 | Key : Key_Type; | |
414 | Process : not null access procedure (Position : Cursor)); | |
1ed69f61 AC |
415 | -- Call Process with a cursor designating each element equivalent to |
416 | -- Key, in order from Ceiling (Container, Key) to | |
417 | -- Floor (Container, Key). | |
4c2d6a70 AC |
418 | |
419 | end Generic_Keys; | |
420 | ||
421 | private | |
422 | ||
f97ccb3a BD |
423 | pragma Inline (Next); |
424 | pragma Inline (Previous); | |
425 | ||
4c2d6a70 AC |
426 | type Node_Type; |
427 | type Node_Access is access Node_Type; | |
428 | ||
8704d4b3 MH |
429 | type Node_Type is limited record |
430 | Parent : Node_Access; | |
431 | Left : Node_Access; | |
432 | Right : Node_Access; | |
433 | Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red; | |
434 | Element : Element_Type; | |
435 | end record; | |
4c2d6a70 | 436 | |
3c25856a AC |
437 | package Tree_Types is |
438 | new Red_Black_Trees.Generic_Tree_Types (Node_Type, Node_Access); | |
4c2d6a70 | 439 | |
8704d4b3 MH |
440 | type Set is new Ada.Finalization.Controlled with record |
441 | Tree : Tree_Types.Tree_Type; | |
4c2d6a70 AC |
442 | end record; |
443 | ||
2a6b365a | 444 | overriding |
4c2d6a70 AC |
445 | procedure Adjust (Container : in out Set); |
446 | ||
2a6b365a | 447 | overriding |
4c2d6a70 AC |
448 | procedure Finalize (Container : in out Set) renames Clear; |
449 | ||
8704d4b3 MH |
450 | use Red_Black_Trees; |
451 | use Tree_Types; | |
452 | use Ada.Finalization; | |
2368f04e | 453 | use Ada.Streams; |
8704d4b3 MH |
454 | |
455 | type Set_Access is access all Set; | |
4c2d6a70 AC |
456 | for Set_Access'Storage_Size use 0; |
457 | ||
458 | type Cursor is record | |
459 | Container : Set_Access; | |
460 | Node : Node_Access; | |
461 | end record; | |
462 | ||
2368f04e | 463 | procedure Write |
d90e94c7 | 464 | (Stream : not null access Root_Stream_Type'Class; |
2368f04e | 465 | Item : Cursor); |
4c2d6a70 | 466 | |
2368f04e MH |
467 | for Cursor'Write use Write; |
468 | ||
469 | procedure Read | |
d90e94c7 | 470 | (Stream : not null access Root_Stream_Type'Class; |
2368f04e MH |
471 | Item : out Cursor); |
472 | ||
473 | for Cursor'Read use Read; | |
474 | ||
475 | No_Element : constant Cursor := Cursor'(null, null); | |
4c2d6a70 AC |
476 | |
477 | procedure Write | |
d90e94c7 | 478 | (Stream : not null access Root_Stream_Type'Class; |
4c2d6a70 AC |
479 | Container : Set); |
480 | ||
481 | for Set'Write use Write; | |
482 | ||
483 | procedure Read | |
d90e94c7 | 484 | (Stream : not null access Root_Stream_Type'Class; |
4c2d6a70 AC |
485 | Container : out Set); |
486 | ||
487 | for Set'Read use Read; | |
488 | ||
489 | Empty_Set : constant Set := | |
8704d4b3 MH |
490 | (Controlled with Tree => (First => null, |
491 | Last => null, | |
492 | Root => null, | |
493 | Length => 0, | |
494 | Busy => 0, | |
495 | Lock => 0)); | |
4c2d6a70 AC |
496 | |
497 | end Ada.Containers.Ordered_Multisets; |