-- 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 queue
--   ,   and
--   |   or
--   +   if a is and object and p and p are lists (possibly empty) then
--         p+a+q is a list
-- (f,...,r) a queue may be viewed as an n-tuple with f, the object at the
--       front and r the object at the rear
--   '   If x passed as argument then x' is result after subprog executes
--  #(q) No. of objects in q
------------------------------------------------------------------
with Ada.Finalization; use Ada.Finalization;

package Queue_Polymorphic_Cntl is

type Place_Holder is new controlled with private;
   procedure Initialize (Source: in out Place_Holder);
   procedure Finalize (Source: in out Place_Holder);
   procedure Adjust (Source: 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 Queue_Type is new controlled with private;
   procedure Initialize (Queue: in out Queue_Type);
   procedure Finalize (Queue: in out Queue_Type);
   procedure Adjust (Queue: in out Queue_Type);

   Queue_Error    : exception;
   Queue_Underflow: exception;
   Queue_Overflow : exception;

function Empty (Queue: Queue_Type) return boolean;
   ---------------------------------------------------------------------
   -- Pre  Cond  : None
   -- Post Cond  : Return (Queue /= {})
   -- Exceptions : None
   ---------------------------------------------------------------------

function Empty_Queue return Queue_Type;
   ---------------------------------------------------------------------
   -- Pre  Cond  : None
   -- Post Cond  : Queue' = {}
   -- Exceptions : None
   ---------------------------------------------------------------------

generic
   type Extended_Type is new Place_Holder with private;
function g_Front_Of (Queue: Queue_Type) return Extended_Type;

function Front_Of (Queue: Queue_Type) return Holder_Class_Ptr;
   ---------------------------------------------------------------------
   -- Pre  Cond  : Queue /= {}
   -- Post Cond  : Returns Queue(1)
   -- Exceptions : Queue_Underflow
   ---------------------------------------------------------------------

procedure Dequeue (Queue : in out Queue_Type);

generic
   type Extended_Type is new Place_Holder with private;
procedure g_Dequeue (Queue : in out Queue_Type;
                     Object: in out Extended_Type);
procedure Dequeue (Queue : in out Queue_Type;
                   Object: in out Holder_Class_Ptr);
   ---------------------------------------------------------------------
   -- Pre  Cond  : Queue /= {}, Queue = (f, rest), rest is a queue
   -- Post Cond  : Object' = f, Queue' = (rest)
   -- Exceptions : Queue_Underflow
   -- NOTE:   Swap used to exchange value of Place_Holder
   ---------------------------------------------------------------------

procedure Enqueue (Object: in     Place_Holder'Class;
                   Queue : in out Queue_Type);
   ---------------------------------------------------------------------
   -- Pre  Cond  : none,
   -- Post Cond  : Queue' = (Queue, Object)
   -- Exceptions : Queue_Overflow
   -- NOTE:   Swap used to exchange value of Place_Holder
   ---------------------------------------------------------------------

procedure Swap (Source: in out Queue_Type;
                Target: in out Queue_Type);
   ---------------------------------------------------------------------
   -- Pre  Cond  : None
   -- Post Cond  : Target' = Source, Source' = Target
   -- Exceptions : None
   ---------------------------------------------------------------------

private
   type Place_Holder is new controlled with
      record
         Next  : Holder_Class_Ptr := null;
      end record;
      --------------------------------------
   type Queue_Type is new controlled with
      record
         Rear: Holder_Class_Ptr := null;
         Size: natural := 0;
      end record;
      --------------------------------------
end Queue_Polymorphic_Cntl;