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