-- 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 list
--   ,   and
--   |   or
--   '   If x passed as argument then x' is result after subprog executes
-- () or (h,T) A list is either empty of an ordered, (h,T), where h is an.
--       object called the head of the list, and T is a list, called the
--       tail of the list being represented by the ordered pair.
------------------------------------------------------------------
--  Unsafe package, DO NOT USE
------------------------------------------------------------------

generic
   type Object_Type is limited private;
   with procedure Initialize (Object: in out Object_Type);
   with procedure Finalize (Object: in out Object_Type);
   with procedure Copy (Source: in     Object_Type;
                        Target: in out Object_Type);
   with procedure Swap (Source, Target: in out Object_Type);
package List_LPBase is

   type LPList_Type is private;

   List_Underflow  : exception;
   List_Overflow   : exception;

procedure Initialize (List: in out LPList_Type);
   ------------------------------------------------------------------
   -- Pre Cond : List uninitialized
   -- Post Cond: List may be used by other subprograms
   ------------------------------------------------------------------

procedure Finalize (List: in out LPList_Type);
   ------------------------------------------------------------------
   -- Pre Cond : List initialized
   -- Post Cond: List uninitialized
   ------------------------------------------------------------------

function Tail_Of (List: LPList_Type) return LPList_Type;
   ------------------------------------------------------------------
   -- Pre Cond : List /= {}, List = (head, tail) head is
   --            an Object_Type and tail is a LPList_Type
   -- Post Cond: Returns tail
   -- Exception: Invalid_Position, List_Underflow.
   ------------------------------------------------------------------

function Head_Of (List: LPList_Type) return Object_Type;
   ------------------------------------------------------------------
   -- Pre Cond : List = (h, tail), i.e. not empty
   -- Post Cond: returns copy of h
   -- Exception: List_Underflow or Invalid_Position
   ------------------------------------------------------------------

function Empty (List: LPList_Type) return boolean;
   ------------------------------------------------------------------
   -- Pre Cond : None
   -- Post Cond: returns (List /= {})
   -- Exception: None
   ------------------------------------------------------------------

procedure New_Head (Object: in out Object_Type;
                    List  : in     LPList_Type);
   ------------------------------------------------------------------
   -- Pre Cond : List is a (possibly empty) list
   -- Post Cond: List' = (Object, List)
   -- Exception: Invalid_Position, List_Overflow
   -- NOTE:   Swap used to exchange value of Object_Type
   ----------------------------------------------------------

procedure Remove_Head (List  : in     LPList_Type;
                       Object: in out Object_Type);
   ------------------------------------------------------------------
   -- Pre Cond : List = (head, Tail)
   -- Post Cond: List' = Tail
   -- Exception: Invalid_Position, List_Overflow
   -- NOTE:   Swap used to exchange value of Object_Type
   ----------------------------------------------------------

procedure Swap_Tail (Source: in     LPList_Type;
                     Target: in     LPList_Type);
   ---------------------------------------------------------------
   -- Pre-cond : Source = (s, Stail) or (), Target = (t, Ttail) or ()
   --            where Stail and/or Ttail may be ().
   -- Post-cond: Source' = (s, Ttail) or (Ttail),
   --            Target' = (t, Stail) or (Stail)
   -- Exception: Invalid_Share
   ---------------------------------------------------------------

procedure Append (List    : in     LPList_Type;
                  New_Tail: in     LPList_Type);
   ------------------------------------------------------------------
   -- Pre Cond : None
   -- Post Cond: List' = List==New_Tail (Net_Tail attached to the end
   --             New_Tail' = {}
   -- Exception: List_Underflow
   ------------------------------------------------------------------
procedure Append (List    : in     LPList_Type;
                  New_Tail: in out Object_Type);
   -- NOTE:   Swap used to exchange value of Object_Type

type In_Place_Process_Type is access
   procedure (Object: in out Object_Type);

procedure Process_Head (List   : in     LPList_Type;
                        Process:        In_Place_Process_Type);
   ----------------------------------------------------------------
   -- Pre Cond : List = (x, tail)
   -- Post Cond: Process (x) performed
   -- Exception: Depends upon Process
   ------------------------------------------------------------------

procedure Update_Head (List  : in     LPList_Type;
                       Object: in out Object_Type);
   ---------------------------------------------------------
   -- Pre Cond : List = (x, tail)
   -- Post Cond: List' = (Object, tail)
   -- Exception: Invalid_Position
   -- NOTE:   Swap used to exchange value of Object_Type
   ----------------------------------------------------------

procedure Copy (Source: in     LPList_Type;
                Target: in out LPList_Type);
   ------------------------------------------------------------------
   -- Pre Cond : None
   -- Post Cond: Target' = Source
   -- Exception: None
   ------------------------------------------------------------------

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

private
   type Object_Holder;
   type List_Ptr is access Object_Holder;
   type Object_Holder is
      record
         Object: Object_Type; -- Generic data type
         Next  : aliased List_Ptr:= null;
      end record;
      ----------------------------------------
   type LPList_Type is access all List_Ptr;

end List_LPBase;