1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- ADA.CONTAINERS.INDEFINITE_ORDERED_SETS -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 2004-2019, 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 36with Ada.Containers.Helpers; 37private with Ada.Containers.Red_Black_Trees; 38private with Ada.Finalization; 39private with Ada.Streams; 40 41generic 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 47package 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 335private 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 467end Ada.Containers.Indefinite_Ordered_Sets; 468