gcc/ada/a-crbtgk.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --                ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_KEYS               --
   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
  30 package body Ada.Containers.Red_Black_Trees.Generic_Keys is
  31
  32    package Ops renames Tree_Operations;
  33
  34    -------------
  35    -- Ceiling --
  36    -------------
  37
  38    --  AKA Lower_Bound
  39
  40    function Ceiling (Tree : Tree_Type; Key : Key_Type) return Node_Access is
  41       B : Natural renames Tree'Unrestricted_Access.Busy;
  42       L : Natural renames Tree'Unrestricted_Access.Lock;
  43
  44       Y : Node_Access;
  45       X : Node_Access;
  46
  47    begin
  48       --  If the container is empty, return a result immediately, so that we do
  49       --  not manipulate the tamper bits unnecessarily.
  50
  51       if Tree.Root = null then
  52          return null;
  53       end if;
  54
  55       --  Per AI05-0022, the container implementation is required to detect
  56       --  element tampering by a generic actual subprogram.
  57
  58       B := B + 1;
  59       L := L + 1;
  60
  61       X := Tree.Root;
  62       while X /= null loop
  63          if Is_Greater_Key_Node (Key, X) then
  64             X := Ops.Right (X);
  65          else
  66             Y := X;
  67             X := Ops.Left (X);
  68          end if;
  69       end loop;
  70
  71       B := B - 1;
  72       L := L - 1;
  73
  74       return Y;
  75
  76    exception
  77       when others =>
  78          B := B - 1;
  79          L := L - 1;
  80          raise;
  81    end Ceiling;
  82
  83    ----------
  84    -- Find --
  85    ----------
  86
  87    function Find (Tree : Tree_Type; Key : Key_Type) return Node_Access is
  88       B : Natural renames Tree'Unrestricted_Access.Busy;
  89       L : Natural renames Tree'Unrestricted_Access.Lock;
  90
  91       Y : Node_Access;
  92       X : Node_Access;
  93
  94       Result : Node_Access;
  95
  96    begin
  97       --  If the container is empty, return a result immediately, so that we do
  98       --  not manipulate the tamper bits unnecessarily.
  99
 100       if Tree.Root = null then
 101          return null;
 102       end if;
 103
 104       --  Per AI05-0022, the container implementation is required to detect
 105       --  element tampering by a generic actual subprogram.
 106
 107       B := B + 1;
 108       L := L + 1;
 109
 110       X := Tree.Root;
 111       while X /= null loop
 112          if Is_Greater_Key_Node (Key, X) then
 113             X := Ops.Right (X);
 114          else
 115             Y := X;
 116             X := Ops.Left (X);
 117          end if;
 118       end loop;
 119
 120       if Y = null then
 121          Result := null;
 122
 123       elsif Is_Less_Key_Node (Key, Y) then
 124          Result := null;
 125
 126       else
 127          Result := Y;
 128       end if;
 129
 130       B := B - 1;
 131       L := L - 1;
 132
 133       return Result;
 134
 135    exception
 136       when others =>
 137          B := B - 1;
 138          L := L - 1;
 139          raise;
 140    end Find;
 141
 142    -----------
 143    -- Floor --
 144    -----------
 145
 146    function Floor (Tree : Tree_Type; Key : Key_Type) return Node_Access is
 147       B : Natural renames Tree'Unrestricted_Access.Busy;
 148       L : Natural renames Tree'Unrestricted_Access.Lock;
 149
 150       Y : Node_Access;
 151       X : Node_Access;
 152
 153    begin
 154       --  If the container is empty, return a result immediately, so that we do
 155       --  not manipulate the tamper bits unnecessarily.
 156
 157       if Tree.Root = null then
 158          return null;
 159       end if;
 160
 161       --  Per AI05-0022, the container implementation is required to detect
 162       --  element tampering by a generic actual subprogram.
 163
 164       B := B + 1;
 165       L := L + 1;
 166
 167       X := Tree.Root;
 168       while X /= null loop
 169          if Is_Less_Key_Node (Key, X) then
 170             X := Ops.Left (X);
 171          else
 172             Y := X;
 173             X := Ops.Right (X);
 174          end if;
 175       end loop;
 176
 177       B := B - 1;
 178       L := L - 1;
 179
 180       return Y;
 181
 182    exception
 183       when others =>
 184          B := B - 1;
 185          L := L - 1;
 186          raise;
 187    end Floor;
 188
 189    --------------------------------
 190    -- Generic_Conditional_Insert --
 191    --------------------------------
 192
 193    procedure Generic_Conditional_Insert
 194      (Tree     : in out Tree_Type;
 195       Key      : Key_Type;
 196       Node     : out Node_Access;
 197       Inserted : out Boolean)
 198    is
 199       X : Node_Access;
 200       Y : Node_Access;
 201
 202       --  Per AI05-0022, the container implementation is required to detect
 203       --  element tampering by a generic actual subprogram.
 204
 205       B : Natural renames Tree.Busy;
 206       L : Natural renames Tree.Lock;
 207
 208       Compare : Boolean;
 209
 210    begin
 211       --  This is a "conditional" insertion, meaning that the insertion request
 212       --  can "fail" in the sense that no new node is created. If the Key is
 213       --  equivalent to an existing node, then we return the existing node and
 214       --  Inserted is set to False. Otherwise, we allocate a new node (via
 215       --  Insert_Post) and Inserted is set to True.
 216
 217       --  Note that we are testing for equivalence here, not equality. Key must
 218       --  be strictly less than its next neighbor, and strictly greater than
 219       --  its previous neighbor, in order for the conditional insertion to
 220       --  succeed.
 221
 222       --  Handle insertion into an empty container as a special case, so that
 223       --  we do not manipulate the tamper bits unnecessarily.
 224
 225       if Tree.Root = null then
 226          Insert_Post (Tree, null, True, Node);
 227          Inserted := True;
 228          return;
 229       end if;
 230
 231       --  We search the tree to find the nearest neighbor of Key, which is
 232       --  either the smallest node greater than Key (Inserted is True), or the
 233       --  largest node less or equivalent to Key (Inserted is False).
 234
 235       begin
 236          B := B + 1;
 237          L := L + 1;
 238
 239          X := Tree.Root;
 240          Y := null;
 241          Inserted := True;
 242          while X /= null loop
 243             Y := X;
 244             Inserted := Is_Less_Key_Node (Key, X);
 245             X := (if Inserted then Ops.Left (X) else Ops.Right (X));
 246          end loop;
 247
 248          L := L - 1;
 249          B := B - 1;
 250
 251       exception
 252          when others =>
 253             L := L - 1;
 254             B := B - 1;
 255             raise;
 256       end;
 257
 258       if Inserted then
 259
 260          --  Key is less than Y. If Y is the first node in the tree, then there
 261          --  are no other nodes that we need to search for, and we insert a new
 262          --  node into the tree.
 263
 264          if Y = Tree.First then
 265             Insert_Post (Tree, Y, True, Node);
 266             return;
 267          end if;
 268
 269          --  Y is the next nearest-neighbor of Key. We know that Key is not
 270          --  equivalent to Y (because Key is strictly less than Y), so we move
 271          --  to the previous node, the nearest-neighbor just smaller or
 272          --  equivalent to Key.
 273
 274          Node := Ops.Previous (Y);
 275
 276       else
 277          --  Y is the previous nearest-neighbor of Key. We know that Key is not
 278          --  less than Y, which means either that Key is equivalent to Y, or
 279          --  greater than Y.
 280
 281          Node := Y;
 282       end if;
 283
 284       --  Key is equivalent to or greater than Node. We must resolve which is
 285       --  the case, to determine whether the conditional insertion succeeds.
 286
 287       begin
 288          B := B + 1;
 289          L := L + 1;
 290
 291          Compare := Is_Greater_Key_Node (Key, Node);
 292
 293          L := L - 1;
 294          B := B - 1;
 295
 296       exception
 297          when others =>
 298             L := L - 1;
 299             B := B - 1;
 300             raise;
 301       end;
 302
 303       if Compare then
 304
 305          --  Key is strictly greater than Node, which means that Key is not
 306          --  equivalent to Node. In this case, the insertion succeeds, and we
 307          --  insert a new node into the tree.
 308
 309          Insert_Post (Tree, Y, Inserted, Node);
 310          Inserted := True;
 311          return;
 312       end if;
 313
 314       --  Key is equivalent to Node. This is a conditional insertion, so we do
 315       --  not insert a new node in this case. We return the existing node and
 316       --  report that no insertion has occurred.
 317
 318       Inserted := False;
 319    end Generic_Conditional_Insert;
 320
 321    ------------------------------------------
 322    -- Generic_Conditional_Insert_With_Hint --
 323    ------------------------------------------
 324
 325    procedure Generic_Conditional_Insert_With_Hint
 326      (Tree      : in out Tree_Type;
 327       Position  : Node_Access;
 328       Key       : Key_Type;
 329       Node      : out Node_Access;
 330       Inserted  : out Boolean)
 331    is
 332       --  Per AI05-0022, the container implementation is required to detect
 333       --  element tampering by a generic actual subprogram.
 334
 335       B : Natural renames Tree.Busy;
 336       L : Natural renames Tree.Lock;
 337
 338       Test    : Node_Access;
 339       Compare : Boolean;
 340
 341    begin
 342       --  The purpose of a hint is to avoid a search from the root of
 343       --  tree. If we have it hint it means we only need to traverse the
 344       --  subtree rooted at the hint to find the nearest neighbor. Note
 345       --  that finding the neighbor means merely walking the tree; this
 346       --  is not a search and the only comparisons that occur are with
 347       --  the hint and its neighbor.
 348
 349       --  Handle insertion into an empty container as a special case, so that
 350       --  we do not manipulate the tamper bits unnecessarily.
 351
 352       if Tree.Root = null then
 353          Insert_Post (Tree, null, True, Node);
 354          Inserted := True;
 355          return;
 356       end if;
 357
 358       --  If Position is null, this is interpreted to mean that Key is large
 359       --  relative to the nodes in the tree. If Key is greater than the last
 360       --  node in the tree, then we're done; otherwise the hint was "wrong" and
 361       --  we must search.
 362
 363       if Position = null then  -- largest
 364          begin
 365             B := B + 1;
 366             L := L + 1;
 367
 368             Compare := Is_Greater_Key_Node (Key, Tree.Last);
 369
 370             L := L - 1;
 371             B := B - 1;
 372
 373          exception
 374             when others =>
 375                L := L - 1;
 376                B := B - 1;
 377                raise;
 378          end;
 379
 380          if Compare then
 381             Insert_Post (Tree, Tree.Last, False, Node);
 382             Inserted := True;
 383          else
 384             Conditional_Insert_Sans_Hint (Tree, Key, Node, Inserted);
 385          end if;
 386
 387          return;
 388       end if;
 389
 390       pragma Assert (Tree.Length > 0);
 391
 392       --  A hint can either name the node that immediately follows Key,
 393       --  or immediately precedes Key. We first test whether Key is
 394       --  less than the hint, and if so we compare Key to the node that
 395       --  precedes the hint. If Key is both less than the hint and
 396       --  greater than the hint's preceding neighbor, then we're done;
 397       --  otherwise we must search.
 398
 399       --  Note also that a hint can either be an anterior node or a leaf
 400       --  node. A new node is always inserted at the bottom of the tree
 401       --  (at least prior to rebalancing), becoming the new left or
 402       --  right child of leaf node (which prior to the insertion must
 403       --  necessarily be null, since this is a leaf). If the hint names
 404       --  an anterior node then its neighbor must be a leaf, and so
 405       --  (here) we insert after the neighbor. If the hint names a leaf
 406       --  then its neighbor must be anterior and so we insert before the
 407       --  hint.
 408
 409       begin
 410          B := B + 1;
 411          L := L + 1;
 412
 413          Compare := Is_Less_Key_Node (Key, Position);
 414
 415          L := L - 1;
 416          B := B - 1;
 417
 418       exception
 419          when others =>
 420             L := L - 1;
 421             B := B - 1;
 422             raise;
 423       end;
 424
 425       if Compare then
 426          Test := Ops.Previous (Position);  -- "before"
 427
 428          if Test = null then  -- new first node
 429             Insert_Post (Tree, Tree.First, True, Node);
 430
 431             Inserted := True;
 432             return;
 433          end if;
 434
 435          begin
 436             B := B + 1;
 437             L := L + 1;
 438
 439             Compare := Is_Greater_Key_Node (Key, Test);
 440
 441             L := L - 1;
 442             B := B - 1;
 443
 444          exception
 445             when others =>
 446                L := L - 1;
 447                B := B - 1;
 448                raise;
 449          end;
 450
 451          if Compare then
 452             if Ops.Right (Test) = null then
 453                Insert_Post (Tree, Test, False, Node);
 454             else
 455                Insert_Post (Tree, Position, True, Node);
 456             end if;
 457
 458             Inserted := True;
 459
 460          else
 461             Conditional_Insert_Sans_Hint (Tree, Key, Node, Inserted);
 462          end if;
 463
 464          return;
 465       end if;
 466
 467       --  We know that Key isn't less than the hint so we try again, this time
 468       --  to see if it's greater than the hint. If so we compare Key to the
 469       --  node that follows the hint. If Key is both greater than the hint and
 470       --  less than the hint's next neighbor, then we're done; otherwise we
 471       --  must search.
 472
 473       begin
 474          B := B + 1;
 475          L := L + 1;
 476
 477          Compare := Is_Greater_Key_Node (Key, Position);
 478
 479          L := L - 1;
 480          B := B - 1;
 481
 482       exception
 483          when others =>
 484             L := L - 1;
 485             B := B - 1;
 486             raise;
 487       end;
 488
 489       if Compare then
 490          Test := Ops.Next (Position);  -- "after"
 491
 492          if Test = null then  -- new last node
 493             Insert_Post (Tree, Tree.Last, False, Node);
 494
 495             Inserted := True;
 496             return;
 497          end if;
 498
 499          begin
 500             B := B + 1;
 501             L := L + 1;
 502
 503             Compare := Is_Less_Key_Node (Key, Test);
 504
 505             L := L - 1;
 506             B := B - 1;
 507
 508          exception
 509             when others =>
 510                L := L - 1;
 511                B := B - 1;
 512                raise;
 513          end;
 514
 515          if Compare then
 516             if Ops.Right (Position) = null then
 517                Insert_Post (Tree, Position, False, Node);
 518             else
 519                Insert_Post (Tree, Test, True, Node);
 520             end if;
 521
 522             Inserted := True;
 523
 524          else
 525             Conditional_Insert_Sans_Hint (Tree, Key, Node, Inserted);
 526          end if;
 527
 528          return;
 529       end if;
 530
 531       --  We know that Key is neither less than the hint nor greater than the
 532       --  hint, and that's the definition of equivalence. There's nothing else
 533       --  we need to do, since a search would just reach the same conclusion.
 534
 535       Node := Position;
 536       Inserted := False;
 537    end Generic_Conditional_Insert_With_Hint;
 538
 539    -------------------------
 540    -- Generic_Insert_Post --
 541    -------------------------
 542
 543    procedure Generic_Insert_Post
 544      (Tree   : in out Tree_Type;
 545       Y      : Node_Access;
 546       Before : Boolean;
 547       Z      : out Node_Access)
 548    is
 549    begin
 550       if Tree.Length = Count_Type'Last then
 551          raise Constraint_Error with "too many elements";
 552       end if;
 553
 554       if Tree.Busy > 0 then
 555          raise Program_Error with
 556            "attempt to tamper with cursors (container is busy)";
 557       end if;
 558
 559       Z := New_Node;
 560       pragma Assert (Z /= null);
 561       pragma Assert (Ops.Color (Z) = Red);
 562
 563       if Y = null then
 564          pragma Assert (Tree.Length = 0);
 565          pragma Assert (Tree.Root = null);
 566          pragma Assert (Tree.First = null);
 567          pragma Assert (Tree.Last = null);
 568
 569          Tree.Root := Z;
 570          Tree.First := Z;
 571          Tree.Last := Z;
 572
 573       elsif Before then
 574          pragma Assert (Ops.Left (Y) = null);
 575
 576          Ops.Set_Left (Y, Z);
 577
 578          if Y = Tree.First then
 579             Tree.First := Z;
 580          end if;
 581
 582       else
 583          pragma Assert (Ops.Right (Y) = null);
 584
 585          Ops.Set_Right (Y, Z);
 586
 587          if Y = Tree.Last then
 588             Tree.Last := Z;
 589          end if;
 590       end if;
 591
 592       Ops.Set_Parent (Z, Y);
 593       Ops.Rebalance_For_Insert (Tree, Z);
 594       Tree.Length := Tree.Length + 1;
 595    end Generic_Insert_Post;
 596
 597    -----------------------
 598    -- Generic_Iteration --
 599    -----------------------
 600
 601    procedure Generic_Iteration
 602      (Tree : Tree_Type;
 603       Key  : Key_Type)
 604    is
 605       procedure Iterate (Node : Node_Access);
 606
 607       -------------
 608       -- Iterate --
 609       -------------
 610
 611       procedure Iterate (Node : Node_Access) is
 612          N : Node_Access;
 613       begin
 614          N := Node;
 615          while N /= null loop
 616             if Is_Less_Key_Node (Key, N) then
 617                N := Ops.Left (N);
 618             elsif Is_Greater_Key_Node (Key, N) then
 619                N := Ops.Right (N);
 620             else
 621                Iterate (Ops.Left (N));
 622                Process (N);
 623                N := Ops.Right (N);
 624             end if;
 625          end loop;
 626       end Iterate;
 627
 628    --  Start of processing for Generic_Iteration
 629
 630    begin
 631       Iterate (Tree.Root);
 632    end Generic_Iteration;
 633
 634    -------------------------------
 635    -- Generic_Reverse_Iteration --
 636    -------------------------------
 637
 638    procedure Generic_Reverse_Iteration
 639      (Tree : Tree_Type;
 640       Key  : Key_Type)
 641    is
 642       procedure Iterate (Node : Node_Access);
 643
 644       -------------
 645       -- Iterate --
 646       -------------
 647
 648       procedure Iterate (Node : Node_Access) is
 649          N : Node_Access;
 650       begin
 651          N := Node;
 652          while N /= null loop
 653             if Is_Less_Key_Node (Key, N) then
 654                N := Ops.Left (N);
 655             elsif Is_Greater_Key_Node (Key, N) then
 656                N := Ops.Right (N);
 657             else
 658                Iterate (Ops.Right (N));
 659                Process (N);
 660                N := Ops.Left (N);
 661             end if;
 662          end loop;
 663       end Iterate;
 664
 665    --  Start of processing for Generic_Reverse_Iteration
 666
 667    begin
 668       Iterate (Tree.Root);
 669    end Generic_Reverse_Iteration;
 670
 671    ----------------------------------
 672    -- Generic_Unconditional_Insert --
 673    ----------------------------------
 674
 675    procedure Generic_Unconditional_Insert
 676      (Tree : in out Tree_Type;
 677       Key  : Key_Type;
 678       Node : out Node_Access)
 679    is
 680       Y : Node_Access;
 681       X : Node_Access;
 682
 683       Before : Boolean;
 684
 685    begin
 686       Y := null;
 687       Before := False;
 688
 689       X := Tree.Root;
 690       while X /= null loop
 691          Y := X;
 692          Before := Is_Less_Key_Node (Key, X);
 693          X := (if Before then Ops.Left (X) else Ops.Right (X));
 694       end loop;
 695
 696       Insert_Post (Tree, Y, Before, Node);
 697    end Generic_Unconditional_Insert;
 698
 699    --------------------------------------------
 700    -- Generic_Unconditional_Insert_With_Hint --
 701    --------------------------------------------
 702
 703    procedure Generic_Unconditional_Insert_With_Hint
 704      (Tree : in out Tree_Type;
 705       Hint : Node_Access;
 706       Key  : Key_Type;
 707       Node : out Node_Access)
 708    is
 709    begin
 710       --  There are fewer constraints for an unconditional insertion
 711       --  than for a conditional insertion, since we allow duplicate
 712       --  keys. So instead of having to check (say) whether Key is
 713       --  (strictly) greater than the hint's previous neighbor, here we
 714       --  allow Key to be equal to or greater than the previous node.
 715
 716       --  There is the issue of what to do if Key is equivalent to the
 717       --  hint. Does the new node get inserted before or after the hint?
 718       --  We decide that it gets inserted after the hint, reasoning that
 719       --  this is consistent with behavior for non-hint insertion, which
 720       --  inserts a new node after existing nodes with equivalent keys.
 721
 722       --  First we check whether the hint is null, which is interpreted
 723       --  to mean that Key is large relative to existing nodes.
 724       --  Following our rule above, if Key is equal to or greater than
 725       --  the last node, then we insert the new node immediately after
 726       --  last. (We don't have an operation for testing whether a key is
 727       --  "equal to or greater than" a node, so we must say instead "not
 728       --  less than", which is equivalent.)
 729
 730       if Hint = null then  -- largest
 731          if Tree.Last = null then
 732             Insert_Post (Tree, null, False, Node);
 733          elsif Is_Less_Key_Node (Key, Tree.Last) then
 734             Unconditional_Insert_Sans_Hint (Tree, Key, Node);
 735          else
 736             Insert_Post (Tree, Tree.Last, False, Node);
 737          end if;
 738
 739          return;
 740       end if;
 741
 742       pragma Assert (Tree.Length > 0);
 743
 744       --  We decide here whether to insert the new node prior to the
 745       --  hint. Key could be equivalent to the hint, so in theory we
 746       --  could write the following test as "not greater than" (same as
 747       --  "less than or equal to"). If Key were equivalent to the hint,
 748       --  that would mean that the new node gets inserted before an
 749       --  equivalent node. That wouldn't break any container invariants,
 750       --  but our rule above says that new nodes always get inserted
 751       --  after equivalent nodes. So here we test whether Key is both
 752       --  less than the hint and equal to or greater than the hint's
 753       --  previous neighbor, and if so insert it before the hint.
 754
 755       if Is_Less_Key_Node (Key, Hint) then
 756          declare
 757             Before : constant Node_Access := Ops.Previous (Hint);
 758          begin
 759             if Before = null then
 760                Insert_Post (Tree, Hint, True, Node);
 761             elsif Is_Less_Key_Node (Key, Before) then
 762                Unconditional_Insert_Sans_Hint (Tree, Key, Node);
 763             elsif Ops.Right (Before) = null then
 764                Insert_Post (Tree, Before, False, Node);
 765             else
 766                Insert_Post (Tree, Hint, True, Node);
 767             end if;
 768          end;
 769
 770          return;
 771       end if;
 772
 773       --  We know that Key isn't less than the hint, so it must be equal
 774       --  or greater. So we just test whether Key is less than or equal
 775       --  to (same as "not greater than") the hint's next neighbor, and
 776       --  if so insert it after the hint.
 777
 778       declare
 779          After : constant Node_Access := Ops.Next (Hint);
 780       begin
 781          if After = null then
 782             Insert_Post (Tree, Hint, False, Node);
 783          elsif Is_Greater_Key_Node (Key, After) then
 784             Unconditional_Insert_Sans_Hint (Tree, Key, Node);
 785          elsif Ops.Right (Hint) = null then
 786             Insert_Post (Tree, Hint, False, Node);
 787          else
 788             Insert_Post (Tree, After, True, Node);
 789          end if;
 790       end;
 791    end Generic_Unconditional_Insert_With_Hint;
 792
 793    -----------------
 794    -- Upper_Bound --
 795    -----------------
 796
 797    function Upper_Bound
 798      (Tree : Tree_Type;
 799       Key  : Key_Type) return Node_Access
 800    is
 801       Y : Node_Access;
 802       X : Node_Access;
 803
 804    begin
 805       X := Tree.Root;
 806       while X /= null loop
 807          if Is_Less_Key_Node (Key, X) then
 808             Y := X;
 809             X := Ops.Left (X);
 810          else
 811             X := Ops.Right (X);
 812          end if;
 813       end loop;
 814
 815       return Y;
 816    end Upper_Bound;
 817
 818 end Ada.Containers.Red_Black_Trees.Generic_Keys;