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