]>
Commit | Line | Data |
---|---|---|
ff2efe85 AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT LIBRARY COMPONENTS -- | |
4 | -- -- | |
5 | -- A D A . C O N T A I N E R S . B O U N D E D _ O R D E R E D _ M A P S -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
1d005acc | 9 | -- Copyright (C) 2004-2019, Free Software Foundation, Inc. -- |
ff2efe85 AC |
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 | -- This unit was originally developed by Matthew J Heaney. -- | |
28 | ------------------------------------------------------------------------------ | |
29 | ||
14f73211 BD |
30 | with Ada.Containers.Helpers; use Ada.Containers.Helpers; |
31 | ||
ff2efe85 AC |
32 | with Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations; |
33 | pragma Elaborate_All | |
34 | (Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations); | |
35 | ||
36 | with Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys; | |
37 | pragma Elaborate_All | |
38 | (Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys); | |
39 | ||
ef992452 | 40 | with System; use type System.Address; |
ff2efe85 AC |
41 | |
42 | package body Ada.Containers.Bounded_Ordered_Maps is | |
43 | ||
14f73211 BD |
44 | pragma Warnings (Off, "variable ""Busy*"" is not referenced"); |
45 | pragma Warnings (Off, "variable ""Lock*"" is not referenced"); | |
46 | -- See comment in Ada.Containers.Helpers | |
47 | ||
ff2efe85 AC |
48 | ----------------------------- |
49 | -- Node Access Subprograms -- | |
50 | ----------------------------- | |
51 | ||
52 | -- These subprograms provide a functional interface to access fields | |
53 | -- of a node, and a procedural interface for modifying these values. | |
54 | ||
55 | function Color (Node : Node_Type) return Color_Type; | |
56 | pragma Inline (Color); | |
57 | ||
58 | function Left (Node : Node_Type) return Count_Type; | |
59 | pragma Inline (Left); | |
60 | ||
61 | function Parent (Node : Node_Type) return Count_Type; | |
62 | pragma Inline (Parent); | |
63 | ||
64 | function Right (Node : Node_Type) return Count_Type; | |
65 | pragma Inline (Right); | |
66 | ||
67 | procedure Set_Parent (Node : in out Node_Type; Parent : Count_Type); | |
68 | pragma Inline (Set_Parent); | |
69 | ||
70 | procedure Set_Left (Node : in out Node_Type; Left : Count_Type); | |
71 | pragma Inline (Set_Left); | |
72 | ||
73 | procedure Set_Right (Node : in out Node_Type; Right : Count_Type); | |
74 | pragma Inline (Set_Right); | |
75 | ||
76 | procedure Set_Color (Node : in out Node_Type; Color : Color_Type); | |
77 | pragma Inline (Set_Color); | |
78 | ||
79 | ----------------------- | |
80 | -- Local Subprograms -- | |
81 | ----------------------- | |
82 | ||
83 | function Is_Greater_Key_Node | |
84 | (Left : Key_Type; | |
85 | Right : Node_Type) return Boolean; | |
86 | pragma Inline (Is_Greater_Key_Node); | |
87 | ||
88 | function Is_Less_Key_Node | |
89 | (Left : Key_Type; | |
90 | Right : Node_Type) return Boolean; | |
91 | pragma Inline (Is_Less_Key_Node); | |
92 | ||
93 | -------------------------- | |
94 | -- Local Instantiations -- | |
95 | -------------------------- | |
96 | ||
97 | package Tree_Operations is | |
98 | new Red_Black_Trees.Generic_Bounded_Operations (Tree_Types); | |
99 | ||
100 | use Tree_Operations; | |
101 | ||
102 | package Key_Ops is | |
103 | new Red_Black_Trees.Generic_Bounded_Keys | |
104 | (Tree_Operations => Tree_Operations, | |
105 | Key_Type => Key_Type, | |
106 | Is_Less_Key_Node => Is_Less_Key_Node, | |
107 | Is_Greater_Key_Node => Is_Greater_Key_Node); | |
108 | ||
109 | --------- | |
110 | -- "<" -- | |
111 | --------- | |
112 | ||
113 | function "<" (Left, Right : Cursor) return Boolean is | |
114 | begin | |
14f73211 | 115 | if Checks and then Left.Node = 0 then |
ff2efe85 AC |
116 | raise Constraint_Error with "Left cursor of ""<"" equals No_Element"; |
117 | end if; | |
118 | ||
14f73211 | 119 | if Checks and then Right.Node = 0 then |
ff2efe85 AC |
120 | raise Constraint_Error with "Right cursor of ""<"" equals No_Element"; |
121 | end if; | |
122 | ||
123 | pragma Assert (Vet (Left.Container.all, Left.Node), | |
124 | "Left cursor of ""<"" is bad"); | |
125 | ||
126 | pragma Assert (Vet (Right.Container.all, Right.Node), | |
127 | "Right cursor of ""<"" is bad"); | |
128 | ||
129 | declare | |
130 | LN : Node_Type renames Left.Container.Nodes (Left.Node); | |
131 | RN : Node_Type renames Right.Container.Nodes (Right.Node); | |
132 | ||
133 | begin | |
134 | return LN.Key < RN.Key; | |
135 | end; | |
136 | end "<"; | |
137 | ||
138 | function "<" (Left : Cursor; Right : Key_Type) return Boolean is | |
139 | begin | |
14f73211 | 140 | if Checks and then Left.Node = 0 then |
ff2efe85 AC |
141 | raise Constraint_Error with "Left cursor of ""<"" equals No_Element"; |
142 | end if; | |
143 | ||
144 | pragma Assert (Vet (Left.Container.all, Left.Node), | |
145 | "Left cursor of ""<"" is bad"); | |
146 | ||
147 | declare | |
148 | LN : Node_Type renames Left.Container.Nodes (Left.Node); | |
149 | ||
150 | begin | |
151 | return LN.Key < Right; | |
152 | end; | |
153 | end "<"; | |
154 | ||
155 | function "<" (Left : Key_Type; Right : Cursor) return Boolean is | |
156 | begin | |
14f73211 | 157 | if Checks and then Right.Node = 0 then |
ff2efe85 AC |
158 | raise Constraint_Error with "Right cursor of ""<"" equals No_Element"; |
159 | end if; | |
160 | ||
161 | pragma Assert (Vet (Right.Container.all, Right.Node), | |
162 | "Right cursor of ""<"" is bad"); | |
163 | ||
164 | declare | |
165 | RN : Node_Type renames Right.Container.Nodes (Right.Node); | |
166 | ||
167 | begin | |
168 | return Left < RN.Key; | |
169 | end; | |
170 | end "<"; | |
171 | ||
172 | --------- | |
173 | -- "=" -- | |
174 | --------- | |
175 | ||
176 | function "=" (Left, Right : Map) return Boolean is | |
177 | function Is_Equal_Node_Node (L, R : Node_Type) return Boolean; | |
178 | pragma Inline (Is_Equal_Node_Node); | |
179 | ||
180 | function Is_Equal is | |
181 | new Tree_Operations.Generic_Equal (Is_Equal_Node_Node); | |
182 | ||
183 | ------------------------ | |
184 | -- Is_Equal_Node_Node -- | |
185 | ------------------------ | |
186 | ||
187 | function Is_Equal_Node_Node | |
188 | (L, R : Node_Type) return Boolean is | |
189 | begin | |
190 | if L.Key < R.Key then | |
191 | return False; | |
192 | ||
193 | elsif R.Key < L.Key then | |
194 | return False; | |
195 | ||
196 | else | |
197 | return L.Element = R.Element; | |
198 | end if; | |
199 | end Is_Equal_Node_Node; | |
200 | ||
201 | -- Start of processing for "=" | |
202 | ||
203 | begin | |
204 | return Is_Equal (Left, Right); | |
205 | end "="; | |
206 | ||
207 | --------- | |
208 | -- ">" -- | |
209 | --------- | |
210 | ||
211 | function ">" (Left, Right : Cursor) return Boolean is | |
212 | begin | |
14f73211 | 213 | if Checks and then Left.Node = 0 then |
ff2efe85 AC |
214 | raise Constraint_Error with "Left cursor of "">"" equals No_Element"; |
215 | end if; | |
216 | ||
14f73211 | 217 | if Checks and then Right.Node = 0 then |
ff2efe85 AC |
218 | raise Constraint_Error with "Right cursor of "">"" equals No_Element"; |
219 | end if; | |
220 | ||
221 | pragma Assert (Vet (Left.Container.all, Left.Node), | |
222 | "Left cursor of "">"" is bad"); | |
223 | ||
224 | pragma Assert (Vet (Right.Container.all, Right.Node), | |
225 | "Right cursor of "">"" is bad"); | |
226 | ||
227 | declare | |
228 | LN : Node_Type renames Left.Container.Nodes (Left.Node); | |
229 | RN : Node_Type renames Right.Container.Nodes (Right.Node); | |
230 | ||
231 | begin | |
232 | return RN.Key < LN.Key; | |
233 | end; | |
234 | end ">"; | |
235 | ||
236 | function ">" (Left : Cursor; Right : Key_Type) return Boolean is | |
237 | begin | |
14f73211 | 238 | if Checks and then Left.Node = 0 then |
ff2efe85 AC |
239 | raise Constraint_Error with "Left cursor of "">"" equals No_Element"; |
240 | end if; | |
241 | ||
242 | pragma Assert (Vet (Left.Container.all, Left.Node), | |
243 | "Left cursor of "">"" is bad"); | |
244 | ||
245 | declare | |
246 | LN : Node_Type renames Left.Container.Nodes (Left.Node); | |
ff2efe85 AC |
247 | begin |
248 | return Right < LN.Key; | |
249 | end; | |
250 | end ">"; | |
251 | ||
252 | function ">" (Left : Key_Type; Right : Cursor) return Boolean is | |
253 | begin | |
14f73211 | 254 | if Checks and then Right.Node = 0 then |
ff2efe85 AC |
255 | raise Constraint_Error with "Right cursor of "">"" equals No_Element"; |
256 | end if; | |
257 | ||
258 | pragma Assert (Vet (Right.Container.all, Right.Node), | |
259 | "Right cursor of "">"" is bad"); | |
260 | ||
261 | declare | |
262 | RN : Node_Type renames Right.Container.Nodes (Right.Node); | |
263 | ||
264 | begin | |
265 | return RN.Key < Left; | |
266 | end; | |
267 | end ">"; | |
268 | ||
269 | ------------ | |
270 | -- Assign -- | |
271 | ------------ | |
272 | ||
273 | procedure Assign (Target : in out Map; Source : Map) is | |
274 | procedure Append_Element (Source_Node : Count_Type); | |
275 | ||
276 | procedure Append_Elements is | |
277 | new Tree_Operations.Generic_Iteration (Append_Element); | |
278 | ||
279 | -------------------- | |
280 | -- Append_Element -- | |
281 | -------------------- | |
282 | ||
283 | procedure Append_Element (Source_Node : Count_Type) is | |
284 | SN : Node_Type renames Source.Nodes (Source_Node); | |
285 | ||
286 | procedure Set_Element (Node : in out Node_Type); | |
287 | pragma Inline (Set_Element); | |
288 | ||
289 | function New_Node return Count_Type; | |
290 | pragma Inline (New_Node); | |
291 | ||
292 | procedure Insert_Post is | |
293 | new Key_Ops.Generic_Insert_Post (New_Node); | |
294 | ||
295 | procedure Unconditional_Insert_Sans_Hint is | |
296 | new Key_Ops.Generic_Unconditional_Insert (Insert_Post); | |
297 | ||
298 | procedure Unconditional_Insert_Avec_Hint is | |
299 | new Key_Ops.Generic_Unconditional_Insert_With_Hint | |
300 | (Insert_Post, | |
301 | Unconditional_Insert_Sans_Hint); | |
302 | ||
303 | procedure Allocate is | |
304 | new Tree_Operations.Generic_Allocate (Set_Element); | |
305 | ||
306 | -------------- | |
307 | -- New_Node -- | |
308 | -------------- | |
309 | ||
310 | function New_Node return Count_Type is | |
311 | Result : Count_Type; | |
312 | ||
313 | begin | |
314 | Allocate (Target, Result); | |
315 | return Result; | |
316 | end New_Node; | |
317 | ||
318 | ----------------- | |
319 | -- Set_Element -- | |
320 | ----------------- | |
321 | ||
322 | procedure Set_Element (Node : in out Node_Type) is | |
323 | begin | |
324 | Node.Key := SN.Key; | |
325 | Node.Element := SN.Element; | |
326 | end Set_Element; | |
327 | ||
328 | Target_Node : Count_Type; | |
329 | ||
330 | -- Start of processing for Append_Element | |
331 | ||
332 | begin | |
333 | Unconditional_Insert_Avec_Hint | |
334 | (Tree => Target, | |
335 | Hint => 0, | |
336 | Key => SN.Key, | |
337 | Node => Target_Node); | |
338 | end Append_Element; | |
339 | ||
340 | -- Start of processing for Assign | |
341 | ||
342 | begin | |
343 | if Target'Address = Source'Address then | |
344 | return; | |
345 | end if; | |
346 | ||
14f73211 | 347 | if Checks and then Target.Capacity < Source.Length then |
ff2efe85 AC |
348 | raise Capacity_Error |
349 | with "Target capacity is less than Source length"; | |
350 | end if; | |
351 | ||
352 | Tree_Operations.Clear_Tree (Target); | |
353 | Append_Elements (Source); | |
354 | end Assign; | |
355 | ||
356 | ------------- | |
357 | -- Ceiling -- | |
358 | ------------- | |
359 | ||
360 | function Ceiling (Container : Map; Key : Key_Type) return Cursor is | |
361 | Node : constant Count_Type := Key_Ops.Ceiling (Container, Key); | |
362 | ||
363 | begin | |
364 | if Node = 0 then | |
365 | return No_Element; | |
366 | end if; | |
367 | ||
368 | return Cursor'(Container'Unrestricted_Access, Node); | |
369 | end Ceiling; | |
370 | ||
371 | ----------- | |
372 | -- Clear -- | |
373 | ----------- | |
374 | ||
375 | procedure Clear (Container : in out Map) is | |
376 | begin | |
cbdb0df1 BD |
377 | while not Container.Is_Empty loop |
378 | Container.Delete_Last; | |
379 | end loop; | |
ff2efe85 AC |
380 | end Clear; |
381 | ||
382 | ----------- | |
383 | -- Color -- | |
384 | ----------- | |
385 | ||
386 | function Color (Node : Node_Type) return Color_Type is | |
387 | begin | |
388 | return Node.Color; | |
389 | end Color; | |
390 | ||
c9423ca3 AC |
391 | ------------------------ |
392 | -- Constant_Reference -- | |
393 | ------------------------ | |
394 | ||
395 | function Constant_Reference | |
396 | (Container : aliased Map; | |
397 | Position : Cursor) return Constant_Reference_Type | |
398 | is | |
399 | begin | |
14f73211 | 400 | if Checks and then Position.Container = null then |
c9423ca3 AC |
401 | raise Constraint_Error with |
402 | "Position cursor has no element"; | |
403 | end if; | |
404 | ||
14f73211 BD |
405 | if Checks and then Position.Container /= Container'Unrestricted_Access |
406 | then | |
c9423ca3 AC |
407 | raise Program_Error with |
408 | "Position cursor designates wrong map"; | |
409 | end if; | |
410 | ||
411 | pragma Assert (Vet (Container, Position.Node), | |
412 | "Position cursor in Constant_Reference is bad"); | |
413 | ||
414 | declare | |
415 | N : Node_Type renames Container.Nodes (Position.Node); | |
14f73211 BD |
416 | TC : constant Tamper_Counts_Access := |
417 | Container.TC'Unrestricted_Access; | |
c9423ca3 | 418 | begin |
3bd783ec | 419 | return R : constant Constant_Reference_Type := |
14f73211 BD |
420 | (Element => N.Element'Access, |
421 | Control => (Controlled with TC)) | |
3bd783ec | 422 | do |
2f26abcc | 423 | Busy (TC.all); |
3bd783ec | 424 | end return; |
c9423ca3 AC |
425 | end; |
426 | end Constant_Reference; | |
427 | ||
428 | function Constant_Reference | |
2a290fec | 429 | (Container : aliased Map; |
c9423ca3 AC |
430 | Key : Key_Type) return Constant_Reference_Type |
431 | is | |
432 | Node : constant Count_Type := Key_Ops.Find (Container, Key); | |
433 | ||
434 | begin | |
14f73211 | 435 | if Checks and then Node = 0 then |
c9423ca3 AC |
436 | raise Constraint_Error with "key not in map"; |
437 | end if; | |
438 | ||
439 | declare | |
440 | N : Node_Type renames Container.Nodes (Node); | |
14f73211 BD |
441 | TC : constant Tamper_Counts_Access := |
442 | Container.TC'Unrestricted_Access; | |
c9423ca3 | 443 | begin |
3bd783ec | 444 | return R : constant Constant_Reference_Type := |
14f73211 BD |
445 | (Element => N.Element'Access, |
446 | Control => (Controlled with TC)) | |
3bd783ec | 447 | do |
2f26abcc | 448 | Busy (TC.all); |
3bd783ec | 449 | end return; |
c9423ca3 AC |
450 | end; |
451 | end Constant_Reference; | |
452 | ||
ff2efe85 AC |
453 | -------------- |
454 | -- Contains -- | |
455 | -------------- | |
456 | ||
457 | function Contains (Container : Map; Key : Key_Type) return Boolean is | |
458 | begin | |
459 | return Find (Container, Key) /= No_Element; | |
460 | end Contains; | |
461 | ||
462 | ---------- | |
463 | -- Copy -- | |
464 | ---------- | |
465 | ||
466 | function Copy (Source : Map; Capacity : Count_Type := 0) return Map is | |
5ce1c773 BD |
467 | C : constant Count_Type := |
468 | (if Capacity = 0 then Source.Length | |
469 | else Capacity); | |
ff2efe85 | 470 | begin |
5ce1c773 BD |
471 | if Checks and then C < Source.Length then |
472 | raise Capacity_Error with "Capacity too small"; | |
ff2efe85 AC |
473 | end if; |
474 | ||
475 | return Target : Map (Capacity => C) do | |
476 | Assign (Target => Target, Source => Source); | |
477 | end return; | |
478 | end Copy; | |
479 | ||
480 | ------------ | |
481 | -- Delete -- | |
482 | ------------ | |
483 | ||
484 | procedure Delete (Container : in out Map; Position : in out Cursor) is | |
485 | begin | |
14f73211 | 486 | if Checks and then Position.Node = 0 then |
ff2efe85 AC |
487 | raise Constraint_Error with |
488 | "Position cursor of Delete equals No_Element"; | |
489 | end if; | |
490 | ||
14f73211 BD |
491 | if Checks and then Position.Container /= Container'Unrestricted_Access |
492 | then | |
ff2efe85 AC |
493 | raise Program_Error with |
494 | "Position cursor of Delete designates wrong map"; | |
495 | end if; | |
496 | ||
497 | pragma Assert (Vet (Container, Position.Node), | |
498 | "Position cursor of Delete is bad"); | |
499 | ||
500 | Tree_Operations.Delete_Node_Sans_Free (Container, Position.Node); | |
501 | Tree_Operations.Free (Container, Position.Node); | |
502 | ||
503 | Position := No_Element; | |
504 | end Delete; | |
505 | ||
506 | procedure Delete (Container : in out Map; Key : Key_Type) is | |
507 | X : constant Count_Type := Key_Ops.Find (Container, Key); | |
508 | ||
509 | begin | |
14f73211 | 510 | if Checks and then X = 0 then |
ff2efe85 AC |
511 | raise Constraint_Error with "key not in map"; |
512 | end if; | |
513 | ||
514 | Tree_Operations.Delete_Node_Sans_Free (Container, X); | |
515 | Tree_Operations.Free (Container, X); | |
516 | end Delete; | |
517 | ||
518 | ------------------ | |
519 | -- Delete_First -- | |
520 | ------------------ | |
521 | ||
522 | procedure Delete_First (Container : in out Map) is | |
523 | X : constant Count_Type := Container.First; | |
524 | ||
525 | begin | |
526 | if X /= 0 then | |
527 | Tree_Operations.Delete_Node_Sans_Free (Container, X); | |
528 | Tree_Operations.Free (Container, X); | |
529 | end if; | |
530 | end Delete_First; | |
531 | ||
532 | ----------------- | |
533 | -- Delete_Last -- | |
534 | ----------------- | |
535 | ||
536 | procedure Delete_Last (Container : in out Map) is | |
537 | X : constant Count_Type := Container.Last; | |
538 | ||
539 | begin | |
540 | if X /= 0 then | |
541 | Tree_Operations.Delete_Node_Sans_Free (Container, X); | |
542 | Tree_Operations.Free (Container, X); | |
543 | end if; | |
544 | end Delete_Last; | |
545 | ||
546 | ------------- | |
547 | -- Element -- | |
548 | ------------- | |
549 | ||
550 | function Element (Position : Cursor) return Element_Type is | |
551 | begin | |
14f73211 | 552 | if Checks and then Position.Node = 0 then |
ff2efe85 AC |
553 | raise Constraint_Error with |
554 | "Position cursor of function Element equals No_Element"; | |
555 | end if; | |
556 | ||
557 | pragma Assert (Vet (Position.Container.all, Position.Node), | |
558 | "Position cursor of function Element is bad"); | |
559 | ||
560 | return Position.Container.Nodes (Position.Node).Element; | |
561 | end Element; | |
562 | ||
563 | function Element (Container : Map; Key : Key_Type) return Element_Type is | |
564 | Node : constant Count_Type := Key_Ops.Find (Container, Key); | |
ff2efe85 | 565 | begin |
14f73211 | 566 | if Checks and then Node = 0 then |
ff2efe85 AC |
567 | raise Constraint_Error with "key not in map"; |
568 | end if; | |
14f73211 BD |
569 | |
570 | return Container.Nodes (Node).Element; | |
ff2efe85 AC |
571 | end Element; |
572 | ||
573 | --------------------- | |
574 | -- Equivalent_Keys -- | |
575 | --------------------- | |
576 | ||
577 | function Equivalent_Keys (Left, Right : Key_Type) return Boolean is | |
578 | begin | |
579 | if Left < Right | |
580 | or else Right < Left | |
581 | then | |
582 | return False; | |
583 | else | |
584 | return True; | |
585 | end if; | |
586 | end Equivalent_Keys; | |
587 | ||
588 | ------------- | |
589 | -- Exclude -- | |
590 | ------------- | |
591 | ||
592 | procedure Exclude (Container : in out Map; Key : Key_Type) is | |
593 | X : constant Count_Type := Key_Ops.Find (Container, Key); | |
594 | ||
595 | begin | |
596 | if X /= 0 then | |
597 | Tree_Operations.Delete_Node_Sans_Free (Container, X); | |
598 | Tree_Operations.Free (Container, X); | |
599 | end if; | |
600 | end Exclude; | |
601 | ||
ef992452 AC |
602 | -------------- |
603 | -- Finalize -- | |
604 | -------------- | |
605 | ||
606 | procedure Finalize (Object : in out Iterator) is | |
607 | begin | |
608 | if Object.Container /= null then | |
14f73211 | 609 | Unbusy (Object.Container.TC); |
3bd783ec AC |
610 | end if; |
611 | end Finalize; | |
612 | ||
ff2efe85 AC |
613 | ---------- |
614 | -- Find -- | |
615 | ---------- | |
616 | ||
617 | function Find (Container : Map; Key : Key_Type) return Cursor is | |
618 | Node : constant Count_Type := Key_Ops.Find (Container, Key); | |
ff2efe85 AC |
619 | begin |
620 | if Node = 0 then | |
621 | return No_Element; | |
d85fd922 AC |
622 | else |
623 | return Cursor'(Container'Unrestricted_Access, Node); | |
ff2efe85 | 624 | end if; |
ff2efe85 AC |
625 | end Find; |
626 | ||
627 | ----------- | |
628 | -- First -- | |
629 | ----------- | |
630 | ||
631 | function First (Container : Map) return Cursor is | |
632 | begin | |
633 | if Container.First = 0 then | |
634 | return No_Element; | |
d85fd922 AC |
635 | else |
636 | return Cursor'(Container'Unrestricted_Access, Container.First); | |
ff2efe85 | 637 | end if; |
ff2efe85 AC |
638 | end First; |
639 | ||
a6dd3a54 | 640 | function First (Object : Iterator) return Cursor is |
a6dd3a54 | 641 | begin |
f947ee34 AC |
642 | -- The value of the iterator object's Node component influences the |
643 | -- behavior of the First (and Last) selector function. | |
644 | ||
645 | -- When the Node component is 0, this means the iterator object was | |
646 | -- constructed without a start expression, in which case the (forward) | |
647 | -- iteration starts from the (logical) beginning of the entire sequence | |
648 | -- of items (corresponding to Container.First, for a forward iterator). | |
649 | ||
650 | -- Otherwise, this is iteration over a partial sequence of items. When | |
651 | -- the Node component is positive, the iterator object was constructed | |
652 | -- with a start expression, that specifies the position from which the | |
653 | -- (forward) partial iteration begins. | |
654 | ||
655 | if Object.Node = 0 then | |
656 | return Bounded_Ordered_Maps.First (Object.Container.all); | |
d85fd922 | 657 | else |
f947ee34 | 658 | return Cursor'(Object.Container, Object.Node); |
a6dd3a54 | 659 | end if; |
a6dd3a54 ES |
660 | end First; |
661 | ||
ff2efe85 AC |
662 | ------------------- |
663 | -- First_Element -- | |
664 | ------------------- | |
665 | ||
666 | function First_Element (Container : Map) return Element_Type is | |
667 | begin | |
14f73211 | 668 | if Checks and then Container.First = 0 then |
ff2efe85 AC |
669 | raise Constraint_Error with "map is empty"; |
670 | end if; | |
14f73211 BD |
671 | |
672 | return Container.Nodes (Container.First).Element; | |
ff2efe85 AC |
673 | end First_Element; |
674 | ||
675 | --------------- | |
676 | -- First_Key -- | |
677 | --------------- | |
678 | ||
679 | function First_Key (Container : Map) return Key_Type is | |
680 | begin | |
14f73211 | 681 | if Checks and then Container.First = 0 then |
ff2efe85 AC |
682 | raise Constraint_Error with "map is empty"; |
683 | end if; | |
14f73211 BD |
684 | |
685 | return Container.Nodes (Container.First).Key; | |
ff2efe85 AC |
686 | end First_Key; |
687 | ||
688 | ----------- | |
689 | -- Floor -- | |
690 | ----------- | |
691 | ||
692 | function Floor (Container : Map; Key : Key_Type) return Cursor is | |
693 | Node : constant Count_Type := Key_Ops.Floor (Container, Key); | |
ff2efe85 AC |
694 | begin |
695 | if Node = 0 then | |
696 | return No_Element; | |
d85fd922 AC |
697 | else |
698 | return Cursor'(Container'Unrestricted_Access, Node); | |
ff2efe85 | 699 | end if; |
ff2efe85 AC |
700 | end Floor; |
701 | ||
14f73211 BD |
702 | ------------------------ |
703 | -- Get_Element_Access -- | |
704 | ------------------------ | |
705 | ||
706 | function Get_Element_Access | |
707 | (Position : Cursor) return not null Element_Access is | |
708 | begin | |
709 | return Position.Container.Nodes (Position.Node).Element'Access; | |
710 | end Get_Element_Access; | |
711 | ||
ff2efe85 AC |
712 | ----------------- |
713 | -- Has_Element -- | |
714 | ----------------- | |
715 | ||
716 | function Has_Element (Position : Cursor) return Boolean is | |
717 | begin | |
718 | return Position /= No_Element; | |
719 | end Has_Element; | |
720 | ||
721 | ------------- | |
722 | -- Include -- | |
723 | ------------- | |
724 | ||
725 | procedure Include | |
726 | (Container : in out Map; | |
727 | Key : Key_Type; | |
728 | New_Item : Element_Type) | |
729 | is | |
730 | Position : Cursor; | |
731 | Inserted : Boolean; | |
732 | ||
733 | begin | |
734 | Insert (Container, Key, New_Item, Position, Inserted); | |
735 | ||
736 | if not Inserted then | |
14f73211 | 737 | TE_Check (Container.TC); |
ff2efe85 AC |
738 | |
739 | declare | |
740 | N : Node_Type renames Container.Nodes (Position.Node); | |
ff2efe85 AC |
741 | begin |
742 | N.Key := Key; | |
743 | N.Element := New_Item; | |
744 | end; | |
745 | end if; | |
746 | end Include; | |
747 | ||
748 | ------------ | |
749 | -- Insert -- | |
750 | ------------ | |
751 | ||
752 | procedure Insert | |
753 | (Container : in out Map; | |
754 | Key : Key_Type; | |
755 | New_Item : Element_Type; | |
756 | Position : out Cursor; | |
757 | Inserted : out Boolean) | |
758 | is | |
759 | procedure Assign (Node : in out Node_Type); | |
760 | pragma Inline (Assign); | |
761 | ||
762 | function New_Node return Count_Type; | |
763 | pragma Inline (New_Node); | |
764 | ||
765 | procedure Insert_Post is | |
766 | new Key_Ops.Generic_Insert_Post (New_Node); | |
767 | ||
768 | procedure Insert_Sans_Hint is | |
769 | new Key_Ops.Generic_Conditional_Insert (Insert_Post); | |
770 | ||
771 | procedure Allocate is | |
772 | new Tree_Operations.Generic_Allocate (Assign); | |
773 | ||
774 | ------------ | |
775 | -- Assign -- | |
776 | ------------ | |
777 | ||
778 | procedure Assign (Node : in out Node_Type) is | |
779 | begin | |
780 | Node.Key := Key; | |
781 | Node.Element := New_Item; | |
782 | end Assign; | |
783 | ||
784 | -------------- | |
785 | -- New_Node -- | |
786 | -------------- | |
787 | ||
788 | function New_Node return Count_Type is | |
789 | Result : Count_Type; | |
ff2efe85 AC |
790 | begin |
791 | Allocate (Container, Result); | |
792 | return Result; | |
793 | end New_Node; | |
794 | ||
795 | -- Start of processing for Insert | |
796 | ||
797 | begin | |
798 | Insert_Sans_Hint | |
799 | (Container, | |
800 | Key, | |
801 | Position.Node, | |
802 | Inserted); | |
803 | ||
804 | Position.Container := Container'Unrestricted_Access; | |
805 | end Insert; | |
806 | ||
807 | procedure Insert | |
808 | (Container : in out Map; | |
809 | Key : Key_Type; | |
810 | New_Item : Element_Type) | |
811 | is | |
812 | Position : Cursor; | |
813 | pragma Unreferenced (Position); | |
814 | ||
815 | Inserted : Boolean; | |
816 | ||
817 | begin | |
818 | Insert (Container, Key, New_Item, Position, Inserted); | |
819 | ||
14f73211 | 820 | if Checks and then not Inserted then |
ff2efe85 AC |
821 | raise Constraint_Error with "key already in map"; |
822 | end if; | |
823 | end Insert; | |
824 | ||
825 | procedure Insert | |
826 | (Container : in out Map; | |
827 | Key : Key_Type; | |
828 | Position : out Cursor; | |
829 | Inserted : out Boolean) | |
830 | is | |
831 | procedure Assign (Node : in out Node_Type); | |
832 | pragma Inline (Assign); | |
833 | ||
834 | function New_Node return Count_Type; | |
835 | pragma Inline (New_Node); | |
836 | ||
837 | procedure Insert_Post is | |
838 | new Key_Ops.Generic_Insert_Post (New_Node); | |
839 | ||
840 | procedure Insert_Sans_Hint is | |
841 | new Key_Ops.Generic_Conditional_Insert (Insert_Post); | |
842 | ||
843 | procedure Allocate is | |
844 | new Tree_Operations.Generic_Allocate (Assign); | |
845 | ||
846 | ------------ | |
847 | -- Assign -- | |
848 | ------------ | |
849 | ||
850 | procedure Assign (Node : in out Node_Type) is | |
b7051481 AC |
851 | pragma Warnings (Off); |
852 | Default_Initialized_Item : Element_Type; | |
853 | pragma Unmodified (Default_Initialized_Item); | |
fe4552f4 AC |
854 | -- Default-initialized element (ok to reference, see below) |
855 | ||
ff2efe85 AC |
856 | begin |
857 | Node.Key := Key; | |
d85fd922 | 858 | |
3e586e10 AC |
859 | -- There is no explicit element provided, but in an instance the element |
860 | -- type may be a scalar with a Default_Value aspect, or a composite type | |
861 | -- with such a scalar component or with defaulted components, so insert | |
862 | -- possibly initialized elements at the given position. | |
fe4552f4 | 863 | |
b7051481 AC |
864 | Node.Element := Default_Initialized_Item; |
865 | pragma Warnings (On); | |
ff2efe85 AC |
866 | end Assign; |
867 | ||
868 | -------------- | |
869 | -- New_Node -- | |
870 | -------------- | |
871 | ||
872 | function New_Node return Count_Type is | |
873 | Result : Count_Type; | |
ff2efe85 AC |
874 | begin |
875 | Allocate (Container, Result); | |
876 | return Result; | |
877 | end New_Node; | |
878 | ||
879 | -- Start of processing for Insert | |
880 | ||
881 | begin | |
882 | Insert_Sans_Hint | |
883 | (Container, | |
884 | Key, | |
885 | Position.Node, | |
886 | Inserted); | |
887 | ||
888 | Position.Container := Container'Unrestricted_Access; | |
889 | end Insert; | |
890 | ||
891 | -------------- | |
892 | -- Is_Empty -- | |
893 | -------------- | |
894 | ||
895 | function Is_Empty (Container : Map) return Boolean is | |
896 | begin | |
897 | return Container.Length = 0; | |
898 | end Is_Empty; | |
899 | ||
900 | ------------------------- | |
901 | -- Is_Greater_Key_Node -- | |
902 | ------------------------- | |
903 | ||
904 | function Is_Greater_Key_Node | |
905 | (Left : Key_Type; | |
906 | Right : Node_Type) return Boolean | |
907 | is | |
908 | begin | |
d85fd922 | 909 | -- Left > Right same as Right < Left |
ff2efe85 AC |
910 | |
911 | return Right.Key < Left; | |
912 | end Is_Greater_Key_Node; | |
913 | ||
914 | ---------------------- | |
915 | -- Is_Less_Key_Node -- | |
916 | ---------------------- | |
917 | ||
918 | function Is_Less_Key_Node | |
919 | (Left : Key_Type; | |
920 | Right : Node_Type) return Boolean | |
921 | is | |
922 | begin | |
923 | return Left < Right.Key; | |
924 | end Is_Less_Key_Node; | |
925 | ||
926 | ------------- | |
927 | -- Iterate -- | |
928 | ------------- | |
929 | ||
930 | procedure Iterate | |
931 | (Container : Map; | |
932 | Process : not null access procedure (Position : Cursor)) | |
933 | is | |
934 | procedure Process_Node (Node : Count_Type); | |
935 | pragma Inline (Process_Node); | |
936 | ||
937 | procedure Local_Iterate is | |
938 | new Tree_Operations.Generic_Iteration (Process_Node); | |
939 | ||
940 | ------------------ | |
941 | -- Process_Node -- | |
942 | ------------------ | |
943 | ||
944 | procedure Process_Node (Node : Count_Type) is | |
945 | begin | |
946 | Process (Cursor'(Container'Unrestricted_Access, Node)); | |
947 | end Process_Node; | |
948 | ||
14f73211 | 949 | Busy : With_Busy (Container.TC'Unrestricted_Access); |
ff2efe85 AC |
950 | |
951 | -- Start of processing for Iterate | |
952 | ||
953 | begin | |
14f73211 | 954 | Local_Iterate (Container); |
ff2efe85 AC |
955 | end Iterate; |
956 | ||
a6dd3a54 | 957 | function Iterate |
f947ee34 | 958 | (Container : Map) return Map_Iterator_Interfaces.Reversible_Iterator'Class |
a6dd3a54 | 959 | is |
a6dd3a54 | 960 | begin |
f947ee34 AC |
961 | -- The value of the Node component influences the behavior of the First |
962 | -- and Last selector functions of the iterator object. When the Node | |
963 | -- component is 0 (as is the case here), this means the iterator object | |
964 | -- was constructed without a start expression. This is a complete | |
965 | -- iterator, meaning that the iteration starts from the (logical) | |
966 | -- beginning of the sequence of items. | |
967 | ||
968 | -- Note: For a forward iterator, Container.First is the beginning, and | |
969 | -- for a reverse iterator, Container.Last is the beginning. | |
970 | ||
ef992452 | 971 | return It : constant Iterator := |
15f0f591 AC |
972 | (Limited_Controlled with |
973 | Container => Container'Unrestricted_Access, | |
974 | Node => 0) | |
ef992452 | 975 | do |
14f73211 | 976 | Busy (Container.TC'Unrestricted_Access.all); |
ef992452 | 977 | end return; |
a6dd3a54 ES |
978 | end Iterate; |
979 | ||
d85fd922 AC |
980 | function Iterate |
981 | (Container : Map; | |
982 | Start : Cursor) | |
f947ee34 | 983 | return Map_Iterator_Interfaces.Reversible_Iterator'Class |
a6dd3a54 | 984 | is |
ef992452 AC |
985 | begin |
986 | -- Iterator was defined to behave the same as for a complete iterator, | |
f947ee34 AC |
987 | -- and iterate over the entire sequence of items. However, those |
988 | -- semantics were unintuitive and arguably error-prone (it is too easy | |
989 | -- to accidentally create an endless loop), and so they were changed, | |
990 | -- per the ARG meeting in Denver on 2011/11. However, there was no | |
991 | -- consensus about what positive meaning this corner case should have, | |
992 | -- and so it was decided to simply raise an exception. This does imply, | |
993 | -- however, that it is not possible to use a partial iterator to specify | |
994 | -- an empty sequence of items. | |
995 | ||
14f73211 | 996 | if Checks and then Start = No_Element then |
f947ee34 AC |
997 | raise Constraint_Error with |
998 | "Start position for iterator equals No_Element"; | |
999 | end if; | |
1000 | ||
14f73211 | 1001 | if Checks and then Start.Container /= Container'Unrestricted_Access then |
f947ee34 AC |
1002 | raise Program_Error with |
1003 | "Start cursor of Iterate designates wrong map"; | |
1004 | end if; | |
1005 | ||
1006 | pragma Assert (Vet (Container, Start.Node), | |
1007 | "Start cursor of Iterate is bad"); | |
1008 | ||
1009 | -- The value of the Node component influences the behavior of the First | |
1010 | -- and Last selector functions of the iterator object. When the Node | |
1011 | -- component is positive (as is the case here), it means that this | |
1012 | -- is a partial iteration, over a subset of the complete sequence of | |
1013 | -- items. The iterator object was constructed with a start expression, | |
1014 | -- indicating the position from which the iteration begins. (Note that | |
1015 | -- the start position has the same value irrespective of whether this | |
1016 | -- is a forward or reverse iteration.) | |
1017 | ||
ef992452 | 1018 | return It : constant Iterator := |
15f0f591 AC |
1019 | (Limited_Controlled with |
1020 | Container => Container'Unrestricted_Access, | |
1021 | Node => Start.Node) | |
ef992452 | 1022 | do |
14f73211 | 1023 | Busy (Container.TC'Unrestricted_Access.all); |
ef992452 | 1024 | end return; |
a6dd3a54 ES |
1025 | end Iterate; |
1026 | ||
ff2efe85 AC |
1027 | --------- |
1028 | -- Key -- | |
1029 | --------- | |
1030 | ||
1031 | function Key (Position : Cursor) return Key_Type is | |
1032 | begin | |
14f73211 | 1033 | if Checks and then Position.Node = 0 then |
ff2efe85 AC |
1034 | raise Constraint_Error with |
1035 | "Position cursor of function Key equals No_Element"; | |
1036 | end if; | |
1037 | ||
1038 | pragma Assert (Vet (Position.Container.all, Position.Node), | |
1039 | "Position cursor of function Key is bad"); | |
1040 | ||
1041 | return Position.Container.Nodes (Position.Node).Key; | |
1042 | end Key; | |
1043 | ||
1044 | ---------- | |
1045 | -- Last -- | |
1046 | ---------- | |
1047 | ||
1048 | function Last (Container : Map) return Cursor is | |
1049 | begin | |
1050 | if Container.Last = 0 then | |
1051 | return No_Element; | |
d85fd922 AC |
1052 | else |
1053 | return Cursor'(Container'Unrestricted_Access, Container.Last); | |
ff2efe85 | 1054 | end if; |
ff2efe85 AC |
1055 | end Last; |
1056 | ||
a6dd3a54 | 1057 | function Last (Object : Iterator) return Cursor is |
a6dd3a54 | 1058 | begin |
f947ee34 AC |
1059 | -- The value of the iterator object's Node component influences the |
1060 | -- behavior of the Last (and First) selector function. | |
1061 | ||
1062 | -- When the Node component is 0, this means the iterator object was | |
1063 | -- constructed without a start expression, in which case the (reverse) | |
1064 | -- iteration starts from the (logical) beginning of the entire sequence | |
1065 | -- (corresponding to Container.Last, for a reverse iterator). | |
1066 | ||
1067 | -- Otherwise, this is iteration over a partial sequence of items. When | |
1068 | -- the Node component is positive, the iterator object was constructed | |
1069 | -- with a start expression, that specifies the position from which the | |
1070 | -- (reverse) partial iteration begins. | |
1071 | ||
1072 | if Object.Node = 0 then | |
1073 | return Bounded_Ordered_Maps.Last (Object.Container.all); | |
d85fd922 | 1074 | else |
f947ee34 | 1075 | return Cursor'(Object.Container, Object.Node); |
a6dd3a54 | 1076 | end if; |
a6dd3a54 ES |
1077 | end Last; |
1078 | ||
ff2efe85 AC |
1079 | ------------------ |
1080 | -- Last_Element -- | |
1081 | ------------------ | |
1082 | ||
1083 | function Last_Element (Container : Map) return Element_Type is | |
1084 | begin | |
14f73211 | 1085 | if Checks and then Container.Last = 0 then |
ff2efe85 AC |
1086 | raise Constraint_Error with "map is empty"; |
1087 | end if; | |
14f73211 BD |
1088 | |
1089 | return Container.Nodes (Container.Last).Element; | |
ff2efe85 AC |
1090 | end Last_Element; |
1091 | ||
1092 | -------------- | |
1093 | -- Last_Key -- | |
1094 | -------------- | |
1095 | ||
1096 | function Last_Key (Container : Map) return Key_Type is | |
1097 | begin | |
14f73211 | 1098 | if Checks and then Container.Last = 0 then |
ff2efe85 AC |
1099 | raise Constraint_Error with "map is empty"; |
1100 | end if; | |
14f73211 BD |
1101 | |
1102 | return Container.Nodes (Container.Last).Key; | |
ff2efe85 AC |
1103 | end Last_Key; |
1104 | ||
1105 | ---------- | |
1106 | -- Left -- | |
1107 | ---------- | |
1108 | ||
1109 | function Left (Node : Node_Type) return Count_Type is | |
1110 | begin | |
1111 | return Node.Left; | |
1112 | end Left; | |
1113 | ||
1114 | ------------ | |
1115 | -- Length -- | |
1116 | ------------ | |
1117 | ||
1118 | function Length (Container : Map) return Count_Type is | |
1119 | begin | |
1120 | return Container.Length; | |
1121 | end Length; | |
1122 | ||
1123 | ---------- | |
1124 | -- Move -- | |
1125 | ---------- | |
1126 | ||
1127 | procedure Move (Target : in out Map; Source : in out Map) is | |
1128 | begin | |
1129 | if Target'Address = Source'Address then | |
1130 | return; | |
1131 | end if; | |
1132 | ||
14f73211 | 1133 | TC_Check (Source.TC); |
ff2efe85 | 1134 | |
dfbf013f MH |
1135 | Target.Assign (Source); |
1136 | Source.Clear; | |
ff2efe85 AC |
1137 | end Move; |
1138 | ||
1139 | ---------- | |
1140 | -- Next -- | |
1141 | ---------- | |
1142 | ||
1143 | procedure Next (Position : in out Cursor) is | |
1144 | begin | |
1145 | Position := Next (Position); | |
1146 | end Next; | |
1147 | ||
1148 | function Next (Position : Cursor) return Cursor is | |
1149 | begin | |
1150 | if Position = No_Element then | |
1151 | return No_Element; | |
1152 | end if; | |
1153 | ||
1154 | pragma Assert (Vet (Position.Container.all, Position.Node), | |
1155 | "Position cursor of Next is bad"); | |
1156 | ||
1157 | declare | |
1158 | M : Map renames Position.Container.all; | |
1159 | ||
1160 | Node : constant Count_Type := | |
15f0f591 | 1161 | Tree_Operations.Next (M, Position.Node); |
ff2efe85 AC |
1162 | |
1163 | begin | |
1164 | if Node = 0 then | |
1165 | return No_Element; | |
1166 | end if; | |
1167 | ||
1168 | return Cursor'(Position.Container, Node); | |
1169 | end; | |
1170 | end Next; | |
1171 | ||
a6dd3a54 ES |
1172 | function Next |
1173 | (Object : Iterator; | |
1174 | Position : Cursor) return Cursor | |
1175 | is | |
a6dd3a54 | 1176 | begin |
f947ee34 AC |
1177 | if Position.Container = null then |
1178 | return No_Element; | |
1179 | end if; | |
1180 | ||
14f73211 | 1181 | if Checks and then Position.Container /= Object.Container then |
f947ee34 AC |
1182 | raise Program_Error with |
1183 | "Position cursor of Next designates wrong map"; | |
1184 | end if; | |
1185 | ||
a6dd3a54 ES |
1186 | return Next (Position); |
1187 | end Next; | |
1188 | ||
ff2efe85 AC |
1189 | ------------ |
1190 | -- Parent -- | |
1191 | ------------ | |
1192 | ||
1193 | function Parent (Node : Node_Type) return Count_Type is | |
1194 | begin | |
1195 | return Node.Parent; | |
1196 | end Parent; | |
1197 | ||
1198 | -------------- | |
1199 | -- Previous -- | |
1200 | -------------- | |
1201 | ||
1202 | procedure Previous (Position : in out Cursor) is | |
1203 | begin | |
1204 | Position := Previous (Position); | |
1205 | end Previous; | |
1206 | ||
1207 | function Previous (Position : Cursor) return Cursor is | |
1208 | begin | |
1209 | if Position = No_Element then | |
1210 | return No_Element; | |
1211 | end if; | |
1212 | ||
1213 | pragma Assert (Vet (Position.Container.all, Position.Node), | |
1214 | "Position cursor of Previous is bad"); | |
1215 | ||
1216 | declare | |
1217 | M : Map renames Position.Container.all; | |
1218 | ||
1219 | Node : constant Count_Type := | |
15f0f591 | 1220 | Tree_Operations.Previous (M, Position.Node); |
ff2efe85 AC |
1221 | |
1222 | begin | |
1223 | if Node = 0 then | |
1224 | return No_Element; | |
1225 | end if; | |
1226 | ||
1227 | return Cursor'(Position.Container, Node); | |
1228 | end; | |
1229 | end Previous; | |
1230 | ||
a6dd3a54 ES |
1231 | function Previous |
1232 | (Object : Iterator; | |
1233 | Position : Cursor) return Cursor | |
1234 | is | |
a6dd3a54 | 1235 | begin |
f947ee34 AC |
1236 | if Position.Container = null then |
1237 | return No_Element; | |
1238 | end if; | |
1239 | ||
14f73211 | 1240 | if Checks and then Position.Container /= Object.Container then |
f947ee34 AC |
1241 | raise Program_Error with |
1242 | "Position cursor of Previous designates wrong map"; | |
1243 | end if; | |
1244 | ||
a6dd3a54 ES |
1245 | return Previous (Position); |
1246 | end Previous; | |
1247 | ||
14f73211 BD |
1248 | ---------------------- |
1249 | -- Pseudo_Reference -- | |
1250 | ---------------------- | |
1251 | ||
1252 | function Pseudo_Reference | |
1253 | (Container : aliased Map'Class) return Reference_Control_Type | |
1254 | is | |
1255 | TC : constant Tamper_Counts_Access := | |
1256 | Container.TC'Unrestricted_Access; | |
1257 | begin | |
1258 | return R : constant Reference_Control_Type := (Controlled with TC) do | |
2f26abcc | 1259 | Busy (TC.all); |
14f73211 BD |
1260 | end return; |
1261 | end Pseudo_Reference; | |
1262 | ||
ff2efe85 AC |
1263 | ------------------- |
1264 | -- Query_Element -- | |
1265 | ------------------- | |
1266 | ||
1267 | procedure Query_Element | |
1268 | (Position : Cursor; | |
1269 | Process : not null access procedure (Key : Key_Type; | |
1270 | Element : Element_Type)) | |
1271 | is | |
1272 | begin | |
14f73211 | 1273 | if Checks and then Position.Node = 0 then |
ff2efe85 AC |
1274 | raise Constraint_Error with |
1275 | "Position cursor of Query_Element equals No_Element"; | |
1276 | end if; | |
1277 | ||
1278 | pragma Assert (Vet (Position.Container.all, Position.Node), | |
1279 | "Position cursor of Query_Element is bad"); | |
1280 | ||
1281 | declare | |
1282 | M : Map renames Position.Container.all; | |
1283 | N : Node_Type renames M.Nodes (Position.Node); | |
14f73211 | 1284 | Lock : With_Lock (M.TC'Unrestricted_Access); |
ff2efe85 | 1285 | begin |
14f73211 | 1286 | Process (N.Key, N.Element); |
ff2efe85 AC |
1287 | end; |
1288 | end Query_Element; | |
1289 | ||
1290 | ---------- | |
1291 | -- Read -- | |
1292 | ---------- | |
1293 | ||
1294 | procedure Read | |
1295 | (Stream : not null access Root_Stream_Type'Class; | |
1296 | Container : out Map) | |
1297 | is | |
1298 | procedure Read_Element (Node : in out Node_Type); | |
1299 | pragma Inline (Read_Element); | |
1300 | ||
1301 | procedure Allocate is | |
1302 | new Tree_Operations.Generic_Allocate (Read_Element); | |
1303 | ||
1304 | procedure Read_Elements is | |
1305 | new Tree_Operations.Generic_Read (Allocate); | |
1306 | ||
1307 | ------------------ | |
1308 | -- Read_Element -- | |
1309 | ------------------ | |
1310 | ||
1311 | procedure Read_Element (Node : in out Node_Type) is | |
1312 | begin | |
1313 | Key_Type'Read (Stream, Node.Key); | |
1314 | Element_Type'Read (Stream, Node.Element); | |
1315 | end Read_Element; | |
1316 | ||
1317 | -- Start of processing for Read | |
1318 | ||
1319 | begin | |
1320 | Read_Elements (Stream, Container); | |
1321 | end Read; | |
1322 | ||
1323 | procedure Read | |
1324 | (Stream : not null access Root_Stream_Type'Class; | |
1325 | Item : out Cursor) | |
1326 | is | |
1327 | begin | |
1328 | raise Program_Error with "attempt to stream map cursor"; | |
1329 | end Read; | |
1330 | ||
a6dd3a54 ES |
1331 | procedure Read |
1332 | (Stream : not null access Root_Stream_Type'Class; | |
1333 | Item : out Reference_Type) | |
1334 | is | |
1335 | begin | |
1336 | raise Program_Error with "attempt to stream reference"; | |
1337 | end Read; | |
1338 | ||
1339 | procedure Read | |
1340 | (Stream : not null access Root_Stream_Type'Class; | |
1341 | Item : out Constant_Reference_Type) | |
1342 | is | |
1343 | begin | |
1344 | raise Program_Error with "attempt to stream reference"; | |
1345 | end Read; | |
1346 | ||
1347 | --------------- | |
1348 | -- Reference -- | |
1349 | --------------- | |
1350 | ||
c9423ca3 AC |
1351 | function Reference |
1352 | (Container : aliased in out Map; | |
1353 | Position : Cursor) return Reference_Type | |
a6dd3a54 ES |
1354 | is |
1355 | begin | |
14f73211 | 1356 | if Checks and then Position.Container = null then |
c9423ca3 AC |
1357 | raise Constraint_Error with |
1358 | "Position cursor has no element"; | |
1359 | end if; | |
1360 | ||
14f73211 BD |
1361 | if Checks and then Position.Container /= Container'Unrestricted_Access |
1362 | then | |
c9423ca3 AC |
1363 | raise Program_Error with |
1364 | "Position cursor designates wrong map"; | |
1365 | end if; | |
1366 | ||
1367 | pragma Assert (Vet (Container, Position.Node), | |
1368 | "Position cursor in function Reference is bad"); | |
1369 | ||
1370 | declare | |
1371 | N : Node_Type renames Container.Nodes (Position.Node); | |
14f73211 BD |
1372 | TC : constant Tamper_Counts_Access := |
1373 | Container.TC'Unrestricted_Access; | |
c9423ca3 | 1374 | begin |
3bd783ec AC |
1375 | return R : constant Reference_Type := |
1376 | (Element => N.Element'Access, | |
14f73211 | 1377 | Control => (Controlled with TC)) |
3bd783ec | 1378 | do |
2f26abcc | 1379 | Busy (TC.all); |
3bd783ec | 1380 | end return; |
c9423ca3 AC |
1381 | end; |
1382 | end Reference; | |
a6dd3a54 | 1383 | |
d85fd922 | 1384 | function Reference |
c9423ca3 | 1385 | (Container : aliased in out Map; |
d85fd922 | 1386 | Key : Key_Type) return Reference_Type |
a6dd3a54 | 1387 | is |
c9423ca3 AC |
1388 | Node : constant Count_Type := Key_Ops.Find (Container, Key); |
1389 | ||
a6dd3a54 | 1390 | begin |
14f73211 | 1391 | if Checks and then Node = 0 then |
c9423ca3 AC |
1392 | raise Constraint_Error with "key not in map"; |
1393 | end if; | |
1394 | ||
1395 | declare | |
1396 | N : Node_Type renames Container.Nodes (Node); | |
14f73211 BD |
1397 | TC : constant Tamper_Counts_Access := |
1398 | Container.TC'Unrestricted_Access; | |
c9423ca3 | 1399 | begin |
3bd783ec AC |
1400 | return R : constant Reference_Type := |
1401 | (Element => N.Element'Access, | |
14f73211 | 1402 | Control => (Controlled with TC)) |
3bd783ec | 1403 | do |
2f26abcc | 1404 | Busy (TC.all); |
3bd783ec | 1405 | end return; |
c9423ca3 | 1406 | end; |
a6dd3a54 ES |
1407 | end Reference; |
1408 | ||
ff2efe85 AC |
1409 | ------------- |
1410 | -- Replace -- | |
1411 | ------------- | |
1412 | ||
1413 | procedure Replace | |
1414 | (Container : in out Map; | |
1415 | Key : Key_Type; | |
1416 | New_Item : Element_Type) | |
1417 | is | |
1418 | Node : constant Count_Type := Key_Ops.Find (Container, Key); | |
1419 | ||
1420 | begin | |
14f73211 | 1421 | if Checks and then Node = 0 then |
ff2efe85 AC |
1422 | raise Constraint_Error with "key not in map"; |
1423 | end if; | |
1424 | ||
14f73211 | 1425 | TE_Check (Container.TC); |
ff2efe85 AC |
1426 | |
1427 | declare | |
1428 | N : Node_Type renames Container.Nodes (Node); | |
1429 | ||
1430 | begin | |
1431 | N.Key := Key; | |
1432 | N.Element := New_Item; | |
1433 | end; | |
1434 | end Replace; | |
1435 | ||
1436 | --------------------- | |
1437 | -- Replace_Element -- | |
1438 | --------------------- | |
1439 | ||
1440 | procedure Replace_Element | |
1441 | (Container : in out Map; | |
1442 | Position : Cursor; | |
1443 | New_Item : Element_Type) | |
1444 | is | |
1445 | begin | |
14f73211 | 1446 | if Checks and then Position.Node = 0 then |
ff2efe85 AC |
1447 | raise Constraint_Error with |
1448 | "Position cursor of Replace_Element equals No_Element"; | |
1449 | end if; | |
1450 | ||
14f73211 BD |
1451 | if Checks and then Position.Container /= Container'Unrestricted_Access |
1452 | then | |
ff2efe85 AC |
1453 | raise Program_Error with |
1454 | "Position cursor of Replace_Element designates wrong map"; | |
1455 | end if; | |
1456 | ||
14f73211 | 1457 | TE_Check (Container.TC); |
ff2efe85 AC |
1458 | |
1459 | pragma Assert (Vet (Container, Position.Node), | |
1460 | "Position cursor of Replace_Element is bad"); | |
1461 | ||
1462 | Container.Nodes (Position.Node).Element := New_Item; | |
1463 | end Replace_Element; | |
1464 | ||
1465 | --------------------- | |
1466 | -- Reverse_Iterate -- | |
1467 | --------------------- | |
1468 | ||
1469 | procedure Reverse_Iterate | |
1470 | (Container : Map; | |
1471 | Process : not null access procedure (Position : Cursor)) | |
1472 | is | |
1473 | procedure Process_Node (Node : Count_Type); | |
1474 | pragma Inline (Process_Node); | |
1475 | ||
1476 | procedure Local_Reverse_Iterate is | |
1477 | new Tree_Operations.Generic_Reverse_Iteration (Process_Node); | |
1478 | ||
1479 | ------------------ | |
1480 | -- Process_Node -- | |
1481 | ------------------ | |
1482 | ||
1483 | procedure Process_Node (Node : Count_Type) is | |
1484 | begin | |
1485 | Process (Cursor'(Container'Unrestricted_Access, Node)); | |
1486 | end Process_Node; | |
1487 | ||
14f73211 | 1488 | Busy : With_Busy (Container.TC'Unrestricted_Access); |
ff2efe85 | 1489 | |
d85fd922 | 1490 | -- Start of processing for Reverse_Iterate |
ff2efe85 AC |
1491 | |
1492 | begin | |
14f73211 | 1493 | Local_Reverse_Iterate (Container); |
ff2efe85 AC |
1494 | end Reverse_Iterate; |
1495 | ||
1496 | ----------- | |
1497 | -- Right -- | |
1498 | ----------- | |
1499 | ||
1500 | function Right (Node : Node_Type) return Count_Type is | |
1501 | begin | |
1502 | return Node.Right; | |
1503 | end Right; | |
1504 | ||
1505 | --------------- | |
1506 | -- Set_Color -- | |
1507 | --------------- | |
1508 | ||
1509 | procedure Set_Color | |
1510 | (Node : in out Node_Type; | |
1511 | Color : Color_Type) | |
1512 | is | |
1513 | begin | |
1514 | Node.Color := Color; | |
1515 | end Set_Color; | |
1516 | ||
1517 | -------------- | |
1518 | -- Set_Left -- | |
1519 | -------------- | |
1520 | ||
1521 | procedure Set_Left (Node : in out Node_Type; Left : Count_Type) is | |
1522 | begin | |
1523 | Node.Left := Left; | |
1524 | end Set_Left; | |
1525 | ||
1526 | ---------------- | |
1527 | -- Set_Parent -- | |
1528 | ---------------- | |
1529 | ||
1530 | procedure Set_Parent (Node : in out Node_Type; Parent : Count_Type) is | |
1531 | begin | |
1532 | Node.Parent := Parent; | |
1533 | end Set_Parent; | |
1534 | ||
1535 | --------------- | |
1536 | -- Set_Right -- | |
1537 | --------------- | |
1538 | ||
1539 | procedure Set_Right (Node : in out Node_Type; Right : Count_Type) is | |
1540 | begin | |
1541 | Node.Right := Right; | |
1542 | end Set_Right; | |
1543 | ||
1544 | -------------------- | |
1545 | -- Update_Element -- | |
1546 | -------------------- | |
1547 | ||
1548 | procedure Update_Element | |
1549 | (Container : in out Map; | |
1550 | Position : Cursor; | |
1551 | Process : not null access procedure (Key : Key_Type; | |
1552 | Element : in out Element_Type)) | |
1553 | is | |
1554 | begin | |
14f73211 | 1555 | if Checks and then Position.Node = 0 then |
ff2efe85 AC |
1556 | raise Constraint_Error with |
1557 | "Position cursor of Update_Element equals No_Element"; | |
1558 | end if; | |
1559 | ||
14f73211 BD |
1560 | if Checks and then Position.Container /= Container'Unrestricted_Access |
1561 | then | |
ff2efe85 AC |
1562 | raise Program_Error with |
1563 | "Position cursor of Update_Element designates wrong map"; | |
1564 | end if; | |
1565 | ||
1566 | pragma Assert (Vet (Container, Position.Node), | |
1567 | "Position cursor of Update_Element is bad"); | |
1568 | ||
1569 | declare | |
1570 | N : Node_Type renames Container.Nodes (Position.Node); | |
14f73211 | 1571 | Lock : With_Lock (Container.TC'Unrestricted_Access); |
ff2efe85 | 1572 | begin |
14f73211 | 1573 | Process (N.Key, N.Element); |
ff2efe85 AC |
1574 | end; |
1575 | end Update_Element; | |
1576 | ||
1577 | ----------- | |
1578 | -- Write -- | |
1579 | ----------- | |
1580 | ||
1581 | procedure Write | |
1582 | (Stream : not null access Root_Stream_Type'Class; | |
1583 | Container : Map) | |
1584 | is | |
1585 | procedure Write_Node | |
1586 | (Stream : not null access Root_Stream_Type'Class; | |
1587 | Node : Node_Type); | |
1588 | pragma Inline (Write_Node); | |
1589 | ||
1590 | procedure Write_Nodes is | |
1591 | new Tree_Operations.Generic_Write (Write_Node); | |
1592 | ||
1593 | ---------------- | |
1594 | -- Write_Node -- | |
1595 | ---------------- | |
1596 | ||
1597 | procedure Write_Node | |
1598 | (Stream : not null access Root_Stream_Type'Class; | |
1599 | Node : Node_Type) | |
1600 | is | |
1601 | begin | |
1602 | Key_Type'Write (Stream, Node.Key); | |
1603 | Element_Type'Write (Stream, Node.Element); | |
1604 | end Write_Node; | |
1605 | ||
1606 | -- Start of processing for Write | |
1607 | ||
1608 | begin | |
1609 | Write_Nodes (Stream, Container); | |
1610 | end Write; | |
1611 | ||
1612 | procedure Write | |
1613 | (Stream : not null access Root_Stream_Type'Class; | |
1614 | Item : Cursor) | |
1615 | is | |
1616 | begin | |
1617 | raise Program_Error with "attempt to stream map cursor"; | |
1618 | end Write; | |
1619 | ||
a6dd3a54 ES |
1620 | procedure Write |
1621 | (Stream : not null access Root_Stream_Type'Class; | |
1622 | Item : Reference_Type) | |
1623 | is | |
1624 | begin | |
1625 | raise Program_Error with "attempt to stream reference"; | |
1626 | end Write; | |
1627 | ||
1628 | procedure Write | |
1629 | (Stream : not null access Root_Stream_Type'Class; | |
1630 | Item : Constant_Reference_Type) | |
1631 | is | |
1632 | begin | |
1633 | raise Program_Error with "attempt to stream reference"; | |
1634 | end Write; | |
1635 | ||
ff2efe85 | 1636 | end Ada.Containers.Bounded_Ordered_Maps; |