1------------------------------------------------------------------------------
2--                                                                          --
3--                            GNAT2XML COMPONENTS                           --
4--                                                                          --
5--                               V E C T O R S                              --
6--                                                                          --
7--                                 S p e c                                  --
8--                                                                          --
9--                      Copyright (C) 2013-2016, AdaCore                    --
10--                                                                          --
11-- Gnat2xml is free software; you can redistribute it and/or modify it      --
12-- under terms of the  GNU General Public License  as published by the Free --
13-- Software Foundation;  either version 2,  or  (at your option)  any later --
14-- version. Gnat2xml is distributed  in the hope  that it will be useful,   --
15-- but WITHOUT ANY WARRANTY; without even the implied warranty of MER-      --
16-- CHANTABILITY or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General  --
17-- Public License for more details. You should have received a copy of the  --
18-- GNU General Public License distributed with GNAT; see file COPYING. If   --
19-- not, write to the Free Software Foundation, 59 Temple Place Suite 330,   --
20-- Boston, MA 02111-1307, USA.                                              --
21-- The gnat2xml tool was derived from the Avatox sources.                   --
22------------------------------------------------------------------------------
23
24pragma Ada_2012;
25
26with Ada.Containers; use Ada.Containers;
27with Ada.Iterator_Interfaces;
28
29private with Ada.Finalization;
30
31generic
32   type Index_Type is range <>;
33   type Element_Type is private;
34   type Elements_Array is array (Index_Type range <>) of Element_Type;
35
36   with function "=" (Left, Right : Element_Type) return Boolean is <>;
37
38package ASIS_UL.Fast_Vectors is
39
40   --  This is a more efficient version of Ada.Containers.Vectors.
41
42   pragma Suppress (All_Checks);
43
44   pragma Assert (Index_Type'First = 1);
45   pragma Assert (Index_Type'Last = 2**31 - 1);
46   --  These assumptions allow us to avoid a lot of horsing around. But we
47   --  still inherit some such horsing from Ada.Containers.Vectors.
48
49   subtype Extended_Index is
50     Index_Type'
51       Base range
52       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 with
58      Constant_Indexing => Constant_Reference,
59      Variable_Indexing => Reference,
60      Default_Iterator  => Iterate,
61      Iterator_Element  => Element_Type;
62
63   type Cursor is private;
64
65   No_Element : constant Cursor;
66
67   function Has_Element (Position : Cursor) return Boolean;
68
69   package Vector_Iterator_Interfaces is new Ada.Iterator_Interfaces
70     (Cursor,
71      Has_Element);
72
73   Empty_Vector : constant Vector;
74
75   overriding function "=" (Left, Right : Vector) return Boolean;
76
77   function Length (Container : Vector) return Count_Type;
78
79   procedure Set_Length (Container : in out Vector; Length : Count_Type);
80
81   function Is_Empty (Container : Vector) return Boolean;
82
83   procedure Clear (Container : in out Vector);
84
85   procedure Free (Container : in out Vector);
86   --  Same as Clear, but also frees storage
87
88   function To_Cursor
89     (Container : Vector;
90      Index     : Extended_Index)
91      return      Cursor;
92
93   function To_Index (Position : Cursor) return Extended_Index;
94
95   function Element
96     (Container : Vector;
97      Index     : Index_Type)
98      return      Element_Type;
99
100   function Element (Position : Cursor) return Element_Type;
101
102   type Constant_Reference_Type
103     (Element : not null access constant Element_Type) is private with
104      Implicit_Dereference => Element;
105
106   type Reference_Type (Element : not null access Element_Type) is private with
107      Implicit_Dereference => Element;
108
109   function Constant_Reference
110     (Container : aliased Vector;
111      Position  : Cursor)
112      return      Constant_Reference_Type;
113
114   function Reference
115     (Container : aliased in out Vector;
116      Position  : Cursor)
117      return      Reference_Type;
118
119   function Constant_Reference
120     (Container : aliased Vector;
121      Index     : Index_Type)
122      return      Constant_Reference_Type;
123
124   function Reference
125     (Container : aliased in out Vector;
126      Index     : Index_Type)
127      return      Reference_Type;
128
129   procedure Move (Target : in out Vector; Source : in out Vector);
130
131   procedure Append (Container : in out Vector; New_Item : Element_Type);
132
133   type Element_Access is access all Element_Type;
134   function Append (Container : in out Vector) return Element_Access;
135
136   procedure Delete_Last (Container : in out Vector);
137
138   function First (Container : Vector) return Cursor;
139
140   function Last_Index (Container : Vector) return Extended_Index;
141
142   function Last (Container : Vector) return Cursor;
143
144   function Last_Element (Container : Vector) return Element_Type;
145
146   function Next (Position : Cursor) return Cursor;
147
148   procedure Next (Position : in out Cursor);
149
150   function Previous (Position : Cursor) return Cursor;
151
152   procedure Previous (Position : in out Cursor);
153
154   procedure Iterate
155     (Container : Vector;
156      Process   : not null access procedure (Position : Cursor));
157
158   procedure Reverse_Iterate
159     (Container : Vector;
160      Process   : not null access procedure (Position : Cursor));
161
162   function Iterate
163     (Container : Vector)
164      return      Vector_Iterator_Interfaces.Reversible_Iterator'Class;
165
166   function Iterate
167     (Container : Vector;
168      Start     : Cursor)
169      return      Vector_Iterator_Interfaces.Reversible_Iterator'Class;
170
171   generic
172      with function "<" (Left, Right : Element_Type) return Boolean is <>;
173   package Generic_Sorting is
174
175      function Is_Sorted (Container : Vector) return Boolean;
176
177      procedure Sort (Container : in out Vector);
178
179      procedure Merge (Target : in out Vector; Source : in out Vector);
180
181   end Generic_Sorting;
182
183   --  Extra operations not in Ada.Containers.Vectors:
184
185   subtype Big_Elements_Array is Elements_Array (Index_Type);
186   type Big_Ptr is access constant Big_Elements_Array;
187   pragma No_Strict_Aliasing (Big_Ptr);
188   type Big_Ptr_Var is access all Big_Elements_Array;
189   pragma No_Strict_Aliasing (Big_Ptr_Var);
190
191   function Elems (Container : Vector) return Big_Ptr; -- with
192--      Post => Elems'Result'First = Index_Type'First;
193   function Elems_Var (Container : Vector) return Big_Ptr_Var; -- with
194--      Post => Elems_Var'Result'First = Index_Type'First;
195--  ???Above postconditions cause warnings These return a pointer to the
196--  underlying data structure. This is of course dangerous. The idea is
197--  that you can do:
198   --
199   --     X : Elems_Array renames Elems (V) (1 .. Last_Index (V));
200   --
201   --  But don't do Append (etc) while X still exists. Do not call these
202   --  without the slicing.
203
204   function Slice
205     (Container : Vector;
206      First     : Index_Type;
207      Last      : Extended_Index)
208      return      Elements_Array with
209      Post => Slice'Result'First = Index_Type'First;
210
211   function To_Array (Container : Vector) return Elements_Array with
212      Post => To_Array'Result'First = Index_Type'First;
213
214   procedure Append (Container : in out Vector; New_Items : Elements_Array);
215
216private
217
218   pragma Inline (Append);
219   pragma Inline (Constant_Reference);
220   pragma Inline (Clear);
221   pragma Inline (Reference);
222   pragma Inline (Last_Index);
223   pragma Inline (Element);
224   pragma Inline (Last_Element);
225   pragma Inline (Is_Empty);
226
227   function "=" (L, R : Elements_Array) return Boolean is abstract;
228
229   type Elements_Type (Last : Extended_Index) is limited record
230      EA : aliased Elements_Array (Index_Type'First .. Last);
231   end record;
232
233   Empty_Elements : aliased Elements_Type := (Last => 0, EA => (others => <>));
234
235   type Elements_Access is access all Elements_Type;
236
237   use Ada.Finalization;
238
239   type Vector is new Controlled with record
240      Elements : Elements_Access := Empty_Elements'Access;
241      Last     : Extended_Index  := No_Index;
242   end record;
243
244   overriding procedure Adjust (Container : in out Vector);
245
246   overriding procedure Finalize (Container : in out Vector);
247
248   type Vector_Access is access all Vector;
249
250   type Cursor is record
251      Container : Vector_Access;
252      Index     : Index_Type := Index_Type'First;
253   end record;
254
255   type Constant_Reference_Type
256     (Element : not null access constant Element_Type) is null record;
257
258   type Reference_Type (Element : not null access Element_Type) is null record;
259
260   No_Element : constant Cursor := Cursor'(null, Index_Type'First);
261
262   Empty_Vector : constant Vector := (Controlled with others => <>);
263
264end ASIS_UL.Fast_Vectors;
265