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
23with BC.Support.Dynamic;
24with BC.Support.Hash_Tables;
25with System.Storage_Pools;
26
27generic
28   with function Hash (V : Item) return Natural is <>;
29   Buckets : Positive;
30   Storage : in out System.Storage_Pools.Root_Storage_Pool'Class;
31   Initial_Size : Positive := 10;
32package BC.Containers.Bags.Dynamic is
33
34   pragma Preelaborate;
35
36   --  A bag denotes a collection of items, drawn from some
37   --  well-defined universe. A bag may contain duplicate items. A bag
38   --  actually owns only one copy of each unique item: duplicates are
39   --  counted, but are not stored with the bag.
40
41   --  The hash function (the generic parameter Hash) determines the
42   --  allocation of items to hash buckets. The value returned must
43   --  not change during the lifetime of a given Item. The range of
44   --  hash values need not be constrained to the number of buckets in
45   --  the bag.
46
47   --  The hash function must satisfy the condition that, for objects
48   --  A and B, if A = B, then Hash (A) must equal Hash (B). The hash
49   --  function should attempt to spread the set of possible items
50   --  uniformly across the number of buckets. The quality of the hash
51   --  function has a significant impact upon performance.
52
53   type Bag is new Abstract_Bag with private;
54
55   function Null_Container return Bag;
56
57   procedure Clear (B : in out Bag);
58   --  Empty the bag of all items.
59
60   procedure Add (B : in out Bag; I : Item; Added : out Boolean);
61   --  Add the item to the bag. If the item is not already a distinct
62   --  member of the bag, copy the item and add it to the bag and set
63   --  Added to True. If the item already exists, then increment the
64   --  number of that item and set Added to False.
65
66   procedure Remove (B : in out Bag; I : Item);
67   --  If the item is not a member of the bag, raise
68   --  BC.Not_Found. Otherwise, if there is exactly one of the item in
69   --  the bag, remove the item in the bag; if there is more than one
70   --  of the item in the bag, simply decrement its number.
71
72   function Extent (B : Bag) return Natural;
73   --  Return the number of distinct items in the bag.
74
75   function Count (B : Bag; I : Item) return Natural;
76   --  Return the number of times the item occurs in the bag.
77
78   function Is_Empty (B : Bag) return Boolean;
79   --  Return True if and only if there are no items in the bag.
80
81   function Is_Member (B : Bag; I : Item) return Boolean;
82   --  Return True if and only if the item exists in the bag.
83
84   procedure Preallocate (B : in out Bag; Size : Positive);
85   --  Allocates 'Size' additional storage elements for each bucket of
86   --  the Bag
87
88   procedure Set_Chunk_Size (B : in out Bag; Size : Positive);
89   --  Establishes the Size each bucket of the Bag will grow if the
90   --  Bag exhausts its current size.
91
92   function Chunk_Size (B : Bag) return Positive;
93   --  Returns the Chunk_Size.
94
95   function New_Iterator (For_The_Bag : Bag) return Iterator'Class;
96   --  Return a reset Iterator bound to the specific Bag.
97
98private
99
100   package IC is new BC.Support.Dynamic (Item => Item,
101                                         Item_Ptr => Item_Ptr,
102                                         Storage => Storage,
103                                         Initial_Size => Initial_Size);
104   package Items is new BC.Support.Hash_Tables.Item_Signature
105     (Item => Item,
106      Item_Ptr => Item_Ptr,
107      Eq => Containers."=",
108      Hash => Hash,
109      Item_Container => IC.Dyn_Node,
110      Clear => IC.Clear,
111      Insert => IC.Insert,
112      Append => IC.Append,
113      Remove => IC.Remove,
114      Replace => IC.Replace,
115      Length => IC.Length,
116      Item_At => IC.Item_At,
117      Access_Item_At => IC.Item_At,
118      Location => IC.Location);
119
120   type Positive_Ptr is access all Positive;
121   for Positive_Ptr'Storage_Size use 0;
122   package VC is new BC.Support.Dynamic (Item => Positive,
123                                         Item_Ptr => Positive_Ptr,
124                                         Storage => Storage,
125                                         Initial_Size => Initial_Size);
126   package Values is new BC.Support.Hash_Tables.Value_Signature
127     (Value => Positive,
128      Value_Ptr => Positive_Ptr,
129      Eq => Standard."=",
130      Value_Container => VC.Dyn_Node,
131      Clear => VC.Clear,
132      Insert => VC.Insert,
133      Append => VC.Append,
134      Remove => VC.Remove,
135      Replace => VC.Replace,
136      Length => VC.Length,
137      Item_At => VC.Item_At,
138      Access_Item_At => VC.Item_At,
139      Location => VC.Location);
140
141   package Tables is new BC.Support.Hash_Tables.Tables
142     (Items => Items,
143      Values => Values);
144
145   type Bag is new Abstract_Bag with record
146      Rep : Tables.Table (Number_Of_Buckets => Buckets);
147   end record;
148
149   procedure Attach (B : in out Bag; I : Item; C : Positive);
150
151   procedure Detach (B : in out Bag; I : Item);
152
153   procedure Set_Value (B : in out Bag; I : Item; C : Positive);
154
155   --  Iterators
156
157   type Dynamic_Bag_Iterator is new Bag_Iterator with null record;
158
159   procedure Reset (It : in out Dynamic_Bag_Iterator);
160
161   procedure Next (It : in out Dynamic_Bag_Iterator);
162
163   function Is_Done (It : Dynamic_Bag_Iterator) return Boolean;
164
165   function Current_Item (It : Dynamic_Bag_Iterator) return Item;
166
167   function Current_Item_Ptr (It : Dynamic_Bag_Iterator) return Item_Ptr;
168
169   procedure Delete_Item_At (It : in out Dynamic_Bag_Iterator);
170
171end BC.Containers.Bags.Dynamic;
172