File : bc-containers-trees-binary.adb


-- Copyright (C) 1994-1998 Grady Booch, David Weller and Simon Wright.
-- All Rights Reserved.
--
--      This program is free software; you can redistribute it
--      and/or modify it under the terms of the Ada Community
--      License which comes with this Library.
--
--      This program is distributed in the hope that it will be
--      useful, but WITHOUT ANY WARRANTY; without even the implied
--      warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
--      PURPOSE. See the Ada Community License for more details.
--      You should have received a copy of the Ada Community
--      License with this library, in the file named "Ada Community
--      License" or "ACL". If not, contact the author of this library
--      for a copy.
--

-- $Id: bc-containers-trees-binary.adb,v 1.8.2.1 1999/12/31 15:15:05 simon Exp $

with BC.Support.Exceptions;

package body BC.Containers.Trees.Binary is

  package BSE renames BC.Support.Exceptions;
  procedure Assert
  is new BSE.Assert ("BC.Containers.Trees.Binary");

  use type Nodes.Binary_Node;
  use type Nodes.Binary_Node_Ref;

  function Create (From : Binary_Tree) return Binary_Tree is
    Temp : Binary_Tree := (Ada.Finalization.Controlled with Rep => From.Rep);
  begin
    if From.Rep /= null then
      Temp.Rep.Count := Temp.Rep.Count + 1;
    end if;
    return Temp;
  end Create;

  function "=" (Left, Right : Binary_Tree) return Boolean is
  begin
    return Left.Rep.all = Right.Rep.all;
  end "=";

  procedure Clear (T : in out Binary_Tree) is
  begin
    Purge (T.Rep);
    T.Rep := null;
  end Clear;

  procedure Insert (T : in out Binary_Tree;
                    Elem : in Item;
                    Child : in Child_Branch) is
  begin
    Assert (T.Rep = null or else T.Rep.Parent = null,
       BC.Not_Root'Identity,
       "Insert",
       BSE.Not_Root);
    if Child = Left then
      T.Rep := Nodes.Create (Elem,
                             Parent => null,
                             Left => T.Rep,
                             Right => null);
    else
      T.Rep := Nodes.Create (Elem,
                             Parent => null,
                             Left => null,
                             Right => T.Rep);
    end if;
  end Insert;

  procedure Append (T : in out Binary_Tree;
                    Elem : in Item;
                    Child : in Child_Branch;
                    After : in Child_Branch) is
  begin
    if T.Rep = null then
      T.Rep := Nodes.Create (Elem,
                             Parent => null,
                             Left => null,
                             Right => null);
    else
      if After = Left then
        if Child = Left then
          T.Rep.Left := Nodes.Create (Elem,
                                      Parent => T.Rep,
                                      Left => T.Rep.Left,
                                      Right => null);
        else
          T.Rep.Left := Nodes.Create (Elem,
                                      Parent => T.Rep,
                                      Left => null,
                                      Right => T.Rep.Left);
        end if;
      else
        if Child = Left then
          T.Rep.Right := Nodes.Create (Elem,
                                       Parent => T.Rep,
                                       Left => T.Rep.Right,
                                       Right => null);
        else
          T.Rep.Right := Nodes.Create (Elem,
                                       Parent => T.Rep,
                                       Left => null,
                                       Right => T.Rep.Right);
        end if;
      end if;
    end if;
  end Append;

  procedure Remove (T : in out Binary_Tree; Child : in Child_Branch) is
  begin
    Assert (T.Rep /= null,
            BC.Is_Null'Identity,
            "Remove",
            BSE.Is_Null);
    if Child = Left then
      Purge (T.Rep.Left);
      T.Rep.Left := null;
    else
      Purge (T.Rep.Right);
      T.Rep.Right := null;
    end if;
  end Remove;

  procedure Share (T : in out Binary_Tree;
                   Share_With : in Binary_Tree;
                   Child : in Child_Branch) is
    Temp : Nodes.Binary_Node_Ref :=  Share_With.Rep;
  begin
    Assert (Share_With.Rep /= null,
            BC.Is_Null'Identity,
            "Share",
            BSE.Is_Null);
    if Child = Left then
      Temp := Share_With.Rep.Left;
    else
      Temp := Share_With.Rep.Right;
    end if;
    Clear (T);
    T.Rep := Temp;
    T.Rep.Count := T.Rep.Count + 1;
  end Share;

  procedure Swap_Child (T : in out Binary_Tree;
                        Swap_With : in out Binary_Tree;
                        Child : in Child_Branch) is
    Curr : Nodes.Binary_Node_Ref;
  begin
    Assert (T.Rep /= null,
            BC.Is_Null'Identity,
            "Swap_Child",
            BSE.Is_Null);
    Assert (Swap_With.Rep = null or else Swap_With.Rep.Parent = null,
       BC.Not_Root'Identity,
       "Swap_Child",
       BSE.Not_Root);
    if Child = Left then
      Curr := T.Rep.Left;
      T.Rep.Left := Swap_With.Rep;
    else
      Curr := T.Rep.Right;
      T.Rep.Right := Swap_With.Rep;
    end if;
    if Swap_With.Rep /= null then
      Swap_With.Rep.Parent := T.Rep;
    end if;
    Swap_With.Rep := Curr;
    if Swap_With.Rep /= null then
      Swap_With.Rep.Parent := null;
    end if;
  end Swap_Child;

  procedure Child (T : in out Binary_Tree; Child : in Child_Branch) is
  begin
    if Child = Left then
      Left_Child (T);
    else
      Right_Child (T);
    end if;
  end Child;

  procedure Left_Child (T : in out Binary_Tree) is
    Curr : Nodes.Binary_Node_Ref;
  begin
    Assert (T.Rep /= null,
            BC.Is_Null'Identity,
            "Left_Child",
            BSE.Is_Null);
    Curr := T.Rep;
    T.Rep := T.Rep.Left;
    if Curr.Count > 1 then
      Curr.Count := Curr.Count - 1;
      if T.Rep /= null then
        T.Rep.Count := T.Rep.Count + 1;
      end if;
    else
      if T.Rep /= null then
        T.Rep.Parent := null;
      end if;
      if Curr.Right /= null then
        Curr.Right.Parent := null;
      end if;
      Nodes.Delete (Curr);
    end if;
  end Left_Child;

  function Left_Child (T : Binary_Tree) return Binary_Tree is
    Result : Binary_Tree;
  begin
    Result := T;
    Left_Child (Result);
    return Result;
  end Left_Child;

  procedure Right_Child (T : in out Binary_Tree) is
    Curr : Nodes.Binary_Node_Ref;
  begin
    Assert (T.Rep /= null,
            BC.Is_Null'Identity,
            "Right_Child",
            BSE.Is_Null);
    Curr := T.Rep;
    T.Rep := T.Rep.Right;
    if Curr.Count > 1 then
      Curr.Count := Curr.Count - 1;
      if T.Rep /= null then
        T.Rep.Count := T.Rep.Count + 1;
      end if;
    else
      if T.Rep /= null then
        T.Rep.Parent := null;
      end if;
      if Curr.Left /= null then
        Curr.Left.Parent := null;
      end if;
      Nodes.Delete (Curr);
    end if;
  end Right_Child;

  function Right_Child (T : Binary_Tree) return Binary_Tree is
    Result : Binary_Tree;
  begin
    Result := T;
    Right_Child (Result);
    return Result;
  end Right_Child;

  procedure Parent (T : in out Binary_Tree) is
  begin
    Assert (T.Rep /= null,
            BC.Is_Null'Identity,
            "Parent",
            BSE.Is_Null);
    if T.Rep.Parent = null then
      Clear (T);
    else
      T.Rep.Count := T.Rep.Count - 1;
      T.Rep := T.Rep.Parent;
      if T.Rep /= null then
        T.Rep.Count := T.Rep.Count + 1;
      end if;
    end if;
  end Parent;

  procedure Set_Item (T : in out Binary_Tree; Elem : in Item) is
  begin
    Assert (T.Rep /= null,
            BC.Is_Null'Identity,
            "Set_Item",
            BSE.Is_Null);
    T.Rep.Element := Elem;
  end Set_Item;

  function Has_Children (T : in Binary_Tree) return Boolean is
  begin
    return (T.Rep /= null and then
       (T.Rep.Left /= null or else T.Rep.Right /= null));
  end Has_Children;

  function Is_Null (T : in Binary_Tree) return Boolean is
  begin
    return T.Rep = null;
  end Is_Null;

  function Is_Shared (T : in Binary_Tree) return Boolean is
  begin
    return T.Rep /= null and then T.Rep.Count > 1;
  end Is_Shared;

  function Is_Root (T : in Binary_Tree) return Boolean is
  begin
    return T.Rep = null or else T.Rep.Parent = null;
  end Is_Root;

  function Item_At (T : in Binary_Tree) return Item is
  begin
    Assert (T.Rep /= null,
            BC.Is_Null'Identity,
            "Item_At",
            BSE.Is_Null);
    return T.Rep.Element;
  end Item_At;

  procedure Purge (Node : in out Nodes.Binary_Node_Ref) is
  begin
    if Node /= null then
      if Node.Count > 1 then
        Node.Count := Node.Count - 1;
      else
        Purge (Node.Left);
        if Node.Left /= null then
          Node.Left.Parent := null;
        end if;
        Purge (Node.Right);
        if Node.Right /= null then
          Node.Right.Parent := null;
        end if;
        Nodes.Delete (Node);
      end if;
    end if;
  end Purge;

  procedure Initialize (T : in out Binary_Tree) is
  begin
    null;
  end Initialize;

  procedure Adjust (T : in out Binary_Tree) is
  begin
    if T.Rep /= null then
      T.Rep.Count := T.Rep.Count + 1;
    end if;
  end Adjust;

  procedure Finalize (T : in out Binary_Tree) is
  begin
    Clear (T);
  end;

end BC.Containers.Trees.Binary;