Thue.Mod
· 2.8 KiB · Text
Raw
Playground
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].n] := B[k+L[i].n] END
ELSE
FOR k := S+j TO S+NS-L[i].n-1 DO B[k+R[i].n] := B[k+L[i].n] 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
kingdom, no knight.::=A kingdom was lost, all for the want of a nail.
no horse::=no knight
no shoe::=no horse
no nail::=no shoe
::=
kingdom, no nail.
To run: Thue.Go
| 1 | MODULE Thue; |
| 2 | IMPORT Texts, Oberon; |
| 3 | |
| 4 | CONST MaxB = 10000; |
| 5 | MaxRules = 1000; |
| 6 | |
| 7 | VAR W: Texts.Writer; |
| 8 | B: ARRAY MaxB OF CHAR; |
| 9 | S, NS, NR: INTEGER; |
| 10 | L, R: ARRAY MaxRules OF RECORD s, n: INTEGER END; |
| 11 | |
| 12 | PROCEDURE Write(s, n: INTEGER); |
| 13 | VAR i: INTEGER; |
| 14 | BEGIN |
| 15 | FOR i := s TO s+n-1 DO Texts.Write(W, B[i]) END; |
| 16 | Texts.Append(Oberon.Log, W.buf) |
| 17 | END Write; |
| 18 | |
| 19 | PROCEDURE Find(s: ARRAY OF CHAR; start, n: INTEGER; VAR pos: INTEGER): BOOLEAN; |
| 20 | VAR i, j: INTEGER; |
| 21 | f: BOOLEAN; |
| 22 | BEGIN |
| 23 | IF NS < n THEN f := FALSE |
| 24 | ELSE |
| 25 | i := 0; |
| 26 | WHILE i <= NS-n DO |
| 27 | f := TRUE; j := 0; |
| 28 | WHILE j < n DO |
| 29 | IF B[S+i+j] # s[start+j] THEN f := FALSE; j := n ELSE INC(j) END |
| 30 | END; |
| 31 | IF f THEN pos := i; i := NS ELSE INC(i) END |
| 32 | END |
| 33 | END; |
| 34 | RETURN f |
| 35 | END Find; |
| 36 | |
| 37 | PROCEDURE Reset; |
| 38 | BEGIN |
| 39 | NR := 0; S := 0; NS := 0 |
| 40 | END Reset; |
| 41 | |
| 42 | PROCEDURE Read*; |
| 43 | VAR Rr: Texts.Reader; |
| 44 | i, sep: INTEGER; |
| 45 | f: BOOLEAN; |
| 46 | |
| 47 | PROCEDURE ReadLine(VAR R: Texts.Reader); |
| 48 | VAR i: INTEGER; |
| 49 | ch: CHAR; |
| 50 | BEGIN |
| 51 | i := 0; Texts.Read(R, ch); |
| 52 | WHILE (S+i < MaxB) & ~R.eot & (ch # 0DX) DO |
| 53 | B[S+i] := ch; INC(i); Texts.Read(R, ch) |
| 54 | END; |
| 55 | NS := i; |
| 56 | IF S+i = MaxB THEN Texts.WriteString(W, "Out of space"); Texts.WriteLn(W) END |
| 57 | END ReadLine; |
| 58 | |
| 59 | BEGIN |
| 60 | Reset; |
| 61 | Texts.OpenReader(Rr, Oberon.Par.text, Oberon.Par.pos); |
| 62 | f := FALSE; |
| 63 | REPEAT ReadLine(Rr); |
| 64 | IF Find("::=", 0, 3, sep) THEN |
| 65 | IF NS = 3 THEN ReadLine(Rr); Rr.eot := TRUE |
| 66 | ELSIF NR < MaxRules THEN |
| 67 | L[NR].s := S; L[NR].n := sep; |
| 68 | R[NR].s := S + sep + 3; R[NR].n := NS - sep - 3; |
| 69 | INC(NR); INC(S, NS) |
| 70 | ELSE Texts.WriteString(W, "Too many rules"); Texts.WriteLn(W); f := TRUE END |
| 71 | ELSE |
| 72 | i := 0; |
| 73 | WHILE i < NS DO |
| 74 | IF B[S+i] # " " THEN f := TRUE; i := NS ELSE INC(i) END |
| 75 | END; |
| 76 | IF f THEN Texts.WriteString(W, "Invalid rule"); Texts.WriteLn(W) END |
| 77 | END |
| 78 | UNTIL Rr.eot OR f; |
| 79 | IF f THEN Reset ELSE Write(S, NS); Texts.WriteLn(W) END; |
| 80 | Texts.Append(Oberon.Log, W.buf) |
| 81 | END Read; |
| 82 | |
| 83 | PROCEDURE Go*; |
| 84 | VAR i, j, k: INTEGER; |
| 85 | BEGIN |
| 86 | i := 0; |
| 87 | WHILE i < NR DO |
| 88 | IF Find(B, L[i].s, L[i].n, j) THEN |
| 89 | IF NS - L[i].n + R[i].n <= MaxB THEN |
| 90 | IF L[i].n < R[i].n THEN |
| 91 | FOR k := S+NS-L[i].n-1 TO S+j BY -1 DO B[k+R[i].n] := B[k+L[i].n] END |
| 92 | ELSE |
| 93 | FOR k := S+j TO S+NS-L[i].n-1 DO B[k+R[i].n] := B[k+L[i].n] END |
| 94 | END; |
| 95 | FOR k := 0 TO R[i].n-1 DO B[S+j+k] := B[R[i].s+k] END; |
| 96 | NS := NS - L[i].n + R[i].n; |
| 97 | Write(S, NS); Texts.WriteLn(W); |
| 98 | i := 0 |
| 99 | ELSE Texts.WriteString(W, "Out of space"); Texts.WriteLn(W); i := NR END |
| 100 | ELSE INC(i) END |
| 101 | END; |
| 102 | Texts.Append(Oberon.Log, W.buf) |
| 103 | END Go; |
| 104 | |
| 105 | BEGIN Texts.OpenWriter(W); |
| 106 | END Thue. |
| 107 | |
| 108 | ~~~ |
| 109 | |
| 110 | To compile: System.Free Thue~ ORP.Compile Thue.Mod/s~ |
| 111 | |
| 112 | To load a program: Thue.Read |
| 113 | kingdom, no knight.::=A kingdom was lost, all for the want of a nail. |
| 114 | no horse::=no knight |
| 115 | no shoe::=no horse |
| 116 | no nail::=no shoe |
| 117 | ::= |
| 118 | kingdom, no nail. |
| 119 | |
| 120 | To run: Thue.Go |