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