crx.mod

一个Modula-2语言分析器

IMPLEMENTATION MODULE CRX;

(* CRX   Parser Generation
   ===   =================

   Uses the top-down graph and the computed sets of terminal start symbols
   from CRT to generate recursive descent parsing procedures.

   Errors are reported by error numbers. The corresponding error messages
   are written to <grammar name>.ERR.

   ---------------------------------------------------------------------*)

IMPORT CRS, CRT, CRA, FileIO, Sets;

CONST
  symSetSize = 100; (* max.number of symbol sets of the generated parser *)
  maxTerm    =   5; (* sets of size < maxTerm are enumerated *)
  maxAlter   =   5; (* more than maxAlter alternatives are handled with
                       a case statement *)
                    (* kinds of generated error messages *)
  tErr       =   0; (* unmatched terminal symbol *)
  altErr     =   1; (* unmatched alternatives *)
  syncErr    =   2; (* error reported at synchronization point *)

TYPE
  INT32 = FileIO.INT32;

VAR
  symSet:   ARRAY [0 .. symSetSize] OF CRT.Set; (* symbol sets in the
                                                   generated parser *)
  maxSS:    INTEGER; (* number of symbol sets *)
  errorNr:  INTEGER; (* number of last generated error message*)
  curSy:    INTEGER; (* symbol whose production is currently generated *)
  err:      FileIO.File; (* output: error message texts *)
  fram:     FileIO.File; (* input:  parser frame parser.frm *)
  syn:      FileIO.File; (* output: generated parser *)
  NewLine:  BOOLEAN;
  IndDisp:  INTEGER;

(*#check(overflow=>off)*)

(* Put                  Write ch
----------------------------------------------------------------------*)
PROCEDURE Put (ch: CHAR);
  BEGIN
    FileIO.Write(syn, ch)
  END Put;

(* PutLn                Write line mark
----------------------------------------------------------------------*)
PROCEDURE PutLn;
  BEGIN
    FileIO.WriteLn(syn)
  END PutLn;

(* PutB                 Write n blanks
----------------------------------------------------------------------*)
PROCEDURE PutB (n: INTEGER);
  BEGIN
    IF n > 0 THEN FileIO.WriteText(syn, "", n) END;
  END PutB;

(* Indent               Indent n characters
----------------------------------------------------------------------*)
PROCEDURE Indent (n: INTEGER);
  BEGIN
    IF NewLine THEN PutB(n) ELSE NewLine := TRUE END;
  END Indent;

(* IndentProc           IndentProc n characters with additional IndDisp
----------------------------------------------------------------------*)
PROCEDURE IndentProc (n: INTEGER);
  BEGIN
    Indent(n + IndDisp);
  END IndentProc;

(* PutS                 Shortcut for WriteString(syn, ..)
----------------------------------------------------------------------*)
PROCEDURE PutS (s: ARRAY OF CHAR);
  VAR
    i: CARDINAL;
  BEGIN
    i := 0;
    WHILE (i <= HIGH(s)) & (s[i] # 0C) DO
      IF s[i] = "$"
        THEN FileIO.WriteLn(syn)
        ELSE FileIO.Write(syn, s[i])
      END;
      INC(i)
    END
  END PutS;

(* PutI                 Shortcut for WriteInt(syn, i, 1)
----------------------------------------------------------------------*)
PROCEDURE PutI (i: INTEGER);
  BEGIN
    FileIO.WriteInt(syn, i, 1)
  END PutI;

(* PutI2                Shortcut for WriteInt(syn, i, 2)
----------------------------------------------------------------------*)
PROCEDURE PutI2 (i: INTEGER);
  BEGIN
    FileIO.WriteInt(syn, i, 2)
  END PutI2;

(* PutSI                Writes i or named constant of symbol i
----------------------------------------------------------------------*)
PROCEDURE PutSI (i: INTEGER);
  VAR
    sn: CRT.SymbolNode;
  BEGIN
    CRT.GetSym(i, sn);
    IF FileIO.SLENGTH(sn.constant) > 0 THEN
      PutS(sn.constant);
    ELSE
      PutI(i);
    END;
  END PutSI;

(* PutSet               Enumerate bitset
----------------------------------------------------------------------*)
PROCEDURE PutSet (s: BITSET; offset: CARDINAL);
  CONST
    MaxLine = 76;
  VAR
    first: BOOLEAN;
    i, l, len: CARDINAL;
    sn: CRT.SymbolNode;
  BEGIN
    i := 0; first := TRUE; len := 20;
    WHILE (i < Sets.size) & (offset + i <= ORD(CRT.maxT)) DO
      IF i IN s THEN
        IF first THEN first := FALSE ELSE PutS(", "); INC(len, 2) END;
        CRT.GetSym(offset + i, sn); l := FileIO.SLENGTH(sn.constant);
        IF l > 0 THEN
          IF len + l > MaxLine THEN
            PutS('$                    ');
            len := 20;
          END;
          PutS(sn.constant); INC(len, l);
          IF offset > 0 THEN Put("-"); PutI(offset); INC(len, 3) END;
        ELSE
          IF len + l > MaxLine THEN
            PutS('$                    ');
            len := 20;
          END;
          PutI(i); INC(len, i DIV 10 + 1);
        END;
      END;
      INC(i)
    END
  END PutSet;

(* PutSet1              Enumerate long set
----------------------------------------------------------------------*)
PROCEDURE PutSet1 (s: CRT.Set);
  VAR
    i: INTEGER;
    first: BOOLEAN;
  BEGIN
    i := 0; first := TRUE;
    WHILE i <= CRT.maxT DO
      IF Sets.In(s, i) THEN
        IF first THEN first := FALSE ELSE PutS(", ") END;
        PutSI(i)
      END;
      INC(i)
    END
  END PutSet1;

(* Alternatives         Count alternatives of gp
----------------------------------------------------------------------*)
PROCEDURE Alternatives (gp: INTEGER): INTEGER;
  VAR
    gn: CRT.GraphNode;
    n: INTEGER;
  BEGIN
    n := 0;
    WHILE gp > 0 DO
      CRT.GetNode(gp, gn); gp := gn.p2; INC(n);
    END;
    RETURN n;
  END Alternatives;

(* CopyFramePart        Copy from file <fram> to file <syn> until <stopStr>
----------------------------------------------------------------------*)
PROCEDURE CopyFramePart (stopStr: ARRAY OF CHAR; VAR leftMarg: CARDINAL);
  BEGIN
    CRA.CopyFramePart(stopStr, leftMarg, fram, syn);
  END CopyFramePart;

TYPE
  IndentProcType = PROCEDURE (INTEGER);

(* CopySourcePart       Copy sequence <pos> from input file to file <syn>
----------------------------------------------------------------------*)
PROCEDURE CopySourcePart (pos: CRT.Position; indent: INTEGER;
                          indentProc: IndentProcType);
  VAR
    lastCh, ch: CHAR;
    extra, col, i: INTEGER;
    bp: INT32;
    nChars: CARDINAL;
  BEGIN
    IF pos.beg >= FileIO.Long0 THEN
      bp := pos.beg; nChars := pos.len;
      col := pos.col - 1; ch := " "; extra := 0;
      WHILE (nChars > 0) & ((ch = " ") OR (ch = CHR(9))) DO
      (* skip leading white space *)
        ch := CRS.CharAt(bp); INC(bp); DEC(nChars); INC(col);
      END;
      indentProc(indent);
      LOOP
        WHILE (ch = FileIO.CR) OR (ch = FileIO.LF) DO
          (* Write blank lines with the correct number of leading blanks *)
          FileIO.WriteLn(syn);
          lastCh := ch;
          IF nChars > 0
            THEN ch := CRS.CharAt(bp); INC(bp); DEC(nChars);
            ELSE EXIT
          END;
          IF (ch = FileIO.LF) & (lastCh = FileIO.CR) THEN
            extra := 1 (* must be MS-DOS format *);
            IF nChars > 0
              THEN ch := CRS.CharAt(bp); INC(bp); DEC(nChars);
              ELSE EXIT
            END
          END;
          IF (ch # FileIO.CR) & (ch # FileIO.LF) THEN
            (* we have something on this line *)
            indentProc(indent);
            i := col - 1 - extra;
            WHILE ((ch = " ") OR (ch = CHR(9))) & (i > 0) DO
              (* skip at most "col-1" white space chars at start of line *)
              IF nChars > 0
                THEN ch := CRS.CharAt(bp); INC(bp); DEC(nChars);
                ELSE EXIT
              END;
              DEC(i);
            END;
          END;
        END;
        (* Handle extra blanks *)
        i := 0;
        WHILE ch = " " DO
          IF nChars > 0
            THEN ch := CRS.CharAt(bp); INC(bp); DEC(nChars);
            ELSE EXIT
          END;
          INC(i);
        END;
        IF (ch # FileIO.CR) & (ch # FileIO.LF) & (ch # FileIO.EOF) THEN
          IF i > 0 THEN PutB(i) END;
          FileIO.Write(syn, ch);
          IF nChars > 0
            THEN ch := CRS.CharAt(bp); INC(bp); DEC(nChars);
            ELSE EXIT
          END;
        END;
      END;
    END;
  END CopySourcePart;

(* GenErrorMsg          Generate an error message and return its number
----------------------------------------------------------------------*)
PROCEDURE GenErrorMsg (errTyp, errSym: INTEGER; VAR errNr: INTEGER);
  VAR
    i: INTEGER;
    name: CRT.Name;
    sn: CRT.SymbolNode;
  BEGIN
    INC(errorNr); errNr := errorNr;
    CRT.GetSym(errSym, sn); name := sn.name;
    i := 0;
    WHILE name[i] # 0C DO
      IF name[i] = '"' THEN name[i] := "'" END;
      INC(i)
    END;
    IF errNr = 0
      THEN FileIO.WriteString(err, " ");
      ELSE FileIO.WriteString(err, "|");
    END;
    FileIO.WriteInt(err, errNr, 3); FileIO.WriteString(err, ': Msg("');
    CASE errTyp OF
      tErr   : FileIO.WriteString(err, name);
               FileIO.WriteString(err, " expected")
    | altErr : FileIO.WriteString(err, "invalid ");
               FileIO.WriteString(err, name)
    | syncErr: FileIO.WriteString(err, "this symbol not expected in ");
               FileIO.WriteString(err, name)
    END;
    FileIO.WriteString(err, '")');
    FileIO.WriteLn(err);
  END GenErrorMsg;

(* NewCondSet    Generate a new condition set, if set not yet exists
----------------------------------------------------------------------*)
PROCEDURE NewCondSet (set: CRT.Set): INTEGER;
  VAR
    i: INTEGER;
  BEGIN
    i := 1; (*skip symSet[0]*)
    WHILE i <= maxSS DO
      IF Sets.Equal(set, symSet[i]) THEN RETURN i END;
      INC(i)
    END;
    INC(maxSS);
    IF maxSS > symSetSize THEN CRT.Restriction(5, symSetSize) END;
    symSet[maxSS] := set;
    RETURN maxSS
  END NewCondSet;

(* GenCond              Generate code to check if sym is in set
----------------------------------------------------------------------*)
PROCEDURE GenCond (set: CRT.Set; indent: INTEGER);
  VAR
    i, n: INTEGER;

  PROCEDURE Small (s: CRT.Set): BOOLEAN;
    BEGIN
      i := Sets.size;
      WHILE i <= CRT.maxT DO
        IF Sets.In(s, i) THEN RETURN FALSE END;
        INC(i)
      END;
      RETURN TRUE
    END Small;

  BEGIN
    n := Sets.Elements(set, i);
    IF n = 0 THEN PutS(" FALSE") (*this branch should never be taken*)
    ELSIF n <= maxTerm THEN
      i := 0;
      WHILE i <= CRT.maxT DO
        IF Sets.In(set, i) THEN
          PutS(" (sym = "); PutSI(i); Put(")"); DEC(n);
          IF n > 0 THEN
            PutS(" OR");
            IF CRT.ddt["N"] THEN PutLn; IndentProc(indent) END
          END
        END;
        INC(i)
      END
    ELSIF Small(set) THEN
      PutS(" (sym < "); PutI2(Sets.size);
      PutS(") (* prevent range error *) AND$");
      IndentProc(indent); PutS(" (sym IN BITSET{");
      PutSet(set[0], 0); PutS("}) ")
    ELSE PutS(" In(symSet["); PutI(NewCondSet(set)); PutS("], sym)")
    END;
  END GenCond;

(* GenCode              Generate code for graph gp in production curSy
----------------------------------------------------------------------*)
PROCEDURE GenCode (gp, indent: INTEGER; checked: CRT.Set);
  VAR
    gn, gn2: CRT.GraphNode;
    sn: CRT.SymbolNode;
    s1, s2: CRT.Set;
    gp2, errNr, alts, indent1, addInd, errSemNod: INTEGER;
    FirstCase, equal, OldNewLine: BOOLEAN;
    altStart: INT32;
  BEGIN
    WHILE gp > 0 DO
      CRT.GetNode(gp, gn);
      CASE gn.typ OF

        CRT.nt:
          IndentProc(indent);
          CRT.GetSym(gn.p1, sn); PutS(sn.name);
          IF gn.pos.beg >= FileIO.Long0 THEN
            Put("("); NewLine := FALSE;
            indent1 := indent + VAL(INTEGER, FileIO.SLENGTH(sn.name)) + 1;
            CopySourcePart(gn.pos, indent1, IndentProc);
(* was      CopySourcePart(gn.pos, 0, IndentProc); ++++ *)
            Put(")")
          END;
          PutS(";$")

      | CRT.t:
          CRT.GetSym(gn.p1, sn); IndentProc(indent);
          IF Sets.In(checked, gn.p1) THEN
            PutS("Get;$");
          ELSE
            PutS("Expect("); PutSI(gn.p1); PutS(");$");
          END

      | CRT.wt:
          CRT.CompExpected(ABS(gn.next), curSy, s1);
          CRT.GetSet(0, s2); Sets.Unite(s1, s2);
          CRT.GetSym(gn.p1, sn); IndentProc(indent);
          PutS("ExpectWeak("); PutSI(gn.p1); PutS(", ");
          PutI(NewCondSet(s1)); PutS(");$")

      | CRT.any:
          IndentProc(indent); PutS("Get;$")

      | CRT.eps: (* nothing *)

      | CRT.sem:
          CopySourcePart(gn.pos, indent, IndentProc); PutS(";$");

      | CRT.sync:
          CRT.GetSet(gn.p1, s1);
          GenErrorMsg(syncErr, curSy, errNr);