package body RINGS is
-- QUEUEs are implemented as rings.

-- This version is not intended for concurrent use.
-- No mutual exclusion is provided.

  type QUEUE_RECORD is
       record ITEM: ITEM_TYPE;
              NEXT,
              PREV: QUEUE_TYPE;
       end record;

-- Each queue is represented as an ordered ring:
-- The pointer to the queue points to a header node,
-- which in turn points to the first, and then in ascending order
-- until the last element is reached.
-- This permits cheap insertion at the head or tail position,
-- and cheap deletion at any position.

AVAIL:        -- list of available nodes.
        QUEUE_TYPE:= null;

procedure APPLY(QUEUE: QUEUE_TYPE) is
  N: QUEUE_TYPE:= QUEUE;
begin loop N:=N.NEXT;
           exit when N=QUEUE;
           P(N.ITEM);
      end loop;
end APPLY;

procedure DELETE(QUEUE: QUEUE_TYPE; ITEM: ITEM_TYPE) is
  N,P,X: QUEUE_TYPE;
begin X:=QUEUE;
      loop X:=X.NEXT;
           if X=QUEUE then return; end if;
           if X.ITEM>=ITEM
           then if X.ITEM=ITEM then exit;
                else return; end if;
           end if;
      end loop;
      N:=X.NEXT; P:=X.PREV;
      N.PREV:=P; P.NEXT:=N;
      X.NEXT:=AVAIL; AVAIL:=X;
end DELETE; 

function EMPTY(QUEUE: QUEUE_TYPE) return BOOLEAN is
begin return QUEUE=QUEUE.NEXT;
end EMPTY;

procedure INSERT(QUEUE: QUEUE_TYPE; ITEM: ITEM_TYPE) is
  N,T: QUEUE_TYPE:=QUEUE;
begin loop N:=N.NEXT;
           exit when N=QUEUE;
           if N.ITEM=ITEM then return; end if;
           exit when N.ITEM>=ITEM;
      end loop;
      if AVAIL=null then T:=new QUEUE_RECORD;
      else T:=AVAIL; AVAIL:=AVAIL.NEXT; end if;
      T.ITEM:=ITEM;
      T.PREV:=N.PREV; T.NEXT:=N;
      N.PREV:=T; T.PREV.NEXT:=T;
end INSERT;

procedure MAKE_EMPTY(QUEUE: in out QUEUE_TYPE) is
begin if QUEUE=null
      then if AVAIL=null then QUEUE:= new QUEUE_RECORD;
           else QUEUE:= AVAIL; AVAIL:=AVAIL.NEXT; end if;
      elsif QUEUE.NEXT=QUEUE then return;
      else QUEUE.PREV.NEXT:=AVAIL; AVAIL:=QUEUE.NEXT;
      end if;
      QUEUE.NEXT:= QUEUE; QUEUE.PREV:= QUEUE;
end MAKE_EMPTY;

function MEMBER(QUEUE: QUEUE_TYPE; ITEM: ITEM_TYPE) return BOOLEAN is
  N: QUEUE_TYPE:=QUEUE;
begin loop N:=N.NEXT;
           exit when N=QUEUE;
           if N.ITEM>=ITEM
           then if N.ITEM=ITEM then return TRUE;
                else return FALSE; end if;
           end if;
      end loop;
      return FALSE;
end MEMBER;
  
function MIN(QUEUE: QUEUE_TYPE) return ITEM_TYPE is
begin return QUEUE.NEXT.ITEM;
end MIN;

end RINGS;