(* ----------------------------------------------------------------------------
 * $Id: SACSET.mi,v 1.3 1992/10/15 16:28:22 kredel Exp $
 * ----------------------------------------------------------------------------
 * This file is part of MAS.
 * ----------------------------------------------------------------------------
 * Copyright (c) 1989 - 1992 Universitaet Passau
 * ----------------------------------------------------------------------------
 * $Log: SACSET.mi,v $
 * Revision 1.3  1992/10/15  16:28:22  kredel
 * Changed rcsid variable
 *
 * Revision 1.2  1992/02/12  13:19:20  pesch
 * Moved CONST Definition to the right place.
 *
 * Revision 1.1  1992/01/22  15:08:48  kredel
 * Initial revision
 *
 * ----------------------------------------------------------------------------
 *)

IMPLEMENTATION MODULE SACSET;

(* SAC Set Implementation Module. *)



(* Import lists and declarations. *)

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

FROM SACLIST IMPORT CONC, ADV2, COMP2, 
                    EQUAL, MEMBER;

CONST rcsidi = "$Id: SACSET.mi,v 1.3 1992/10/15 16:28:22 kredel Exp $";
CONST copyrighti = "Copyright (c) 1989 - 1992 Universitaet Passau";


  
PROCEDURE LBIBMS(L: LIST): LIST;
(*List of beta-integers bubble-merge sort.  L is an arbitrary list of
beta-integers, possibly with repetitions.  M is the result of sorting
L into non-decreasing order.  A combination of bubble-sort and merge-
sort is used.  The list L is modified to produce M.*)
VAR  B, BP, C, IL, J1Y, JL, KL, L1, L2, LP, LPP, LPPP, M, ML, NL, QL,
     QLP, RL, TL: LIST;
BEGIN
(*1*) (*short list.*) TL:=10; NL:=LENGTH(L);
      IF NL < TL THEN LBIBS(L); M:=L; RETURN(M); END;
(*2*) (*prepare for merge.*) KL:=0; ML:=1; QL:=NL;
      REPEAT KL:=KL+1; ML:=ML+ML; QL:=QL DIV 2;
             UNTIL QL < TL;
      J1Y:=ML*QL; RL:=NL-J1Y; B:=BETA; LP:=L;
      FOR IL:=1 TO ML DO
          IF IL <= RL THEN QLP:=QL; ELSE QLP:=QL-1; END;
          LPP:=LP;
          FOR JL:=1 TO QLP DO LPP:=RED(LPP); END;
          LPPP:=RED(LPP); SRED(LPP,SIL); LBIBS(LP); B:=COMP(LP,B);
          LP:=LPPP; END;
(*3*) (*merge.*)
      FOR IL:=1 TO KL DO C:=BETA; BP:=B;
          REPEAT ADV2(BP,L1,L2,BP); L1:=LBIM(L1,L2); C:=COMP(L1,C);
                 UNTIL BP = SIL;
          B:=C; END;
      M:=FIRST(B); RETURN(M);
(*6*) END LBIBMS;


PROCEDURE LBIBS(L: LIST);
(*List of beta-integers bubble sort.  L is an arbitrary list of
beta-integers, with possible repetitions.  L is sorted into
non-decreasing order by the bubble-sort method.  The list L, though not
its location, is modified.*)
VAR  ALP, ALPP, LP, LPP, M, MP: LIST;
BEGIN
(*1*) (*trivial case.*)
      IF L = SIL THEN RETURN; END;
(*2*) (*general case.*) M:=BETA;
      REPEAT LP:=L; LPP:=RED(LP); ALP:=FIRST(LP); MP:=BETA;
             WHILE LPP <> M DO ALPP:=FIRST(LPP);
                   IF ALP > ALPP THEN SFIRST(LP,ALPP);
                      SFIRST(LPP,ALP); MP:=LPP; ELSE ALP:=ALPP; END;
                   LP:=LPP; LPP:=RED(LP); END;
             M:=MP;
             UNTIL M = SIL;
      RETURN;
(*5*) END LBIBS;


PROCEDURE LBIM(L1,L2: LIST): LIST;
(*List of beta-integers merge.  L1 and L2 are arbitrary lists of
beta-integers in non-decreasing order.  L is the merge of L1 and L2.
L1 and L2 are modified to produce L.*)
(*goto-free version of LBIM from ,ALDES implementation guide,
by R. Loos. *) 
VAR  AL1, AL2, L, LP, LS, LP1, LP2, LPP1, LPP2: LIST;
BEGIN
(*1*) (*initialize. *) LP1:=L1; LP2:=L2; L:=SIL; LS:=SIL;
(*2*) (*merge l1 and l2. *) 
      WHILE (LP1 <> SIL) AND (LP2 <> SIL) DO 
            ADV(LP1,AL1,LPP1); ADV(LP2,AL2,LPP2);
            IF AL1 < AL2 THEN LP:=LP1; LP1:=LPP1;
                         ELSE LP:=LP2; LP2:=LPP2; END;
            IF LS = SIL THEN LS:=LP; L:=LP;
                        ELSE SRED(LS,LP); LS:=LP; END;
            END;
(*3*) (*finish. *) IF LP2 <> SIL THEN LP1:=LP2; END;
      IF LS = SIL THEN L:=LP;
                  ELSE SRED(LS,LP1); END;
      RETURN(L);
(*4*) END LBIM;                                                 


PROCEDURE SCOMP(AL,L: LIST): LIST;
(*Set composition. a is a beta-integer, L is a set of beta-integers.
LP is the union of SET(a) and L. *)
VAR LP, LS, LPP, BL: LIST;
BEGIN 
(*1*) (* initialize. *) LS:=L; LP:=SIL;
(*2*) (* search for insertion place. *)
      WHILE LS <> SIL DO 
            ADV(LS,BL,LS);
            IF AL = BL THEN LP:=L; RETURN(LP); END;
            IF AL > BL THEN LP:=COMP(BL,LP);
                       ELSE LPP:=COMP2(BL,AL,LP); LP:=INV(LP);
                            SRED(LPP,LS); RETURN(LP); END; 
            END;
(*3*) (*finish. *) LP:=COMP(AL,LP); LP:=INV(LP); RETURN(LP);
      END SCOMP;            


PROCEDURE SDIFF(A,B: LIST): LIST;
(*Set difference.  A and B are sets of beta-integers.  C=A-B.*)
VAR  AL, AP, BL, BP, C, CP: LIST;
BEGIN
(*1*) CP:=BETA; AP:=A; BP:=B;
      WHILE (AP <> SIL) AND (BP <> SIL) DO AL:=FIRST(AP);
            BL:=FIRST(BP);
            IF AL = BL THEN AP:=RED(AP); BP:=RED(BP); ELSE
               IF AL < BL THEN CP:=COMP(AL,CP); AP:=RED(AP); ELSE
                  BP:=RED(BP); END;
               END;
            END;
      IF CP = SIL THEN C:=AP; ELSE C:=INV(CP); SRED(CP,AP); END;
      RETURN(C);
(*4*) END SDIFF;


PROCEDURE SINTER(A,B: LIST): LIST;
(*Set intersection.  A and B are sets of beta-integers.  C is the
intersection of A and B.*)
VAR  AL, AP, BL, BP, C, CP: LIST;
BEGIN
(*1*) CP:=BETA; AP:=A; BP:=B;
      WHILE (AP <> SIL) AND (BP <> SIL) DO AL:=FIRST(AP);
            BL:=FIRST(BP);
            IF AL = BL THEN CP:=COMP(AL,CP); AP:=RED(AP);
               BP:=RED(BP); ELSE
               IF AL < BL THEN AP:=RED(AP); ELSE BP:=RED(BP); END;
               END;
            END;
      C:=INV(CP); RETURN(C);
(*4*) END SINTER;


PROCEDURE SUNION(A,B: LIST): LIST;
(*Set union.  A and B are sets of beta-integers.  C is the union of
A and B.*)
VAR  AL, AP, BL, BP, C, CP: LIST;
BEGIN
(*1*) CP:=BETA; AP:=A; BP:=B;
      WHILE (AP <> SIL) AND (BP <> SIL) DO AL:=FIRST(AP);
            BL:=FIRST(BP);
            IF AL = BL THEN CP:=COMP(AL,CP); AP:=RED(AP);
               BP:=RED(BP); ELSE
               IF AL < BL THEN CP:=COMP(AL,CP); AP:=RED(AP); ELSE
                  CP:=COMP(BL,CP); BP:=RED(BP); END;
               END;
            END;
      IF AP = SIL THEN AP:=BP; END;
      IF CP = SIL THEN C:=AP; ELSE C:=INV(CP); SRED(CP,AP); END;
      RETURN(C);
(*4*) END SUNION;


PROCEDURE USCOMP(AL,L: LIST): LIST;
(*Unordered set composition. a is an object, L is an unordered set.
LP is the union of SET(a) and L. *)
VAR LP: LIST;
BEGIN
(*1*) IF MEMBER(AL,L) = 1 THEN LP:=L; ELSE LP:=COMP(AL,L); END;
(*2*) RETURN(LP);
      END USCOMP;


PROCEDURE USDIFF(A,B: LIST): LIST;
(*Unordered set difference.  A and B are unordered sets.  C is the
difference A-B.*)
VAR  AL, AP, C: LIST;
BEGIN
(*1*) AP:=A; C:=BETA;
      WHILE AP <> SIL DO ADV(AP,AL,AP);
            IF MEMBER(AL,B) = 0 THEN C:=COMP(AL,C); END;
            END;
      RETURN(C);
(*4*) END USDIFF;


PROCEDURE USINT(A,B: LIST): LIST;
(*Unordered set intersection.  A and B are unordered sets.  C is the
intersection of A and B.*)
VAR  AL, AP, C: LIST;
BEGIN
(*1*) AP:=A; C:=BETA;
      WHILE AP <> SIL DO ADV(AP,AL,AP);
            IF MEMBER(AL,B) = 1 THEN C:=COMP(AL,C); END;
            END;
      RETURN(C);
(*4*) END USINT;


PROCEDURE USUN(A,B: LIST): LIST;
(*Unordered set union.  A and B are unordered sets.  C is the union
of A and B.*)
VAR  C, J1Y: LIST;
BEGIN
(*1*) J1Y:=USDIFF(A,B); C:=CONC(J1Y,B); RETURN(C);
(*4*) END USUN;


END SACSET.



(* -EOF- *)