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