annotate gcc/ada/libgnat/a-cofuma.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT LIBRARY COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- ADA.CONTAINERS.FUNCTIONAL_MAPS --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
9 -- Copyright (C) 2016-2018, Free Software Foundation, Inc. --
111
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- This specification is derived from the Ada Reference Manual for use with --
kono
parents:
diff changeset
12 -- GNAT. The copyright notice above, and the license provisions that follow --
kono
parents:
diff changeset
13 -- apply solely to the contents of the part following the private keyword. --
kono
parents:
diff changeset
14 -- --
kono
parents:
diff changeset
15 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
16 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
17 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
20 -- or FITNESS FOR A PARTICULAR PURPOSE. --
kono
parents:
diff changeset
21 -- --
kono
parents:
diff changeset
22 -- As a special exception under Section 7 of GPL version 3, you are granted --
kono
parents:
diff changeset
23 -- additional permissions described in the GCC Runtime Library Exception, --
kono
parents:
diff changeset
24 -- version 3.1, as published by the Free Software Foundation. --
kono
parents:
diff changeset
25 -- --
kono
parents:
diff changeset
26 -- You should have received a copy of the GNU General Public License and --
kono
parents:
diff changeset
27 -- a copy of the GCC Runtime Library Exception along with this program; --
kono
parents:
diff changeset
28 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
kono
parents:
diff changeset
29 -- <http://www.gnu.org/licenses/>. --
kono
parents:
diff changeset
30 ------------------------------------------------------------------------------
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 pragma Ada_2012;
kono
parents:
diff changeset
33 package body Ada.Containers.Functional_Maps with SPARK_Mode => Off is
kono
parents:
diff changeset
34 use Key_Containers;
kono
parents:
diff changeset
35 use Element_Containers;
kono
parents:
diff changeset
36
kono
parents:
diff changeset
37 ---------
kono
parents:
diff changeset
38 -- "=" --
kono
parents:
diff changeset
39 ---------
kono
parents:
diff changeset
40
kono
parents:
diff changeset
41 function "=" (Left : Map; Right : Map) return Boolean is
kono
parents:
diff changeset
42 (Left.Keys <= Right.Keys and Right <= Left);
kono
parents:
diff changeset
43
kono
parents:
diff changeset
44 ----------
kono
parents:
diff changeset
45 -- "<=" --
kono
parents:
diff changeset
46 ----------
kono
parents:
diff changeset
47
kono
parents:
diff changeset
48 function "<=" (Left : Map; Right : Map) return Boolean is
kono
parents:
diff changeset
49 I2 : Count_Type;
kono
parents:
diff changeset
50
kono
parents:
diff changeset
51 begin
kono
parents:
diff changeset
52 for I1 in 1 .. Length (Left.Keys) loop
kono
parents:
diff changeset
53 I2 := Find (Right.Keys, Get (Left.Keys, I1));
kono
parents:
diff changeset
54 if I2 = 0
kono
parents:
diff changeset
55 or else Get (Right.Elements, I2) /= Get (Left.Elements, I1)
kono
parents:
diff changeset
56 then
kono
parents:
diff changeset
57 return False;
kono
parents:
diff changeset
58 end if;
kono
parents:
diff changeset
59 end loop;
kono
parents:
diff changeset
60 return True;
kono
parents:
diff changeset
61 end "<=";
kono
parents:
diff changeset
62
kono
parents:
diff changeset
63 ---------
kono
parents:
diff changeset
64 -- Add --
kono
parents:
diff changeset
65 ---------
kono
parents:
diff changeset
66
kono
parents:
diff changeset
67 function Add
kono
parents:
diff changeset
68 (Container : Map;
kono
parents:
diff changeset
69 New_Key : Key_Type;
kono
parents:
diff changeset
70 New_Item : Element_Type) return Map
kono
parents:
diff changeset
71 is
kono
parents:
diff changeset
72 begin
kono
parents:
diff changeset
73 return
kono
parents:
diff changeset
74 (Keys =>
kono
parents:
diff changeset
75 Add (Container.Keys, Length (Container.Keys) + 1, New_Key),
kono
parents:
diff changeset
76 Elements =>
kono
parents:
diff changeset
77 Add
kono
parents:
diff changeset
78 (Container.Elements, Length (Container.Elements) + 1, New_Item));
kono
parents:
diff changeset
79 end Add;
kono
parents:
diff changeset
80
kono
parents:
diff changeset
81 ---------------------------
kono
parents:
diff changeset
82 -- Elements_Equal_Except --
kono
parents:
diff changeset
83 ---------------------------
kono
parents:
diff changeset
84
kono
parents:
diff changeset
85 function Elements_Equal_Except
kono
parents:
diff changeset
86 (Left : Map;
kono
parents:
diff changeset
87 Right : Map;
kono
parents:
diff changeset
88 New_Key : Key_Type) return Boolean
kono
parents:
diff changeset
89 is
kono
parents:
diff changeset
90 begin
kono
parents:
diff changeset
91 for I in 1 .. Length (Left.Keys) loop
kono
parents:
diff changeset
92 declare
kono
parents:
diff changeset
93 K : constant Key_Type := Get (Left.Keys, I);
kono
parents:
diff changeset
94 begin
kono
parents:
diff changeset
95 if not Equivalent_Keys (K, New_Key)
kono
parents:
diff changeset
96 and then
kono
parents:
diff changeset
97 (Find (Right.Keys, K) = 0
kono
parents:
diff changeset
98 or else Get (Right.Elements, Find (Right.Keys, K)) /=
kono
parents:
diff changeset
99 Get (Left.Elements, I))
kono
parents:
diff changeset
100 then
kono
parents:
diff changeset
101 return False;
kono
parents:
diff changeset
102 end if;
kono
parents:
diff changeset
103 end;
kono
parents:
diff changeset
104 end loop;
kono
parents:
diff changeset
105 return True;
kono
parents:
diff changeset
106 end Elements_Equal_Except;
kono
parents:
diff changeset
107
kono
parents:
diff changeset
108 function Elements_Equal_Except
kono
parents:
diff changeset
109 (Left : Map;
kono
parents:
diff changeset
110 Right : Map;
kono
parents:
diff changeset
111 X : Key_Type;
kono
parents:
diff changeset
112 Y : Key_Type) return Boolean
kono
parents:
diff changeset
113 is
kono
parents:
diff changeset
114 begin
kono
parents:
diff changeset
115 for I in 1 .. Length (Left.Keys) loop
kono
parents:
diff changeset
116 declare
kono
parents:
diff changeset
117 K : constant Key_Type := Get (Left.Keys, I);
kono
parents:
diff changeset
118 begin
kono
parents:
diff changeset
119 if not Equivalent_Keys (K, X)
kono
parents:
diff changeset
120 and then not Equivalent_Keys (K, Y)
kono
parents:
diff changeset
121 and then
kono
parents:
diff changeset
122 (Find (Right.Keys, K) = 0
kono
parents:
diff changeset
123 or else Get (Right.Elements, Find (Right.Keys, K)) /=
kono
parents:
diff changeset
124 Get (Left.Elements, I))
kono
parents:
diff changeset
125 then
kono
parents:
diff changeset
126 return False;
kono
parents:
diff changeset
127 end if;
kono
parents:
diff changeset
128 end;
kono
parents:
diff changeset
129 end loop;
kono
parents:
diff changeset
130 return True;
kono
parents:
diff changeset
131 end Elements_Equal_Except;
kono
parents:
diff changeset
132
kono
parents:
diff changeset
133 ---------
kono
parents:
diff changeset
134 -- Get --
kono
parents:
diff changeset
135 ---------
kono
parents:
diff changeset
136
kono
parents:
diff changeset
137 function Get (Container : Map; Key : Key_Type) return Element_Type is
kono
parents:
diff changeset
138 begin
kono
parents:
diff changeset
139 return Get (Container.Elements, Find (Container.Keys, Key));
kono
parents:
diff changeset
140 end Get;
kono
parents:
diff changeset
141
kono
parents:
diff changeset
142 -------------
kono
parents:
diff changeset
143 -- Has_Key --
kono
parents:
diff changeset
144 -------------
kono
parents:
diff changeset
145
kono
parents:
diff changeset
146 function Has_Key (Container : Map; Key : Key_Type) return Boolean is
kono
parents:
diff changeset
147 begin
kono
parents:
diff changeset
148 return Find (Container.Keys, Key) > 0;
kono
parents:
diff changeset
149 end Has_Key;
kono
parents:
diff changeset
150
kono
parents:
diff changeset
151 -----------------
kono
parents:
diff changeset
152 -- Has_Witness --
kono
parents:
diff changeset
153 -----------------
kono
parents:
diff changeset
154
kono
parents:
diff changeset
155 function Has_Witness
kono
parents:
diff changeset
156 (Container : Map;
kono
parents:
diff changeset
157 Witness : Count_Type) return Boolean
kono
parents:
diff changeset
158 is
kono
parents:
diff changeset
159 (Witness in 1 .. Length (Container.Keys));
kono
parents:
diff changeset
160
kono
parents:
diff changeset
161 --------------
kono
parents:
diff changeset
162 -- Is_Empty --
kono
parents:
diff changeset
163 --------------
kono
parents:
diff changeset
164
kono
parents:
diff changeset
165 function Is_Empty (Container : Map) return Boolean is
kono
parents:
diff changeset
166 begin
kono
parents:
diff changeset
167 return Length (Container.Keys) = 0;
kono
parents:
diff changeset
168 end Is_Empty;
kono
parents:
diff changeset
169
kono
parents:
diff changeset
170 -------------------
kono
parents:
diff changeset
171 -- Keys_Included --
kono
parents:
diff changeset
172 -------------------
kono
parents:
diff changeset
173
kono
parents:
diff changeset
174 function Keys_Included (Left : Map; Right : Map) return Boolean is
kono
parents:
diff changeset
175 begin
kono
parents:
diff changeset
176 for I in 1 .. Length (Left.Keys) loop
kono
parents:
diff changeset
177 declare
kono
parents:
diff changeset
178 K : constant Key_Type := Get (Left.Keys, I);
kono
parents:
diff changeset
179 begin
kono
parents:
diff changeset
180 if Find (Right.Keys, K) = 0 then
kono
parents:
diff changeset
181 return False;
kono
parents:
diff changeset
182 end if;
kono
parents:
diff changeset
183 end;
kono
parents:
diff changeset
184 end loop;
kono
parents:
diff changeset
185
kono
parents:
diff changeset
186 return True;
kono
parents:
diff changeset
187 end Keys_Included;
kono
parents:
diff changeset
188
kono
parents:
diff changeset
189 --------------------------
kono
parents:
diff changeset
190 -- Keys_Included_Except --
kono
parents:
diff changeset
191 --------------------------
kono
parents:
diff changeset
192
kono
parents:
diff changeset
193 function Keys_Included_Except
kono
parents:
diff changeset
194 (Left : Map;
kono
parents:
diff changeset
195 Right : Map;
kono
parents:
diff changeset
196 New_Key : Key_Type) return Boolean
kono
parents:
diff changeset
197 is
kono
parents:
diff changeset
198 begin
kono
parents:
diff changeset
199 for I in 1 .. Length (Left.Keys) loop
kono
parents:
diff changeset
200 declare
kono
parents:
diff changeset
201 K : constant Key_Type := Get (Left.Keys, I);
kono
parents:
diff changeset
202 begin
kono
parents:
diff changeset
203 if not Equivalent_Keys (K, New_Key)
kono
parents:
diff changeset
204 and then Find (Right.Keys, K) = 0
kono
parents:
diff changeset
205 then
kono
parents:
diff changeset
206 return False;
kono
parents:
diff changeset
207 end if;
kono
parents:
diff changeset
208 end;
kono
parents:
diff changeset
209 end loop;
kono
parents:
diff changeset
210
kono
parents:
diff changeset
211 return True;
kono
parents:
diff changeset
212 end Keys_Included_Except;
kono
parents:
diff changeset
213
kono
parents:
diff changeset
214 function Keys_Included_Except
kono
parents:
diff changeset
215 (Left : Map;
kono
parents:
diff changeset
216 Right : Map;
kono
parents:
diff changeset
217 X : Key_Type;
kono
parents:
diff changeset
218 Y : Key_Type) return Boolean
kono
parents:
diff changeset
219 is
kono
parents:
diff changeset
220 begin
kono
parents:
diff changeset
221 for I in 1 .. Length (Left.Keys) loop
kono
parents:
diff changeset
222 declare
kono
parents:
diff changeset
223 K : constant Key_Type := Get (Left.Keys, I);
kono
parents:
diff changeset
224 begin
kono
parents:
diff changeset
225 if not Equivalent_Keys (K, X)
kono
parents:
diff changeset
226 and then not Equivalent_Keys (K, Y)
kono
parents:
diff changeset
227 and then Find (Right.Keys, K) = 0
kono
parents:
diff changeset
228 then
kono
parents:
diff changeset
229 return False;
kono
parents:
diff changeset
230 end if;
kono
parents:
diff changeset
231 end;
kono
parents:
diff changeset
232 end loop;
kono
parents:
diff changeset
233
kono
parents:
diff changeset
234 return True;
kono
parents:
diff changeset
235 end Keys_Included_Except;
kono
parents:
diff changeset
236
kono
parents:
diff changeset
237 ------------
kono
parents:
diff changeset
238 -- Length --
kono
parents:
diff changeset
239 ------------
kono
parents:
diff changeset
240
kono
parents:
diff changeset
241 function Length (Container : Map) return Count_Type is
kono
parents:
diff changeset
242 begin
kono
parents:
diff changeset
243 return Length (Container.Elements);
kono
parents:
diff changeset
244 end Length;
kono
parents:
diff changeset
245
kono
parents:
diff changeset
246 ---------------
kono
parents:
diff changeset
247 -- Same_Keys --
kono
parents:
diff changeset
248 ---------------
kono
parents:
diff changeset
249
kono
parents:
diff changeset
250 function Same_Keys (Left : Map; Right : Map) return Boolean is
kono
parents:
diff changeset
251 (Keys_Included (Left, Right)
kono
parents:
diff changeset
252 and Keys_Included (Left => Right, Right => Left));
kono
parents:
diff changeset
253
kono
parents:
diff changeset
254 ---------
kono
parents:
diff changeset
255 -- Set --
kono
parents:
diff changeset
256 ---------
kono
parents:
diff changeset
257
kono
parents:
diff changeset
258 function Set
kono
parents:
diff changeset
259 (Container : Map;
kono
parents:
diff changeset
260 Key : Key_Type;
kono
parents:
diff changeset
261 New_Item : Element_Type) return Map
kono
parents:
diff changeset
262 is
kono
parents:
diff changeset
263 (Keys => Container.Keys,
kono
parents:
diff changeset
264 Elements =>
kono
parents:
diff changeset
265 Set (Container.Elements, Find (Container.Keys, Key), New_Item));
kono
parents:
diff changeset
266
kono
parents:
diff changeset
267 -----------
kono
parents:
diff changeset
268 -- W_Get --
kono
parents:
diff changeset
269 -----------
kono
parents:
diff changeset
270
kono
parents:
diff changeset
271 function W_Get
kono
parents:
diff changeset
272 (Container : Map;
kono
parents:
diff changeset
273 Witness : Count_Type) return Element_Type
kono
parents:
diff changeset
274 is
kono
parents:
diff changeset
275 (Get (Container.Elements, Witness));
kono
parents:
diff changeset
276
kono
parents:
diff changeset
277 -------------
kono
parents:
diff changeset
278 -- Witness --
kono
parents:
diff changeset
279 -------------
kono
parents:
diff changeset
280
kono
parents:
diff changeset
281 function Witness (Container : Map; Key : Key_Type) return Count_Type is
kono
parents:
diff changeset
282 (Find (Container.Keys, Key));
kono
parents:
diff changeset
283
kono
parents:
diff changeset
284 end Ada.Containers.Functional_Maps;