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 _ H A S H E D _ S E T S -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 2004-2012, 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.Hash_Tables; 37private with Ada.Streams; 38 39generic 40 type Element_Type is private; 41 42 with function Hash (Element : Element_Type) return Hash_Type; 43 44 with function Equivalent_Elements 45 (Left, Right : Element_Type) return Boolean; 46 47 with function "=" (Left, Right : Element_Type) return Boolean is <>; 48 49package Ada.Containers.Bounded_Hashed_Sets is 50 pragma Pure; 51 pragma Remote_Types; 52 53 type Set (Capacity : Count_Type; Modulus : Hash_Type) is tagged private 54 with Constant_Indexing => Constant_Reference, 55 Default_Iterator => Iterate, 56 Iterator_Element => Element_Type; 57 58 pragma Preelaborable_Initialization (Set); 59 60 type Cursor is private; 61 pragma Preelaborable_Initialization (Cursor); 62 63 Empty_Set : constant Set; 64 -- Set objects declared without an initialization expression are 65 -- initialized to the value Empty_Set. 66 67 No_Element : constant Cursor; 68 -- Cursor objects declared without an initialization expression are 69 -- initialized to the value No_Element. 70 71 function Has_Element (Position : Cursor) return Boolean; 72 -- Equivalent to Position /= No_Element 73 74 package Set_Iterator_Interfaces is new 75 Ada.Iterator_Interfaces (Cursor, Has_Element); 76 77 function "=" (Left, Right : Set) return Boolean; 78 -- For each element in Left, set equality attempts to find the equal 79 -- element in Right; if a search fails, then set equality immediately 80 -- returns False. The search works by calling Hash to find the bucket in 81 -- the Right set that corresponds to the Left element. If the bucket is 82 -- non-empty, the search calls the generic formal element equality operator 83 -- to compare the element (in Left) to the element of each node in the 84 -- bucket (in Right); the search terminates when a matching node in the 85 -- bucket is found, or the nodes in the bucket are exhausted. (Note that 86 -- element equality is called here, not Equivalent_Elements. Set equality 87 -- is the only operation in which element equality is used. Compare set 88 -- equality to Equivalent_Sets, which does call Equivalent_Elements.) 89 90 function Equivalent_Sets (Left, Right : Set) return Boolean; 91 -- Similar to set equality, with the difference that the element in Left is 92 -- compared to the elements in Right using the generic formal 93 -- Equivalent_Elements operation instead of element equality. 94 95 function To_Set (New_Item : Element_Type) return Set; 96 -- Constructs a singleton set comprising New_Element. To_Set calls Hash to 97 -- determine the bucket for New_Item. 98 99 function Capacity (Container : Set) return Count_Type; 100 -- Returns the current capacity of the set. Capacity is the maximum length 101 -- before which rehashing in guaranteed not to occur. 102 103 procedure Reserve_Capacity (Container : in out Set; Capacity : Count_Type); 104 -- If the value of the Capacity actual parameter is less or equal to 105 -- Container.Capacity, then the operation has no effect. Otherwise it 106 -- raises Capacity_Error (as no expansion of capacity is possible for a 107 -- bounded form). 108 109 function Default_Modulus (Capacity : Count_Type) return Hash_Type; 110 -- Returns a modulus value (hash table size) which is optimal for the 111 -- specified capacity (which corresponds to the maximum number of items). 112 113 function Length (Container : Set) return Count_Type; 114 -- Returns the number of items in the set 115 116 function Is_Empty (Container : Set) return Boolean; 117 -- Equivalent to Length (Container) = 0 118 119 procedure Clear (Container : in out Set); 120 -- Removes all of the items from the set 121 122 function Element (Position : Cursor) return Element_Type; 123 -- Returns the element of the node designated by the cursor 124 125 procedure Replace_Element 126 (Container : in out Set; 127 Position : Cursor; 128 New_Item : Element_Type); 129 -- If New_Item is equivalent (as determined by calling Equivalent_Elements) 130 -- to the element of the node designated by Position, then New_Element is 131 -- assigned to that element. Otherwise, it calls Hash to determine the 132 -- bucket for New_Item. If the bucket is not empty, then it calls 133 -- Equivalent_Elements for each node in that bucket to determine whether 134 -- New_Item is equivalent to an element in that bucket. If 135 -- Equivalent_Elements returns True then Program_Error is raised (because 136 -- an element may appear only once in the set); otherwise, New_Item is 137 -- assigned to the node designated by Position, and the node is moved to 138 -- its new bucket. 139 140 procedure Query_Element 141 (Position : Cursor; 142 Process : not null access procedure (Element : Element_Type)); 143 -- Calls Process with the element (having only a constant view) of the node 144 -- designated by the cursor. 145 146 type Constant_Reference_Type 147 (Element : not null access constant Element_Type) is private 148 with Implicit_Dereference => Element; 149 150 function Constant_Reference 151 (Container : aliased Set; 152 Position : Cursor) return Constant_Reference_Type; 153 154 procedure Assign (Target : in out Set; Source : Set); 155 -- If Target denotes the same object as Source, then the operation has no 156 -- effect. If the Target capacity is less than the Source length, then 157 -- Assign raises Capacity_Error. Otherwise, Assign clears Target and then 158 -- copies the (active) elements from Source to Target. 159 160 function Copy 161 (Source : Set; 162 Capacity : Count_Type := 0; 163 Modulus : Hash_Type := 0) return Set; 164 -- Constructs a new set object whose elements correspond to Source. If the 165 -- Capacity parameter is 0, then the capacity of the result is the same as 166 -- the length of Source. If the Capacity parameter is equal or greater than 167 -- the length of Source, then the capacity of the result is the specified 168 -- value. Otherwise, Copy raises Capacity_Error. If the Modulus parameter 169 -- is 0, then the modulus of the result is the value returned by a call to 170 -- Default_Modulus with the capacity parameter determined as above; 171 -- otherwise the modulus of the result is the specified value. 172 173 procedure Move (Target : in out Set; Source : in out Set); 174 -- Clears Target (if it's not empty), and then moves (not copies) the 175 -- buckets array and nodes from Source to Target. 176 177 procedure Insert 178 (Container : in out Set; 179 New_Item : Element_Type; 180 Position : out Cursor; 181 Inserted : out Boolean); 182 -- Conditionally inserts New_Item into the set. If New_Item is already in 183 -- the set, then Inserted returns False and Position designates the node 184 -- containing the existing element (which is not modified). If New_Item is 185 -- not already in the set, then Inserted returns True and Position 186 -- designates the newly-inserted node containing New_Item. The search for 187 -- an existing element works as follows. Hash is called to determine 188 -- New_Item's bucket; if the bucket is non-empty, then Equivalent_Elements 189 -- is called to compare New_Item to the element of each node in that 190 -- bucket. If the bucket is empty, or there were no equivalent elements in 191 -- the bucket, the search "fails" and the New_Item is inserted in the set 192 -- (and Inserted returns True); otherwise, the search "succeeds" (and 193 -- Inserted returns False). 194 195 procedure Insert (Container : in out Set; New_Item : Element_Type); 196 -- Attempts to insert New_Item into the set, performing the usual insertion 197 -- search (which involves calling both Hash and Equivalent_Elements); if 198 -- the search succeeds (New_Item is equivalent to an element already in the 199 -- set, and so was not inserted), then this operation raises 200 -- Constraint_Error. (This version of Insert is similar to Replace, but 201 -- having the opposite exception behavior. It is intended for use when you 202 -- want to assert that the item is not already in the set.) 203 204 procedure Include (Container : in out Set; New_Item : Element_Type); 205 -- Attempts to insert New_Item into the set. If an element equivalent to 206 -- New_Item is already in the set (the insertion search succeeded, and 207 -- hence New_Item was not inserted), then the value of New_Item is assigned 208 -- to the existing element. (This insertion operation only raises an 209 -- exception if cursor tampering occurs. It is intended for use when you 210 -- want to insert the item in the set, and you don't care whether an 211 -- equivalent element is already present.) 212 213 procedure Replace (Container : in out Set; New_Item : Element_Type); 214 -- Searches for New_Item in the set; if the search fails (because an 215 -- equivalent element was not in the set), then it raises 216 -- Constraint_Error. Otherwise, the existing element is assigned the value 217 -- New_Item. (This is similar to Insert, but with the opposite exception 218 -- behavior. It is intended for use when you want to assert that the item 219 -- is already in the set.) 220 221 procedure Exclude (Container : in out Set; Item : Element_Type); 222 -- Searches for Item in the set, and if found, removes its node from the 223 -- set and then deallocates it. The search works as follows. The operation 224 -- calls Hash to determine the item's bucket; if the bucket is not empty, 225 -- it calls Equivalent_Elements to compare Item to the element of each node 226 -- in the bucket. (This is the deletion analog of Include. It is intended 227 -- for use when you want to remove the item from the set, but don't care 228 -- whether the item is already in the set.) 229 230 procedure Delete (Container : in out Set; Item : Element_Type); 231 -- Searches for Item in the set (which involves calling both Hash and 232 -- Equivalent_Elements). If the search fails, then the operation raises 233 -- Constraint_Error. Otherwise it removes the node from the set and then 234 -- deallocates it. (This is the deletion analog of non-conditional 235 -- Insert. It is intended for use when you want to assert that the item is 236 -- already in the set.) 237 238 procedure Delete (Container : in out Set; Position : in out Cursor); 239 -- Removes the node designated by Position from the set, and then 240 -- deallocates the node. The operation calls Hash to determine the bucket, 241 -- and then compares Position to each node in the bucket until there's a 242 -- match (it does not call Equivalent_Elements). 243 244 procedure Union (Target : in out Set; Source : Set); 245 -- Iterates over the Source set, and conditionally inserts each element 246 -- into Target. 247 248 function Union (Left, Right : Set) return Set; 249 -- The operation first copies the Left set to the result, and then iterates 250 -- over the Right set to conditionally insert each element into the result. 251 252 function "or" (Left, Right : Set) return Set renames Union; 253 254 procedure Intersection (Target : in out Set; Source : Set); 255 -- Iterates over the Target set (calling First and Next), calling Find to 256 -- determine whether the element is in Source. If an equivalent element is 257 -- not found in Source, the element is deleted from Target. 258 259 function Intersection (Left, Right : Set) return Set; 260 -- Iterates over the Left set, calling Find to determine whether the 261 -- element is in Right. If an equivalent element is found, it is inserted 262 -- into the result set. 263 264 function "and" (Left, Right : Set) return Set renames Intersection; 265 266 procedure Difference (Target : in out Set; Source : Set); 267 -- Iterates over the Source (calling First and Next), calling Find to 268 -- determine whether the element is in Target. If an equivalent element is 269 -- found, it is deleted from Target. 270 271 function Difference (Left, Right : Set) return Set; 272 -- Iterates over the Left set, calling Find to determine whether the 273 -- element is in the Right set. If an equivalent element is not found, the 274 -- element is inserted into the result set. 275 276 function "-" (Left, Right : Set) return Set renames Difference; 277 278 procedure Symmetric_Difference (Target : in out Set; Source : Set); 279 -- The operation iterates over the Source set, searching for the element 280 -- in Target (calling Hash and Equivalent_Elements). If an equivalent 281 -- element is found, it is removed from Target; otherwise it is inserted 282 -- into Target. 283 284 function Symmetric_Difference (Left, Right : Set) return Set; 285 -- The operation first iterates over the Left set. It calls Find to 286 -- determine whether the element is in the Right set. If no equivalent 287 -- element is found, the element from Left is inserted into the result. The 288 -- operation then iterates over the Right set, to determine whether the 289 -- element is in the Left set. If no equivalent element is found, the Right 290 -- element is inserted into the result. 291 292 function "xor" (Left, Right : Set) return Set 293 renames Symmetric_Difference; 294 295 function Overlap (Left, Right : Set) return Boolean; 296 -- Iterates over the Left set (calling First and Next), calling Find to 297 -- determine whether the element is in the Right set. If an equivalent 298 -- element is found, the operation immediately returns True. The operation 299 -- returns False if the iteration over Left terminates without finding any 300 -- equivalent element in Right. 301 302 function Is_Subset (Subset : Set; Of_Set : Set) return Boolean; 303 -- Iterates over Subset (calling First and Next), calling Find to determine 304 -- whether the element is in Of_Set. If no equivalent element is found in 305 -- Of_Set, the operation immediately returns False. The operation returns 306 -- True if the iteration over Subset terminates without finding an element 307 -- not in Of_Set (that is, every element in Subset is equivalent to an 308 -- element in Of_Set). 309 310 function First (Container : Set) return Cursor; 311 -- Returns a cursor that designates the first non-empty bucket, by 312 -- searching from the beginning of the buckets array. 313 314 function Next (Position : Cursor) return Cursor; 315 -- Returns a cursor that designates the node that follows the current one 316 -- designated by Position. If Position designates the last node in its 317 -- bucket, the operation calls Hash to compute the index of this bucket, 318 -- and searches the buckets array for the first non-empty bucket, starting 319 -- from that index; otherwise, it simply follows the link to the next node 320 -- in the same bucket. 321 322 procedure Next (Position : in out Cursor); 323 -- Equivalent to Position := Next (Position) 324 325 function Find 326 (Container : Set; 327 Item : Element_Type) return Cursor; 328 -- Searches for Item in the set. Find calls Hash to determine the item's 329 -- bucket; if the bucket is not empty, it calls Equivalent_Elements to 330 -- compare Item to each element in the bucket. If the search succeeds, Find 331 -- returns a cursor designating the node containing the equivalent element; 332 -- otherwise, it returns No_Element. 333 334 function Contains (Container : Set; Item : Element_Type) return Boolean; 335 -- Equivalent to Find (Container, Item) /= No_Element 336 337 function Equivalent_Elements (Left, Right : Cursor) return Boolean; 338 -- Returns the result of calling Equivalent_Elements with the elements of 339 -- the nodes designated by cursors Left and Right. 340 341 function Equivalent_Elements 342 (Left : Cursor; 343 Right : Element_Type) return Boolean; 344 -- Returns the result of calling Equivalent_Elements with element of the 345 -- node designated by Left and element Right. 346 347 function Equivalent_Elements 348 (Left : Element_Type; 349 Right : Cursor) return Boolean; 350 -- Returns the result of calling Equivalent_Elements with element Left and 351 -- the element of the node designated by Right. 352 353 procedure Iterate 354 (Container : Set; 355 Process : not null access procedure (Position : Cursor)); 356 -- Calls Process for each node in the set 357 358 function Iterate 359 (Container : Set) 360 return Set_Iterator_Interfaces.Forward_Iterator'Class; 361 362 generic 363 type Key_Type (<>) is private; 364 365 with function Key (Element : Element_Type) return Key_Type; 366 367 with function Hash (Key : Key_Type) return Hash_Type; 368 369 with function Equivalent_Keys (Left, Right : Key_Type) return Boolean; 370 371 package Generic_Keys is 372 373 function Key (Position : Cursor) return Key_Type; 374 -- Applies generic formal operation Key to the element of the node 375 -- designated by Position. 376 377 function Element (Container : Set; Key : Key_Type) return Element_Type; 378 -- Searches (as per the key-based Find) for the node containing Key, and 379 -- returns the associated element. 380 381 procedure Replace 382 (Container : in out Set; 383 Key : Key_Type; 384 New_Item : Element_Type); 385 -- Searches (as per the key-based Find) for the node containing Key, and 386 -- then replaces the element of that node (as per the element-based 387 -- Replace_Element). 388 389 procedure Exclude (Container : in out Set; Key : Key_Type); 390 -- Searches for Key in the set, and if found, removes its node from the 391 -- set and then deallocates it. The search works by first calling Hash 392 -- (on Key) to determine the bucket; if the bucket is not empty, it 393 -- calls Equivalent_Keys to compare parameter Key to the value of 394 -- generic formal operation Key applied to element of each node in the 395 -- bucket. 396 397 procedure Delete (Container : in out Set; Key : Key_Type); 398 -- Deletes the node containing Key as per Exclude, with the difference 399 -- that Constraint_Error is raised if Key is not found. 400 401 function Find (Container : Set; Key : Key_Type) return Cursor; 402 -- Searches for the node containing Key, and returns a cursor 403 -- designating the node. The search works by first calling Hash (on Key) 404 -- to determine the bucket. If the bucket is not empty, the search 405 -- compares Key to the element of each node in the bucket, and returns 406 -- the matching node. The comparison itself works by applying the 407 -- generic formal Key operation to the element of the node, and then 408 -- calling generic formal operation Equivalent_Keys. 409 410 function Contains (Container : Set; Key : Key_Type) return Boolean; 411 -- Equivalent to Find (Container, Key) /= No_Element 412 413 procedure Update_Element_Preserving_Key 414 (Container : in out Set; 415 Position : Cursor; 416 Process : not null access 417 procedure (Element : in out Element_Type)); 418 -- Calls Process with the element of the node designated by Position, 419 -- but with the restriction that the key-value of the element is not 420 -- modified. The operation first makes a copy of the value returned by 421 -- applying generic formal operation Key on the element of the node, and 422 -- then calls Process with the element. The operation verifies that the 423 -- key-part has not been modified by calling generic formal operation 424 -- Equivalent_Keys to compare the saved key-value to the value returned 425 -- by applying generic formal operation Key to the post-Process value of 426 -- element. If the key values compare equal then the operation 427 -- completes. Otherwise, the node is removed from the map and 428 -- Program_Error is raised. 429 430 type Reference_Type (Element : not null access Element_Type) is private 431 with Implicit_Dereference => Element; 432 433 function Reference_Preserving_Key 434 (Container : aliased in out Set; 435 Position : Cursor) return Reference_Type; 436 437 function Constant_Reference 438 (Container : aliased Set; 439 Key : Key_Type) return Constant_Reference_Type; 440 441 function Reference_Preserving_Key 442 (Container : aliased in out Set; 443 Key : Key_Type) return Reference_Type; 444 445 private 446 type Reference_Type (Element : not null access Element_Type) 447 is null record; 448 449 use Ada.Streams; 450 451 procedure Read 452 (Stream : not null access Root_Stream_Type'Class; 453 Item : out Reference_Type); 454 455 for Reference_Type'Read use Read; 456 457 procedure Write 458 (Stream : not null access Root_Stream_Type'Class; 459 Item : Reference_Type); 460 461 for Reference_Type'Write use Write; 462 463 end Generic_Keys; 464 465private 466 pragma Inline (Next); 467 468 type Node_Type is record 469 Element : aliased Element_Type; 470 Next : Count_Type; 471 end record; 472 473 package HT_Types is 474 new Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type); 475 476 type Set (Capacity : Count_Type; Modulus : Hash_Type) is 477 new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record; 478 479 use HT_Types; 480 use Ada.Streams; 481 482 procedure Write 483 (Stream : not null access Root_Stream_Type'Class; 484 Container : Set); 485 486 for Set'Write use Write; 487 488 procedure Read 489 (Stream : not null access Root_Stream_Type'Class; 490 Container : out Set); 491 492 for Set'Read use Read; 493 494 type Set_Access is access all Set; 495 for Set_Access'Storage_Size use 0; 496 497 -- Note: If a Cursor object has no explicit initialization expression, 498 -- it must default initialize to the same value as constant No_Element. 499 -- The Node component of type Cursor has scalar type Count_Type, so it 500 -- requires an explicit initialization expression of its own declaration, 501 -- in order for objects of record type Cursor to properly initialize. 502 503 type Cursor is record 504 Container : Set_Access; 505 Node : Count_Type := 0; 506 end record; 507 508 procedure Write 509 (Stream : not null access Root_Stream_Type'Class; 510 Item : Cursor); 511 512 for Cursor'Write use Write; 513 514 procedure Read 515 (Stream : not null access Root_Stream_Type'Class; 516 Item : out Cursor); 517 518 for Cursor'Read use Read; 519 520 type Constant_Reference_Type 521 (Element : not null access constant Element_Type) is null record; 522 523 procedure Read 524 (Stream : not null access Root_Stream_Type'Class; 525 Item : out Constant_Reference_Type); 526 527 for Constant_Reference_Type'Read use Read; 528 529 procedure Write 530 (Stream : not null access Root_Stream_Type'Class; 531 Item : Constant_Reference_Type); 532 533 for Constant_Reference_Type'Write use Write; 534 535 Empty_Set : constant Set := 536 (Hash_Table_Type with Capacity => 0, Modulus => 0); 537 538 No_Element : constant Cursor := (Container => null, Node => 0); 539 540end Ada.Containers.Bounded_Hashed_Sets; 541