(* ----------------------------------------------------------------------------
 * $Id: SACLIST.mi,v 1.4 1992/10/16 13:47:57 kredel Exp $
 * ----------------------------------------------------------------------------
 * This file is part of MAS.
 * ----------------------------------------------------------------------------
 * Copyright (c) 1989 - 1992 Universitaet Passau
 * ----------------------------------------------------------------------------
 * $Log: SACLIST.mi,v $
 * Revision 1.4  1992/10/16  13:47:57  kredel
 * Errors found by Mocka
 *
 * Revision 1.3  1992/10/15  16:25:03  kredel
 * Changed rcsid variable
 *
 * Revision 1.2  1992/02/12  17:32:03  pesch
 * Moved CONST definition to the right place
 *
 * Revision 1.1  1992/01/22  15:10:48  kredel
 * Initial revision
 *
 * ----------------------------------------------------------------------------
 *)

IMPLEMENTATION MODULE SACLIST;

(* List Processing Implementation Module. *)



(* Import lists and Definitions *) 

FROM MASELEM IMPORT GAMMAINT, MASMAX, MASODD;


FROM MASBIOS IMPORT BKSP, CREAD, CREADB, CWRITE, BLINES,
                    DIGIT, DIBUFF, GWRITE,  
                    MASORD, SWRITE;


FROM MASSTOR IMPORT BETA, SIL, LIST, INV, LIST1,
                    ADV, FIRST, RED, COMP, SFIRST, SRED;

CONST rcsidi = "$Id: SACLIST.mi,v 1.4 1992/10/16 13:47:57 kredel Exp $";
CONST copyrighti = "Copyright (c) 1989 - 1992 Universitaet Passau";



PROCEDURE ADV2(L: LIST; VAR AL,BL,LP: LIST);
(*Advance 2.  L is a list of length two or more.  a=FIRST(L),
b=SECOND(L) and LP=RED(RED(L)).*)
BEGIN
(*1*) ADV(L,AL,LP); ADV(LP,BL,LP); RETURN;
(*4*) END ADV2;


PROCEDURE ADV3(L: LIST; VAR AL1,AL2,AL3,LP: LIST);
(*Advance 3.  L is a list of length 3 or more.  a1, a2 and a3 are
the first three elements of L.  LP is the third reductum of L.*)
BEGIN
(*1*) ADV2(L,AL1,AL2,LP); ADV(LP,AL3,LP); RETURN;
(*4*) END ADV3;


PROCEDURE ADV4(L: LIST; VAR AL1,AL2,AL3,AL4,LP: LIST);
(*Advance 4.  L is a list of length 4 or more.  a1, a2, a3, and a4
are the first 4 elements of L.  LP is the fourth reductum of L.*)
BEGIN
(*1*) ADV(L,AL1,LP); ADV(LP,AL2,LP); ADV(LP,AL3,LP); ADV(LP,AL4,LP);
      RETURN;
(*4*) END ADV4;


PROCEDURE AREAD(): LIST;
(*Atom read.  An atom A is read from the input stream.  Any preceding
blanks are skipped.*)
VAR  A, C, I, J1Y, S: LIST;
BEGIN
(*1*) (*skip blanks and read sign, if any.*) S:=1; C:=CREADB();
      IF C = MASORD("+") THEN C:=CREAD(); ELSE
         IF C = MASORD("-") THEN C:=CREAD(); S:=-1; ELSE
            IF NOT DIGIT(C) THEN 
               (*go to 3*) 
               (*3*) (*error.*) SWRITE("ERROR FOUND BY AREAD.");
                     DIBUFF;
                     RETURN(0);
               END;
            END;
         END;
(*2*) (*read digits and convert.*) A:=0; I:=BETA DIV 10;
      REPEAT IF A > I THEN
                (*error.*) SWRITE("ERROR FOUND BY AREAD.");
                DIBUFF;
                RETURN(0);
                END;
             J1Y:=10*A; A:=J1Y+C;
             IF A >= BETA THEN 
                (*error.*) SWRITE("ERROR FOUND BY AREAD.");
                DIBUFF;
                RETURN(0);
                END;
             C:=CREAD();
             UNTIL NOT DIGIT(C);
      A:=S*A; BKSP; RETURN(A);
(*6*) END AREAD;


PROCEDURE AWRITE(A: LIST);
(*Atom write.  The atom A is written in the output stream.*)
VAR  D: ARRAY[1..20] OF LIST; 
     AP, Q, J1Y: LIST;
     N: INTEGER;
BEGIN
(*5*) (*write minus sign.*)
      IF A < 0 THEN AP:=-A; SWRITE("-"); ELSE AP:=A; END;
(*2*) (*convert to decimal.*) N:=0;
      REPEAT Q:=AP DIV 10; N:=N+1; J1Y:=10*Q; D[N]:=AP-J1Y; AP:=Q;
             UNTIL AP = 0;
(*3*) (*write digits.*)
      REPEAT CWRITE(D[N]); N:=N-1;
             UNTIL N = 0;
      RETURN;
(*6*) END AWRITE;


PROCEDURE CCONC(L1,L2: LIST): LIST;
(*Constructive concatenation.  L1 and L2 are lists.  L is the
concatenation of L1 and L2.  The list L is constructed.*)
VAR  L, LP1: LIST;
BEGIN
(*1*) (*is l1 or l2 null.*) L:=L2;
      IF L1 = SIL THEN RETURN(L); END;
      L:=L1;
      IF L2 = SIL THEN RETURN(L); END;
(*2*) (*concatenate copy of l1.*) LP1:=CINV(L1); L:=INV(LP1);
      SRED(LP1,L2); RETURN(L);
(*5*) END CCONC;


PROCEDURE CINV(L: LIST): LIST;
(*Constructive inverse.  L is a list.  M=INV(L).  M is constructed
using comp.*)
VAR  AL, LP, M: LIST;
BEGIN
(*1*) M:=BETA; LP:=L;
      WHILE LP <> SIL DO ADV(LP,AL,LP); M:=COMP(AL,M); END;
      RETURN(M);
(*4*) END CINV;


PROCEDURE CLOUT(L: LIST);
(*Character list out.  The input is a character list L=(C(1),C(2),...,
C(n)).  The C(i) are sequentially transmitted to the output stream 
using CWRITE.*)
VAR  C, LP: LIST;
BEGIN
(*1*) LP:=L;
      WHILE LP <> SIL DO ADV(LP,C,LP); 
            IF C < SIL THEN CWRITE(C) END END;
      RETURN;
(*4*) END CLOUT;


PROCEDURE COMP2(AL,BL,L: LIST): LIST;
(*Composition 2.  a and b are objects.  L is a list.
M=COMP(a,COMP(b,L)).*)
VAR  J1Y, M: LIST;
BEGIN
(*1*) J1Y:=COMP(BL,L); M:=COMP(AL,J1Y); RETURN(M);
(*4*) END COMP2;


PROCEDURE COMP3(AL1,AL2,AL3,L: LIST): LIST;
(*Composition 3.  a1, a2 and a3 are objects.  L is a list.
M=COMP(a1,COMP(a2,COMP(a3,L))).*)
VAR  J1Y, M: LIST;
BEGIN
(*1*) J1Y:=COMP(AL3,L); J1Y:=COMP(AL2,J1Y); M:=COMP(AL1,J1Y); RETURN(M);
(*4*) END COMP3;


PROCEDURE COMP4(AL1,AL2,AL3,AL4,L: LIST): LIST;
(*Composition 4.  a1, a2, a3 and a4 are objects.  L is a list.
M=COMP(a1,COMP(a2,COMP(a3,COMP(a4,l)))).*)
VAR  J1Y, M: LIST;
BEGIN
(*1*) J1Y:=COMP(AL4,L); J1Y:=COMP(AL3,J1Y); J1Y:=COMP(AL2,J1Y);
      M:=COMP(AL1,J1Y); RETURN(M);
(*4*) END COMP4;


PROCEDURE CONC(L1,L2: LIST): LIST;
(*Concatenation.  L1 and L2 are lists.  L=CONC(L1,L2).  The list L1 is
modified.*)
VAR  L, LP: LIST;
BEGIN
(*1*) (*l1 null.*) L:=L2;
      IF L1 = SIL THEN RETURN(L); END;
(*2*) (*l2 null.*) L:=L1;
      IF L2 = SIL THEN RETURN(L); END;
(*3*) (*l1 and l2 non-null.*) LP:=LAST(L1); SRED(LP,L2); RETURN(L);
(*6*) END CONC;


PROCEDURE EQUAL(AL,BL: LIST): LIST;
(*Equal.  a and b are objects.  t=1 if a and b are equal and
otherwise t=0.*)
VAR  AL1, ALP, BL1, BLP, TL: LIST;
BEGIN
(*1*) (*identical atoms or list representations.*) TL:=0;
      IF AL = BL THEN TL:=1; RETURN(TL); END;
(*2*) (*al or bl is an atom.*)
      IF (AL < BETA) OR (BL < BETA) THEN RETURN(TL); END;
(*3*) (*recursion.*) ALP:=AL; BLP:=BL;
      WHILE (ALP <> SIL) AND (BLP <> SIL) DO ADV(ALP,AL1,ALP);
            ADV(BLP,BL1,BLP);
            IF EQUAL(AL1,BL1) = 0 THEN RETURN(TL); END;
            IF ALP = BLP THEN TL:=1; RETURN(TL); END;
            END;
      RETURN(TL);
(*6*) END EQUAL;


PROCEDURE EXTENT(AL: LIST): LIST;
(*Extent.  a is an object.  n=EXTENT(a).*)
VAR  AL1, ALP, J1Y, NL: LIST;
BEGIN
(*1*) (*al an atom.*) NL:=0;
      IF AL < BETA THEN RETURN(NL); END;
(*2*) (*al a list.*) ALP:=AL;
      WHILE ALP <> SIL DO ADV(ALP,AL1,ALP); J1Y:=EXTENT(AL1);
            J1Y:=NL+J1Y; NL:=J1Y+1; END;
      RETURN(NL);
(*5*) END EXTENT;


PROCEDURE FIRST2(L: LIST; VAR AL,BL: LIST);
(*First 2.  L is a list of length 2 or more.  a=FIRST(L) and
b=SECOND(L).*)
VAR  LP: LIST;
BEGIN
(*1*) ADV(L,AL,LP); BL:=FIRST(LP); RETURN;
(*4*) END FIRST2;


PROCEDURE FIRST3(L: LIST; VAR AL1,AL2,AL3: LIST);
(*First 3.  L is a list of length 3 or more.  a1=FIRST(L),
a2=SECOND(L) and a3=THIRD(L).*)
VAR  LP: LIST;
BEGIN
(*1*) ADV2(L,AL1,AL2,LP); AL3:=FIRST(LP); RETURN;
(*4*) END FIRST3;


PROCEDURE FIRST4(L: LIST; VAR AL1,AL2,AL3,AL4: LIST);
(*First 4.  L is a list of length 4 or more.  a1=FIRST(L),
a2=SECOND(L), a3=THIRD(L) and a4=FOURTH(L).*)
VAR  LP: LIST;
BEGIN
(*1*) ADV(L,AL1,LP); ADV(LP,AL2,LP); ADV(LP,AL3,LP); AL4:=FIRST(LP);
      RETURN;
(*4*) END FIRST4;


PROCEDURE FOURTH(L: LIST): LIST;
(*Fourth.  L is a list of length 4 or more.  a is the fourth element
of L.*)
VAR  AL, J1Y: LIST;
BEGIN
(*1*) J1Y:=RED3(L); AL:=FIRST(J1Y); RETURN(AL);
(*4*) END FOURTH;


PROCEDURE LAST(L: LIST): LIST;
(*Last.  L is a non-null list.  LP is the location of the last cell
of L.*)
VAR  LP, LPP: LIST;
BEGIN
(*1*) LP:=L; LPP:=RED(LP);
      WHILE LPP <> SIL DO LP:=LPP; LPP:=RED(LP); END;
      RETURN(LP);
(*4*) END LAST; 


PROCEDURE LEINST(A,IL,AL: LIST): LIST;
(*List element insertion.  A is the list (a(1), ...,a(n)) of objects.
i is a beta-integer, 0 le i le n.  a is an object.  If i=0, then
L=(a,a(1), ...,a(n)).  If i=n, then L=(a(1), ...,a(n),a).
otherwise, L=(a(1), ...,a(i),a,a(i+1), ...,a(n)).  A is modified.*)
VAR  AP, APP, JL, L: LIST;
BEGIN
(*1*) (*il=0.*)
      IF IL = 0 THEN L:=COMP(AL,A); RETURN(L); END;
(*2*) (*il gt 0.*) L:=A; AP:=A;
      FOR JL:=2 TO IL DO AP:=RED(AP); END;
      APP:=RED(AP); APP:=COMP(AL,APP); SRED(AP,APP); RETURN(L);
(*5*) END LEINST;


PROCEDURE LELT(A,IL: LIST): LIST;
(*List element.  A is a list.  1 le i le LENGTH(A).  a is the i-th
element of A.*)
VAR  AL, AP, JL: LIST;
BEGIN
(*1*) AP:=A;
      FOR JL:=1 TO IL-1 DO AP:=RED(AP); END;
      AL:=FIRST(AP); RETURN(AL);
(*4*) END LELT;


PROCEDURE LEROT(L,IL,JL: LIST): LIST;
(*List element rotation.  L is a list (a(1), ...,a(n)) of objects, n
gt 0.  i and j, 1 le i le j le n, are beta-integers.  If i=j
then M=L.  Otherwise M=(a(1), ...,a(i-1),a(j),a(i), ...,a(j-1),
a(j+1), ...,a(n)).  L is modified.*)
VAR  AL, BL, KL, LP, LPP, M: LIST;
BEGIN
(*1*) (*il=jl.*) M:=L;
      IF IL = JL THEN RETURN(M); END;
(*2*) (*il lt jl.*) LP:=L;
      FOR KL:=1 TO IL-1 DO LP:=RED(LP); END;
      ADV(LP,AL,LPP);
      FOR KL:=IL TO JL-1 DO BL:=FIRST(LPP); SFIRST(LPP,AL); AL:=BL;
          LPP:=RED(LPP); END;
      SFIRST(LP,AL); RETURN(M);
(*5*) END LEROT;


PROCEDURE LINS(AL,L: LIST);
(*List insertion.  L is a non-null list (a(1), ...,a(n)).  a is an
object.  a is inserted in L after a(1) (suffixed to L if n=1),
producing a modified list L=(a(1),a,a(2), ...,a(n)).*)
VAR  A, J1Y: LIST;
BEGIN
(*1*) J1Y:=RED(L); A:=COMP(AL,J1Y); SRED(L,A); RETURN;
(*4*) END LINS;


PROCEDURE LINSRT(AL,A: LIST): LIST;
(*List insertion.  A is a list (a(1), ...,a(n)) of beta-integers,
n ge 0, with a(1) lt a(2) lt  ...lt a(n).  If n=0 then B=(a).
If a lt a(1) then B=(a,a(1), ...,a(n)).  If a ge a(n) then
B=(a(1), ...,a(n),a).  Otherwise B=(a(1), ...,a(i),a,a(i+1),
 ...,a(n)) where a(i) le a lt a(i+1).  The list A is modified
to produce B.*)
VAR  AP, APP, AS, B: LIST;
BEGIN
(*1*) (*nl=0.*)
      IF A = SIL THEN B:=LIST1(AL); RETURN(B); END;
(*2*) (*al lt al1.*)
      IF AL < FIRST(A) THEN B:=COMP(AL,A); RETURN(B); END;
(*3*) (*general case.*) AP:=A; APP:=RED(AP);
      WHILE (APP <> SIL) AND (AL >= FIRST(APP)) DO AP:=APP;
            APP:=RED(AP); END;
      AS:=COMP(AL,APP); SRED(AP,AS); B:=A; RETURN(B);
(*6*) END LINSRT;


PROCEDURE LIST10(AL1,AL2,AL3,AL4,AL5,AL6,AL7,AL8,AL9,AL10: LIST): LIST;
(*List, 10 elements.  a1, a2, a3, a4, a5, a6, a7, a8, a9 and a10 are
objects.  L is the list (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10).*)
VAR  J1Y, L: LIST;
BEGIN
(*1*) J1Y:=COMP(AL10,BETA); J1Y:=COMP(AL9,J1Y); J1Y:=COMP(AL8,J1Y);
      J1Y:=COMP(AL7,J1Y); J1Y:=COMP(AL6,J1Y); J1Y:=COMP(AL5,J1Y);
      J1Y:=COMP(AL4,J1Y); J1Y:=COMP(AL3,J1Y); J1Y:=COMP(AL2,J1Y);
      L:=COMP(AL1,J1Y); RETURN(L);
(*4*) END LIST10;


PROCEDURE LIST2(AL,BL: LIST): LIST;
(*List, 2 elements.  a and b are objects.  L is the list (a,b).*)
VAR  J1Y, L: LIST;
BEGIN
(*1*) J1Y:=COMP(BL,BETA); L:=COMP(AL,J1Y); RETURN(L);
(*4*) END LIST2;


PROCEDURE LIST3(AL1,AL2,AL3: LIST): LIST;
(*List, 3 elements.  a1, a2 and a3 are objects.  L=(a1,a2,a3).*)
VAR  J1Y, L: LIST;
BEGIN
(*1*) J1Y:=COMP(AL3,BETA); J1Y:=COMP(AL2,J1Y); L:=COMP(AL1,J1Y);
      RETURN(L);
(*4*) END LIST3;


PROCEDURE LIST4(AL1,AL2,AL3,AL4: LIST): LIST;
(*List, 4 elements.  a1, a2, a3 and a4 are objects.  L is the list
(a1,a2,a3,a4).*)
VAR  J1Y, L: LIST;
BEGIN
(*1*) J1Y:=COMP(AL4,BETA); J1Y:=COMP(AL3,J1Y); J1Y:=COMP(AL2,J1Y);
      L:=COMP(AL1,J1Y); RETURN(L);
(*4*) END LIST4;


PROCEDURE LIST5(AL1,AL2,AL3,AL4,AL5: LIST): LIST;
(*List, 5 elements.  a1,a2,a3,a4 and a5 are objects.  L is the list
(a1,a2,a3,a4,a5).*)
VAR  J1Y, L: LIST;
BEGIN
(*1*) J1Y:=COMP(AL5,BETA); J1Y:=COMP(AL4,J1Y); J1Y:=COMP(AL3,J1Y);
      J1Y:=COMP(AL2,J1Y); L:=COMP(AL1,J1Y); RETURN(L);
(*4*) END LIST5;


PROCEDURE LREAD(): LIST;
(*List read.  The list L is read from the input stream.  Any preceding
blanks are skipped.*)
VAR  C, IDUM, L, L1: LIST;
BEGIN
(*1*) (*read list elements.*) L:=BETA; C:=CREADB();
      IF C <> MASORD("(") THEN 
         SWRITE("ERROR FOUND BY LREAD."); DIBUFF;
         RETURN(L); END;
(*2*) LOOP C:=CREADB();
           IF C = MASORD(")") THEN L:=INV(L); RETURN(L); ELSE
              IF C = MASORD("(") THEN BKSP; L1:=LREAD(); ELSE
                 IF    (C = MASORD("+")) 
                    OR (C = MASORD("-")) 
                    OR DIGIT(C) 
                    THEN BKSP; L1:=AREAD(); 
                    ELSE SWRITE("ERROR FOUND BY LREAD."); DIBUFF;
                         L:=INV(L); RETURN(L) END;
                 END;
              END;
           L:=COMP(L1,L); C:=CREADB();
           IF C = MASORD(")") THEN BKSP; ELSE
              IF C <> MASORD(",") THEN  
                 SWRITE("ERROR FOUND BY LREAD."); DIBUFF;
                 L:=INV(L); RETURN(L) END;
              END;
           END 
(*5*) END LREAD;


PROCEDURE LSRCH(AL,A: LIST): LIST;
(*List search.  A is a list of beta-integers, (a(1), ...,a(n)),
n ge 0.  If there is a j such that a=a(j) then i is the least
such j.  Otherwise i=0.*)
VAR  AL1, AP, IL: LIST;
BEGIN
(*1*) AP:=A; IL:=1;
      WHILE AP <> SIL DO ADV(AP,AL1,AP);
            IF AL = AL1 THEN RETURN(IL); END;
            IL:=IL+1; END;
      IL:=0; RETURN(IL);
(*4*) END LSRCH;


PROCEDURE LWRITE(L: LIST);
(*List write.  The input list L is written in the output stream.*)
VAR  L1, LP: LIST;
BEGIN
(*1*) (*initialize.*) SWRITE("("); LP:=L;
(*2*) (*write list elements.*)
      WHILE LP <> SIL DO ADV(LP,L1,LP);
            IF L1 < BETA THEN AWRITE(L1); ELSE LWRITE(L1); END;
            IF LP <> BETA THEN SWRITE(","); END;
            END;
(*3*) (*finish.*) SWRITE(")"); RETURN;
(*6*) END LWRITE;


PROCEDURE MEMBER(AL,L: LIST): LIST;
(*Membership test.  a is an object, L a list.  t=1 if a is a
member of L and otherwise t=0.*)
VAR  AL1, LP, TL: LIST;
BEGIN
(*1*) TL:=0; LP:=L;
      WHILE LP <> SIL DO ADV(LP,AL1,LP); TL:=EQUAL(AL,AL1);
            IF TL = 1 THEN RETURN(TL); END;
            END;
      RETURN(TL);
(*4*) END MEMBER;


PROCEDURE ORDER(AL: LIST): LIST;
(*Order.  a is an object.  n=ORDER(a).*)
VAR  AL1, ALP, J1Y, NL: LIST;
BEGIN
(*1*) (*al an atom.*) NL:=0;
      IF AL < BETA THEN RETURN(NL); END;
(*2*) (*al a list.*) ALP:=AL;
      WHILE ALP <> SIL DO ADV(ALP,AL1,ALP); J1Y:=ORDER(AL1);
            NL:=MASMAX(NL,J1Y); END;
      NL:=NL+1; RETURN(NL);
(*5*) END ORDER;


PROCEDURE OREAD(): LIST;
(*Object read.  The object B is read from the input stream.  Any
preceding blanks are skipped.*)
VAR  B, C, IDUM: LIST;
BEGIN
(*1*) (*read list or atom.*) C:=CREADB(); BKSP;
      IF C = MASORD("(") THEN B:=LREAD(); ELSE B:=AREAD(); END;
      RETURN(B);
(*4*) END OREAD;


PROCEDURE OWRITE(B: LIST);
(*Object write.  The input object B is written in the output stream.*)
BEGIN
(*1*) IF B < BETA THEN AWRITE(B); ELSE LWRITE(B); END;
      RETURN;
(*4*) END OWRITE;


PROCEDURE PAIR(A,B: LIST): LIST;
(*Pair.  A=(a(1), ...,a(m)) and B=(b(1), ...,b(n)) are lists with
m and n non-negative.  C is the list (a(1),b(1), ...,a(r),b(r))
where r=MIN(m,n).*)
VAR  AL, AP, BL, BP, C: LIST;
BEGIN
(*1*) AP:=A; BP:=B; C:=BETA;
      WHILE (AP <> SIL) AND (BP <> SIL) DO ADV(AP,AL,AP);
            ADV(BP,BL,BP); C:=COMP2(BL,AL,C); END;
      C:=INV(C); RETURN(C);
(*4*) END PAIR;


PROCEDURE REDUCT(A,IL: LIST): LIST;
(*Reductum.  A is a list.  i is a non-negative beta-integer not less
than LENGTH(A).  B=A, if i=0.  Otherwise, B is the i-th reductum of
A.*)
VAR  B, JL: LIST;
BEGIN
(*1*) B:=A;
      FOR JL:=1 TO IL DO B:=RED(B); END;
      RETURN(B);
(*4*) END REDUCT;


PROCEDURE RED2(L: LIST): LIST;
(*Reductum 2.  L is a list of length 2 or more.  LP=RED(RED(L)).*)
VAR  J1Y, LP: LIST;
BEGIN
(*1*) J1Y:=RED(L); LP:=RED(J1Y); RETURN(LP);
(*4*) END RED2;


PROCEDURE RED3(L: LIST): LIST;
(*Reductum 3.  L is a list of length 3 or more.  M is the third
reductum of L.*)
VAR  J1Y, M: LIST;
BEGIN
(*1*) J1Y:=RED2(L); M:=RED(J1Y); RETURN(M);
(*4*) END RED3;


PROCEDURE RED4(L: LIST): LIST;
(*Reductum 4.  L is a list of length 4 or more.  M is the fourth
reductum of L.*)
VAR  J1Y, M: LIST;
BEGIN
(*1*) J1Y:=RED(L); J1Y:=RED(J1Y); J1Y:=RED(J1Y); M:=RED(J1Y); RETURN(M);
(*4*) END RED4;


PROCEDURE SECOND(L: LIST): LIST;
(*Second.  L is a list of length 2 or more.  a is the second element
of L.*)
VAR  AL, J1Y: LIST;
BEGIN
(*1*) J1Y:=RED(L); AL:=FIRST(J1Y); RETURN(AL);
(*4*) END SECOND;


PROCEDURE SLELT(A,IL,AL: LIST);
(*Set list element.  A is a list.  1 le i le LENGTH(A).  The i-th
element of A is changed to a.*)
VAR  AP, JL: LIST;
BEGIN
(*1*) AP:=A;
      FOR JL:=1 TO IL-1 DO AP:=RED(AP); END;
      SFIRST(AP,AL); RETURN;
(*4*) END SLELT;


PROCEDURE SUFFIX(L,BL: LIST): LIST;
(*Suffix.  L is a list (a(1), ..., a(n)), n non-negative.  b is an
object.  LP=(a(1), ..., a(n),b).  L is modified.*)
VAR  J1Y, LP: LIST;
BEGIN
(*1*) J1Y:=LIST1(BL); LP:=CONC(L,J1Y); RETURN(LP);
(*4*) END SUFFIX;


PROCEDURE THIRD(L: LIST): LIST;
(*Third.  L is a list of length 3 or more.  a is the third element
of L.*)
VAR  AL, J1Y: LIST;
BEGIN
(*1*) J1Y:=RED2(L); AL:=FIRST(J1Y); RETURN(AL);
(*4*) END THIRD;


END SACLIST.


(* -EOF- *)