File : a-ciorse.ads
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT LIBRARY COMPONENTS --
4 -- --
5 -- ADA.CONTAINERS.INDEFINITE_ORDERED_SETS --
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.Finalization;
39 private with Ada.Streams;
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.Indefinite_Ordered_Sets is
48 pragma Annotate (CodePeer, Skip_Analysis);
49 pragma Preelaborate;
50 pragma Remote_Types;
51
52 function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
53
54 type Set is tagged private with
55 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 with
99 Implicit_Dereference => Element;
100
101 function Constant_Reference
102 (Container : aliased Set;
103 Position : Cursor) return Constant_Reference_Type;
104 pragma Inline (Constant_Reference);
105
106 procedure Assign (Target : in out Set; Source : Set);
107
108 function Copy (Source : Set) 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
191 (Container : Set;
192 Item : Element_Type) return Cursor;
193
194 function Floor
195 (Container : Set;
196 Item : Element_Type) return Cursor;
197
198 function Ceiling
199 (Container : Set;
200 Item : Element_Type) return Cursor;
201
202 function Contains
203 (Container : Set;
204 Item : Element_Type) return Boolean;
205
206 function "<" (Left, Right : Cursor) return Boolean;
207
208 function ">" (Left, Right : Cursor) return Boolean;
209
210 function "<" (Left : Cursor; Right : Element_Type) return Boolean;
211
212 function ">" (Left : Cursor; Right : Element_Type) return Boolean;
213
214 function "<" (Left : Element_Type; Right : Cursor) return Boolean;
215
216 function ">" (Left : Element_Type; Right : Cursor) return Boolean;
217
218 procedure Iterate
219 (Container : Set;
220 Process : not null access procedure (Position : Cursor));
221
222 procedure Reverse_Iterate
223 (Container : Set;
224 Process : not null access procedure (Position : Cursor));
225
226 function Iterate
227 (Container : Set)
228 return Set_Iterator_Interfaces.Reversible_Iterator'class;
229
230 function Iterate
231 (Container : Set;
232 Start : Cursor)
233 return Set_Iterator_Interfaces.Reversible_Iterator'class;
234
235 generic
236 type Key_Type (<>) is private;
237
238 with function Key (Element : Element_Type) return Key_Type;
239
240 with function "<" (Left, Right : Key_Type) return Boolean is <>;
241
242 package Generic_Keys is
243
244 function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
245
246 function Key (Position : Cursor) return Key_Type;
247
248 function Element (Container : Set; Key : Key_Type) return Element_Type;
249
250 procedure Replace
251 (Container : in out Set;
252 Key : Key_Type;
253 New_Item : Element_Type);
254
255 procedure Exclude (Container : in out Set; Key : Key_Type);
256
257 procedure Delete (Container : in out Set; Key : Key_Type);
258
259 function Find
260 (Container : Set;
261 Key : Key_Type) return Cursor;
262
263 function Floor
264 (Container : Set;
265 Key : Key_Type) return Cursor;
266
267 function Ceiling
268 (Container : Set;
269 Key : Key_Type) return Cursor;
270
271 function Contains
272 (Container : Set;
273 Key : Key_Type) return Boolean;
274
275 procedure Update_Element_Preserving_Key
276 (Container : in out Set;
277 Position : Cursor;
278 Process : not null access
279 procedure (Element : in out Element_Type));
280
281 type Reference_Type (Element : not null access Element_Type) is private
282 with
283 Implicit_Dereference => Element;
284
285 function Reference_Preserving_Key
286 (Container : aliased in out Set;
287 Position : Cursor) return Reference_Type;
288
289 function Constant_Reference
290 (Container : aliased Set;
291 Key : Key_Type) return Constant_Reference_Type;
292
293 function Reference_Preserving_Key
294 (Container : aliased in out Set;
295 Key : Key_Type) return Reference_Type;
296
297 private
298 type Set_Access is access all Set;
299 for Set_Access'Storage_Size use 0;
300
301 type Key_Access is access all Key_Type;
302
303 package Impl is new Helpers.Generic_Implementation;
304
305 type Reference_Control_Type is
306 new Impl.Reference_Control_Type with
307 record
308 Container : Set_Access;
309 Pos : Cursor;
310 Old_Key : Key_Access;
311 end record;
312
313 overriding procedure Finalize (Control : in out Reference_Control_Type);
314 pragma Inline (Finalize);
315
316 type Reference_Type (Element : not null access Element_Type) is record
317 Control : Reference_Control_Type;
318 end record;
319
320 use Ada.Streams;
321
322 procedure Write
323 (Stream : not null access Root_Stream_Type'Class;
324 Item : Reference_Type);
325
326 for Reference_Type'Write use Write;
327
328 procedure Read
329 (Stream : not null access Root_Stream_Type'Class;
330 Item : out Reference_Type);
331
332 for Reference_Type'Read use Read;
333 end Generic_Keys;
334
335 private
336 pragma Inline (Next);
337 pragma Inline (Previous);
338
339 type Node_Type;
340 type Node_Access is access Node_Type;
341
342 type Element_Access is access all Element_Type;
343
344 type Node_Type is limited record
345 Parent : Node_Access;
346 Left : Node_Access;
347 Right : Node_Access;
348 Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
349 Element : Element_Access;
350 end record;
351
352 package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
353 (Node_Type,
354 Node_Access);
355
356 type Set is new Ada.Finalization.Controlled with record
357 Tree : Tree_Types.Tree_Type;
358 end record;
359
360 overriding procedure Adjust (Container : in out Set);
361
362 overriding procedure Finalize (Container : in out Set) renames Clear;
363
364 use Red_Black_Trees;
365 use Tree_Types, Tree_Types.Implementation;
366 use Ada.Finalization;
367 use Ada.Streams;
368
369 procedure Write
370 (Stream : not null access Root_Stream_Type'Class;
371 Container : Set);
372
373 for Set'Write use Write;
374
375 procedure Read
376 (Stream : not null access Root_Stream_Type'Class;
377 Container : out Set);
378
379 for Set'Read use Read;
380
381 type Set_Access is access all Set;
382 for Set_Access'Storage_Size use 0;
383
384 type Cursor is record
385 Container : Set_Access;
386 Node : Node_Access;
387 end record;
388
389 procedure Write
390 (Stream : not null access Root_Stream_Type'Class;
391 Item : Cursor);
392
393 for Cursor'Write use Write;
394
395 procedure Read
396 (Stream : not null access Root_Stream_Type'Class;
397 Item : out Cursor);
398
399 for Cursor'Read use Read;
400
401 subtype Reference_Control_Type is Implementation.Reference_Control_Type;
402 -- It is necessary to rename this here, so that the compiler can find it
403
404 type Constant_Reference_Type
405 (Element : not null access constant Element_Type) is
406 record
407 Control : Reference_Control_Type :=
408 raise Program_Error with "uninitialized reference";
409 -- The RM says, "The default initialization of an object of
410 -- type Constant_Reference_Type or Reference_Type propagates
411 -- Program_Error."
412 end record;
413
414 procedure Read
415 (Stream : not null access Root_Stream_Type'Class;
416 Item : out Constant_Reference_Type);
417
418 for Constant_Reference_Type'Read use Read;
419
420 procedure Write
421 (Stream : not null access Root_Stream_Type'Class;
422 Item : Constant_Reference_Type);
423
424 for Constant_Reference_Type'Write use Write;
425
426 -- Three operations are used to optimize in the expansion of "for ... of"
427 -- loops: the Next(Cursor) procedure in the visible part, and the following
428 -- Pseudo_Reference and Get_Element_Access functions. See Sem_Ch5 for
429 -- details.
430
431 function Pseudo_Reference
432 (Container : aliased Set'Class) return Reference_Control_Type;
433 pragma Inline (Pseudo_Reference);
434 -- Creates an object of type Reference_Control_Type pointing to the
435 -- container, and increments the Lock. Finalization of this object will
436 -- decrement the Lock.
437
438 function Get_Element_Access
439 (Position : Cursor) return not null Element_Access;
440 -- Returns a pointer to the element designated by Position.
441
442 Empty_Set : constant Set := (Controlled with others => <>);
443
444 No_Element : constant Cursor := Cursor'(null, null);
445
446 type Iterator is new Limited_Controlled and
447 Set_Iterator_Interfaces.Reversible_Iterator with
448 record
449 Container : Set_Access;
450 Node : Node_Access;
451 end record
452 with Disable_Controlled => not T_Check;
453
454 overriding procedure Finalize (Object : in out Iterator);
455
456 overriding function First (Object : Iterator) return Cursor;
457 overriding function Last (Object : Iterator) return Cursor;
458
459 overriding function Next
460 (Object : Iterator;
461 Position : Cursor) return Cursor;
462
463 overriding function Previous
464 (Object : Iterator;
465 Position : Cursor) return Cursor;
466
467 end Ada.Containers.Indefinite_Ordered_Sets;