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