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-2014, 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 three 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. The Load_Factor_HTable package provides a more 39-- complex abstraction where collisions are resolved by chaining, and the 40-- table grows by a percentage after the load factor has been exceeded. 41 42-- This package provides a facility similar to that of GNAT.HTable, except 43-- that this package declares types that can be used to define dynamic 44-- instances of hash tables, while instantiations in GNAT.HTable creates a 45-- single instance of the hash table. 46 47-- Note that this interface should remain synchronized with those in 48-- GNAT.HTable to keep as much coherency as possible between these two 49-- related units. 50 51private with Ada.Finalization; 52 53package GNAT.Dynamic_HTables is 54 55 ------------------- 56 -- Static_HTable -- 57 ------------------- 58 59 -- A low-level Hash-Table abstraction, not as easy to instantiate as 60 -- Simple_HTable. This mirrors the interface of GNAT.HTable.Static_HTable, 61 -- but does require dynamic allocation (since we allow multiple instances 62 -- of the table). The model is that each Element contains its own Key that 63 -- can be retrieved by Get_Key. Furthermore, Element provides a link that 64 -- can be used by the HTable for linking elements with same hash codes: 65 66 -- Element 67 68 -- +-------------------+ 69 -- | Key | 70 -- +-------------------+ 71 -- : other data : 72 -- +-------------------+ 73 -- | Next Elmt | 74 -- +-------------------+ 75 76 generic 77 type Header_Num is range <>; 78 -- An integer type indicating the number and range of hash headers 79 80 type Element (<>) is limited private; 81 -- The type of element to be stored 82 83 type Elmt_Ptr is private; 84 -- The type used to reference an element (will usually be an access 85 -- type, but could be some other form of type such as an integer type). 86 87 Null_Ptr : Elmt_Ptr; 88 -- The null value of the Elmt_Ptr type 89 90 with procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr); 91 with function Next (E : Elmt_Ptr) return Elmt_Ptr; 92 -- The type must provide an internal link for the sake of the 93 -- staticness of the HTable. 94 95 type Key is limited private; 96 with function Get_Key (E : Elmt_Ptr) return Key; 97 with function Hash (F : Key) return Header_Num; 98 with function Equal (F1, F2 : Key) return Boolean; 99 100 package Static_HTable is 101 102 type Instance is private; 103 Nil : constant Instance; 104 105 procedure Reset (T : in out Instance); 106 -- Resets the hash table by releasing all memory associated with 107 -- it. The hash table can safely be reused after this call. For the 108 -- most common case where Elmt_Ptr is an access type, and Null_Ptr is 109 -- null, this is only needed if the same table is reused in a new 110 -- context. If Elmt_Ptr is other than an access type, or Null_Ptr is 111 -- other than null, then Reset must be called before the first use of 112 -- the hash table. 113 114 procedure Set (T : in out Instance; E : Elmt_Ptr); 115 -- Insert the element pointer in the HTable 116 117 function Get (T : Instance; K : Key) return Elmt_Ptr; 118 -- Returns the latest inserted element pointer with the given Key 119 -- or null if none. 120 121 procedure Remove (T : Instance; K : Key); 122 -- Removes the latest inserted element pointer associated with the 123 -- given key if any, does nothing if none. 124 125 function Get_First (T : Instance) return Elmt_Ptr; 126 -- Returns Null_Ptr if the Htable is empty, otherwise returns one 127 -- non specified element. There is no guarantee that 2 calls to this 128 -- function will return the same element. 129 130 function Get_Next (T : Instance) return Elmt_Ptr; 131 -- Returns a non-specified element that has not been returned by the 132 -- same function since the last call to Get_First or Null_Ptr if 133 -- there is no such element or Get_First has never been called. If 134 -- there is no call to 'Set' in between Get_Next calls, all the 135 -- elements of the Htable will be traversed. 136 137 private 138 type Instance_Data; 139 type Instance is access all Instance_Data; 140 Nil : constant Instance := null; 141 end Static_HTable; 142 143 ------------------- 144 -- Simple_HTable -- 145 ------------------- 146 147 -- A simple hash table abstraction, easy to instantiate, easy to use. 148 -- The table associates one element to one key with the procedure Set. 149 -- Get retrieves the Element stored for a given Key. The efficiency of 150 -- retrieval is function of the size of the Table parameterized by 151 -- Header_Num and the hashing function Hash. 152 153 generic 154 type Header_Num is range <>; 155 -- An integer type indicating the number and range of hash headers 156 157 type Element is private; 158 -- The type of element to be stored 159 160 No_Element : Element; 161 -- The object that is returned by Get when no element has been set for 162 -- a given key 163 164 type Key is private; 165 with function Hash (F : Key) return Header_Num; 166 with function Equal (F1, F2 : Key) return Boolean; 167 168 package Simple_HTable is 169 170 type Instance is private; 171 Nil : constant Instance; 172 173 procedure Set (T : in out Instance; K : Key; E : Element); 174 -- Associates an element with a given key. Overrides any previously 175 -- associated element. 176 177 procedure Reset (T : in out Instance); 178 -- Releases all memory associated with the table. The table can be 179 -- reused after this call (it is automatically allocated on the first 180 -- access to the table). 181 182 function Get (T : Instance; K : Key) return Element; 183 -- Returns the Element associated with a key or No_Element if the 184 -- given key has not associated element 185 186 procedure Remove (T : Instance; K : Key); 187 -- Removes the latest inserted element pointer associated with the 188 -- given key if any, does nothing if none. 189 190 function Get_First (T : Instance) return Element; 191 -- Returns No_Element if the Htable is empty, otherwise returns one 192 -- non specified element. There is no guarantee that two calls to this 193 -- function will return the same element, if the Htable has been 194 -- modified between the two calls. 195 196 function Get_Next (T : Instance) return Element; 197 -- Returns a non-specified element that has not been returned by the 198 -- same function since the last call to Get_First or No_Element if 199 -- there is no such element. If there is no call to 'Set' in between 200 -- Get_Next calls, all the elements of the Htable will be traversed. 201 -- To guarantee that all the elements of the Htable will be traversed, 202 -- no modification of the Htable (Set, Reset, Remove) should occur 203 -- between a call to Get_First and subsequent consecutive calls to 204 -- Get_Next, until one of these calls returns No_Element. 205 206 private 207 208 type Element_Wrapper; 209 type Elmt_Ptr is access all Element_Wrapper; 210 type Element_Wrapper is record 211 K : Key; 212 E : Element; 213 Next : Elmt_Ptr; 214 end record; 215 216 procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr); 217 function Next (E : Elmt_Ptr) return Elmt_Ptr; 218 function Get_Key (E : Elmt_Ptr) return Key; 219 220 package Tab is new Static_HTable 221 (Header_Num => Header_Num, 222 Element => Element_Wrapper, 223 Elmt_Ptr => Elmt_Ptr, 224 Null_Ptr => null, 225 Set_Next => Set_Next, 226 Next => Next, 227 Key => Key, 228 Get_Key => Get_Key, 229 Hash => Hash, 230 Equal => Equal); 231 232 type Instance is new Tab.Instance; 233 Nil : constant Instance := Instance (Tab.Nil); 234 235 end Simple_HTable; 236 237 ------------------------ 238 -- Load_Factor_HTable -- 239 ------------------------ 240 241 -- A simple hash table abstraction capable of growing once a threshold has 242 -- been exceeded. Collisions are resolved by chaining elements onto lists 243 -- hanging from individual buckets. This implementation does not make any 244 -- effort to minimize the number of necessary rehashes once the table has 245 -- been expanded, hence the term "simple". 246 247 -- WARNING: This hash table implementation utilizes dynamic allocation. 248 -- Storage reclamation is performed by the hash table. 249 250 -- WARNING: This hash table implementation is not thread-safe. To achieve 251 -- proper concurrency and synchronization, wrap an instance of a table in 252 -- a protected object. 253 254 generic 255 type Range_Type is range <>; 256 -- The underlying range of the hash table. Note that this type must be 257 -- large enough to accommodate multiple expansions of the table. 258 259 type Key_Type is private; 260 type Value_Type is private; 261 -- The types of the (key, value) pair stored in the hash table 262 263 No_Value : Value_Type; 264 -- A predefined value denoting a non-existent value 265 266 Initial_Size : Positive; 267 -- The starting size of the hash table. The hash table must contain at 268 -- least one bucket. 269 270 Growth_Percentage : Positive; 271 -- The amount of increase expressed as a percentage. The hash table must 272 -- grow by at least 1%. To illustrate, a value of 100 will increase the 273 -- table by 100%, effectively doubling its size. 274 275 Load_Factor : Float; 276 -- The ratio of the elements stored within the hash table divided by the 277 -- current size of the table. This value acts as the growth threshold. 278 -- If exceeded, the hash table is expanded by Growth_Percentage. 279 280 with function Equal 281 (Left : Key_Type; 282 Right : Key_Type) return Boolean; 283 284 with function Hash 285 (Key : Key_Type; 286 Size : Positive) return Range_Type; 287 -- Parameter Size denotes the current size of the hash table 288 289 package Load_Factor_HTable is 290 type Table is tagged limited private; 291 292 function Current_Size (T : Table) return Positive; 293 -- Obtain the current size of the table 294 295 function Get (T : Table; Key : Key_Type) return Value_Type; 296 -- Obtain the value associated with a key. This routine returns No_Value 297 -- if the key is not present in the hash table. 298 299 procedure Remove (T : in out Table; Key : Key_Type); 300 -- Remove the value associated with the given key. This routine has no 301 -- effect if the key is not present in the hash table. 302 303 procedure Set 304 (T : in out Table; 305 Key : Key_Type; 306 Val : Value_Type); 307 -- Associate a value with a given key. This routine has no effect if the 308 -- the (key, value) pair is already present in the hash table. Note that 309 -- this action may cause the table to grow. 310 311 private 312 -- The following types model a bucket chain. Note that the key is also 313 -- stored for rehashing purposes. 314 315 type Element; 316 type Element_Ptr is access all Element; 317 type Element is record 318 Key : Key_Type; 319 Val : Value_Type; 320 Prev : Element_Ptr := null; 321 Next : Element_Ptr := null; 322 end record; 323 324 No_Element : constant Element_Ptr := null; 325 326 -- The following types model the buckets of the hash table. Each bucket 327 -- has a dummy head to facilitate insertion and deletion of elements. 328 329 type Buckets_Array is array (Range_Type range <>) of aliased Element; 330 type Buckets_Array_Ptr is access all Buckets_Array; 331 332 type Table is new Ada.Finalization.Limited_Controlled with record 333 Buckets : Buckets_Array_Ptr := null; 334 335 Element_Count : Natural := 0; 336 -- The number of (key, value) pairs stored in the hash table 337 end record; 338 339 procedure Finalize (T : in out Table); 340 -- Destroy the contents of a hash table by reclaiming all storage used 341 -- by buckets and their respective chains. 342 343 procedure Initialize (T : in out Table); 344 -- Create a hash table with buckets within the range Range_Type'First .. 345 -- Range_Type'First + Initial_Size - 1. 346 347 end Load_Factor_HTable; 348 349end GNAT.Dynamic_HTables; 350