Listing: 1 IMPLEMENTATION MODULE BigSets; 2 (* 3 * REPERTOIRE 4 * Release 1.6 5 * By Charles Bradford and Cole Brecheen 6 * (c) Copyright 1985-1992 PMI 7 * Green Bay, Wisconsin 8 * All rights reserved 9 * (414) 468-6040 10 * 11 * $Header: D:/logfiles/mods/bigsets.mov 1.3 10 Mar 1991 15:25:08 coleb $ 12 * 13 * 14 * Written and contributed by Wilbur C. Andrews. 15 * 16 *) 17 18 19 IMPORT ErrorManager; 20 IMPORT M2Strings; 21 IMPORT StrEdit; 22 23 24 VAR 25 Initialized : BOOLEAN; 26 27 PROCEDURE Init(); 28 BEGIN 29 IF Initialized THEN 30 RETURN; 31 ELSE 32 Initialized := TRUE; 33 END; 34 ErrorManager.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 35 M2Strings.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 36 StrEdit.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 37 38 InitSet(DigitSet); ***** ^ undeclared identifier ***** ^ undeclared identifier 39 InitSet(ChSet); ***** ^ undeclared identifier ***** ^ undeclared identifier 40 AppendSet(DigitSet, "{'0'..'9'}"); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 41 AppendSet(ChSet, "{' '..'~'}"); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 42 END Init; ***** ^ not supported yet 43 44 45 CONST 46 begin = 1; 47 Dot = 2; 48 Quote = 3; 49 statement = 4; 50 incomplete = 5; 51 end = 7; 52 StartSym = '{'; 53 EndSym = '}'; 54 55 56 57 PROCEDURE SetStuff(n : CARDINAL; VAR ArrayNo, Index : CARDINAL); 58 BEGIN 59 IF n=0 THEN 60 ArrayNo := 0; 61 Index := 0; 62 ELSE 63 ArrayNo := n DIV BitSetSize; ***** ^ undeclared identifier 64 Index := n MOD BitSetSize; ***** ^ undeclared identifier 65 END; 66 END SetStuff; ***** ^ not supported yet 67 68 PROCEDURE InitSet(VAR BSet : ARRAY OF BITSET); ***** ^ undeclared identifier 69 VAR 70 n : CARDINAL; 71 BEGIN 72 FOR n := 0 TO HIGH(BSet) DO ***** ^ undeclared identifier ***** ^ not supported yet 73 BSet[n] := {}; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 74 END; 75 END InitSet; ***** ^ not supported yet 76 77 PROCEDURE AssignSet(Set1 : ARRAY OF BITSET; VAR Set2 : ARRAY OF ***** ^ undeclared identifier 78 BITSET); ***** ^ undeclared identifier 79 VAR 80 a : CARDINAL; 81 BEGIN 82 FOR a := 0 TO HIGH(Set1) DO ***** ^ undeclared identifier ***** ^ not supported yet 83 Set2[a] := Set1[a]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 84 END; 85 END AssignSet; ***** ^ not supported yet 86 87 PROCEDURE Check( ArrayNumber, LastBitSet: CARDINAL ); 88 BEGIN 89 IF ArrayNumber > LastBitSet THEN 90 ErrorManager.WARN( "Set element out of range"); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 91 END; 92 END Check; ***** ^ not supported yet 93 94 PROCEDURE InclSet(VAR BSet : ARRAY OF BITSET; n : CARDINAL); ***** ^ undeclared identifier 95 VAR 96 ArrayNo, Index : CARDINAL; 97 BEGIN 98 SetStuff(n, ArrayNo, Index); ***** ^ not supported yet ***** ^ not supported yet 99 Check( ArrayNo, HIGH(BSet) ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 100 INCL(BSet[ArrayNo], Index); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 101 END InclSet; ***** ^ not supported yet 102 103 PROCEDURE ExclSet(VAR BSet : ARRAY OF BITSET; n : CARDINAL); ***** ^ undeclared identifier 104 VAR 105 ArrayNo, Index : CARDINAL; 106 BEGIN 107 SetStuff(n, ArrayNo, Index); ***** ^ not supported yet ***** ^ not supported yet 108 Check( ArrayNo, HIGH(BSet) ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 109 EXCL(BSet[ArrayNo], Index); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 110 END ExclSet; ***** ^ not supported yet 111 112 PROCEDURE InSet(VAR BSet : ARRAY OF BITSET; n : CARDINAL) : BOOLEAN; ***** ^ undeclared identifier 113 VAR 114 ArrayNo, Index : CARDINAL; 115 bool : BOOLEAN; 116 BEGIN 117 SetStuff(n, ArrayNo, Index); ***** ^ not supported yet ***** ^ not supported yet 118 Check( ArrayNo, HIGH(BSet) ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 119 bool := Index IN BSet[ArrayNo]; ***** ^ not supported yet ***** ^ not supported yet 120 RETURN bool; 121 END InSet; ***** ^ not supported yet 122 123 PROCEDURE EqualSet(VAR SetOne, SetTwo : ARRAY OF BITSET) : BOOLEAN; ***** ^ undeclared identifier 124 VAR 125 EqualBool : BOOLEAN; 126 a : CARDINAL; 127 BEGIN 128 a := 0; 129 EqualBool := TRUE; 130 WHILE (a<=HIGH(SetOne)) AND EqualBool DO ***** ^ undeclared identifier ***** ^ not supported yet 131 EqualBool := SetOne[a]=SetTwo[a]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 132 a := a+1; 133 END; 134 RETURN EqualBool; 135 END EqualSet; ***** ^ not supported yet 136 137 138 PROCEDURE AppendSet(VAR BSet : ARRAY OF BITSET; st : ARRAY OF CHAR); ***** ^ undeclared identifier ***** ^ not supported yet 139 140 TYPE 141 SetStType = ARRAY [0..79] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 142 StRecord = 143 RECORD 144 Item : SetStType; 145 type : (card, octal, char); 146 END; ***** ^ not supported yet 147 148 VAR 149 ch : CHAR; 150 Error, count : CARDINAL; 151 CodeSt : SetStType; ***** ^ not supported yet 152 StartSt, EndSt : StRecord; ***** ^ not supported yet 153 EndBool : BOOLEAN; 154 message: ARRAY [0..79] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 155 dumstr: ARRAY [0..0] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 156 157 PROCEDURE GetCh(); 158 BEGIN 159 IF count<=(M2Strings.Length(CodeSt)-1) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 160 ch := CodeSt[count]; ***** ^ not supported yet ***** ^ not supported yet 161 INC(count); ***** ^ undeclared identifier ***** ^ not supported yet 162 ELSE 163 ch := 0C; 164 END; 165 END GetCh; ***** ^ not supported yet 166 167 PROCEDURE GetSym(); 168 BEGIN 169 GetCh(); ***** ^ not supported yet ***** ^ not supported yet 170 WHILE ch=' ' DO 171 GetCh(); ***** ^ not supported yet ***** ^ not supported yet 172 END; 173 END GetSym; ***** ^ not supported yet 174 175 PROCEDURE StToNum(st : ARRAY OF CHAR; base : CARDINAL) : CARDINAL; ***** ^ not supported yet 176 VAR 177 a, c : CARDINAL; 178 BEGIN 179 c := 0; 180 FOR a := 0 TO M2Strings.Length(st)-1 DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ FOR needs integer variable and bounds 181 c := c*base+(ORD(st[a])-ORD('0')); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 182 END; 183 RETURN c; 184 END StToNum; ***** ^ not supported yet 185 186 PROCEDURE AddToSet(VAR BSet : ARRAY OF BITSET); ***** ^ undeclared identifier 187 VAR 188 StartNum, EndNum : CARDINAL; 189 190 PROCEDURE SetNum(st : StRecord) : CARDINAL; 191 BEGIN 192 CASE st.type OF ***** ^ not supported yet ***** ^ not supported yet 193 card : ***** ^ not supported yet 194 RETURN StToNum(st.Item,10); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 195 | octal : ***** ^ not supported yet 196 RETURN StToNum(st.Item,8); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 197 | char : ***** ^ not supported yet 198 RETURN ORD(st.Item[0]); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 199 END; 200 RETURN 0; 201 END SetNum; ***** ^ not supported yet 202 203 BEGIN 204 (* AddToSet *) 205 IF M2Strings.Length(EndSt.Item)>0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 206 IF M2Strings.Length(StartSt.Item)=0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 207 InclSet(BSet, SetNum(EndSt)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 208 ELSE 209 StartNum := SetNum(StartSt); ***** ^ not supported yet ***** ^ not supported yet 210 EndNum := SetNum(EndSt); ***** ^ not supported yet ***** ^ not supported yet 211 WHILE StartNum<=EndNum DO 212 InclSet(BSet, StartNum); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 213 INC(StartNum); ***** ^ undeclared identifier ***** ^ not supported yet 214 END; 215 END; 216 END; 217 StartSt.Item := 0C; ***** ^ not supported yet ***** ^ not supported yet 218 EndSt.Item := 0C; ***** ^ not supported yet ***** ^ not supported yet 219 END AddToSet; ***** ^ not supported yet 220 221 PROCEDURE AddToNumSt(ch : CHAR; VAR st : ARRAY OF CHAR); ***** ^ not supported yet 222 BEGIN 223 StrEdit.Append(st, ch); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 224 END AddToNumSt; ***** ^ not supported yet 225 226 PROCEDURE DecodeDot(); 227 BEGIN 228 IF ch='.' THEN 229 StartSt := EndSt; ***** ^ not supported yet ***** ^ not supported yet 230 EndSt.Item := 0C; ***** ^ not supported yet ***** ^ not supported yet 231 ELSE 232 Error := Dot; 233 EndBool := TRUE; 234 END; 235 END DecodeDot; ***** ^ not supported yet 236 237 PROCEDURE DecodeNum(); 238 BEGIN 239 EndSt.type := card; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 240 AddToNumSt(ch, EndSt.Item); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 241 GetCh(); ***** ^ not supported yet ***** ^ not supported yet 242 WHILE (ch>='0') AND (ch<='9') DO 243 AddToNumSt(ch, EndSt.Item); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 244 GetCh(); ***** ^ not supported yet ***** ^ not supported yet 245 END; 246 IF CAP(ch)='C' THEN ***** ^ undeclared identifier ***** ^ not supported yet 247 EndSt.type := octal; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 248 GetCh(); ***** ^ not supported yet ***** ^ not supported yet 249 END; 250 END DecodeNum; ***** ^ not supported yet 251 252 PROCEDURE DecodeQuote(QuoteCh : CHAR); 253 BEGIN 254 EndSt.Item[0] := ch; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 255 EndSt.Item[1] := 0C; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 256 EndSt.type := char; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 257 GetCh(); ***** ^ not supported yet ***** ^ not supported yet 258 IF ch#QuoteCh THEN 259 Error := Quote; 260 EndBool := TRUE; 261 END; 262 END DecodeQuote; ***** ^ not supported yet 263 264 PROCEDURE Statement(); 265 BEGIN 266 (* Statement *) 267 StartSt.Item := 0C; ***** ^ not supported yet ***** ^ not supported yet 268 EndSt.Item := 0C; ***** ^ not supported yet ***** ^ not supported yet 269 WHILE (NOT EndBool) DO 270 IF ch="'" THEN 271 (* Character *) 272 GetCh(); ***** ^ not supported yet ***** ^ not supported yet 273 DecodeQuote("'"); ***** ^ not supported yet ***** ^ not supported yet 274 GetSym(); ***** ^ not supported yet ***** ^ not supported yet 275 ELSIF ch='"' THEN 276 (* Character *) 277 GetCh(); ***** ^ not supported yet ***** ^ not supported yet 278 DecodeQuote('"'); ***** ^ not supported yet ***** ^ not supported yet 279 GetSym(); ***** ^ not supported yet ***** ^ not supported yet 280 ELSIF (ch>='0') AND (ch<='9') THEN 281 (* CARDINAL OR OCTAL Number *) 282 DecodeNum(); ***** ^ not supported yet ***** ^ not supported yet 283 IF ch=' ' THEN 284 GetSym(); ***** ^ not supported yet ***** ^ not supported yet 285 END; 286 ELSE 287 Error := statement; 288 EndBool := TRUE; 289 END; 290 IF ch=0C THEN 291 Error := incomplete; 292 (* End of string reached *) 293 EndBool := TRUE; 294 ELSIF ch=',' THEN 295 AddToSet(BSet); ***** ^ not supported yet ***** ^ not supported yet 296 GetSym(); ***** ^ not supported yet ***** ^ not supported yet 297 ELSIF ch='.' THEN 298 GetCh(); ***** ^ not supported yet ***** ^ not supported yet 299 DecodeDot(); ***** ^ not supported yet ***** ^ not supported yet 300 GetSym(); ***** ^ not supported yet ***** ^ not supported yet 301 ELSIF ch=EndSym THEN 302 EndBool := TRUE; 303 ELSE 304 Error := statement; 305 EndBool := TRUE; 306 END; 307 END; 308 (* WHILE NOT EndBool *) 309 END Statement; ***** ^ not supported yet 310 311 BEGIN 312 (* AppendSet *) 313 StrEdit.AssignStr( st, CodeSt ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 314 EndBool := FALSE; 315 Error := 0; 316 count := 0; 317 ch := ' '; 318 GetSym(); ***** ^ not supported yet ***** ^ not supported yet 319 IF ch=StartSym THEN 320 GetSym(); ***** ^ not supported yet ***** ^ not supported yet 321 IF ch#EndSym THEN 322 Statement(); ***** ^ not supported yet ***** ^ not supported yet 323 END; 324 ELSE 325 Error := begin; 326 EndBool := TRUE; 327 END; 328 IF (ch=EndSym) AND (Error=0) THEN 329 AddToSet(BSet); ***** ^ not supported yet ***** ^ not supported yet 330 ELSIF Error=0 THEN 331 Error := end; 332 END; 333 IF Error # 0 THEN 334 StrEdit.AssignStr( 'Programmer error #', message ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 335 dumstr[0] := CHR(Error); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 336 StrEdit.Append( message, dumstr ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 337 StrEdit.Append( message, 'in AppendSet.' ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 338 ErrorManager.WARN( message ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 339 END; 340 END AppendSet; ***** ^ not supported yet 341 342 PROCEDURE InclCh(VAR ChSet : ARRAY OF BITSET; ch : CHAR); ***** ^ undeclared identifier 343 VAR 344 n : CARDINAL; 345 BEGIN 346 n := ORD(ch); ***** ^ undeclared identifier ***** ^ not supported yet 347 InclSet(ChSet, n); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 348 END InclCh; ***** ^ not supported yet 349 350 PROCEDURE ExclCh(VAR ChSet : ARRAY OF BITSET; ch : CHAR); ***** ^ undeclared identifier 351 VAR 352 n : CARDINAL; 353 BEGIN 354 n := ORD(ch); ***** ^ undeclared identifier ***** ^ not supported yet 355 ExclSet(ChSet, n); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 356 END ExclCh; ***** ^ not supported yet 357 358 PROCEDURE InChSet(VAR ChSet : ARRAY OF BITSET; ch : CHAR) : BOOLEAN; ***** ^ undeclared identifier 359 VAR 360 n : CARDINAL; 361 bool : BOOLEAN; 362 BEGIN 363 n := ORD(ch); ***** ^ undeclared identifier ***** ^ not supported yet 364 bool := InSet(ChSet,n); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 365 RETURN bool; 366 END InChSet; ***** ^ not supported yet 367 368 PROCEDURE InTest(SetSt : ARRAY OF CHAR; TestCh : CHAR) : BOOLEAN; ***** ^ not supported yet 369 VAR 370 TestSet : ChSetArray; ***** ^ undeclared identifier 371 BEGIN 372 InitSet(TestSet); ***** ^ not supported yet ***** ^ not supported yet 373 AppendSet(TestSet, SetSt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 374 RETURN InChSet(TestSet,TestCh); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 375 END InTest; ***** ^ not supported yet 376 377 378 (* The procedures below assume that SetOne, SetTwo, 379 and result are all of equal size. The compiler's 380 range checking option ought to catch violations of 381 that assumption, but particular implementations may 382 not. The routines could be rewritten to deal with 383 sets of unequal size, but that would take a lot more 384 code and would probably be much slower. *) 385 386 PROCEDURE SetUnion( SetOne, SetTwo: ARRAY OF BITSET; ***** ^ undeclared identifier 387 VAR result: ARRAY OF BITSET ); ***** ^ undeclared identifier 388 VAR 389 cnt, last: CARDINAL; 390 BEGIN 391 InitSet( result ); ***** ^ not supported yet ***** ^ not supported yet 392 last := HIGH( SetOne ); ***** ^ undeclared identifier ***** ^ not supported yet 393 FOR cnt := 0 TO last DO 394 result[cnt] := SetOne[cnt] + SetTwo[cnt]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 395 END; 396 END SetUnion; ***** ^ not supported yet 397 398 PROCEDURE SetDifference( SetOne, SetTwo: ARRAY OF 399 BITSET; VAR result: ARRAY OF BITSET ); ***** ^ undeclared identifier ***** ^ undeclared identifier 400 VAR 401 cnt, last: CARDINAL; 402 BEGIN 403 InitSet( result ); ***** ^ not supported yet ***** ^ not supported yet 404 last := HIGH( SetOne ); ***** ^ undeclared identifier ***** ^ not supported yet 405 FOR cnt := 0 TO last DO 406 result[cnt] := SetOne[cnt] - SetTwo[cnt]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 407 END; 408 END SetDifference; ***** ^ not supported yet 409 410 PROCEDURE SetIntersection( SetOne, SetTwo: ARRAY OF 411 BITSET; VAR result: ARRAY OF BITSET ); ***** ^ undeclared identifier ***** ^ undeclared identifier 412 VAR 413 cnt, last: CARDINAL; 414 BEGIN 415 InitSet( result ); ***** ^ not supported yet ***** ^ not supported yet 416 last := HIGH( SetOne ); ***** ^ undeclared identifier ***** ^ not supported yet 417 FOR cnt := 0 TO last DO 418 result[cnt] := SetOne[cnt] * SetTwo[cnt]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 419 END; 420 END SetIntersection; ***** ^ not supported yet 421 422 PROCEDURE SetSymmetricDiff( SetOne, SetTwo: ARRAY OF 423 BITSET; VAR result: ARRAY OF BITSET ); ***** ^ undeclared identifier ***** ^ undeclared identifier 424 VAR 425 cnt, last: CARDINAL; 426 BEGIN 427 InitSet( result ); ***** ^ not supported yet ***** ^ not supported yet 428 last := HIGH( SetOne ); ***** ^ undeclared identifier ***** ^ not supported yet 429 FOR cnt := 0 TO last DO 430 result[cnt] := SetOne[cnt] / SetTwo[cnt]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 431 END; 432 END SetSymmetricDiff; ***** ^ not supported yet 433 434 BEGIN 435 Initialized := FALSE; 436 Init(); ***** ^ not supported yet ***** ^ not supported yet 437 END BigSets. ***** ^ not supported yet 356 errors