Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/libgnat/a-cofuba.adb @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT LIBRARY COMPONENTS --
4 -- --
5 -- ADA.CONTAINERS.FUNCTIONAL_BASE --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2016-2017, Free Software Foundation, Inc. --
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;