Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/libgnat/a-ciorse.ads @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 ------------------------------------------------------------------------------ | |
2 -- -- | |
3 -- GNAT LIBRARY COMPONENTS -- | |
4 -- -- | |
5 -- ADA.CONTAINERS.INDEFINITE_ORDERED_SETS -- | |
6 -- -- | |
7 -- S p e c -- | |
8 -- -- | |
9 -- Copyright (C) 2004-2017, 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 -- This unit was originally developed by Matthew J Heaney. -- | |
32 ------------------------------------------------------------------------------ | |
33 | |
34 with Ada.Iterator_Interfaces; | |
35 | |
36 with Ada.Containers.Helpers; | |
37 private with Ada.Containers.Red_Black_Trees; | |
38 private with Ada.Finalization; | |
39 private with Ada.Streams; | |
40 | |
41 generic | |
42 type Element_Type (<>) is private; | |
43 | |
44 with function "<" (Left, Right : Element_Type) return Boolean is <>; | |
45 with function "=" (Left, Right : Element_Type) return Boolean is <>; | |
46 | |
47 package Ada.Containers.Indefinite_Ordered_Sets is | |
48 pragma Annotate (CodePeer, Skip_Analysis); | |
49 pragma Preelaborate; | |
50 pragma Remote_Types; | |
51 | |
52 function Equivalent_Elements (Left, Right : Element_Type) return Boolean; | |
53 | |
54 type Set is tagged private with | |
55 Constant_Indexing => Constant_Reference, | |
56 Default_Iterator => Iterate, | |
57 Iterator_Element => Element_Type; | |
58 | |
59 pragma Preelaborable_Initialization (Set); | |
60 | |
61 type Cursor is private; | |
62 pragma Preelaborable_Initialization (Cursor); | |
63 | |
64 Empty_Set : constant Set; | |
65 | |
66 No_Element : constant Cursor; | |
67 | |
68 function Has_Element (Position : Cursor) return Boolean; | |
69 | |
70 package Set_Iterator_Interfaces is new | |
71 Ada.Iterator_Interfaces (Cursor, Has_Element); | |
72 | |
73 function "=" (Left, Right : Set) return Boolean; | |
74 | |
75 function Equivalent_Sets (Left, Right : Set) return Boolean; | |
76 | |
77 function To_Set (New_Item : Element_Type) return Set; | |
78 | |
79 function Length (Container : Set) return Count_Type; | |
80 | |
81 function Is_Empty (Container : Set) return Boolean; | |
82 | |
83 procedure Clear (Container : in out Set); | |
84 | |
85 function Element (Position : Cursor) return Element_Type; | |
86 | |
87 procedure Replace_Element | |
88 (Container : in out Set; | |
89 Position : Cursor; | |
90 New_Item : Element_Type); | |
91 | |
92 procedure Query_Element | |
93 (Position : Cursor; | |
94 Process : not null access procedure (Element : Element_Type)); | |
95 | |
96 type Constant_Reference_Type | |
97 (Element : not null access constant Element_Type) is | |
98 private with | |
99 Implicit_Dereference => Element; | |
100 | |
101 function Constant_Reference | |
102 (Container : aliased Set; | |
103 Position : Cursor) return Constant_Reference_Type; | |
104 pragma Inline (Constant_Reference); | |
105 | |
106 procedure Assign (Target : in out Set; Source : Set); | |
107 | |
108 function Copy (Source : Set) return Set; | |
109 | |
110 procedure Move (Target : in out Set; Source : in out Set); | |
111 | |
112 procedure Insert | |
113 (Container : in out Set; | |
114 New_Item : Element_Type; | |
115 Position : out Cursor; | |
116 Inserted : out Boolean); | |
117 | |
118 procedure Insert | |
119 (Container : in out Set; | |
120 New_Item : Element_Type); | |
121 | |
122 procedure Include | |
123 (Container : in out Set; | |
124 New_Item : Element_Type); | |
125 | |
126 procedure Replace | |
127 (Container : in out Set; | |
128 New_Item : Element_Type); | |
129 | |
130 procedure Exclude | |
131 (Container : in out Set; | |
132 Item : Element_Type); | |
133 | |
134 procedure Delete | |
135 (Container : in out Set; | |
136 Item : Element_Type); | |
137 | |
138 procedure Delete | |
139 (Container : in out Set; | |
140 Position : in out Cursor); | |
141 | |
142 procedure Delete_First (Container : in out Set); | |
143 | |
144 procedure Delete_Last (Container : in out Set); | |
145 | |
146 procedure Union (Target : in out Set; Source : Set); | |
147 | |
148 function Union (Left, Right : Set) return Set; | |
149 | |
150 function "or" (Left, Right : Set) return Set renames Union; | |
151 | |
152 procedure Intersection (Target : in out Set; Source : Set); | |
153 | |
154 function Intersection (Left, Right : Set) return Set; | |
155 | |
156 function "and" (Left, Right : Set) return Set renames Intersection; | |
157 | |
158 procedure Difference (Target : in out Set; Source : Set); | |
159 | |
160 function Difference (Left, Right : Set) return Set; | |
161 | |
162 function "-" (Left, Right : Set) return Set renames Difference; | |
163 | |
164 procedure Symmetric_Difference (Target : in out Set; Source : Set); | |
165 | |
166 function Symmetric_Difference (Left, Right : Set) return Set; | |
167 | |
168 function "xor" (Left, Right : Set) return Set renames Symmetric_Difference; | |
169 | |
170 function Overlap (Left, Right : Set) return Boolean; | |
171 | |
172 function Is_Subset (Subset : Set; Of_Set : Set) return Boolean; | |
173 | |
174 function First (Container : Set) return Cursor; | |
175 | |
176 function First_Element (Container : Set) return Element_Type; | |
177 | |
178 function Last (Container : Set) return Cursor; | |
179 | |
180 function Last_Element (Container : Set) return Element_Type; | |
181 | |
182 function Next (Position : Cursor) return Cursor; | |
183 | |
184 procedure Next (Position : in out Cursor); | |
185 | |
186 function Previous (Position : Cursor) return Cursor; | |
187 | |
188 procedure Previous (Position : in out Cursor); | |
189 | |
190 function Find | |
191 (Container : Set; | |
192 Item : Element_Type) return Cursor; | |
193 | |
194 function Floor | |
195 (Container : Set; | |
196 Item : Element_Type) return Cursor; | |
197 | |
198 function Ceiling | |
199 (Container : Set; | |
200 Item : Element_Type) return Cursor; | |
201 | |
202 function Contains | |
203 (Container : Set; | |
204 Item : Element_Type) return Boolean; | |
205 | |
206 function "<" (Left, Right : Cursor) return Boolean; | |
207 | |
208 function ">" (Left, Right : Cursor) return Boolean; | |
209 | |
210 function "<" (Left : Cursor; Right : Element_Type) return Boolean; | |
211 | |
212 function ">" (Left : Cursor; Right : Element_Type) return Boolean; | |
213 | |
214 function "<" (Left : Element_Type; Right : Cursor) return Boolean; | |
215 | |
216 function ">" (Left : Element_Type; Right : Cursor) return Boolean; | |
217 | |
218 procedure Iterate | |
219 (Container : Set; | |
220 Process : not null access procedure (Position : Cursor)); | |
221 | |
222 procedure Reverse_Iterate | |
223 (Container : Set; | |
224 Process : not null access procedure (Position : Cursor)); | |
225 | |
226 function Iterate | |
227 (Container : Set) | |
228 return Set_Iterator_Interfaces.Reversible_Iterator'class; | |
229 | |
230 function Iterate | |
231 (Container : Set; | |
232 Start : Cursor) | |
233 return Set_Iterator_Interfaces.Reversible_Iterator'class; | |
234 | |
235 generic | |
236 type Key_Type (<>) is private; | |
237 | |
238 with function Key (Element : Element_Type) return Key_Type; | |
239 | |
240 with function "<" (Left, Right : Key_Type) return Boolean is <>; | |
241 | |
242 package Generic_Keys is | |
243 | |
244 function Equivalent_Keys (Left, Right : Key_Type) return Boolean; | |
245 | |
246 function Key (Position : Cursor) return Key_Type; | |
247 | |
248 function Element (Container : Set; Key : Key_Type) return Element_Type; | |
249 | |
250 procedure Replace | |
251 (Container : in out Set; | |
252 Key : Key_Type; | |
253 New_Item : Element_Type); | |
254 | |
255 procedure Exclude (Container : in out Set; Key : Key_Type); | |
256 | |
257 procedure Delete (Container : in out Set; Key : Key_Type); | |
258 | |
259 function Find | |
260 (Container : Set; | |
261 Key : Key_Type) return Cursor; | |
262 | |
263 function Floor | |
264 (Container : Set; | |
265 Key : Key_Type) return Cursor; | |
266 | |
267 function Ceiling | |
268 (Container : Set; | |
269 Key : Key_Type) return Cursor; | |
270 | |
271 function Contains | |
272 (Container : Set; | |
273 Key : Key_Type) return Boolean; | |
274 | |
275 procedure Update_Element_Preserving_Key | |
276 (Container : in out Set; | |
277 Position : Cursor; | |
278 Process : not null access | |
279 procedure (Element : in out Element_Type)); | |
280 | |
281 type Reference_Type (Element : not null access Element_Type) is private | |
282 with | |
283 Implicit_Dereference => Element; | |
284 | |
285 function Reference_Preserving_Key | |
286 (Container : aliased in out Set; | |
287 Position : Cursor) return Reference_Type; | |
288 | |
289 function Constant_Reference | |
290 (Container : aliased Set; | |
291 Key : Key_Type) return Constant_Reference_Type; | |
292 | |
293 function Reference_Preserving_Key | |
294 (Container : aliased in out Set; | |
295 Key : Key_Type) return Reference_Type; | |
296 | |
297 private | |
298 type Set_Access is access all Set; | |
299 for Set_Access'Storage_Size use 0; | |
300 | |
301 type Key_Access is access all Key_Type; | |
302 | |
303 package Impl is new Helpers.Generic_Implementation; | |
304 | |
305 type Reference_Control_Type is | |
306 new Impl.Reference_Control_Type with | |
307 record | |
308 Container : Set_Access; | |
309 Pos : Cursor; | |
310 Old_Key : Key_Access; | |
311 end record; | |
312 | |
313 overriding procedure Finalize (Control : in out Reference_Control_Type); | |
314 pragma Inline (Finalize); | |
315 | |
316 type Reference_Type (Element : not null access Element_Type) is record | |
317 Control : Reference_Control_Type; | |
318 end record; | |
319 | |
320 use Ada.Streams; | |
321 | |
322 procedure Write | |
323 (Stream : not null access Root_Stream_Type'Class; | |
324 Item : Reference_Type); | |
325 | |
326 for Reference_Type'Write use Write; | |
327 | |
328 procedure Read | |
329 (Stream : not null access Root_Stream_Type'Class; | |
330 Item : out Reference_Type); | |
331 | |
332 for Reference_Type'Read use Read; | |
333 end Generic_Keys; | |
334 | |
335 private | |
336 pragma Inline (Next); | |
337 pragma Inline (Previous); | |
338 | |
339 type Node_Type; | |
340 type Node_Access is access Node_Type; | |
341 | |
342 type Element_Access is access all Element_Type; | |
343 | |
344 type Node_Type is limited record | |
345 Parent : Node_Access; | |
346 Left : Node_Access; | |
347 Right : Node_Access; | |
348 Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red; | |
349 Element : Element_Access; | |
350 end record; | |
351 | |
352 package Tree_Types is new Red_Black_Trees.Generic_Tree_Types | |
353 (Node_Type, | |
354 Node_Access); | |
355 | |
356 type Set is new Ada.Finalization.Controlled with record | |
357 Tree : Tree_Types.Tree_Type; | |
358 end record; | |
359 | |
360 overriding procedure Adjust (Container : in out Set); | |
361 | |
362 overriding procedure Finalize (Container : in out Set) renames Clear; | |
363 | |
364 use Red_Black_Trees; | |
365 use Tree_Types, Tree_Types.Implementation; | |
366 use Ada.Finalization; | |
367 use Ada.Streams; | |
368 | |
369 procedure Write | |
370 (Stream : not null access Root_Stream_Type'Class; | |
371 Container : Set); | |
372 | |
373 for Set'Write use Write; | |
374 | |
375 procedure Read | |
376 (Stream : not null access Root_Stream_Type'Class; | |
377 Container : out Set); | |
378 | |
379 for Set'Read use Read; | |
380 | |
381 type Set_Access is access all Set; | |
382 for Set_Access'Storage_Size use 0; | |
383 | |
384 type Cursor is record | |
385 Container : Set_Access; | |
386 Node : Node_Access; | |
387 end record; | |
388 | |
389 procedure Write | |
390 (Stream : not null access Root_Stream_Type'Class; | |
391 Item : Cursor); | |
392 | |
393 for Cursor'Write use Write; | |
394 | |
395 procedure Read | |
396 (Stream : not null access Root_Stream_Type'Class; | |
397 Item : out Cursor); | |
398 | |
399 for Cursor'Read use Read; | |
400 | |
401 subtype Reference_Control_Type is Implementation.Reference_Control_Type; | |
402 -- It is necessary to rename this here, so that the compiler can find it | |
403 | |
404 type Constant_Reference_Type | |
405 (Element : not null access constant Element_Type) is | |
406 record | |
407 Control : Reference_Control_Type := | |
408 raise Program_Error with "uninitialized reference"; | |
409 -- The RM says, "The default initialization of an object of | |
410 -- type Constant_Reference_Type or Reference_Type propagates | |
411 -- Program_Error." | |
412 end record; | |
413 | |
414 procedure Read | |
415 (Stream : not null access Root_Stream_Type'Class; | |
416 Item : out Constant_Reference_Type); | |
417 | |
418 for Constant_Reference_Type'Read use Read; | |
419 | |
420 procedure Write | |
421 (Stream : not null access Root_Stream_Type'Class; | |
422 Item : Constant_Reference_Type); | |
423 | |
424 for Constant_Reference_Type'Write use Write; | |
425 | |
426 -- Three operations are used to optimize in the expansion of "for ... of" | |
427 -- loops: the Next(Cursor) procedure in the visible part, and the following | |
428 -- Pseudo_Reference and Get_Element_Access functions. See Sem_Ch5 for | |
429 -- details. | |
430 | |
431 function Pseudo_Reference | |
432 (Container : aliased Set'Class) return Reference_Control_Type; | |
433 pragma Inline (Pseudo_Reference); | |
434 -- Creates an object of type Reference_Control_Type pointing to the | |
435 -- container, and increments the Lock. Finalization of this object will | |
436 -- decrement the Lock. | |
437 | |
438 function Get_Element_Access | |
439 (Position : Cursor) return not null Element_Access; | |
440 -- Returns a pointer to the element designated by Position. | |
441 | |
442 Empty_Set : constant Set := (Controlled with others => <>); | |
443 | |
444 No_Element : constant Cursor := Cursor'(null, null); | |
445 | |
446 type Iterator is new Limited_Controlled and | |
447 Set_Iterator_Interfaces.Reversible_Iterator with | |
448 record | |
449 Container : Set_Access; | |
450 Node : Node_Access; | |
451 end record | |
452 with Disable_Controlled => not T_Check; | |
453 | |
454 overriding procedure Finalize (Object : in out Iterator); | |
455 | |
456 overriding function First (Object : Iterator) return Cursor; | |
457 overriding function Last (Object : Iterator) return Cursor; | |
458 | |
459 overriding function Next | |
460 (Object : Iterator; | |
461 Position : Cursor) return Cursor; | |
462 | |
463 overriding function Previous | |
464 (Object : Iterator; | |
465 Position : Cursor) return Cursor; | |
466 | |
467 end Ada.Containers.Indefinite_Ordered_Sets; |