{ unit for implementing general queues as linked lists.
           environment, Object Oriented Turbo Pascal 6.0 }
{ Author : Lin Jensen
  Date   : Feb. 12, 1991 }

UNIT QUEUE ;
INTERFACE

{ ============================================================
  A General O-O implementation of linked lists.  A List has elements,
  which have a 'next' slot (plus whatever data the descendents add), 
  they are inserted at the tail, and removed from the head.

  A list can be empty.  A newly created one is empty.  A non-empty list:

        HEAD                            TAIL
         |                               |
         v                               v
       [  ] -> [  ] -> [  ] -> [  ] -> [  ] -> nil

LIST  METHODS:
        INIT    :  Initialize a queue (points to nil)
        GET     :  Return the first element (head) and delete it from queue
        IsEMPTY :  TRUE if queue is empty
        CARD    :  Cardinality (number of elements) in the list.
                :       CARD(INIT) = 0
                :       GET decreases CARD by 1
                :       Adding elements increases CARD
----------------------------------------------------------------
Did you notice that there is no method for adding elements to the list?
What a strange data type!  The answer is that at least the following descendent
types have different element adding protocols, which must be respected:

FIFO Queue
        TAIL_INSERT() : Insert the given element at the end

STACK (LIFO)
        PUSH()      : Add given element at the beginning of the list
        POP         : (Same as GET)

*ORDERED LIST
        INSERT()    : Insert given element in order, this requires a user-
                    :   defined ordering function.
================================================================ }

TYPE
    ElementPtr = ^ queueElement;
    queueElement = OBJECT           {queue elements have a slot which points }
        next : ElementPtr;          { to the next element in the list }
        constructor Init;
        function before (old:ElementPtr): BOOLEAN; virtual;
                        {for ordered lists, define what it means for SELF
                         to come before an old element}
        function equal  (old:ElementPtr): BOOLEAN; virtual;
                        {for Erase, define what object equality means}
        destructor  Destroy; virtual; {allows actual size to be determined}
    end;

{By default, Before returns FALSE, and must be redefined to
 enable ordering. Otherwise, you get a fifoQueue with no erase.
 Equal returns TRUE if the address of self is the same as the "old"
 list element. This is the strictest definition, it can be relaxed to
 mean some field(s) must match }


   {queuePtr = ^ list;}

{ ----------------------- GENERAL LIST --------------------------
  Not very useful by itself, since there is no method for adding elements!
  This is deliberate, we intend it as a framework for :
        FIFO queue  : Insert at the tail
        Stack       : Insert at the head
        Ordered list: Insert based upon ordering relation specific to elements
  ---------------------------------------------------------------------- }

{   ERASURE of an element from any list type is on the basis of a
    compare function EQUAL defined as a virtual method for the particular
    element type.
    This compares Self, a "new" element or test element
    with an existing element, and returns TRUE if the test element
    sufficiently matches the existing one.  Pointers to the old element is
    passed.  It must be TypeCast into the actual type.}


    list  =  OBJECT
    {--------------------- queue methods --------}
       constructor  Init ;
       function     Get     : ElementPtr ;       {also removes from q }
       function     remove (body : elementPtr) : ElementPtr;
                      {remove item matching Body from list, if it is
                      there, as defined by EQUAL method of its object class}
       procedure    erase (body : elementPtr);
                      {Also try to dispose if it USE CAREFULLY}
       function     IsEmpty : BOOLEAN ;          {TRUE if queue empty }
       function     Card    : INTEGER ;     {Cardinality (# elem.) in list}
       function     HeadQ   : ElementPtr;   {so we can traverse list ourselves}
       destructor   Destroy ;
    private
       head : ElementPtr;
       tail : ElementPtr;
       len  : INTEGER;
    end; {list object}

{ ------------------------ FIFO  QUEUES   ------------------------------- }

{ == Elements are inserted at the end of a FIFO queue == }

fifoQueue =     OBJECT (list)
       procedure    Tail_insert ( node : ElementPtr ); 
    end;

{ ------------------------   STACKS       ------------------------------- }

{ == Elements are inserted at the beginning of a stack == }

    Stack =     OBJECT (list)
       procedure    Push ( node : ElementPtr ); 
       function     Pop  : ElementPtr;
    end;
{------------------------- ORDERED  LISTS --------------------------------}

{   Insertion in an ordered queue is on the basis of a compare function
    BEFORE defined as a virtual method for the particular element type.
    This compares a new element SELF with an existing element,
    and returns TRUE if the new element should be inserted before
    the existing one.  Pointer to the existing (old) element s passed.
    They must be TypeCast into the actual type.  If the existing
    element is NIL, return TRUE !!}

{compare = function (new:ElementPtr; old:ElementPtr) : BOOLEAN;} { FAR; }
          {TRUE iff  old = NIL  OR  new^ < old^ ; 
                                   where < depends on element type}

{    orderedListPtr = ^ orderedList;}
    orderedList  = OBJECT (list)
       procedure    Insert (snoring : elementPtr );
       {insert can be used if a virtual function BEFORE is defined to compare
        elements of the actual descendent type}
    end;


    STACKwithErase = STACK;

{============================================================================}
IMPLEMENTATION

constructor queueElement.init;  {MUST BE CALLED to init VMT}
begin
   next := NIL;
end;

function  queueElement.before (old:ElementPtr): BOOLEAN; 
                        {for ordered lists, define what it means for SELF
                         to come before an old element}
begin
  before := old = NIL;  {TRUE if old is NIL, else always false}
end;    {not much to do in simple case}

function  queueElement.equal  (old:ElementPtr): BOOLEAN; 
                        {for Erase, define what object equality means}
{The default is the strictest, identity of the two elements}
begin
  equal := old = addr(self);
end;    {equal: for example, to find myself in reporter}


destructor queueElement.Destroy;
begin
end;    {not much to do in simple case}

    {---------------------  LIST methods --------}
constructor  list.Init ;
begin
   head := NIL;
   tail := NIL;
   len  := 0;
end;

procedure    FIFOqueue.Tail_insert ( node : ElementPtr );
begin
   if head = NIL then
      head := node           {empty -> singleton }
   else
      tail^.next := node ;     {after curent tail}
   tail := node;
   tail^.next := nil  ;     {mark end of list}
   len := len + 1;          {keep track of length}
end; {tail insert}

function  list.Get : ElementPtr ;  {also removes from q }
begin
    get := head;                        {return pointer to first element}
    if head = NIL then
       WRITELN ('ATTEMPT TO GET ELEMENT FROM EMPTY LIST')
    else
      begin
       len := len - 1;      {keep track of length}
       head := head^.next;              {remove it from list}
      end;
    if head = NIL then tail := NIL;     {list may have become empty}
end;    {Get}

function     list.IsEmpty : BOOLEAN ;                {TRUE if queue empty }
begin
   IsEmpty := head = NIL;
end;

function    list.Card : Integer;            {determine cardinality (length)}
begin
    card := len
end;

function     list.HeadQ   : ElementPtr;   {so we can traverse list ourselves}
begin HeadQ := Head; end;

destructor  list.destroy;
begin
   { deallocate all the elements -- must know their size or type }
   while not IsEmpty do
      Dispose (Get, Destroy);
end;

{----------------  STACK METHODS ----------------------------------}

procedure   stack. Push ( node : ElementPtr ); 
begin
    node^.next := head;      {insert at head of list}
    head := node;
    len := len + 1;
end;  {push}

function    stack.  Pop  : ElementPtr;  {synonym for Get}
begin
    pop := get
end;

{  =====================  ORDERED INSERT  ================================ }

Procedure orderedlist. INSERT (snoring : elementPtr);
var
   prev  : elementPtr; {pointer which follows processes with earlier wakeups}

procedure link (VAR before, this : elementPtr);     {link pointers together}
begin
    this^.next := before;  {move link to new item's link field}
    before := this;        {previous pointer field now links to new process}
end; {local link}

begin {insert}
    if snoring = NIL then EXIT;    {nothing to insert!!}
    if snoring^.before(head) then
        link (head, snoring)
    else
      begin             {look for last process with earlier time}
        prev := head;
        while NOT snoring^.before ( prev^.next) do
            prev := prev^.next;
        link (prev^.next, snoring);   {note that the actual link field passed}
      end;
   len := len + 1;          {keep track of length}
end; {insert}

{-------------------   remove from list -------------------------------------}

function list . remove (body : elementPtr) : elementPtr;
{remove 'equal' element from list, ASSUME it is THERE }
{giving it back to caller (or NIL if not there)}
{Use ERASE, CAREFULLY, to also dispose of the list element}
var 
   fore, aft : elementPtr;   {double ptr scan through list}
begin
  fore := head;
  if (head <> nil) and (body <> Nil) then         {do nothing to empty list}
   if body^.EQUAL (fore) then       {found at head of list}
     begin
      head := fore^.next ;           {remove head element}
      len := len - 1;                { correct length }
     end
   else
     begin                          {assume body is there}
      while (fore <> nil) and not body^.EQUAL (fore) do
       begin
        aft := fore;
        fore := fore^.next
       end ;   {scan}
      if fore<>nil then
       begin
         aft^.next := fore^.next;      {link around}
(*         dispose (fore, destroy);       {release space}    *)
         len := len - 1;                { correct length }
       end;                        {else no operation, not there}
     end;
     REMOVE := FORE;               {deliver item to caller, if there}
end; {remove}

procedure list . erase (body : elementPtr);
{if it is there, get rid of it, and it's space.
 We know at least that we cannot dispose of the SAME space as body
 here, ("invalid pointer operation"), but only an extra copy.
 Otherwise, the user must be careful to ensure that the item being
 disposed was in fact dynamically allocated}

var
   dodo : elementPtr;
begin
   dodo := remove (body);
   if (dodo <> NIL) AND (dodo <> body) then
      DISPOSE (dodo, destroy);
end; {erase}

END.