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