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 _ M A P 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
36private with Ada.Containers.Hash_Tables;
37private with Ada.Streams;
38private with Ada.Finalization;
39
40generic
41   type Key_Type is private;
42   type Element_Type is private;
43
44   with function Hash (Key : Key_Type) return Hash_Type;
45   with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
46   with function "=" (Left, Right : Element_Type) return Boolean is <>;
47
48package Ada.Containers.Bounded_Hashed_Maps is
49   pragma Annotate (CodePeer, Skip_Analysis);
50   pragma Pure;
51   pragma Remote_Types;
52
53   type Map (Capacity : Count_Type; Modulus : Hash_Type) is tagged private with
54      Constant_Indexing => Constant_Reference,
55      Variable_Indexing => Reference,
56      Default_Iterator  => Iterate,
57      Iterator_Element  => Element_Type;
58
59   pragma Preelaborable_Initialization (Map);
60
61   type Cursor is private;
62   pragma Preelaborable_Initialization (Cursor);
63
64   Empty_Map : constant Map;
65   --  Map objects declared without an initialization expression are
66   --  initialized to the value Empty_Map.
67
68   No_Element : constant Cursor;
69   --  Cursor objects declared without an initialization expression are
70   --  initialized to the value No_Element.
71
72   function Has_Element (Position : Cursor) return Boolean;
73   --  Equivalent to Position /= No_Element
74
75   package Map_Iterator_Interfaces is new
76     Ada.Iterator_Interfaces (Cursor, Has_Element);
77
78   function "=" (Left, Right : Map) return Boolean;
79   --  For each key/element pair in Left, equality attempts to find the key in
80   --  Right; if a search fails the equality returns False. The search works by
81   --  calling Hash to find the bucket in the Right map that corresponds to the
82   --  Left key. If bucket is non-empty, then equality calls Equivalent_Keys
83   --  to compare the key (in Left) to the key of each node in the bucket (in
84   --  Right); if the keys are equivalent, then the equality test for this
85   --  key/element pair (in Left) completes by calling the element equality
86   --  operator to compare the element (in Left) to the element of the node
87   --  (in Right) whose key matched.
88
89   function Capacity (Container : Map) return Count_Type;
90   --  Returns the current capacity of the map. Capacity is the maximum length
91   --  before which rehashing in guaranteed not to occur.
92
93   procedure Reserve_Capacity (Container : in out Map; Capacity : Count_Type);
94   --  If the value of the Capacity actual parameter is less or equal to
95   --  Container.Capacity, then the operation has no effect.  Otherwise it
96   --  raises Capacity_Error (as no expansion of capacity is possible for a
97   --  bounded form).
98
99   function Default_Modulus (Capacity : Count_Type) return Hash_Type;
100   --  Returns a modulus value (hash table size) which is optimal for the
101   --  specified capacity (which corresponds to the maximum number of items).
102
103   function Length (Container : Map) return Count_Type;
104   --  Returns the number of items in the map
105
106   function Is_Empty (Container : Map) return Boolean;
107   --  Equivalent to Length (Container) = 0
108
109   procedure Clear (Container : in out Map);
110   --  Removes all of the items from the map. This will deallocate all memory
111   --  associated with this map.
112
113   function Key (Position : Cursor) return Key_Type;
114   --  Returns the key of the node designated by the cursor
115
116   function Element (Position : Cursor) return Element_Type;
117   --  Returns the element of the node designated by the cursor
118
119   procedure Replace_Element
120     (Container : in out Map;
121      Position  : Cursor;
122      New_Item  : Element_Type);
123   --  Assigns the value New_Item to the element designated by the cursor
124
125   procedure Query_Element
126     (Position : Cursor;
127      Process  : not null access
128                   procedure (Key : Key_Type; Element : Element_Type));
129   --  Calls Process with the key and element (both having only a constant
130   --  view) of the node designed by the cursor.
131
132   procedure Update_Element
133     (Container : in out Map;
134      Position  : Cursor;
135      Process   : not null access
136                    procedure (Key : Key_Type; Element : in out Element_Type));
137   --  Calls Process with the key (with only a constant view) and element (with
138   --  a variable view) of the node designed by the cursor.
139
140   type Constant_Reference_Type
141      (Element : not null access constant Element_Type) is
142   private
143   with
144      Implicit_Dereference => Element;
145
146   type Reference_Type (Element : not null access Element_Type) is private
147   with
148      Implicit_Dereference => Element;
149
150   function Constant_Reference
151     (Container : aliased Map;
152      Position  : Cursor) return Constant_Reference_Type;
153
154   function Reference
155     (Container : aliased in out Map;
156      Position  : Cursor) return Reference_Type;
157
158   function Constant_Reference
159     (Container : aliased Map;
160      Key       : Key_Type) return Constant_Reference_Type;
161
162   function Reference
163     (Container : aliased in out Map;
164      Key       : Key_Type) return Reference_Type;
165
166   procedure Assign (Target : in out Map; Source : Map);
167   --  If Target denotes the same object as Source, then the operation has no
168   --  effect. If the Target capacity is less than the Source length, then
169   --  Assign raises Capacity_Error.  Otherwise, Assign clears Target and then
170   --  copies the (active) elements from Source to Target.
171
172   function Copy
173     (Source   : Map;
174      Capacity : Count_Type := 0;
175      Modulus  : Hash_Type := 0) return Map;
176   --  Constructs a new set object whose elements correspond to Source.  If the
177   --  Capacity parameter is 0, then the capacity of the result is the same as
178   --  the length of Source. If the Capacity parameter is equal or greater than
179   --  the length of Source, then the capacity of the result is the specified
180   --  value. Otherwise, Copy raises Capacity_Error. If the Modulus parameter
181   --  is 0, then the modulus of the result is the value returned by a call to
182   --  Default_Modulus with the capacity parameter determined as above;
183   --  otherwise the modulus of the result is the specified value.
184
185   procedure Move (Target : in out Map; Source : in out Map);
186   --  Clears Target (if it's not empty), and then moves (not copies) the
187   --  buckets array and nodes from Source to Target.
188
189   procedure Insert
190     (Container : in out Map;
191      Key       : Key_Type;
192      New_Item  : Element_Type;
193      Position  : out Cursor;
194      Inserted  : out Boolean);
195   --  Conditionally inserts New_Item into the map. If Key is already in the
196   --  map, then Inserted returns False and Position designates the node
197   --  containing the existing key/element pair (neither of which is modified).
198   --  If Key is not already in the map, the Inserted returns True and Position
199   --  designates the newly-inserted node container Key and New_Item. The
200   --  search for the key works as follows. Hash is called to determine Key's
201   --  bucket; if the bucket is non-empty, then Equivalent_Keys is called to
202   --  compare Key to each node in that bucket. If the bucket is empty, or
203   --  there were no matching keys in the bucket, the search "fails" and the
204   --  key/item pair is inserted in the map (and Inserted returns True);
205   --  otherwise, the search "succeeds" (and Inserted returns False).
206
207   procedure Insert
208     (Container : in out Map;
209      Key       : Key_Type;
210      Position  : out Cursor;
211      Inserted  : out Boolean);
212   --  The same as the (conditional) Insert that accepts an element parameter,
213   --  with the difference that if Inserted returns True, then the element of
214   --  the newly-inserted node is initialized to its default value.
215
216   procedure Insert
217     (Container : in out Map;
218      Key       : Key_Type;
219      New_Item  : Element_Type);
220   --  Attempts to insert Key into the map, performing the usual search (which
221   --  involves calling both Hash and Equivalent_Keys); if the search succeeds
222   --  (because Key is already in the map), then it raises Constraint_Error.
223   --  (This version of Insert is similar to Replace, but having the opposite
224   --  exception behavior. It is intended for use when you want to assert that
225   --  Key is not already in the map.)
226
227   procedure Include
228     (Container : in out Map;
229      Key       : Key_Type;
230      New_Item  : Element_Type);
231   --  Attempts to insert Key into the map. If Key is already in the map, then
232   --  both the existing key and element are assigned the values of Key and
233   --  New_Item, respectively. (This version of Insert only raises an exception
234   --  if cursor tampering occurs. It is intended for use when you want to
235   --  insert the key/element pair in the map, and you don't care whether Key
236   --  is already present.)
237
238   procedure Replace
239     (Container : in out Map;
240      Key       : Key_Type;
241      New_Item  : Element_Type);
242   --  Searches for Key in the map; if the search fails (because Key was not in
243   --  the map), then it raises Constraint_Error. Otherwise, both the existing
244   --  key and element are assigned the values of Key and New_Item rsp. (This
245   --  is similar to Insert, but with the opposite exception behavior. It is to
246   --  be used when you want to assert that Key is already in the map.)
247
248   procedure Exclude (Container : in out Map; Key : Key_Type);
249   --  Searches for Key in the map, and if found, removes its node from the map
250   --  and then deallocates it. The search works as follows. The operation
251   --  calls Hash to determine the key's bucket; if the bucket is not empty, it
252   --  calls Equivalent_Keys to compare Key to each key in the bucket. (This is
253   --  the deletion analog of Include. It is intended for use when you want to
254   --  remove the item from the map, but don't care whether the key is already
255   --  in the map.)
256
257   procedure Delete (Container : in out Map; Key : Key_Type);
258   --  Searches for Key in the map (which involves calling both Hash and
259   --  Equivalent_Keys). If the search fails, then the operation raises
260   --  Constraint_Error. Otherwise it removes the node from the map and then
261   --  deallocates it. (This is the deletion analog of non-conditional
262   --  Insert. It is intended for use when you want to assert that the item is
263   --  already in the map.)
264
265   procedure Delete (Container : in out Map; Position : in out Cursor);
266   --  Removes the node designated by Position from the map, and then
267   --  deallocates the node. The operation calls Hash to determine the bucket,
268   --  and then compares Position to each node in the bucket until there's a
269   --  match (it does not call Equivalent_Keys).
270
271   function First (Container : Map) return Cursor;
272   --  Returns a cursor that designates the first non-empty bucket, by
273   --  searching from the beginning of the buckets array.
274
275   function Next (Position : Cursor) return Cursor;
276   --  Returns a cursor that designates the node that follows the current one
277   --  designated by Position. If Position designates the last node in its
278   --  bucket, the operation calls Hash to compute the index of this bucket,
279   --  and searches the buckets array for the first non-empty bucket, starting
280   --  from that index; otherwise, it simply follows the link to the next node
281   --  in the same bucket.
282
283   procedure Next (Position : in out Cursor);
284   --  Equivalent to Position := Next (Position)
285
286   function Find (Container : Map; Key : Key_Type) return Cursor;
287   --  Searches for Key in the map. Find calls Hash to determine the key's
288   --  bucket; if the bucket is not empty, it calls Equivalent_Keys to compare
289   --  Key to each key in the bucket. If the search succeeds, Find returns a
290   --  cursor designating the matching node; otherwise, it returns No_Element.
291
292   function Contains (Container : Map; Key : Key_Type) return Boolean;
293   --  Equivalent to Find (Container, Key) /= No_Element
294
295   function Element (Container : Map; Key : Key_Type) return Element_Type;
296   --  Equivalent to Element (Find (Container, Key))
297
298   function Equivalent_Keys (Left, Right : Cursor) return Boolean;
299   --  Returns the result of calling Equivalent_Keys with the keys of the nodes
300   --  designated by cursors Left and Right.
301
302   function Equivalent_Keys (Left : Cursor; Right : Key_Type) return Boolean;
303   --  Returns the result of calling Equivalent_Keys with key of the node
304   --  designated by Left and key Right.
305
306   function Equivalent_Keys (Left : Key_Type; Right : Cursor) return Boolean;
307   --  Returns the result of calling Equivalent_Keys with key Left and the node
308   --  designated by Right.
309
310   procedure Iterate
311     (Container : Map;
312      Process   : not null access procedure (Position : Cursor));
313   --  Calls Process for each node in the map
314
315   function Iterate (Container : Map)
316      return Map_Iterator_Interfaces.Forward_Iterator'class;
317
318private
319   pragma Inline (Length);
320   pragma Inline (Is_Empty);
321   pragma Inline (Clear);
322   pragma Inline (Key);
323   pragma Inline (Element);
324   pragma Inline (Move);
325   pragma Inline (Contains);
326   pragma Inline (Capacity);
327   pragma Inline (Reserve_Capacity);
328   pragma Inline (Has_Element);
329   pragma Inline (Next);
330
331   type Node_Type is record
332      Key     : Key_Type;
333      Element : aliased Element_Type;
334      Next    : Count_Type;
335   end record;
336
337   package HT_Types is
338     new Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type);
339
340   type Map (Capacity : Count_Type; Modulus : Hash_Type) is
341      new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
342
343   use HT_Types, HT_Types.Implementation;
344   use Ada.Streams;
345   use Ada.Finalization;
346
347   procedure Write
348     (Stream    : not null access Root_Stream_Type'Class;
349      Container : Map);
350
351   for Map'Write use Write;
352
353   procedure Read
354     (Stream    : not null access Root_Stream_Type'Class;
355      Container : out Map);
356
357   for Map'Read use Read;
358
359   type Map_Access is access all Map;
360   for Map_Access'Storage_Size use 0;
361
362   --  Note: If a Cursor object has no explicit initialization expression,
363   --  it must default initialize to the same value as constant No_Element.
364   --  The Node component of type Cursor has scalar type Count_Type, so it
365   --  requires an explicit initialization expression of its own declaration,
366   --  in order for objects of record type Cursor to properly initialize.
367
368   type Cursor is record
369      Container : Map_Access;
370      Node      : Count_Type := 0;
371   end record;
372
373   procedure Read
374     (Stream : not null access Root_Stream_Type'Class;
375      Item   : out Cursor);
376
377   for Cursor'Read use Read;
378
379   procedure Write
380     (Stream : not null access Root_Stream_Type'Class;
381      Item   : Cursor);
382
383   for Cursor'Write use Write;
384
385   subtype Reference_Control_Type is Implementation.Reference_Control_Type;
386   --  It is necessary to rename this here, so that the compiler can find it
387
388   type Constant_Reference_Type
389     (Element : not null access constant Element_Type) is
390      record
391         Control : Reference_Control_Type :=
392           raise Program_Error with "uninitialized reference";
393         --  The RM says, "The default initialization of an object of
394         --  type Constant_Reference_Type or Reference_Type propagates
395         --  Program_Error."
396      end record;
397
398   procedure Write
399     (Stream : not null access Root_Stream_Type'Class;
400      Item   : Constant_Reference_Type);
401
402   for Constant_Reference_Type'Write use Write;
403
404   procedure Read
405     (Stream : not null access Root_Stream_Type'Class;
406      Item   : out Constant_Reference_Type);
407
408   for Constant_Reference_Type'Read use Read;
409
410   type Reference_Type (Element : not null access Element_Type) is record
411      Control : Reference_Control_Type :=
412        raise Program_Error with "uninitialized reference";
413      --  The RM says, "The default initialization of an object of
414      --  type Constant_Reference_Type or Reference_Type propagates
415      --  Program_Error."
416   end record;
417
418   procedure Write
419     (Stream : not null access Root_Stream_Type'Class;
420      Item   : Reference_Type);
421
422   for Reference_Type'Write use Write;
423
424   procedure Read
425     (Stream : not null access Root_Stream_Type'Class;
426      Item   : out Reference_Type);
427
428   for Reference_Type'Read use Read;
429
430   --  Three operations are used to optimize in the expansion of "for ... of"
431   --  loops: the Next(Cursor) procedure in the visible part, and the following
432   --  Pseudo_Reference and Get_Element_Access functions. See Sem_Ch5 for
433   --  details.
434
435   function Pseudo_Reference
436     (Container : aliased Map'Class) return Reference_Control_Type;
437   pragma Inline (Pseudo_Reference);
438   --  Creates an object of type Reference_Control_Type pointing to the
439   --  container, and increments the Lock. Finalization of this object will
440   --  decrement the Lock.
441
442   type Element_Access is access all Element_Type with
443     Storage_Size => 0;
444
445   function Get_Element_Access
446     (Position : Cursor) return not null Element_Access;
447   --  Returns a pointer to the element designated by Position.
448
449   Empty_Map : constant Map :=
450                 (Hash_Table_Type with Capacity => 0, Modulus => 0);
451
452   No_Element : constant Cursor := (Container => null, Node => 0);
453
454   type Iterator is new Limited_Controlled and
455     Map_Iterator_Interfaces.Forward_Iterator with
456   record
457      Container : Map_Access;
458   end record
459     with Disable_Controlled => not T_Check;
460
461   overriding procedure Finalize (Object : in out Iterator);
462
463   overriding function First (Object : Iterator) return Cursor;
464
465   overriding function Next
466     (Object   : Iterator;
467      Position : Cursor) return Cursor;
468
469end Ada.Containers.Bounded_Hashed_Maps;
470