gpcp/VarSets.cp

   1 (* ==================================================================== *)
   2 (*                                                                      *)
   3 (*  VarSet Module for the Gardens Point Component Pascal Compiler.      *)
   4 (*  Implements operations on variable length bitsets.                   *)
   5 (*      Copyright (c) John Gough 1999, 2000.                            *)
   6 (*                                                                      *)
   7 (* ==================================================================== *)
   8
   9 MODULE VarSets;
  10
  11   IMPORT
  12         GPCPcopyright,
  13         Console;
  14
  15 (* ============================================================ *)
  16
  17   CONST bits = 32;
  18         iMax = bits-1;
  19
  20 (* ============================================================ *)
  21
  22   TYPE
  23     VarSet* = POINTER TO RECORD
  24                 vars : POINTER TO ARRAY OF SET;
  25                 size : INTEGER;
  26               END;
  27
  28 (* ============================================================ *)
  29 (* =======  Implementation of VarSet abstract data type ======= *)
  30 (* ============================================================ *)
  31
  32   PROCEDURE newSet*(size : INTEGER) : VarSet;
  33     VAR tmp : VarSet;
  34         len : INTEGER;
  35   BEGIN
  36     NEW(tmp);
  37     tmp.size := size;
  38     IF size = 0 THEN len := 1 ELSE len := (size + iMax) DIV bits END;
  39     NEW(tmp.vars, len);
  40     RETURN tmp;
  41   END newSet;
  42
  43 (* ======================================= *)
  44
  45   PROCEDURE newUniv*(size : INTEGER) : VarSet;
  46     VAR tmp : VarSet;
  47         rem : INTEGER;
  48         idx : INTEGER;
  49   BEGIN
  50     idx := 0;
  51     rem := size;
  52     tmp := newSet(size);
  53     WHILE rem > 32 DO
  54       tmp.vars[idx] := {0 .. iMax};
  55       INC(idx); DEC(rem,bits);
  56     END;
  57     tmp.vars[idx] := {0 .. (rem-1)};
  58     RETURN tmp;
  59   END newUniv;
  60
  61 (* ======================================= *)
  62
  63   PROCEDURE newEmpty*(size : INTEGER) : VarSet;
  64     VAR tmp : VarSet;
  65         idx : INTEGER;
  66   BEGIN
  67     tmp := newSet(size);
  68     FOR idx := 0 TO LEN(tmp.vars^)-1 DO tmp.vars[idx] := {} END;
  69     RETURN tmp;
  70   END newEmpty;
  71
  72 (* ======================================= *)
  73
  74   PROCEDURE (self : VarSet)newCopy*() : VarSet,NEW;
  75     VAR tmp : VarSet;
  76         idx : INTEGER;
  77   BEGIN
  78     tmp := newSet(self.size);
  79     FOR idx := 0 TO LEN(tmp.vars)-1 DO tmp.vars[idx] := self.vars[idx] END;
  80     RETURN tmp;
  81   END newCopy;
  82
  83 (* ======================================= *)
  84
  85   PROCEDURE (self : VarSet)cardinality*() : INTEGER,NEW;
  86   BEGIN RETURN self.size END cardinality;
  87
  88 (* ============================================================ *)
  89
  90   PROCEDURE (self : VarSet)includes*(elem : INTEGER) : BOOLEAN, NEW;
  91   BEGIN
  92     RETURN (elem < self.size) &
  93                 ((elem MOD bits) IN self.vars[elem DIV bits]);
  94   END includes;
  95
  96 (* ============================================================ *)
  97
  98   PROCEDURE (self : VarSet)Incl*(elem : INTEGER),NEW;
  99   BEGIN
 100     INCL(self.vars[elem DIV bits], elem MOD bits);
 101   END Incl;
 102
 103 (* ======================================= *)
 104
 105   PROCEDURE (self : VarSet)InclSet*(add : VarSet),NEW;
 106     VAR i : INTEGER;
 107   BEGIN
 108     ASSERT(self.size = add.size);
 109     FOR i := 0 TO LEN(self.vars)-1 DO
 110       self.vars[i] := self.vars[i] + add.vars[i];
 111     END;
 112   END InclSet;
 113
 114 (* ============================================================ *)
 115
 116   PROCEDURE (self : VarSet)Excl*(elem : INTEGER),NEW;
 117   BEGIN
 118     EXCL(self.vars[elem DIV bits], elem MOD bits);
 119   END Excl;
 120
 121 (* ======================================= *)
 122
 123   PROCEDURE (self : VarSet)ExclSet*(sub : VarSet),NEW;
 124     VAR i : INTEGER;
 125   BEGIN
 126     ASSERT(self.size = sub.size);
 127     FOR i := 0 TO LEN(self.vars)-1 DO
 128       self.vars[i] := self.vars[i] - sub.vars[i];
 129     END;
 130   END ExclSet;
 131
 132 (* ============================================================ *)
 133
 134   PROCEDURE (self : VarSet)isUniv*() : BOOLEAN, NEW;
 135     VAR i,r : INTEGER; s : SET;
 136   BEGIN
 137     i := 0; r := self.size;
 138     WHILE r > bits DO
 139       IF self.vars[i] # {0 .. iMax} THEN RETURN FALSE END;
 140       INC(i); DEC(r,bits);
 141     END;
 142     RETURN self.vars[i] = {0 .. (r-1)};
 143   END isUniv;
 144
 145 (* ============================================================ *)
 146
 147   PROCEDURE (self : VarSet)isEmpty*() : BOOLEAN, NEW;
 148     VAR i : INTEGER;
 149   BEGIN
 150     IF self.size <= 32 THEN RETURN self.vars[0] = {} END;
 151     FOR i := 0 TO LEN(self.vars)-1 DO
 152       IF self.vars[i] # {} THEN RETURN FALSE END;
 153     END;
 154     RETURN TRUE;
 155   END isEmpty;
 156
 157 (* ============================================================ *)
 158
 159   PROCEDURE (self : VarSet)not*() : VarSet, NEW;
 160     VAR tmp : VarSet;
 161         rem : INTEGER;
 162         idx : INTEGER;
 163   BEGIN
 164     idx := 0;
 165     rem := self.size;
 166     tmp := newSet(rem);
 167     WHILE rem > 32 DO
 168       tmp.vars[idx] := {0 .. iMax} - self.vars[idx];
 169       INC(idx); DEC(rem,bits);
 170     END;
 171     tmp.vars[idx] := {0 .. (rem-1)} - self.vars[idx];
 172     RETURN tmp;
 173   END not;
 174
 175 (* ======================================= *)
 176
 177   PROCEDURE (self : VarSet)Neg*(),NEW;
 178     VAR rem : INTEGER;
 179         idx : INTEGER;
 180   BEGIN
 181     idx := 0;
 182     rem := self.size;
 183     WHILE rem > 32 DO
 184       self.vars[idx] := {0 .. iMax} - self.vars[idx];
 185       INC(idx); DEC(rem,bits);
 186     END;
 187     self.vars[idx] := {0 .. (rem-1)} - self.vars[idx];
 188   END Neg;
 189
 190 (* ============================================================ *)
 191
 192   PROCEDURE (self : VarSet)cup*(rhs : VarSet) : VarSet,NEW;
 193     VAR tmp : VarSet;
 194     VAR i   : INTEGER;
 195   BEGIN
 196     ASSERT(self.size = rhs.size);
 197     tmp := newSet(self.size);
 198     FOR i := 0 TO LEN(self.vars)-1 DO
 199       tmp.vars[i] := self.vars[i] + rhs.vars[i];
 200     END;
 201     RETURN tmp;
 202   END cup;
 203
 204 (* ======================================= *)
 205
 206   PROCEDURE (self : VarSet)Union*(rhs : VarSet),NEW;
 207   BEGIN
 208     self.InclSet(rhs);
 209   END Union;
 210
 211 (* ============================================================ *)
 212
 213   PROCEDURE (self : VarSet)cap*(rhs : VarSet) : VarSet,NEW;
 214     VAR tmp : VarSet;
 215     VAR i   : INTEGER;
 216   BEGIN
 217     ASSERT(self.size = rhs.size);
 218     tmp := newSet(self.size);
 219     FOR i := 0 TO LEN(self.vars)-1 DO
 220       tmp.vars[i] := self.vars[i] * rhs.vars[i];
 221     END;
 222     RETURN tmp;
 223   END cap;
 224
 225 (* ======================================= *)
 226
 227   PROCEDURE (self : VarSet)Intersect*(rhs : VarSet),NEW;
 228     VAR i   : INTEGER;
 229   BEGIN
 230     ASSERT(self.size = rhs.size);
 231     FOR i := 0 TO LEN(self.vars)-1 DO
 232       self.vars[i] := self.vars[i] * rhs.vars[i];
 233     END;
 234   END Intersect;
 235
 236 (* ============================================================ *)
 237
 238   PROCEDURE (self : VarSet)xor*(rhs : VarSet) : VarSet,NEW;
 239     VAR tmp : VarSet;
 240         i   : INTEGER;
 241   BEGIN
 242     ASSERT(self.size = rhs.size);
 243     tmp := newSet(self.size);
 244     FOR i := 0 TO LEN(self.vars)-1 DO
 245       tmp.vars[i] := self.vars[i] / rhs.vars[i];
 246     END;
 247     RETURN tmp;
 248   END xor;
 249
 250 (* ======================================= *)
 251
 252   PROCEDURE (self : VarSet)SymDiff*(rhs : VarSet),NEW;
 253     VAR i   : INTEGER;
 254   BEGIN
 255     ASSERT(self.size = rhs.size);
 256     FOR i := 0 TO LEN(self.vars)-1 DO
 257       self.vars[i] := self.vars[i] / rhs.vars[i];
 258     END;
 259   END SymDiff;
 260
 261 (* ============================================================ *)
 262
 263   PROCEDURE (self : VarSet)Diagnose*(),NEW;
 264     VAR i,j : INTEGER;
 265         lim : INTEGER;
 266         chr : CHAR;
 267   BEGIN
 268     j := 0;
 269     lim := self.size-1;
 270     Console.Write('{');
 271     FOR i := 0 TO self.size-1 DO
 272       chr := CHR(i MOD 10 + ORD('0'));
 273       IF self.includes(i) THEN
 274         Console.Write(chr);
 275       ELSE
 276         Console.Write('.');
 277       END;
 278       IF (chr = '9') & (i < lim) THEN
 279         IF j < 6 THEN INC(j) ELSE Console.WriteLn; j := 0 END;
 280         Console.Write('|');
 281       END;
 282     END;
 283     Console.Write('}');
 284   END Diagnose;
 285
 286 (* ============================================================ *)
 287 END VarSets.  (* ============================================== *)
 288 (* ============================================================ *)
 289