stephes_ada_library_3.7.3_08b48307/source/sal-gen_unbounded_definite_hash_tables.ads

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
--  Abstract:
--
--  Generic Hash Table, using red-black trees for collisions.
--
--  Design
--
--  We assume computing Key from Element is free (for example, Element
--  is (Key, Index to actual store)), and computing Hash from Key is
--  cheap. Hashes are recomputed for all elements when the table is
--  grown.
--
--  References
--
--  [1] Prime numbers http://compoasso.free.fr/primelistweb/page/prime/liste_online_en.php
--
--  Notice
--
--  Copyright (C) 2020 - 2021 Free Software Foundation, Inc. All Rights Reserved.
--
--  This library is free software;  you can redistribute it and/or modify it
--  under terms of the  GNU General Public License  as published by the Free
--  Software  Foundation;  either version 3,  or (at your  option) any later
--  version. This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.

--  As a special exception under Section 7 of GPL version 3, you are granted
--  additional permissions described in the GCC Runtime Library Exception,
--  version 3.1, as published by the Free Software Foundation.

pragma License (Modified_GPL);

with Ada.Containers;
with Ada.Iterator_Interfaces;
private with SAL.Gen_Unbounded_Definite_Red_Black_Trees;
private with SAL.Gen_Unbounded_Definite_Vectors;
generic
   type Element_Type is private;
   type Key_Type (<>) is private;
   with function Key (Element : in Element_Type) return Key_Type is <>;
   with function Key_Compare (Left, Right : in Key_Type) return Compare_Result;

   with function Hash (Element : Element_Type; Rows : Positive) return Positive;
   --  WORKAROUND: GNAT community 2019 doesn't allow 'with post' here
   --  with Release compilation switches. Fixed in GNAT community 2021.
   --  with Post => Hash'Result in 1 .. Rows;
   --
   --  Takes Element, not Key, to allow storing Hash in Element so it is
   --  only computed once.
   --
   --  1 + (Some_hash (Key) mod Rows) works.

   Default_Init_Rows : Positive := 113;

package SAL.Gen_Unbounded_Definite_Hash_Tables is

   package Pkg renames Gen_Unbounded_Definite_Hash_Tables;

   Default_Rows : constant Positive := Pkg.Default_Init_Rows;

   type Hash_Table is tagged private
   with
     Constant_Indexing => Constant_Ref,
     Default_Iterator  => Iterate,
     Iterator_Element  => Element_Type;

   procedure Set_Rows
     (Table : in out Hash_Table;
      Rows  : in     Positive);
   --  Set the hash table size. If Table is not empty, all hashes are
   --  recomputed; this renders any Constant_Refs invalid.

   function Rows (Table : in Hash_Table) return Positive;

   procedure Clear (Table : in out Hash_Table);
   --  Set Table to empty.

   procedure Insert
     (Table     : in out Hash_Table;
      Element   : in     Element_Type;
      Duplicate : in     Ignore_Error_Type);
   --  If Key (Element) is already in Table: if Duplicate is Ignore, does
   --  nothing; otherwise, raises Duplicate_Key.

   type Constant_Reference_Type is access constant Element_Type;
   --  The name lies; this is not a "reference type" as defined by Ada.
   --  But gnat pro 22.0w 20201222 does not support using a real
   --  reference type here. See AdaCore ticket U117-010 (on the
   --  Eurocontrol contract).

   type Variable_Reference_Type is access all Element_Type;
   --  Similarly, this is not a "reference type"; therefore we cannot
   --  implement aspect Variable_Indexing.

   function Find_Or_Insert
     (Table   : in out Hash_Table;
      Element : in     Element_Type;
      Found   :    out Boolean)
     return Constant_Reference_Type;

   function Find_Or_Insert_Var
     (Table   : in out Hash_Table;
      Element : in     Element_Type;
      Found   :    out Boolean)
     return Variable_Reference_Type;
   --  User must not change Key or Hash via this reference.

   type Cursor is private;

   No_Element : constant Cursor;

   function Has_Element (Cursor : in Pkg.Cursor) return Boolean;

   function Constant_Ref
     (Table    : aliased in Hash_Table;
      Position :         in Cursor)
     return Constant_Reference_Type
   with Inline, Pre => Has_Element (Position);

   function Variable_Ref
     (Table    : aliased in Hash_Table;
      Position :         in Cursor)
     return Variable_Reference_Type
   with Inline, Pre => Has_Element (Position);

   function Find
     (Table   : aliased in Hash_Table;
      Element :         in Element_Type)
     return Cursor;
   --  Result is No_Element if Key is not in Table.
   --
   --  Takes Element instead of Key to allow storing Hash in Element.

   package Iterators is new Ada.Iterator_Interfaces (Cursor, Has_Element);

   type Iterator (<>) is new Iterators.Forward_Iterator with private;

   function Iterate (Table : aliased in Pkg.Hash_Table'Class) return Iterator;

   overriding function First (Iterator : in Pkg.Iterator) return Cursor;
   overriding function Next (Iterator : in Pkg.Iterator; Position : in Cursor) return Cursor
   with Pre => Has_Element (Position);

   procedure Sizes
     (Table             : in     Hash_Table;
      Elements          :    out Ada.Containers.Count_Type;
      Rows              :    out Integer;
      Max_Row_Depth     :    out Ada.Containers.Count_Type;
      Average_Row_Depth :    out Ada.Containers.Count_Type;
      Empty_Rows        :    out Integer);

private

   package Element_Trees is new SAL.Gen_Unbounded_Definite_Red_Black_Trees
     (Element_Type, Key_Type, Key, Key_Compare);
   --  Holds elements for a row

   package Hash_Arrays is new SAL.Gen_Unbounded_Definite_Vectors
     (Natural, Element_Trees.Tree, Element_Trees.Empty_Tree);

   type Hash_Table is tagged record
      --  Directly deriving Hash_Table from Hash_Arrays.Vector would mean we
      --  have to implement Iterate.
      Table : Hash_Arrays.Vector;
   end record;

   function Rows (Table : in Hash_Table) return Positive
   is (if Table.Table.Last_Index = Hash_Arrays.No_Index then Default_Init_Rows else Table.Table.Last_Index);

   type Cursor is record
      Row : Integer              := Hash_Arrays.No_Index; --  index into Table.Table.
      Cur : Element_Trees.Cursor := Element_Trees.No_Element;
   end record;

   No_Element : constant Cursor := (others => <>);

   type Iterator (Table : not null access constant Hash_Table) is new Iterators.Forward_Iterator
     with null record;

end SAL.Gen_Unbounded_Definite_Hash_Tables;