|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT LIBRARY COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- A D A . C O N T A I N E R S . F O R M A L _ H A S H E D _ M A P S --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 2010-2019, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
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- --
|
|
|
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- --
|
|
|
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
|
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
|
17 -- --
|
|
|
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
21 -- --
|
|
|
22 -- You should have received a copy of the GNU General Public License and --
|
|
|
23 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
25 -- <http://www.gnu.org/licenses/>. --
|
|
|
26 ------------------------------------------------------------------------------
|
|
|
27
|
|
|
28 with Ada.Containers.Hash_Tables.Generic_Bounded_Operations;
|
|
|
29 pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Bounded_Operations);
|
|
|
30
|
|
|
31 with Ada.Containers.Hash_Tables.Generic_Bounded_Keys;
|
|
|
32 pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Bounded_Keys);
|
|
|
33
|
|
|
34 with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers;
|
|
|
35
|
|
|
36 with System; use type System.Address;
|
|
|
37
|
|
|
38 package body Ada.Containers.Formal_Hashed_Maps with
|
|
|
39 SPARK_Mode => Off
|
|
|
40 is
|
|
|
41 -----------------------
|
|
|
42 -- Local Subprograms --
|
|
|
43 -----------------------
|
|
|
44
|
|
|
45 -- All local subprograms require comments ???
|
|
|
46
|
|
|
47 function Equivalent_Keys
|
|
|
48 (Key : Key_Type;
|
|
|
49 Node : Node_Type) return Boolean;
|
|
|
50 pragma Inline (Equivalent_Keys);
|
|
|
51
|
|
|
52 procedure Free
|
|
|
53 (HT : in out Map;
|
|
|
54 X : Count_Type);
|
|
|
55
|
|
|
56 generic
|
|
|
57 with procedure Set_Element (Node : in out Node_Type);
|
|
|
58 procedure Generic_Allocate
|
|
|
59 (HT : in out Map;
|
|
|
60 Node : out Count_Type);
|
|
|
61
|
|
|
62 function Hash_Node (Node : Node_Type) return Hash_Type;
|
|
|
63 pragma Inline (Hash_Node);
|
|
|
64
|
|
|
65 function Next (Node : Node_Type) return Count_Type;
|
|
|
66 pragma Inline (Next);
|
|
|
67
|
|
|
68 procedure Set_Next (Node : in out Node_Type; Next : Count_Type);
|
|
|
69 pragma Inline (Set_Next);
|
|
|
70
|
|
|
71 function Vet (Container : Map; Position : Cursor) return Boolean;
|
|
|
72
|
|
|
73 --------------------------
|
|
|
74 -- Local Instantiations --
|
|
|
75 --------------------------
|
|
|
76
|
|
|
77 package HT_Ops is
|
|
|
78 new Hash_Tables.Generic_Bounded_Operations
|
|
|
79 (HT_Types => HT_Types,
|
|
|
80 Hash_Node => Hash_Node,
|
|
|
81 Next => Next,
|
|
|
82 Set_Next => Set_Next);
|
|
|
83
|
|
|
84 package Key_Ops is
|
|
|
85 new Hash_Tables.Generic_Bounded_Keys
|
|
|
86 (HT_Types => HT_Types,
|
|
|
87 Next => Next,
|
|
|
88 Set_Next => Set_Next,
|
|
|
89 Key_Type => Key_Type,
|
|
|
90 Hash => Hash,
|
|
|
91 Equivalent_Keys => Equivalent_Keys);
|
|
|
92
|
|
|
93 ---------
|
|
|
94 -- "=" --
|
|
|
95 ---------
|
|
|
96
|
|
|
97 function "=" (Left, Right : Map) return Boolean is
|
|
|
98 begin
|
|
|
99 if Length (Left) /= Length (Right) then
|
|
|
100 return False;
|
|
|
101 end if;
|
|
|
102
|
|
|
103 if Length (Left) = 0 then
|
|
|
104 return True;
|
|
|
105 end if;
|
|
|
106
|
|
|
107 declare
|
|
|
108 Node : Count_Type;
|
|
|
109 ENode : Count_Type;
|
|
|
110
|
|
|
111 begin
|
|
|
112 Node := Left.First.Node;
|
|
|
113 while Node /= 0 loop
|
|
|
114 ENode :=
|
|
|
115 Find
|
|
|
116 (Container => Right,
|
|
|
117 Key => Left.Nodes (Node).Key).Node;
|
|
|
118
|
|
|
119 if ENode = 0 or else
|
|
|
120 Right.Nodes (ENode).Element /= Left.Nodes (Node).Element
|
|
|
121 then
|
|
|
122 return False;
|
|
|
123 end if;
|
|
|
124
|
|
|
125 Node := HT_Ops.Next (Left, Node);
|
|
|
126 end loop;
|
|
|
127
|
|
|
128 return True;
|
|
|
129 end;
|
|
|
130 end "=";
|
|
|
131
|
|
|
132 ------------
|
|
|
133 -- Assign --
|
|
|
134 ------------
|
|
|
135
|
|
|
136 procedure Assign (Target : in out Map; Source : Map) is
|
|
|
137 procedure Insert_Element (Source_Node : Count_Type);
|
|
|
138 pragma Inline (Insert_Element);
|
|
|
139
|
|
|
140 procedure Insert_Elements is
|
|
|
141 new HT_Ops.Generic_Iteration (Insert_Element);
|
|
|
142
|
|
|
143 --------------------
|
|
|
144 -- Insert_Element --
|
|
|
145 --------------------
|
|
|
146
|
|
|
147 procedure Insert_Element (Source_Node : Count_Type) is
|
|
|
148 N : Node_Type renames Source.Nodes (Source_Node);
|
|
|
149 begin
|
|
|
150 Insert (Target, N.Key, N.Element);
|
|
|
151 end Insert_Element;
|
|
|
152
|
|
|
153 -- Start of processing for Assign
|
|
|
154
|
|
|
155 begin
|
|
|
156 if Target'Address = Source'Address then
|
|
|
157 return;
|
|
|
158 end if;
|
|
|
159
|
|
|
160 if Target.Capacity < Length (Source) then
|
|
|
161 raise Constraint_Error with -- correct exception ???
|
|
|
162 "Source length exceeds Target capacity";
|
|
|
163 end if;
|
|
|
164
|
|
|
165 Clear (Target);
|
|
|
166
|
|
|
167 Insert_Elements (Source);
|
|
|
168 end Assign;
|
|
|
169
|
|
|
170 --------------
|
|
|
171 -- Capacity --
|
|
|
172 --------------
|
|
|
173
|
|
|
174 function Capacity (Container : Map) return Count_Type is
|
|
|
175 begin
|
|
|
176 return Container.Nodes'Length;
|
|
|
177 end Capacity;
|
|
|
178
|
|
|
179 -----------
|
|
|
180 -- Clear --
|
|
|
181 -----------
|
|
|
182
|
|
|
183 procedure Clear (Container : in out Map) is
|
|
|
184 begin
|
|
|
185 HT_Ops.Clear (Container);
|
|
|
186 end Clear;
|
|
|
187
|
|
|
188 --------------
|
|
|
189 -- Contains --
|
|
|
190 --------------
|
|
|
191
|
|
|
192 function Contains (Container : Map; Key : Key_Type) return Boolean is
|
|
|
193 begin
|
|
|
194 return Find (Container, Key) /= No_Element;
|
|
|
195 end Contains;
|
|
|
196
|
|
|
197 ----------
|
|
|
198 -- Copy --
|
|
|
199 ----------
|
|
|
200
|
|
|
201 function Copy
|
|
|
202 (Source : Map;
|
|
|
203 Capacity : Count_Type := 0) return Map
|
|
|
204 is
|
|
|
205 C : constant Count_Type :=
|
|
|
206 Count_Type'Max (Capacity, Source.Capacity);
|
|
|
207 Cu : Cursor;
|
|
|
208 H : Hash_Type;
|
|
|
209 N : Count_Type;
|
|
|
210 Target : Map (C, Source.Modulus);
|
|
|
211
|
|
|
212 begin
|
|
|
213 if 0 < Capacity and then Capacity < Source.Capacity then
|
|
|
214 raise Capacity_Error;
|
|
|
215 end if;
|
|
|
216
|
|
|
217 Target.Length := Source.Length;
|
|
|
218 Target.Free := Source.Free;
|
|
|
219
|
|
|
220 H := 1;
|
|
|
221 while H <= Source.Modulus loop
|
|
|
222 Target.Buckets (H) := Source.Buckets (H);
|
|
|
223 H := H + 1;
|
|
|
224 end loop;
|
|
|
225
|
|
|
226 N := 1;
|
|
|
227 while N <= Source.Capacity loop
|
|
|
228 Target.Nodes (N) := Source.Nodes (N);
|
|
|
229 N := N + 1;
|
|
|
230 end loop;
|
|
|
231
|
|
|
232 while N <= C loop
|
|
|
233 Cu := (Node => N);
|
|
|
234 Free (Target, Cu.Node);
|
|
|
235 N := N + 1;
|
|
|
236 end loop;
|
|
|
237
|
|
|
238 return Target;
|
|
|
239 end Copy;
|
|
|
240
|
|
|
241 ---------------------
|
|
|
242 -- Default_Modulus --
|
|
|
243 ---------------------
|
|
|
244
|
|
|
245 function Default_Modulus (Capacity : Count_Type) return Hash_Type is
|
|
|
246 begin
|
|
|
247 return To_Prime (Capacity);
|
|
|
248 end Default_Modulus;
|
|
|
249
|
|
|
250 ------------
|
|
|
251 -- Delete --
|
|
|
252 ------------
|
|
|
253
|
|
|
254 procedure Delete (Container : in out Map; Key : Key_Type) is
|
|
|
255 X : Count_Type;
|
|
|
256
|
|
|
257 begin
|
|
|
258 Key_Ops.Delete_Key_Sans_Free (Container, Key, X);
|
|
|
259
|
|
|
260 if X = 0 then
|
|
|
261 raise Constraint_Error with "attempt to delete key not in map";
|
|
|
262 end if;
|
|
|
263
|
|
|
264 Free (Container, X);
|
|
|
265 end Delete;
|
|
|
266
|
|
|
267 procedure Delete (Container : in out Map; Position : in out Cursor) is
|
|
|
268 begin
|
|
|
269 if not Has_Element (Container, Position) then
|
|
|
270 raise Constraint_Error with
|
|
|
271 "Position cursor of Delete has no element";
|
|
|
272 end if;
|
|
|
273
|
|
|
274 pragma Assert (Vet (Container, Position), "bad cursor in Delete");
|
|
|
275
|
|
|
276 HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
|
|
|
277
|
|
|
278 Free (Container, Position.Node);
|
|
|
279 Position := No_Element;
|
|
|
280 end Delete;
|
|
|
281
|
|
|
282 -------------
|
|
|
283 -- Element --
|
|
|
284 -------------
|
|
|
285
|
|
|
286 function Element (Container : Map; Key : Key_Type) return Element_Type is
|
|
|
287 Node : constant Count_Type := Find (Container, Key).Node;
|
|
|
288
|
|
|
289 begin
|
|
|
290 if Node = 0 then
|
|
|
291 raise Constraint_Error with
|
|
|
292 "no element available because key not in map";
|
|
|
293 end if;
|
|
|
294
|
|
|
295 return Container.Nodes (Node).Element;
|
|
|
296 end Element;
|
|
|
297
|
|
|
298 function Element (Container : Map; Position : Cursor) return Element_Type is
|
|
|
299 begin
|
|
|
300 if not Has_Element (Container, Position) then
|
|
|
301 raise Constraint_Error with "Position cursor equals No_Element";
|
|
|
302 end if;
|
|
|
303
|
|
|
304 pragma Assert
|
|
|
305 (Vet (Container, Position), "bad cursor in function Element");
|
|
|
306
|
|
|
307 return Container.Nodes (Position.Node).Element;
|
|
|
308 end Element;
|
|
|
309
|
|
|
310 ---------------------
|
|
|
311 -- Equivalent_Keys --
|
|
|
312 ---------------------
|
|
|
313
|
|
|
314 function Equivalent_Keys
|
|
|
315 (Key : Key_Type;
|
|
|
316 Node : Node_Type) return Boolean
|
|
|
317 is
|
|
|
318 begin
|
|
|
319 return Equivalent_Keys (Key, Node.Key);
|
|
|
320 end Equivalent_Keys;
|
|
|
321
|
|
|
322 -------------
|
|
|
323 -- Exclude --
|
|
|
324 -------------
|
|
|
325
|
|
|
326 procedure Exclude (Container : in out Map; Key : Key_Type) is
|
|
|
327 X : Count_Type;
|
|
|
328 begin
|
|
|
329 Key_Ops.Delete_Key_Sans_Free (Container, Key, X);
|
|
|
330 Free (Container, X);
|
|
|
331 end Exclude;
|
|
|
332
|
|
|
333 ----------
|
|
|
334 -- Find --
|
|
|
335 ----------
|
|
|
336
|
|
|
337 function Find (Container : Map; Key : Key_Type) return Cursor is
|
|
|
338 Node : constant Count_Type := Key_Ops.Find (Container, Key);
|
|
|
339
|
|
|
340 begin
|
|
|
341 if Node = 0 then
|
|
|
342 return No_Element;
|
|
|
343 end if;
|
|
|
344
|
|
|
345 return (Node => Node);
|
|
|
346 end Find;
|
|
|
347
|
|
|
348 -----------
|
|
|
349 -- First --
|
|
|
350 -----------
|
|
|
351
|
|
|
352 function First (Container : Map) return Cursor is
|
|
|
353 Node : constant Count_Type := HT_Ops.First (Container);
|
|
|
354
|
|
|
355 begin
|
|
|
356 if Node = 0 then
|
|
|
357 return No_Element;
|
|
|
358 end if;
|
|
|
359
|
|
|
360 return (Node => Node);
|
|
|
361 end First;
|
|
|
362
|
|
|
363 ------------------
|
|
|
364 -- Formal_Model --
|
|
|
365 ------------------
|
|
|
366
|
|
|
367 package body Formal_Model is
|
|
|
368
|
|
|
369 ----------
|
|
|
370 -- Find --
|
|
|
371 ----------
|
|
|
372
|
|
|
373 function Find
|
|
|
374 (Container : K.Sequence;
|
|
|
375 Key : Key_Type) return Count_Type
|
|
|
376 is
|
|
|
377 begin
|
|
|
378 for I in 1 .. K.Length (Container) loop
|
|
|
379 if Equivalent_Keys (Key, K.Get (Container, I)) then
|
|
|
380 return I;
|
|
|
381 end if;
|
|
|
382 end loop;
|
|
|
383 return 0;
|
|
|
384 end Find;
|
|
|
385
|
|
|
386 ---------------------
|
|
|
387 -- K_Keys_Included --
|
|
|
388 ---------------------
|
|
|
389
|
|
|
390 function K_Keys_Included
|
|
|
391 (Left : K.Sequence;
|
|
|
392 Right : K.Sequence) return Boolean
|
|
|
393 is
|
|
|
394 begin
|
|
|
395 for I in 1 .. K.Length (Left) loop
|
|
|
396 if not K.Contains (Right, 1, K.Length (Right), K.Get (Left, I))
|
|
|
397 then
|
|
|
398 return False;
|
|
|
399 end if;
|
|
|
400 end loop;
|
|
|
401
|
|
|
402 return True;
|
|
|
403 end K_Keys_Included;
|
|
|
404
|
|
|
405 ----------
|
|
|
406 -- Keys --
|
|
|
407 ----------
|
|
|
408
|
|
|
409 function Keys (Container : Map) return K.Sequence is
|
|
|
410 Position : Count_Type := HT_Ops.First (Container);
|
|
|
411 R : K.Sequence;
|
|
|
412
|
|
|
413 begin
|
|
|
414 -- Can't use First, Next or Element here, since they depend on models
|
|
|
415 -- for their postconditions.
|
|
|
416
|
|
|
417 while Position /= 0 loop
|
|
|
418 R := K.Add (R, Container.Nodes (Position).Key);
|
|
|
419 Position := HT_Ops.Next (Container, Position);
|
|
|
420 end loop;
|
|
|
421
|
|
|
422 return R;
|
|
|
423 end Keys;
|
|
|
424
|
|
|
425 ----------------------------
|
|
|
426 -- Lift_Abstraction_Level --
|
|
|
427 ----------------------------
|
|
|
428
|
|
|
429 procedure Lift_Abstraction_Level (Container : Map) is null;
|
|
|
430
|
|
|
431 -----------------------
|
|
131
|
432 -- Mapping_Preserved --
|
|
111
|
433 -----------------------
|
|
|
434
|
|
|
435 function Mapping_Preserved
|
|
|
436 (K_Left : K.Sequence;
|
|
|
437 K_Right : K.Sequence;
|
|
|
438 P_Left : P.Map;
|
|
|
439 P_Right : P.Map) return Boolean
|
|
|
440 is
|
|
|
441 begin
|
|
|
442 for C of P_Left loop
|
|
|
443 if not P.Has_Key (P_Right, C)
|
|
|
444 or else P.Get (P_Left, C) > K.Length (K_Left)
|
|
|
445 or else P.Get (P_Right, C) > K.Length (K_Right)
|
|
|
446 or else K.Get (K_Left, P.Get (P_Left, C)) /=
|
|
|
447 K.Get (K_Right, P.Get (P_Right, C))
|
|
|
448 then
|
|
|
449 return False;
|
|
|
450 end if;
|
|
|
451 end loop;
|
|
|
452
|
|
|
453 return True;
|
|
|
454 end Mapping_Preserved;
|
|
|
455
|
|
|
456 -----------
|
|
|
457 -- Model --
|
|
|
458 -----------
|
|
|
459
|
|
|
460 function Model (Container : Map) return M.Map is
|
|
|
461 Position : Count_Type := HT_Ops.First (Container);
|
|
|
462 R : M.Map;
|
|
|
463
|
|
|
464 begin
|
|
|
465 -- Can't use First, Next or Element here, since they depend on models
|
|
|
466 -- for their postconditions.
|
|
|
467
|
|
|
468 while Position /= 0 loop
|
|
|
469 R :=
|
|
|
470 M.Add
|
|
|
471 (Container => R,
|
|
|
472 New_Key => Container.Nodes (Position).Key,
|
|
|
473 New_Item => Container.Nodes (Position).Element);
|
|
|
474
|
|
|
475 Position := HT_Ops.Next (Container, Position);
|
|
|
476 end loop;
|
|
|
477
|
|
|
478 return R;
|
|
|
479 end Model;
|
|
|
480
|
|
|
481 ---------------
|
|
|
482 -- Positions --
|
|
|
483 ---------------
|
|
|
484
|
|
|
485 function Positions (Container : Map) return P.Map is
|
|
|
486 I : Count_Type := 1;
|
|
|
487 Position : Count_Type := HT_Ops.First (Container);
|
|
|
488 R : P.Map;
|
|
|
489
|
|
|
490 begin
|
|
|
491 -- Can't use First, Next or Element here, since they depend on models
|
|
|
492 -- for their postconditions.
|
|
|
493
|
|
|
494 while Position /= 0 loop
|
|
|
495 R := P.Add (R, (Node => Position), I);
|
|
|
496 pragma Assert (P.Length (R) = I);
|
|
|
497 Position := HT_Ops.Next (Container, Position);
|
|
|
498 I := I + 1;
|
|
|
499 end loop;
|
|
|
500
|
|
|
501 return R;
|
|
|
502 end Positions;
|
|
|
503
|
|
|
504 end Formal_Model;
|
|
|
505
|
|
|
506 ----------
|
|
|
507 -- Free --
|
|
|
508 ----------
|
|
|
509
|
|
|
510 procedure Free (HT : in out Map; X : Count_Type) is
|
|
|
511 begin
|
|
145
|
512 if X /= 0 then
|
|
|
513 pragma Assert (X <= HT.Capacity);
|
|
|
514 HT.Nodes (X).Has_Element := False;
|
|
|
515 HT_Ops.Free (HT, X);
|
|
|
516 end if;
|
|
111
|
517 end Free;
|
|
|
518
|
|
|
519 ----------------------
|
|
|
520 -- Generic_Allocate --
|
|
|
521 ----------------------
|
|
|
522
|
|
|
523 procedure Generic_Allocate (HT : in out Map; Node : out Count_Type) is
|
|
|
524 procedure Allocate is
|
|
|
525 new HT_Ops.Generic_Allocate (Set_Element);
|
|
|
526
|
|
|
527 begin
|
|
|
528 Allocate (HT, Node);
|
|
|
529 HT.Nodes (Node).Has_Element := True;
|
|
|
530 end Generic_Allocate;
|
|
|
531
|
|
|
532 -----------------
|
|
|
533 -- Has_Element --
|
|
|
534 -----------------
|
|
|
535
|
|
|
536 function Has_Element (Container : Map; Position : Cursor) return Boolean is
|
|
|
537 begin
|
|
|
538 if Position.Node = 0
|
|
|
539 or else not Container.Nodes (Position.Node).Has_Element
|
|
|
540 then
|
|
|
541 return False;
|
|
|
542 else
|
|
|
543 return True;
|
|
|
544 end if;
|
|
|
545 end Has_Element;
|
|
|
546
|
|
|
547 ---------------
|
|
|
548 -- Hash_Node --
|
|
|
549 ---------------
|
|
|
550
|
|
|
551 function Hash_Node (Node : Node_Type) return Hash_Type is
|
|
|
552 begin
|
|
|
553 return Hash (Node.Key);
|
|
|
554 end Hash_Node;
|
|
|
555
|
|
|
556 -------------
|
|
|
557 -- Include --
|
|
|
558 -------------
|
|
|
559
|
|
|
560 procedure Include
|
|
|
561 (Container : in out Map;
|
|
|
562 Key : Key_Type;
|
|
|
563 New_Item : Element_Type)
|
|
|
564 is
|
|
|
565 Position : Cursor;
|
|
|
566 Inserted : Boolean;
|
|
|
567
|
|
|
568 begin
|
|
|
569 Insert (Container, Key, New_Item, Position, Inserted);
|
|
|
570
|
|
|
571 if not Inserted then
|
|
|
572 declare
|
|
|
573 N : Node_Type renames Container.Nodes (Position.Node);
|
|
|
574 begin
|
|
|
575 N.Key := Key;
|
|
|
576 N.Element := New_Item;
|
|
|
577 end;
|
|
|
578 end if;
|
|
|
579 end Include;
|
|
|
580
|
|
|
581 ------------
|
|
|
582 -- Insert --
|
|
|
583 ------------
|
|
|
584
|
|
|
585 procedure Insert
|
|
|
586 (Container : in out Map;
|
|
|
587 Key : Key_Type;
|
|
|
588 New_Item : Element_Type;
|
|
|
589 Position : out Cursor;
|
|
|
590 Inserted : out Boolean)
|
|
|
591 is
|
|
|
592 procedure Assign_Key (Node : in out Node_Type);
|
|
|
593 pragma Inline (Assign_Key);
|
|
|
594
|
|
|
595 function New_Node return Count_Type;
|
|
|
596 pragma Inline (New_Node);
|
|
|
597
|
|
|
598 procedure Local_Insert is
|
|
|
599 new Key_Ops.Generic_Conditional_Insert (New_Node);
|
|
|
600
|
|
|
601 procedure Allocate is
|
|
|
602 new Generic_Allocate (Assign_Key);
|
|
|
603
|
|
|
604 -----------------
|
|
|
605 -- Assign_Key --
|
|
|
606 -----------------
|
|
|
607
|
|
|
608 procedure Assign_Key (Node : in out Node_Type) is
|
|
|
609 begin
|
|
|
610 Node.Key := Key;
|
|
|
611 Node.Element := New_Item;
|
|
|
612 end Assign_Key;
|
|
|
613
|
|
|
614 --------------
|
|
|
615 -- New_Node --
|
|
|
616 --------------
|
|
|
617
|
|
|
618 function New_Node return Count_Type is
|
|
|
619 Result : Count_Type;
|
|
|
620 begin
|
|
|
621 Allocate (Container, Result);
|
|
|
622 return Result;
|
|
|
623 end New_Node;
|
|
|
624
|
|
|
625 -- Start of processing for Insert
|
|
|
626
|
|
|
627 begin
|
|
|
628 Local_Insert (Container, Key, Position.Node, Inserted);
|
|
|
629 end Insert;
|
|
|
630
|
|
|
631 procedure Insert
|
|
|
632 (Container : in out Map;
|
|
|
633 Key : Key_Type;
|
|
|
634 New_Item : Element_Type)
|
|
|
635 is
|
|
|
636 Position : Cursor;
|
|
|
637 pragma Unreferenced (Position);
|
|
|
638
|
|
|
639 Inserted : Boolean;
|
|
|
640
|
|
|
641 begin
|
|
|
642 Insert (Container, Key, New_Item, Position, Inserted);
|
|
|
643
|
|
|
644 if not Inserted then
|
|
|
645 raise Constraint_Error with "attempt to insert key already in map";
|
|
|
646 end if;
|
|
|
647 end Insert;
|
|
|
648
|
|
|
649 --------------
|
|
|
650 -- Is_Empty --
|
|
|
651 --------------
|
|
|
652
|
|
|
653 function Is_Empty (Container : Map) return Boolean is
|
|
|
654 begin
|
|
|
655 return Length (Container) = 0;
|
|
|
656 end Is_Empty;
|
|
|
657
|
|
|
658 ---------
|
|
|
659 -- Key --
|
|
|
660 ---------
|
|
|
661
|
|
|
662 function Key (Container : Map; Position : Cursor) return Key_Type is
|
|
|
663 begin
|
|
|
664 if not Has_Element (Container, Position) then
|
|
|
665 raise Constraint_Error with
|
|
|
666 "Position cursor of function Key has no element";
|
|
|
667 end if;
|
|
|
668
|
|
|
669 pragma Assert (Vet (Container, Position), "bad cursor in function Key");
|
|
|
670
|
|
|
671 return Container.Nodes (Position.Node).Key;
|
|
|
672 end Key;
|
|
|
673
|
|
|
674 ------------
|
|
|
675 -- Length --
|
|
|
676 ------------
|
|
|
677
|
|
|
678 function Length (Container : Map) return Count_Type is
|
|
|
679 begin
|
|
|
680 return Container.Length;
|
|
|
681 end Length;
|
|
|
682
|
|
|
683 ----------
|
|
|
684 -- Move --
|
|
|
685 ----------
|
|
|
686
|
|
|
687 procedure Move
|
|
|
688 (Target : in out Map;
|
|
|
689 Source : in out Map)
|
|
|
690 is
|
|
|
691 NN : HT_Types.Nodes_Type renames Source.Nodes;
|
|
|
692 X : Count_Type;
|
|
|
693 Y : Count_Type;
|
|
|
694
|
|
|
695 begin
|
|
|
696 if Target'Address = Source'Address then
|
|
|
697 return;
|
|
|
698 end if;
|
|
|
699
|
|
|
700 if Target.Capacity < Length (Source) then
|
|
|
701 raise Constraint_Error with -- ???
|
|
|
702 "Source length exceeds Target capacity";
|
|
|
703 end if;
|
|
|
704
|
|
|
705 Clear (Target);
|
|
|
706
|
|
|
707 if Source.Length = 0 then
|
|
|
708 return;
|
|
|
709 end if;
|
|
|
710
|
|
|
711 X := HT_Ops.First (Source);
|
|
|
712 while X /= 0 loop
|
|
|
713 Insert (Target, NN (X).Key, NN (X).Element); -- optimize???
|
|
|
714
|
|
|
715 Y := HT_Ops.Next (Source, X);
|
|
|
716
|
|
|
717 HT_Ops.Delete_Node_Sans_Free (Source, X);
|
|
|
718 Free (Source, X);
|
|
|
719
|
|
|
720 X := Y;
|
|
|
721 end loop;
|
|
|
722 end Move;
|
|
|
723
|
|
|
724 ----------
|
|
|
725 -- Next --
|
|
|
726 ----------
|
|
|
727
|
|
|
728 function Next (Node : Node_Type) return Count_Type is
|
|
|
729 begin
|
|
|
730 return Node.Next;
|
|
|
731 end Next;
|
|
|
732
|
|
|
733 function Next (Container : Map; Position : Cursor) return Cursor is
|
|
|
734 begin
|
|
|
735 if Position.Node = 0 then
|
|
|
736 return No_Element;
|
|
|
737 end if;
|
|
|
738
|
|
|
739 if not Has_Element (Container, Position) then
|
|
|
740 raise Constraint_Error with "Position has no element";
|
|
|
741 end if;
|
|
|
742
|
|
|
743 pragma Assert (Vet (Container, Position), "bad cursor in function Next");
|
|
|
744
|
|
|
745 declare
|
|
|
746 Node : constant Count_Type := HT_Ops.Next (Container, Position.Node);
|
|
|
747
|
|
|
748 begin
|
|
|
749 if Node = 0 then
|
|
|
750 return No_Element;
|
|
|
751 end if;
|
|
|
752
|
|
|
753 return (Node => Node);
|
|
|
754 end;
|
|
|
755 end Next;
|
|
|
756
|
|
|
757 procedure Next (Container : Map; Position : in out Cursor) is
|
|
|
758 begin
|
|
|
759 Position := Next (Container, Position);
|
|
|
760 end Next;
|
|
|
761
|
|
|
762 -------------
|
|
|
763 -- Replace --
|
|
|
764 -------------
|
|
|
765
|
|
|
766 procedure Replace
|
|
|
767 (Container : in out Map;
|
|
|
768 Key : Key_Type;
|
|
|
769 New_Item : Element_Type)
|
|
|
770 is
|
|
|
771 Node : constant Count_Type := Key_Ops.Find (Container, Key);
|
|
|
772
|
|
|
773 begin
|
|
|
774 if Node = 0 then
|
|
|
775 raise Constraint_Error with "attempt to replace key not in map";
|
|
|
776 end if;
|
|
|
777
|
|
|
778 declare
|
|
|
779 N : Node_Type renames Container.Nodes (Node);
|
|
|
780 begin
|
|
|
781 N.Key := Key;
|
|
|
782 N.Element := New_Item;
|
|
|
783 end;
|
|
|
784 end Replace;
|
|
|
785
|
|
|
786 ---------------------
|
|
|
787 -- Replace_Element --
|
|
|
788 ---------------------
|
|
|
789
|
|
|
790 procedure Replace_Element
|
|
|
791 (Container : in out Map;
|
|
|
792 Position : Cursor;
|
|
|
793 New_Item : Element_Type)
|
|
|
794 is
|
|
|
795 begin
|
|
|
796 if not Has_Element (Container, Position) then
|
|
|
797 raise Constraint_Error with
|
|
|
798 "Position cursor of Replace_Element has no element";
|
|
|
799 end if;
|
|
|
800
|
|
|
801 pragma Assert
|
|
|
802 (Vet (Container, Position), "bad cursor in Replace_Element");
|
|
|
803
|
|
|
804 Container.Nodes (Position.Node).Element := New_Item;
|
|
|
805 end Replace_Element;
|
|
|
806
|
|
|
807 ----------------------
|
|
|
808 -- Reserve_Capacity --
|
|
|
809 ----------------------
|
|
|
810
|
|
|
811 procedure Reserve_Capacity
|
|
|
812 (Container : in out Map;
|
|
|
813 Capacity : Count_Type)
|
|
|
814 is
|
|
|
815 begin
|
|
|
816 if Capacity > Container.Capacity then
|
|
|
817 raise Capacity_Error with "requested capacity is too large";
|
|
|
818 end if;
|
|
|
819 end Reserve_Capacity;
|
|
|
820
|
|
|
821 --------------
|
|
|
822 -- Set_Next --
|
|
|
823 --------------
|
|
|
824
|
|
|
825 procedure Set_Next (Node : in out Node_Type; Next : Count_Type) is
|
|
|
826 begin
|
|
|
827 Node.Next := Next;
|
|
|
828 end Set_Next;
|
|
|
829
|
|
|
830 ---------
|
|
|
831 -- Vet --
|
|
|
832 ---------
|
|
|
833
|
|
|
834 function Vet (Container : Map; Position : Cursor) return Boolean is
|
|
|
835 begin
|
|
|
836 if Position.Node = 0 then
|
|
|
837 return True;
|
|
|
838 end if;
|
|
|
839
|
|
|
840 declare
|
|
|
841 X : Count_Type;
|
|
|
842
|
|
|
843 begin
|
|
|
844 if Container.Length = 0 then
|
|
|
845 return False;
|
|
|
846 end if;
|
|
|
847
|
|
|
848 if Container.Capacity = 0 then
|
|
|
849 return False;
|
|
|
850 end if;
|
|
|
851
|
|
|
852 if Container.Buckets'Length = 0 then
|
|
|
853 return False;
|
|
|
854 end if;
|
|
|
855
|
|
|
856 if Position.Node > Container.Capacity then
|
|
|
857 return False;
|
|
|
858 end if;
|
|
|
859
|
|
|
860 if Container.Nodes (Position.Node).Next = Position.Node then
|
|
|
861 return False;
|
|
|
862 end if;
|
|
|
863
|
|
|
864 X :=
|
|
|
865 Container.Buckets
|
|
|
866 (Key_Ops.Index (Container, Container.Nodes (Position.Node).Key));
|
|
|
867
|
|
|
868 for J in 1 .. Container.Length loop
|
|
|
869 if X = Position.Node then
|
|
|
870 return True;
|
|
|
871 end if;
|
|
|
872
|
|
|
873 if X = 0 then
|
|
|
874 return False;
|
|
|
875 end if;
|
|
|
876
|
|
|
877 if X = Container.Nodes (X).Next then
|
|
|
878
|
|
|
879 -- Prevent unnecessary looping
|
|
|
880
|
|
|
881 return False;
|
|
|
882 end if;
|
|
|
883
|
|
|
884 X := Container.Nodes (X).Next;
|
|
|
885 end loop;
|
|
|
886
|
|
|
887 return False;
|
|
|
888 end;
|
|
|
889 end Vet;
|
|
|
890
|
|
|
891 end Ada.Containers.Formal_Hashed_Maps;
|
