1--  Copyright 1994 Grady Booch
2--  Copyright 1998-2014 Simon Wright <simon@pushface.org>
3
4--  This package is free software; you can redistribute it and/or
5--  modify it under terms of the GNU General Public License as
6--  published by the Free Software Foundation; either version 2, or
7--  (at your option) any later version. This package is distributed in
8--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
9--  even the implied warranty of MERCHANTABILITY or FITNESS FOR A
10--  PARTICULAR PURPOSE. See the GNU General Public License for more
11--  details. You should have received a copy of the GNU General Public
12--  License distributed with this package; see file COPYING.  If not,
13--  write to the Free Software Foundation, 59 Temple Place - Suite
14--  330, Boston, MA 02111-1307, USA.
15
16--  As a special exception, if other files instantiate generics from
17--  this unit, or you link this unit with other files to produce an
18--  executable, this unit does not by itself cause the resulting
19--  executable to be covered by the GNU General Public License.  This
20--  exception does not however invalidate any other reasons why the
21--  executable file might be covered by the GNU Public License.
22
23package BC.Support.Hash_Tables is
24
25   pragma Preelaborate;
26
27
28   --  In the generic signature packages, Item denotes the universe
29   --  from which the hash table draws its items. Value denotes the
30   --  universe from which the hash table draws its values. Items and
31   --  Values may be either primitive types or user-defined
32   --  non-limited types.
33
34   --  The function Eq is used for equality instead of the more normal
35   --  "=" because (in Bounded_Hash_Tables) ObjectAda 7.2 and 7.2.1
36   --  get confused otherwise.
37
38   --  Item_Container and Value_Container provide the concrete
39   --  container for each bucket. These types will normally be
40   --  provided by instantiations of the bounded, dynamic, and
41   --  unbounded support packages defined for this library.
42
43
44   generic
45
46      type Item is private;
47      type Item_Ptr is access Item;
48      with function Eq (L, R : Item) return Boolean;
49      with function Hash (V : Item) return Natural;
50
51      type Item_Container is private;
52
53      --  The subprograms for Items are provided by one of
54      --  BC.Support.Bounded, Dynamic or Unbounded as appropriate.
55
56      with procedure Clear (C : in out Item_Container);
57      with procedure Insert (C : in out Item_Container; I : Item);
58      with procedure Append (C : in out Item_Container; I : Item);
59      with procedure Remove (C : in out Item_Container; From : Positive);
60      with procedure Replace
61        (C : in out Item_Container; Index : Positive; I : Item);
62      with function Length (C : Item_Container) return Natural;
63      with function Item_At
64        (C : Item_Container; Index : Positive) return Item;
65      with function Access_Item_At
66        (C : Item_Container; Index : Positive) return Item_Ptr;
67      with function Location
68        (C : Item_Container; I : Item; Start : Positive) return Natural;
69
70   package Item_Signature is end Item_Signature;
71
72
73   generic
74
75      type Value is private;
76      type Value_Ptr is access Value;
77      with function Eq (L, R : Value) return Boolean;
78
79      type Value_Container is private;
80
81      --  The subprograms for Values are provided by one of
82      --  BC.Support.Bounded, Dynamic or Unbounded as appropriate.
83
84      with procedure Clear (C : in out Value_Container);
85      with procedure Insert (C : in out Value_Container; V : Value);
86      with procedure Append (C : in out Value_Container; V : Value);
87      with procedure Remove
88        (C : in out Value_Container; From : Positive);
89      with procedure Replace
90        (C : in out Value_Container; Index : Positive; V : Value);
91      with function Length (C : Value_Container) return Natural;
92      with function Item_At
93        (C : Value_Container; Index : Positive) return Value;
94      with function Access_Item_At
95        (C : Value_Container; Index : Positive) return Value_Ptr;
96      with function Location
97        (C : Value_Container;
98         V : Value;
99         Start : Positive) return Natural;
100
101   package Value_Signature is end Value_Signature;
102
103
104   generic
105
106      with package Items is new Item_Signature (<>);
107      with package Values is new Value_Signature (<>);
108
109   package Tables is
110
111      --  The type Table represents an open hash table whose buckets
112      --  may be formed by bounded, dynamic, or unbounded
113      --  containers. Each table contains n buckets, wherein each
114      --  bucket is a container of item/value pairs. To insert,
115      --  remove, or locate a pair in the table, the operation first
116      --  generates a hash value upon the item to select a specific
117      --  bucket, and then the given operation is performed upon the
118      --  selected container.
119
120      --  This is a low-level abstraction that specifies no policies
121      --  for the order in which items may be added and removed from
122      --  the container. This class is not intended to be subclassed.
123
124      type Item_Array is array (Positive range <>) of Items.Item_Container;
125      type Value_Array is array (Positive range <>) of Values.Value_Container;
126
127      type Table (Number_Of_Buckets : Positive) is record
128         Items : Item_Array (1 .. Number_Of_Buckets);
129         Values : Value_Array (1 .. Number_Of_Buckets);
130         Size : Natural := 0;
131      end record;
132
133      function "=" (L, R : Table) return Boolean;
134
135      procedure Clear (T : in out Table);
136      --  Empty the hash table of all item/value pairs.
137
138      procedure Bind (T : in out Table; I : Items.Item; V : Values.Value);
139      --  Generate a hash value for the item to select a bucket. If
140      --  the item already exists in that bucket, raise BC.Duplicate;
141      --  otherwise, insert the Item/value pair in the selected
142      --  container.
143
144      procedure Rebind (T : in out Table; I : Items.Item; V : Values.Value);
145      --  Generate a hash value for the item to select a bucket. If
146      --  the item already exists in that bucket, change the item's
147      --  corresponding value; otherwise, raise BC.Not_Found.
148
149      procedure Unbind (T : in out Table; I : Items.Item);
150      --  Generate a hash value for the item to select a bucket. If
151      --  the item already exists in that bucket, remove the
152      --  item/value pair; otherwise, BC.Not_Found.
153
154      function Extent (T : Table) return Natural;
155      --  Return the number of item/value pairs in the hash table.
156
157      function Is_Bound (T : Table; I : Items.Item) return Boolean;
158      --  Return True if the item has a binding in the hash table;
159      --  otherwise, return False.
160
161      function Value_Of (T : Table; I : Items.Item) return Values.Value;
162      --  If the item does not have a binding in the hash table, raise
163      --  BC.Not_Found; otherwise, return the value corresponding to
164      --  this item.
165
166      --  Iterator support
167
168      procedure Reset (T : Table;
169                       Bucket : out Positive;
170                       Index : out Positive);
171
172      function Is_Done (T : Table;
173                        Bucket : Positive;
174                        Index : Positive) return Boolean;
175
176      function Current_Item_Ptr (T : Table;
177                                 Bucket : Positive;
178                                 Index : Positive) return Items.Item_Ptr;
179
180      function Current_Value_Ptr (T : Table;
181                                  Bucket : Positive;
182                                  Index : Positive) return Values.Value_Ptr;
183
184      procedure Delete_Item_At (T : in out Table;
185                                Bucket : in out Positive;
186                                Index : in out  Positive);
187
188      procedure Next (T : Table;
189                      Bucket : in out Positive;
190                      Index : in out  Positive);
191
192   end Tables;
193
194end BC.Support.Hash_Tables;
195