1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT LIBRARY COMPONENTS                          --
4--                                                                          --
5--                A D A . C O N T A I N E R S . V E C T O R S               --
6--                                                                          --
7--                                 S p e c                                  --
8--                                                                          --
9--          Copyright (C) 2004-2015, 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
34with Ada.Iterator_Interfaces;
35
36with Ada.Containers.Helpers;
37private with Ada.Finalization;
38private with Ada.Streams;
39
40generic
41   type Index_Type is range <>;
42   type Element_Type is private;
43
44   with function "=" (Left, Right : Element_Type) return Boolean is <>;
45
46package Ada.Containers.Vectors is
47   pragma Annotate (CodePeer, Skip_Analysis);
48   pragma Preelaborate;
49   pragma Remote_Types;
50
51   subtype Extended_Index is Index_Type'Base
52     range Index_Type'First - 1 ..
53           Index_Type'Min (Index_Type'Base'Last - 1, Index_Type'Last) + 1;
54
55   No_Index : constant Extended_Index := Extended_Index'First;
56
57   type Vector is tagged private
58   with
59      Constant_Indexing => Constant_Reference,
60      Variable_Indexing => Reference,
61      Default_Iterator  => Iterate,
62      Iterator_Element  => Element_Type;
63   pragma Preelaborable_Initialization (Vector);
64
65   type Cursor is private;
66   pragma Preelaborable_Initialization (Cursor);
67
68   No_Element : constant Cursor;
69
70   function Has_Element (Position : Cursor) return Boolean;
71
72   package Vector_Iterator_Interfaces is new
73      Ada.Iterator_Interfaces (Cursor, Has_Element);
74
75   Empty_Vector : constant Vector;
76
77   overriding function "=" (Left, Right : Vector) return Boolean;
78
79   function To_Vector (Length : Count_Type) return Vector;
80
81   function To_Vector
82     (New_Item : Element_Type;
83      Length   : Count_Type) return Vector;
84
85   function "&" (Left, Right : Vector) return Vector;
86
87   function "&" (Left : Vector; Right : Element_Type) return Vector;
88
89   function "&" (Left : Element_Type; Right : Vector) return Vector;
90
91   function "&" (Left, Right : Element_Type) return Vector;
92
93   function Capacity (Container : Vector) return Count_Type;
94
95   procedure Reserve_Capacity
96     (Container : in out Vector;
97      Capacity  : Count_Type);
98
99   function Length (Container : Vector) return Count_Type;
100
101   procedure Set_Length
102     (Container : in out Vector;
103      Length    : Count_Type);
104
105   function Is_Empty (Container : Vector) return Boolean;
106
107   procedure Clear (Container : in out Vector);
108
109   function To_Cursor
110     (Container : Vector;
111      Index     : Extended_Index) return Cursor;
112
113   function To_Index (Position : Cursor) return Extended_Index;
114
115   function Element
116     (Container : Vector;
117      Index     : Index_Type) return Element_Type;
118
119   function Element (Position : Cursor) return Element_Type;
120
121   procedure Replace_Element
122     (Container : in out Vector;
123      Index     : Index_Type;
124      New_Item  : Element_Type);
125
126   procedure Replace_Element
127     (Container : in out Vector;
128      Position  : Cursor;
129      New_Item  : Element_Type);
130
131   procedure Query_Element
132     (Container : Vector;
133      Index     : Index_Type;
134      Process   : not null access procedure (Element : Element_Type));
135
136   procedure Query_Element
137     (Position : Cursor;
138      Process  : not null access procedure (Element : Element_Type));
139
140   procedure Update_Element
141     (Container : in out Vector;
142      Index     : Index_Type;
143      Process   : not null access procedure (Element : in out Element_Type));
144
145   procedure Update_Element
146     (Container : in out Vector;
147      Position  : Cursor;
148      Process   : not null access procedure (Element : in out Element_Type));
149
150   type Constant_Reference_Type
151      (Element : not null access constant Element_Type) is
152   private
153   with
154      Implicit_Dereference => Element;
155
156   type Reference_Type (Element : not null access Element_Type) is private
157   with
158      Implicit_Dereference => Element;
159
160   function Constant_Reference
161     (Container : aliased Vector;
162      Position  : Cursor) return Constant_Reference_Type;
163   pragma Inline (Constant_Reference);
164
165   function Reference
166     (Container : aliased in out Vector;
167      Position  : Cursor) return Reference_Type;
168   pragma Inline (Reference);
169
170   function Constant_Reference
171     (Container : aliased Vector;
172      Index     : Index_Type) return Constant_Reference_Type;
173   pragma Inline (Constant_Reference);
174
175   function Reference
176     (Container : aliased in out Vector;
177      Index     : Index_Type) return Reference_Type;
178   pragma Inline (Reference);
179
180   procedure Assign (Target : in out Vector; Source : Vector);
181
182   function Copy (Source : Vector; Capacity : Count_Type := 0) return Vector;
183
184   procedure Move (Target : in out Vector; Source : in out Vector);
185
186   procedure Insert
187     (Container : in out Vector;
188      Before    : Extended_Index;
189      New_Item  : Vector);
190
191   procedure Insert
192     (Container : in out Vector;
193      Before    : Cursor;
194      New_Item  : Vector);
195
196   procedure Insert
197     (Container : in out Vector;
198      Before    : Cursor;
199      New_Item  : Vector;
200      Position  : out Cursor);
201
202   procedure Insert
203     (Container : in out Vector;
204      Before    : Extended_Index;
205      New_Item  : Element_Type;
206      Count     : Count_Type := 1);
207
208   procedure Insert
209     (Container : in out Vector;
210      Before    : Cursor;
211      New_Item  : Element_Type;
212      Count     : Count_Type := 1);
213
214   procedure Insert
215     (Container : in out Vector;
216      Before    : Cursor;
217      New_Item  : Element_Type;
218      Position  : out Cursor;
219      Count     : Count_Type := 1);
220
221   procedure Insert
222     (Container : in out Vector;
223      Before    : Extended_Index;
224      Count     : Count_Type := 1);
225
226   procedure Insert
227     (Container : in out Vector;
228      Before    : Cursor;
229      Position  : out Cursor;
230      Count     : Count_Type := 1);
231
232   procedure Prepend
233     (Container : in out Vector;
234      New_Item  : Vector);
235
236   procedure Prepend
237     (Container : in out Vector;
238      New_Item  : Element_Type;
239      Count     : Count_Type := 1);
240
241   procedure Append
242     (Container : in out Vector;
243      New_Item  : Vector);
244
245   procedure Append
246     (Container : in out Vector;
247      New_Item  : Element_Type;
248      Count     : Count_Type := 1);
249
250   procedure Insert_Space
251     (Container : in out Vector;
252      Before    : Extended_Index;
253      Count     : Count_Type := 1);
254
255   procedure Insert_Space
256     (Container : in out Vector;
257      Before    : Cursor;
258      Position  : out Cursor;
259      Count     : Count_Type := 1);
260
261   procedure Delete
262     (Container : in out Vector;
263      Index     : Extended_Index;
264      Count     : Count_Type := 1);
265
266   procedure Delete
267     (Container : in out Vector;
268      Position  : in out Cursor;
269      Count     : Count_Type := 1);
270
271   procedure Delete_First
272     (Container : in out Vector;
273      Count     : Count_Type := 1);
274
275   procedure Delete_Last
276     (Container : in out Vector;
277      Count     : Count_Type := 1);
278
279   procedure Reverse_Elements (Container : in out Vector);
280
281   procedure Swap (Container : in out Vector; I, J : Index_Type);
282
283   procedure Swap (Container : in out Vector; I, J : Cursor);
284
285   function First_Index (Container : Vector) return Index_Type;
286
287   function First (Container : Vector) return Cursor;
288
289   function First_Element (Container : Vector) return Element_Type;
290
291   function Last_Index (Container : Vector) return Extended_Index;
292
293   function Last (Container : Vector) return Cursor;
294
295   function Last_Element (Container : Vector) return Element_Type;
296
297   function Next (Position : Cursor) return Cursor;
298
299   procedure Next (Position : in out Cursor);
300
301   function Previous (Position : Cursor) return Cursor;
302
303   procedure Previous (Position : in out Cursor);
304
305   function Find_Index
306     (Container : Vector;
307      Item      : Element_Type;
308      Index     : Index_Type := Index_Type'First) return Extended_Index;
309
310   function Find
311     (Container : Vector;
312      Item      : Element_Type;
313      Position  : Cursor := No_Element) return Cursor;
314
315   function Reverse_Find_Index
316     (Container : Vector;
317      Item      : Element_Type;
318      Index     : Index_Type := Index_Type'Last) return Extended_Index;
319
320   function Reverse_Find
321     (Container : Vector;
322      Item      : Element_Type;
323      Position  : Cursor := No_Element) return Cursor;
324
325   function Contains
326     (Container : Vector;
327      Item      : Element_Type) return Boolean;
328
329   procedure Iterate
330     (Container : Vector;
331      Process   : not null access procedure (Position : Cursor));
332
333   procedure Reverse_Iterate
334     (Container : Vector;
335      Process   : not null access procedure (Position : Cursor));
336
337   function Iterate (Container : Vector)
338      return Vector_Iterator_Interfaces.Reversible_Iterator'Class;
339
340   function Iterate (Container : Vector; Start : Cursor)
341      return Vector_Iterator_Interfaces.Reversible_Iterator'Class;
342
343   generic
344      with function "<" (Left, Right : Element_Type) return Boolean is <>;
345   package Generic_Sorting is
346
347      function Is_Sorted (Container : Vector) return Boolean;
348
349      procedure Sort (Container : in out Vector);
350
351      procedure Merge (Target : in out Vector; Source : in out Vector);
352
353   end Generic_Sorting;
354
355private
356
357   pragma Inline (Append);
358   pragma Inline (First_Index);
359   pragma Inline (Last_Index);
360   pragma Inline (Element);
361   pragma Inline (First_Element);
362   pragma Inline (Last_Element);
363   pragma Inline (Query_Element);
364   pragma Inline (Update_Element);
365   pragma Inline (Replace_Element);
366   pragma Inline (Is_Empty);
367   pragma Inline (Contains);
368   pragma Inline (Next);
369   pragma Inline (Previous);
370
371   use Ada.Containers.Helpers;
372   package Implementation is new Generic_Implementation;
373   use Implementation;
374
375   type Elements_Array is array (Index_Type range <>) of aliased Element_Type;
376   function "=" (L, R : Elements_Array) return Boolean is abstract;
377
378   type Elements_Type (Last : Extended_Index) is limited record
379      EA : Elements_Array (Index_Type'First .. Last);
380   end record;
381
382   type Elements_Access is access all Elements_Type;
383
384   use Finalization;
385   use Streams;
386
387   type Vector is new Controlled with record
388      Elements : Elements_Access := null;
389      Last     : Extended_Index := No_Index;
390      TC       : aliased Tamper_Counts;
391   end record;
392
393   overriding procedure Adjust (Container : in out Vector);
394   overriding procedure Finalize (Container : in out Vector);
395
396   procedure Write
397     (Stream    : not null access Root_Stream_Type'Class;
398      Container : Vector);
399
400   for Vector'Write use Write;
401
402   procedure Read
403     (Stream    : not null access Root_Stream_Type'Class;
404      Container : out Vector);
405
406   for Vector'Read use Read;
407
408   type Vector_Access is access all Vector;
409   for Vector_Access'Storage_Size use 0;
410
411   type Cursor is record
412      Container : Vector_Access;
413      Index     : Index_Type := Index_Type'First;
414   end record;
415
416   procedure Read
417     (Stream   : not null access Root_Stream_Type'Class;
418      Position : out Cursor);
419
420   for Cursor'Read use Read;
421
422   procedure Write
423     (Stream   : not null access Root_Stream_Type'Class;
424      Position : Cursor);
425
426   for Cursor'Write use Write;
427
428   subtype Reference_Control_Type is Implementation.Reference_Control_Type;
429   --  It is necessary to rename this here, so that the compiler can find it
430
431   type Constant_Reference_Type
432     (Element : not null access constant Element_Type) is
433      record
434         Control : Reference_Control_Type :=
435           raise Program_Error with "uninitialized reference";
436         --  The RM says, "The default initialization of an object of
437         --  type Constant_Reference_Type or Reference_Type propagates
438         --  Program_Error."
439      end record;
440
441   procedure Write
442     (Stream : not null access Root_Stream_Type'Class;
443      Item   : Constant_Reference_Type);
444
445   for Constant_Reference_Type'Write use Write;
446
447   procedure Read
448     (Stream : not null access Root_Stream_Type'Class;
449      Item   : out Constant_Reference_Type);
450
451   for Constant_Reference_Type'Read use Read;
452
453   type Reference_Type
454     (Element : not null access Element_Type) is
455      record
456         Control : Reference_Control_Type :=
457           raise Program_Error with "uninitialized reference";
458         --  The RM says, "The default initialization of an object of
459         --  type Constant_Reference_Type or Reference_Type propagates
460         --  Program_Error."
461      end record;
462
463   procedure Write
464     (Stream : not null access Root_Stream_Type'Class;
465      Item   : Reference_Type);
466
467   for Reference_Type'Write use Write;
468
469   procedure Read
470     (Stream : not null access Root_Stream_Type'Class;
471      Item   : out Reference_Type);
472
473   for Reference_Type'Read use Read;
474
475   --  Three operations are used to optimize in the expansion of "for ... of"
476   --  loops: the Next(Cursor) procedure in the visible part, and the following
477   --  Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for
478   --  details.
479
480   function Pseudo_Reference
481     (Container : aliased Vector'Class) return Reference_Control_Type;
482   pragma Inline (Pseudo_Reference);
483   --  Creates an object of type Reference_Control_Type pointing to the
484   --  container, and increments the Lock. Finalization of this object will
485   --  decrement the Lock.
486
487   type Element_Access is access all Element_Type;
488
489   function Get_Element_Access
490     (Position : Cursor) return not null Element_Access;
491   --  Returns a pointer to the element designated by Position.
492
493   No_Element : constant Cursor := Cursor'(null, Index_Type'First);
494
495   Empty_Vector : constant Vector := (Controlled with others => <>);
496
497   type Iterator is new Limited_Controlled and
498     Vector_Iterator_Interfaces.Reversible_Iterator with
499   record
500      Container : Vector_Access;
501      Index     : Index_Type'Base;
502   end record
503     with Disable_Controlled => not T_Check;
504
505   overriding procedure Finalize (Object : in out Iterator);
506
507   overriding function First (Object : Iterator) return Cursor;
508   overriding function Last  (Object : Iterator) return Cursor;
509
510   overriding function Next
511     (Object   : Iterator;
512      Position : Cursor) return Cursor;
513
514   overriding function Previous
515     (Object   : Iterator;
516      Position : Cursor) return Cursor;
517
518end Ada.Containers.Vectors;
519