a-crbtgo.ads: Commented each subprogram

2006-10-31  Matt Heaney  <heaney@adacore.com>

	* a-crbtgo.ads: Commented each subprogram

	* a-crbtgo.adb: Added reference to book from which algorithms were
	adapted.

        * a-crbtgk.ads, a-crbtgk.adb (Generic_Insert_Post): pass flag to
	indicate which child.
	(Generic_Conditional_Insert): changed parameter name from "Success" to
	"Inserted".
	(Generic_Unconditional_Insert_With_Hint): improved algorithm

	* a-coorse.adb (Replace_Element): changed parameter name in call to
	conditional insert operation.

	* a-convec.adb, a-coinve.adb (Insert): removed obsolete comment

	* a-cohama.adb (Iterate): manipulate busy-bit here, instead of in
	Generic_Iteration

	* a-ciorse.adb (Replace_Element): changed parameter name in call to
	conditional insert operation.

	* a-cihama.adb (Iterate): manipulate busy-bit here, instead of in
	Generic_Iteration.

	* a-cidlli.ads, a-cidlli.adb (Splice): Position param is now mode in
	instead of mode inout.

	* a-chtgop.adb (Adjust): modified comments to reflect current AI-302
	draft
	(Generic_Read): preserve existing buckets array if possible
	(Generic_Write): don't send buckets array length anymore

	* a-cdlili.ads, a-cdlili.adb (Splice): Position param is now mode in
	instead of mode inout.

	* a-cihase.adb (Difference): iterate over smaller of Tgt and Src sets
	(Iterate): manipulate busy-bit here, instead of in Generic_Iteration

	* a-cohase.adb (Difference): iterate over smaller of Tgt and Src sets
	(Iterate): manipulate busy-bit here, instead of in Generic_Iteration
	(Replace_Element): local operation is now an instantiation

	* a-chtgke.ads, a-chtgke.adb (Generic_Conditional_Insert): manually
	check current length.
	(Generic_Replace_Element): new operation

From-SVN: r118324

1 files changed, 198 insertions, 149 deletions

diff --git a/gcc/ada/a-crbtgk.adb b/gcc/ada/a-crbtgk.adb
index 7fe8e3b..f90568d 100644
--- a/gcc/ada/a-crbtgk.adb
+++ b/gcc/ada/a-crbtgk.adb
@@ -7,11 +7,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
---                                                                          --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the  contents of the part following the private keyword. --
+--          Copyright (C) 2004-2006, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -44,11 +40,12 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
 
    --  AKA Lower_Bound
 
-   function Ceiling (Tree : Tree_Type; Key  : Key_Type) return Node_Access is
+   function Ceiling (Tree : Tree_Type; Key : Key_Type) return Node_Access is
       Y : Node_Access;
-      X : Node_Access := Tree.Root;
+      X : Node_Access;
 
    begin
+      X := Tree.Root;
       while X /= null loop
          if Is_Greater_Key_Node (Key, X) then
             X := Ops.Right (X);
@@ -67,9 +64,10 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
 
    function Find (Tree : Tree_Type; Key  : Key_Type) return Node_Access is
       Y : Node_Access;
-      X : Node_Access := Tree.Root;
+      X : Node_Access;
 
    begin
+      X := Tree.Root;
       while X /= null loop
          if Is_Greater_Key_Node (Key, X) then
             X := Ops.Right (X);
@@ -96,9 +94,10 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
 
    function Floor (Tree : Tree_Type; Key  : Key_Type) return Node_Access is
       Y : Node_Access;
-      X : Node_Access := Tree.Root;
+      X : Node_Access;
 
    begin
+      X := Tree.Root;
       while X /= null loop
          if Is_Less_Key_Node (Key, X) then
             X := Ops.Left (X);
@@ -116,45 +115,55 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
    --------------------------------
 
    procedure Generic_Conditional_Insert
-     (Tree    : in out Tree_Type;
-      Key     : Key_Type;
-      Node    : out Node_Access;
-      Success : out Boolean)
+     (Tree     : in out Tree_Type;
+      Key      : Key_Type;
+      Node     : out Node_Access;
+      Inserted : out Boolean)
    is
       Y : Node_Access := null;
       X : Node_Access := Tree.Root;
 
    begin
-      Success := True;
+      Inserted := True;
       while X /= null loop
          Y := X;
-         Success := Is_Less_Key_Node (Key, X);
+         Inserted := Is_Less_Key_Node (Key, X);
 
-         if Success then
+         if Inserted then
             X := Ops.Left (X);
          else
             X := Ops.Right (X);
          end if;
       end loop;
 
-      Node := Y;
+      --  If Inserted is True, then this means either that Tree is
+      --  empty, or there was a least one node (strictly) greater than
+      --  Key. Otherwise, it means that Key is equal to or greater than
+      --  every node.
 
-      if Success then
-         if Node = Tree.First then
-            Insert_Post (Tree, X, Y, Key, Node);
+      if Inserted then
+         if Y = Tree.First then
+            Insert_Post (Tree, Y, True, Node);
             return;
          end if;
 
-         Node := Ops.Previous (Node);
+         Node := Ops.Previous (Y);
+
+      else
+         Node := Y;
       end if;
 
+      --  Here Node has a value that is less than or equal to Key. We
+      --  now have to resolve whether Key is equal to or greater than
+      --  Node, which determines whether the insertion succeeds.
+
       if Is_Greater_Key_Node (Key, Node) then
-         Insert_Post (Tree, X, Y, Key, Node);
-         Success := True;
+         Insert_Post (Tree, Y, Inserted, Node);
+         Inserted := True;
          return;
       end if;
 
-      Success := False;
+      Inserted := False;
    end Generic_Conditional_Insert;
 
    ------------------------------------------
@@ -162,21 +171,33 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
    ------------------------------------------
 
    procedure Generic_Conditional_Insert_With_Hint
-     (Tree     : in out Tree_Type;
-      Position : Node_Access;
-      Key      : Key_Type;
-      Node     : out Node_Access;
-      Success  : out Boolean)
+     (Tree      : in out Tree_Type;
+      Position  : Node_Access;
+      Key       : Key_Type;
+      Node      : out Node_Access;
+      Inserted  : out Boolean)
    is
    begin
+      --  The purpose of a hint is to avoid a search from the root of
+      --  tree. If we have it hint it means we only need to traverse the
+      --  subtree rooted at the hint to find the nearest neighbor. Note
+      --  that finding the neighbor means merely walking the tree; this
+      --  is not a search and the only comparisons that occur are with
+      --  the hint and its neighbor.
+
+      --  If Position is null, this is intepreted to mean that Key is
+      --  large relative to the nodes in the tree. If the tree is empty,
+      --  or Key is greater than the last node in the tree, then we're
+      --  done; otherwise the hint was "wrong" and we must search.
+
       if Position = null then  -- largest
-         if Tree.Length > 0
-           and then Is_Greater_Key_Node (Key, Tree.Last)
+         if Tree.Last = null
+           or else Is_Greater_Key_Node (Key, Tree.Last)
          then
-            Insert_Post (Tree, null, Tree.Last, Key, Node);
-            Success := True;
+            Insert_Post (Tree, Tree.Last, False, Node);
+            Inserted := True;
          else
-            Conditional_Insert_Sans_Hint (Tree, Key, Node, Success);
+            Conditional_Insert_Sans_Hint (Tree, Key, Node, Inserted);
          end if;
 
          return;
@@ -184,64 +205,88 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
 
       pragma Assert (Tree.Length > 0);
 
-      if Is_Less_Key_Node (Key, Position) then
-         if Position = Tree.First then
-            Insert_Post (Tree, Position, Position, Key, Node);
-            Success := True;
-            return;
-         end if;
+      --  A hint can either name the node that immediately follows Key,
+      --  or immediately precedes Key. We first test whether Key is is
+      --  less than the hint, and if so we compare Key to the node that
+      --  precedes the hint. If Key is both less than the hint and
+      --  greater than the hint's preceding neighbor, then we're done;
+      --  otherwise we must search.
+
+      --  Note also that a hint can either be an anterior node or a leaf
+      --  node. A new node is always inserted at the bottom of the tree
+      --  (at least prior to rebalancing), becoming the new left or
+      --  right child of leaf node (which prior to the insertion must
+      --  necessarily be null, since this is a leaf). If the hint names
+      --  an anterior node then its neighbor must be a leaf, and so
+      --  (here) we insert after the neighbor. If the hint names a leaf
+      --  then its neighbor must be anterior and so we insert before the
+      --  hint.
 
+      if Is_Less_Key_Node (Key, Position) then
          declare
             Before : constant Node_Access := Ops.Previous (Position);
 
          begin
-            if Is_Greater_Key_Node (Key, Before) then
+            if Before = null then
+               Insert_Post (Tree, Tree.First, True, Node);
+               Inserted := True;
+
+            elsif Is_Greater_Key_Node (Key, Before) then
                if Ops.Right (Before) = null then
-                  Insert_Post (Tree, null, Before, Key, Node);
+                  Insert_Post (Tree, Before, False, Node);
                else
-                  Insert_Post (Tree, Position, Position, Key, Node);
+                  Insert_Post (Tree, Position, True, Node);
                end if;
 
-               Success := True;
+               Inserted := True;
 
             else
-               Conditional_Insert_Sans_Hint (Tree, Key, Node, Success);
+               Conditional_Insert_Sans_Hint (Tree, Key, Node, Inserted);
             end if;
          end;
 
          return;
       end if;
 
-      if Is_Greater_Key_Node (Key, Position) then
-         if Position = Tree.Last then
-            Insert_Post (Tree, null, Tree.Last, Key, Node);
-            Success := True;
-            return;
-         end if;
+      --  We know that Key isn't less than the hint so we try again,
+      --  this time to see if it's greater than the hint. If so we
+      --  compare Key to the node that follows the hint. If Key is both
+      --  greater than the hint and less than the hint's next neighbor,
+      --  then we're done; otherwise we must search.
 
+      if Is_Greater_Key_Node (Key, Position) then
          declare
             After : constant Node_Access := Ops.Next (Position);
 
          begin
-            if Is_Less_Key_Node (Key, After) then
+            if After = null then
+               Insert_Post (Tree, Tree.Last, False, Node);
+               Inserted := True;
+
+            elsif Is_Less_Key_Node (Key, After) then
                if Ops.Right (Position) = null then
-                  Insert_Post (Tree, null, Position, Key, Node);
+                  Insert_Post (Tree, Position, False, Node);
                else
-                  Insert_Post (Tree, After, After, Key, Node);
+                  Insert_Post (Tree, After, True, Node);
                end if;
 
-               Success := True;
+               Inserted := True;
 
             else
-               Conditional_Insert_Sans_Hint (Tree, Key, Node, Success);
+               Conditional_Insert_Sans_Hint (Tree, Key, Node, Inserted);
             end if;
          end;
 
          return;
       end if;
 
+      --  We know that Key is neither less than the hint nor greater
+      --  than the hint, and that's the definition of equivalence.
+      --  There's nothing else we need to do, since a search would just
+      --  reach the same conclusion.
+
       Node := Position;
-      Success := False;
+      Inserted := False;
    end Generic_Conditional_Insert_With_Hint;
 
    -------------------------
@@ -249,10 +294,10 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
    -------------------------
 
    procedure Generic_Insert_Post
-     (Tree : in out Tree_Type;
-      X, Y : Node_Access;
-      Key  : Key_Type;
-      Z    : out Node_Access)
+     (Tree   : in out Tree_Type;
+      Y      : Node_Access;
+      Before : Boolean;
+      Z      : out Node_Access)
    is
    begin
       if Tree.Length = Count_Type'Last then
@@ -264,50 +309,32 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
            "attempt to tamper with cursors (container is busy)";
       end if;
 
-      if Y = null
-        or else X /= null
-        or else Is_Less_Key_Node (Key, Y)
-      then
-         pragma Assert (Y = null
-                          or else Ops.Left (Y) = null);
+      Z := New_Node;
+      pragma Assert (Z /= null);
+      pragma Assert (Ops.Color (Z) = Red);
 
-         --  Delay allocation as long as we can, in order to defend
-         --  against exceptions propagated by relational operators.
+      if Y = null then
+         pragma Assert (Tree.Length = 0);
+         pragma Assert (Tree.Root = null);
+         pragma Assert (Tree.First = null);
+         pragma Assert (Tree.Last = null);
 
-         Z := New_Node;
+         Tree.Root := Z;
+         Tree.First := Z;
+         Tree.Last := Z;
 
-         pragma Assert (Z /= null);
-         pragma Assert (Ops.Color (Z) = Red);
+      elsif Before then
+         pragma Assert (Ops.Left (Y) = null);
 
-         if Y = null then
-            pragma Assert (Tree.Length = 0);
-            pragma Assert (Tree.Root = null);
-            pragma Assert (Tree.First = null);
-            pragma Assert (Tree.Last = null);
+         Ops.Set_Left (Y, Z);
 
-            Tree.Root := Z;
+         if Y = Tree.First then
             Tree.First := Z;
-            Tree.Last := Z;
-
-         else
-            Ops.Set_Left (Y, Z);
-
-            if Y = Tree.First then
-               Tree.First := Z;
-            end if;
          end if;
 
       else
          pragma Assert (Ops.Right (Y) = null);
 
-         --  Delay allocation as long as we can, in order to defend
-         --  against exceptions propagated by relational operators.
-
-         Z := New_Node;
-
-         pragma Assert (Z /= null);
-         pragma Assert (Ops.Color (Z) = Red);
-
          Ops.Set_Right (Y, Z);
 
          if Y = Tree.Last then
@@ -335,8 +362,9 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       -------------
 
       procedure Iterate (Node : Node_Access) is
-         N : Node_Access := Node;
+         N : Node_Access;
       begin
+         N := Node;
          while N /= null loop
             if Is_Less_Key_Node (Key, N) then
                N := Ops.Left (N);
@@ -371,8 +399,9 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       -------------
 
       procedure Iterate (Node : Node_Access) is
-         N : Node_Access := Node;
+         N : Node_Access;
       begin
+         N := Node;
          while N /= null loop
             if Is_Less_Key_Node (Key, N) then
                N := Ops.Left (N);
@@ -401,21 +430,28 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       Key  : Key_Type;
       Node : out Node_Access)
    is
-      Y : Node_Access := null;
-      X : Node_Access := Tree.Root;
+      Y : Node_Access;
+      X : Node_Access;
+
+      Before : Boolean;
 
    begin
+      Y := null;
+      Before := False;
+
+      X := Tree.Root;
       while X /= null loop
          Y := X;
+         Before := Is_Less_Key_Node (Key, X);
 
-         if Is_Less_Key_Node (Key, X) then
+         if Before then
             X := Ops.Left (X);
          else
             X := Ops.Right (X);
          end if;
       end loop;
 
-      Insert_Post (Tree, X, Y, Key, Node);
+      Insert_Post (Tree, Y, Before, Node);
    end Generic_Unconditional_Insert;
 
    --------------------------------------------
@@ -428,22 +464,34 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       Key  : Key_Type;
       Node : out Node_Access)
    is
-      --  TODO: verify this algorithm.  It was (quickly) adapted it from the
-      --  same algorithm for conditional_with_hint. It may be that the test
-      --  Key > Hint should be something like a Key >= Hint, to handle the
-      --  case when Hint is The Last Item of A (Contiguous) sequence of
-      --  Equivalent Items.  (The Key < Hint Test is probably OK. It is not
-      --  clear that you can use Key <= Hint, since new items are always
-      --  inserted last in the sequence of equivalent items.) ???
-
    begin
+      --  There are fewer constraints for an unconditional insertion
+      --  than for a conditional insertion, since we allow duplicate
+      --  keys. So instead of having to check (say) whether Key is
+      --  (strictly) greater than the hint's previous neighbor, here we
+      --  allow Key to be equal to or greater than the previous node.
+
+      --  There is the issue of what to do if Key is equivalent to the
+      --  hint. Does the new node get inserted before or after the hint?
+      --  We decide that it gets inserted after the hint, reasoning that
+      --  this is consistent with behavior for non-hint insertion, which
+      --  inserts a new node after existing nodes with equivalent keys.
+
+      --  First we check whether the hint is null, which is interpreted
+      --  to mean that Key is large relative to existing nodes.
+      --  Following our rule above, if Key is equal to or greater than
+      --  the last node, then we insert the new node immediately after
+      --  last. (We don't have an operation for testing whether a key is
+      --  "equal to or greater than" a node, so we must say instead "not
+      --  less than", which is equivalent.)
+
       if Hint = null then  -- largest
-         if Tree.Length > 0
-           and then Is_Greater_Key_Node (Key, Tree.Last)
-         then
-            Insert_Post (Tree, null, Tree.Last, Key, Node);
-         else
+         if Tree.Last = null then
+            Insert_Post (Tree, null, False, Node);
+         elsif Is_Less_Key_Node (Key, Tree.Last) then
             Unconditional_Insert_Sans_Hint (Tree, Key, Node);
+         else
+            Insert_Post (Tree, Tree.Last, False, Node);
          end if;
 
          return;
@@ -451,53 +499,53 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
 
       pragma Assert (Tree.Length > 0);
 
-      if Is_Less_Key_Node (Key, Hint) then
-         if Hint = Tree.First then
-            Insert_Post (Tree, Hint, Hint, Key, Node);
-            return;
-         end if;
+      --  We decide here whether to insert the new node prior to the
+      --  hint. Key could be equivalent to the hint, so in theory we
+      --  could write the following test as "not greater than" (same as
+      --  "less than or equal to"). If Key were equivalent to the hint,
+      --  that would mean that the new node gets inserted before an
+      --  equivalent node. That wouldn't break any container invariants,
+      --  but our rule above says that new nodes always get inserted
+      --  after equivalent nodes. So here we test whether Key is both
+      --  less than the hint and and equal to or greater than the hint's
+      --  previous neighbor, and if so insert it before the hint.
 
+      if Is_Less_Key_Node (Key, Hint) then
          declare
             Before : constant Node_Access := Ops.Previous (Hint);
          begin
-            if Is_Greater_Key_Node (Key, Before) then
-               if Ops.Right (Before) = null then
-                  Insert_Post (Tree, null, Before, Key, Node);
-               else
-                  Insert_Post (Tree, Hint, Hint, Key, Node);
-               end if;
-            else
+            if Before = null then
+               Insert_Post (Tree, Hint, True, Node);
+            elsif Is_Less_Key_Node (Key, Before) then
                Unconditional_Insert_Sans_Hint (Tree, Key, Node);
-            end if;
-         end;
-
-         return;
-      end if;
-
-      if Is_Greater_Key_Node (Key, Hint) then
-         if Hint = Tree.Last then
-            Insert_Post (Tree, null, Tree.Last, Key, Node);
-            return;
-         end if;
-
-         declare
-            After : constant Node_Access := Ops.Next (Hint);
-         begin
-            if Is_Less_Key_Node (Key, After) then
-               if Ops.Right (Hint) = null then
-                  Insert_Post (Tree, null, Hint, Key, Node);
-               else
-                  Insert_Post (Tree, After, After, Key, Node);
-               end if;
+            elsif Ops.Right (Before) = null then
+               Insert_Post (Tree, Before, False, Node);
             else
-               Unconditional_Insert_Sans_Hint (Tree, Key, Node);
+               Insert_Post (Tree, Hint, True, Node);
             end if;
          end;
 
          return;
       end if;
 
-      Unconditional_Insert_Sans_Hint (Tree, Key, Node);
+      --  We know that Key isn't less than the hint, so it must be equal
+      --  or greater. So we just test whether Key is less than or equal
+      --  to (same as "not greater than") the hint's next neighbor, and
+      --  if so insert it after the hint.
+
+      declare
+         After : constant Node_Access := Ops.Next (Hint);
+      begin
+         if After = null then
+            Insert_Post (Tree, Hint, False, Node);
+         elsif Is_Greater_Key_Node (Key, After) then
+            Unconditional_Insert_Sans_Hint (Tree, Key, Node);
+         elsif Ops.Right (Hint) = null then
+            Insert_Post (Tree, Hint, False, Node);
+         else
+            Insert_Post (Tree, After, True, Node);
+         end if;
+      end;
    end Generic_Unconditional_Insert_With_Hint;
 
    -----------------
@@ -509,9 +557,10 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       Key  : Key_Type) return Node_Access
    is
       Y : Node_Access;
-      X : Node_Access := Tree.Root;
+      X : Node_Access;
 
    begin
+      X := Tree.Root;
       while X /= null loop
          if Is_Less_Key_Node (Key, X) then
             Y := X;