Sets.Mod from v4 system added (GPL)

Former-commit-id: b600d11d01
This commit is contained in:
Norayr Chilingarian 2014-01-24 18:22:02 +04:00
parent bc8c90fb84
commit 6961b9628e
2 changed files with 156 additions and 15 deletions

137
src/lib/v4/Sets.Mod Normal file
View file

@ -0,0 +1,137 @@
MODULE Sets;
IMPORT Texts;
CONST size* = 32;
PROCEDURE Clear*(VAR s: ARRAY OF SET);
VAR i: INTEGER;
BEGIN
i := 0; WHILE i < LEN(s) DO s[i] := {}; INC(i) END
END Clear;
PROCEDURE Fill*(VAR s: ARRAY OF SET);
VAR i: INTEGER;
BEGIN
i := 0; WHILE i < LEN(s) DO s[i] := {0 .. size-1}; INC(i) END
END Fill;
PROCEDURE Incl*(VAR s: ARRAY OF SET; x: INTEGER);
BEGIN INCL(s[x DIV size], x MOD size)
END Incl;
PROCEDURE Excl*(VAR s: ARRAY OF SET; x: INTEGER);
BEGIN EXCL(s[x DIV size], x MOD size)
END Excl;
PROCEDURE In*(VAR s: ARRAY OF SET; x: INTEGER): BOOLEAN;
BEGIN RETURN x MOD size IN s[x DIV size]
END In;
PROCEDURE Includes*(VAR s1, s2: ARRAY OF SET): BOOLEAN;
VAR i: INTEGER;
BEGIN
i := 0;
WHILE i < LEN(s1) DO
IF s1[i] + s2[i] # s1[i] THEN RETURN FALSE END ;
INC(i)
END ;
RETURN TRUE;
END Includes;
PROCEDURE Elements*(VAR s: ARRAY OF SET; VAR lastElem: INTEGER): INTEGER;
VAR i, n, max: INTEGER;
BEGIN
i := 0; n := 0; max := SHORT(LEN(s)) * size;
WHILE i < max DO
IF (i MOD size) IN s[i DIV size] THEN INC(n); lastElem := i END ;
INC(i)
END ;
RETURN n
END Elements;
PROCEDURE Empty*(VAR s: ARRAY OF SET): BOOLEAN;
VAR i: INTEGER;
BEGIN
i := 0;
WHILE i < LEN(s) DO
IF s[i] # {} THEN RETURN FALSE END ;
INC(i)
END ;
RETURN TRUE
END Empty;
PROCEDURE Equal*(VAR s1, s2: ARRAY OF SET): BOOLEAN;
VAR i: INTEGER;
BEGIN
i := 0;
WHILE i < LEN(s1) DO
IF s1[i] # s2[i] THEN RETURN FALSE END ;
INC(i)
END ;
RETURN TRUE
END Equal;
PROCEDURE Different*(VAR s1, s2: ARRAY OF SET): BOOLEAN;
VAR i: INTEGER;
BEGIN
i := 0;
WHILE i < LEN(s1) DO
IF s1[i] * s2[i] # {} THEN RETURN FALSE END ;
INC(i)
END ;
RETURN TRUE
END Different;
PROCEDURE Unite*(VAR s1, s2: ARRAY OF SET);
VAR i: INTEGER; s: SET;
BEGIN
i := 0; WHILE i < LEN(s1) DO s := s1[i] + s2[i]; s1[i] := s; INC(i) END
END Unite;
PROCEDURE Differ*(VAR s1, s2: ARRAY OF SET);
VAR i: INTEGER; s: SET;
BEGIN
i := 0; WHILE i < LEN(s1) DO s := s1[i] - s2[i]; s1[i] := s; INC(i) END
END Differ;
PROCEDURE Intersect*(VAR s1, s2, s3: ARRAY OF SET);
VAR i: INTEGER; s: SET;
BEGIN
i := 0; WHILE i < LEN(s1) DO s := s1[i] * s2[i]; s3[i] := s; INC(i) END
END Intersect;
PROCEDURE Print*(VAR f: Texts.Writer; s: ARRAY OF SET; w, indent: INTEGER);
VAR col, i, max: INTEGER;
BEGIN
i := 0; col := indent; max := SHORT(LEN(s)) * size;
Texts.Write(f, "{");
WHILE i < max DO
IF In(s, i) THEN
IF col + 4 > w THEN
Texts.WriteLn(f);
col := 0; WHILE col < indent DO Texts.Write(f, " "); INC(col) END
END ;
Texts.WriteInt(f, i, 3); Texts.Write(f, ",");
INC(col, 4)
END ;
INC(i)
END ;
Texts.Write(f, "}")
END Print;

View file

@ -1,6 +1,6 @@
MODULE CRT; (* Cocol-R Tables *)
IMPORT Texts := CmdlnTexts,(* Oberon, Sets;
IMPORT Texts := CmdlnTexts, Out := Console, (*Oberon,*) Sets;
CONST
maxSymbols* = 300; (*max nr of t, nt, and pragmas*)
@ -109,11 +109,14 @@ PROCEDURE ^MovePragmas;
PROCEDURE ^DelNode*(gn: GraphNode): BOOLEAN;
PROCEDURE Str(s: ARRAY OF CHAR);
BEGIN Texts.WriteString(w, s)
BEGIN
(*Texts.WriteString(w, s)*)
Out.String(s)
END Str;
PROCEDURE NL;
BEGIN Texts.WriteLn(w)
BEGIN
Out.Ln(*Texts.WriteLn(w)*)
END NL;
PROCEDURE Length(s: ARRAY OF CHAR): INTEGER;
@ -125,7 +128,8 @@ END Length;
PROCEDURE Restriction(n: INTEGER);
BEGIN
NL; Str("Restriction "); Texts.WriteInt(w, n, 0); NL; Texts.Append(Oberon.Log, w.buf);
NL; Str("Restriction ");
Out.Int(n, 0); NL; (*Texts.Append(Oberon.Log, w.buf);*)
HALT(99)
END Restriction;
@ -216,7 +220,7 @@ BEGIN
INC(i)
END;
IF empty THEN Str("-- empty set --") END;
NL; Texts.Append(Oberon.Log, w.buf)
NL; (*Texts.Append(Oberon.Log, w.buf)*)
END PrintSet;
PROCEDURE CompFirstSet*(gp: INTEGER; VAR fs: Set);
@ -432,7 +436,7 @@ BEGIN
IF sn.deletable THEN Str(" "); Str(sn.name); Str(" deletable"); NL END;
INC(i);
END;
Texts.Append(Oberon.Log, w.buf)
(*Texts.Append(Oberon.Log, w.buf)*)
END CompDeletableSymbols;
@ -462,7 +466,7 @@ BEGIN
Str(" set["); Texts.WriteInt (w, i, 2); Str("] = "); PrintSet(set[i], 16);
INC (i)
END;
NL; NL; Texts.Append(Oberon.Log, w.buf)
NL; NL; (*Texts.Append(Oberon.Log, w.buf)*)
END;
END CompSymbolSets;
@ -519,7 +523,7 @@ BEGIN (* PrintSymbolTable *)
Texts.WriteInt(w, st[i].line, 6); NL;
IF i = maxT THEN i := firstNt ELSE INC(i) END
END;
NL; NL; Texts.Append(Oberon.Log, w.buf)
NL; NL; (*Texts.Append(Oberon.Log, w.buf)*)
END PrintSymbolTable;
PROCEDURE NewClass*(name: Name; set: Set): INTEGER;
@ -620,7 +624,7 @@ BEGIN (* XRef *)
IF i = maxT THEN NL; Str("Pragmas:"); NL END;
IF i = maxP THEN NL; Str("Nonterminals:"); NL; i := firstNt ELSE INC(i) END
END;
NL; NL; Texts.Append(Oberon.Log, w.buf)
NL; NL; (*Texts.Append(Oberon.Log, w.buf)*)
END XRef;
@ -741,7 +745,7 @@ BEGIN (* PrintGraph *)
NL;
INC(i);
END;
NL; NL; Texts.Append(Oberon.Log, w.buf)
NL; NL; (*Texts.Append(Oberon.Log, w.buf)*)
END PrintGraph;
PROCEDURE FindCircularProductions* (VAR ok: BOOLEAN);
@ -818,7 +822,7 @@ BEGIN (* FindCircularProductions *)
END;
INC(i)
END;
Texts.Append(Oberon.Log, w.buf)
(*Texts.Append(Oberon.Log, w.buf)*)
END FindCircularProductions;
@ -836,7 +840,7 @@ PROCEDURE LL1Test* (VAR ll1: BOOLEAN);
| 2: Str(" start & successor of deletable structure")
| 3: Str(" an ANY node that matchs no symbol")
END;
NL; Texts.Append(Oberon.Log, w.buf)
NL; (*Texts.Append(Oberon.Log, w.buf)*)
END LL1Error;
PROCEDURE Check (cond: INTEGER; VAR s1, s2: Set);
@ -891,7 +895,7 @@ BEGIN
WHILE sp <= lastNt DO (*for all nonterminals*)
GetSym (sp, sn);
IF sn.struct = 0 THEN
ok := FALSE; NL; Str(" No production for "); Str(sn.name); Texts.Append(Oberon.Log, w.buf)
ok := FALSE; NL; Str(" No production for "); Str(sn.name); (*Texts.Append(Oberon.Log, w.buf)*)
END;
INC(sp)
END
@ -931,7 +935,7 @@ BEGIN (* TestIfAllNtReached *)
END;
INC(sp)
END;
Texts.Append(Oberon.Log, w.buf)
(*Texts.Append(Oberon.Log, w.buf)*)
END TestIfAllNtReached;
@ -972,7 +976,7 @@ BEGIN (* TestIfNtToTerm *)
END;
INC(sp)
END;
Texts.Append(Oberon.Log, w.buf)
(*Texts.Append(Oberon.Log, w.buf)*)
END TestIfNtToTerm;
PROCEDURE Init*;