1 MODULE CRX
; (* H.Moessenboeck 17.11.93 *)
3 IMPORT Oberon
, Texts
, Sets
, CRS
, CRT
, SYSTEM
;
7 maxTerm
= 3; (* sets of size < maxTerm are enumerated *)
9 tErr
= 0; altErr
= 1; syncErr
= 2;
13 maxSS
: INTEGER; (* number of symbol sets *)
14 errorNr
: INTEGER; (* highest parser error number *)
15 curSy
: INTEGER; (* symbol whose production is currently generated *)
20 scanner
: ARRAY 32 OF CHAR;
21 symSet
: ARRAY symSetSize
OF CRT
.Set
;
24 PROCEDURE Restriction(n
: INTEGER);
26 Texts
.WriteLn(w
); Texts
.WriteString(w
, "Restriction ");
27 Texts
.WriteInt(w
, n
, 0); Texts
.WriteLn(w
); Texts
.Append(Oberon
.Log
, w
.buf
);
31 PROCEDURE PutS(s
: ARRAY OF CHAR);
34 WHILE (i
< LEN(s
)) & (s
[i
] # 0X
) DO
35 IF s
[i
] = "$" THEN Texts
.WriteLn(syn
) ELSE Texts
.Write(syn
, s
[i
]) END;
40 PROCEDURE PutI(i
: INTEGER);
41 BEGIN Texts
.WriteInt(syn
, i
, 0)
44 PROCEDURE Indent(n
: INTEGER);
46 BEGIN i
:= 0; WHILE i
< n
DO Texts
.Write(syn
, " "); INC(i
) END
49 PROCEDURE PutSet(s
: SET);
50 VAR i
: INTEGER; first
: BOOLEAN;
52 i
:= 0; first
:= TRUE
;
53 WHILE i
< Sets
.size
DO
55 IF first
THEN first
:= FALSE
ELSE Texts
.Write(syn
, ",") END;
62 PROCEDURE PutSet1(s
: CRT
.Set
);
63 VAR i
: INTEGER; first
: BOOLEAN;
65 i
:= 0; first
:= TRUE
;
66 WHILE i
<= CRT
.maxT
DO
68 IF first
THEN first
:= FALSE
ELSE Texts
.Write(syn
, ",") END;
75 PROCEDURE Length
*(s
: ARRAY OF CHAR): INTEGER;
78 i
:=0; WHILE (i
< LEN(s
)) & (s
[i
] # 0X
) DO INC(i
) END;
82 PROCEDURE Alternatives(gp
: INTEGER): INTEGER;
83 VAR gn
: CRT
.GraphNode
; n
: INTEGER;
87 CRT
.GetNode(gp
, gn
); gp
:= gn
.p2
; INC(n
)
92 PROCEDURE CopyFramePart (stopStr
: ARRAY OF CHAR); (*Copy from file <fram> to file <syn> until <stopStr>*)
93 VAR ch
, startCh
: CHAR; i
, j
, high
: INTEGER;
95 startCh
:= stopStr
[0]; high
:= Length(stopStr
) - 1; Texts
.Read (fram
, ch
);
97 IF ch
= startCh
THEN (* check if stopString occurs *)
100 IF i
= high
THEN RETURN END; (*stopStr[0..i] found; no unrecognized character*)
101 Texts
.Read (fram
, ch
); INC(i
);
102 UNTIL ch
# stopStr
[i
];
103 (*stopStr[0..i-1] found; 1 unrecognized character*)
104 j
:= 0; WHILE j
< i
DO Texts
.Write(syn
, stopStr
[j
]); INC(j
) END
105 ELSE Texts
.Write (syn
, ch
); Texts
.Read(fram
, ch
)
110 PROCEDURE CopySourcePart (pos
: CRT
.Position
; indent
: INTEGER);
111 (*Copy sequence <position> from <src> to <syn>*)
112 VAR ch
: CHAR; i
: INTEGER; nChars
: LONGINT; r
: Texts
.Reader
;
114 IF (pos
.beg
>= 0) & (pos
.len
> 0) THEN
115 Texts
.OpenReader(r
, CRS
.src
, pos
.beg
); Texts
.Read(r
, ch
);
116 nChars
:= pos
.len
- 1;
120 Texts
.WriteLn(syn
); Indent(indent
);
121 IF nChars
> 0 THEN Texts
.Read(r
, ch
); DEC(nChars
) ELSE EXIT END;
123 WHILE (ch
= " ") & (i
> 0) DO (* skip blanks at beginning of line *)
124 IF nChars
> 0 THEN Texts
.Read(r
, ch
); DEC (nChars
) ELSE EXIT END;
128 Texts
.Write (syn
, ch
);
129 IF nChars
> 0 THEN Texts
.Read(r
, ch
); DEC (nChars
) ELSE EXIT END
133 (* IF pos.beg >= 0 THEN
134 Texts.OpenReader(r, CRS.src, pos.beg);
135 nChars := pos.len; col := pos.col - 1; ch := " ";
136 WHILE (nChars > 0) & (ch = " ") DO (*skip leading blanks*)
137 Texts
.Read(r
, ch
); DEC(nChars
); INC(col
)
142 Texts
.WriteLn(syn
); Indent(indent
);
143 IF nChars
> 0 THEN Texts
.Read(r
, ch
); DEC(nChars
) ELSE EXIT END;
145 WHILE (ch
= " ") & (i
> 0) DO (* skip blanks at beginning of line *)
146 IF nChars
> 0 THEN Texts
.Read(r
, ch
); DEC (nChars
) ELSE EXIT END;
150 Texts
.Write (syn
, ch
);
151 IF nChars
> 0 THEN Texts
.Read(r
, ch
); DEC (nChars
) ELSE EXIT END
156 PROCEDURE GenErrorMsg (errTyp
, errSym
: INTEGER; VAR errNr
: INTEGER);
157 VAR i
: INTEGER; name
: ARRAY 32 OF CHAR; sn
: CRT
.SymbolNode
;
159 INC (errorNr
); errNr
:= errorNr
;
160 CRT
.GetSym (errSym
, sn
); COPY(sn
.name
, name
);
161 i
:= 0; WHILE name
[i
] # 0X
DO IF name
[i
] = CHR(34) THEN name
[i
] := "'" END; INC(i
) END;
162 Texts
.WriteString(err
, " |");
163 Texts
.WriteInt (err
, errNr
, 3); Texts
.WriteString (err
, ": Msg("); Texts
.Write(err
, CHR(34));
165 | tErr
: Texts
.WriteString (err
, name
); Texts
.WriteString (err
, " expected")
166 | altErr
: Texts
.WriteString (err
, "invalid "); Texts
.WriteString (err
, name
)
167 | syncErr
: Texts
.WriteString (err
, "this symbol not expected in "); Texts
.WriteString (err
, name
)
169 Texts
.Write(err
, CHR(34)); Texts
.Write(err
, ")"); Texts
.WriteLn(err
)
172 PROCEDURE NewCondSet (set
: CRT
.Set
): INTEGER;
175 i
:= 1; (*skip symSet[0]*)
177 IF Sets
.Equal(set
, symSet
[i
]) THEN RETURN i
END;
180 INC(maxSS
); IF maxSS
> symSetSize
THEN Restriction (9) END;
181 symSet
[maxSS
] := set
;
185 PROCEDURE GenCond (set
: CRT
.Set
);
186 VAR sx
, i
, n
: INTEGER;
188 PROCEDURE Small(s
: CRT
.Set
): BOOLEAN;
191 WHILE i
<= CRT
.maxT
DO
192 IF Sets
.In(set
, i
) THEN RETURN FALSE
END;
199 n
:= Sets
.Elements(set
, i
);
200 (*IF n = 0 THEN PutS(" FALSE") (*this branch should never be taken*)
201 ELSIF (n
> 1) & Small(set
) THEN
202 PutS(" sym IN {"); PutSet(set
[0]); PutS("} ")
203 ELSIF n
<= maxTerm
THEN
205 WHILE i
<= CRT
.maxT
DO
206 IF Sets
.In (set
, i
) THEN
207 PutS(" (sym = "); PutI(i
); Texts
.Write(syn
, ")");
208 DEC(n
); IF n
> 0 THEN PutS(" OR") END
212 ELSE PutS(" sym IN symSet["); PutI(NewCondSet(set
)); PutS(",0]")
214 IF n
= 0 THEN PutS(" FALSE") (*this branch should never be taken*)
215 ELSIF n
<= maxTerm
THEN
217 WHILE i
<= CRT
.maxT
DO
218 IF Sets
.In (set
, i
) THEN
219 PutS(" (sym = "); PutI(i
); Texts
.Write(syn
, ")");
220 DEC(n
); IF n
> 0 THEN PutS(" OR") END
224 ELSE PutS(" StartOf("); PutI(NewCondSet(set
)); PutS(") ")
229 PROCEDURE GenCode (gp
, indent
: INTEGER; checked
: CRT
.Set
);
230 VAR gn
, gn2
: CRT
.GraphNode
; sn
: CRT
.SymbolNode
; gp2
: INTEGER;
231 s1
, s2
: CRT
.Set
; errNr
, alts
: INTEGER; equal
: BOOLEAN;
234 CRT
.GetNode (gp
, gn
);
239 CRT
.GetSym(gn
.p1
, sn
); PutS(sn
.name
);
240 IF gn
.pos
.beg
>= 0 THEN
241 Texts
.Write(syn
, "("); CopySourcePart(gn
.pos
, 0); Texts
.Write(syn
, ")")
246 CRT
.GetSym(gn
.p1
, sn
); Indent(indent
);
247 IF Sets
.In(checked
, gn
.p1
) THEN
250 PutS("Expect("); PutI(gn
.p1
); PutS(");$")
254 CRT
.CompExpected(ABS(gn
.next
), curSy
, s1
);
255 CRT
.GetSet(0, s2
); Sets
.Unite(s1
, s2
);
256 CRT
.GetSym(gn
.p1
, sn
); Indent(indent
);
257 PutS("ExpectWeak("); PutI(gn
.p1
); PutS(", "); PutI(NewCondSet(s1
)); PutS(");$")
260 Indent(indent
); PutS("Get;$")
262 | CRT
.eps
: (* nothing *)
265 CopySourcePart(gn
.pos
, indent
); PutS(";$");
268 CRT
.GetSet(gn
.p1
, s1
);
269 GenErrorMsg (syncErr
, curSy
, errNr
);
271 PutS("WHILE ~("); GenCond(s1
); PutS(") DO Error(");
272 PutI(errNr
); PutS("); Get END;$")
275 CRT
.CompFirstSet(gp
, s1
); equal
:= Sets
.Equal(s1
, checked
);
276 alts
:= Alternatives(gp
);
277 IF alts
> 5 THEN Indent(indent
); PutS("CASE sym OF$") END;
280 CRT
.GetNode(gp2
, gn2
);
281 CRT
.CompExpected(gn2
.p1
, curSy
, s1
);
283 IF alts
> 5 THEN PutS("| "); PutSet1(s1
); PutS(": ") (*case labels*)
284 ELSIF gp2
= gp
THEN PutS("IF"); GenCond(s1
); PutS(" THEN$")
285 ELSIF (gn2
.p2
= 0) & equal
THEN PutS("ELSE$")
286 ELSE PutS("ELSIF"); GenCond(s1
); PutS(" THEN$")
288 Sets
.Unite(s1
, checked
);
289 GenCode(gn2
.p1
, indent
+ 2, s1
);
293 GenErrorMsg(altErr
, curSy
, errNr
);
294 Indent(indent
); PutS("ELSE Error("); PutI(errNr
); PutS(")$")
296 Indent(indent
); PutS("END;$")
299 CRT
.GetNode(gn
.p1
, gn2
);
300 Indent(indent
); PutS("WHILE");
301 IF gn2
.typ
= CRT
.wt
THEN
302 CRT
.CompExpected(ABS(gn2
.next
), curSy
, s1
);
303 CRT
.CompExpected(ABS(gn
.next
), curSy
, s2
);
304 CRT
.GetSym(gn2
.p1
, sn
);
305 PutS(" WeakSeparator("); PutI(gn2
.p1
); PutS(", "); PutI(NewCondSet(s1
));
306 PutS(", "); PutI(NewCondSet(s2
)); PutS(") ");
307 Sets
.Clear(s1
); (*for inner structure*)
308 IF gn2
.next
> 0 THEN gp2
:= gn2
.next
ELSE gp2
:= 0 END
310 gp2
:= gn
.p1
; CRT
.CompFirstSet(gp2
, s1
); GenCond(s1
)
313 GenCode(gp2
, indent
+ 2, s1
);
314 Indent(indent
); PutS("END;$")
317 CRT
.CompFirstSet(gn
.p1
, s1
);
318 IF ~ Sets
.Equal(checked
, s1
) THEN
319 Indent(indent
); PutS("IF"); GenCond(s1
); PutS(" THEN$");
320 GenCode(gn
.p1
, indent
+ 2, s1
);
321 Indent(indent
); PutS("END;$")
322 ELSE GenCode(gn
.p1
, indent
, checked
)
326 IF ~
(gn
.typ
IN {CRT
.eps
, CRT
.sem
, CRT
.sync
}) THEN Sets
.Clear(checked
) END;
331 PROCEDURE GenCodePragmas
;
332 VAR i
, p
: INTEGER; sn
: CRT
.SymbolNode
;
334 PROCEDURE P(s1
, s2
: ARRAY OF CHAR);
336 PutS(" "); PutS(scanner
); PutS(s1
); PutS(" := "); PutS(scanner
); PutS(s2
); PutS(";$")
341 WHILE i
<= CRT
.maxP
DO
343 PutS(" IF sym = "); PutI(i
); PutS(" THEN$"); CopySourcePart(sn
.semPos
, 9); PutS("$ END;$");
346 P(".nextPos", ".pos"); P(".nextCol", ".col"); P(".nextLine", ".line"); P(".nextLen", ".len")
349 PROCEDURE GenProcedureHeading (sn
: CRT
.SymbolNode
; forward
: BOOLEAN);
352 IF forward
THEN Texts
.Write(syn
, "^") END;
354 IF sn
.attrPos
.beg
>= 0 THEN
355 Texts
.Write(syn
, "("); CopySourcePart(sn
.attrPos
, 0); Texts
.Write(syn
, ")")
358 END GenProcedureHeading
;
360 PROCEDURE GenForwardRefs
;
361 VAR sp
: INTEGER; sn
: CRT
.SymbolNode
;
365 WHILE sp
<= CRT
.lastNt
DO (* for all nonterminals *)
366 CRT
.GetSym (sp
, sn
); GenProcedureHeading(sn
, TRUE
);
373 PROCEDURE GenProductions
;
374 VAR sn
: CRT
.SymbolNode
; checked
: CRT
.Set
;
376 curSy
:= CRT
.firstNt
;
377 WHILE curSy
<= CRT
.lastNt
DO (* for all nonterminals *)
378 CRT
.GetSym (curSy
, sn
); GenProcedureHeading (sn
, FALSE
);
379 IF sn
.semPos
.beg
>= 0 THEN CopySourcePart(sn
.semPos
, 2); PutS(" $") END;
380 PutS("BEGIN$"); Sets
.Clear(checked
);
381 GenCode (sn
.struct
, 2, checked
);
382 PutS("END "); PutS(sn
.name
); PutS(";$$");
390 i
:= 0; CRT
.GetSet(0, symSet
[0]);
393 WHILE j
<= CRT
.maxT
DIV Sets
.size
DO
394 PutS(" symSet["); PutI(i
); PutS(", ");PutI(j
);
395 PutS("] := {"); PutSet(symSet
[i
, j
]); PutS("};$");
402 PROCEDURE *Show(t
: Texts
.Text
; op
: INTEGER; beg
, end
: LONGINT);
405 PROCEDURE GenCompiler
*;
406 VAR errNr
, i
: INTEGER; checked
: CRT
.Set
;
407 gn
: CRT
.GraphNode
; sn
: CRT
.SymbolNode
;
408 parser
: ARRAY 32 OF CHAR;
409 t
: Texts
.Text
; pos
: LONGINT;
412 CRT
.GetNode(CRT
.root
, gn
); CRT
.GetSym(gn
.p1
, sn
);
413 COPY(sn
.name
, parser
); i
:= Length(parser
); parser
[i
] := "P"; parser
[i
+1] := 0X
;
414 COPY(parser
, scanner
); scanner
[i
] := "S";
416 NEW(t
); Texts
.Open(t
, "Parser.FRM"); Texts
.OpenReader(fram
, t
, 0);
418 Texts
.WriteString(w
, "Parser.FRM not found"); Texts
.WriteLn(w
);
419 Texts
.Append(Oberon
.Log
, w
.buf
); HALT(99)
422 Texts
.OpenWriter(err
); Texts
.WriteLn(err
);
424 WHILE i
<= CRT
.maxT
DO GenErrorMsg(tErr
, i
, errNr
); INC(i
) END;
426 (*----- write *P.Mod -----*)
427 Texts
.OpenWriter(syn
);
428 NEW(t
); t
.notify
:= Show
; Texts
.Open(t
, "");
429 CopyFramePart("-->modulename"); PutS(parser
);
430 CopyFramePart("-->scanner"); PutS(scanner
);
431 IF CRT
.importPos
.beg
>= 0 THEN PutS(", "); CopySourcePart(CRT
.importPos
, 0) END;
432 CopyFramePart("-->constants");
433 PutS("maxP = "); PutI(CRT
.maxP
); PutS(";$");
434 PutS(" maxT = "); PutI(CRT
.maxT
); PutS(";$");
435 PutS(" nrSets = ;$"); Texts
.Append(t
, syn
.buf
); pos
:= t
.len
- 2;
436 CopyFramePart("-->declarations"); CopySourcePart(CRT
.semDeclPos
, 0);
437 CopyFramePart("-->errors"); PutS(scanner
); PutS(".Error(n, "); PutS(scanner
); PutS(".nextPos)");
438 CopyFramePart("-->scanProc");
439 IF CRT
.maxT
= CRT
.maxP
THEN PutS(scanner
); PutS(".Get(sym)")
441 PutS("LOOP "); PutS(scanner
); PutS(".Get(sym);$");
442 PutS(" IF sym > maxT THEN$");
448 CopyFramePart("-->productions"); GenForwardRefs
; GenProductions
;
449 CopyFramePart("-->parseRoot"); Sets
.Clear(checked
); GenCode (CRT
.root
, 2, checked
);
450 CopyFramePart("-->initialization"); InitSets
;
451 CopyFramePart("-->modulename"); PutS(parser
); Texts
.Write(syn
, ".");
452 Texts
.Append(t
, syn
.buf
); Texts
.Append(t
, err
.buf
);
453 PutI(maxSS
+1); (*if no set, maxSS = -1*) Texts
.Insert(t
, pos
, syn
.buf
);
454 i
:= Length(parser
); parser
[i
] := "."; parser
[i
+1] := "M"; parser
[i
+2] := "o"; parser
[i
+3] := "d"; parser
[i
+4] := 0X
;
455 Texts
.Close(t
, parser
)
458 PROCEDURE WriteStatistics
*;
460 Texts
.WriteInt (w
, CRT
.maxT
+ 1, 0); Texts
.WriteString(w
, " t, ");
461 Texts
.WriteInt (w
, CRT
.maxSymbols
- CRT
.firstNt
+ CRT
.maxT
+ 1, 0); Texts
.WriteString(w
, " syms, ");
462 Texts
.WriteInt (w
, CRT
.nNodes
, 0); Texts
.WriteString(w
, " nodes, ");
463 Texts
.WriteInt (w
, maxSS
, 0); Texts
.WriteString(w
, "sets");
464 Texts
.WriteLn(w
); Texts
.Append(Oberon
.Log
, w
.buf
)
469 errorNr
:= -1; maxSS
:= 0 (*symSet[0] reserved for all SYNC sets*)