File : a-cborse.ads
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 _ O R D E R E D _ S E T S --
6 -- --
7 -- S p e c --
8 -- --
9 -- Copyright (C) 2004-2015, 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 -- --
23 -- --
24 -- --
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 with Ada.Containers.Helpers;
37 private with Ada.Containers.Red_Black_Trees;
38 private with Ada.Streams;
39 private with Ada.Finalization;
40
41 generic
42 type Element_Type is private;
43
44 with function "<" (Left, Right : Element_Type) return Boolean is <>;
45 with function "=" (Left, Right : Element_Type) return Boolean is <>;
46
47 package Ada.Containers.Bounded_Ordered_Sets is
48 pragma Annotate (CodePeer, Skip_Analysis);
49 pragma Pure;
50 pragma Remote_Types;
51
52 function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
53
54 type Set (Capacity : Count_Type) is tagged private
55 with Constant_Indexing => Constant_Reference,
56 Default_Iterator => Iterate,
57 Iterator_Element => Element_Type;
58
59 pragma Preelaborable_Initialization (Set);
60
61 type Cursor is private;
62 pragma Preelaborable_Initialization (Cursor);
63
64 Empty_Set : constant Set;
65
66 No_Element : constant Cursor;
67
68 function Has_Element (Position : Cursor) return Boolean;
69
70 package Set_Iterator_Interfaces is new
71 Ada.Iterator_Interfaces (Cursor, Has_Element);
72
73 function "=" (Left, Right : Set) return Boolean;
74
75 function Equivalent_Sets (Left, Right : Set) return Boolean;
76
77 function To_Set (New_Item : Element_Type) return Set;
78
79 function Length (Container : Set) return Count_Type;
80
81 function Is_Empty (Container : Set) return Boolean;
82
83 procedure Clear (Container : in out Set);
84
85 function Element (Position : Cursor) return Element_Type;
86
87 procedure Replace_Element
88 (Container : in out Set;
89 Position : Cursor;
90 New_Item : Element_Type);
91
92 procedure Query_Element
93 (Position : Cursor;
94 Process : not null access procedure (Element : Element_Type));
95
96 type Constant_Reference_Type
97 (Element : not null access constant Element_Type) is
98 private
99 with
100 Implicit_Dereference => Element;
101
102 function Constant_Reference
103 (Container : aliased Set;
104 Position : Cursor) return Constant_Reference_Type;
105
106 procedure Assign (Target : in out Set; Source : Set);
107
108 function Copy (Source : Set; Capacity : Count_Type := 0) return Set;
109
110 procedure Move (Target : in out Set; Source : in out Set);
111
112 procedure Insert
113 (Container : in out Set;
114 New_Item : Element_Type;
115 Position : out Cursor;
116 Inserted : out Boolean);
117
118 procedure Insert
119 (Container : in out Set;
120 New_Item : Element_Type);
121
122 procedure Include
123 (Container : in out Set;
124 New_Item : Element_Type);
125
126 procedure Replace
127 (Container : in out Set;
128 New_Item : Element_Type);
129
130 procedure Exclude
131 (Container : in out Set;
132 Item : Element_Type);
133
134 procedure Delete
135 (Container : in out Set;
136 Item : Element_Type);
137
138 procedure Delete
139 (Container : in out Set;
140 Position : in out Cursor);
141
142 procedure Delete_First (Container : in out Set);
143
144 procedure Delete_Last (Container : in out Set);
145
146 procedure Union (Target : in out Set; Source : Set);
147
148 function Union (Left, Right : Set) return Set;
149
150 function "or" (Left, Right : Set) return Set renames Union;
151
152 procedure Intersection (Target : in out Set; Source : Set);
153
154 function Intersection (Left, Right : Set) return Set;
155
156 function "and" (Left, Right : Set) return Set renames Intersection;
157
158 procedure Difference (Target : in out Set; Source : Set);
159
160 function Difference (Left, Right : Set) return Set;
161
162 function "-" (Left, Right : Set) return Set renames Difference;
163
164 procedure Symmetric_Difference (Target : in out Set; Source : Set);
165
166 function Symmetric_Difference (Left, Right : Set) return Set;
167
168 function "xor" (Left, Right : Set) return Set renames Symmetric_Difference;
169
170 function Overlap (Left, Right : Set) return Boolean;
171
172 function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
173
174 function First (Container : Set) return Cursor;
175
176 function First_Element (Container : Set) return Element_Type;
177
178 function Last (Container : Set) return Cursor;
179
180 function Last_Element (Container : Set) return Element_Type;
181
182 function Next (Position : Cursor) return Cursor;
183
184 procedure Next (Position : in out Cursor);
185
186 function Previous (Position : Cursor) return Cursor;
187
188 procedure Previous (Position : in out Cursor);
189
190 function Find (Container : Set; Item : Element_Type) return Cursor;
191
192 function Floor (Container : Set; Item : Element_Type) return Cursor;
193
194 function Ceiling (Container : Set; Item : Element_Type) return Cursor;
195
196 function Contains (Container : Set; Item : Element_Type) return Boolean;
197
198 function "<" (Left, Right : Cursor) return Boolean;
199
200 function ">" (Left, Right : Cursor) return Boolean;
201
202 function "<" (Left : Cursor; Right : Element_Type) return Boolean;
203
204 function ">" (Left : Cursor; Right : Element_Type) return Boolean;
205
206 function "<" (Left : Element_Type; Right : Cursor) return Boolean;
207
208 function ">" (Left : Element_Type; Right : Cursor) return Boolean;
209
210 procedure Iterate
211 (Container : Set;
212 Process : not null access procedure (Position : Cursor));
213
214 procedure Reverse_Iterate
215 (Container : Set;
216 Process : not null access procedure (Position : Cursor));
217
218 function Iterate
219 (Container : Set)
220 return Set_Iterator_Interfaces.Reversible_Iterator'class;
221
222 function Iterate
223 (Container : Set;
224 Start : Cursor)
225 return Set_Iterator_Interfaces.Reversible_Iterator'class;
226
227 generic
228 type Key_Type (<>) is private;
229
230 with function Key (Element : Element_Type) return Key_Type;
231
232 with function "<" (Left, Right : Key_Type) return Boolean is <>;
233
234 package Generic_Keys is
235
236 function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
237
238 function Key (Position : Cursor) return Key_Type;
239
240 function Element (Container : Set; Key : Key_Type) return Element_Type;
241
242 procedure Replace
243 (Container : in out Set;
244 Key : Key_Type;
245 New_Item : Element_Type);
246
247 procedure Exclude (Container : in out Set; Key : Key_Type);
248
249 procedure Delete (Container : in out Set; Key : Key_Type);
250
251 function Find (Container : Set; Key : Key_Type) return Cursor;
252
253 function Floor (Container : Set; Key : Key_Type) return Cursor;
254
255 function Ceiling (Container : Set; Key : Key_Type) return Cursor;
256
257 function Contains (Container : Set; Key : Key_Type) return Boolean;
258
259 procedure Update_Element_Preserving_Key
260 (Container : in out Set;
261 Position : Cursor;
262 Process : not null access
263 procedure (Element : in out Element_Type));
264
265 type Reference_Type (Element : not null access Element_Type) is private
266 with
267 Implicit_Dereference => Element;
268
269 function Reference_Preserving_Key
270 (Container : aliased in out Set;
271 Position : Cursor) return Reference_Type;
272
273 function Constant_Reference
274 (Container : aliased Set;
275 Key : Key_Type) return Constant_Reference_Type;
276
277 function Reference_Preserving_Key
278 (Container : aliased in out Set;
279 Key : Key_Type) return Reference_Type;
280
281 private
282 type Set_Access is access all Set;
283 for Set_Access'Storage_Size use 0;
284
285 type Key_Access is access all Key_Type;
286
287 use Ada.Streams;
288
289 package Impl is new Helpers.Generic_Implementation;
290
291 type Reference_Control_Type is
292 new Impl.Reference_Control_Type with
293 record
294 Container : Set_Access;
295 Pos : Cursor;
296 Old_Key : Key_Access;
297 end record;
298
299 overriding procedure Finalize (Control : in out Reference_Control_Type);
300 pragma Inline (Finalize);
301
302 type Reference_Type (Element : not null access Element_Type) is record
303 Control : Reference_Control_Type;
304 end record;
305
306 procedure Read
307 (Stream : not null access Root_Stream_Type'Class;
308 Item : out Reference_Type);
309
310 for Reference_Type'Read use Read;
311
312 procedure Write
313 (Stream : not null access Root_Stream_Type'Class;
314 Item : Reference_Type);
315
316 for Reference_Type'Write use Write;
317
318 end Generic_Keys;
319
320 private
321
322 pragma Inline (Next);
323 pragma Inline (Previous);
324
325 type Node_Type is record
326 Parent : Count_Type;
327 Left : Count_Type;
328 Right : Count_Type;
329 Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
330 Element : aliased Element_Type;
331 end record;
332
333 package Tree_Types is
334 new Red_Black_Trees.Generic_Bounded_Tree_Types (Node_Type);
335
336 type Set (Capacity : Count_Type) is
337 new Tree_Types.Tree_Type (Capacity) with null record;
338
339 use Tree_Types, Tree_Types.Implementation;
340 use Ada.Finalization;
341 use Ada.Streams;
342
343 procedure Write
344 (Stream : not null access Root_Stream_Type'Class;
345 Container : Set);
346
347 for Set'Write use Write;
348
349 procedure Read
350 (Stream : not null access Root_Stream_Type'Class;
351 Container : out Set);
352
353 for Set'Read use Read;
354
355 type Set_Access is access all Set;
356 for Set_Access'Storage_Size use 0;
357
358 -- Note: If a Cursor object has no explicit initialization expression,
359 -- it must default initialize to the same value as constant No_Element.
360 -- The Node component of type Cursor has scalar type Count_Type, so it
361 -- requires an explicit initialization expression of its own declaration,
362 -- in order for objects of record type Cursor to properly initialize.
363
364 type Cursor is record
365 Container : Set_Access;
366 Node : Count_Type := 0;
367 end record;
368
369 procedure Write
370 (Stream : not null access Root_Stream_Type'Class;
371 Item : Cursor);
372
373 for Cursor'Write use Write;
374
375 procedure Read
376 (Stream : not null access Root_Stream_Type'Class;
377 Item : out Cursor);
378
379 for Cursor'Read use Read;
380
381 subtype Reference_Control_Type is Implementation.Reference_Control_Type;
382 -- It is necessary to rename this here, so that the compiler can find it
383
384 type Constant_Reference_Type
385 (Element : not null access constant Element_Type) is
386 record
387 Control : Reference_Control_Type :=
388 raise Program_Error with "uninitialized reference";
389 -- The RM says, "The default initialization of an object of
390 -- type Constant_Reference_Type or Reference_Type propagates
391 -- Program_Error."
392 end record;
393
394 procedure Read
395 (Stream : not null access Root_Stream_Type'Class;
396 Item : out Constant_Reference_Type);
397
398 for Constant_Reference_Type'Read use Read;
399
400 procedure Write
401 (Stream : not null access Root_Stream_Type'Class;
402 Item : Constant_Reference_Type);
403
404 for Constant_Reference_Type'Write use Write;
405
406 -- Three operations are used to optimize in the expansion of "for ... of"
407 -- loops: the Next(Cursor) procedure in the visible part, and the following
408 -- Pseudo_Reference and Get_Element_Access functions. See Sem_Ch5 for
409 -- details.
410
411 function Pseudo_Reference
412 (Container : aliased Set'Class) return Reference_Control_Type;
413 pragma Inline (Pseudo_Reference);
414 -- Creates an object of type Reference_Control_Type pointing to the
415 -- container, and increments the Lock. Finalization of this object will
416 -- decrement the Lock.
417
418 type Element_Access is access all Element_Type with
419 Storage_Size => 0;
420
421 function Get_Element_Access
422 (Position : Cursor) return not null Element_Access;
423 -- Returns a pointer to the element designated by Position.
424
425 Empty_Set : constant Set := Set'(Tree_Type with Capacity => 0);
426
427 No_Element : constant Cursor := Cursor'(null, 0);
428
429 type Iterator is new Limited_Controlled and
430 Set_Iterator_Interfaces.Reversible_Iterator with
431 record
432 Container : Set_Access;
433 Node : Count_Type;
434 end record
435 with Disable_Controlled => not T_Check;
436
437 overriding procedure Finalize (Object : in out Iterator);
438
439 overriding function First (Object : Iterator) return Cursor;
440 overriding function Last (Object : Iterator) return Cursor;
441
442 overriding function Next
443 (Object : Iterator;
444 Position : Cursor) return Cursor;
445
446 overriding function Previous
447 (Object : Iterator;
448 Position : Cursor) return Cursor;
449
450 end Ada.Containers.Bounded_Ordered_Sets;