Sets.Mod from v4 system added (GPL)

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