1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT LIBRARY COMPONENTS                          --
4--                                                                          --
5--    A D A . C O N T A I N E R S . F O R M A L _ H A S H E D _ S E T S     --
6--                                                                          --
7--                                 S p e c                                  --
8--                                                                          --
9--          Copyright (C) 2004-2013, 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
32--  This spec is derived from package Ada.Containers.Bounded_Hashed_Sets in the
33--  Ada 2012 RM. The modifications are meant to facilitate formal proofs by
34--  making it easier to express properties, and by making the specification of
35--  this unit compatible with SPARK 2014. Note that the API of this unit may be
36--  subject to incompatible changes as SPARK 2014 evolves.
37
38--  The modifications are:
39
40--    A parameter for the container is added to every function reading the
41--    content of a container: Element, Next, Query_Element, Has_Element, Key,
42--    Iterate, Equivalent_Elements. This change is motivated by the need to
43--    have cursors which are valid on different containers (typically a
44--    container C and its previous version C'Old) for expressing properties,
45--    which is not possible if cursors encapsulate an access to the underlying
46--    container.
47
48--    There are three new functions:
49
50--      function Strict_Equal (Left, Right : Set) return Boolean;
51--      function First_To_Previous  (Container : Set; Current : Cursor)
52--         return Set;
53--      function Current_To_Last (Container : Set; Current : Cursor)
54--         return Set;
55
56--    See detailed specifications for these subprograms
57
58private with Ada.Containers.Hash_Tables;
59
60generic
61   type Element_Type is private;
62
63   with function Hash (Element : Element_Type) return Hash_Type;
64
65   with function Equivalent_Elements (Left, Right : Element_Type)
66                                      return Boolean;
67
68   with function "=" (Left, Right : Element_Type) return Boolean is <>;
69
70package Ada.Containers.Formal_Hashed_Sets is
71   pragma Annotate (GNATprove, External_Axiomatization);
72   pragma Pure;
73
74   type Set (Capacity : Count_Type; Modulus : Hash_Type) is private with
75     Iterable => (First       => First,
76                  Next        => Next,
77                  Has_Element => Has_Element,
78                  Element     => Element);
79   pragma Preelaborable_Initialization (Set);
80
81   type Cursor is private;
82   pragma Preelaborable_Initialization (Cursor);
83
84   Empty_Set : constant Set;
85
86   No_Element : constant Cursor;
87
88   function "=" (Left, Right : Set) return Boolean with
89     Global => null;
90
91   function Equivalent_Sets (Left, Right : Set) return Boolean with
92     Global => null;
93
94   function To_Set (New_Item : Element_Type) return Set with
95     Global => null;
96
97   function Capacity (Container : Set) return Count_Type with
98     Global => null;
99
100   procedure Reserve_Capacity
101     (Container : in out Set;
102      Capacity  : Count_Type)
103   with
104     Global => null,
105     Pre    => Capacity <= Container.Capacity;
106
107   function Length (Container : Set) return Count_Type with
108     Global => null;
109
110   function Is_Empty (Container : Set) return Boolean with
111     Global => null;
112
113   procedure Clear (Container : in out Set) with
114     Global => null;
115
116   procedure Assign (Target : in out Set; Source : Set) with
117     Global => null,
118     Pre    => Target.Capacity >= Length (Source);
119
120   function Copy
121     (Source   : Set;
122      Capacity : Count_Type := 0) return Set
123   with
124     Global => null,
125     Pre    => Capacity = 0 or else Capacity >= Source.Capacity;
126
127   function Element
128     (Container : Set;
129      Position  : Cursor) return Element_Type
130   with
131     Global => null,
132     Pre    => Has_Element (Container, Position);
133
134   procedure Replace_Element
135     (Container : in out Set;
136      Position  : Cursor;
137      New_Item  : Element_Type)
138   with
139     Global => null,
140     Pre    => Has_Element (Container, Position);
141
142   procedure Move (Target : in out Set; Source : in out Set) with
143     Global => null,
144     Pre    => Target.Capacity >= Length (Source);
145
146   procedure Insert
147     (Container : in out Set;
148      New_Item  : Element_Type;
149      Position  : out Cursor;
150      Inserted  : out Boolean)
151   with
152     Global => null,
153     Pre    => Length (Container) < Container.Capacity;
154
155   procedure Insert  (Container : in out Set; New_Item : Element_Type) with
156     Global => null,
157     Pre    => Length (Container) < Container.Capacity
158                 and then (not Contains (Container, New_Item));
159
160   procedure Include (Container : in out Set; New_Item : Element_Type) with
161     Global => null,
162     Pre    => Length (Container) < Container.Capacity;
163
164   procedure Replace (Container : in out Set; New_Item : Element_Type) with
165     Global => null,
166     Pre    => Contains (Container, New_Item);
167
168   procedure Exclude (Container : in out Set; Item     : Element_Type) with
169     Global => null;
170
171   procedure Delete  (Container : in out Set; Item     : Element_Type) with
172     Global => null,
173     Pre    => Contains (Container, Item);
174
175   procedure Delete (Container : in out Set; Position  : in out Cursor) with
176     Global => null,
177     Pre    => Has_Element (Container, Position);
178
179   procedure Union (Target : in out Set; Source : Set) with
180     Global => null,
181     Pre    => Length (Target) + Length (Source) -
182                 Length (Intersection (Target, Source)) <= Target.Capacity;
183
184   function Union (Left, Right : Set) return Set with
185     Global => null,
186     Pre    => Length (Left) + Length (Right) -
187                 Length (Intersection (Left, Right)) <= Count_Type'Last;
188
189   function "or" (Left, Right : Set) return Set renames Union;
190
191   procedure Intersection (Target : in out Set; Source : Set) with
192     Global => null;
193
194   function Intersection (Left, Right : Set) return Set with
195     Global => null;
196
197   function "and" (Left, Right : Set) return Set renames Intersection;
198
199   procedure Difference (Target : in out Set; Source : Set) with
200     Global => null;
201
202   function Difference (Left, Right : Set) return Set with
203     Global => null;
204
205   function "-" (Left, Right : Set) return Set renames Difference;
206
207   procedure Symmetric_Difference (Target : in out Set; Source : Set) with
208     Global => null,
209     Pre    => Length (Target) + Length (Source) -
210                 2 * Length (Intersection (Target, Source)) <= Target.Capacity;
211
212   function Symmetric_Difference (Left, Right : Set) return Set with
213     Global => null,
214     Pre    => Length (Left) + Length (Right) -
215                 2 * Length (Intersection (Left, Right)) <= Count_Type'Last;
216
217   function "xor" (Left, Right : Set) return Set
218     renames Symmetric_Difference;
219
220   function Overlap (Left, Right : Set) return Boolean with
221     Global => null;
222
223   function Is_Subset (Subset : Set; Of_Set : Set) return Boolean with
224     Global => null;
225
226   function First (Container : Set) return Cursor with
227     Global => null;
228
229   function Next (Container : Set; Position : Cursor) return Cursor with
230     Global => null,
231     Pre    => Has_Element (Container, Position) or else Position = No_Element;
232
233   procedure Next (Container : Set; Position : in out Cursor) with
234     Global => null,
235     Pre    => Has_Element (Container, Position) or else Position = No_Element;
236
237   function Find
238     (Container : Set;
239      Item      : Element_Type) return Cursor
240   with
241     Global => null;
242
243   function Contains (Container : Set; Item : Element_Type) return Boolean with
244     Global => null;
245
246   function Has_Element (Container : Set; Position : Cursor) return Boolean
247   with
248     Global => null;
249
250   function Equivalent_Elements (Left  : Set; CLeft : Cursor;
251                                 Right : Set; CRight : Cursor) return Boolean
252   with
253     Global => null;
254
255   function Equivalent_Elements
256     (Left  : Set; CLeft : Cursor;
257      Right : Element_Type) return Boolean
258   with
259     Global => null;
260
261   function Equivalent_Elements
262     (Left  : Element_Type;
263      Right : Set; CRight : Cursor) return Boolean
264   with
265     Global => null;
266
267   function Default_Modulus (Capacity : Count_Type) return Hash_Type with
268     Global => null;
269
270   generic
271      type Key_Type (<>) is private;
272
273      with function Key (Element : Element_Type) return Key_Type;
274
275      with function Hash (Key : Key_Type) return Hash_Type;
276
277      with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
278
279   package Generic_Keys is
280
281      function Key (Container : Set; Position : Cursor) return Key_Type with
282        Global => null;
283
284      function Element (Container : Set; Key : Key_Type) return Element_Type
285      with
286          Global => null;
287
288      procedure Replace
289        (Container : in out Set;
290         Key       : Key_Type;
291         New_Item  : Element_Type)
292      with
293          Global => null;
294
295      procedure Exclude (Container : in out Set; Key : Key_Type) with
296        Global => null;
297
298      procedure Delete (Container : in out Set; Key : Key_Type) with
299        Global => null;
300
301      function Find (Container : Set; Key : Key_Type) return Cursor with
302        Global => null;
303
304      function Contains (Container : Set; Key : Key_Type) return Boolean with
305        Global => null;
306
307   end Generic_Keys;
308
309   function Strict_Equal (Left, Right : Set) return Boolean with
310     Global => null;
311   --  Strict_Equal returns True if the containers are physically equal, i.e.
312   --  they are structurally equal (function "=" returns True) and that they
313   --  have the same set of cursors.
314
315   function First_To_Previous  (Container : Set; Current : Cursor) return Set
316   with
317     Global => null,
318     Pre    => Has_Element (Container, Current) or else Current = No_Element;
319   function Current_To_Last (Container : Set; Current : Cursor) return Set
320   with
321     Global => null,
322     Pre    => Has_Element (Container, Current) or else Current = No_Element;
323   --  First_To_Previous returns a container containing all elements preceding
324   --  Current (excluded) in Container. Current_To_Last returns a container
325   --  containing all elements following Current (included) in Container.
326   --  These two new functions can be used to express invariant properties in
327   --  loops which iterate over containers. First_To_Previous returns the part
328   --  of the container already scanned and Current_To_Last the part not
329   --  scanned yet.
330
331private
332
333   pragma Inline (Next);
334
335   type Node_Type is
336      record
337         Element     : Element_Type;
338         Next        : Count_Type;
339         Has_Element : Boolean := False;
340      end record;
341
342   package HT_Types is new
343     Ada.Containers.Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type);
344
345   type Set (Capacity : Count_Type; Modulus : Hash_Type) is
346      new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
347
348   use HT_Types;
349
350   type Cursor is record
351      Node : Count_Type;
352   end record;
353
354   No_Element : constant Cursor := (Node => 0);
355
356   Empty_Set : constant Set := (Capacity => 0, Modulus => 0, others => <>);
357
358end Ada.Containers.Formal_Hashed_Sets;
359