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-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.Streams; 39private with Ada.Finalization; 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.Bounded_Ordered_Sets is 48 pragma Annotate (CodePeer, Skip_Analysis); 49 pragma Pure; 50 pragma Remote_Types; 51 52 function Equivalent_Elements (Left, Right : Element_Type) return Boolean; 53 54 type Set (Capacity : Count_Type) is tagged private 55 with 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 99 with 100 Implicit_Dereference => Element; 101 102 function Constant_Reference 103 (Container : aliased Set; 104 Position : Cursor) return Constant_Reference_Type; 105 106 procedure Assign (Target : in out Set; Source : Set); 107 108 function Copy (Source : Set; Capacity : Count_Type := 0) 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 (Container : Set; Item : Element_Type) return Cursor; 191 192 function Floor (Container : Set; Item : Element_Type) return Cursor; 193 194 function Ceiling (Container : Set; Item : Element_Type) return Cursor; 195 196 function Contains (Container : Set; Item : Element_Type) return Boolean; 197 198 function "<" (Left, Right : Cursor) return Boolean; 199 200 function ">" (Left, Right : Cursor) return Boolean; 201 202 function "<" (Left : Cursor; Right : Element_Type) return Boolean; 203 204 function ">" (Left : Cursor; Right : Element_Type) return Boolean; 205 206 function "<" (Left : Element_Type; Right : Cursor) return Boolean; 207 208 function ">" (Left : Element_Type; Right : Cursor) return Boolean; 209 210 procedure Iterate 211 (Container : Set; 212 Process : not null access procedure (Position : Cursor)); 213 214 procedure Reverse_Iterate 215 (Container : Set; 216 Process : not null access procedure (Position : Cursor)); 217 218 function Iterate 219 (Container : Set) 220 return Set_Iterator_Interfaces.Reversible_Iterator'class; 221 222 function Iterate 223 (Container : Set; 224 Start : Cursor) 225 return Set_Iterator_Interfaces.Reversible_Iterator'class; 226 227 generic 228 type Key_Type (<>) is private; 229 230 with function Key (Element : Element_Type) return Key_Type; 231 232 with function "<" (Left, Right : Key_Type) return Boolean is <>; 233 234 package Generic_Keys is 235 236 function Equivalent_Keys (Left, Right : Key_Type) return Boolean; 237 238 function Key (Position : Cursor) return Key_Type; 239 240 function Element (Container : Set; Key : Key_Type) return Element_Type; 241 242 procedure Replace 243 (Container : in out Set; 244 Key : Key_Type; 245 New_Item : Element_Type); 246 247 procedure Exclude (Container : in out Set; Key : Key_Type); 248 249 procedure Delete (Container : in out Set; Key : Key_Type); 250 251 function Find (Container : Set; Key : Key_Type) return Cursor; 252 253 function Floor (Container : Set; Key : Key_Type) return Cursor; 254 255 function Ceiling (Container : Set; Key : Key_Type) return Cursor; 256 257 function Contains (Container : Set; Key : Key_Type) return Boolean; 258 259 procedure Update_Element_Preserving_Key 260 (Container : in out Set; 261 Position : Cursor; 262 Process : not null access 263 procedure (Element : in out Element_Type)); 264 265 type Reference_Type (Element : not null access Element_Type) is private 266 with 267 Implicit_Dereference => Element; 268 269 function Reference_Preserving_Key 270 (Container : aliased in out Set; 271 Position : Cursor) return Reference_Type; 272 273 function Constant_Reference 274 (Container : aliased Set; 275 Key : Key_Type) return Constant_Reference_Type; 276 277 function Reference_Preserving_Key 278 (Container : aliased in out Set; 279 Key : Key_Type) return Reference_Type; 280 281 private 282 type Set_Access is access all Set; 283 for Set_Access'Storage_Size use 0; 284 285 type Key_Access is access all Key_Type; 286 287 use Ada.Streams; 288 289 package Impl is new Helpers.Generic_Implementation; 290 291 type Reference_Control_Type is 292 new Impl.Reference_Control_Type with 293 record 294 Container : Set_Access; 295 Pos : Cursor; 296 Old_Key : Key_Access; 297 end record; 298 299 overriding procedure Finalize (Control : in out Reference_Control_Type); 300 pragma Inline (Finalize); 301 302 type Reference_Type (Element : not null access Element_Type) is record 303 Control : Reference_Control_Type; 304 end record; 305 306 procedure Read 307 (Stream : not null access Root_Stream_Type'Class; 308 Item : out Reference_Type); 309 310 for Reference_Type'Read use Read; 311 312 procedure Write 313 (Stream : not null access Root_Stream_Type'Class; 314 Item : Reference_Type); 315 316 for Reference_Type'Write use Write; 317 318 end Generic_Keys; 319 320private 321 322 pragma Inline (Next); 323 pragma Inline (Previous); 324 325 type Node_Type is record 326 Parent : Count_Type; 327 Left : Count_Type; 328 Right : Count_Type; 329 Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red; 330 Element : aliased Element_Type; 331 end record; 332 333 package Tree_Types is 334 new Red_Black_Trees.Generic_Bounded_Tree_Types (Node_Type); 335 336 type Set (Capacity : Count_Type) is 337 new Tree_Types.Tree_Type (Capacity) with null record; 338 339 use Tree_Types, Tree_Types.Implementation; 340 use Ada.Finalization; 341 use Ada.Streams; 342 343 procedure Write 344 (Stream : not null access Root_Stream_Type'Class; 345 Container : Set); 346 347 for Set'Write use Write; 348 349 procedure Read 350 (Stream : not null access Root_Stream_Type'Class; 351 Container : out Set); 352 353 for Set'Read use Read; 354 355 type Set_Access is access all Set; 356 for Set_Access'Storage_Size use 0; 357 358 -- Note: If a Cursor object has no explicit initialization expression, 359 -- it must default initialize to the same value as constant No_Element. 360 -- The Node component of type Cursor has scalar type Count_Type, so it 361 -- requires an explicit initialization expression of its own declaration, 362 -- in order for objects of record type Cursor to properly initialize. 363 364 type Cursor is record 365 Container : Set_Access; 366 Node : Count_Type := 0; 367 end record; 368 369 procedure Write 370 (Stream : not null access Root_Stream_Type'Class; 371 Item : Cursor); 372 373 for Cursor'Write use Write; 374 375 procedure Read 376 (Stream : not null access Root_Stream_Type'Class; 377 Item : out Cursor); 378 379 for Cursor'Read use Read; 380 381 subtype Reference_Control_Type is Implementation.Reference_Control_Type; 382 -- It is necessary to rename this here, so that the compiler can find it 383 384 type Constant_Reference_Type 385 (Element : not null access constant Element_Type) is 386 record 387 Control : Reference_Control_Type := 388 raise Program_Error with "uninitialized reference"; 389 -- The RM says, "The default initialization of an object of 390 -- type Constant_Reference_Type or Reference_Type propagates 391 -- Program_Error." 392 end record; 393 394 procedure Read 395 (Stream : not null access Root_Stream_Type'Class; 396 Item : out Constant_Reference_Type); 397 398 for Constant_Reference_Type'Read use Read; 399 400 procedure Write 401 (Stream : not null access Root_Stream_Type'Class; 402 Item : Constant_Reference_Type); 403 404 for Constant_Reference_Type'Write use Write; 405 406 -- Three operations are used to optimize in the expansion of "for ... of" 407 -- loops: the Next(Cursor) procedure in the visible part, and the following 408 -- Pseudo_Reference and Get_Element_Access functions. See Sem_Ch5 for 409 -- details. 410 411 function Pseudo_Reference 412 (Container : aliased Set'Class) return Reference_Control_Type; 413 pragma Inline (Pseudo_Reference); 414 -- Creates an object of type Reference_Control_Type pointing to the 415 -- container, and increments the Lock. Finalization of this object will 416 -- decrement the Lock. 417 418 type Element_Access is access all Element_Type with 419 Storage_Size => 0; 420 421 function Get_Element_Access 422 (Position : Cursor) return not null Element_Access; 423 -- Returns a pointer to the element designated by Position. 424 425 Empty_Set : constant Set := Set'(Tree_Type with Capacity => 0); 426 427 No_Element : constant Cursor := Cursor'(null, 0); 428 429 type Iterator is new Limited_Controlled and 430 Set_Iterator_Interfaces.Reversible_Iterator with 431 record 432 Container : Set_Access; 433 Node : Count_Type; 434 end record 435 with Disable_Controlled => not T_Check; 436 437 overriding procedure Finalize (Object : in out Iterator); 438 439 overriding function First (Object : Iterator) return Cursor; 440 overriding function Last (Object : Iterator) return Cursor; 441 442 overriding function Next 443 (Object : Iterator; 444 Position : Cursor) return Cursor; 445 446 overriding function Previous 447 (Object : Iterator; 448 Position : Cursor) return Cursor; 449 450end Ada.Containers.Bounded_Ordered_Sets; 451