Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/libgnat/a-cofove.adb @ 145:1830386684a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
4 -- -- 4 -- --
5 -- A D A . C O N T A I N E R S . F O R M A L _ V E C T O R S -- 5 -- A D A . C O N T A I N E R S . F O R M A L _ V E C T O R S --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 2010-2018, Free Software Foundation, Inc. -- 9 -- Copyright (C) 2010-2019, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 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- -- 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- -- 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- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. -- 25 -- <http://www.gnu.org/licenses/>. --
26 ------------------------------------------------------------------------------ 26 ------------------------------------------------------------------------------
27 27
28 with Ada.Containers.Generic_Array_Sort; 28 with Ada.Containers.Generic_Array_Sort;
29 with Ada.Unchecked_Deallocation;
30 29
31 with System; use type System.Address; 30 with System; use type System.Address;
32 31
33 package body Ada.Containers.Formal_Vectors with 32 package body Ada.Containers.Formal_Vectors with
34 SPARK_Mode => Off 33 SPARK_Mode => Off
35 is 34 is
36 35
37 Growth_Factor : constant := 2;
38 -- When growing a container, multiply current capacity by this. Doubling
39 -- leads to amortized linear-time copying.
40
41 type Int is range System.Min_Int .. System.Max_Int; 36 type Int is range System.Min_Int .. System.Max_Int;
42 37
43 procedure Free is
44 new Ada.Unchecked_Deallocation (Elements_Array, Elements_Array_Ptr);
45
46 type Maximal_Array_Ptr is access all Elements_Array (Array_Index)
47 with Storage_Size => 0;
48 type Maximal_Array_Ptr_Const is access constant Elements_Array (Array_Index)
49 with Storage_Size => 0;
50
51 function Elems (Container : in out Vector) return Maximal_Array_Ptr;
52 function Elemsc
53 (Container : Vector) return Maximal_Array_Ptr_Const;
54 -- Returns a pointer to the Elements array currently in use -- either
55 -- Container.Elements_Ptr or a pointer to Container.Elements. We work with
56 -- pointers to a bogus array subtype that is constrained with the maximum
57 -- possible bounds. This means that the pointer is a thin pointer. This is
58 -- necessary because 'Unrestricted_Access doesn't work when it produces
59 -- access-to-unconstrained and is returned from a function.
60 --
61 -- Note that this is dangerous: make sure calls to this use an indexed
62 -- component or slice that is within the bounds 1 .. Length (Container).
63
64 function Get_Element
65 (Container : Vector;
66 Position : Capacity_Range) return Element_Type;
67
68 function To_Array_Index (Index : Index_Type'Base) return Count_Type'Base; 38 function To_Array_Index (Index : Index_Type'Base) return Count_Type'Base;
69
70 function Current_Capacity (Container : Vector) return Capacity_Range;
71 39
72 procedure Insert_Space 40 procedure Insert_Space
73 (Container : in out Vector; 41 (Container : in out Vector;
74 Before : Extended_Index; 42 Before : Extended_Index;
75 Count : Count_Type := 1); 43 Count : Count_Type := 1);
87 if Length (Left) /= Length (Right) then 55 if Length (Left) /= Length (Right) then
88 return False; 56 return False;
89 end if; 57 end if;
90 58
91 for J in 1 .. Length (Left) loop 59 for J in 1 .. Length (Left) loop
92 if Get_Element (Left, J) /= Get_Element (Right, J) then 60 if Left.Elements (J) /= Right.Elements (J) then
93 return False; 61 return False;
94 end if; 62 end if;
95 end loop; 63 end loop;
96 64
97 return True; 65 return True;
146 begin 114 begin
147 if Target'Address = Source'Address then 115 if Target'Address = Source'Address then
148 return; 116 return;
149 end if; 117 end if;
150 118
151 if Bounded and then Target.Capacity < LS then 119 if Target.Capacity < LS then
152 raise Constraint_Error; 120 raise Constraint_Error;
153 end if; 121 end if;
154 122
155 Clear (Target); 123 Clear (Target);
156 Append (Target, Source); 124 Append (Target, Source);
160 -- Capacity -- 128 -- Capacity --
161 -------------- 129 --------------
162 130
163 function Capacity (Container : Vector) return Capacity_Range is 131 function Capacity (Container : Vector) return Capacity_Range is
164 begin 132 begin
165 return 133 return Container.Capacity;
166 (if Bounded then
167 Container.Capacity
168 else
169 Capacity_Range'Last);
170 end Capacity; 134 end Capacity;
171 135
172 ----------- 136 -----------
173 -- Clear -- 137 -- Clear --
174 ----------- 138 -----------
175 139
176 procedure Clear (Container : in out Vector) is 140 procedure Clear (Container : in out Vector) is
177 begin 141 begin
178 Container.Last := No_Index; 142 Container.Last := No_Index;
179
180 -- Free element, note that this is OK if Elements_Ptr is null
181
182 Free (Container.Elements_Ptr);
183 end Clear; 143 end Clear;
184 144
185 -------------- 145 --------------
186 -- Contains -- 146 -- Contains --
187 -------------- 147 --------------
213 else 173 else
214 raise Capacity_Error; 174 raise Capacity_Error;
215 end if; 175 end if;
216 176
217 return Target : Vector (C) do 177 return Target : Vector (C) do
218 Elems (Target) (1 .. LS) := Elemsc (Source) (1 .. LS); 178 Target.Elements (1 .. LS) := Source.Elements (1 .. LS);
219 Target.Last := Source.Last; 179 Target.Last := Source.Last;
220 end return; 180 end return;
221 end Copy; 181 end Copy;
222
223 ----------------------
224 -- Current_Capacity --
225 ----------------------
226
227 function Current_Capacity (Container : Vector) return Capacity_Range is
228 begin
229 return
230 (if Container.Elements_Ptr = null then
231 Container.Elements'Length
232 else
233 Container.Elements_Ptr.all'Length);
234 end Current_Capacity;
235 182
236 ------------ 183 ------------
237 -- Delete -- 184 -- Delete --
238 ------------ 185 ------------
239 186
331 278
332 -- The array index values for each slice have already been determined, 279 -- The array index values for each slice have already been determined,
333 -- so we just slide down to Index the elements that weren't deleted. 280 -- so we just slide down to Index the elements that weren't deleted.
334 281
335 declare 282 declare
336 EA : Maximal_Array_Ptr renames Elems (Container); 283 EA : Elements_Array renames Container.Elements;
337 Idx : constant Count_Type := EA'First + Off; 284 Idx : constant Count_Type := EA'First + Off;
338 begin 285 begin
339 EA (Idx .. Old_Len - Count) := EA (Idx + Count .. Old_Len); 286 EA (Idx .. Old_Len - Count) := EA (Idx + Count .. Old_Len);
340 Container.Last := New_Last; 287 Container.Last := New_Last;
341 end; 288 end;
416 363
417 declare 364 declare
418 II : constant Int'Base := Int (Index) - Int (No_Index); 365 II : constant Int'Base := Int (Index) - Int (No_Index);
419 I : constant Capacity_Range := Capacity_Range (II); 366 I : constant Capacity_Range := Capacity_Range (II);
420 begin 367 begin
421 return Get_Element (Container, I); 368 return Container.Elements (I);
422 end; 369 end;
423 end Element; 370 end Element;
424
425 -----------
426 -- Elems --
427 -----------
428
429 function Elems (Container : in out Vector) return Maximal_Array_Ptr is
430 begin
431 return
432 (if Container.Elements_Ptr = null then
433 Container.Elements'Unrestricted_Access
434 else
435 Container.Elements_Ptr.all'Unrestricted_Access);
436 end Elems;
437
438 function Elemsc (Container : Vector) return Maximal_Array_Ptr_Const is
439 begin
440 return
441 (if Container.Elements_Ptr = null then
442 Container.Elements'Unrestricted_Access
443 else
444 Container.Elements_Ptr.all'Unrestricted_Access);
445 end Elemsc;
446 371
447 ---------------- 372 ----------------
448 -- Find_Index -- 373 -- Find_Index --
449 ---------------- 374 ----------------
450 375
451 function Find_Index 376 function Find_Index
452 (Container : Vector; 377 (Container : Vector;
453 Item : Element_Type; 378 Item : Element_Type;
454 Index : Index_Type := Index_Type'First) return Extended_Index 379 Index : Index_Type := Index_Type'First) return Extended_Index
455 is 380 is
456 K : Capacity_Range; 381 K : Count_Type;
457 Last : constant Index_Type := Last_Index (Container); 382 Last : constant Extended_Index := Last_Index (Container);
458 383
459 begin 384 begin
460 K := Capacity_Range (Int (Index) - Int (No_Index)); 385 K := Capacity_Range (Int (Index) - Int (No_Index));
461 for Indx in Index .. Last loop 386 for Indx in Index .. Last loop
462 if Get_Element (Container, K) = Item then 387 if Container.Elements (K) = Item then
463 return Indx; 388 return Indx;
464 end if; 389 end if;
465 390
466 K := K + 1; 391 K := K + 1;
467 end loop; 392 end loop;
476 function First_Element (Container : Vector) return Element_Type is 401 function First_Element (Container : Vector) return Element_Type is
477 begin 402 begin
478 if Is_Empty (Container) then 403 if Is_Empty (Container) then
479 raise Constraint_Error with "Container is empty"; 404 raise Constraint_Error with "Container is empty";
480 else 405 else
481 return Get_Element (Container, 1); 406 return Container.Elements (1);
482 end if; 407 end if;
483 end First_Element; 408 end First_Element;
484 409
485 ----------------- 410 -----------------
486 -- First_Index -- 411 -- First_Index --
620 function Model (Container : Vector) return M.Sequence is 545 function Model (Container : Vector) return M.Sequence is
621 R : M.Sequence; 546 R : M.Sequence;
622 547
623 begin 548 begin
624 for Position in 1 .. Length (Container) loop 549 for Position in 1 .. Length (Container) loop
625 R := M.Add (R, Elemsc (Container) (Position)); 550 R := M.Add (R, Container.Elements (Position));
626 end loop; 551 end loop;
627 552
628 return R; 553 return R;
629 end Model; 554 end Model;
630 555
682 function Is_Sorted (Container : Vector) return Boolean is 607 function Is_Sorted (Container : Vector) return Boolean is
683 L : constant Capacity_Range := Length (Container); 608 L : constant Capacity_Range := Length (Container);
684 609
685 begin 610 begin
686 for J in 1 .. L - 1 loop 611 for J in 1 .. L - 1 loop
687 if Get_Element (Container, J + 1) < 612 if Container.Elements (J + 1) <
688 Get_Element (Container, J) 613 Container.Elements (J)
689 then 614 then
690 return False; 615 return False;
691 end if; 616 end if;
692 end loop; 617 end loop;
693 618
710 635
711 begin 636 begin
712 if Container.Last <= Index_Type'First then 637 if Container.Last <= Index_Type'First then
713 return; 638 return;
714 else 639 else
715 Sort (Elems (Container) (1 .. Len)); 640 Sort (Container.Elements (1 .. Len));
716 end if; 641 end if;
717 end Sort; 642 end Sort;
718 643
719 ----------- 644 -----------
720 -- Merge -- 645 -- Merge --
742 667
743 declare 668 declare
744 New_Length : constant Count_Type := I + Length (Source); 669 New_Length : constant Count_Type := I + Length (Source);
745 670
746 begin 671 begin
747 if not Bounded
748 and then Current_Capacity (Target) < Capacity_Range (New_Length)
749 then
750 Reserve_Capacity
751 (Target,
752 Capacity_Range'Max
753 (Current_Capacity (Target) * Growth_Factor,
754 Capacity_Range (New_Length)));
755 end if;
756
757 if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then 672 if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
758 Target.Last := No_Index + Index_Type'Base (New_Length); 673 Target.Last := No_Index + Index_Type'Base (New_Length);
759 674
760 else 675 else
761 Target.Last := 676 Target.Last :=
762 Index_Type'Base (Count_Type'Base (No_Index) + New_Length); 677 Index_Type'Base (Count_Type'Base (No_Index) + New_Length);
763 end if; 678 end if;
764 end; 679 end;
765 680
766 declare 681 declare
767 TA : Maximal_Array_Ptr renames Elems (Target); 682 TA : Elements_Array renames Target.Elements;
768 SA : Maximal_Array_Ptr renames Elems (Source); 683 SA : Elements_Array renames Source.Elements;
769 684
770 begin 685 begin
771 J := Length (Target); 686 J := Length (Target);
772 while Length (Source) /= 0 loop 687 while Length (Source) /= 0 loop
773 if I = 0 then 688 if I = 0 then
791 end Merge; 706 end Merge;
792 707
793 end Generic_Sorting; 708 end Generic_Sorting;
794 709
795 ----------------- 710 -----------------
796 -- Get_Element --
797 -----------------
798
799 function Get_Element
800 (Container : Vector;
801 Position : Capacity_Range) return Element_Type
802 is
803 begin
804 return Elemsc (Container) (Position);
805 end Get_Element;
806
807 -----------------
808 -- Has_Element -- 711 -- Has_Element --
809 ----------------- 712 -----------------
810 713
811 function Has_Element 714 function Has_Element
812 (Container : Vector; 715 (Container : Vector;
842 745
843 Insert_Space (Container, Before, Count); 746 Insert_Space (Container, Before, Count);
844 747
845 J := To_Array_Index (Before); 748 J := To_Array_Index (Before);
846 749
847 Elems (Container) (J .. J - 1 + Count) := (others => New_Item); 750 Container.Elements (J .. J - 1 + Count) := (others => New_Item);
848 end Insert; 751 end Insert;
849 752
850 procedure Insert 753 procedure Insert
851 (Container : in out Vector; 754 (Container : in out Vector;
852 Before : Extended_Index; 755 Before : Extended_Index;
874 return; 777 return;
875 end if; 778 end if;
876 779
877 B := To_Array_Index (Before); 780 B := To_Array_Index (Before);
878 781
879 Elems (Container) (B .. B + N - 1) := Elemsc (New_Item) (1 .. N); 782 Container.Elements (B .. B + N - 1) := New_Item.Elements (1 .. N);
880 end Insert; 783 end Insert;
881 784
882 ------------------ 785 ------------------
883 -- Insert_Space -- 786 -- Insert_Space --
884 ------------------ 787 ------------------
1051 raise Constraint_Error with "Count is out of range"; 954 raise Constraint_Error with "Count is out of range";
1052 end if; 955 end if;
1053 956
1054 J := To_Array_Index (Before); 957 J := To_Array_Index (Before);
1055 958
1056 -- Increase the capacity of container if needed
1057
1058 if not Bounded
1059 and then Current_Capacity (Container) < Capacity_Range (New_Length)
1060 then
1061 Reserve_Capacity
1062 (Container,
1063 Capacity_Range'Max (Current_Capacity (Container) * Growth_Factor,
1064 Capacity_Range (New_Length)));
1065 end if;
1066
1067 declare 959 declare
1068 EA : Maximal_Array_Ptr renames Elems (Container); 960 EA : Elements_Array renames Container.Elements;
1069 961
1070 begin 962 begin
1071 if Before <= Container.Last then 963 if Before <= Container.Last then
1072 964
1073 -- The new items are being inserted before some existing 965 -- The new items are being inserted before some existing
1103 function Last_Element (Container : Vector) return Element_Type is 995 function Last_Element (Container : Vector) return Element_Type is
1104 begin 996 begin
1105 if Is_Empty (Container) then 997 if Is_Empty (Container) then
1106 raise Constraint_Error with "Container is empty"; 998 raise Constraint_Error with "Container is empty";
1107 else 999 else
1108 return Get_Element (Container, Length (Container)); 1000 return Container.Elements (Length (Container));
1109 end if; 1001 end if;
1110 end Last_Element; 1002 end Last_Element;
1111 1003
1112 ---------------- 1004 ----------------
1113 -- Last_Index -- 1005 -- Last_Index --
1141 begin 1033 begin
1142 if Target'Address = Source'Address then 1034 if Target'Address = Source'Address then
1143 return; 1035 return;
1144 end if; 1036 end if;
1145 1037
1146 if Bounded and then Target.Capacity < LS then 1038 if Target.Capacity < LS then
1147 raise Constraint_Error; 1039 raise Constraint_Error;
1148 end if; 1040 end if;
1149 1041
1150 Clear (Target); 1042 Clear (Target);
1151 Append (Target, Source); 1043 Append (Target, Source);
1192 declare 1084 declare
1193 II : constant Int'Base := Int (Index) - Int (No_Index); 1085 II : constant Int'Base := Int (Index) - Int (No_Index);
1194 I : constant Capacity_Range := Capacity_Range (II); 1086 I : constant Capacity_Range := Capacity_Range (II);
1195 1087
1196 begin 1088 begin
1197 Elems (Container) (I) := New_Item; 1089 Container.Elements (I) := New_Item;
1198 end; 1090 end;
1199 end Replace_Element; 1091 end Replace_Element;
1200 1092
1201 ---------------------- 1093 ----------------------
1202 -- Reserve_Capacity -- 1094 -- Reserve_Capacity --
1205 procedure Reserve_Capacity 1097 procedure Reserve_Capacity
1206 (Container : in out Vector; 1098 (Container : in out Vector;
1207 Capacity : Capacity_Range) 1099 Capacity : Capacity_Range)
1208 is 1100 is
1209 begin 1101 begin
1210 if Bounded then 1102 if Capacity > Container.Capacity then
1211 if Capacity > Container.Capacity then 1103 raise Constraint_Error with "Capacity is out of range";
1212 raise Constraint_Error with "Capacity is out of range";
1213 end if;
1214
1215 else
1216 if Capacity > Formal_Vectors.Current_Capacity (Container) then
1217 declare
1218 New_Elements : constant Elements_Array_Ptr :=
1219 new Elements_Array (1 .. Capacity);
1220 L : constant Capacity_Range := Length (Container);
1221
1222 begin
1223 New_Elements (1 .. L) := Elemsc (Container) (1 .. L);
1224 Free (Container.Elements_Ptr);
1225 Container.Elements_Ptr := New_Elements;
1226 end;
1227 end if;
1228 end if; 1104 end if;
1229 end Reserve_Capacity; 1105 end Reserve_Capacity;
1230 1106
1231 ---------------------- 1107 ----------------------
1232 -- Reverse_Elements -- 1108 -- Reverse_Elements --
1239 end if; 1115 end if;
1240 1116
1241 declare 1117 declare
1242 I, J : Capacity_Range; 1118 I, J : Capacity_Range;
1243 E : Elements_Array renames 1119 E : Elements_Array renames
1244 Elems (Container) (1 .. Length (Container)); 1120 Container.Elements (1 .. Length (Container));
1245 1121
1246 begin 1122 begin
1247 I := 1; 1123 I := 1;
1248 J := Length (Container); 1124 J := Length (Container);
1249 while I < J loop 1125 while I < J loop
1269 (Container : Vector; 1145 (Container : Vector;
1270 Item : Element_Type; 1146 Item : Element_Type;
1271 Index : Index_Type := Index_Type'Last) return Extended_Index 1147 Index : Index_Type := Index_Type'Last) return Extended_Index
1272 is 1148 is
1273 Last : Index_Type'Base; 1149 Last : Index_Type'Base;
1274 K : Capacity_Range; 1150 K : Count_Type'Base;
1275 1151
1276 begin 1152 begin
1277 if Index > Last_Index (Container) then 1153 if Index > Last_Index (Container) then
1278 Last := Last_Index (Container); 1154 Last := Last_Index (Container);
1279 else 1155 else
1280 Last := Index; 1156 Last := Index;
1281 end if; 1157 end if;
1282 1158
1283 K := Capacity_Range (Int (Last) - Int (No_Index)); 1159 K := Capacity_Range (Int (Last) - Int (No_Index));
1284 for Indx in reverse Index_Type'First .. Last loop 1160 for Indx in reverse Index_Type'First .. Last loop
1285 if Get_Element (Container, K) = Item then 1161 if Container.Elements (K) = Item then
1286 return Indx; 1162 return Indx;
1287 end if; 1163 end if;
1288 1164
1289 K := K - 1; 1165 K := K - 1;
1290 end loop; 1166 end loop;
1316 1192
1317 declare 1193 declare
1318 II : constant Int'Base := Int (I) - Int (No_Index); 1194 II : constant Int'Base := Int (I) - Int (No_Index);
1319 JJ : constant Int'Base := Int (J) - Int (No_Index); 1195 JJ : constant Int'Base := Int (J) - Int (No_Index);
1320 1196
1321 EI : Element_Type renames Elems (Container) (Capacity_Range (II)); 1197 EI : Element_Type renames Container.Elements (Capacity_Range (II));
1322 EJ : Element_Type renames Elems (Container) (Capacity_Range (JJ)); 1198 EJ : Element_Type renames Container.Elements (Capacity_Range (JJ));
1323 1199
1324 EI_Copy : constant Element_Type := EI; 1200 EI_Copy : constant Element_Type := EI;
1325 1201
1326 begin 1202 begin
1327 EI := EJ; 1203 EI := EJ;
1386 end if; 1262 end if;
1387 1263
1388 Last := Index_Type (Last_As_Int); 1264 Last := Index_Type (Last_As_Int);
1389 1265
1390 return 1266 return
1391 (Capacity => Length, 1267 (Capacity => Length,
1392 Last => Last, 1268 Last => Last,
1393 Elements_Ptr => <>, 1269 Elements => (others => New_Item));
1394 Elements => (others => New_Item));
1395 end; 1270 end;
1396 end To_Vector; 1271 end To_Vector;
1397 1272
1398 end Ada.Containers.Formal_Vectors; 1273 end Ada.Containers.Formal_Vectors;