MODULE Thue; IMPORT Texts, Oberon; CONST MaxB = 10000; MaxRules = 1000; VAR W: Texts.Writer; B: ARRAY MaxB OF CHAR; S, NS, NR: INTEGER; L, R: ARRAY MaxRules OF RECORD s, n: INTEGER END; PROCEDURE Write(s, n: INTEGER); VAR i: INTEGER; BEGIN FOR i := s TO s+n-1 DO Texts.Write(W, B[i]) END; Texts.Append(Oberon.Log, W.buf) END Write; PROCEDURE Find(s: ARRAY OF CHAR; start, n: INTEGER; VAR pos: INTEGER): BOOLEAN; VAR i, j: INTEGER; f: BOOLEAN; BEGIN IF NS < n THEN f := FALSE ELSE i := 0; WHILE i <= NS-n DO f := TRUE; j := 0; WHILE j < n DO IF B[S+i+j] # s[start+j] THEN f := FALSE; j := n ELSE INC(j) END END; IF f THEN pos := i; i := NS ELSE INC(i) END END END; RETURN f END Find; PROCEDURE Reset; BEGIN NR := 0; S := 0; NS := 0 END Reset; PROCEDURE Read*; VAR Rr: Texts.Reader; i, sep: INTEGER; f: BOOLEAN; PROCEDURE ReadLine(VAR R: Texts.Reader); VAR i: INTEGER; ch: CHAR; BEGIN i := 0; Texts.Read(R, ch); WHILE (S+i < MaxB) & ~R.eot & (ch # 0DX) DO B[S+i] := ch; INC(i); Texts.Read(R, ch) END; NS := i; IF S+i = MaxB THEN Texts.WriteString(W, "Out of space"); Texts.WriteLn(W) END END ReadLine; BEGIN Reset; Texts.OpenReader(Rr, Oberon.Par.text, Oberon.Par.pos); f := FALSE; REPEAT ReadLine(Rr); IF Find("::=", 0, 3, sep) THEN IF NS = 3 THEN ReadLine(Rr); Rr.eot := TRUE ELSIF NR < MaxRules THEN L[NR].s := S; L[NR].n := sep; R[NR].s := S + sep + 3; R[NR].n := NS - sep - 3; INC(NR); INC(S, NS) ELSE Texts.WriteString(W, "Too many rules"); Texts.WriteLn(W); f := TRUE END ELSE i := 0; WHILE i < NS DO IF B[S+i] # " " THEN f := TRUE; i := NS ELSE INC(i) END END; IF f THEN Texts.WriteString(W, "Invalid rule"); Texts.WriteLn(W) END END UNTIL Rr.eot OR f; IF f THEN Reset ELSE Write(S, NS); Texts.WriteLn(W) END; Texts.Append(Oberon.Log, W.buf) END Read; PROCEDURE Go*; VAR i, j, k: INTEGER; BEGIN i := 0; WHILE i < NR DO IF Find(B, L[i].s, L[i].n, j) THEN IF NS - L[i].n + R[i].n <= MaxB THEN IF L[i].n < R[i].n THEN FOR k := S+NS-L[i].n-1 TO S+j BY -1 DO B[k+R[i].s] := B[k+L[i].s] END ELSE FOR k := S+j TO S+NS-L[i].n-1 DO B[k+R[i].s] := B[k+L[i].s] END END; FOR k := 0 TO R[i].n-1 DO B[S+j+k] := B[R[i].s+k] END; NS := NS - L[i].n + R[i].n; Write(S, NS); Texts.WriteLn(W); i := 0 ELSE Texts.WriteString(W, "Out of space"); Texts.WriteLn(W); i := NR END ELSE INC(i) END END; Texts.Append(Oberon.Log, W.buf) END Go; BEGIN Texts.OpenWriter(W); END Thue. ~~~ To compile: System.Free Thue~ ORP.Compile Thue.Mod/s~ To load a program: Thue.Read a::=bb bbb::=c ::= acaabcaabbba To run: Thue.Go