1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.INDEFINITE_ORDERED_SETS --
9 -- Copyright (C) 2004-2018, Free Software Foundation, Inc. --
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. --
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. --
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. --
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/>. --
31 -- This unit was originally developed by Matthew J Heaney. --
32 ------------------------------------------------------------------------------
34 with Ada
.Iterator_Interfaces
;
36 with Ada
.Containers
.Helpers
;
37 private with Ada
.Containers
.Red_Black_Trees
;
38 private with Ada
.Finalization
;
39 private with Ada
.Streams
;
42 type Element_Type
(<>) is private;
44 with function "<" (Left
, Right
: Element_Type
) return Boolean is <>;
45 with function "=" (Left
, Right
: Element_Type
) return Boolean is <>;
47 package Ada
.Containers
.Indefinite_Ordered_Sets
is
48 pragma Annotate
(CodePeer
, Skip_Analysis
);
52 function Equivalent_Elements
(Left
, Right
: Element_Type
) return Boolean;
54 type Set
is tagged private with
55 Constant_Indexing
=> Constant_Reference
,
56 Default_Iterator
=> Iterate
,
57 Iterator_Element
=> Element_Type
;
59 pragma Preelaborable_Initialization
(Set
);
61 type Cursor
is private;
62 pragma Preelaborable_Initialization
(Cursor
);
64 Empty_Set
: constant Set
;
66 No_Element
: constant Cursor
;
68 function Has_Element
(Position
: Cursor
) return Boolean;
70 package Set_Iterator_Interfaces
is new
71 Ada
.Iterator_Interfaces
(Cursor
, Has_Element
);
73 function "=" (Left
, Right
: Set
) return Boolean;
75 function Equivalent_Sets
(Left
, Right
: Set
) return Boolean;
77 function To_Set
(New_Item
: Element_Type
) return Set
;
79 function Length
(Container
: Set
) return Count_Type
;
81 function Is_Empty
(Container
: Set
) return Boolean;
83 procedure Clear
(Container
: in out Set
);
85 function Element
(Position
: Cursor
) return Element_Type
;
87 procedure Replace_Element
88 (Container
: in out Set
;
90 New_Item
: Element_Type
);
92 procedure Query_Element
94 Process
: not null access procedure (Element
: Element_Type
));
96 type Constant_Reference_Type
97 (Element
: not null access constant Element_Type
) is
99 Implicit_Dereference
=> Element
;
101 function Constant_Reference
102 (Container
: aliased Set
;
103 Position
: Cursor
) return Constant_Reference_Type
;
104 pragma Inline
(Constant_Reference
);
106 procedure Assign
(Target
: in out Set
; Source
: Set
);
108 function Copy
(Source
: Set
) return Set
;
110 procedure Move
(Target
: in out Set
; Source
: in out Set
);
113 (Container
: in out Set
;
114 New_Item
: Element_Type
;
115 Position
: out Cursor
;
116 Inserted
: out Boolean);
119 (Container
: in out Set
;
120 New_Item
: Element_Type
);
123 (Container
: in out Set
;
124 New_Item
: Element_Type
);
127 (Container
: in out Set
;
128 New_Item
: Element_Type
);
131 (Container
: in out Set
;
132 Item
: Element_Type
);
135 (Container
: in out Set
;
136 Item
: Element_Type
);
139 (Container
: in out Set
;
140 Position
: in out Cursor
);
142 procedure Delete_First
(Container
: in out Set
);
144 procedure Delete_Last
(Container
: in out Set
);
146 procedure Union
(Target
: in out Set
; Source
: Set
);
148 function Union
(Left
, Right
: Set
) return Set
;
150 function "or" (Left
, Right
: Set
) return Set
renames Union
;
152 procedure Intersection
(Target
: in out Set
; Source
: Set
);
154 function Intersection
(Left
, Right
: Set
) return Set
;
156 function "and" (Left
, Right
: Set
) return Set
renames Intersection
;
158 procedure Difference
(Target
: in out Set
; Source
: Set
);
160 function Difference
(Left
, Right
: Set
) return Set
;
162 function "-" (Left
, Right
: Set
) return Set
renames Difference
;
164 procedure Symmetric_Difference
(Target
: in out Set
; Source
: Set
);
166 function Symmetric_Difference
(Left
, Right
: Set
) return Set
;
168 function "xor" (Left
, Right
: Set
) return Set
renames Symmetric_Difference
;
170 function Overlap
(Left
, Right
: Set
) return Boolean;
172 function Is_Subset
(Subset
: Set
; Of_Set
: Set
) return Boolean;
174 function First
(Container
: Set
) return Cursor
;
176 function First_Element
(Container
: Set
) return Element_Type
;
178 function Last
(Container
: Set
) return Cursor
;
180 function Last_Element
(Container
: Set
) return Element_Type
;
182 function Next
(Position
: Cursor
) return Cursor
;
184 procedure Next
(Position
: in out Cursor
);
186 function Previous
(Position
: Cursor
) return Cursor
;
188 procedure Previous
(Position
: in out Cursor
);
192 Item
: Element_Type
) return Cursor
;
196 Item
: Element_Type
) return Cursor
;
200 Item
: Element_Type
) return Cursor
;
204 Item
: Element_Type
) return Boolean;
206 function "<" (Left
, Right
: Cursor
) return Boolean;
208 function ">" (Left
, Right
: Cursor
) return Boolean;
210 function "<" (Left
: Cursor
; Right
: Element_Type
) return Boolean;
212 function ">" (Left
: Cursor
; Right
: Element_Type
) return Boolean;
214 function "<" (Left
: Element_Type
; Right
: Cursor
) return Boolean;
216 function ">" (Left
: Element_Type
; Right
: Cursor
) return Boolean;
220 Process
: not null access procedure (Position
: Cursor
));
222 procedure Reverse_Iterate
224 Process
: not null access procedure (Position
: Cursor
));
228 return Set_Iterator_Interfaces
.Reversible_Iterator
'class;
233 return Set_Iterator_Interfaces
.Reversible_Iterator
'class;
236 type Key_Type
(<>) is private;
238 with function Key
(Element
: Element_Type
) return Key_Type
;
240 with function "<" (Left
, Right
: Key_Type
) return Boolean is <>;
242 package Generic_Keys
is
244 function Equivalent_Keys
(Left
, Right
: Key_Type
) return Boolean;
246 function Key
(Position
: Cursor
) return Key_Type
;
248 function Element
(Container
: Set
; Key
: Key_Type
) return Element_Type
;
251 (Container
: in out Set
;
253 New_Item
: Element_Type
);
255 procedure Exclude
(Container
: in out Set
; Key
: Key_Type
);
257 procedure Delete
(Container
: in out Set
; Key
: Key_Type
);
261 Key
: Key_Type
) return Cursor
;
265 Key
: Key_Type
) return Cursor
;
269 Key
: Key_Type
) return Cursor
;
273 Key
: Key_Type
) return Boolean;
275 procedure Update_Element_Preserving_Key
276 (Container
: in out Set
;
278 Process
: not null access
279 procedure (Element
: in out Element_Type
));
281 type Reference_Type
(Element
: not null access Element_Type
) is private
283 Implicit_Dereference
=> Element
;
285 function Reference_Preserving_Key
286 (Container
: aliased in out Set
;
287 Position
: Cursor
) return Reference_Type
;
289 function Constant_Reference
290 (Container
: aliased Set
;
291 Key
: Key_Type
) return Constant_Reference_Type
;
293 function Reference_Preserving_Key
294 (Container
: aliased in out Set
;
295 Key
: Key_Type
) return Reference_Type
;
298 type Set_Access
is access all Set
;
299 for Set_Access
'Storage_Size use 0;
301 type Key_Access
is access all Key_Type
;
303 package Impl
is new Helpers
.Generic_Implementation
;
305 type Reference_Control_Type
is
306 new Impl
.Reference_Control_Type
with
308 Container
: Set_Access
;
310 Old_Key
: Key_Access
;
313 overriding
procedure Finalize
(Control
: in out Reference_Control_Type
);
314 pragma Inline
(Finalize
);
316 type Reference_Type
(Element
: not null access Element_Type
) is record
317 Control
: Reference_Control_Type
;
323 (Stream
: not null access Root_Stream_Type
'Class;
324 Item
: Reference_Type
);
326 for Reference_Type
'Write use Write
;
329 (Stream
: not null access Root_Stream_Type
'Class;
330 Item
: out Reference_Type
);
332 for Reference_Type
'Read use Read
;
336 pragma Inline
(Next
);
337 pragma Inline
(Previous
);
340 type Node_Access
is access Node_Type
;
342 type Element_Access
is access all Element_Type
;
344 type Node_Type
is limited record
345 Parent
: Node_Access
;
348 Color
: Red_Black_Trees
.Color_Type
:= Red_Black_Trees
.Red
;
349 Element
: Element_Access
;
352 package Tree_Types
is new Red_Black_Trees
.Generic_Tree_Types
356 type Set
is new Ada
.Finalization
.Controlled
with record
357 Tree
: Tree_Types
.Tree_Type
;
360 overriding
procedure Adjust
(Container
: in out Set
);
362 overriding
procedure Finalize
(Container
: in out Set
) renames Clear
;
365 use Tree_Types
, Tree_Types
.Implementation
;
366 use Ada
.Finalization
;
370 (Stream
: not null access Root_Stream_Type
'Class;
373 for Set
'Write use Write
;
376 (Stream
: not null access Root_Stream_Type
'Class;
377 Container
: out Set
);
379 for Set
'Read use Read
;
381 type Set_Access
is access all Set
;
382 for Set_Access
'Storage_Size use 0;
384 type Cursor
is record
385 Container
: Set_Access
;
390 (Stream
: not null access Root_Stream_Type
'Class;
393 for Cursor
'Write use Write
;
396 (Stream
: not null access Root_Stream_Type
'Class;
399 for Cursor
'Read use Read
;
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
404 type Constant_Reference_Type
405 (Element
: not null access constant Element_Type
) is
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
415 (Stream
: not null access Root_Stream_Type
'Class;
416 Item
: out Constant_Reference_Type
);
418 for Constant_Reference_Type
'Read use Read
;
421 (Stream
: not null access Root_Stream_Type
'Class;
422 Item
: Constant_Reference_Type
);
424 for Constant_Reference_Type
'Write use Write
;
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
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.
438 function Get_Element_Access
439 (Position
: Cursor
) return not null Element_Access
;
440 -- Returns a pointer to the element designated by Position.
442 Empty_Set
: constant Set
:= (Controlled
with others => <>);
444 No_Element
: constant Cursor
:= Cursor
'(null, null);
446 type Iterator is new Limited_Controlled and
447 Set_Iterator_Interfaces.Reversible_Iterator with
449 Container : Set_Access;
452 with Disable_Controlled => not T_Check;
454 overriding procedure Finalize (Object : in out Iterator);
456 overriding function First (Object : Iterator) return Cursor;
457 overriding function Last (Object : Iterator) return Cursor;
459 overriding function Next
461 Position : Cursor) return Cursor;
463 overriding function Previous
465 Position : Cursor) return Cursor;
467 end Ada.Containers.Indefinite_Ordered_Sets;