gcc/ada/libgnat/a-cohama.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --            A D A . C O N T A I N E R S . H A S H E D _ M A P S           --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2004-2023, 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
  34 with Ada.Iterator_Interfaces;
  35
  36 private with Ada.Containers.Hash_Tables;
  37 private with Ada.Finalization;
  38 private with Ada.Streams;
  39 private with Ada.Strings.Text_Buffers;
  40
  41 --  The language-defined generic package Containers.Hashed_Maps provides
  42 --  private types Map and Cursor, and a set of operations for each type. A map
  43 --  container allows an arbitrary type to be used as a key to find the element
  44 --  associated with that key. A hashed map uses a hash function to organize the
  45 --  keys.
  46 --
  47 --  A map contains pairs of keys and elements, called nodes. Map cursors
  48 --  designate nodes, but also can be thought of as designating an element (the
  49 --  element contained in the node) for consistency with the other containers.
  50 --  There exists an equivalence relation on keys, whose definition is different
  51 --  for hashed maps and ordered maps. A map never contains two or more nodes
  52 --  with equivalent keys. The length of a map is the number of nodes it
  53 --  contains.
  54 --
  55 --  Each nonempty map has two particular nodes called the first node and the
  56 --  last node (which may be the same). Each node except for the last node has a
  57 --  successor node. If there are no other intervening operations, starting with
  58 --  the first node and repeatedly going to the successor node will visit each
  59 --  node in the map exactly once until the last node is reached.
  60
  61 generic
  62    type Key_Type is private;
  63    type Element_Type is private;
  64
  65    with function Hash (Key : Key_Type) return Hash_Type;
  66    --  The actual function for the generic formal function Hash is expected to
  67    --  return the same value each time it is called with a particular key
  68    --  value. For any two equivalent key values, the actual for Hash is
  69    --  expected to return the same value. If the actual for Hash behaves in
  70    --  some other manner, the behavior of this package is unspecified. Which
  71    --  subprograms of this package call Hash, and how many times they call it,
  72    --  is unspecified.
  73
  74    with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
  75    --  The actual function for the generic formal function Equivalent_Keys on
  76    --  Key_Type values is expected to return the same value each time it is
  77    --  called with a particular pair of key values. It should define an
  78    --  equivalence relationship, that is, be reflexive, symmetric, and
  79    --  transitive. If the actual for Equivalent_Keys behaves in some other
  80    --  manner, the behavior of this package is unspecified. Which subprograms
  81    --  of this package call Equivalent_Keys, and how many times they call it,
  82    --  is unspecified.
  83
  84    with function "=" (Left, Right : Element_Type) return Boolean is <>;
  85    --  The actual function for the generic formal function "=" on Element_Type
  86    --  values is expected to define a reflexive and symmetric relationship and
  87    --  return the same result value each time it is called with a particular
  88    --  pair of values.  If it behaves in some other manner, the function "=" on
  89    --  map values returns an unspecified value. The exact arguments and number
  90    --  of calls of this generic formal function by the function "=" on map
  91    --  values are unspecified.
  92 package Ada.Containers.Hashed_Maps with
  93   SPARK_Mode => Off
  94 is
  95    pragma Annotate (CodePeer, Skip_Analysis);
  96    pragma Preelaborate;
  97    pragma Remote_Types;
  98
  99    type Map is tagged private
 100    with
 101       Constant_Indexing => Constant_Reference,
 102       Variable_Indexing => Reference,
 103       Default_Iterator  => Iterate,
 104       Iterator_Element  => Element_Type,
 105       Aggregate         => (Empty     => Empty,
 106                             Add_Named => Insert);
 107
 108    pragma Preelaborable_Initialization (Map);
 109
 110    type Cursor is private;
 111    pragma Preelaborable_Initialization (Cursor);
 112
 113    function "=" (Left, Right : Cursor) return Boolean;
 114    --  The representation of cursors includes a component used to optimize
 115    --  iteration over maps. This component may become unreliable after
 116    --  multiple map insertions, and must be excluded from cursor equality,
 117    --  so we need to provide an explicit definition for it, instead of
 118    --  using predefined equality (as implied by a questionable comment
 119    --  in the RM).
 120
 121    Empty_Map : constant Map;
 122    --  Map objects declared without an initialization expression are
 123    --  initialized to the value Empty_Map.
 124
 125    No_Element : constant Cursor;
 126    --  Cursor objects declared without an initialization expression are
 127    --  initialized to the value No_Element.
 128
 129    function Empty (Capacity : Count_Type := 1000) return Map;
 130
 131    function Has_Element (Position : Cursor) return Boolean;
 132    --  Returns True if Position designates an element, and returns False
 133    --  otherwise.
 134
 135    package Map_Iterator_Interfaces is new
 136      Ada.Iterator_Interfaces (Cursor, Has_Element);
 137
 138    function "=" (Left, Right : Map) return Boolean;
 139    --  If Left and Right denote the same map object, then the function returns
 140    --  True. If Left and Right have different lengths, then the function
 141    --  returns False. Otherwise, for each key K in Left, the function returns
 142    --  False if:
 143    --
 144    --  * a key equivalent to K is not present in Right; or
 145    --
 146    --  * the element associated with K in Left is not equal to the
 147    --    element associated with K in Right (using the generic formal
 148    --    equality operator for elements).
 149    --
 150    --  If the function has not returned a result after checking all of the
 151    --  keys, it returns True. Any exception raised during evaluation of key
 152    --  equivalence or element equality is propagated.
 153
 154    function Capacity (Container : Map) return Count_Type;
 155    --  Returns the current capacity of the map. Capacity is the maximum length
 156    --  before which rehashing in guaranteed not to occur.
 157
 158    procedure Reserve_Capacity (Container : in out Map; Capacity : Count_Type);
 159    --  Adjusts the current capacity, by allocating a new buckets array. If the
 160    --  requested capacity is less than the current capacity, then the capacity
 161    --  is contracted (to a value not less than the current length). If the
 162    --  requested capacity is greater than the current capacity, then the
 163    --  capacity is expanded (to a value not less than what is requested). In
 164    --  either case, the nodes are rehashed from the old buckets array onto the
 165    --  new buckets array (Hash is called once for each existing key in order to
 166    --  compute the new index), and then the old buckets array is deallocated.
 167
 168    function Length (Container : Map) return Count_Type;
 169    --  Returns the number of items in the map
 170
 171    function Is_Empty (Container : Map) return Boolean;
 172    --  Equivalent to Length (Container) = 0
 173
 174    procedure Clear (Container : in out Map);
 175    --  Removes all of the items from the map
 176
 177    function Key (Position : Cursor) return Key_Type;
 178    --  Key returns the key component of the node designated by Position.
 179    --
 180    --  If Position equals No_Element, then Constraint_Error is propagated.
 181
 182    function Element (Position : Cursor) return Element_Type;
 183    --  Element returns the element component of the node designated
 184    --  by Position.
 185    --
 186    --  If Position equals No_Element, then Constraint_Error is propagated.
 187
 188    procedure Replace_Element
 189      (Container : in out Map;
 190       Position  : Cursor;
 191       New_Item  : Element_Type);
 192    --  Replace_Element assigns New_Item to the element of the node designated
 193    --  by Position.
 194    --
 195    --  If Position equals No_Element, then Constraint_Error is propagated; if
 196    --  Position does not designate an element in Container, then Program_Error
 197    --  is propagated.
 198
 199    procedure Query_Element
 200      (Position : Cursor;
 201       Process  : not null access
 202                    procedure (Key : Key_Type; Element : Element_Type));
 203    --  Query_Element calls Process.all with the key and element from the node
 204    --  designated by Position as the arguments.
 205    --
 206    --  If Position equals No_Element, then Constraint_Error is propagated.
 207    --
 208    --  Tampering with the elements of the map that contains the element
 209    --  designated by Position is prohibited during the execution of the call on
 210    --  Process.all. Any exception raised by Process.all is propagated.
 211
 212    procedure Update_Element
 213      (Container : in out Map;
 214       Position  : Cursor;
 215       Process   : not null access
 216                     procedure (Key : Key_Type; Element : in out Element_Type));
 217    --  Update_Element calls Process.all with the key and element from the node
 218    --  designated by Position as the arguments.
 219    --
 220    --  If Position equals No_Element, then Constraint_Error is propagated; if
 221    --  Position does not designate an element in Container, then Program_Error
 222    --  is propagated.
 223    --
 224    --  Tampering with the elements of Container is prohibited during the
 225    --  execution of the call on Process.all. Any exception raised by
 226    --  Process.all is propagated.
 227
 228    type Constant_Reference_Type
 229       (Element : not null access constant Element_Type) is private
 230    with
 231       Implicit_Dereference => Element;
 232
 233    type Reference_Type (Element : not null access Element_Type) is private
 234    with
 235       Implicit_Dereference => Element;
 236
 237    function Constant_Reference
 238      (Container : aliased Map;
 239       Position  : Cursor) return Constant_Reference_Type;
 240    pragma Inline (Constant_Reference);
 241    --  This function (combined with the Constant_Indexing and
 242    --  Implicit_Dereference aspects) provides a convenient way to gain read
 243    --  access to an individual element of a map given a cursor.
 244    --  Constant_Reference returns an object whose discriminant is an access
 245    --  value that designates the element designated by Position.
 246    --
 247    --  If Position equals No_Element, then Constraint_Error is propagated; if
 248    --  Position does not designate an element in Container, then Program_Error
 249    --  is propagated.
 250    --
 251    --  Tampering with the elements of Container is prohibited
 252    --  while the object returned by Constant_Reference exists and has not been
 253    --  finalized.
 254
 255    function Reference
 256      (Container : aliased in out Map;
 257       Position  : Cursor) return Reference_Type;
 258    pragma Inline (Reference);
 259    --  This function (combined with the Variable_Indexing and
 260    --  Implicit_Dereference aspects) provides a convenient way to gain read and
 261    --  write access to an individual element of a map given a cursor.
 262    --  Reference returns an object whose discriminant is an access value that
 263    --  designates the element designated by Position.
 264    --
 265    --  If Position equals No_Element, then Constraint_Error is propagated; if
 266    --  Position does not designate an element in Container, then Program_Error
 267    --  is propagated.
 268    --
 269    --  Tampering with the elements of Container is prohibited while the object
 270    --  returned by Reference exists and has not been finalized.
 271
 272    function Constant_Reference
 273      (Container : aliased Map;
 274       Key       : Key_Type) return Constant_Reference_Type;
 275    pragma Inline (Constant_Reference);
 276    --  Equivalent to Constant_Reference (Container, Find (Container, Key)).
 277
 278    function Reference
 279      (Container : aliased in out Map;
 280       Key       : Key_Type) return Reference_Type;
 281    pragma Inline (Reference);
 282    --  Equivalent to Reference (Container, Find (Container, Key)).
 283
 284    procedure Assign (Target : in out Map; Source : Map);
 285    --  If Target denotes the same object as Source, the operation has no
 286    --  effect. Otherwise, the key/element pairs of Source are copied to Target
 287    --  as for an assignment_statement assigning Source to Target.
 288
 289    function Copy (Source : Map; Capacity : Count_Type := 0) return Map;
 290
 291    procedure Move (Target : in out Map; Source : in out Map);
 292    --  If Target denotes the same object as Source, then the operation has no
 293    --  effect. Otherwise, the operation is equivalent to Assign (Target,
 294    --  Source) followed by Clear (Source).
 295
 296    procedure Insert
 297      (Container : in out Map;
 298       Key       : Key_Type;
 299       New_Item  : Element_Type;
 300       Position  : out Cursor;
 301       Inserted  : out Boolean);
 302    --  Insert checks if a node with a key equivalent to Key is already present
 303    --  in Container. If a match is found, Inserted is set to False and Position
 304    --  designates the element with the matching key.  Otherwise, Insert
 305    --  allocates a new node, initializes it to Key and New_Item, and adds it to
 306    --  Container; Inserted is set to True and Position designates the
 307    --  newly-inserted node. Any exception raised during allocation is
 308    --  propagated and Container is not modified.
 309
 310    procedure Insert
 311      (Container : in out Map;
 312       Key       : Key_Type;
 313       Position  : out Cursor;
 314       Inserted  : out Boolean);
 315    --  Insert inserts Key into Container as per the five-parameter Insert, with
 316    --  the difference that an element initialized by default (see 3.3.1) is
 317    --  inserted.
 318
 319    procedure Insert
 320      (Container : in out Map;
 321       Key       : Key_Type;
 322       New_Item  : Element_Type);
 323    --  Insert inserts Key and New_Item into Container as per the five-parameter
 324    --  Insert, with the difference that if a node with a key equivalent to Key
 325    --  is already in the map, then Constraint_Error is propagated.
 326
 327    procedure Include
 328      (Container : in out Map;
 329       Key       : Key_Type;
 330       New_Item  : Element_Type);
 331    --  Include inserts Key and New_Item into Container as per the
 332    --  five-parameter Insert, with the difference that if a node with a key
 333    --  equivalent to Key is already in the map, then this operation assigns Key
 334    --  and New_Item to the matching node. Any exception raised during
 335    --  assignment is propagated.
 336
 337    procedure Replace
 338      (Container : in out Map;
 339       Key       : Key_Type;
 340       New_Item  : Element_Type);
 341    --  Replace checks if a node with a key equivalent to Key is present in
 342    --  Container. If a match is found, Replace assigns Key and New_Item to the
 343    --  matching node; otherwise, Constraint_Error is propagated.
 344
 345    procedure Exclude (Container : in out Map; Key : Key_Type);
 346    --  Exclude checks if a node with a key equivalent to Key is present in
 347    --  Container. If a match is found, Exclude removes the node from the map.
 348
 349    procedure Delete (Container : in out Map; Key : Key_Type);
 350    --  Delete checks if a node with a key equivalent to Key is present in
 351    --  Container. If a match is found, Delete removes the node from the map;
 352    --  otherwise, Constraint_Error is propagated.
 353
 354    procedure Delete (Container : in out Map; Position : in out Cursor);
 355    --  Delete removes the node designated by Position from the map. Position is
 356    --  set to No_Element on return.
 357    --
 358    --  If Position equals No_Element, then Constraint_Error is propagated. If
 359    --  Position does not designate an element in Container, then Program_Error
 360    --  is propagated.
 361
 362    function First (Container : Map) return Cursor;
 363    --  If Length (Container) = 0, then First returns No_Element.  Otherwise,
 364    --  First returns a cursor that designates the first node in Container.
 365
 366    function Next (Position : Cursor) return Cursor;
 367    --  Returns a cursor that designates the successor of the node designated by
 368    --  Position. If Position designates the last node, then No_Element is
 369    --  returned. If Position equals No_Element, then No_Element is returned.
 370
 371    procedure Next (Position : in out Cursor);
 372    --  Equivalent to Position := Next (Position)
 373
 374    function Find (Container : Map; Key : Key_Type) return Cursor;
 375    --  If Length (Container) equals 0, then Find returns No_Element.
 376    --  Otherwise, Find checks if a node with a key equivalent to Key is present
 377    --  in Container. If a match is found, a cursor designating the matching
 378    --  node is returned; otherwise, No_Element is returned.
 379
 380    function Contains (Container : Map; Key : Key_Type) return Boolean;
 381    --  Equivalent to Find (Container, Key) /= No_Element.
 382
 383    function Element (Container : Map; Key : Key_Type) return Element_Type;
 384    --  Equivalent to Element (Find (Container, Key))
 385
 386    function Equivalent_Keys (Left, Right : Cursor) return Boolean;
 387    --  Returns the result of calling Equivalent_Keys with the keys of the nodes
 388    --  designated by cursors Left and Right.
 389
 390    function Equivalent_Keys (Left : Cursor; Right : Key_Type) return Boolean;
 391    --  Returns the result of calling Equivalent_Keys with key of the node
 392    --  designated by Left and key Right.
 393
 394    function Equivalent_Keys (Left : Key_Type; Right : Cursor) return Boolean;
 395    --  Returns the result of calling Equivalent_Keys with key Left and the node
 396    --  designated by Right.
 397
 398    procedure Iterate
 399      (Container : Map;
 400       Process   : not null access procedure (Position : Cursor));
 401    --  Iterate calls Process.all with a cursor that designates each node in
 402    --  Container, starting with the first node and moving the cursor according
 403    --  to the successor relation. Tampering with the cursors of Container is
 404    --  prohibited during the execution of a call on Process.all. Any exception
 405    --  raised by Process.all is propagated.
 406
 407    function Iterate
 408      (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'Class;
 409
 410 private
 411    pragma Inline ("=");
 412    pragma Inline (Length);
 413    pragma Inline (Is_Empty);
 414    pragma Inline (Clear);
 415    pragma Inline (Key);
 416    pragma Inline (Element);
 417    pragma Inline (Move);
 418    pragma Inline (Contains);
 419    pragma Inline (Capacity);
 420    pragma Inline (Reserve_Capacity);
 421    pragma Inline (Has_Element);
 422    pragma Inline (Equivalent_Keys);
 423    pragma Inline (Next);
 424
 425    type Node_Type;
 426    type Node_Access is access Node_Type;
 427
 428    type Node_Type is limited record
 429       Key     : Key_Type;
 430       Element : aliased Element_Type;
 431       Next    : Node_Access;
 432    end record;
 433
 434    package HT_Types is
 435      new Hash_Tables.Generic_Hash_Table_Types (Node_Type, Node_Access);
 436
 437    type Map is new Ada.Finalization.Controlled with record
 438       HT : HT_Types.Hash_Table_Type;
 439    end record with Put_Image => Put_Image;
 440
 441    procedure Put_Image
 442      (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Map);
 443
 444    overriding procedure Adjust (Container : in out Map);
 445
 446    overriding procedure Finalize (Container : in out Map);
 447
 448    use HT_Types, HT_Types.Implementation;
 449    use Ada.Finalization;
 450    use Ada.Streams;
 451
 452    procedure Write
 453      (Stream    : not null access Root_Stream_Type'Class;
 454       Container : Map);
 455
 456    for Map'Write use Write;
 457
 458    procedure Read
 459      (Stream    : not null access Root_Stream_Type'Class;
 460       Container : out Map);
 461
 462    for Map'Read use Read;
 463
 464    type Map_Access is access all Map;
 465    for Map_Access'Storage_Size use 0;
 466
 467    type Cursor is record
 468       Container : Map_Access;
 469       --  Access to this cursor's container
 470
 471       Node      : Node_Access;
 472       --  Access to the node pointed to by this cursor
 473
 474       Position  : Hash_Type := Hash_Type'Last;
 475       --  Position of the node in the buckets of the container. If this is
 476       --  equal to Hash_Type'Last, then it will not be used. Position is
 477       --  not requried by the implementation, but improves the efficiency
 478       --  of various operations.
 479       --
 480       --  However, this value must be maintained so that the predefined
 481       --  equality operation acts as required by RM A.18.4-18/2, which
 482       --  states: "The predefined "=" operator for type Cursor returns True
 483       --  if both cursors are No_Element, or designate the same element
 484       --  in the same container."
 485    end record;
 486
 487    procedure Read
 488      (Stream : not null access Root_Stream_Type'Class;
 489       Item   : out Cursor);
 490
 491    for Cursor'Read use Read;
 492
 493    procedure Write
 494      (Stream : not null access Root_Stream_Type'Class;
 495       Item   : Cursor);
 496
 497    for Cursor'Write use Write;
 498
 499    subtype Reference_Control_Type is Implementation.Reference_Control_Type;
 500    --  It is necessary to rename this here, so that the compiler can find it
 501
 502    type Constant_Reference_Type
 503      (Element : not null access constant Element_Type) is
 504       record
 505          Control : Reference_Control_Type :=
 506            raise Program_Error with "uninitialized reference";
 507          --  The RM says, "The default initialization of an object of
 508          --  type Constant_Reference_Type or Reference_Type propagates
 509          --  Program_Error."
 510       end record;
 511
 512    procedure Write
 513      (Stream : not null access Root_Stream_Type'Class;
 514       Item   : Constant_Reference_Type);
 515
 516    for Constant_Reference_Type'Write use Write;
 517
 518    procedure Read
 519      (Stream : not null access Root_Stream_Type'Class;
 520       Item   : out Constant_Reference_Type);
 521
 522    for Constant_Reference_Type'Read use Read;
 523
 524    type Reference_Type
 525      (Element : not null access Element_Type) is
 526       record
 527          Control : Reference_Control_Type :=
 528            raise Program_Error with "uninitialized reference";
 529          --  The RM says, "The default initialization of an object of
 530          --  type Constant_Reference_Type or Reference_Type propagates
 531          --  Program_Error."
 532       end record;
 533
 534    procedure Write
 535      (Stream : not null access Root_Stream_Type'Class;
 536       Item   : Reference_Type);
 537
 538    for Reference_Type'Write use Write;
 539
 540    procedure Read
 541      (Stream : not null access Root_Stream_Type'Class;
 542       Item   : out Reference_Type);
 543
 544    for Reference_Type'Read use Read;
 545
 546    --  See Ada.Containers.Vectors for documentation on the following
 547
 548    procedure _Next (Position : in out Cursor) renames Next;
 549
 550    function Pseudo_Reference
 551      (Container : aliased Map'Class) return Reference_Control_Type;
 552    pragma Inline (Pseudo_Reference);
 553    --  Creates an object of type Reference_Control_Type pointing to the
 554    --  container, and increments the Lock. Finalization of this object will
 555    --  decrement the Lock.
 556
 557    type Element_Access is access all Element_Type with
 558      Storage_Size => 0;
 559
 560    function Get_Element_Access
 561      (Position : Cursor) return not null Element_Access;
 562    --  Returns a pointer to the element designated by Position.
 563
 564    Empty_Map : constant Map := (Controlled with others => <>);
 565
 566    No_Element : constant Cursor := (Container => null, Node => null,
 567                                     Position  => Hash_Type'Last);
 568
 569    type Iterator is new Limited_Controlled and
 570      Map_Iterator_Interfaces.Forward_Iterator with
 571    record
 572       Container : Map_Access;
 573    end record
 574      with Disable_Controlled => not T_Check;
 575
 576    overriding procedure Finalize (Object : in out Iterator);
 577
 578    overriding function First (Object : Iterator) return Cursor;
 579
 580    overriding function Next
 581      (Object   : Iterator;
 582       Position : Cursor) return Cursor;
 583
 584 end Ada.Containers.Hashed_Maps;