program adtdemo (infile1,output);
    {adtdemo reads a file of single digit integers, one per line, and puts
     them into a list L. The list is then printed, purged of duplicate elements
     and printed again.

 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
              QUEUE ADT    -   MAXIMUM SIZE OF THE QUEUE}
const
  maxlength = 16;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      LIST ADT (a LINKED LIST (WITHOUT a header cell) implementation)


NOTES:-    1. The position operated on by RETRIEVE and DELETE
              is the position pointed to by the position pointer.
              (ENDLIS returns a pointer to nil ("one past last element")
              and FIRST to the first element)

           2. INSERT puts its argument after the element pointed to.
              It is not possible to insert ahead of the first element.}

type
  infotype = integer;
  list = ^listype;
  position = list;
  listype = record
              info: infotype;
              next: list
            end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

              QUEUE ADT    -   DECLARATIONS}

  elementtype = char;
  QUEUE = record
            elements: array [1..maxlength] of elementtype;
            front, rear: integer
          end;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

var
  infile1: text;
  L: list;
  Q: QUEUE;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      LIST ADT    -   CODE}

function FIRST (var L: list): position;
  begin
    FIRST:=L
  end;
function ENDLIS (L: list): position;
  begin
    ENDLIS:= nil
  end;
function NEXT (p: position; L:list): position;
  begin
    NEXT:= p^.next
  end;
function RETRIEVE (p: position; L: list): infotype;
  begin
    RETRIEVE:= p^.info
  end;
procedure DELETE (var p: position; var L: list);
  var
    s,t: position;
  begin
    if p=L
      then
        begin
          L:= L^.next;
          p:= L
        end
      else
        begin
          s:= L;
          t:= L^.next;
          while t<>p do
            begin
              s:= s^.next;
              t:= t^.next
            end;
          s^.next:= p^.next;
          s:= p;
          p:= p^.next;
          dispose (s)
        end
  end;
procedure MAKENULL (var L: list);
  begin
    L:=nil
  end;
procedure INSERT (x: infotype; var p: position; var L: list);
  var
    q: position;
  begin
    new(q);
    q^.info:=x;
    if L=nil
      then
        begin
          q^.next:= nil;
          L:=q
        end
      else
        begin
          q^.next:= p^.next;
          p^.next:= q;
        end;
    p:= q
  end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

              QUEUE    -   CODE}

procedure error;
  begin
  { * * COMPILER SPECIFIC FEATURE FOLLOWS * * }
    abort ('FATAL ERROR',0,0)
  { * * END CSF * * }
  end;
function addone (i: integer): integer;
  begin
    addone:= (i mod maxlength) + 1
  end;
procedure MAKENULLQ (var Q: QUEUE);
  begin
    Q.front := 1;
    Q.rear := maxlength
  end;
function EMPTY (var Q: QUEUE): boolean;
  begin
    EMPTY:= addone (Q.rear) = Q.front
  end;
procedure PUTQ (x: elementtype; var Q: QUEUE);
  begin
    if addone (addone (Q.rear)) = Q.front
      then
        Q.front:= addone (Q.front);
    Q.rear:= addone(Q.rear);
    Q.elements[Q.rear]:= x
  end;
procedure PRINTQ (var Q: QUEUE);
  var
    p: integer;
  begin
    if EMPTY(Q)
      then
        error
      else
        begin
          p:= Q.front;
          while p <> addone(Q.rear) do
            begin
              write (Q.elements[p], ' ');
              p:= addone(p)
            end
        end
  end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

procedure read_in (var f: text; var L: list);
    {read_in reads the input text file and puts the elements in list L. One
     single digit integer per line is the expected file format.}
  var
    p: position;
    v: infotype;
  begin
    p:= FIRST(L);
    while not eof(f) do
      begin
        readln (f,v);
        INSERT (v, p, L);
      end
  end;

procedure print_out (var L: list);
    {print_out prints list L, after a linefeed. The elements are expected to be
     single digit integers (a field width of 2 is used with no formatting) if
     this is not the case the output will look confused.}
  var
    p: position;
  begin
    writeln;
    p:= FIRST(L);
    while p <> ENDLIS(L) do
      begin
        write (RETRIEVE(p, L):2);
        p:= NEXT(p, L)
      end
  end;

function SAME (a,b: infotype): boolean;
    {SAME returns true if its arguments are identical, false otherwise}
  begin
    SAME:= a=b
  end;

procedure purge (var L: list; var Q1: QUEUE);
    {purge removes duplicate elements from list L}
  var
    p,q: position;  {p will be the "current" position in L, and q will move
                     ahead to find equal elements}
  begin
    p:= FIRST(L);
    while p <> ENDLIS(L) do
      begin
        PUTQ ('A',Q1);
        q:= NEXT(p, L);
        while q <> ENDLIS(L) do
          begin
            PUTQ ('B',Q1);
            if SAME (RETRIEVE(p, L), RETRIEVE(q, L))
              then
                begin
                  DELETE(q, L);
                  PUTQ ('C',Q1)
                end
              else
                q:= NEXT(q, L)
          end;
        p:= NEXT(p, L)
      end  {while}
  end;   {purge}

{     *  *  *     MAIN PROGRAM CODE STARTS HERE    *  *  *}

begin
  reset(infile1);
  MAKENULL(L);
  MAKENULLQ(Q);
  read_in (infile1, L);
  print_out (L);
  purge (L, Q);
  print_out (L);
  writeln;
  writeln;
  writeln;
  writeln ('TRACE OUTPUT BUFFER SIZE IS ',maxlength-1:2,' CHARACTERS');
  writeln;
  PRINTQ (Q);
  writeln;
  writeln;
end.