111
|
1 ------------------------------------------------------------------------------
|
|
2 -- --
|
|
3 -- GNAT LIBRARY COMPONENTS --
|
|
4 -- --
|
|
5 -- ADA.CONTAINERS.FUNCTIONAL_MAPS --
|
|
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 package body Ada.Containers.Functional_Maps with SPARK_Mode => Off is
|
|
34 use Key_Containers;
|
|
35 use Element_Containers;
|
|
36
|
|
37 ---------
|
|
38 -- "=" --
|
|
39 ---------
|
|
40
|
|
41 function "=" (Left : Map; Right : Map) return Boolean is
|
|
42 (Left.Keys <= Right.Keys and Right <= Left);
|
|
43
|
|
44 ----------
|
|
45 -- "<=" --
|
|
46 ----------
|
|
47
|
|
48 function "<=" (Left : Map; Right : Map) return Boolean is
|
|
49 I2 : Count_Type;
|
|
50
|
|
51 begin
|
|
52 for I1 in 1 .. Length (Left.Keys) loop
|
|
53 I2 := Find (Right.Keys, Get (Left.Keys, I1));
|
|
54 if I2 = 0
|
|
55 or else Get (Right.Elements, I2) /= Get (Left.Elements, I1)
|
|
56 then
|
|
57 return False;
|
|
58 end if;
|
|
59 end loop;
|
|
60 return True;
|
|
61 end "<=";
|
|
62
|
|
63 ---------
|
|
64 -- Add --
|
|
65 ---------
|
|
66
|
|
67 function Add
|
|
68 (Container : Map;
|
|
69 New_Key : Key_Type;
|
|
70 New_Item : Element_Type) return Map
|
|
71 is
|
|
72 begin
|
|
73 return
|
|
74 (Keys =>
|
|
75 Add (Container.Keys, Length (Container.Keys) + 1, New_Key),
|
|
76 Elements =>
|
|
77 Add
|
|
78 (Container.Elements, Length (Container.Elements) + 1, New_Item));
|
|
79 end Add;
|
|
80
|
|
81 ---------------------------
|
|
82 -- Elements_Equal_Except --
|
|
83 ---------------------------
|
|
84
|
|
85 function Elements_Equal_Except
|
|
86 (Left : Map;
|
|
87 Right : Map;
|
|
88 New_Key : Key_Type) return Boolean
|
|
89 is
|
|
90 begin
|
|
91 for I in 1 .. Length (Left.Keys) loop
|
|
92 declare
|
|
93 K : constant Key_Type := Get (Left.Keys, I);
|
|
94 begin
|
|
95 if not Equivalent_Keys (K, New_Key)
|
|
96 and then
|
|
97 (Find (Right.Keys, K) = 0
|
|
98 or else Get (Right.Elements, Find (Right.Keys, K)) /=
|
|
99 Get (Left.Elements, I))
|
|
100 then
|
|
101 return False;
|
|
102 end if;
|
|
103 end;
|
|
104 end loop;
|
|
105 return True;
|
|
106 end Elements_Equal_Except;
|
|
107
|
|
108 function Elements_Equal_Except
|
|
109 (Left : Map;
|
|
110 Right : Map;
|
|
111 X : Key_Type;
|
|
112 Y : Key_Type) return Boolean
|
|
113 is
|
|
114 begin
|
|
115 for I in 1 .. Length (Left.Keys) loop
|
|
116 declare
|
|
117 K : constant Key_Type := Get (Left.Keys, I);
|
|
118 begin
|
|
119 if not Equivalent_Keys (K, X)
|
|
120 and then not Equivalent_Keys (K, Y)
|
|
121 and then
|
|
122 (Find (Right.Keys, K) = 0
|
|
123 or else Get (Right.Elements, Find (Right.Keys, K)) /=
|
|
124 Get (Left.Elements, I))
|
|
125 then
|
|
126 return False;
|
|
127 end if;
|
|
128 end;
|
|
129 end loop;
|
|
130 return True;
|
|
131 end Elements_Equal_Except;
|
|
132
|
|
133 ---------
|
|
134 -- Get --
|
|
135 ---------
|
|
136
|
|
137 function Get (Container : Map; Key : Key_Type) return Element_Type is
|
|
138 begin
|
|
139 return Get (Container.Elements, Find (Container.Keys, Key));
|
|
140 end Get;
|
|
141
|
|
142 -------------
|
|
143 -- Has_Key --
|
|
144 -------------
|
|
145
|
|
146 function Has_Key (Container : Map; Key : Key_Type) return Boolean is
|
|
147 begin
|
|
148 return Find (Container.Keys, Key) > 0;
|
|
149 end Has_Key;
|
|
150
|
|
151 -----------------
|
|
152 -- Has_Witness --
|
|
153 -----------------
|
|
154
|
|
155 function Has_Witness
|
|
156 (Container : Map;
|
|
157 Witness : Count_Type) return Boolean
|
|
158 is
|
|
159 (Witness in 1 .. Length (Container.Keys));
|
|
160
|
|
161 --------------
|
|
162 -- Is_Empty --
|
|
163 --------------
|
|
164
|
|
165 function Is_Empty (Container : Map) return Boolean is
|
|
166 begin
|
|
167 return Length (Container.Keys) = 0;
|
|
168 end Is_Empty;
|
|
169
|
|
170 -------------------
|
|
171 -- Keys_Included --
|
|
172 -------------------
|
|
173
|
|
174 function Keys_Included (Left : Map; Right : Map) return Boolean is
|
|
175 begin
|
|
176 for I in 1 .. Length (Left.Keys) loop
|
|
177 declare
|
|
178 K : constant Key_Type := Get (Left.Keys, I);
|
|
179 begin
|
|
180 if Find (Right.Keys, K) = 0 then
|
|
181 return False;
|
|
182 end if;
|
|
183 end;
|
|
184 end loop;
|
|
185
|
|
186 return True;
|
|
187 end Keys_Included;
|
|
188
|
|
189 --------------------------
|
|
190 -- Keys_Included_Except --
|
|
191 --------------------------
|
|
192
|
|
193 function Keys_Included_Except
|
|
194 (Left : Map;
|
|
195 Right : Map;
|
|
196 New_Key : Key_Type) return Boolean
|
|
197 is
|
|
198 begin
|
|
199 for I in 1 .. Length (Left.Keys) loop
|
|
200 declare
|
|
201 K : constant Key_Type := Get (Left.Keys, I);
|
|
202 begin
|
|
203 if not Equivalent_Keys (K, New_Key)
|
|
204 and then Find (Right.Keys, K) = 0
|
|
205 then
|
|
206 return False;
|
|
207 end if;
|
|
208 end;
|
|
209 end loop;
|
|
210
|
|
211 return True;
|
|
212 end Keys_Included_Except;
|
|
213
|
|
214 function Keys_Included_Except
|
|
215 (Left : Map;
|
|
216 Right : Map;
|
|
217 X : Key_Type;
|
|
218 Y : Key_Type) return Boolean
|
|
219 is
|
|
220 begin
|
|
221 for I in 1 .. Length (Left.Keys) loop
|
|
222 declare
|
|
223 K : constant Key_Type := Get (Left.Keys, I);
|
|
224 begin
|
|
225 if not Equivalent_Keys (K, X)
|
|
226 and then not Equivalent_Keys (K, Y)
|
|
227 and then Find (Right.Keys, K) = 0
|
|
228 then
|
|
229 return False;
|
|
230 end if;
|
|
231 end;
|
|
232 end loop;
|
|
233
|
|
234 return True;
|
|
235 end Keys_Included_Except;
|
|
236
|
|
237 ------------
|
|
238 -- Length --
|
|
239 ------------
|
|
240
|
|
241 function Length (Container : Map) return Count_Type is
|
|
242 begin
|
|
243 return Length (Container.Elements);
|
|
244 end Length;
|
|
245
|
|
246 ---------------
|
|
247 -- Same_Keys --
|
|
248 ---------------
|
|
249
|
|
250 function Same_Keys (Left : Map; Right : Map) return Boolean is
|
|
251 (Keys_Included (Left, Right)
|
|
252 and Keys_Included (Left => Right, Right => Left));
|
|
253
|
|
254 ---------
|
|
255 -- Set --
|
|
256 ---------
|
|
257
|
|
258 function Set
|
|
259 (Container : Map;
|
|
260 Key : Key_Type;
|
|
261 New_Item : Element_Type) return Map
|
|
262 is
|
|
263 (Keys => Container.Keys,
|
|
264 Elements =>
|
|
265 Set (Container.Elements, Find (Container.Keys, Key), New_Item));
|
|
266
|
|
267 -----------
|
|
268 -- W_Get --
|
|
269 -----------
|
|
270
|
|
271 function W_Get
|
|
272 (Container : Map;
|
|
273 Witness : Count_Type) return Element_Type
|
|
274 is
|
|
275 (Get (Container.Elements, Witness));
|
|
276
|
|
277 -------------
|
|
278 -- Witness --
|
|
279 -------------
|
|
280
|
|
281 function Witness (Container : Map; Key : Key_Type) return Count_Type is
|
|
282 (Find (Container.Keys, Key));
|
|
283
|
|
284 end Ada.Containers.Functional_Maps;
|