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