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