1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_BOUNDED_SET_OPERATIONS -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2004-2013, Free Software Foundation, Inc. -- 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 30with System; use type System.Address; 31 32package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations is 33 34 ----------------------- 35 -- Local Subprograms -- 36 ----------------------- 37 38 function Copy (Source : Set_Type) return Set_Type; 39 40 ---------- 41 -- Copy -- 42 ---------- 43 44 function Copy (Source : Set_Type) return Set_Type is 45 begin 46 return Target : Set_Type (Source.Length) do 47 Assign (Target => Target, Source => Source); 48 end return; 49 end Copy; 50 51 ---------------- 52 -- Difference -- 53 ---------------- 54 55 procedure Set_Difference (Target : in out Set_Type; Source : Set_Type) is 56 BT : Natural renames Target.Busy; 57 LT : Natural renames Target.Lock; 58 59 BS : Natural renames Source'Unrestricted_Access.Busy; 60 LS : Natural renames Source'Unrestricted_Access.Lock; 61 62 Tgt, Src : Count_Type; 63 64 TN : Nodes_Type renames Target.Nodes; 65 SN : Nodes_Type renames Source.Nodes; 66 67 Compare : Integer; 68 69 begin 70 if Target'Address = Source'Address then 71 if Target.Busy > 0 then 72 raise Program_Error with 73 "attempt to tamper with cursors (container is busy)"; 74 end if; 75 76 Tree_Operations.Clear_Tree (Target); 77 return; 78 end if; 79 80 if Source.Length = 0 then 81 return; 82 end if; 83 84 if Target.Busy > 0 then 85 raise Program_Error with 86 "attempt to tamper with cursors (container is busy)"; 87 end if; 88 89 Tgt := Target.First; 90 Src := Source.First; 91 loop 92 if Tgt = 0 then 93 exit; 94 end if; 95 96 if Src = 0 then 97 exit; 98 end if; 99 100 -- Per AI05-0022, the container implementation is required to detect 101 -- element tampering by a generic actual subprogram. 102 103 begin 104 BT := BT + 1; 105 LT := LT + 1; 106 107 BS := BS + 1; 108 LS := LS + 1; 109 110 if Is_Less (TN (Tgt), SN (Src)) then 111 Compare := -1; 112 elsif Is_Less (SN (Src), TN (Tgt)) then 113 Compare := 1; 114 else 115 Compare := 0; 116 end if; 117 118 BT := BT - 1; 119 LT := LT - 1; 120 121 BS := BS - 1; 122 LS := LS - 1; 123 exception 124 when others => 125 BT := BT - 1; 126 LT := LT - 1; 127 128 BS := BS - 1; 129 LS := LS - 1; 130 131 raise; 132 end; 133 134 if Compare < 0 then 135 Tgt := Tree_Operations.Next (Target, Tgt); 136 137 elsif Compare > 0 then 138 Src := Tree_Operations.Next (Source, Src); 139 140 else 141 declare 142 X : constant Count_Type := Tgt; 143 begin 144 Tgt := Tree_Operations.Next (Target, Tgt); 145 146 Tree_Operations.Delete_Node_Sans_Free (Target, X); 147 Tree_Operations.Free (Target, X); 148 end; 149 150 Src := Tree_Operations.Next (Source, Src); 151 end if; 152 end loop; 153 end Set_Difference; 154 155 function Set_Difference (Left, Right : Set_Type) return Set_Type is 156 begin 157 if Left'Address = Right'Address then 158 return S : Set_Type (0); -- Empty set 159 end if; 160 161 if Left.Length = 0 then 162 return S : Set_Type (0); -- Empty set 163 end if; 164 165 if Right.Length = 0 then 166 return Copy (Left); 167 end if; 168 169 return Result : Set_Type (Left.Length) do 170 -- Per AI05-0022, the container implementation is required to detect 171 -- element tampering by a generic actual subprogram. 172 173 declare 174 BL : Natural renames Left'Unrestricted_Access.Busy; 175 LL : Natural renames Left'Unrestricted_Access.Lock; 176 177 BR : Natural renames Right'Unrestricted_Access.Busy; 178 LR : Natural renames Right'Unrestricted_Access.Lock; 179 180 L_Node : Count_Type; 181 R_Node : Count_Type; 182 183 Dst_Node : Count_Type; 184 pragma Warnings (Off, Dst_Node); 185 186 begin 187 BL := BL + 1; 188 LL := LL + 1; 189 190 BR := BR + 1; 191 LR := LR + 1; 192 193 L_Node := Left.First; 194 R_Node := Right.First; 195 loop 196 if L_Node = 0 then 197 exit; 198 end if; 199 200 if R_Node = 0 then 201 while L_Node /= 0 loop 202 Insert_With_Hint 203 (Dst_Set => Result, 204 Dst_Hint => 0, 205 Src_Node => Left.Nodes (L_Node), 206 Dst_Node => Dst_Node); 207 208 L_Node := Tree_Operations.Next (Left, L_Node); 209 end loop; 210 211 exit; 212 end if; 213 214 if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then 215 Insert_With_Hint 216 (Dst_Set => Result, 217 Dst_Hint => 0, 218 Src_Node => Left.Nodes (L_Node), 219 Dst_Node => Dst_Node); 220 221 L_Node := Tree_Operations.Next (Left, L_Node); 222 223 elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then 224 R_Node := Tree_Operations.Next (Right, R_Node); 225 226 else 227 L_Node := Tree_Operations.Next (Left, L_Node); 228 R_Node := Tree_Operations.Next (Right, R_Node); 229 end if; 230 end loop; 231 232 BL := BL - 1; 233 LL := LL - 1; 234 235 BR := BR - 1; 236 LR := LR - 1; 237 exception 238 when others => 239 BL := BL - 1; 240 LL := LL - 1; 241 242 BR := BR - 1; 243 LR := LR - 1; 244 245 raise; 246 end; 247 end return; 248 end Set_Difference; 249 250 ------------------ 251 -- Intersection -- 252 ------------------ 253 254 procedure Set_Intersection 255 (Target : in out Set_Type; 256 Source : Set_Type) 257 is 258 BT : Natural renames Target.Busy; 259 LT : Natural renames Target.Lock; 260 261 BS : Natural renames Source'Unrestricted_Access.Busy; 262 LS : Natural renames Source'Unrestricted_Access.Lock; 263 264 Tgt : Count_Type; 265 Src : Count_Type; 266 267 Compare : Integer; 268 269 begin 270 if Target'Address = Source'Address then 271 return; 272 end if; 273 274 if Target.Busy > 0 then 275 raise Program_Error with 276 "attempt to tamper with cursors (container is busy)"; 277 end if; 278 279 if Source.Length = 0 then 280 Tree_Operations.Clear_Tree (Target); 281 return; 282 end if; 283 284 Tgt := Target.First; 285 Src := Source.First; 286 while Tgt /= 0 287 and then Src /= 0 288 loop 289 -- Per AI05-0022, the container implementation is required to detect 290 -- element tampering by a generic actual subprogram. 291 292 begin 293 BT := BT + 1; 294 LT := LT + 1; 295 296 BS := BS + 1; 297 LS := LS + 1; 298 299 if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then 300 Compare := -1; 301 elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then 302 Compare := 1; 303 else 304 Compare := 0; 305 end if; 306 307 BT := BT - 1; 308 LT := LT - 1; 309 310 BS := BS - 1; 311 LS := LS - 1; 312 exception 313 when others => 314 BT := BT - 1; 315 LT := LT - 1; 316 317 BS := BS - 1; 318 LS := LS - 1; 319 320 raise; 321 end; 322 323 if Compare < 0 then 324 declare 325 X : constant Count_Type := Tgt; 326 begin 327 Tgt := Tree_Operations.Next (Target, Tgt); 328 329 Tree_Operations.Delete_Node_Sans_Free (Target, X); 330 Tree_Operations.Free (Target, X); 331 end; 332 333 elsif Compare > 0 then 334 Src := Tree_Operations.Next (Source, Src); 335 336 else 337 Tgt := Tree_Operations.Next (Target, Tgt); 338 Src := Tree_Operations.Next (Source, Src); 339 end if; 340 end loop; 341 342 while Tgt /= 0 loop 343 declare 344 X : constant Count_Type := Tgt; 345 begin 346 Tgt := Tree_Operations.Next (Target, Tgt); 347 348 Tree_Operations.Delete_Node_Sans_Free (Target, X); 349 Tree_Operations.Free (Target, X); 350 end; 351 end loop; 352 end Set_Intersection; 353 354 function Set_Intersection (Left, Right : Set_Type) return Set_Type is 355 begin 356 if Left'Address = Right'Address then 357 return Copy (Left); 358 end if; 359 360 return Result : Set_Type (Count_Type'Min (Left.Length, Right.Length)) do 361 362 -- Per AI05-0022, the container implementation is required to detect 363 -- element tampering by a generic actual subprogram. 364 365 declare 366 BL : Natural renames Left'Unrestricted_Access.Busy; 367 LL : Natural renames Left'Unrestricted_Access.Lock; 368 369 BR : Natural renames Right'Unrestricted_Access.Busy; 370 LR : Natural renames Right'Unrestricted_Access.Lock; 371 372 L_Node : Count_Type; 373 R_Node : Count_Type; 374 375 Dst_Node : Count_Type; 376 pragma Warnings (Off, Dst_Node); 377 378 begin 379 BL := BL + 1; 380 LL := LL + 1; 381 382 BR := BR + 1; 383 LR := LR + 1; 384 385 L_Node := Left.First; 386 R_Node := Right.First; 387 loop 388 if L_Node = 0 then 389 exit; 390 end if; 391 392 if R_Node = 0 then 393 exit; 394 end if; 395 396 if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then 397 L_Node := Tree_Operations.Next (Left, L_Node); 398 399 elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then 400 R_Node := Tree_Operations.Next (Right, R_Node); 401 402 else 403 Insert_With_Hint 404 (Dst_Set => Result, 405 Dst_Hint => 0, 406 Src_Node => Left.Nodes (L_Node), 407 Dst_Node => Dst_Node); 408 409 L_Node := Tree_Operations.Next (Left, L_Node); 410 R_Node := Tree_Operations.Next (Right, R_Node); 411 end if; 412 end loop; 413 414 BL := BL - 1; 415 LL := LL - 1; 416 417 BR := BR - 1; 418 LR := LR - 1; 419 exception 420 when others => 421 BL := BL - 1; 422 LL := LL - 1; 423 424 BR := BR - 1; 425 LR := LR - 1; 426 427 raise; 428 end; 429 end return; 430 end Set_Intersection; 431 432 --------------- 433 -- Is_Subset -- 434 --------------- 435 436 function Set_Subset 437 (Subset : Set_Type; 438 Of_Set : Set_Type) return Boolean 439 is 440 begin 441 if Subset'Address = Of_Set'Address then 442 return True; 443 end if; 444 445 if Subset.Length > Of_Set.Length then 446 return False; 447 end if; 448 449 -- Per AI05-0022, the container implementation is required to detect 450 -- element tampering by a generic actual subprogram. 451 452 declare 453 BL : Natural renames Subset'Unrestricted_Access.Busy; 454 LL : Natural renames Subset'Unrestricted_Access.Lock; 455 456 BR : Natural renames Of_Set'Unrestricted_Access.Busy; 457 LR : Natural renames Of_Set'Unrestricted_Access.Lock; 458 459 Subset_Node : Count_Type; 460 Set_Node : Count_Type; 461 462 Result : Boolean; 463 464 begin 465 BL := BL + 1; 466 LL := LL + 1; 467 468 BR := BR + 1; 469 LR := LR + 1; 470 471 Subset_Node := Subset.First; 472 Set_Node := Of_Set.First; 473 loop 474 if Set_Node = 0 then 475 Result := Subset_Node = 0; 476 exit; 477 end if; 478 479 if Subset_Node = 0 then 480 Result := True; 481 exit; 482 end if; 483 484 if Is_Less (Subset.Nodes (Subset_Node), 485 Of_Set.Nodes (Set_Node)) 486 then 487 Result := False; 488 exit; 489 end if; 490 491 if Is_Less (Of_Set.Nodes (Set_Node), 492 Subset.Nodes (Subset_Node)) 493 then 494 Set_Node := Tree_Operations.Next (Of_Set, Set_Node); 495 else 496 Set_Node := Tree_Operations.Next (Of_Set, Set_Node); 497 Subset_Node := Tree_Operations.Next (Subset, Subset_Node); 498 end if; 499 end loop; 500 501 BL := BL - 1; 502 LL := LL - 1; 503 504 BR := BR - 1; 505 LR := LR - 1; 506 507 return Result; 508 exception 509 when others => 510 BL := BL - 1; 511 LL := LL - 1; 512 513 BR := BR - 1; 514 LR := LR - 1; 515 516 raise; 517 end; 518 end Set_Subset; 519 520 ------------- 521 -- Overlap -- 522 ------------- 523 524 function Set_Overlap (Left, Right : Set_Type) return Boolean is 525 begin 526 if Left'Address = Right'Address then 527 return Left.Length /= 0; 528 end if; 529 530 -- Per AI05-0022, the container implementation is required to detect 531 -- element tampering by a generic actual subprogram. 532 533 declare 534 BL : Natural renames Left'Unrestricted_Access.Busy; 535 LL : Natural renames Left'Unrestricted_Access.Lock; 536 537 BR : Natural renames Right'Unrestricted_Access.Busy; 538 LR : Natural renames Right'Unrestricted_Access.Lock; 539 540 L_Node : Count_Type; 541 R_Node : Count_Type; 542 543 Result : Boolean; 544 545 begin 546 BL := BL + 1; 547 LL := LL + 1; 548 549 BR := BR + 1; 550 LR := LR + 1; 551 552 L_Node := Left.First; 553 R_Node := Right.First; 554 loop 555 if L_Node = 0 556 or else R_Node = 0 557 then 558 Result := False; 559 exit; 560 end if; 561 562 if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then 563 L_Node := Tree_Operations.Next (Left, L_Node); 564 565 elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then 566 R_Node := Tree_Operations.Next (Right, R_Node); 567 568 else 569 Result := True; 570 exit; 571 end if; 572 end loop; 573 574 BL := BL - 1; 575 LL := LL - 1; 576 577 BR := BR - 1; 578 LR := LR - 1; 579 580 return Result; 581 exception 582 when others => 583 BL := BL - 1; 584 LL := LL - 1; 585 586 BR := BR - 1; 587 LR := LR - 1; 588 589 raise; 590 end; 591 end Set_Overlap; 592 593 -------------------------- 594 -- Symmetric_Difference -- 595 -------------------------- 596 597 procedure Set_Symmetric_Difference 598 (Target : in out Set_Type; 599 Source : Set_Type) 600 is 601 BT : Natural renames Target.Busy; 602 LT : Natural renames Target.Lock; 603 604 BS : Natural renames Source'Unrestricted_Access.Busy; 605 LS : Natural renames Source'Unrestricted_Access.Lock; 606 607 Tgt : Count_Type; 608 Src : Count_Type; 609 610 New_Tgt_Node : Count_Type; 611 pragma Warnings (Off, New_Tgt_Node); 612 613 Compare : Integer; 614 615 begin 616 if Target'Address = Source'Address then 617 Tree_Operations.Clear_Tree (Target); 618 return; 619 end if; 620 621 Tgt := Target.First; 622 Src := Source.First; 623 loop 624 if Tgt = 0 then 625 while Src /= 0 loop 626 Insert_With_Hint 627 (Dst_Set => Target, 628 Dst_Hint => 0, 629 Src_Node => Source.Nodes (Src), 630 Dst_Node => New_Tgt_Node); 631 632 Src := Tree_Operations.Next (Source, Src); 633 end loop; 634 635 return; 636 end if; 637 638 if Src = 0 then 639 return; 640 end if; 641 642 -- Per AI05-0022, the container implementation is required to detect 643 -- element tampering by a generic actual subprogram. 644 645 begin 646 BT := BT + 1; 647 LT := LT + 1; 648 649 BS := BS + 1; 650 LS := LS + 1; 651 652 if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then 653 Compare := -1; 654 elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then 655 Compare := 1; 656 else 657 Compare := 0; 658 end if; 659 660 BT := BT - 1; 661 LT := LT - 1; 662 663 BS := BS - 1; 664 LS := LS - 1; 665 exception 666 when others => 667 BT := BT - 1; 668 LT := LT - 1; 669 670 BS := BS - 1; 671 LS := LS - 1; 672 673 raise; 674 end; 675 676 if Compare < 0 then 677 Tgt := Tree_Operations.Next (Target, Tgt); 678 679 elsif Compare > 0 then 680 Insert_With_Hint 681 (Dst_Set => Target, 682 Dst_Hint => Tgt, 683 Src_Node => Source.Nodes (Src), 684 Dst_Node => New_Tgt_Node); 685 686 Src := Tree_Operations.Next (Source, Src); 687 688 else 689 declare 690 X : constant Count_Type := Tgt; 691 begin 692 Tgt := Tree_Operations.Next (Target, Tgt); 693 694 Tree_Operations.Delete_Node_Sans_Free (Target, X); 695 Tree_Operations.Free (Target, X); 696 end; 697 698 Src := Tree_Operations.Next (Source, Src); 699 end if; 700 end loop; 701 end Set_Symmetric_Difference; 702 703 function Set_Symmetric_Difference 704 (Left, Right : Set_Type) return Set_Type 705 is 706 begin 707 if Left'Address = Right'Address then 708 return S : Set_Type (0); -- Empty set 709 end if; 710 711 if Right.Length = 0 then 712 return Copy (Left); 713 end if; 714 715 if Left.Length = 0 then 716 return Copy (Right); 717 end if; 718 719 return Result : Set_Type (Left.Length + Right.Length) do 720 721 -- Per AI05-0022, the container implementation is required to detect 722 -- element tampering by a generic actual subprogram. 723 724 declare 725 BL : Natural renames Left'Unrestricted_Access.Busy; 726 LL : Natural renames Left'Unrestricted_Access.Lock; 727 728 BR : Natural renames Right'Unrestricted_Access.Busy; 729 LR : Natural renames Right'Unrestricted_Access.Lock; 730 731 L_Node : Count_Type; 732 R_Node : Count_Type; 733 734 Dst_Node : Count_Type; 735 pragma Warnings (Off, Dst_Node); 736 737 begin 738 BL := BL + 1; 739 LL := LL + 1; 740 741 BR := BR + 1; 742 LR := LR + 1; 743 744 L_Node := Left.First; 745 R_Node := Right.First; 746 loop 747 if L_Node = 0 then 748 while R_Node /= 0 loop 749 Insert_With_Hint 750 (Dst_Set => Result, 751 Dst_Hint => 0, 752 Src_Node => Right.Nodes (R_Node), 753 Dst_Node => Dst_Node); 754 755 R_Node := Tree_Operations.Next (Right, R_Node); 756 end loop; 757 758 exit; 759 end if; 760 761 if R_Node = 0 then 762 while L_Node /= 0 loop 763 Insert_With_Hint 764 (Dst_Set => Result, 765 Dst_Hint => 0, 766 Src_Node => Left.Nodes (L_Node), 767 Dst_Node => Dst_Node); 768 769 L_Node := Tree_Operations.Next (Left, L_Node); 770 end loop; 771 772 exit; 773 end if; 774 775 if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then 776 Insert_With_Hint 777 (Dst_Set => Result, 778 Dst_Hint => 0, 779 Src_Node => Left.Nodes (L_Node), 780 Dst_Node => Dst_Node); 781 782 L_Node := Tree_Operations.Next (Left, L_Node); 783 784 elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then 785 Insert_With_Hint 786 (Dst_Set => Result, 787 Dst_Hint => 0, 788 Src_Node => Right.Nodes (R_Node), 789 Dst_Node => Dst_Node); 790 791 R_Node := Tree_Operations.Next (Right, R_Node); 792 793 else 794 L_Node := Tree_Operations.Next (Left, L_Node); 795 R_Node := Tree_Operations.Next (Right, R_Node); 796 end if; 797 end loop; 798 799 BL := BL - 1; 800 LL := LL - 1; 801 802 BR := BR - 1; 803 LR := LR - 1; 804 exception 805 when others => 806 BL := BL - 1; 807 LL := LL - 1; 808 809 BR := BR - 1; 810 LR := LR - 1; 811 812 raise; 813 end; 814 end return; 815 end Set_Symmetric_Difference; 816 817 ----------- 818 -- Union -- 819 ----------- 820 821 procedure Set_Union (Target : in out Set_Type; Source : Set_Type) is 822 Hint : Count_Type := 0; 823 824 procedure Process (Node : Count_Type); 825 pragma Inline (Process); 826 827 procedure Iterate is new Tree_Operations.Generic_Iteration (Process); 828 829 ------------- 830 -- Process -- 831 ------------- 832 833 procedure Process (Node : Count_Type) is 834 begin 835 Insert_With_Hint 836 (Dst_Set => Target, 837 Dst_Hint => Hint, 838 Src_Node => Source.Nodes (Node), 839 Dst_Node => Hint); 840 end Process; 841 842 -- Start of processing for Union 843 844 begin 845 if Target'Address = Source'Address then 846 return; 847 end if; 848 849 -- Per AI05-0022, the container implementation is required to detect 850 -- element tampering by a generic actual subprogram. 851 852 declare 853 BS : Natural renames Source'Unrestricted_Access.Busy; 854 LS : Natural renames Source'Unrestricted_Access.Lock; 855 856 begin 857 BS := BS + 1; 858 LS := LS + 1; 859 860 -- Note that there's no way to decide a priori whether the target has 861 -- enough capacity for the union with source. We cannot simply 862 -- compare the sum of the existing lengths to the capacity of the 863 -- target, because equivalent items from source are not included in 864 -- the union. 865 866 Iterate (Source); 867 868 BS := BS - 1; 869 LS := LS - 1; 870 exception 871 when others => 872 BS := BS - 1; 873 LS := LS - 1; 874 875 raise; 876 end; 877 end Set_Union; 878 879 function Set_Union (Left, Right : Set_Type) return Set_Type is 880 begin 881 if Left'Address = Right'Address then 882 return Copy (Left); 883 end if; 884 885 if Left.Length = 0 then 886 return Copy (Right); 887 end if; 888 889 if Right.Length = 0 then 890 return Copy (Left); 891 end if; 892 893 return Result : Set_Type (Left.Length + Right.Length) do 894 declare 895 BL : Natural renames Left'Unrestricted_Access.Busy; 896 LL : Natural renames Left'Unrestricted_Access.Lock; 897 898 BR : Natural renames Right'Unrestricted_Access.Busy; 899 LR : Natural renames Right'Unrestricted_Access.Lock; 900 901 begin 902 BL := BL + 1; 903 LL := LL + 1; 904 905 BR := BR + 1; 906 LR := LR + 1; 907 908 Assign (Target => Result, Source => Left); 909 910 Insert_Right : declare 911 Hint : Count_Type := 0; 912 913 procedure Process (Node : Count_Type); 914 pragma Inline (Process); 915 916 procedure Iterate is 917 new Tree_Operations.Generic_Iteration (Process); 918 919 ------------- 920 -- Process -- 921 ------------- 922 923 procedure Process (Node : Count_Type) is 924 begin 925 Insert_With_Hint 926 (Dst_Set => Result, 927 Dst_Hint => Hint, 928 Src_Node => Right.Nodes (Node), 929 Dst_Node => Hint); 930 end Process; 931 932 -- Start of processing for Insert_Right 933 934 begin 935 Iterate (Right); 936 end Insert_Right; 937 938 BL := BL - 1; 939 LL := LL - 1; 940 941 BR := BR - 1; 942 LR := LR - 1; 943 exception 944 when others => 945 BL := BL - 1; 946 LL := LL - 1; 947 948 BR := BR - 1; 949 LR := LR - 1; 950 951 raise; 952 end; 953 end return; 954 end Set_Union; 955 956end Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations; 957