1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- G N A T . D Y N A M I C _ H T A B L E S -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 1995-2020, AdaCore -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- Hash table searching routines 33 34-- This package contains two separate packages. The Simple_HTable package 35-- provides a very simple abstraction that associates one element to one key 36-- value and takes care of all allocations automatically using the heap. The 37-- Static_HTable package provides a more complex interface that allows full 38-- control over allocation. 39 40-- This package provides a facility similar to that of GNAT.HTable, except 41-- that this package declares types that can be used to define dynamic 42-- instances of hash tables, while instantiations in GNAT.HTable creates a 43-- single instance of the hash table. 44 45-- Note that this interface should remain synchronized with those in 46-- GNAT.HTable to keep as much coherency as possible between these two 47-- related units. 48 49pragma Compiler_Unit_Warning; 50 51package GNAT.Dynamic_HTables is 52 53 function Hash_Two_Keys 54 (Left : Bucket_Range_Type; 55 Right : Bucket_Range_Type) return Bucket_Range_Type; 56 pragma Inline (Hash_Two_Keys); 57 -- Obtain the hash value of keys Left and Right 58 59 ------------------- 60 -- Static_HTable -- 61 ------------------- 62 63 -- A low-level Hash-Table abstraction, not as easy to instantiate as 64 -- Simple_HTable. This mirrors the interface of GNAT.HTable.Static_HTable, 65 -- but does require dynamic allocation (since we allow multiple instances 66 -- of the table). The model is that each Element contains its own Key that 67 -- can be retrieved by Get_Key. Furthermore, Element provides a link that 68 -- can be used by the HTable for linking elements with same hash codes: 69 70 -- Element 71 72 -- +-------------------+ 73 -- | Key | 74 -- +-------------------+ 75 -- : other data : 76 -- +-------------------+ 77 -- | Next Elmt | 78 -- +-------------------+ 79 80 generic 81 type Header_Num is range <>; 82 -- An integer type indicating the number and range of hash headers 83 84 type Element (<>) is limited private; 85 -- The type of element to be stored 86 87 type Elmt_Ptr is private; 88 -- The type used to reference an element (will usually be an access 89 -- type, but could be some other form of type such as an integer type). 90 91 Null_Ptr : Elmt_Ptr; 92 -- The null value of the Elmt_Ptr type 93 94 with function Next (E : Elmt_Ptr) return Elmt_Ptr; 95 with procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr); 96 -- The type must provide an internal link for the sake of the 97 -- staticness of the HTable. 98 99 type Key is limited private; 100 with function Get_Key (E : Elmt_Ptr) return Key; 101 with function Hash (F : Key) return Header_Num; 102 with function Equal (F1 : Key; F2 : Key) return Boolean; 103 104 package Static_HTable is 105 type Instance is private; 106 Nil : constant Instance; 107 108 procedure Reset (T : in out Instance); 109 -- Resets the hash table by releasing all memory associated with it. The 110 -- hash table can safely be reused after this call. For the most common 111 -- case where Elmt_Ptr is an access type, and Null_Ptr is null, this is 112 -- only needed if the same table is reused in a new context. If Elmt_Ptr 113 -- is other than an access type, or Null_Ptr is other than null, then 114 -- Reset must be called before the first use of the hash table. 115 116 procedure Set (T : in out Instance; E : Elmt_Ptr); 117 -- Insert the element pointer in the HTable 118 119 function Get (T : Instance; K : Key) return Elmt_Ptr; 120 -- Returns the latest inserted element pointer with the given Key or 121 -- null if none. 122 123 procedure Remove (T : Instance; K : Key); 124 -- Removes the latest inserted element pointer associated with the given 125 -- key if any, does nothing if none. 126 127 function Get_First (T : Instance) return Elmt_Ptr; 128 -- Returns Null_Ptr if the Htable is empty, otherwise returns one 129 -- unspecified element. There is no guarantee that 2 calls to this 130 -- function will return the same element. 131 132 function Get_Next (T : Instance) return Elmt_Ptr; 133 -- Returns an unspecified element that has not been returned by the same 134 -- function since the last call to Get_First or Null_Ptr if there is no 135 -- such element or Get_First has never been called. If there is no call 136 -- to 'Set' in between Get_Next calls, all the elements of the Htable 137 -- will be traversed. 138 139 private 140 type Table_Type is array (Header_Num) of Elmt_Ptr; 141 142 type Instance_Data is record 143 Table : Table_Type; 144 Iterator_Index : Header_Num; 145 Iterator_Ptr : Elmt_Ptr; 146 Iterator_Started : Boolean := False; 147 end record; 148 149 type Instance is access all Instance_Data; 150 151 Nil : constant Instance := null; 152 end Static_HTable; 153 154 ------------------- 155 -- Simple_HTable -- 156 ------------------- 157 158 -- A simple hash table abstraction, easy to instantiate, easy to use. 159 -- The table associates one element to one key with the procedure Set. 160 -- Get retrieves the Element stored for a given Key. The efficiency of 161 -- retrieval is function of the size of the Table parameterized by 162 -- Header_Num and the hashing function Hash. 163 164 generic 165 type Header_Num is range <>; 166 -- An integer type indicating the number and range of hash headers 167 168 type Element is private; 169 -- The type of element to be stored 170 171 No_Element : Element; 172 -- The object that is returned by Get when no element has been set for 173 -- a given key 174 175 type Key is private; 176 with function Hash (F : Key) return Header_Num; 177 with function Equal (F1 : Key; F2 : Key) return Boolean; 178 179 package Simple_HTable is 180 type Instance is private; 181 Nil : constant Instance; 182 183 type Key_Option (Present : Boolean := False) is record 184 case Present is 185 when True => K : Key; 186 when False => null; 187 end case; 188 end record; 189 190 procedure Set (T : in out Instance; K : Key; E : Element); 191 -- Associates an element with a given key. Overrides any previously 192 -- associated element. 193 194 procedure Reset (T : in out Instance); 195 -- Releases all memory associated with the table. The table can be 196 -- reused after this call (it is automatically allocated on the first 197 -- access to the table). 198 199 function Get (T : Instance; K : Key) return Element; 200 -- Returns the Element associated with a key or No_Element if the given 201 -- key has not associated element 202 203 procedure Remove (T : Instance; K : Key); 204 -- Removes the latest inserted element pointer associated with the given 205 -- key if any, does nothing if none. 206 207 function Get_First (T : Instance) return Element; 208 -- Returns No_Element if the Htable is empty, otherwise returns one 209 -- unspecified element. There is no guarantee that two calls to this 210 -- function will return the same element, if the Htable has been 211 -- modified between the two calls. 212 213 function Get_First_Key (T : Instance) return Key_Option; 214 -- Returns an option type giving an unspecified key. If the Htable 215 -- is empty, the discriminant will have field Present set to False, 216 -- otherwise its Present field is set to True and the field K contains 217 -- the key. There is no guarantee that two calls to this function will 218 -- return the same key, if the Htable has been modified between the two 219 -- calls. 220 221 function Get_Next (T : Instance) return Element; 222 -- Returns an unspecified element that has not been returned by the 223 -- same function since the last call to Get_First or No_Element if 224 -- there is no such element. If there is no call to 'Set' in between 225 -- Get_Next calls, all the elements of the Htable will be traversed. 226 -- To guarantee that all the elements of the Htable will be traversed, 227 -- no modification of the Htable (Set, Reset, Remove) should occur 228 -- between a call to Get_First and subsequent consecutive calls to 229 -- Get_Next, until one of these calls returns No_Element. 230 231 function Get_Next_Key (T : Instance) return Key_Option; 232 -- Same as Get_Next except that this returns an option type having field 233 -- Present set either to False if there no key never returned before by 234 -- either Get_First_Key or this very same function, or to True if there 235 -- is one, with the field K containing the key specified as before. The 236 -- same restrictions apply as Get_Next. 237 238 private 239 type Element_Wrapper; 240 type Elmt_Ptr is access all Element_Wrapper; 241 type Element_Wrapper is record 242 K : Key; 243 E : Element; 244 Next : Elmt_Ptr; 245 end record; 246 247 procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr); 248 function Next (E : Elmt_Ptr) return Elmt_Ptr; 249 function Get_Key (E : Elmt_Ptr) return Key; 250 251 package Tab is new Static_HTable 252 (Header_Num => Header_Num, 253 Element => Element_Wrapper, 254 Elmt_Ptr => Elmt_Ptr, 255 Null_Ptr => null, 256 Set_Next => Set_Next, 257 Next => Next, 258 Key => Key, 259 Get_Key => Get_Key, 260 Hash => Hash, 261 Equal => Equal); 262 263 type Instance is new Tab.Instance; 264 Nil : constant Instance := Instance (Tab.Nil); 265 end Simple_HTable; 266 267 ------------------------- 268 -- Dynamic_Hash_Tables -- 269 ------------------------- 270 271 -- The following package offers a hash table abstraction with the following 272 -- characteristics: 273 -- 274 -- * Dynamic resizing based on load factor 275 -- * Creation of multiple instances, of different sizes 276 -- * Iterable keys 277 -- 278 -- This type of hash table is best used in scenarios where the size of the 279 -- key set is not known. The dynamic resizing aspect allows for performance 280 -- to remain within reasonable bounds as the size of the key set grows. 281 -- 282 -- The following use pattern must be employed when operating this table: 283 -- 284 -- Table : Dynamic_Hash_Table := Create (<some size>); 285 -- 286 -- <various operations> 287 -- 288 -- Destroy (Table); 289 -- 290 -- The destruction of the table reclaims all storage occupied by it. 291 292 -- The following type denotes the multiplicative factor used in expansion 293 -- and compression of the hash table. 294 295 subtype Factor_Type is Bucket_Range_Type range 2 .. 100; 296 297 -- The following type denotes the threshold range used in expansion and 298 -- compression of the hash table. 299 300 subtype Threshold_Type is Long_Float range 0.0 .. Long_Float'Last; 301 302 generic 303 type Key_Type is private; 304 type Value_Type is private; 305 -- The types of the key-value pairs stored in the hash table 306 307 No_Value : Value_Type; 308 -- An indicator for a non-existent value 309 310 Expansion_Threshold : Threshold_Type; 311 Expansion_Factor : Factor_Type; 312 -- Once the load factor goes over Expansion_Threshold, the size of the 313 -- buckets is increased using the formula 314 -- 315 -- New_Size = Old_Size * Expansion_Factor 316 -- 317 -- An Expansion_Threshold of 1.5 and Expansion_Factor of 2 indicate that 318 -- the size of the buckets will be doubled once the load factor exceeds 319 -- 1.5. 320 321 Compression_Threshold : Threshold_Type; 322 Compression_Factor : Factor_Type; 323 -- Once the load factor drops below Compression_Threshold, the size of 324 -- the buckets is decreased using the formula 325 -- 326 -- New_Size = Old_Size / Compression_Factor 327 -- 328 -- A Compression_Threshold of 0.5 and Compression_Factor of 2 indicate 329 -- that the size of the buckets will be halved once the load factor 330 -- drops below 0.5. 331 332 with function "=" 333 (Left : Key_Type; 334 Right : Key_Type) return Boolean; 335 336 with procedure Destroy_Value (Val : in out Value_Type); 337 -- Value destructor 338 339 with function Hash (Key : Key_Type) return Bucket_Range_Type; 340 -- Map an arbitrary key into the range of buckets 341 342 package Dynamic_Hash_Tables is 343 344 ---------------------- 345 -- Table operations -- 346 ---------------------- 347 348 -- The following type denotes a hash table handle. Each instance must be 349 -- created using routine Create. 350 351 type Dynamic_Hash_Table is private; 352 Nil : constant Dynamic_Hash_Table; 353 354 function Contains 355 (T : Dynamic_Hash_Table; 356 Key : Key_Type) return Boolean; 357 -- Determine whether key Key exists in hash table T 358 359 function Create (Initial_Size : Positive) return Dynamic_Hash_Table; 360 -- Create a new table with bucket capacity Initial_Size. This routine 361 -- must be called at the start of a hash table's lifetime. 362 363 procedure Delete 364 (T : Dynamic_Hash_Table; 365 Key : Key_Type); 366 -- Delete the value which corresponds to key Key from hash table T. The 367 -- routine has no effect if the value is not present in the hash table. 368 -- This action will raise Iterated if the hash table has outstanding 369 -- iterators. If the load factor drops below Compression_Threshold, the 370 -- size of the buckets is decreased by Copression_Factor. 371 372 procedure Destroy (T : in out Dynamic_Hash_Table); 373 -- Destroy the contents of hash table T, rendering it unusable. This 374 -- routine must be called at the end of a hash table's lifetime. This 375 -- action will raise Iterated if the hash table has outstanding 376 -- iterators. 377 378 function Get 379 (T : Dynamic_Hash_Table; 380 Key : Key_Type) return Value_Type; 381 -- Obtain the value which corresponds to key Key from hash table T. If 382 -- the value does not exist, return No_Value. 383 384 function Is_Empty (T : Dynamic_Hash_Table) return Boolean; 385 -- Determine whether hash table T is empty 386 387 function Present (T : Dynamic_Hash_Table) return Boolean; 388 -- Determine whether hash table T exists 389 390 procedure Put 391 (T : Dynamic_Hash_Table; 392 Key : Key_Type; 393 Value : Value_Type); 394 -- Associate value Value with key Key in hash table T. If the table 395 -- already contains a mapping of the same key to a previous value, the 396 -- previous value is overwritten. This action will raise Iterated if 397 -- the hash table has outstanding iterators. If the load factor goes 398 -- over Expansion_Threshold, the size of the buckets is increased by 399 -- Expansion_Factor. 400 401 procedure Reset (T : Dynamic_Hash_Table); 402 -- Destroy the contents of hash table T, and reset it to its initial 403 -- created state. This action will raise Iterated if the hash table 404 -- has outstanding iterators. 405 406 function Size (T : Dynamic_Hash_Table) return Natural; 407 -- Obtain the number of key-value pairs in hash table T 408 409 ------------------------- 410 -- Iterator operations -- 411 ------------------------- 412 413 -- The following type represents a key iterator. An iterator locks 414 -- all mutation operations, and unlocks them once it is exhausted. 415 -- The iterator must be used with the following pattern: 416 -- 417 -- Iter := Iterate (My_Table); 418 -- while Has_Next (Iter) loop 419 -- Key := Next (Iter); 420 -- . . . 421 -- end loop; 422 -- 423 -- It is possible to advance the iterator by using Next only, however 424 -- this risks raising Iterator_Exhausted. 425 426 type Iterator is private; 427 428 function Has_Next (Iter : Iterator) return Boolean; 429 -- Determine whether iterator Iter has more keys to examine. If the 430 -- iterator has been exhausted, restore all mutation functionality of 431 -- the associated hash table. 432 433 function Iterate (T : Dynamic_Hash_Table) return Iterator; 434 -- Obtain an iterator over the keys of hash table T. This action locks 435 -- all mutation functionality of the associated hash table. 436 437 procedure Next (Iter : in out Iterator; Key : out Key_Type); 438 -- Return the current key referenced by iterator Iter and advance to 439 -- the next available key. If the iterator has been exhausted and 440 -- further attempts are made to advance it, this routine restores 441 -- mutation functionality of the associated hash table, and then 442 -- raises Iterator_Exhausted. 443 444 private 445 -- The following type represents a doubly linked list node used to 446 -- store a key-value pair. There are several reasons to use a doubly 447 -- linked list: 448 -- 449 -- * Most read and write operations utilize the same primitve 450 -- routines to locate, create, and delete a node, allowing for 451 -- greater degree of code sharing. 452 -- 453 -- * Special cases are eliminated by maintaining a circular node 454 -- list with a dummy head (see type Bucket_Table). 455 -- 456 -- A node is said to be "valid" if it is non-null, and does not refer to 457 -- the dummy head of some bucket. 458 459 type Node; 460 type Node_Ptr is access all Node; 461 type Node is record 462 Key : Key_Type; 463 Value : Value_Type := No_Value; 464 -- Key-value pair stored in a bucket 465 466 Prev : Node_Ptr := null; 467 Next : Node_Ptr := null; 468 end record; 469 470 -- The following type represents a bucket table. Each bucket contains a 471 -- circular doubly linked list of nodes with a dummy head. Initially, 472 -- the head does not refer to itself. This is intentional because it 473 -- improves the performance of creation, compression, and expansion by 474 -- avoiding a separate pass to link a head to itself. Several routines 475 -- ensure that the head is properly formed. 476 477 type Bucket_Table is array (Bucket_Range_Type range <>) of aliased Node; 478 type Bucket_Table_Ptr is access Bucket_Table; 479 480 -- The following type represents a hash table 481 482 type Dynamic_Hash_Table_Attributes is record 483 Buckets : Bucket_Table_Ptr := null; 484 -- Reference to the compressing / expanding buckets 485 486 Initial_Size : Bucket_Range_Type := 0; 487 -- The initial size of the buckets as specified at creation time 488 489 Iterators : Natural := 0; 490 -- Number of outstanding iterators 491 492 Pairs : Natural := 0; 493 -- Number of key-value pairs in the buckets 494 end record; 495 496 type Dynamic_Hash_Table is access Dynamic_Hash_Table_Attributes; 497 Nil : constant Dynamic_Hash_Table := null; 498 499 -- The following type represents a key iterator 500 501 type Iterator is record 502 Curr_Idx : Bucket_Range_Type := 0; 503 -- Index of the current bucket being examined. This index is always 504 -- kept within the range of the buckets. 505 506 Curr_Nod : Node_Ptr := null; 507 -- Reference to the current node being examined within the current 508 -- bucket. The invariant of the iterator requires that this field 509 -- always point to a valid node. A value of null indicates that the 510 -- iterator is exhausted. 511 512 Table : Dynamic_Hash_Table := null; 513 -- Reference to the associated hash table 514 end record; 515 end Dynamic_Hash_Tables; 516 517end GNAT.Dynamic_HTables; 518