OSDN Git Service

PR ada/53766
[pf3gnuchains/gcc-fork.git] / gcc / ada / a-cfhase.ads
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-2011, 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 to facilitate formal proofs by making it
34 --  easier to express properties.
35
36 --  The modifications are:
37
38 --    A parameter for the container is added to every function reading the
39 --    content of a container: Element, Next, Query_Element, Has_Element, Key,
40 --    Iterate, Equivalent_Elements. This change is motivated by the need to
41 --    have cursors which are valid on different containers (typically a
42 --    container C and its previous version C'Old) for expressing properties,
43 --    which is not possible if cursors encapsulate an access to the underlying
44 --    container.
45
46 --    There are three new functions:
47
48 --      function Strict_Equal (Left, Right : Set) return Boolean;
49 --      function Left  (Container : Set; Position : Cursor) return Set;
50 --      function Right (Container : Set; Position : Cursor) return Set;
51
52 --    See detailed specifications for these subprograms
53
54 private with Ada.Containers.Hash_Tables;
55 private with Ada.Streams;
56
57 generic
58    type Element_Type is private;
59
60    with function Hash (Element : Element_Type) return Hash_Type;
61
62    with function Equivalent_Elements (Left, Right : Element_Type)
63                                       return Boolean;
64
65    with function "=" (Left, Right : Element_Type) return Boolean is <>;
66
67 package Ada.Containers.Formal_Hashed_Sets is
68    pragma Pure;
69
70    type Set (Capacity : Count_Type; Modulus : Hash_Type) is tagged private;
71    --  why is this commented out ???
72    --  pragma Preelaborable_Initialization (Set);
73
74    type Cursor is private;
75    pragma Preelaborable_Initialization (Cursor);
76
77    Empty_Set : constant Set;
78
79    No_Element : constant Cursor;
80
81    function "=" (Left, Right : Set) return Boolean;
82
83    function Equivalent_Sets (Left, Right : Set) return Boolean;
84
85    function To_Set (New_Item : Element_Type) return Set;
86
87    function Capacity (Container : Set) return Count_Type;
88
89    procedure Reserve_Capacity
90      (Container : in out Set;
91       Capacity  : Count_Type);
92
93    function Length (Container : Set) return Count_Type;
94
95    function Is_Empty (Container : Set) return Boolean;
96
97    procedure Clear (Container : in out Set);
98
99    procedure Assign (Target : in out Set; Source : Set);
100
101    function Copy (Source   : Set;
102                   Capacity : Count_Type := 0) return Set;
103
104    function Element (Container : Set; Position : Cursor) return Element_Type;
105
106    procedure Replace_Element
107      (Container : in out Set;
108       Position  : Cursor;
109       New_Item  : Element_Type);
110
111    procedure Query_Element
112      (Container : in out Set;
113       Position  : Cursor;
114       Process   : not null access procedure (Element : Element_Type));
115
116    procedure Move (Target : in out Set; Source : in out Set);
117
118    procedure Insert
119      (Container : in out Set;
120       New_Item  : Element_Type;
121       Position  : out Cursor;
122       Inserted  : out Boolean);
123
124    procedure Insert  (Container : in out Set; New_Item : Element_Type);
125
126    procedure Include (Container : in out Set; New_Item : Element_Type);
127
128    procedure Replace (Container : in out Set; New_Item : Element_Type);
129
130    procedure Exclude (Container : in out Set; Item     : Element_Type);
131
132    procedure Delete  (Container : in out Set; Item     : Element_Type);
133
134    procedure Delete (Container : in out Set; Position  : in out Cursor);
135
136    procedure Union (Target : in out Set; Source : Set);
137
138    function Union (Left, Right : Set) return Set;
139
140    function "or" (Left, Right : Set) return Set renames Union;
141
142    procedure Intersection (Target : in out Set; Source : Set);
143
144    function Intersection (Left, Right : Set) return Set;
145
146    function "and" (Left, Right : Set) return Set renames Intersection;
147
148    procedure Difference (Target : in out Set; Source : Set);
149
150    function Difference (Left, Right : Set) return Set;
151
152    function "-" (Left, Right : Set) return Set renames Difference;
153
154    procedure Symmetric_Difference (Target : in out Set; Source : Set);
155
156    function Symmetric_Difference (Left, Right : Set) return Set;
157
158    function "xor" (Left, Right : Set) return Set
159                    renames Symmetric_Difference;
160
161    function Overlap (Left, Right : Set) return Boolean;
162
163    function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
164
165    function First (Container : Set) return Cursor;
166
167    function Next (Container : Set; Position : Cursor) return Cursor;
168
169    procedure Next (Container : Set; Position : in out Cursor);
170
171    function Find
172      (Container : Set;
173       Item      : Element_Type) return Cursor;
174
175    function Contains (Container : Set; Item : Element_Type) return Boolean;
176
177    function Has_Element (Container : Set; Position : Cursor) return Boolean;
178
179    function Equivalent_Elements (Left  : Set; CLeft : Cursor;
180                                  Right : Set; CRight : Cursor) return Boolean;
181
182    function Equivalent_Elements
183      (Left  : Set; CLeft : Cursor;
184       Right : Element_Type) return Boolean;
185
186    function Equivalent_Elements
187      (Left  : Element_Type;
188       Right : Set; CRight : Cursor) return Boolean;
189
190    procedure Iterate
191      (Container : Set;
192       Process   :
193         not null access procedure (Container : Set; Position : Cursor));
194
195    function Default_Modulus (Capacity : Count_Type) return Hash_Type;
196
197    generic
198       type Key_Type (<>) is private;
199
200       with function Key (Element : Element_Type) return Key_Type;
201
202       with function Hash (Key : Key_Type) return Hash_Type;
203
204       with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
205
206    package Generic_Keys is
207
208       function Key (Container : Set; Position : Cursor) return Key_Type;
209
210       function Element (Container : Set; Key : Key_Type) return Element_Type;
211
212       procedure Replace
213         (Container : in out Set;
214          Key       : Key_Type;
215          New_Item  : Element_Type);
216
217       procedure Exclude (Container : in out Set; Key : Key_Type);
218
219       procedure Delete (Container : in out Set; Key : Key_Type);
220
221       function Find (Container : Set; Key : Key_Type) return Cursor;
222
223       function Contains (Container : Set; Key : Key_Type) return Boolean;
224
225       procedure Update_Element_Preserving_Key
226         (Container : in out Set;
227          Position  : Cursor;
228          Process   : not null access
229                        procedure (Element : in out Element_Type));
230
231    end Generic_Keys;
232
233    function Strict_Equal (Left, Right : Set) return Boolean;
234    --  Strict_Equal returns True if the containers are physically equal, i.e.
235    --  they are structurally equal (function "=" returns True) and that they
236    --  have the same set of cursors.
237
238    function Left  (Container : Set; Position : Cursor) return Set;
239    function Right (Container : Set; Position : Cursor) return Set;
240    --  Left returns a container containing all elements preceding Position
241    --  (excluded) in Container. Right returns a container containing all
242    --  elements following Position (included) in Container. These two new
243    --  functions can be used to express invariant properties in loops which
244    --  iterate over containers. Left returns the part of the container already
245    --  scanned and Right the part not scanned yet.
246
247 private
248
249    pragma Inline (Next);
250
251    type Node_Type is
252       record
253          Element     : Element_Type;
254          Next        : Count_Type;
255          Has_Element : Boolean := False;
256       end record;
257
258    package HT_Types is new
259      Ada.Containers.Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type);
260
261    type Set (Capacity : Count_Type; Modulus : Hash_Type) is
262       new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
263
264    use HT_Types;
265    use Ada.Streams;
266
267    type Cursor is record
268       Node : Count_Type;
269    end record;
270
271    procedure Write
272      (Stream : not null access Root_Stream_Type'Class;
273       Item   : Cursor);
274
275    for Cursor'Write use Write;
276
277    procedure Read
278      (Stream : not null access Root_Stream_Type'Class;
279       Item   : out Cursor);
280
281    for Cursor'Read use Read;
282
283    No_Element : constant Cursor := (Node => 0);
284
285    procedure Write
286      (Stream    : not null access Root_Stream_Type'Class;
287       Container : Set);
288
289    for Set'Write use Write;
290
291    procedure Read
292      (Stream    : not null access Root_Stream_Type'Class;
293       Container : out Set);
294
295    for Set'Read use Read;
296
297    Empty_Set : constant Set := (Capacity => 0, Modulus => 0, others => <>);
298
299 end Ada.Containers.Formal_Hashed_Sets;