1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.FORMAL_INDEFINITE_VECTORS --
9 -- Copyright (C) 2010-2017, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 ------------------------------------------------------------------------------
28 with Ada
.Containers
.Generic_Array_Sort
;
29 with Ada
.Unchecked_Deallocation
;
31 with System
; use type System
.Address
;
33 package body Ada
.Containers
.Formal_Indefinite_Vectors
with
36 function H
(New_Item
: Element_Type
) return Holder
renames To_Holder
;
37 function E
(Container
: Holder
) return Element_Type
renames Get
;
39 Growth_Factor
: constant := 2;
40 -- When growing a container, multiply current capacity by this. Doubling
41 -- leads to amortized linear-time copying.
43 type Int
is range System
.Min_Int
.. System
.Max_Int
;
46 new Ada
.Unchecked_Deallocation
(Elements_Array
, Elements_Array_Ptr
);
48 type Maximal_Array_Ptr
is access all Elements_Array
(Array_Index
)
49 with Storage_Size
=> 0;
50 type Maximal_Array_Ptr_Const
is access constant Elements_Array
(Array_Index
)
51 with Storage_Size
=> 0;
53 function Elems
(Container
: in out Vector
) return Maximal_Array_Ptr
;
55 (Container
: Vector
) return Maximal_Array_Ptr_Const
;
56 -- Returns a pointer to the Elements array currently in use -- either
57 -- Container.Elements_Ptr or a pointer to Container.Elements. We work with
58 -- pointers to a bogus array subtype that is constrained with the maximum
59 -- possible bounds. This means that the pointer is a thin pointer. This is
60 -- necessary because 'Unrestricted_Access doesn't work when it produces
61 -- access-to-unconstrained and is returned from a function.
63 -- Note that this is dangerous: make sure calls to this use an indexed
64 -- component or slice that is within the bounds 1 .. Length (Container).
68 Position
: Capacity_Range
) return Element_Type
;
70 function To_Array_Index
(Index
: Index_Type
'Base) return Count_Type
'Base;
72 function Current_Capacity
(Container
: Vector
) return Capacity_Range
;
74 procedure Insert_Space
75 (Container
: in out Vector
;
76 Before
: Extended_Index
;
77 Count
: Count_Type
:= 1);
83 function "=" (Left
: Vector
; Right
: Vector
) return Boolean is
85 if Left
'Address = Right
'Address then
89 if Length
(Left
) /= Length
(Right
) then
93 for J
in 1 .. Length
(Left
) loop
94 if Get_Element
(Left
, J
) /= Get_Element
(Right
, J
) then
106 procedure Append
(Container
: in out Vector
; New_Item
: Vector
) is
108 if Is_Empty
(New_Item
) then
112 if Container
.Last
>= Index_Type
'Last then
113 raise Constraint_Error
with "vector is already at its maximum length";
116 Insert
(Container
, Container
.Last
+ 1, New_Item
);
119 procedure Append
(Container
: in out Vector
; New_Item
: Element_Type
) is
121 Append
(Container
, New_Item
, 1);
125 (Container
: in out Vector
;
126 New_Item
: Element_Type
;
134 if Container
.Last
>= Index_Type
'Last then
135 raise Constraint_Error
with "vector is already at its maximum length";
138 Insert
(Container
, Container
.Last
+ 1, New_Item
, Count
);
145 procedure Assign
(Target
: in out Vector
; Source
: Vector
) is
146 LS
: constant Capacity_Range
:= Length
(Source
);
149 if Target
'Address = Source
'Address then
153 if Bounded
and then Target
.Capacity
< LS
then
154 raise Constraint_Error
;
158 Append
(Target
, Source
);
165 function Capacity
(Container
: Vector
) return Capacity_Range
is
171 Capacity_Range
'Last);
178 procedure Clear
(Container
: in out Vector
) is
180 Container
.Last
:= No_Index
;
182 -- Free element, note that this is OK if Elements_Ptr is null
184 Free
(Container
.Elements_Ptr
);
193 Item
: Element_Type
) return Boolean
196 return Find_Index
(Container
, Item
) /= No_Index
;
205 Capacity
: Capacity_Range
:= 0) return Vector
207 LS
: constant Capacity_Range
:= Length
(Source
);
213 elsif Capacity
>= LS
then
216 raise Capacity_Error
;
219 return Target
: Vector
(C
) do
220 Elems
(Target
) (1 .. LS
) := Elemsc
(Source
) (1 .. LS
);
221 Target
.Last
:= Source
.Last
;
225 ----------------------
226 -- Current_Capacity --
227 ----------------------
229 function Current_Capacity
(Container
: Vector
) return Capacity_Range
is
232 (if Container
.Elements_Ptr
= null then
233 Container
.Elements
'Length
235 Container
.Elements_Ptr
.all'Length);
236 end Current_Capacity
;
242 procedure Delete
(Container
: in out Vector
; Index
: Extended_Index
) is
244 Delete
(Container
, Index
, 1);
248 (Container
: in out Vector
;
249 Index
: Extended_Index
;
252 Old_Last
: constant Index_Type
'Base := Container
.Last
;
253 Old_Len
: constant Count_Type
:= Length
(Container
);
254 New_Last
: Index_Type
'Base;
255 Count2
: Count_Type
'Base; -- count of items from Index to Old_Last
256 Off
: Count_Type
'Base; -- Index expressed as offset from IT'First
259 -- Delete removes items from the vector, the number of which is the
260 -- minimum of the specified Count and the items (if any) that exist from
261 -- Index to Container.Last. There are no constraints on the specified
262 -- value of Count (it can be larger than what's available at this
263 -- position in the vector, for example), but there are constraints on
264 -- the allowed values of the Index.
266 -- As a precondition on the generic actual Index_Type, the base type
267 -- must include Index_Type'Pred (Index_Type'First); this is the value
268 -- that Container.Last assumes when the vector is empty. However, we do
269 -- not allow that as the value for Index when specifying which items
270 -- should be deleted, so we must manually check. (That the user is
271 -- allowed to specify the value at all here is a consequence of the
272 -- declaration of the Extended_Index subtype, which includes the values
273 -- in the base range that immediately precede and immediately follow the
274 -- values in the Index_Type.)
276 if Index
< Index_Type
'First then
277 raise Constraint_Error
with "Index is out of range (too small)";
280 -- We do allow a value greater than Container.Last to be specified as
281 -- the Index, but only if it's immediately greater. This allows the
282 -- corner case of deleting no items from the back end of the vector to
283 -- be treated as a no-op. (It is assumed that specifying an index value
284 -- greater than Last + 1 indicates some deeper flaw in the caller's
285 -- algorithm, so that case is treated as a proper error.)
287 if Index
> Old_Last
then
288 if Index
> Old_Last
+ 1 then
289 raise Constraint_Error
with "Index is out of range (too large)";
299 -- We first calculate what's available for deletion starting at
300 -- Index. Here and elsewhere we use the wider of Index_Type'Base and
301 -- Count_Type'Base as the type for intermediate values. (See function
302 -- Length for more information.)
304 if Count_Type
'Base'Last >= Index_Type'Pos (Index_Type'Base'Last
) then
305 Count2
:= Count_Type
'Base (Old_Last
) - Count_Type
'Base (Index
) + 1;
307 Count2
:= Count_Type
'Base (Old_Last
- Index
+ 1);
310 -- If more elements are requested (Count) for deletion than are
311 -- available (Count2) for deletion beginning at Index, then everything
312 -- from Index is deleted. There are no elements to slide down, and so
313 -- all we need to do is set the value of Container.Last.
315 if Count
>= Count2
then
316 Container
.Last
:= Index
- 1;
320 -- There are some elements that aren't being deleted (the requested
321 -- count was less than the available count), so we must slide them down
322 -- to Index. We first calculate the index values of the respective array
323 -- slices, using the wider of Index_Type'Base and Count_Type'Base as the
324 -- type for intermediate calculations.
326 if Index_Type
'Base'Last >= Count_Type'Pos (Count_Type'Last) then
327 Off := Count_Type'Base (Index - Index_Type'First);
328 New_Last := Old_Last - Index_Type'Base (Count);
330 Off := Count_Type'Base (Index) - Count_Type'Base (Index_Type'First);
331 New_Last := Index_Type'Base (Count_Type'Base (Old_Last) - Count);
334 -- The array index values for each slice have already been determined,
335 -- so we just slide down to Index the elements that weren't deleted.
338 EA : Maximal_Array_Ptr renames Elems (Container);
339 Idx : constant Count_Type := EA'First + Off;
342 EA (Idx .. Old_Len - Count) := EA (Idx + Count .. Old_Len);
343 Container.Last := New_Last;
351 procedure Delete_First (Container : in out Vector) is
353 Delete_First (Container, 1);
356 procedure Delete_First (Container : in out Vector; Count : Count_Type) is
361 elsif Count >= Length (Container) then
366 Delete (Container, Index_Type'First, Count);
374 procedure Delete_Last (Container : in out Vector) is
376 Delete_Last (Container, 1);
379 procedure Delete_Last (Container : in out Vector; Count : Count_Type) is
385 -- There is no restriction on how large Count can be when deleting
386 -- items. If it is equal or greater than the current length, then this
387 -- is equivalent to clearing the vector. (In particular, there's no need
388 -- for us to actually calculate the new value for Last.)
390 -- If the requested count is less than the current length, then we must
391 -- calculate the new value for Last. For the type we use the widest of
392 -- Index_Type'Base and Count_Type'Base for the intermediate values of
393 -- our calculation. (See the comments in Length for more information.)
395 if Count >= Length (Container) then
396 Container.Last := No_Index;
398 elsif Index_Type'Base'Last
>= Count_Type
'Pos (Count_Type
'Last) then
399 Container
.Last
:= Container
.Last
- Index_Type
'Base (Count
);
403 Index_Type
'Base (Count_Type
'Base (Container
.Last
) - Count
);
413 Index
: Index_Type
) return Element_Type
416 if Index
> Container
.Last
then
417 raise Constraint_Error
with "Index is out of range";
421 II
: constant Int
'Base := Int
(Index
) - Int
(No_Index
);
422 I
: constant Capacity_Range
:= Capacity_Range
(II
);
425 return Get_Element
(Container
, I
);
433 function Elems
(Container
: in out Vector
) return Maximal_Array_Ptr
is
436 (if Container
.Elements_Ptr
= null then
437 Container
.Elements
'Unrestricted_Access
439 Container
.Elements_Ptr
.all'Unrestricted_Access);
442 function Elemsc
(Container
: Vector
) return Maximal_Array_Ptr_Const
is
445 (if Container
.Elements_Ptr
= null then
446 Container
.Elements
'Unrestricted_Access
448 Container
.Elements_Ptr
.all'Unrestricted_Access);
458 Index
: Index_Type
:= Index_Type
'First) return Extended_Index
461 Last
: constant Index_Type
:= Last_Index
(Container
);
464 K
:= Capacity_Range
(Int
(Index
) - Int
(No_Index
));
465 for Indx
in Index
.. Last
loop
466 if Get_Element
(Container
, K
) = Item
then
480 function First_Element
(Container
: Vector
) return Element_Type
is
482 if Is_Empty
(Container
) then
483 raise Constraint_Error
with "Container is empty";
485 return Get_Element
(Container
, 1);
493 function First_Index
(Container
: Vector
) return Index_Type
is
494 pragma Unreferenced
(Container
);
496 return Index_Type
'First;
503 package body Formal_Model
is
505 -------------------------
506 -- M_Elements_In_Union --
507 -------------------------
509 function M_Elements_In_Union
510 (Container
: M
.Sequence
;
512 Right
: M
.Sequence
) return Boolean
515 for Index
in Index_Type
'First .. M
.Last
(Container
) loop
517 Elem
: constant Element_Type
:= Element
(Container
, Index
);
519 if not M
.Contains
(Left
, Index_Type
'First, M
.Last
(Left
), Elem
)
522 (Right
, Index_Type
'First, M
.Last
(Right
), Elem
)
530 end M_Elements_In_Union
;
532 -------------------------
533 -- M_Elements_Included --
534 -------------------------
536 function M_Elements_Included
538 L_Fst
: Index_Type
:= Index_Type
'First;
539 L_Lst
: Extended_Index
;
541 R_Fst
: Index_Type
:= Index_Type
'First;
542 R_Lst
: Extended_Index
) return Boolean
545 for I
in L_Fst
.. L_Lst
loop
547 Found
: Boolean := False;
548 J
: Extended_Index
:= R_Fst
- 1;
551 while not Found
and J
< R_Lst
loop
553 if Element
(Left
, I
) = Element
(Right
, J
) then
565 end M_Elements_Included
;
567 -------------------------
568 -- M_Elements_Reversed --
569 -------------------------
571 function M_Elements_Reversed
573 Right
: M
.Sequence
) return Boolean
575 L
: constant Index_Type
:= M
.Last
(Left
);
578 if L
/= M
.Last
(Right
) then
582 for I
in Index_Type
'First .. L
loop
583 if Element
(Left
, I
) /= Element
(Right
, L
- I
+ 1)
590 end M_Elements_Reversed
;
592 ------------------------
593 -- M_Elements_Swapted --
594 ------------------------
596 function M_Elements_Swapped
600 Y
: Index_Type
) return Boolean
603 if M
.Length
(Left
) /= M
.Length
(Right
)
604 or else Element
(Left
, X
) /= Element
(Right
, Y
)
605 or else Element
(Left
, Y
) /= Element
(Right
, X
)
610 for I
in Index_Type
'First .. M
.Last
(Left
) loop
611 if I
/= X
and then I
/= Y
612 and then Element
(Left
, I
) /= Element
(Right
, I
)
619 end M_Elements_Swapped
;
625 function Model
(Container
: Vector
) return M
.Sequence
is
629 for Position
in 1 .. Length
(Container
) loop
630 R
:= M
.Add
(R
, E
(Elemsc
(Container
) (Position
)));
638 ---------------------
639 -- Generic_Sorting --
640 ---------------------
642 package body Generic_Sorting
with SPARK_Mode
=> Off
is
648 package body Formal_Model
is
650 -----------------------
651 -- M_Elements_Sorted --
652 -----------------------
654 function M_Elements_Sorted
(Container
: M
.Sequence
) return Boolean is
656 if M
.Length
(Container
) = 0 then
661 E1
: Element_Type
:= Element
(Container
, Index_Type
'First);
664 for I
in Index_Type
'First + 1 .. M
.Last
(Container
) loop
666 E2
: constant Element_Type
:= Element
(Container
, I
);
679 end M_Elements_Sorted
;
687 function Is_Sorted
(Container
: Vector
) return Boolean is
688 L
: constant Capacity_Range
:= Length
(Container
);
691 for J
in 1 .. L
- 1 loop
692 if Get_Element
(Container
, J
+ 1) < Get_Element
(Container
, J
) then
704 procedure Sort
(Container
: in out Vector
) is
705 function "<" (Left
: Holder
; Right
: Holder
) return Boolean is
706 (E
(Left
) < E
(Right
));
708 procedure Sort
is new Generic_Array_Sort
709 (Index_Type
=> Array_Index
,
710 Element_Type
=> Holder
,
711 Array_Type
=> Elements_Array
,
714 Len
: constant Capacity_Range
:= Length
(Container
);
717 if Container
.Last
<= Index_Type
'First then
720 Sort
(Elems
(Container
) (1 .. Len
));
728 procedure Merge
(Target
: in out Vector
; Source
: in out Vector
) is
733 if Target
'Address = Source
'Address then
734 raise Program_Error
with "Target and Source denote same container";
737 if Length
(Source
) = 0 then
741 if Length
(Target
) = 0 then
742 Move
(Target
=> Target
, Source
=> Source
);
746 I
:= Length
(Target
);
749 New_Length
: constant Count_Type
:= I
+ Length
(Source
);
753 and then Current_Capacity
(Target
) < Capacity_Range
(New_Length
)
758 (Current_Capacity
(Target
) * Growth_Factor
,
759 Capacity_Range
(New_Length
)));
762 if Index_Type
'Base'Last >= Count_Type'Pos (Count_Type'Last) then
763 Target.Last := No_Index + Index_Type'Base (New_Length);
767 Index_Type'Base (Count_Type'Base (No_Index) + New_Length);
772 TA : Maximal_Array_Ptr renames Elems (Target);
773 SA : Maximal_Array_Ptr renames Elems (Source);
776 J := Length (Target);
777 while Length (Source) /= 0 loop
779 TA (1 .. J) := SA (1 .. Length (Source));
780 Source.Last := No_Index;
784 if E (SA (Length (Source))) < E (TA (I)) then
789 TA (J) := SA (Length (Source));
790 Source.Last := Source.Last - 1;
806 Position : Capacity_Range) return Element_Type
809 return E (Elemsc (Container) (Position));
818 Position : Extended_Index) return Boolean
821 return Position in First_Index (Container) .. Last_Index (Container);
829 (Container : in out Vector;
830 Before : Extended_Index;
831 New_Item : Element_Type)
834 Insert (Container, Before, New_Item, 1);
838 (Container : in out Vector;
839 Before : Extended_Index;
840 New_Item : Element_Type;
843 J : Count_Type'Base; -- scratch
846 -- Use Insert_Space to create the "hole" (the destination slice)
848 Insert_Space (Container, Before, Count);
850 J := To_Array_Index (Before);
852 Elems (Container) (J .. J - 1 + Count) := (others => H (New_Item));
856 (Container : in out Vector;
857 Before : Extended_Index;
860 N : constant Count_Type := Length (New_Item);
861 B : Count_Type; -- index Before converted to Count_Type
864 if Container'Address = New_Item'Address then
865 raise Program_Error with
866 "Container and New_Item denote same container";
869 -- Use Insert_Space to create the "hole" (the destination slice) into
870 -- which we copy the source items.
872 Insert_Space (Container, Before, Count => N);
875 -- There's nothing else to do here (vetting of parameters was
876 -- performed already in Insert_Space), so we simply return.
881 B := To_Array_Index (Before);
883 Elems (Container) (B .. B + N - 1) := Elemsc (New_Item) (1 .. N);
890 procedure Insert_Space
891 (Container : in out Vector;
892 Before : Extended_Index;
893 Count : Count_Type := 1)
895 Old_Length : constant Count_Type := Length (Container);
897 Max_Length : Count_Type'Base; -- determined from range of Index_Type
898 New_Length : Count_Type'Base; -- sum of current length and Count
900 Index : Index_Type'Base; -- scratch for intermediate values
901 J : Count_Type'Base; -- scratch
904 -- As a precondition on the generic actual Index_Type, the base type
905 -- must include Index_Type'Pred (Index_Type'First); this is the value
906 -- that Container.Last assumes when the vector is empty. However, we do
907 -- not allow that as the value for Index when specifying where the new
908 -- items should be inserted, so we must manually check. (That the user
909 -- is allowed to specify the value at all here is a consequence of the
910 -- declaration of the Extended_Index subtype, which includes the values
911 -- in the base range that immediately precede and immediately follow the
912 -- values in the Index_Type.)
914 if Before < Index_Type'First then
915 raise Constraint_Error with
916 "Before index is out of range (too small)";
919 -- We do allow a value greater than Container.Last to be specified as
920 -- the Index, but only if it's immediately greater. This allows for the
921 -- case of appending items to the back end of the vector. (It is assumed
922 -- that specifying an index value greater than Last + 1 indicates some
923 -- deeper flaw in the caller's algorithm, so that case is treated as a
926 if Before > Container.Last
927 and then Before - 1 > Container.Last
929 raise Constraint_Error with
930 "Before index is out of range (too large)";
933 -- We treat inserting 0 items into the container as a no-op, so we
940 -- There are two constraints we need to satisfy. The first constraint is
941 -- that a container cannot have more than Count_Type'Last elements, so
942 -- we must check the sum of the current length and the insertion
943 -- count. Note that we cannot simply add these values, because of the
944 -- possibility of overflow.
946 if Old_Length > Count_Type'Last - Count then
947 raise Constraint_Error with "Count is out of range";
950 -- It is now safe compute the length of the new vector, without fear of
953 New_Length := Old_Length + Count;
955 -- The second constraint is that the new Last index value cannot exceed
956 -- Index_Type'Last. In each branch below, we calculate the maximum
957 -- length (computed from the range of values in Index_Type), and then
958 -- compare the new length to the maximum length. If the new length is
959 -- acceptable, then we compute the new last index from that.
961 if Index_Type'Base'Last
>= Count_Type
'Pos (Count_Type
'Last) then
963 -- We have to handle the case when there might be more values in the
964 -- range of Index_Type than in the range of Count_Type.
966 if Index_Type
'First <= 0 then
968 -- We know that No_Index (the same as Index_Type'First - 1) is
969 -- less than 0, so it is safe to compute the following sum without
972 Index
:= No_Index
+ Index_Type
'Base (Count_Type
'Last);
974 if Index
<= Index_Type
'Last then
976 -- We have determined that range of Index_Type has at least as
977 -- many values as in Count_Type, so Count_Type'Last is the
978 -- maximum number of items that are allowed.
980 Max_Length
:= Count_Type
'Last;
983 -- The range of Index_Type has fewer values than in Count_Type,
984 -- so the maximum number of items is computed from the range of
987 Max_Length
:= Count_Type
'Base (Index_Type
'Last - No_Index
);
991 -- No_Index is equal or greater than 0, so we can safely compute
992 -- the difference without fear of overflow (which we would have to
993 -- worry about if No_Index were less than 0, but that case is
996 if Index_Type
'Last - No_Index
>= Count_Type
'Pos (Count_Type
'Last)
998 -- We have determined that range of Index_Type has at least as
999 -- many values as in Count_Type, so Count_Type'Last is the
1000 -- maximum number of items that are allowed.
1002 Max_Length
:= Count_Type
'Last;
1005 -- The range of Index_Type has fewer values than in Count_Type,
1006 -- so the maximum number of items is computed from the range of
1009 Max_Length
:= Count_Type
'Base (Index_Type
'Last - No_Index
);
1013 elsif Index_Type
'First <= 0 then
1015 -- We know that No_Index (the same as Index_Type'First - 1) is less
1016 -- than 0, so it is safe to compute the following sum without fear of
1019 J
:= Count_Type
'Base (No_Index
) + Count_Type
'Last;
1021 if J
<= Count_Type
'Base (Index_Type
'Last) then
1023 -- We have determined that range of Index_Type has at least as
1024 -- many values as in Count_Type, so Count_Type'Last is the maximum
1025 -- number of items that are allowed.
1027 Max_Length
:= Count_Type
'Last;
1030 -- The range of Index_Type has fewer values than Count_Type does,
1031 -- so the maximum number of items is computed from the range of
1035 Count_Type
'Base (Index_Type
'Last) - Count_Type
'Base (No_Index
);
1039 -- No_Index is equal or greater than 0, so we can safely compute the
1040 -- difference without fear of overflow (which we would have to worry
1041 -- about if No_Index were less than 0, but that case is handled
1045 Count_Type
'Base (Index_Type
'Last) - Count_Type
'Base (No_Index
);
1048 -- We have just computed the maximum length (number of items). We must
1049 -- now compare the requested length to the maximum length, as we do not
1050 -- allow a vector expand beyond the maximum (because that would create
1051 -- an internal array with a last index value greater than
1052 -- Index_Type'Last, with no way to index those elements).
1054 if New_Length
> Max_Length
then
1055 raise Constraint_Error
with "Count is out of range";
1058 J
:= To_Array_Index
(Before
);
1060 -- Increase the capacity of container if needed
1063 and then Current_Capacity
(Container
) < Capacity_Range
(New_Length
)
1068 (Current_Capacity
(Container
) * Growth_Factor
,
1069 Capacity_Range
(New_Length
)));
1073 EA
: Maximal_Array_Ptr
renames Elems
(Container
);
1076 if Before
<= Container
.Last
then
1078 -- The new items are being inserted before some existing
1079 -- elements, so we must slide the existing elements up to their
1082 EA
(J
+ Count
.. New_Length
) := EA
(J
.. Old_Length
);
1086 if Index_Type
'Base'Last >= Count_Type'Pos (Count_Type'Last) then
1087 Container.Last := No_Index + Index_Type'Base (New_Length);
1091 Index_Type'Base (Count_Type'Base (No_Index) + New_Length);
1099 function Is_Empty (Container : Vector) return Boolean is
1101 return Last_Index (Container) < Index_Type'First;
1108 function Last_Element (Container : Vector) return Element_Type is
1110 if Is_Empty (Container) then
1111 raise Constraint_Error with "Container is empty";
1113 return Get_Element (Container, Length (Container));
1121 function Last_Index (Container : Vector) return Extended_Index is
1123 return Container.Last;
1130 function Length (Container : Vector) return Capacity_Range is
1131 L : constant Int := Int (Container.Last);
1132 F : constant Int := Int (Index_Type'First);
1133 N : constant Int'Base := L - F + 1;
1136 return Capacity_Range (N);
1143 procedure Move (Target : in out Vector; Source : in out Vector) is
1144 LS : constant Capacity_Range := Length (Source);
1147 if Target'Address = Source'Address then
1151 if Bounded and then Target.Capacity < LS then
1152 raise Constraint_Error;
1156 Append (Target, Source);
1164 procedure Prepend (Container : in out Vector; New_Item : Vector) is
1166 Insert (Container, Index_Type'First, New_Item);
1169 procedure Prepend (Container : in out Vector; New_Item : Element_Type) is
1171 Prepend (Container, New_Item, 1);
1175 (Container : in out Vector;
1176 New_Item : Element_Type;
1180 Insert (Container, Index_Type'First, New_Item, Count);
1183 ---------------------
1184 -- Replace_Element --
1185 ---------------------
1187 procedure Replace_Element
1188 (Container : in out Vector;
1190 New_Item : Element_Type)
1193 if Index > Container.Last then
1194 raise Constraint_Error with "Index is out of range";
1198 II : constant Int'Base := Int (Index) - Int (No_Index);
1199 I : constant Capacity_Range := Capacity_Range (II);
1202 Elems (Container) (I) := H (New_Item);
1204 end Replace_Element;
1206 ----------------------
1207 -- Reserve_Capacity --
1208 ----------------------
1210 procedure Reserve_Capacity
1211 (Container : in out Vector;
1212 Capacity : Capacity_Range)
1216 if Capacity > Container.Capacity then
1217 raise Constraint_Error with "Capacity is out of range";
1221 if Capacity > Current_Capacity (Container) then
1223 New_Elements : constant Elements_Array_Ptr :=
1224 new Elements_Array (1 .. Capacity);
1225 L : constant Capacity_Range := Length (Container);
1228 New_Elements (1 .. L) := Elemsc (Container) (1 .. L);
1229 Free (Container.Elements_Ptr);
1230 Container.Elements_Ptr := New_Elements;
1234 end Reserve_Capacity;
1236 ----------------------
1237 -- Reverse_Elements --
1238 ----------------------
1240 procedure Reverse_Elements (Container : in out Vector) is
1242 if Length (Container) <= 1 then
1249 E : Elements_Array renames
1250 Elems (Container) (1 .. Length (Container));
1254 J := Length (Container);
1257 EI : constant Holder := E (I);
1268 end Reverse_Elements;
1270 ------------------------
1271 -- Reverse_Find_Index --
1272 ------------------------
1274 function Reverse_Find_Index
1275 (Container : Vector;
1276 Item : Element_Type;
1277 Index : Index_Type := Index_Type'Last) return Extended_Index
1279 Last : Index_Type'Base;
1283 if Index > Last_Index (Container) then
1284 Last := Last_Index (Container);
1289 K := Capacity_Range (Int (Last) - Int (No_Index));
1290 for Indx in reverse Index_Type'First .. Last loop
1291 if Get_Element (Container, K) = Item then
1299 end Reverse_Find_Index;
1306 (Container : in out Vector;
1311 if I > Container.Last then
1312 raise Constraint_Error with "I index is out of range";
1315 if J > Container.Last then
1316 raise Constraint_Error with "J index is out of range";
1324 II : constant Int'Base := Int (I) - Int (No_Index);
1325 JJ : constant Int'Base := Int (J) - Int (No_Index);
1327 EI : Holder renames Elems (Container) (Capacity_Range (II));
1328 EJ : Holder renames Elems (Container) (Capacity_Range (JJ));
1330 EI_Copy : constant Holder := EI;
1338 --------------------
1339 -- To_Array_Index --
1340 --------------------
1342 function To_Array_Index (Index : Index_Type'Base) return Count_Type'Base is
1343 Offset : Count_Type'Base;
1347 -- Index >= Index_Type'First
1348 -- hence we also know that
1349 -- Index - Index_Type'First >= 0
1351 -- The issue is that even though 0 is guaranteed to be a value in the
1352 -- type Index_Type'Base, there's no guarantee that the difference is a
1353 -- value in that type. To prevent overflow we use the wider of
1354 -- Count_Type'Base and Index_Type'Base to perform intermediate
1357 if Index_Type'Base'Last
>= Count_Type
'Pos (Count_Type
'Last) then
1358 Offset
:= Count_Type
'Base (Index
- Index_Type
'First);
1361 Offset
:= Count_Type
'Base (Index
) -
1362 Count_Type
'Base (Index_Type
'First);
1365 -- The array index subtype for all container element arrays always
1376 (New_Item
: Element_Type
;
1377 Length
: Capacity_Range
) return Vector
1381 return Empty_Vector
;
1385 First
: constant Int
:= Int
(Index_Type
'First);
1386 Last_As_Int
: constant Int
'Base := First
+ Int
(Length
) - 1;
1390 if Last_As_Int
> Index_Type
'Pos (Index_Type
'Last) then
1391 raise Constraint_Error
with "Length is out of range"; -- ???
1394 Last
:= Index_Type
(Last_As_Int
);
1397 (Capacity
=> Length
,
1400 Elements
=> (others => H
(New_Item
)));
1404 end Ada
.Containers
.Formal_Indefinite_Vectors
;