program polynom (infile1, infile2, output);
  {polynom adds two polynomials and prints the result, the input polynomials
   reside in two text files, each line in a text file contains a singe term
   (the coefficient, followed by a space, then the exponent). The polynomials
   can be any length.}
   
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

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

NOTES:-    1. NO ERROR CHECKING is performed in this implementation.
              The caller has responsibility for ensuring that the
              position to be RETRIEVE'd or DELETED actually exists.

           2. The position operated on by RETRIEVE, INSERT and DELETE
              is the position FOLLOWING the one pointed to by the
              position pointer (ENDLIS returns a pointer to the last
              element, and FIRST to the header cell (NOT the first element)).}


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

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

var
  infile1, infile2: text;
  L1, L2, L3: list;

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

function FIRST (L: list): position;
  begin
    FIRST:= L
  end;
function ENDLIS (L: list): position;
  var
    p: position;
  begin
    p:= L;
    while p^.next <> nil do
      p:= p^.next;
    ENDLIS:= p
  end;
function NEXT (p: position; L:list): position;
  begin
    NEXT:= p^.next
  end;
function RETRIEVEC (p: position; L: list): infotype;
  begin
    RETRIEVEC:= p^.next^.coef
  end;
function RETRIEVEE (p: position; L: list): infotype;
  begin
    RETRIEVEE:= p^.next^.expnt
  end;
procedure DELETE (var p: position; var L: list);
  begin
    p^.next:= p^.next^.next
  end;
procedure MAKENULL (var L: list);
  begin
    new(L);
    L^.next:=nil;
  end;
procedure INSERTP (p: position; c, e: infotype; var L: list);
  var
    q: position;
  begin
    q:= p^.next;
    new(p^.next);
    p^.next^.coef:=c;
    p^.next^.expnt:=e;
    p^.next^.next:=q
  end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
    {This is a bubble sort on a linked list with header cell.
     It is a descending sequence sort}

procedure sortrtn (top:list);
  var
    t,p,q,e: position;                {t,p,q are consecutive nodes and
                                      they move together from t=top to p=e
                                      during each pass through the list.
                                      e moves from the base-1 to the top
                                      with a decrement of 1 for each pass
                                      through the list.}
    sorted,sw1,sw2,sw3 :boolean;     {sw3 signifies the end of pass and
                                      sorted signifies the end of sort
                                      sw1 & sw2 are used to retain the position
                                      of e relative to t,p & q when swapping}
  begin
    if ((top^.next=nil) or (top^.next^.next=nil))
      then
        writeln ('EMPTY FILE OR SINGLE ELEMENT CANNOT SORT')
      else
        begin
{ this code sets e to base-1}
          e:=top;
          while e^.next^.next<>nil do
            e:=e^.next;
{ - - - - - - - - - - - - - }
{       START OF SORT       }
          repeat
            t:=top;
            p:=t^.next;
            q:=p^.next;
            sorted:=true;
            sw3:=false;
            while ((not sw3) and (e<>top)) do
              begin
                if p^.expnt < q^.expnt
                  then
{                       SWAP ENTRIES P & Q                        }
                    begin
                      if e=p then sw1:=true;
                      if e=q then sw2:=true;
                      p^.next:=q^.next;
                      q^.next:=p;
                      t^.next:=q;
                      p:=q;
                      q:=q^.next;
                      if sw1=true
                        then
                          begin
                            e:=p;
                            sw1:=false
                           end;
                      if sw2=true
                        then
                          begin
                            e:=q;
                            sw2:=false
                          end;
                      sorted:=false
                    end;
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
                if e=p
                  then
                    begin
                      e:=t;         {decrement e}
                      sw3:=true     {end of pass}
                    end;
                t:=t^.next;
                p:=p^.next;
                q:=q^.next
              end                         {end of pass (while loop)}
          until (sorted=true)             {end of sort (repeat loop)}
        end                               {else more than 1 entry}
  end;                                    {sortrtn}

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;
    c, e: infotype;
  begin
    p:= FIRST(L);
    while not eof(f) do
      begin
        readln (f,c,e);
        INSERTP (p, c, e, L);
        p:= NEXT(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;
    c, e:infotype;
  begin
    writeln;
    writeln;
    p:= FIRST(L);
    while p <> ENDLIS(L) do
      begin
        c:= RETRIEVEC (p, L);
        e:= RETRIEVEE (p, L);
        write (c:1,'x',e:1);
        p:= NEXT(p, L);
        if p <> ENDLIS(L) then
          write (' + ')
      end
  end;

procedure POLYADD (L1, L2: list; var L3: list);
  var
    c1, c2, c3, e1, e2, e3: infotype;
    p1, p2, p3: position;
  procedure addthels;        {ADDS THE COEFFICIENTS AND STORES AN ENTRY IN L3}
    begin
      c3:= c1 + c2;
      e3:= e1;
      INSERTP (p3, c3, e3, L3);
      p3:= NEXT(p3, L3);
      p1:= NEXT(p1, L1);
      p2:= NEXT(p2, L2)
    end;
  procedure copyla;          {COPIES AN ENTRY FROM L1 TO L3}
    begin
      c3:= c1;
      e3:=e1;
      INSERTP (p3, c3, e3, L3);
      p3:= NEXT(p3, L3);
      p1:= NEXT(p1, L1)
    end;
  procedure copylb;          {COPIES AN ENTRY FROM L2 TO L3}
    begin
      c3:= c2;
      e3:=e2;
      INSERTP (p3, c3, e3, L3);
      p3:= NEXT(p3, L3);
      p2:= NEXT(p2, L2)
    end;
{     *  *  *     POLYADD CODE STARTS HERE    *  *  *}
  begin
    MAKENULL (L3);
    p1:= FIRST(L1);
    p2:= FIRST(L2);
    p3:= FIRST(L3);
    while ((p1<>ENDLIS(L1)) or (p2<>ENDLIS(L2))) do
      if p2<>ENDLIS(L2)
        then
          begin
            c2:= RETRIEVEC (p2, L2);
            e2:= RETRIEVEE (p2, L2);
            if p1<>ENDLIS(L1)
              then
                begin
                  c1:= RETRIEVEC (p1, L1);
                  e1:= RETRIEVEE (p1, L1);
                  if e1=e2
                    then
                      addthels  {ADD COEFFICIENTS IF EXPONENTS EQUAL}
                    else
                      if e1>e2  {COPY ENTRY WITH LARGEST EXPONENT TO L3}
                        then
                          copyla
                        else
                          copylb
                end
              else  {L1 EXHAUSTED COPY L2 TO L3}
                copylb
          end
        else {L2 EXHAUSTED COPY L1 TO L3}
          copyla
  end;

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

begin
  reset(infile1);
  reset(infile2);
  MAKENULL(L1);
  MAKENULL(L2);
  read_in (infile1, L1);
  sortrtn (L1);
  print_out (L1);
  read_in (infile2,L2);
  sortrtn (L2);
  print_out (L2);
  POLYADD (L1, L2, L3);
  print_out (L3)
end.
