1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.VECTORS --
9 -- Copyright (C) 2004 Free Software Foundation, Inc. --
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. --
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 2, 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. See the GNU General Public License --
21 -- for more details. You should have received a copy of the GNU General --
22 -- Public License distributed with GNAT; see file COPYING. If not, write --
23 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
24 -- MA 02111-1307, USA. --
26 -- As a special exception, if other files instantiate generics from this --
27 -- unit, or you link this unit with other files to produce an executable, --
28 -- this unit does not by itself cause the resulting executable to be --
29 -- covered by the GNU General Public License. This exception does not --
30 -- however invalidate any other reasons why the executable file might be --
31 -- covered by the GNU Public License. --
33 -- This unit was originally developed by Matthew J Heaney. --
34 ------------------------------------------------------------------------------
36 with Ada.Containers.Generic_Array_Sort;
37 with Ada.Unchecked_Deallocation;
39 with System; use type System.Address;
41 package body Ada.Containers.Vectors is
43 type Int is range System.Min_Int .. System.Max_Int;
46 new Ada.Unchecked_Deallocation (Elements_Type, Elements_Access);
52 function "&" (Left, Right : Vector) return Vector is
53 LN : constant Count_Type := Length (Left);
54 RN : constant Count_Type := Length (Right);
63 RE : Elements_Type renames
64 Right.Elements (Index_Type'First .. Right.Last);
66 Elements : constant Elements_Access :=
67 new Elements_Type'(RE);
70 return (Controlled with Elements, Right.Last);
76 LE : Elements_Type renames
77 Left.Elements (Index_Type'First .. Left.Last);
79 Elements : constant Elements_Access :=
80 new Elements_Type'(LE);
83 return (Controlled with Elements, Left.Last);
89 Last_As_Int : constant Int'Base :=
90 Int (Index_Type'First) + Int (LN) + Int (RN) - 1;
92 Last : constant Index_Type := Index_Type (Last_As_Int);
94 LE : Elements_Type renames
95 Left.Elements (Index_Type'First .. Left.Last);
97 RE : Elements_Type renames
98 Right.Elements (Index_Type'First .. Right.Last);
100 Elements : constant Elements_Access :=
101 new Elements_Type'(LE & RE);
104 return (Controlled with Elements, Last);
108 function "&" (Left : Vector; Right : Element_Type) return Vector is
109 LN : constant Count_Type := Length (Left);
114 subtype Elements_Subtype is
115 Elements_Type (Index_Type'First .. Index_Type'First);
117 Elements : constant Elements_Access :=
118 new Elements_Subtype'(others => Right);
121 return (Controlled with Elements, Index_Type'First);
126 Last_As_Int : constant Int'Base :=
127 Int (Index_Type'First) + Int (LN);
129 Last : constant Index_Type := Index_Type (Last_As_Int);
131 LE : Elements_Type renames
132 Left.Elements (Index_Type'First .. Left.Last);
134 subtype ET is Elements_Type (Index_Type'First .. Last);
136 Elements : constant Elements_Access := new ET'(LE & Right);
139 return (Controlled with Elements, Last);
143 function "&" (Left : Element_Type; Right : Vector) return Vector is
144 RN : constant Count_Type := Length (Right);
149 subtype Elements_Subtype is
150 Elements_Type (Index_Type'First .. Index_Type'First);
152 Elements : constant Elements_Access :=
153 new Elements_Subtype'(others => Left);
156 return (Controlled with Elements, Index_Type'First);
161 Last_As_Int : constant Int'Base :=
162 Int (Index_Type'First) + Int (RN);
164 Last : constant Index_Type := Index_Type (Last_As_Int);
166 RE : Elements_Type renames
167 Right.Elements (Index_Type'First .. Right.Last);
169 subtype ET is Elements_Type (Index_Type'First .. Last);
171 Elements : constant Elements_Access := new ET'(Left & RE);
174 return (Controlled with Elements, Last);
178 function "&" (Left, Right : Element_Type) return Vector is
179 subtype IT is Index_Type'Base range
180 Index_Type'First .. Index_Type'Succ (Index_Type'First);
182 subtype ET is Elements_Type (IT);
184 Elements : constant Elements_Access := new ET'(Left, Right);
187 return Vector'(Controlled with Elements, Elements'Last);
194 function "=" (Left, Right : Vector) return Boolean is
196 if Left'Address = Right'Address then
200 if Left.Last /= Right.Last then
204 for J in Index_Type range Index_Type'First .. Left.Last loop
205 if Left.Elements (J) /= Right.Elements (J) then
217 procedure Adjust (Container : in out Vector) is
219 if Container.Elements = null then
223 if Container.Elements'Length = 0
224 or else Container.Last < Index_Type'First
226 Container.Elements := null;
231 X : constant Elements_Access := Container.Elements;
232 L : constant Index_Type'Base := Container.Last;
233 E : Elements_Type renames X (Index_Type'First .. L);
235 Container.Elements := null;
236 Container.Last := Index_Type'Pred (Index_Type'First);
237 Container.Elements := new Elements_Type'(E);
246 procedure Append (Container : in out Vector; New_Item : Vector) is
248 if Is_Empty (New_Item) then
254 Index_Type'Succ (Container.Last),
259 (Container : in out Vector;
260 New_Item : Element_Type;
261 Count : Count_Type := 1)
270 Index_Type'Succ (Container.Last),
280 (Target : in out Vector;
283 N : constant Count_Type := Length (Source);
286 if Target'Address = Source'Address then
296 if N > Capacity (Target) then
297 Reserve_Capacity (Target, Capacity => N);
300 Target.Elements (Index_Type'First .. Source.Last) :=
301 Source.Elements (Index_Type'First .. Source.Last);
303 Target.Last := Source.Last;
310 function Capacity (Container : Vector) return Count_Type is
312 if Container.Elements = null then
316 return Container.Elements'Length;
323 procedure Clear (Container : in out Vector) is
325 Container.Last := Index_Type'Pred (Index_Type'First);
334 Item : Element_Type) return Boolean
337 return Find_Index (Container, Item) /= No_Index;
345 (Container : in out Vector;
346 Index : Extended_Index;
347 Count : Count_Type := 1)
355 subtype I_Subtype is Index_Type'Base range
356 Index_Type'First .. Container.Last;
358 I : constant I_Subtype := Index;
359 -- TODO: not sure whether to relax this check ???
361 I_As_Int : constant Int := Int (I);
363 Old_Last_As_Int : constant Int := Index_Type'Pos (Container.Last);
365 Count1 : constant Int'Base := Count_Type'Pos (Count);
366 Count2 : constant Int'Base := Old_Last_As_Int - I_As_Int + 1;
368 N : constant Int'Base := Int'Min (Count1, Count2);
370 J_As_Int : constant Int'Base := I_As_Int + N;
371 J : constant Index_Type'Base := Index_Type'Base (J_As_Int);
373 E : Elements_Type renames Container.Elements.all;
375 New_Last_As_Int : constant Int'Base := Old_Last_As_Int - N;
377 New_Last : constant Extended_Index :=
378 Extended_Index (New_Last_As_Int);
381 E (I .. New_Last) := E (J .. Container.Last);
382 Container.Last := New_Last;
387 (Container : in out Vector;
388 Position : in out Cursor;
389 Count : Count_Type := 1)
393 if Position.Container /= null
394 and then Position.Container /=
395 Vector_Access'(Container'Unchecked_Access)
400 if Position.Container = null
401 or else Position.Index > Container.Last
403 Position := No_Element;
407 Delete (Container, Position.Index, Count);
409 if Position.Index <= Container.Last then
410 Position := (Container'Unchecked_Access, Position.Index);
412 Position := No_Element;
420 procedure Delete_First
421 (Container : in out Vector;
422 Count : Count_Type := 1)
429 if Count >= Length (Container) then
434 Delete (Container, Index_Type'First, Count);
441 procedure Delete_Last
442 (Container : in out Vector;
443 Count : Count_Type := 1)
452 if Count >= Length (Container) then
457 Index := Int'Base (Container.Last) - Int'Base (Count) + 1;
459 Delete (Container, Index_Type'Base (Index), Count);
468 Index : Index_Type) return Element_Type
470 subtype T is Index_Type'Base range
471 Index_Type'First .. Container.Last;
473 return Container.Elements (T'(Index));
476 function Element (Position : Cursor) return Element_Type is
478 return Element (Position.Container.all, Position.Index);
485 procedure Finalize (Container : in out Vector) is
486 X : Elements_Access := Container.Elements;
488 Container.Elements := null;
489 Container.Last := Index_Type'Pred (Index_Type'First);
500 Position : Cursor := No_Element) return Cursor is
503 if Position.Container /= null
504 and then Position.Container /=
505 Vector_Access'(Container'Unchecked_Access)
510 for J in Position.Index .. Container.Last loop
511 if Container.Elements (J) = Item then
512 return (Container'Unchecked_Access, J);
526 Index : Index_Type := Index_Type'First) return Extended_Index is
528 for Indx in Index .. Container.Last loop
529 if Container.Elements (Indx) = Item then
541 function First (Container : Vector) return Cursor is
543 if Is_Empty (Container) then
547 return (Container'Unchecked_Access, Index_Type'First);
554 function First_Element (Container : Vector) return Element_Type is
556 return Element (Container, Index_Type'First);
563 function First_Index (Container : Vector) return Index_Type is
564 pragma Unreferenced (Container);
566 return Index_Type'First;
573 procedure Generic_Sort (Container : Vector)
576 new Generic_Array_Sort
577 (Index_Type => Index_Type,
578 Element_Type => Element_Type,
579 Array_Type => Elements_Type,
583 if Container.Elements = null then
587 Sort (Container.Elements (Index_Type'First .. Container.Last));
594 function Has_Element (Position : Cursor) return Boolean is
596 if Position.Container = null then
600 return Position.Index <= Position.Container.Last;
608 (Container : in out Vector;
609 Before : Extended_Index;
610 New_Item : Element_Type;
611 Count : Count_Type := 1)
613 Old_Last : constant Extended_Index := Container.Last;
615 Old_Last_As_Int : constant Int := Index_Type'Pos (Old_Last);
617 N : constant Int := Count_Type'Pos (Count);
619 New_Last_As_Int : constant Int'Base := Old_Last_As_Int + N;
621 New_Last : constant Extended_Index := Extended_Index (New_Last_As_Int);
625 Dst_Last : Index_Type;
626 Dst : Elements_Access;
634 subtype Before_Subtype is Index_Type'Base range
635 Index_Type'First .. Index_Type'Succ (Container.Last);
637 Old_First : constant Before_Subtype := Before;
639 Old_First_As_Int : constant Int := Index_Type'Pos (Old_First);
641 New_First_As_Int : constant Int'Base := Old_First_As_Int + N;
644 Index := Index_Type (New_First_As_Int);
647 if Container.Elements = null then
649 subtype Elements_Subtype is
650 Elements_Type (Index_Type'First .. New_Last);
652 Container.Elements := new Elements_Subtype'(others => New_Item);
655 Container.Last := New_Last;
659 if New_Last <= Container.Elements'Last then
661 E : Elements_Type renames Container.Elements.all;
663 E (Index .. New_Last) := E (Before .. Container.Last);
664 E (Before .. Index_Type'Pred (Index)) := (others => New_Item);
667 Container.Last := New_Last;
672 First : constant Int := Int (Index_Type'First);
674 New_Size : constant Int'Base := New_Last_As_Int - First + 1;
675 Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
677 Size, Dst_Last_As_Int : Int'Base;
680 if New_Size >= Max_Size / 2 then
681 Dst_Last := Index_Type'Last;
684 Size := Container.Elements'Length;
690 while Size < New_Size loop
694 Dst_Last_As_Int := First + Size - 1;
695 Dst_Last := Index_Type (Dst_Last_As_Int);
699 Dst := new Elements_Type (Index_Type'First .. Dst_Last);
702 Src : Elements_Type renames Container.Elements.all;
705 Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
706 Src (Index_Type'First .. Index_Type'Pred (Before));
708 Dst (Before .. Index_Type'Pred (Index)) :=
709 (others => New_Item);
711 Dst (Index .. New_Last) :=
712 Src (Before .. Container.Last);
721 X : Elements_Access := Container.Elements;
723 Container.Elements := Dst;
724 Container.Last := New_Last;
730 (Container : in out Vector;
731 Before : Extended_Index;
734 N : constant Count_Type := Length (New_Item);
741 Insert_Space (Container, Before, Count => N);
744 Dst_Last_As_Int : constant Int'Base :=
745 Int'Base (Before) + Int'Base (N) - 1;
747 Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int);
750 if Container'Address = New_Item'Address then
752 subtype Src_Index_Subtype is Index_Type'Base range
753 Index_Type'First .. Index_Type'Pred (Before);
755 Src : Elements_Type renames
756 Container.Elements (Src_Index_Subtype);
758 Index_As_Int : constant Int'Base :=
759 Int (Before) + Src'Length - 1;
761 Index : constant Index_Type'Base :=
762 Index_Type'Base (Index_As_Int);
764 Dst : Elements_Type renames
765 Container.Elements (Before .. Index);
772 subtype Src_Index_Subtype is Index_Type'Base range
773 Index_Type'Succ (Dst_Last) .. Container.Last;
775 Src : Elements_Type renames
776 Container.Elements (Src_Index_Subtype);
778 Index_As_Int : constant Int'Base :=
779 Dst_Last_As_Int - Src'Length + 1;
781 Index : constant Index_Type'Base :=
782 Index_Type'Base (Index_As_Int);
784 Dst : Elements_Type renames
785 Container.Elements (Index .. Dst_Last);
792 Container.Elements (Before .. Dst_Last) :=
793 New_Item.Elements (Index_Type'First .. New_Item.Last);
799 (Container : in out Vector;
803 Index : Index_Type'Base;
806 if Before.Container /= null
807 and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
812 if Is_Empty (New_Item) then
816 if Before.Container = null
817 or else Before.Index > Container.Last
819 Index := Index_Type'Succ (Container.Last);
821 Index := Before.Index;
824 Insert (Container, Index, New_Item);
828 (Container : in out Vector;
831 Position : out Cursor)
833 Index : Index_Type'Base;
836 if Before.Container /= null
837 and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
842 if Is_Empty (New_Item) then
843 if Before.Container = null
844 or else Before.Index > Container.Last
846 Position := No_Element;
848 Position := (Container'Unchecked_Access, Before.Index);
854 if Before.Container = null
855 or else Before.Index > Container.Last
857 Index := Index_Type'Succ (Container.Last);
859 Index := Before.Index;
862 Insert (Container, Index, New_Item);
864 Position := Cursor'(Container'Unchecked_Access, Index);
868 (Container : in out Vector;
870 New_Item : Element_Type;
871 Count : Count_Type := 1)
873 Index : Index_Type'Base;
876 if Before.Container /= null
877 and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
886 if Before.Container = null
887 or else Before.Index > Container.Last
889 Index := Index_Type'Succ (Container.Last);
891 Index := Before.Index;
894 Insert (Container, Index, New_Item, Count);
898 (Container : in out Vector;
900 New_Item : Element_Type;
901 Position : out Cursor;
902 Count : Count_Type := 1)
904 Index : Index_Type'Base;
907 if Before.Container /= null
908 and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
914 if Before.Container = null
915 or else Before.Index > Container.Last
917 Position := No_Element;
919 Position := (Container'Unchecked_Access, Before.Index);
925 if Before.Container = null
926 or else Before.Index > Container.Last
928 Index := Index_Type'Succ (Container.Last);
930 Index := Before.Index;
933 Insert (Container, Index, New_Item, Count);
935 Position := Cursor'(Container'Unchecked_Access, Index);
942 procedure Insert_Space
943 (Container : in out Vector;
944 Before : Extended_Index;
945 Count : Count_Type := 1)
947 Old_Last : constant Extended_Index := Container.Last;
949 Old_Last_As_Int : constant Int := Index_Type'Pos (Old_Last);
951 N : constant Int := Count_Type'Pos (Count);
953 New_Last_As_Int : constant Int'Base := Old_Last_As_Int + N;
955 New_Last : constant Extended_Index := Extended_Index (New_Last_As_Int);
959 Dst_Last : Index_Type;
960 Dst : Elements_Access;
968 subtype Before_Subtype is Index_Type'Base range
969 Index_Type'First .. Index_Type'Succ (Container.Last);
971 Old_First : constant Before_Subtype := Before;
973 Old_First_As_Int : constant Int := Index_Type'Pos (Old_First);
975 New_First_As_Int : constant Int'Base := Old_First_As_Int + N;
978 Index := Index_Type (New_First_As_Int);
981 if Container.Elements = null then
982 Container.Elements :=
983 new Elements_Type (Index_Type'First .. New_Last);
985 Container.Last := New_Last;
989 if New_Last <= Container.Elements'Last then
991 E : Elements_Type renames Container.Elements.all;
993 E (Index .. New_Last) := E (Before .. Container.Last);
996 Container.Last := New_Last;
1001 First : constant Int := Int (Index_Type'First);
1003 New_Size : constant Int'Base := New_Last_As_Int - First + 1;
1004 Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
1006 Size, Dst_Last_As_Int : Int'Base;
1009 if New_Size >= Max_Size / 2 then
1010 Dst_Last := Index_Type'Last;
1013 Size := Container.Elements'Length;
1019 while Size < New_Size loop
1023 Dst_Last_As_Int := First + Size - 1;
1024 Dst_Last := Index_Type (Dst_Last_As_Int);
1028 Dst := new Elements_Type (Index_Type'First .. Dst_Last);
1031 Src : Elements_Type renames Container.Elements.all;
1034 Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
1035 Src (Index_Type'First .. Index_Type'Pred (Before));
1037 Dst (Index .. New_Last) :=
1038 Src (Before .. Container.Last);
1047 X : Elements_Access := Container.Elements;
1049 Container.Elements := Dst;
1050 Container.Last := New_Last;
1056 procedure Insert_Space
1057 (Container : in out Vector;
1059 Position : out Cursor;
1060 Count : Count_Type := 1)
1062 Index : Index_Type'Base;
1065 if Before.Container /= null
1066 and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
1068 raise Program_Error;
1072 if Before.Container = null
1073 or else Before.Index > Container.Last
1075 Position := No_Element;
1077 Position := (Container'Unchecked_Access, Before.Index);
1083 if Before.Container = null
1084 or else Before.Index > Container.Last
1086 Index := Index_Type'Succ (Container.Last);
1088 Index := Before.Index;
1091 Insert_Space (Container, Index, Count);
1093 Position := Cursor'(Container'Unchecked_Access, Index);
1100 function Is_Empty (Container : Vector) return Boolean is
1102 return Container.Last < Index_Type'First;
1110 (Container : Vector;
1111 Process : not null access procedure (Position : Cursor))
1114 for Indx in Index_Type'First .. Container.Last loop
1115 Process (Cursor'(Container'Unchecked_Access, Indx));
1123 function Last (Container : Vector) return Cursor is
1125 if Is_Empty (Container) then
1129 return (Container'Unchecked_Access, Container.Last);
1136 function Last_Element (Container : Vector) return Element_Type is
1138 return Element (Container, Container.Last);
1145 function Last_Index (Container : Vector) return Extended_Index is
1147 return Container.Last;
1154 function Length (Container : Vector) return Count_Type is
1155 L : constant Int := Int (Container.Last);
1156 F : constant Int := Int (Index_Type'First);
1157 N : constant Int'Base := L - F + 1;
1159 return Count_Type (N);
1167 (Target : in out Vector;
1168 Source : in out Vector)
1170 X : Elements_Access := Target.Elements;
1173 if Target'Address = Source'Address then
1177 if Target.Last >= Index_Type'First then
1178 raise Constraint_Error;
1181 Target.Elements := null;
1184 Target.Elements := Source.Elements;
1185 Target.Last := Source.Last;
1187 Source.Elements := null;
1188 Source.Last := Index_Type'Pred (Index_Type'First);
1195 function Next (Position : Cursor) return Cursor is
1197 if Position.Container = null then
1201 if Position.Index < Position.Container.Last then
1202 return (Position.Container, Index_Type'Succ (Position.Index));
1212 procedure Next (Position : in out Cursor) is
1214 if Position.Container = null then
1218 if Position.Index < Position.Container.Last then
1219 Position.Index := Index_Type'Succ (Position.Index);
1221 Position := No_Element;
1229 procedure Prepend (Container : in out Vector; New_Item : Vector) is
1231 Insert (Container, Index_Type'First, New_Item);
1235 (Container : in out Vector;
1236 New_Item : Element_Type;
1237 Count : Count_Type := 1)
1250 procedure Previous (Position : in out Cursor) is
1252 if Position.Container = null then
1256 if Position.Index > Index_Type'First then
1257 Position.Index := Index_Type'Pred (Position.Index);
1259 Position := No_Element;
1263 function Previous (Position : Cursor) return Cursor is
1265 if Position.Container = null then
1269 if Position.Index > Index_Type'First then
1270 return (Position.Container, Index_Type'Pred (Position.Index));
1280 procedure Query_Element
1281 (Container : Vector;
1283 Process : not null access procedure (Element : Element_Type))
1285 subtype T is Index_Type'Base range
1286 Index_Type'First .. Container.Last;
1288 Process (Container.Elements (T'(Index)));
1291 procedure Query_Element
1293 Process : not null access procedure (Element : Element_Type))
1295 Container : Vector renames Position.Container.all;
1297 subtype T is Index_Type'Base range
1298 Index_Type'First .. Container.Last;
1301 Process (Container.Elements (T'(Position.Index)));
1309 (Stream : access Root_Stream_Type'Class;
1310 Container : out Vector)
1312 Length : Count_Type'Base;
1313 Last : Index_Type'Base := Index_Type'Pred (Index_Type'First);
1318 Count_Type'Base'Read (Stream, Length);
1320 if Length > Capacity (Container) then
1321 Reserve_Capacity (Container, Capacity => Length);
1324 for J in Count_Type range 1 .. Length loop
1325 Last := Index_Type'Succ (Last);
1326 Element_Type'Read (Stream, Container.Elements (Last));
1327 Container.Last := Last;
1331 ---------------------
1332 -- Replace_Element --
1333 ---------------------
1335 procedure Replace_Element
1336 (Container : Vector;
1340 subtype T is Index_Type'Base range
1341 Index_Type'First .. Container.Last;
1343 Container.Elements (T'(Index)) := By;
1344 end Replace_Element;
1346 procedure Replace_Element (Position : Cursor; By : Element_Type) is
1347 subtype T is Index_Type'Base range
1348 Index_Type'First .. Position.Container.Last;
1350 Position.Container.Elements (T'(Position.Index)) := By;
1351 end Replace_Element;
1353 ----------------------
1354 -- Reserve_Capacity --
1355 ----------------------
1357 procedure Reserve_Capacity
1358 (Container : in out Vector;
1359 Capacity : Count_Type)
1361 N : constant Count_Type := Length (Container);
1364 if Capacity = 0 then
1367 X : Elements_Access := Container.Elements;
1369 Container.Elements := null;
1373 elsif N < Container.Elements'Length then
1375 subtype Array_Index_Subtype is Index_Type'Base range
1376 Index_Type'First .. Container.Last;
1378 Src : Elements_Type renames
1379 Container.Elements (Array_Index_Subtype);
1381 subtype Array_Subtype is
1382 Elements_Type (Array_Index_Subtype);
1384 X : Elements_Access := Container.Elements;
1387 Container.Elements := new Array_Subtype'(Src);
1395 if Container.Elements = null then
1397 Last_As_Int : constant Int'Base :=
1398 Int (Index_Type'First) + Int (Capacity) - 1;
1400 Last : constant Index_Type := Index_Type (Last_As_Int);
1402 subtype Array_Subtype is
1403 Elements_Type (Index_Type'First .. Last);
1406 Container.Elements := new Array_Subtype;
1412 if Capacity <= N then
1413 if N < Container.Elements'Length then
1415 subtype Array_Index_Subtype is Index_Type'Base range
1416 Index_Type'First .. Container.Last;
1418 Src : Elements_Type renames
1419 Container.Elements (Array_Index_Subtype);
1421 subtype Array_Subtype is
1422 Elements_Type (Array_Index_Subtype);
1424 X : Elements_Access := Container.Elements;
1427 Container.Elements := new Array_Subtype'(Src);
1436 if Capacity = Container.Elements'Length then
1441 Last_As_Int : constant Int'Base :=
1442 Int (Index_Type'First) + Int (Capacity) - 1;
1444 Last : constant Index_Type := Index_Type (Last_As_Int);
1446 subtype Array_Subtype is
1447 Elements_Type (Index_Type'First .. Last);
1449 E : Elements_Access := new Array_Subtype;
1453 Src : Elements_Type renames
1454 Container.Elements (Index_Type'First .. Container.Last);
1456 Tgt : Elements_Type renames
1457 E (Index_Type'First .. Container.Last);
1469 X : Elements_Access := Container.Elements;
1471 Container.Elements := E;
1475 end Reserve_Capacity;
1481 function Reverse_Find
1482 (Container : Vector;
1483 Item : Element_Type;
1484 Position : Cursor := No_Element) return Cursor
1486 Last : Index_Type'Base;
1489 if Position.Container /= null
1490 and then Position.Container /=
1491 Vector_Access'(Container'Unchecked_Access)
1493 raise Program_Error;
1496 if Position.Container = null
1497 or else Position.Index > Container.Last
1499 Last := Container.Last;
1501 Last := Position.Index;
1504 for Indx in reverse Index_Type'First .. Last loop
1505 if Container.Elements (Indx) = Item then
1506 return (Container'Unchecked_Access, Indx);
1513 ------------------------
1514 -- Reverse_Find_Index --
1515 ------------------------
1517 function Reverse_Find_Index
1518 (Container : Vector;
1519 Item : Element_Type;
1520 Index : Index_Type := Index_Type'Last) return Extended_Index
1522 Last : Index_Type'Base;
1525 if Index > Container.Last then
1526 Last := Container.Last;
1531 for Indx in reverse Index_Type'First .. Last loop
1532 if Container.Elements (Indx) = Item then
1538 end Reverse_Find_Index;
1540 ---------------------
1541 -- Reverse_Iterate --
1542 ---------------------
1544 procedure Reverse_Iterate
1545 (Container : Vector;
1546 Process : not null access procedure (Position : Cursor))
1549 for Indx in reverse Index_Type'First .. Container.Last loop
1550 Process (Cursor'(Container'Unchecked_Access, Indx));
1552 end Reverse_Iterate;
1558 procedure Set_Length (Container : in out Vector; Length : Count_Type) is
1566 Last_As_Int : constant Int'Base :=
1567 Int (Index_Type'First) + Int (Length) - 1;
1569 Last : constant Index_Type := Index_Type (Last_As_Int);
1572 if Length > Capacity (Container) then
1573 Reserve_Capacity (Container, Capacity => Length);
1576 Container.Last := Last;
1585 (Container : Vector;
1589 subtype T is Index_Type'Base range
1590 Index_Type'First .. Container.Last;
1592 EI : constant Element_Type := Container.Elements (T'(I));
1596 Container.Elements (T'(I)) := Container.Elements (T'(J));
1597 Container.Elements (T'(J)) := EI;
1601 procedure Swap (I, J : Cursor) is
1603 -- NOTE: The behavior has been liberalized here to
1604 -- allow I and J to designate different containers.
1605 -- TODO: Probably this is supposed to raise P_E ???
1607 subtype TI is Index_Type'Base range
1608 Index_Type'First .. I.Container.Last;
1610 EI : Element_Type renames I.Container.Elements (TI'(I.Index));
1612 EI_Copy : constant Element_Type := EI;
1614 subtype TJ is Index_Type'Base range
1615 Index_Type'First .. J.Container.Last;
1617 EJ : Element_Type renames J.Container.Elements (TJ'(J.Index));
1629 (Container : Vector;
1630 Index : Extended_Index) return Cursor
1633 if Index not in Index_Type'First .. Container.Last then
1637 return Cursor'(Container'Unchecked_Access, Index);
1644 function To_Index (Position : Cursor) return Extended_Index is
1646 if Position.Container = null then
1650 if Position.Index <= Position.Container.Last then
1651 return Position.Index;
1661 function To_Vector (Length : Count_Type) return Vector is
1664 return Empty_Vector;
1668 First : constant Int := Int (Index_Type'First);
1669 Last_As_Int : constant Int'Base := First + Int (Length) - 1;
1670 Last : constant Index_Type := Index_Type (Last_As_Int);
1671 Elements : constant Elements_Access :=
1672 new Elements_Type (Index_Type'First .. Last);
1674 return (Controlled with Elements, Last);
1679 (New_Item : Element_Type;
1680 Length : Count_Type) return Vector
1684 return Empty_Vector;
1688 First : constant Int := Int (Index_Type'First);
1689 Last_As_Int : constant Int'Base := First + Int (Length) - 1;
1690 Last : constant Index_Type := Index_Type (Last_As_Int);
1691 Elements : constant Elements_Access :=
1693 (Index_Type'First .. Last => New_Item);
1695 return (Controlled with Elements, Last);
1699 --------------------
1700 -- Update_Element --
1701 --------------------
1703 procedure Update_Element
1704 (Container : Vector;
1706 Process : not null access procedure (Element : in out Element_Type))
1708 subtype T is Index_Type'Base range
1709 Index_Type'First .. Container.Last;
1711 Process (Container.Elements (T'(Index)));
1714 procedure Update_Element
1716 Process : not null access procedure (Element : in out Element_Type))
1718 subtype T is Index_Type'Base range
1719 Index_Type'First .. Position.Container.Last;
1721 Process (Position.Container.Elements (T'(Position.Index)));
1729 (Stream : access Root_Stream_Type'Class;
1733 Count_Type'Base'Write (Stream, Length (Container));
1735 for J in Index_Type'First .. Container.Last loop
1736 Element_Type'Write (Stream, Container.Elements (J));
1740 end Ada.Containers.Vectors;