--::::::::::
--TRBITACN.ADS  -- tree_binary_tag_cntl
--::::::::::
-- Copyright (c) 1995      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 Object_Type.
-- '   If x passed as argument then x' is result after subprog executes
------------------------------------------------------------------
--  For safe use of this package
--  Object_Type is POLYMORPHIC
--  Tree_type is UNBOUND MANAGED CONTROLLED
------------------------------------------------------------------
with rtree_LPBase, Ada.Finalization, Tag_To_Lpt;
use Ada.Finalization;
generic
   type Object_Type is tagged private;
package Tree_Binary_Tag_Cntl is

   type Object_Ptr is access Object_Type'Class;

   -----------------------------------------------------
   -- WARNING: DO NOT USE qzktre & ttl
      package ttl is new Tag_To_Lpt (Object_Type, Object_Ptr);
      package qzktre is new rtree_LPBase
         (Object_Ptr, ttl.Initialize, ttl.Finalize, ttl.Copy, ttl.Swap);
   -----------------------------------------------------

   subtype In_Place_Process_Type is qzktre.In_Place_Process_Type;
   -- access procedure (Object: in out Object_Ptr);

   Tree_Underflow   : exception renames qzktre.Tree_Underflow;
   Tree_Overflow    : exception renames qzktre.Tree_Overflow;
   Root_Exists      : exception renames qzktre.Root_Exists;

type Tree_Type is new controlled with private;

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

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

procedure Graft (Object: in     Object_Type'Class;
                 Tree  : in     Tree_Type );
   -----------------------------------------------------
   -- Pre Cond: Tree = ()
   -- PostCond: Tree' = ((), Object, ())
   -- Exception: Tree_Overflow
   -----------------------------------------------------

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

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

function Left_Subtree (Tree: Tree_Type) return Tree_Type;
   -----------------------------------------------------
   -- Pre Cond: Tree = (lst, r, rst)
   -- PostCond: Returns lst
   -- Exception: Tree_Underflow
   -- 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
   -- SideEffect: rst can only be recursively processed
   -----------------------------------------------------

procedure Process_Root (Tree   : in     Tree_Type;
                        Process:        In_Place_Process_Type);
   -----------------------------------------------------
   -- Pre Cond: Tree = (lst, r, rst)
   -- PostCond: Process(r), let r' be the value of r after
   --    Process(r) then Tree' = (lst, r', rst)
   -- Exception: Tree_Underflow or exceptions raised by
   --            Process
   -----------------------------------------------------

procedure Update_Root (Tree  : in     Tree_Type;
                       Object: in     Object_Type'Class);
   -----------------------------------------------------
   -- Pre Cond: Tree = (lst, root, rst)
   -- PostCond: Tree' = (lst, Object, rst)
   -- Exception: Tree_Underflow
   -----------------------------------------------------

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

private
   procedure Initialize (Tree: in out Tree_Type);
   procedure Finalize (Tree: in out Tree_Type);
   procedure Adjust (Tree: in out Tree_Type);

   type Tree_Type is new controlled with
      record
         Base  : boolean := true;
         Actual: qzktre.RTree_Type;
      end record;
end Tree_Binary_Tag_Cntl;