2014-10-31 Hristian Kirtchev <kirtchev@adacore.com>
[official-gcc.git] / gcc / ada / a-cfhase.ads
blob670d720d5d793a54cb05a76beba0ee72597b9c55
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-2014, 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 ------------------------------------------------------------------------------
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.
38 -- The modifications are:
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.
48 -- There are three new functions:
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;
56 -- See detailed specifications for these subprograms
58 private with Ada.Containers.Hash_Tables;
60 generic
61 type Element_Type is private;
63 with function Hash (Element : Element_Type) return Hash_Type;
65 with function Equivalent_Elements (Left, Right : Element_Type)
66 return Boolean;
68 with function "=" (Left, Right : Element_Type) return Boolean is <>;
70 package Ada.Containers.Formal_Hashed_Sets is
71 pragma Annotate (GNATprove, External_Axiomatization);
72 pragma Pure;
73 pragma SPARK_Mode (On);
75 type Set (Capacity : Count_Type; Modulus : Hash_Type) is private with
76 Iterable => (First => First,
77 Next => Next,
78 Has_Element => Has_Element,
79 Element => Element),
80 Default_Initial_Condition;
81 pragma Preelaborable_Initialization (Set);
83 type Cursor is private;
84 pragma Preelaborable_Initialization (Cursor);
86 Empty_Set : constant Set;
88 No_Element : constant Cursor;
90 function "=" (Left, Right : Set) return Boolean with
91 Global => null;
93 function Equivalent_Sets (Left, Right : Set) return Boolean with
94 Global => null;
96 function To_Set (New_Item : Element_Type) return Set with
97 Global => null;
99 function Capacity (Container : Set) return Count_Type with
100 Global => null;
102 procedure Reserve_Capacity
103 (Container : in out Set;
104 Capacity : Count_Type)
105 with
106 Global => null,
107 Pre => Capacity <= Container.Capacity;
109 function Length (Container : Set) return Count_Type with
110 Global => null;
112 function Is_Empty (Container : Set) return Boolean with
113 Global => null;
115 procedure Clear (Container : in out Set) with
116 Global => null;
118 procedure Assign (Target : in out Set; Source : Set) with
119 Global => null,
120 Pre => Target.Capacity >= Length (Source);
122 function Copy
123 (Source : Set;
124 Capacity : Count_Type := 0) return Set
125 with
126 Global => null,
127 Pre => Capacity = 0 or else Capacity >= Source.Capacity;
129 function Element
130 (Container : Set;
131 Position : Cursor) return Element_Type
132 with
133 Global => null,
134 Pre => Has_Element (Container, Position);
136 procedure Replace_Element
137 (Container : in out Set;
138 Position : Cursor;
139 New_Item : Element_Type)
140 with
141 Global => null,
142 Pre => Has_Element (Container, Position);
144 procedure Move (Target : in out Set; Source : in out Set) with
145 Global => null,
146 Pre => Target.Capacity >= Length (Source);
148 procedure Insert
149 (Container : in out Set;
150 New_Item : Element_Type;
151 Position : out Cursor;
152 Inserted : out Boolean)
153 with
154 Global => null,
155 Pre => Length (Container) < Container.Capacity;
157 procedure Insert (Container : in out Set; New_Item : Element_Type) with
158 Global => null,
159 Pre => Length (Container) < Container.Capacity
160 and then (not Contains (Container, New_Item));
162 procedure Include (Container : in out Set; New_Item : Element_Type) with
163 Global => null,
164 Pre => Length (Container) < Container.Capacity;
166 procedure Replace (Container : in out Set; New_Item : Element_Type) with
167 Global => null,
168 Pre => Contains (Container, New_Item);
170 procedure Exclude (Container : in out Set; Item : Element_Type) with
171 Global => null;
173 procedure Delete (Container : in out Set; Item : Element_Type) with
174 Global => null,
175 Pre => Contains (Container, Item);
177 procedure Delete (Container : in out Set; Position : in out Cursor) with
178 Global => null,
179 Pre => Has_Element (Container, Position);
181 procedure Union (Target : in out Set; Source : Set) with
182 Global => null,
183 Pre => Length (Target) + Length (Source) -
184 Length (Intersection (Target, Source)) <= Target.Capacity;
186 function Union (Left, Right : Set) return Set with
187 Global => null,
188 Pre => Length (Left) + Length (Right) -
189 Length (Intersection (Left, Right)) <= Count_Type'Last;
191 function "or" (Left, Right : Set) return Set renames Union;
193 procedure Intersection (Target : in out Set; Source : Set) with
194 Global => null;
196 function Intersection (Left, Right : Set) return Set with
197 Global => null;
199 function "and" (Left, Right : Set) return Set renames Intersection;
201 procedure Difference (Target : in out Set; Source : Set) with
202 Global => null;
204 function Difference (Left, Right : Set) return Set with
205 Global => null;
207 function "-" (Left, Right : Set) return Set renames Difference;
209 procedure Symmetric_Difference (Target : in out Set; Source : Set) with
210 Global => null,
211 Pre => Length (Target) + Length (Source) -
212 2 * Length (Intersection (Target, Source)) <= Target.Capacity;
214 function Symmetric_Difference (Left, Right : Set) return Set with
215 Global => null,
216 Pre => Length (Left) + Length (Right) -
217 2 * Length (Intersection (Left, Right)) <= Count_Type'Last;
219 function "xor" (Left, Right : Set) return Set
220 renames Symmetric_Difference;
222 function Overlap (Left, Right : Set) return Boolean with
223 Global => null;
225 function Is_Subset (Subset : Set; Of_Set : Set) return Boolean with
226 Global => null;
228 function First (Container : Set) return Cursor with
229 Global => null;
231 function Next (Container : Set; Position : Cursor) return Cursor with
232 Global => null,
233 Pre => Has_Element (Container, Position) or else Position = No_Element;
235 procedure Next (Container : Set; Position : in out Cursor) with
236 Global => null,
237 Pre => Has_Element (Container, Position) or else Position = No_Element;
239 function Find
240 (Container : Set;
241 Item : Element_Type) return Cursor
242 with
243 Global => null;
245 function Contains (Container : Set; Item : Element_Type) return Boolean with
246 Global => null;
248 function Has_Element (Container : Set; Position : Cursor) return Boolean
249 with
250 Global => null;
252 function Equivalent_Elements (Left : Set; CLeft : Cursor;
253 Right : Set; CRight : Cursor) return Boolean
254 with
255 Global => null;
257 function Equivalent_Elements
258 (Left : Set; CLeft : Cursor;
259 Right : Element_Type) return Boolean
260 with
261 Global => null;
263 function Equivalent_Elements
264 (Left : Element_Type;
265 Right : Set; CRight : Cursor) return Boolean
266 with
267 Global => null;
269 function Default_Modulus (Capacity : Count_Type) return Hash_Type with
270 Global => null;
272 generic
273 type Key_Type (<>) is private;
275 with function Key (Element : Element_Type) return Key_Type;
277 with function Hash (Key : Key_Type) return Hash_Type;
279 with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
281 package Generic_Keys is
283 function Key (Container : Set; Position : Cursor) return Key_Type with
284 Global => null;
286 function Element (Container : Set; Key : Key_Type) return Element_Type
287 with
288 Global => null;
290 procedure Replace
291 (Container : in out Set;
292 Key : Key_Type;
293 New_Item : Element_Type)
294 with
295 Global => null;
297 procedure Exclude (Container : in out Set; Key : Key_Type) with
298 Global => null;
300 procedure Delete (Container : in out Set; Key : Key_Type) with
301 Global => null;
303 function Find (Container : Set; Key : Key_Type) return Cursor with
304 Global => null;
306 function Contains (Container : Set; Key : Key_Type) return Boolean with
307 Global => null;
309 end Generic_Keys;
311 function Strict_Equal (Left, Right : Set) return Boolean with
312 Global => null;
313 -- Strict_Equal returns True if the containers are physically equal, i.e.
314 -- they are structurally equal (function "=" returns True) and that they
315 -- have the same set of cursors.
317 function First_To_Previous (Container : Set; Current : Cursor) return Set
318 with
319 Global => null,
320 Pre => Has_Element (Container, Current) or else Current = No_Element;
321 function Current_To_Last (Container : Set; Current : Cursor) return Set
322 with
323 Global => null,
324 Pre => Has_Element (Container, Current) or else Current = No_Element;
325 -- First_To_Previous returns a container containing all elements preceding
326 -- Current (excluded) in Container. Current_To_Last returns a container
327 -- containing all elements following Current (included) in Container.
328 -- These two new functions can be used to express invariant properties in
329 -- loops which iterate over containers. First_To_Previous returns the part
330 -- of the container already scanned and Current_To_Last the part not
331 -- scanned yet.
333 private
334 pragma Inline (Next);
335 pragma SPARK_Mode (Off);
337 type Node_Type is
338 record
339 Element : Element_Type;
340 Next : Count_Type;
341 Has_Element : Boolean := False;
342 end record;
344 package HT_Types is new
345 Ada.Containers.Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type);
347 type Set (Capacity : Count_Type; Modulus : Hash_Type) is
348 new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
350 use HT_Types;
352 type Cursor is record
353 Node : Count_Type;
354 end record;
356 No_Element : constant Cursor := (Node => 0);
358 Empty_Set : constant Set := (Capacity => 0, Modulus => 0, others => <>);
360 end Ada.Containers.Formal_Hashed_Sets;