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-2012, 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
34with Ada.Iterator_Interfaces;
35
36private with Ada.Containers.Red_Black_Trees;
37private with Ada.Streams;
38
39generic
40   type Element_Type is private;
41
42   with function "<" (Left, Right : Element_Type) return Boolean is <>;
43   with function "=" (Left, Right : Element_Type) return Boolean is <>;
44
45package Ada.Containers.Bounded_Ordered_Sets is
46   pragma Pure;
47   pragma Remote_Types;
48
49   function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
50
51   type Set (Capacity : Count_Type) is tagged private
52   with Constant_Indexing => Constant_Reference,
53        Default_Iterator  => Iterate,
54        Iterator_Element  => Element_Type;
55
56   pragma Preelaborable_Initialization (Set);
57
58   type Cursor is private;
59   pragma Preelaborable_Initialization (Cursor);
60
61   Empty_Set : constant Set;
62
63   No_Element : constant Cursor;
64
65   function Has_Element (Position : Cursor) return Boolean;
66
67   package Set_Iterator_Interfaces is new
68     Ada.Iterator_Interfaces (Cursor, Has_Element);
69
70   function "=" (Left, Right : Set) return Boolean;
71
72   function Equivalent_Sets (Left, Right : Set) return Boolean;
73
74   function To_Set (New_Item : Element_Type) return Set;
75
76   function Length (Container : Set) return Count_Type;
77
78   function Is_Empty (Container : Set) return Boolean;
79
80   procedure Clear (Container : in out Set);
81
82   function Element (Position : Cursor) return Element_Type;
83
84   procedure Replace_Element
85     (Container : in out Set;
86      Position  : Cursor;
87      New_Item  : Element_Type);
88
89   procedure Query_Element
90     (Position : Cursor;
91      Process  : not null access procedure (Element : Element_Type));
92
93   type Constant_Reference_Type
94      (Element : not null access constant Element_Type) is
95   private
96   with
97      Implicit_Dereference => Element;
98
99   function Constant_Reference
100     (Container : aliased Set;
101      Position  : Cursor) return Constant_Reference_Type;
102
103   procedure Assign (Target : in out Set; Source : Set);
104
105   function Copy (Source : Set; Capacity : Count_Type := 0) return Set;
106
107   procedure Move (Target : in out Set; Source : in out Set);
108
109   procedure Insert
110     (Container : in out Set;
111      New_Item  : Element_Type;
112      Position  : out Cursor;
113      Inserted  : out Boolean);
114
115   procedure Insert
116     (Container : in out Set;
117      New_Item  : Element_Type);
118
119   procedure Include
120     (Container : in out Set;
121      New_Item  : Element_Type);
122
123   procedure Replace
124     (Container : in out Set;
125      New_Item  : Element_Type);
126
127   procedure Exclude
128     (Container : in out Set;
129      Item      : Element_Type);
130
131   procedure Delete
132     (Container : in out Set;
133      Item      : Element_Type);
134
135   procedure Delete
136     (Container : in out Set;
137      Position  : in out Cursor);
138
139   procedure Delete_First (Container : in out Set);
140
141   procedure Delete_Last (Container : in out Set);
142
143   procedure Union (Target : in out Set; Source : Set);
144
145   function Union (Left, Right : Set) return Set;
146
147   function "or" (Left, Right : Set) return Set renames Union;
148
149   procedure Intersection (Target : in out Set; Source : Set);
150
151   function Intersection (Left, Right : Set) return Set;
152
153   function "and" (Left, Right : Set) return Set renames Intersection;
154
155   procedure Difference (Target : in out Set; Source : Set);
156
157   function Difference (Left, Right : Set) return Set;
158
159   function "-" (Left, Right : Set) return Set renames Difference;
160
161   procedure Symmetric_Difference (Target : in out Set; Source : Set);
162
163   function Symmetric_Difference (Left, Right : Set) return Set;
164
165   function "xor" (Left, Right : Set) return Set renames Symmetric_Difference;
166
167   function Overlap (Left, Right : Set) return Boolean;
168
169   function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
170
171   function First (Container : Set) return Cursor;
172
173   function First_Element (Container : Set) return Element_Type;
174
175   function Last (Container : Set) return Cursor;
176
177   function Last_Element (Container : Set) return Element_Type;
178
179   function Next (Position : Cursor) return Cursor;
180
181   procedure Next (Position : in out Cursor);
182
183   function Previous (Position : Cursor) return Cursor;
184
185   procedure Previous (Position : in out Cursor);
186
187   function Find (Container : Set; Item : Element_Type) return Cursor;
188
189   function Floor (Container : Set; Item : Element_Type) return Cursor;
190
191   function Ceiling (Container : Set; Item : Element_Type) return Cursor;
192
193   function Contains (Container : Set; Item : Element_Type) return Boolean;
194
195   function "<" (Left, Right : Cursor) return Boolean;
196
197   function ">" (Left, Right : Cursor) return Boolean;
198
199   function "<" (Left : Cursor; Right : Element_Type) return Boolean;
200
201   function ">" (Left : Cursor; Right : Element_Type) return Boolean;
202
203   function "<" (Left : Element_Type; Right : Cursor) return Boolean;
204
205   function ">" (Left : Element_Type; Right : Cursor) return Boolean;
206
207   procedure Iterate
208     (Container : Set;
209      Process   : not null access procedure (Position : Cursor));
210
211   procedure Reverse_Iterate
212     (Container : Set;
213      Process   : not null access procedure (Position : Cursor));
214
215   function Iterate
216     (Container : Set)
217      return Set_Iterator_Interfaces.Reversible_Iterator'class;
218
219   function Iterate
220     (Container : Set;
221      Start     : Cursor)
222      return Set_Iterator_Interfaces.Reversible_Iterator'class;
223
224   generic
225      type Key_Type (<>) is private;
226
227      with function Key (Element : Element_Type) return Key_Type;
228
229      with function "<" (Left, Right : Key_Type) return Boolean is <>;
230
231   package Generic_Keys is
232
233      function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
234
235      function Key (Position : Cursor) return Key_Type;
236
237      function Element (Container : Set; Key : Key_Type) return Element_Type;
238
239      procedure Replace
240        (Container : in out Set;
241         Key       : Key_Type;
242         New_Item  : Element_Type);
243
244      procedure Exclude (Container : in out Set; Key : Key_Type);
245
246      procedure Delete (Container : in out Set; Key : Key_Type);
247
248      function Find (Container : Set; Key : Key_Type) return Cursor;
249
250      function Floor (Container : Set; Key : Key_Type) return Cursor;
251
252      function Ceiling (Container : Set; Key : Key_Type) return Cursor;
253
254      function Contains (Container : Set; Key : Key_Type) return Boolean;
255
256      procedure Update_Element_Preserving_Key
257        (Container : in out Set;
258         Position  : Cursor;
259         Process   : not null access
260                       procedure (Element : in out Element_Type));
261
262      type Reference_Type (Element : not null access Element_Type) is private
263      with
264         Implicit_Dereference => Element;
265
266      function Reference_Preserving_Key
267        (Container : aliased in out Set;
268         Position  : Cursor) return Reference_Type;
269
270      function Constant_Reference
271        (Container : aliased Set;
272         Key       : Key_Type) return Constant_Reference_Type;
273
274      function Reference_Preserving_Key
275        (Container : aliased in out Set;
276         Key       : Key_Type) return Reference_Type;
277
278   private
279      type Reference_Type
280         (Element : not null access Element_Type) is null record;
281
282      use Ada.Streams;
283
284      procedure Read
285        (Stream : not null access Root_Stream_Type'Class;
286         Item   : out Reference_Type);
287
288      for Reference_Type'Read use Read;
289
290      procedure Write
291        (Stream : not null access Root_Stream_Type'Class;
292         Item   : Reference_Type);
293
294      for Reference_Type'Write use Write;
295
296   end Generic_Keys;
297
298private
299
300   pragma Inline (Next);
301   pragma Inline (Previous);
302
303   type Node_Type is record
304      Parent  : Count_Type;
305      Left    : Count_Type;
306      Right   : Count_Type;
307      Color   : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
308      Element : aliased Element_Type;
309   end record;
310
311   package Tree_Types is
312     new Red_Black_Trees.Generic_Bounded_Tree_Types (Node_Type);
313
314   type Set (Capacity : Count_Type) is
315     new Tree_Types.Tree_Type (Capacity) with null record;
316
317   use Tree_Types;
318   use Ada.Streams;
319
320   procedure Write
321     (Stream    : not null access Root_Stream_Type'Class;
322      Container : Set);
323
324   for Set'Write use Write;
325
326   procedure Read
327     (Stream    : not null access Root_Stream_Type'Class;
328      Container : out Set);
329
330   for Set'Read use Read;
331
332   type Set_Access is access all Set;
333   for Set_Access'Storage_Size use 0;
334
335   --  Note: If a Cursor object has no explicit initialization expression,
336   --  it must default initialize to the same value as constant No_Element.
337   --  The Node component of type Cursor has scalar type Count_Type, so it
338   --  requires an explicit initialization expression of its own declaration,
339   --  in order for objects of record type Cursor to properly initialize.
340
341   type Cursor is record
342      Container : Set_Access;
343      Node      : Count_Type := 0;
344   end record;
345
346   procedure Write
347     (Stream : not null access Root_Stream_Type'Class;
348      Item   : Cursor);
349
350   for Cursor'Write use Write;
351
352   procedure Read
353     (Stream : not null access Root_Stream_Type'Class;
354      Item   : out Cursor);
355
356   for Cursor'Read use Read;
357
358   type Constant_Reference_Type
359      (Element : not null access constant Element_Type) is null record;
360
361   procedure Read
362     (Stream : not null access Root_Stream_Type'Class;
363      Item   : out Constant_Reference_Type);
364
365   for Constant_Reference_Type'Read use Read;
366
367   procedure Write
368     (Stream : not null access Root_Stream_Type'Class;
369      Item   : Constant_Reference_Type);
370
371   for Constant_Reference_Type'Write use Write;
372
373   Empty_Set : constant Set := Set'(Tree_Type with Capacity => 0);
374
375   No_Element : constant Cursor := Cursor'(null, 0);
376
377end Ada.Containers.Bounded_Ordered_Sets;
378