File : bc-containers-trees-multiway.adb


-- Copyright (C) 1994-1999 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-multiway.adb,v 1.8.2.1 1999/12/31 15:15:32 simon Exp $

with BC.Support.Exceptions;

package body BC.Containers.Trees.Multiway is

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

  use type Nodes.Multiway_Node;
  use type Nodes.Multiway_Node_Ref;

  procedure Mend (T : in out Nodes.Multiway_Node_Ref) is
  begin
    if T.Child /= null then
      T.Child.Parent := T;
    end if;
  end Mend;

  procedure Purge (Curr : in out Nodes.Multiway_Node_Ref) is
  begin
    if Curr /= null then
      if Curr.Count > 1 then
        Curr.Count := Curr.Count - 1;
      else
        declare
          Ptr : Nodes.Multiway_Node_Ref := Curr.Child;
          Next: Nodes.Multiway_Node_Ref;
        begin
          while Ptr /= null loop
            Next := Ptr.Sibling;
            Ptr.Sibling := null;
            Purge (Ptr);
            if Ptr /= null then
              Ptr.Parent := null;
            end if;
            Ptr := Next;
          end loop;
          Nodes.Delete (Curr);
        end;
      end if;
    end if;
  end Purge;

  function Create (From : Multiway_Tree) return Multiway_Tree is
    Temp : Multiway_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 : Multiway_Tree) return Boolean is
  begin
    return Left.Rep = Right.Rep;
  end "=";

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

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

  procedure Append (T : in out Multiway_Tree; Elem : in Item) is
  begin
    if T.Rep = null then
      T.Rep := Nodes.Create (Elem,
                             Parent => null,
                             Child => T.Rep,
                             Sibling => null);
    else
      T.Rep.Child := Nodes.Create (Elem,
                                   Parent => T.Rep,
                                   Child => null,
                                   Sibling => T.Rep.Child);
    end if;
  end Append;

  procedure Append (T : in out Multiway_Tree;
                    Elem : in Item;
                    After : Positive) is
  begin
    if T.Rep = null then
      T.Rep := Nodes.Create (Elem,
                             Parent => null,
                             Child => T.Rep,
                             Sibling => null);
    else
      declare
        Curr : Nodes.Multiway_Node_Ref := T.Rep.Child;
      begin
        if Curr = null then
          T.Rep.Child := Nodes.Create (Elem,
                                       Parent => T.Rep,
                                       Child => null,
                                       Sibling => T.Rep.Child);
        else
          declare
            I : Positive := 1;
          begin
            while Curr /= null and then I < After loop
              Curr := Curr.Sibling;
              I := I + 1;
            end loop;
            Assert (Curr /= null,
                    BC.Range_Error'Identity,
                    "Append",
                    BSE.Invalid_Index);
            Curr.Sibling := Nodes.Create (Elem,
                                          Parent => T.Rep,
                                          Child => null,
                                          Sibling => Curr.Sibling);
          end;
        end if;
      end;
    end if;
  end Append;

  procedure Append (T : in out Multiway_Tree;
                    From_Tree : in out Multiway_Tree) is
  begin
    if From_Tree.Rep = null then
      return;
    end if;
    Assert(From_Tree.Rep.Parent = null,
           BC.Not_Root'Identity,
           "Append",
           BSE.Not_Root);
    if T.Rep = null then
      T.Rep := From_Tree.Rep;
      T.Rep.Count := T.Rep.Count + 1;
    else
      From_Tree.Rep.Sibling := T.Rep.Child;
      From_Tree.Rep.Parent := T.Rep;
      From_Tree.Rep.Count := From_Tree.Rep.Count + 1;
      T.Rep.Child := From_Tree.Rep;
    end if;
  end Append;

  procedure Remove (T : in out Multiway_Tree; Index : Positive) is
  begin
    Assert (T.Rep /= null,
            BC.Is_Null'Identity,
            "Remove",
            BSE.Is_Null);
    declare
      I : Positive := 1;
      Prev : Nodes.Multiway_Node_Ref;
      Curr : Nodes.Multiway_Node_Ref := T.Rep.Child;
    begin
      while Curr /= null and then I < Index loop
        Prev := Curr;
        Curr := Curr.Sibling;
        I := I + 1;
      end loop;
      Assert (Curr /= null,
              BC.Range_Error'Identity,
              "Remove",
              BSE.Invalid_Index);
      if Prev = null then
        T.Rep.Child := Curr.Sibling;
      else
        Prev.Sibling := Curr.Sibling;
      end if;
      Curr.Parent := null;
      Curr.Sibling := null;
      Purge (Curr);
    end;
  end Remove;

  procedure Share (T : in out Multiway_Tree;
                   Share_With : in Multiway_Tree;
                   Child : Positive) is
    Ptr : Nodes.Multiway_Node_Ref := Share_With.Rep;
    I : Positive := 1;
  begin
    Assert (Ptr /= null,
            BC.Is_Null'Identity,
            "Share",
            BSE.Is_Null);
    Ptr := Ptr.Child;
    while Ptr /= null and then I < Child loop
      Ptr := Ptr.Sibling;
      I := I + 1;
    end loop;
    Assert (Ptr /= null,
            BC.Range_Error'Identity,
            "Share",
            BSE.Invalid_Index);
    Clear (T);
    T.Rep := Ptr;
    T.Rep.Count := T.Rep.Count + 1;
  end Share;

  procedure Swap_Child (T : in out Multiway_Tree;
                        Swap_WIth : in out Multiway_Tree;
                        Child : in Positive) is
    Prev : Nodes.Multiway_Node_Ref;
    Curr : Nodes.Multiway_Node_Ref := T.Rep;
    I : Positive := 1;
  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);
    Curr := Curr.Child;
    while Curr /= null and then I < Child loop
      Prev := Curr;
      Curr := Curr.Sibling;
      I := I + 1;
    end loop;
    Assert (Curr /= null,
            BC.Range_Error'Identity,
            "Swap_Child",
            BSE.Invalid_Index);
    Swap_With.Rep.Sibling := Curr.Sibling;
    if Prev = null then
      T.Rep.Child := Swap_With.Rep;
    else
      Prev.Sibling := Swap_With.Rep;
    end if;
    if Swap_With.Rep /= null then
      Swap_With.Rep.Parent := T.Rep;
    end if;
    Swap_With.Rep := Curr;
    Swap_With.Rep.Sibling := null;
    Swap_With.Rep.Parent := null;
  end Swap_Child;


  procedure Child (T : in out Multiway_Tree; Child : in Positive) is
    Curr : Nodes.Multiway_Node_Ref := T.Rep;
    I : Positive := 1;
  begin
    Assert (T.Rep /= null,
            BC.Is_Null'Identity,
            "Child",
            BSE.Is_Null);
    Curr := Curr.Child;
    while Curr /= null and then I < Child loop
      Curr := Curr.Sibling;
      I := I + 1;
    end loop;
    Assert (Curr /= null,
            BC.Range_Error'Identity,
            "Child",
            BSE.Invalid_Index);
    Curr.Count := Curr.Count + 1;
    Purge (T.Rep);
    T.Rep := Curr;
  end Child;

  procedure Parent (T : in out Multiway_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;
      T.Rep.Count := T.Rep.Count + 1;
    end if;
  end Parent;

  procedure Set_Item (T : in out Multiway_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 Arity (T : Multiway_Tree) return Natural is
  begin
    Assert (T.Rep /= null,
            BC.Is_Null'Identity,
            "Arity",
            BSE.Is_Null);
    declare
      Count : Natural := 0;
      Ptr : Nodes.Multiway_Node_Ref := T.Rep.Child;
    begin
      while Ptr /= null loop
        Count := Count + 1;
        Ptr := Ptr.Sibling;
      end loop;
      return Count;
    end;
  end Arity;

  function Has_Children (T : in Multiway_Tree) return Boolean is
  begin
    return T.Rep /= null and then T.Rep.Child /= null;
  end Has_Children;

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

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

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

  function Item_At (T : in Multiway_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;

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

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

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

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

end BC.Containers.Trees.Multiway;