-- Copyright (c) 1995/6    John Beidler
--                         Computing Sciences Dept.
--                         Univ. of Scranton, Scranton, PA 18510
--
--                         (717) 941-7446 voice
--                         (717) 941-4250 FAX
--                         beidler@cs.uofs.edu
--
--  For use by non-profit educational institutions only.
--  This software is GUARANTEED.  Please report any errors.  All
--  corrections will be made as soon as possible (normally within
--  one working day).
------------------------------------------------------------------
-- Assertion notation:
-- /=  not equal
-- {}  empty tree
-- ,   and
-- |   or
-- (lst,root,rst)  represents a tree with the object "root" as the
--     root of the tree and "lst" and "rst" are the left subtree
--     and right subtree, respectively, of the root.  lst or rst may
--     be empty.  root is Place_Holder.
-- '   If x passed as argument then x' is result after subprog executes
------------------------------------------------------------------
with Ada.Finalization; use Ada.Finalization;

package Tree_Binary_Polymorphic_Cntl is

type Place_Holder is new controlled with private;
   procedure Initialize (Object: in out Place_Holder);
   procedure Finalize (Object: in out Place_Holder);
   procedure Adjust (Object: in out Place_Holder);
   -------------------------------------------------------------
   -- When extending Place_Holder type the client must provide
   -- Initialize, Finalize, and Adjust procedures for the extended
   -- type UNLESS the extension is bound AND an aggregate is used
   -- to initialize the components in the extension
   -------------------------------------------------------------

type Holder_Class_Ptr is access Place_Holder'Class;
   procedure Recycle (Point: in out Holder_Class_Ptr);

type Tree_Type is new controlled with private;
   procedure Initialize (Tree: in out Tree_Type);
   procedure Finalize (Tree: in out Tree_Type);
   procedure Adjust (Tree: in out Tree_Type);

   Tree_Underflow   : exception;
   Tree_Overflow    : exception;
   Root_Exists      : exception;

function Empty (Tree: Tree_Type) return boolean;
   -----------------------------------------------------
   -- returns Tree = ()?
   -----------------------------------------------------

function Empty_Tree return Tree_Type;
   -----------------------------------------------------
   -- PostCond: returns ()
   -----------------------------------------------------

generic
   type Extended_Type is new Place_Holder with private;
function g_Root_Of (Tree: Tree_Type) return Extended_Type;

function Root_Of (Tree: Tree_Type) return Holder_Class_Ptr;
   -----------------------------------------------------
   -- PreCond:  Tree = (lst, root, rst), Tree /= ()
   -- returns root
   -----------------------------------------------------

procedure Graft (Object: in     Place_Holder'Class;
                 Tree  : in     Tree_Type );
   -----------------------------------------------------
   -- Pre Cond: Tree = ()
   -- PostCond: Tree' = ((), Object, ())
   -- Exception: Invalid_Position, Invalid_Graft,
   --            Tree_Overflow
   -- NOTE:   Swap used to exchange value of Place_Holder
   -----------------------------------------------------

procedure Graft (Subtree: in     Tree_Type;
                 Tree   : in     Tree_Type);
   -----------------------------------------------------
   -- Pre Cond: Tree = ()
   -- PostCond: Tree' = Subtree, Subtree' = ()
   -- Exception: Invalid_Position, Invalid_Graft, Tree_Overflow
   -----------------------------------------------------

procedure Prune (Tree   : in     Tree_Type;
                 Subtree: in out Tree_Type);
   -----------------------------------------------------
   -- Pre Cond:
   -- PostCond: Tree' = (), Subtree' = Tree
   -- Exception: Invalid_Position
   -----------------------------------------------------

function Left_Subtree (Tree: Tree_Type) return Tree_Type;
   -----------------------------------------------------
   -- Pre Cond: Tree = (lst, r, rst)
   -- PostCond: Returns lst
   -- Exception: Tree_Underflow, Invalid_Position
   -- SideEffect: lst can only be recursively processed
   -----------------------------------------------------

function Right_Subtree (Tree: Tree_Type) return Tree_Type;
   -----------------------------------------------------
   -- Pre Cond: Tree = (lst, r, rst)
   -- PostCond: Returns rst
   -- Exception: Tree_Underflow, Invalid_Position
   -- SideEffect: rst can only be recursively processed
   -----------------------------------------------------

procedure Update_Root (Tree  : in     Tree_Type;
                       Object: in     Place_Holder'Class);
   -----------------------------------------------------
   -- Pre Cond: Tree = (lst, root, rst)
   -- PostCond: Tree' = (lst, Object, rst)
   -- Exception: Invalid_Position
   -- NOTE:   Swap used to exchange value of Place_Holder
   -----------------------------------------------------

procedure Swap (Source: in out Tree_Type;
                Target: in out Tree_Type);
   -----------------------------------------------------
   -- Pre Cond: None
   -- PostCond: Target' = Source, Source' = Target
   -- Exception: None
   -----------------------------------------------------

private

type Place_Holder is new controlled with
   record
      Left_Node : aliased Holder_Class_Ptr := null;
      Right_Node: aliased Holder_Class_Ptr := null;
   end record;
type Tree_Anchor is access all Holder_Class_Ptr;

type Tree_Type is new controlled with
   record
      Anchor: Tree_Anchor;
      Base  : boolean := true;
   end record;

end Tree_Binary_Polymorphic_Cntl;