DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / dsw-obn.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Добавлены строки в отладочную информацию класса (быстрохак)
[dsw-obn.git] / tools / Coco / CRA.obn
1 MODULE CRA; (* handles the DFA *)
2
3 IMPORT Oberon, Texts, Sets, CRS, CRT;
4
5 CONST
6 maxStates = 300;
7 EOL = 0DX;
8
9 TYPE
10 State = POINTER TO StateNode;
11 Action = POINTER TO ActionNode;
12 Target = POINTER TO TargetNode;
13
14 StateNode = RECORD (*state of finite automaton*)
15 nr: INTEGER; (*state number*)
16 firstAction: Action; (*to first action of this state*)
17 endOf: INTEGER; (*nr. of recognized token if state is final*)
18 ctx: BOOLEAN; (*TRUE: state reached by contextTrans*)
19 next: State
20 END;
21 ActionNode = RECORD (*action of finite automaton*)
22 typ: INTEGER; (*type of action symbol: char, class*)
23 sym: INTEGER; (*action symbol*)
24 tc: INTEGER; (*transition code: normTrans, contextTrans*)
25 target: Target; (*states after transition with input symbol*)
26 next: Action;
27 END;
28 TargetNode = RECORD (*state after transition with input symbol*)
29 state: State; (*target state*)
30 next: Target;
31 END;
32
33 Comment = POINTER TO CommentNode;
34 CommentNode = RECORD (* info about a comment syntax *)
35 start,stop: ARRAY 2 OF CHAR;
36 nested: BOOLEAN;
37 next: Comment;
38 END;
39
40 Melted = POINTER TO MeltedNode;
41 MeltedNode = RECORD (* info about melted states *)
42 set: CRT.Set; (* set of old states *)
43 state: State; (* new state *)
44 next: Melted;
45 END;
46
47
48 VAR
49 firstState: State;
50 lastState: State; (* last allocated state *)
51 rootState: State; (* start state of DFA *)
52 lastSimState: INTEGER; (* last non melted state *)
53 stateNr: INTEGER; (*number of last allocated state*)
54 firstMelted: Melted; (* list of melted states *)
55 firstComment: Comment; (* list of comments *)
56 out: Texts.Writer; (* current output *)
57 fram: Texts.Reader; (* scanner frame input *)
58
59
60 PROCEDURE SemErr(nr: INTEGER);
61 BEGIN CRS.Error(200+nr, CRS.pos)
62 END SemErr;
63
64 PROCEDURE Put(ch: CHAR);
65 BEGIN Texts.Write(out, ch) END Put;
66
67 PROCEDURE PutS(s: ARRAY OF CHAR);
68 VAR i: INTEGER;
69 BEGIN i := 0;
70 WHILE (i < LEN(s)) & (s[i] # 0X) DO
71 IF s[i] = "$" THEN Texts.WriteLn(out) ELSE Texts.Write(out, s[i]) END;
72 INC(i)
73 END
74 END PutS;
75
76 PROCEDURE PutI(i: INTEGER);
77 BEGIN Texts.WriteInt(out, i, 0) END PutI;
78
79 PROCEDURE PutI2(i, n: INTEGER);
80 BEGIN Texts.WriteInt(out, i, n) END PutI2;
81
82 PROCEDURE PutC(ch: CHAR);
83 BEGIN
84 IF (ch < " ") OR (ORD(ch) = 34) THEN PutS("CHR("); PutI(ORD(ch)); Put(")")
85 ELSE Put(CHR(34)); Put(ch); Put(CHR(34))
86 END
87 END PutC;
88
89 PROCEDURE PutRange(s: CRT.Set);
90 VAR lo, hi: ARRAY 32 OF CHAR; top, i: INTEGER; s1: CRT.Set;
91 BEGIN
92 (*----- fill lo and hi *)
93 top := -1; i := 0;
94 WHILE i < 128 DO
95 IF Sets.In(s, i) THEN
96 INC(top); lo[top] := CHR(i); INC(i);
97 WHILE (i < 128) & Sets.In(s, i) DO INC(i) END;
98 hi[top] := CHR(i - 1)
99 ELSE INC(i)
100 END
101 END;
102 (*----- print ranges *)
103 IF (top = 1) & (lo[0] = 0X) & (hi[1] = 7FX) & (CHR(ORD(hi[0]) + 2) = lo[1]) THEN
104 Sets.Fill(s1); Sets.Differ(s1, s); PutS("~ ("); PutRange(s1); Put(")")
105 ELSE
106 i := 0;
107 WHILE i <= top DO
108 IF hi[i] = lo[i] THEN PutS("(ch="); PutC(lo[i])
109 ELSIF lo[i] = 0X THEN PutS("(ch<="); PutC(hi[i])
110 ELSIF hi[i] = 7FX THEN PutS("(ch>="); PutC(lo[i])
111 ELSE PutS("(ch>="); PutC(lo[i]); PutS(") & (ch<="); PutC(hi[i])
112 END;
113 Put(")");
114 IF i < top THEN PutS(" OR ") END;
115 INC(i)
116 END
117 END
118 END PutRange;
119
120 PROCEDURE PutChCond(ch: CHAR);
121 BEGIN
122 PutS("(ch ="); PutC(ch); Put(")")
123 END PutChCond;
124
125 PROCEDURE Length*(s: ARRAY OF CHAR): INTEGER;
126 VAR i: INTEGER;
127 BEGIN
128 i:=0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END;
129 RETURN i
130 END Length;
131
132
133 PROCEDURE AddAction(act:Action; VAR head:Action);
134 VAR a,lasta: Action;
135 BEGIN
136 a := head; lasta := NIL;
137 LOOP
138 IF (a = NIL) (*collecting classes at the front gives better*)
139 OR (act^.typ < a^.typ) THEN (*performance*)
140 act^.next := a;
141 IF lasta = NIL THEN head := act ELSE lasta^.next := act END;
142 EXIT;
143 END;
144 lasta := a; a := a^.next;
145 END;
146 END AddAction;
147
148
149 PROCEDURE DetachAction(a:Action; VAR L:Action);
150 BEGIN
151 IF L = a THEN L := a^.next ELSIF L # NIL THEN DetachAction(a, L^.next) END
152 END DetachAction;
153
154
155 PROCEDURE TheAction (state: State; ch: CHAR): Action;
156 VAR a: Action; set: CRT.Set;
157 BEGIN
158 a := state.firstAction;
159 WHILE a # NIL DO
160 IF a.typ = CRT.char THEN
161 IF ORD(ch) = a.sym THEN RETURN a END
162 ELSIF a.typ = CRT.class THEN
163 CRT.GetClass(a^.sym, set);
164 IF Sets.In(set, ORD(ch)) THEN RETURN a END
165 END;
166 a := a.next
167 END;
168 RETURN NIL
169 END TheAction;
170
171
172 PROCEDURE AddTargetList(VAR lista, listb: Target);
173 VAR p,t: Target;
174
175 PROCEDURE AddTarget(t: Target; VAR list:Target);
176 VAR p,lastp: Target;
177 BEGIN
178 p:=list; lastp:=NIL;
179 LOOP
180 IF (p = NIL) OR (t^.state.nr < p^.state.nr) THEN EXIT END;
181 IF p^.state = t^.state THEN RETURN END;
182 lastp := p; p := p^.next
183 END;
184 t^.next:=p;
185 IF lastp=NIL THEN list:=t ELSE lastp^.next:=t END
186 END AddTarget;
187
188 BEGIN
189 p := lista;
190 WHILE p # NIL DO
191 NEW(t); t^.state:=p^.state; AddTarget(t, listb);
192 p := p^.next
193 END
194 END AddTargetList;
195
196
197 PROCEDURE NewMelted(set: CRT.Set; state: State): Melted;
198 VAR melt: Melted;
199 BEGIN
200 NEW(melt); melt^.set := set; melt^.state := state;
201 melt^.next := firstMelted; firstMelted := melt;
202 RETURN melt
203 END NewMelted;
204
205
206 PROCEDURE NewState(): State;
207 VAR state: State;
208 BEGIN
209 NEW(state); INC(stateNr); state.nr := stateNr;
210 state.firstAction := NIL; state.endOf := CRT.noSym; state.ctx := FALSE; state.next := NIL;
211 IF firstState = NIL THEN firstState := state ELSE lastState.next := state END;
212 lastState := state;
213 RETURN state
214 END NewState;
215
216
217 PROCEDURE NewTransition(from, to: State; typ, sym, tc: INTEGER);
218 VAR a: Action; t: Target;
219 BEGIN
220 NEW(t); t^.state := to; t^.next := NIL;
221 NEW(a); a^.typ := typ; a^.sym := sym; a^.tc := tc; a^.target := t;
222 AddAction(a, from.firstAction)
223 END NewTransition;
224
225
226 PROCEDURE NewComment*(from, to: INTEGER; nested: BOOLEAN);
227 VAR com: Comment;
228
229 PROCEDURE MakeStr(gp: INTEGER; VAR s: ARRAY OF CHAR);
230 VAR i, n: INTEGER; gn: CRT.GraphNode; set: CRT.Set;
231 BEGIN
232 i := 0;
233 WHILE gp # 0 DO
234 CRT.GetNode(gp, gn);
235 IF gn.typ = CRT.char THEN
236 IF i < 2 THEN s[i] := CHR(gn.p1) END; INC(i)
237 ELSIF gn.typ = CRT.class THEN
238 CRT.GetClass(gn.p1, set);
239 IF Sets.Elements(set, n) # 1 THEN SemErr(26) END;
240 IF i < 2 THEN s[i] := CHR(n) END; INC(i)
241 ELSE SemErr(22)
242 END;
243 gp := gn.next
244 END;
245 IF i > 2 THEN SemErr(25) ELSIF i < 2 THEN s[i] := 0X END
246 END MakeStr;
247
248 BEGIN
249 NEW(com);
250 MakeStr(from, com^.start); MakeStr(to, com^.stop);
251 com^.nested := nested;
252 com^.next := firstComment; firstComment := com
253 END NewComment;
254
255
256 PROCEDURE MakeSet(p: Action; VAR set: CRT.Set);
257 BEGIN
258 IF p^.typ = CRT.class THEN CRT.GetClass(p^.sym, set)
259 ELSE Sets.Clear(set); Sets.Incl(set, p^.sym)
260 END
261 END MakeSet;
262
263
264 PROCEDURE ChangeAction(a: Action; set: CRT.Set);
265 VAR nr: INTEGER;
266 BEGIN
267 IF Sets.Elements(set, nr) = 1 THEN a^.typ := CRT.char; a^.sym := nr
268 ELSE
269 nr := CRT.ClassWithSet(set);
270 IF nr < 0 THEN nr := CRT.NewClass("#0", set) END; (*class with dummy name*)
271 a^.typ := CRT.class; a^.sym := nr
272 END
273 END ChangeAction;
274
275
276 PROCEDURE CombineShifts;
277 VAR state: State; n: INTEGER; a, b, c: Action; seta, setb: CRT.Set;
278 BEGIN
279 state := firstState;
280 WHILE state # NIL DO
281 a := state.firstAction;
282 WHILE a # NIL DO
283 b := a^.next;
284 WHILE b # NIL DO
285 IF (a^.target^.state = b^.target^.state) & (a^.tc = b^.tc) THEN
286 MakeSet(a, seta); MakeSet(b, setb); Sets.Unite(seta, setb);
287 ChangeAction(a, seta);
288 c := b; b := b^.next; DetachAction(c, a)
289 ELSE b := b^.next
290 END
291 END;
292 a := a^.next
293 END;
294 state := state.next
295 END
296 END CombineShifts;
297
298
299 PROCEDURE DeleteRedundantStates;
300 VAR
301 action: Action;
302 state, s1, s2: State;
303 used: CRT.Set;
304 newState: ARRAY maxStates OF State;
305
306 PROCEDURE FindUsedStates(state: State);
307 VAR action: Action;
308 BEGIN
309 IF Sets.In(used, state.nr) THEN RETURN END;
310 Sets.Incl(used, state.nr);
311 action := state.firstAction;
312 WHILE action # NIL DO
313 FindUsedStates(action^.target^.state);
314 action:=action^.next
315 END
316 END FindUsedStates;
317
318 PROCEDURE DelUnused;
319 VAR state: State;
320 BEGIN
321 state := firstState.next; lastState := firstState; stateNr := 0; (*firstState has number 0*)
322 WHILE state # NIL DO
323 IF Sets.In(used, state.nr) THEN INC(stateNr); state.nr := stateNr; lastState := state
324 ELSE lastState.next := state.next
325 END;
326 state := state.next
327 END
328 END DelUnused;
329
330 BEGIN
331 Sets.Clear(used); FindUsedStates(firstState);
332 (*---------- combine equal final states ------------*)
333 s1 := firstState.next; (*first state cannot be final*)
334 WHILE s1 # NIL DO
335 IF Sets.In(used, s1.nr) & (s1.endOf # CRT.noSym) & (s1.firstAction = NIL) & ~ s1.ctx THEN
336 s2 := s1.next;
337 WHILE s2 # NIL DO
338 IF Sets.In(used, s2.nr) & (s1.endOf = s2.endOf) & (s2.firstAction = NIL) & ~ s2.ctx THEN
339 Sets.Excl(used, s2.nr); newState[s2.nr] := s1
340 END;
341 s2 := s2.next
342 END
343 END;
344 s1 := s1.next
345 END;
346 state := firstState; (*> state := firstState.next*)
347 WHILE state # NIL DO
348 IF Sets.In(used, state.nr) THEN
349 action := state.firstAction;
350 WHILE action # NIL DO
351 IF ~ Sets.In(used, action.target.state.nr) THEN
352 action^.target^.state := newState[action.target.state.nr]
353 END;
354 action := action^.next
355 END
356 END;
357 state := state.next
358 END;
359 DelUnused
360 END DeleteRedundantStates;
361
362
363 PROCEDURE ConvertToStates*(gp0, sp: INTEGER);
364 (*note: gn.line is abused as a state number!*)
365 VAR n: INTEGER; S: ARRAY maxStates OF State; gn: CRT.GraphNode;
366
367 PROCEDURE TheState(gp: INTEGER): State;
368 VAR state: State; gn: CRT.GraphNode;
369 BEGIN
370 IF gp = 0 THEN state := NewState(); state.endOf := sp; RETURN state
371 ELSE CRT.GetNode(gp, gn); RETURN S[gn.line]
372 END
373 END TheState;
374
375 PROCEDURE Step(from: State; gp: INTEGER);
376 VAR gn: CRT.GraphNode;
377 BEGIN
378 IF gp = 0 THEN RETURN END;
379 CRT.GetNode(gp, gn);
380 CASE gn.typ OF
381 CRT.class, CRT.char: NewTransition(from, TheState(ABS(gn.next)), gn.typ, gn.p1, gn.p2)
382 | CRT.alt: Step(from, gn.p1); Step(from, gn.p2)
383 | CRT.opt, CRT.iter: Step(from, ABS(gn.next)); Step(from, gn.p1)
384 END
385 END Step;
386
387 PROCEDURE FindTrans(gp: INTEGER; state: State);
388 VAR gn: CRT.GraphNode; new: BOOLEAN;
389 BEGIN
390 IF gp = 0 THEN RETURN END; (*end of graph*)
391 CRT.GetNode(gp, gn);
392 IF gn.line # 0 THEN RETURN END; (*already visited*)
393 new := state = NIL;
394 IF new THEN state := NewState() END;
395 INC(n); S[n] := state; gn.line := n; CRT.PutNode(gp, gn);
396 IF CRT.DelGraph(gp) THEN state.endOf := sp END; (*state is end state*)
397 CASE gn.typ OF
398 CRT.class, CRT.char: FindTrans(ABS(gn.next), NIL);
399 | CRT.opt: FindTrans(ABS(gn.next), NIL); FindTrans(gn.p1, state)
400 | CRT.iter: FindTrans(ABS(gn.next), state); FindTrans(gn.p1, state)
401 | CRT.alt: FindTrans(gn.p1, state); FindTrans(gn.p2, state)
402 END;
403 IF new OR (state = firstState) & (gp = gp0) THEN (*start of a group of equally numbered nodes*)
404 Step(state, gp)
405 END
406 END FindTrans;
407
408 BEGIN
409 IF CRT.DelGraph(gp0) THEN SemErr(20) END;
410 CRT.GetNode(gp0, gn);
411 IF gn.typ = CRT.iter THEN SemErr(21) END;
412 n := 0; FindTrans(gp0, firstState)
413 END ConvertToStates;
414
415
416 PROCEDURE MatchDFA* (s: ARRAY OF CHAR; sp: INTEGER; VAR matchedSp: INTEGER);
417 VAR state, to: State; a: Action; i, len: INTEGER;
418 BEGIN (*s with quotes*)
419 state := firstState; i := 1; len := Length(s) - 1;
420 LOOP (*try to match s against existing DFA*)
421 IF i = len THEN EXIT END;
422 a := TheAction(state, s[i]);
423 IF a = NIL THEN EXIT END;
424 state := a.target.state; INC(i)
425 END;
426 WHILE i < len DO (*make new DFA for s[i..len-1]*)
427 to := NewState();
428 NewTransition(state, to, CRT.char, ORD(s[i]), CRT.normTrans);
429 state := to; INC(i)
430 END;
431 matchedSp := state.endOf;
432 IF state.endOf = CRT.noSym THEN state.endOf := sp END
433 END MatchDFA;
434
435
436 PROCEDURE SplitActions(a, b: Action);
437 VAR c: Action; seta, setb, setc: CRT.Set;
438
439 PROCEDURE CombineTransCodes(t1, t2: INTEGER; VAR result:INTEGER);
440 BEGIN
441 IF t1 = CRT.contextTrans THEN result := t1 ELSE result := t2 END
442 END CombineTransCodes;
443
444 BEGIN
445 MakeSet(a, seta); MakeSet(b, setb);
446 IF Sets.Equal(seta, setb) THEN
447 AddTargetList(b^.target, a^.target);
448 CombineTransCodes(a^.tc, b^.tc, a^.tc);
449 DetachAction(b, a)
450 ELSIF Sets.Includes(seta, setb) THEN
451 setc := seta; Sets.Differ(setc, setb);
452 AddTargetList(a^.target, b^.target);
453 CombineTransCodes(a^.tc, b^.tc, b^.tc);
454 ChangeAction(a, setc)
455 ELSIF Sets.Includes(setb, seta) THEN
456 setc := setb; Sets.Differ(setc, seta);
457 AddTargetList(b^.target, a^.target);
458 CombineTransCodes(a^.tc, b^.tc, a^.tc);
459 ChangeAction(b, setc)
460 ELSE
461 Sets.Intersect(seta, setb, setc);
462 Sets.Differ(seta, setc);
463 Sets.Differ(setb, setc);
464 ChangeAction(a, seta);
465 ChangeAction(b, setb);
466 NEW(c); c^.target:=NIL;
467 CombineTransCodes(a^.tc, b^.tc, c^.tc);
468 AddTargetList(a^.target, c^.target);
469 AddTargetList(b^.target, c^.target);
470 ChangeAction(c, setc);
471 AddAction(c, a)
472 END
473 END SplitActions;
474
475
476 PROCEDURE MakeUnique(state: State; VAR changed:BOOLEAN);
477 VAR a, b: Action;
478
479 PROCEDURE Overlap(a, b: Action): BOOLEAN;
480 VAR seta, setb: CRT.Set;
481 BEGIN
482 IF a^.typ = CRT.char THEN
483 IF b^.typ = CRT.char THEN RETURN a^.sym = b^.sym
484 ELSE CRT.GetClass(b^.sym, setb); RETURN Sets.In(setb, a^.sym)
485 END
486 ELSE
487 CRT.GetClass(a^.sym, seta);
488 IF b^.typ = CRT.char THEN RETURN Sets.In(seta, b^.sym)
489 ELSE CRT.GetClass(b^.sym, setb); RETURN ~ Sets.Different(seta, setb)
490 END
491 END
492 END Overlap;
493
494 BEGIN
495 a := state.firstAction; changed := FALSE;
496 WHILE a # NIL DO
497 b := a^.next;
498 WHILE b # NIL DO
499 IF Overlap(a, b) THEN SplitActions(a, b); changed:=TRUE END;
500 b := b^.next;
501 END;
502 a:=a^.next
503 END
504 END MakeUnique;
505
506
507 PROCEDURE MeltStates(state: State; VAR correct:BOOLEAN);
508 VAR
509 action: Action;
510 ctx: BOOLEAN;
511 endOf: INTEGER;
512 melt: Melted;
513 set: CRT.Set;
514 s: State;
515 changed: BOOLEAN;
516
517 PROCEDURE AddMeltedSet(nr: INTEGER; VAR set: CRT.Set);
518 VAR m: Melted;
519 BEGIN
520 m := firstMelted;
521 WHILE (m # NIL) & (m^.state.nr # nr) DO m := m^.next END;
522 IF m = NIL THEN HALT(98) END;
523 Sets.Unite(set, m^.set);
524 END AddMeltedSet;
525
526 PROCEDURE GetStateSet(t: Target; VAR set: CRT.Set; VAR endOf: INTEGER; VAR ctx:BOOLEAN);
527 VAR statenr: INTEGER; (*lastS: State;*)
528 BEGIN
529 Sets.Clear(set); endOf := CRT.noSym; ctx := FALSE; (*lastS := NIL;*)
530 WHILE t # NIL DO
531 statenr := t.state.nr;
532 IF statenr <= lastSimState THEN Sets.Incl(set, statenr)
533 ELSE AddMeltedSet(statenr, set)
534 END;
535 IF t^.state^.endOf # CRT.noSym THEN
536 IF (endOf = CRT.noSym) OR (endOf = t^.state^.endOf)
537 (*OR (lastS^.firstAction # NIL) & (t^.state^.firstAction = NIL)*) THEN
538 endOf := t^.state.endOf; (*lastS := t^.state*)
539 ELSE
540 PutS("$Tokens "); PutI(endOf); PutS(" and "); PutI(t^.state.endOf);
541 PutS(" cannot be distinguished.$");
542 correct:=FALSE
543 END
544 END;
545 IF t^.state.ctx THEN ctx := TRUE;
546 IF t.state.endOf # CRT.noSym THEN
547 PutS("$Ambiguous CONTEXT clause.$"); correct := FALSE
548 END
549 END;
550 t := t^.next
551 END
552 END GetStateSet;
553
554 PROCEDURE FillWithActions(state: State; targ: Target);
555 VAR action,a: Action;
556 BEGIN
557 WHILE targ # NIL DO
558 action := targ^.state.firstAction;
559 WHILE action # NIL DO
560 NEW(a); a^ := action^; a^.target := NIL;
561 AddTargetList(action^.target, a^.target);
562 AddAction(a, state.firstAction);
563 action:=action^.next
564 END;
565 targ:=targ^.next
566 END;
567 END FillWithActions;
568
569 PROCEDURE KnownMelted(set:CRT.Set; VAR melt: Melted): BOOLEAN;
570 BEGIN
571 melt := firstMelted;
572 WHILE melt # NIL DO
573 IF Sets.Equal(set, melt^.set) THEN RETURN TRUE END;
574 melt := melt^.next
575 END;
576 RETURN FALSE
577 END KnownMelted;
578
579 BEGIN
580 action := state.firstAction;
581 WHILE action # NIL DO
582 IF action^.target^.next # NIL THEN (*more than one target state*)
583 GetStateSet(action^.target, set, endOf, ctx);
584 IF ~ KnownMelted(set, melt) THEN
585 s := NewState(); s.endOf := endOf; s.ctx := ctx;
586 FillWithActions(s, action^.target);
587 REPEAT MakeUnique(s, changed) UNTIL ~ changed;
588 melt := NewMelted(set, s);
589 END;
590 action^.target^.next:=NIL;
591 action^.target^.state := melt^.state
592 END;
593 action := action^.next
594 END;
595 Texts.Append(Oberon.Log, out.buf)
596 END MeltStates;
597
598
599 PROCEDURE MakeDeterministic*(VAR correct: BOOLEAN);
600 VAR state: State; changed: BOOLEAN;
601
602 PROCEDURE FindCtxStates; (*find states reached by a context transition*)
603 VAR a: Action; state: State;
604 BEGIN
605 state := firstState;
606 WHILE state # NIL DO
607 a := state.firstAction;
608 WHILE a # NIL DO
609 IF a^.tc = CRT.contextTrans THEN a^.target^.state.ctx := TRUE END;
610 a := a^.next
611 END;
612 state := state.next
613 END;
614 END FindCtxStates;
615
616 BEGIN
617 IF lastState = NIL THEN lastSimState := 0 ELSE lastSimState := lastState.nr END;
618 FindCtxStates;
619 state := firstState;
620 WHILE state # NIL DO
621 REPEAT MakeUnique(state, changed) UNTIL ~ changed;
622 state := state.next
623 END;
624 correct := TRUE;
625 state := firstState;
626 WHILE state # NIL DO MeltStates(state, correct); state := state.next END;
627 DeleteRedundantStates;
628 CombineShifts
629 END MakeDeterministic;
630
631
632 PROCEDURE PrintSymbol(typ, val, width: INTEGER);
633 VAR name: CRT.Name; len: INTEGER;
634 BEGIN
635 IF typ = CRT.class THEN
636 CRT.GetClassName(val, name); PutS(name); len := Length(name)
637 ELSIF (val >= ORD(" ")) & (val < 127) & (val # 34) THEN
638 Put(CHR(34)); Put(CHR(val)); Put(CHR(34)); len:=3
639 ELSE
640 PutS("CHR("); PutI2(val, 2); Put(")"); len:=7
641 END;
642 WHILE len < width DO Put(" "); INC(len) END
643 END PrintSymbol;
644
645
646 PROCEDURE PrintStates*;
647 VAR action: Action; first: BOOLEAN; state: State; i: INTEGER; targ: Target; set: CRT.Set; name: CRT.Name;
648 BEGIN
649 PutS("$-------- states ---------$");
650 state := firstState;
651 WHILE state # NIL DO
652 action := state.firstAction; first:=TRUE;
653 IF state.endOf = CRT.noSym THEN PutS(" ")
654 ELSE PutS("E("); PutI2(state.endOf, 2); Put(")")
655 END;
656 PutI2(state.nr, 3); Put(":"); IF action = NIL THEN PutS(" $") END;
657 WHILE action # NIL DO
658 IF first THEN Put(" "); first:=FALSE ELSE PutS(" ") END;
659 PrintSymbol(action^.typ, action^.sym, 0); Put(" ");
660 targ := action^.target;
661 WHILE targ # NIL DO
662 PutI(targ^.state.nr); Put(" "); targ := targ^.next;
663 END;
664 IF action^.tc = CRT.contextTrans THEN PutS(" context$") ELSE PutS(" $") END;
665 action := action^.next
666 END;
667 state := state.next
668 END;
669 PutS("$-------- character classes ---------$");
670 i := 0;
671 WHILE i <= CRT.maxC DO
672 CRT.GetClass(i, set); CRT.GetClassName(i, name); PutS(name); PutS(": ");
673 Sets.Print(out, set, 80, 13); Texts.WriteLn(out);
674 INC(i)
675 END;
676 Texts.Append(Oberon.Log, out.buf)
677 END PrintStates;
678
679
680 PROCEDURE GenComment(com:Comment);
681
682 PROCEDURE GenBody;
683 BEGIN
684 PutS(" LOOP$");
685 PutS(" IF "); PutChCond(com^.stop[0]); PutS(" THEN$");
686 IF Length(com^.stop) = 1 THEN
687 PutS(" DEC(level); oldEols := chLine - startLine; NextCh;$");
688 PutS(" IF level = 0 THEN RETURN TRUE END;$");
689 ELSE
690 PutS(" NextCh;$");
691 PutS(" IF "); PutChCond(com^.stop[1]); PutS(" THEN$");
692 PutS(" DEC(level); oldEols := chLine - startLine; NextCh;$");
693 PutS(" IF level=0 THEN RETURN TRUE END$");
694 PutS(" END;$");
695 END;
696 IF com^.nested THEN
697 PutS(" ELSIF "); PutChCond(com^.start[0]); PutS(" THEN$");
698 IF Length(com^.start) = 1 THEN
699 PutS(" INC(level); NextCh;$");
700 ELSE
701 PutS(" NextCh;$");
702 PutS(" IF "); PutChCond(com^.start[1]); PutS(" THEN$");
703 PutS(" INC(level); NextCh;$");
704 PutS(" END;$");
705 END;
706 END;
707 PutS(" ELSIF ch = EOF THEN RETURN FALSE$");
708 PutS(" ELSE NextCh END;$");
709 PutS(" END;$");
710 END GenBody;
711
712 BEGIN
713 PutS(" IF "); PutChCond(com^.start[0]); PutS(" THEN$");
714 IF Length(com^.start) = 1 THEN
715 PutS(" NextCh;$");
716 GenBody;
717 PutS(" END;");
718 ELSE
719 PutS(" NextCh;$");
720 PutS(" IF "); PutChCond(com^.start[1]); PutS(" THEN$");
721 PutS(" NextCh;$");
722 GenBody;
723 PutS(" ELSE$");
724 PutS(" IF ch = EOL THEN DEC(chLine); lineStart := oldLineStart END;$");
725 PutS(" DEC(chPos, 2); Texts.OpenReader(r, src, chPos+1); NextCh; RETURN FALSE$");
726 PutS(" END$");
727 PutS(" END;");
728 END;
729 END GenComment;
730
731
732 PROCEDURE CopyFramePart (stopStr: ARRAY OF CHAR); (*Copy from file <fram> to file <out> until <stopStr>*)
733 VAR ch, startCh: CHAR; i, j, high: INTEGER;
734 BEGIN
735 startCh := stopStr[0]; high := Length(stopStr) - 1; Texts.Read (fram, ch);
736 WHILE ch # 0X DO
737 IF ch = startCh THEN (* check if stopString occurs *)
738 i := 0;
739 REPEAT
740 IF i = high THEN RETURN END; (*stopStr[0..i] found; no unrecognized character*)
741 Texts.Read (fram, ch); INC(i);
742 UNTIL ch # stopStr[i];
743 (*stopStr[0..i-1] found; 1 unrecognized character*)
744 j := 0; WHILE j < i DO Texts.Write(out, stopStr[j]); INC(j) END
745 ELSE Texts.Write (out, ch); Texts.Read(fram, ch)
746 END
747 END
748 END CopyFramePart;
749
750 PROCEDURE GenLiterals;
751 VAR
752 i, j, k, l: INTEGER;
753 key: ARRAY 128 OF CRT.Name;
754 knr: ARRAY 128 OF INTEGER;
755 ch: CHAR;
756 sn: CRT.SymbolNode;
757 BEGIN
758 (*-- sort literal list*)
759 i := 0; k := 0;
760 WHILE i <= CRT.maxT DO
761 CRT.GetSym(i, sn);
762 IF sn.struct = CRT.litToken THEN
763 j := k-1; WHILE (j >= 0) & (sn.name < key[j]) DO key[j+1] := key[j]; knr[j+1] := knr[j]; DEC(j) END;
764 key[j+1] := sn.name; knr[j+1] := i; INC(k)
765 END;
766 INC(i)
767 END;
768 (*-- print case statement*)
769 IF k > 0 THEN
770 PutS(" IF (lexeme[0] >= "); PutC(key[0, 1]); PutS(") & (lexeme[0] <= "); PutC(key[k-1, 1]); PutS(") THEN$");
771 PutS(" CASE lexeme[0] OF$");
772 i := 0;
773 WHILE i < k DO
774 ch := key[i, 1]; (*key[i, 0] = quote*)
775 PutS(" | "); PutC(ch); j := i;
776 REPEAT
777 IF i = j THEN PutS(": IF lexeme = ") ELSE PutS(" ELSIF lexeme = ") END;
778 PutS(key[i]); PutS(" THEN sym := "); PutI(knr[i]); Put(CHR(13));
779 INC(i)
780 UNTIL (i = k) OR (key[i, 1] # ch);
781 PutS(" END$");
782 END;
783 PutS(" ELSE$ END$ END;$")
784 END
785 END GenLiterals;
786
787
788 PROCEDURE WriteState(state: State);
789 VAR action: Action; first, ctxEnd: BOOLEAN; sn: CRT.SymbolNode; endOf: INTEGER;
790 set: CRT.Set;
791 BEGIN
792 endOf := state.endOf;
793 IF (endOf > CRT.maxT) & (endOf # CRT.noSym) THEN (*pragmas have been moved*)
794 endOf := CRT.maxT + CRT.maxSymbols - endOf
795 END;
796 PutS(" | "); PutI2(state.nr, 2); PutS(": ");
797 first:=TRUE; ctxEnd := state.ctx;
798 action := state.firstAction;
799 WHILE action # NIL DO
800 IF first THEN PutS("IF "); first:=FALSE ELSE PutS(" ELSIF ") END;
801 IF action^.typ = CRT.char THEN PutChCond(CHR(action^.sym))
802 ELSE CRT.GetClass(action^.sym, set); PutRange(set)
803 END;
804 PutS(" THEN");
805 IF action.target.state.nr # state.nr THEN
806 PutS(" state := "); PutI(action.target.state.nr); Put(";")
807 END;
808 IF action^.tc = CRT.contextTrans THEN PutS(" INC(apx)"); ctxEnd := FALSE
809 ELSIF state.ctx THEN PutS(" apx := 0")
810 END;
811 PutS(" $");
812 action := action^.next
813 END;
814 IF state.firstAction # NIL THEN PutS(" ELSE ") END;
815 IF endOf = CRT.noSym THEN PutS("sym := noSym; ")
816 ELSE (*final state*)
817 CRT.GetSym(endOf, sn);
818 IF ctxEnd THEN (*final context state: cut appendix*)
819 PutS("chPos := chPos - apx - 1; Texts.OpenReader(r, src, chPos+1); NextCh; ")
820 END;
821 PutS("sym := "); PutI(endOf); PutS("; ");
822 IF sn.struct = CRT.classLitToken THEN PutS("CheckLiteral; ") END
823 END;
824 PutS("RETURN$");
825 IF state.firstAction # NIL THEN PutS(" END;$") END
826 END WriteState;
827
828 PROCEDURE *Show (t: Texts.Text; op: INTEGER; beg, end: LONGINT);
829 END Show;
830
831
832 PROCEDURE WriteScanner*;
833 VAR
834 scanner: ARRAY 32 OF CHAR;
835 name: ARRAY 64 OF CHAR;
836 startTab: ARRAY 128 OF INTEGER;
837 com: Comment;
838 i, j, l: INTEGER;
839 gn: CRT.GraphNode;
840 sn: CRT.SymbolNode;
841 state: State;
842 t: Texts.Text;
843
844 PROCEDURE FillStartTab;
845 VAR action: Action; i, targetState: INTEGER; class: CRT.Set;
846 BEGIN
847 startTab[0] := stateNr + 1; (*eof*)
848 i := 1; WHILE i < 128 DO startTab[i] := 0; INC(i) END;
849 action := firstState.firstAction;
850 WHILE action # NIL DO
851 targetState := action.target.state.nr;
852 IF action^.typ = CRT.char THEN
853 startTab[action^.sym] := targetState
854 ELSE
855 CRT.GetClass(action^.sym, class); i := 0;
856 WHILE i < 128 DO
857 IF Sets.In(class, i) THEN startTab[i] := targetState END;
858 INC(i)
859 END
860 END;
861 action := action^.next
862 END
863 END FillStartTab;
864
865 BEGIN
866 FillStartTab;
867 CRT.GetNode(CRT.root, gn); CRT.GetSym(gn.p1, sn);
868 COPY(sn.name, scanner); l := Length(scanner); scanner[l] := "S"; scanner[l+1] := 0X;
869 NEW(t); Texts.Open(t, "Scanner.FRM"); Texts.OpenReader(fram, t, 0);
870 IF t.len = 0 THEN
871 Texts.WriteString(out, "Scanner.FRM not found"); Texts.WriteLn(out);
872 Texts.Append(Oberon.Log, out.buf); HALT(99)
873 END;
874 Texts.Append(Oberon.Log, out.buf);
875
876 (*------- *S.MOD -------*)
877 CopyFramePart("-->modulename"); PutS(scanner);
878 CopyFramePart("-->declarations"); PutS(" noSym = "); PutI(CRT.maxT); Put(";");
879 CopyFramePart("-->comment");
880 com := firstComment;
881 WHILE com # NIL DO GenComment(com); com := com^.next END;
882 CopyFramePart("-->literals"); GenLiterals;
883
884 CopyFramePart("-->GetSy1");
885 IF ~ Sets.In(CRT.ignored, ORD(EOL)) THEN PutS(" IF oldEols > 0 THEN DEC(oldEols); ch := EOL END;$") END;
886 PutS(" WHILE (ch=20X)"); IF ~ Sets.Empty(CRT.ignored) THEN PutS(" OR ") END;
887 PutRange(CRT.ignored); PutS(" DO NextCh END;");
888 IF firstComment # NIL THEN
889 PutS("$ IF ("); com := firstComment;
890 WHILE com # NIL DO
891 PutChCond(com^.start[0]);
892 IF com^.next # NIL THEN PutS(" OR ") END;
893 com := com^.next
894 END;
895 PutS(") & Comment() THEN Get(sym); RETURN END;")
896 END;
897 CopyFramePart("-->GetSy2");
898 state := firstState.next;
899 WHILE state # NIL DO WriteState(state); state := state.next END;
900 PutS(" | "); PutI2(stateNr + 1, 2); PutS(": sym := 0; ch := 0X; RETURN$");
901
902 CopyFramePart("-->initialization");
903 i := 0;
904 WHILE i < 32 DO
905 j := 0; PutS(" ");
906 WHILE j < 4 DO
907 PutS("start["); PutI(4*i+j); PutS("]:="); PutI(startTab[4*i+j]); PutS("; ");
908 INC(j)
909 END;
910 Texts.WriteLn(out);
911 INC(i)
912 END;
913
914 CopyFramePart("-->modulename"); PutS(scanner); Put(".");
915 NEW(t); t.notify := Show; Texts.Open(t, ""); Texts.Append(t, out.buf);
916 l := Length(scanner); scanner[l] := "."; scanner[l+1] := "M"; scanner[l+2] := "o"; scanner[l+3] := "d"; scanner[l+4] := 0X;
917 Texts.Close(t, scanner)
918 END WriteScanner;
919
920
921 PROCEDURE Init*;
922 BEGIN
923 firstState := NIL; lastState := NIL; stateNr := -1;
924 rootState := NewState();
925 firstMelted := NIL; firstComment := NIL
926 END Init;
927
928 BEGIN
929 Texts.OpenWriter(out)
930 END CRA.
Another attempt to make Oberon compiler
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024