|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT LIBRARY COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- ADA.CONTAINERS.FUNCTIONAL_BASE --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 2016-2018, Free Software Foundation, Inc. --
|
|
111
|
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
|
|
|
32 pragma Ada_2012;
|
|
|
33
|
|
|
34 package body Ada.Containers.Functional_Base with SPARK_Mode => Off is
|
|
|
35
|
|
|
36 function To_Count (Idx : Extended_Index) return Count_Type is
|
|
|
37 (Count_Type
|
|
|
38 (Extended_Index'Pos (Idx) -
|
|
|
39 Extended_Index'Pos (Extended_Index'First)));
|
|
|
40
|
|
|
41 function To_Index (Position : Count_Type) return Extended_Index is
|
|
|
42 (Extended_Index'Val
|
|
|
43 (Position + Extended_Index'Pos (Extended_Index'First)));
|
|
|
44 -- Conversion functions between Index_Type and Count_Type
|
|
|
45
|
|
|
46 function Find (C : Container; E : access Element_Type) return Count_Type;
|
|
|
47 -- Search a container C for an element equal to E.all, returning the
|
|
|
48 -- position in the underlying array.
|
|
|
49
|
|
|
50 ---------
|
|
|
51 -- "=" --
|
|
|
52 ---------
|
|
|
53
|
|
|
54 function "=" (C1 : Container; C2 : Container) return Boolean is
|
|
|
55 begin
|
|
|
56 if C1.Elements'Length /= C2.Elements'Length then
|
|
|
57 return False;
|
|
|
58 end if;
|
|
|
59
|
|
|
60 for I in C1.Elements'Range loop
|
|
|
61 if C1.Elements (I).all /= C2.Elements (I).all then
|
|
|
62 return False;
|
|
|
63 end if;
|
|
|
64 end loop;
|
|
|
65
|
|
|
66 return True;
|
|
|
67 end "=";
|
|
|
68
|
|
|
69 ----------
|
|
|
70 -- "<=" --
|
|
|
71 ----------
|
|
|
72
|
|
|
73 function "<=" (C1 : Container; C2 : Container) return Boolean is
|
|
|
74 begin
|
|
|
75 for I in C1.Elements'Range loop
|
|
|
76 if Find (C2, C1.Elements (I)) = 0 then
|
|
|
77 return False;
|
|
|
78 end if;
|
|
|
79 end loop;
|
|
|
80
|
|
|
81 return True;
|
|
|
82 end "<=";
|
|
|
83
|
|
|
84 ---------
|
|
|
85 -- Add --
|
|
|
86 ---------
|
|
|
87
|
|
|
88 function Add
|
|
|
89 (C : Container;
|
|
|
90 I : Index_Type;
|
|
|
91 E : Element_Type) return Container
|
|
|
92 is
|
|
|
93 A : constant Element_Array_Access :=
|
|
|
94 new Element_Array'(1 .. C.Elements'Last + 1 => <>);
|
|
|
95 P : Count_Type := 0;
|
|
|
96
|
|
|
97 begin
|
|
|
98 for J in 1 .. C.Elements'Last + 1 loop
|
|
|
99 if J /= To_Count (I) then
|
|
|
100 P := P + 1;
|
|
|
101 A (J) := C.Elements (P);
|
|
|
102 else
|
|
|
103 A (J) := new Element_Type'(E);
|
|
|
104 end if;
|
|
|
105 end loop;
|
|
|
106
|
|
|
107 return Container'(Elements => A);
|
|
|
108 end Add;
|
|
|
109
|
|
|
110 ----------
|
|
|
111 -- Find --
|
|
|
112 ----------
|
|
|
113
|
|
|
114 function Find (C : Container; E : access Element_Type) return Count_Type is
|
|
|
115 begin
|
|
|
116 for I in C.Elements'Range loop
|
|
|
117 if C.Elements (I).all = E.all then
|
|
|
118 return I;
|
|
|
119 end if;
|
|
|
120 end loop;
|
|
|
121
|
|
|
122 return 0;
|
|
|
123 end Find;
|
|
|
124
|
|
|
125 function Find (C : Container; E : Element_Type) return Extended_Index is
|
|
|
126 (To_Index (Find (C, E'Unrestricted_Access)));
|
|
|
127
|
|
|
128 ---------
|
|
|
129 -- Get --
|
|
|
130 ---------
|
|
|
131
|
|
|
132 function Get (C : Container; I : Index_Type) return Element_Type is
|
|
|
133 (C.Elements (To_Count (I)).all);
|
|
|
134
|
|
|
135 ------------------
|
|
|
136 -- Intersection --
|
|
|
137 ------------------
|
|
|
138
|
|
|
139 function Intersection (C1 : Container; C2 : Container) return Container is
|
|
|
140 A : constant Element_Array_Access :=
|
|
|
141 new Element_Array'(1 .. Num_Overlaps (C1, C2) => <>);
|
|
|
142 P : Count_Type := 0;
|
|
|
143
|
|
|
144 begin
|
|
|
145 for I in C1.Elements'Range loop
|
|
|
146 if Find (C2, C1.Elements (I)) > 0 then
|
|
|
147 P := P + 1;
|
|
|
148 A (P) := C1.Elements (I);
|
|
|
149 end if;
|
|
|
150 end loop;
|
|
|
151
|
|
|
152 return Container'(Elements => A);
|
|
|
153 end Intersection;
|
|
|
154
|
|
|
155 ------------
|
|
|
156 -- Length --
|
|
|
157 ------------
|
|
|
158
|
|
|
159 function Length (C : Container) return Count_Type is (C.Elements'Length);
|
|
|
160
|
|
|
161 ---------------------
|
|
|
162 -- Num_Overlaps --
|
|
|
163 ---------------------
|
|
|
164
|
|
|
165 function Num_Overlaps (C1 : Container; C2 : Container) return Count_Type is
|
|
|
166 P : Count_Type := 0;
|
|
|
167
|
|
|
168 begin
|
|
|
169 for I in C1.Elements'Range loop
|
|
|
170 if Find (C2, C1.Elements (I)) > 0 then
|
|
|
171 P := P + 1;
|
|
|
172 end if;
|
|
|
173 end loop;
|
|
|
174
|
|
|
175 return P;
|
|
|
176 end Num_Overlaps;
|
|
|
177
|
|
|
178 ------------
|
|
|
179 -- Remove --
|
|
|
180 ------------
|
|
|
181
|
|
|
182 function Remove (C : Container; I : Index_Type) return Container is
|
|
|
183 A : constant Element_Array_Access :=
|
|
|
184 new Element_Array'(1 .. C.Elements'Last - 1 => <>);
|
|
|
185 P : Count_Type := 0;
|
|
|
186
|
|
|
187 begin
|
|
|
188 for J in C.Elements'Range loop
|
|
|
189 if J /= To_Count (I) then
|
|
|
190 P := P + 1;
|
|
|
191 A (P) := C.Elements (J);
|
|
|
192 end if;
|
|
|
193 end loop;
|
|
|
194
|
|
|
195 return Container'(Elements => A);
|
|
|
196 end Remove;
|
|
|
197
|
|
|
198 ---------
|
|
|
199 -- Set --
|
|
|
200 ---------
|
|
|
201
|
|
|
202 function Set
|
|
|
203 (C : Container;
|
|
|
204 I : Index_Type;
|
|
|
205 E : Element_Type) return Container
|
|
|
206 is
|
|
|
207 Result : constant Container :=
|
|
|
208 Container'(Elements => new Element_Array'(C.Elements.all));
|
|
|
209
|
|
|
210 begin
|
|
|
211 Result.Elements (To_Count (I)) := new Element_Type'(E);
|
|
|
212 return Result;
|
|
|
213 end Set;
|
|
|
214
|
|
|
215 -----------
|
|
|
216 -- Union --
|
|
|
217 -----------
|
|
|
218
|
|
|
219 function Union (C1 : Container; C2 : Container) return Container is
|
|
|
220 N : constant Count_Type := Num_Overlaps (C1, C2);
|
|
|
221
|
|
|
222 begin
|
|
|
223 -- if C2 is completely included in C1 then return C1
|
|
|
224
|
|
|
225 if N = Length (C2) then
|
|
|
226 return C1;
|
|
|
227 end if;
|
|
|
228
|
|
|
229 -- else loop through C2 to find the remaining elements
|
|
|
230
|
|
|
231 declare
|
|
|
232 L : constant Count_Type := Length (C1) - N + Length (C2);
|
|
|
233 A : constant Element_Array_Access :=
|
|
|
234 new Element_Array'
|
|
|
235 (C1.Elements.all & (Length (C1) + 1 .. L => <>));
|
|
|
236 P : Count_Type := Length (C1);
|
|
|
237
|
|
|
238 begin
|
|
|
239 for I in C2.Elements'Range loop
|
|
|
240 if Find (C1, C2.Elements (I)) = 0 then
|
|
|
241 P := P + 1;
|
|
|
242 A (P) := C2.Elements (I);
|
|
|
243 end if;
|
|
|
244 end loop;
|
|
|
245
|
|
|
246 return Container'(Elements => A);
|
|
|
247 end;
|
|
|
248 end Union;
|
|
|
249
|
|
|
250 end Ada.Containers.Functional_Base;
|
