UNIT CRX;
(* CRX   Parser Generation
   ===   =================

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

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

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

INTERFACE

PROCEDURE GenCompiler;
(* Generates the target compiler (parser). *)

PROCEDURE WriteStatistics;
(* Writes statistics about compilation to list file. *)

IMPLEMENTATION

USES CRS, CRTable, 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 *)

VAR
  symSet : ARRAY [0 .. symSetSize] OF CRTable.CRTSet;  (* 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 : TEXT;             (* output: error message texts *)
  fram : TEXT;            (* input:  parser frame parser.frm *)
  syn : TEXT;             (* output: generated parser *)
  NewLine : BOOLEAN;
  IndDisp : INTEGER;

(* Put                  Write ch
----------------------------------------------------------------------*) 

PROCEDURE Put (ch : CHAR);
  BEGIN
    Write(syn, ch)
  END;

(* PutLn                Write line mark
----------------------------------------------------------------------*) 

PROCEDURE PutLn;
  BEGIN
    WriteLn(syn)
  END;

(* PutB                 Write n blanks
----------------------------------------------------------------------*) 

PROCEDURE PutB (n : INTEGER); FAR;
  BEGIN
    IF n > 0 THEN Write(syn, ' ':n)
  END;

(* Indent               Indent n characters
----------------------------------------------------------------------*) 

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

(* IndentProc           IndentProc n characters with additional IndDisp
----------------------------------------------------------------------*) 

PROCEDURE IndentProc (n : INTEGER); FAR;
  BEGIN
    Indent(n + IndDisp);
  END;

(* PutS                 Shortcut for WriteString(syn, ..)
----------------------------------------------------------------------*) 

PROCEDURE PutS (s : STRING); FAR;
  VAR
    i : INTEGER;
  BEGIN
    FOR i := 1 TO Length(s) DO
      IF s[i] = '$' THEN WriteLn(syn) ELSE Write(syn, s[i]);
  END;

(* PutI                 Shortcut for WriteInt(syn, i, 1)
----------------------------------------------------------------------*) 

PROCEDURE PutI (i : INTEGER);
  BEGIN
    Write(syn, i:1)
  END;

(* PutI2                Shortcut for WriteInt(syn, i, 2)
----------------------------------------------------------------------*) 

PROCEDURE PutI2 (i : INTEGER);
  BEGIN
    Write(syn, i:2)
  END;

(* PutSI                Writes i or named constant of symbol i
----------------------------------------------------------------------*) 

PROCEDURE PutSI (i : INTEGER);
  VAR
    sn : CRTable.SymbolNode;

  BEGIN
    CRTable.GetSym(i, sn);
    IF Length(sn.constant) > 0
      THEN PutS(sn.constant)
      ELSE PutI(i);
  END;

(* PutSet               Enumerate bitset
----------------------------------------------------------------------*) 

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

(* PutSet1              Enumerate long set
----------------------------------------------------------------------*) 

PROCEDURE PutSet1 (s : CRTable.CRTSet);
  VAR
    i : INTEGER;
    first : BOOLEAN;
  BEGIN
    i := 0;
    first := TRUE;
    WHILE i <= CRTable.maxT DO BEGIN
      IF Sets.IsIn(s, i) THEN
        BEGIN
          IF first THEN first := FALSE ELSE PutS(', ');
          PutSI(i)
        END;
      INC(i)
    END
  END;

(* Alternatives         Count alternatives of gp
----------------------------------------------------------------------*) 

FUNCTION Alternatives (gp : INTEGER) : INTEGER;
  VAR
    gn : CRTable.GraphNode;
    n : INTEGER;
  BEGIN
    n := 0;
    WHILE gp > 0 DO BEGIN
      CRTable.GetNode(gp, gn); gp := gn.p2; INC(n);
    END;
    Alternatives := n;
  END;

(* CopyFramePart        Copy from file <fram> to file <syn> until <stopStr>
----------------------------------------------------------------------*) 

PROCEDURE CopyFramePart (stopStr : STRING; VAR leftMarg : INTEGER);
  BEGIN
    CRA.CopyFramePart(stopStr, leftMarg, fram, syn);
  END;

TYPE
  IndentProcType = PROCEDURE (i : INTEGER);

(* CopySourcePart       Copy sequence <pos> from input file to file <syn>
----------------------------------------------------------------------*) 

PROCEDURE CopySourcePart (pos : CRTable.Position; indent : INTEGER; indentProc : IndentProcType);
  LABEL
    999;
  CONST
    CR = #13;
    LF = #10;
    EF = #0;
  VAR
    lastCh, ch : CHAR;
    extra, col, i : INTEGER;
    bp : LONGINT;
    nChars : LONGINT;
  BEGIN
    IF pos.beg >= 0 THEN
      BEGIN
        bp := pos.beg;
        nChars := pos.len;
        col := pos.col - 1;
        ch := ' ';
        extra := 0;
        WHILE (nChars > 0) AND ((ch = ' ') OR (ch = CHR(9))) DO BEGIN
        (* skip leading white space *)
        (* skip leading blanks *)
          ch := CRS.CharAt(bp); INC(bp); DEC(nChars); INC(col);
        END;
        indentProc(indent);
        WHILE TRUE DO BEGIN
          WHILE (ch = CR) OR (ch = LF) DO BEGIN
          (* Write blank lines with the correct number of leading blanks *)
            WriteLn(syn);
            lastCh := ch;
            IF nChars > 0
              THEN BEGIN ch := CRS.CharAt(bp); INC(bp); DEC(nChars); END
              ELSE GOTO 999;
            IF (ch = LF) AND (lastCh = CR)
              THEN
                BEGIN
                  extra := 1
                  (* must be MS-DOS format *) ;
                  IF nChars > 0
                    THEN BEGIN ch := CRS.CharAt(bp); INC(bp); DEC(nChars); END
                    ELSE EXIT;
                END;
            IF (ch <> CR) AND (ch <> LF) THEN
            (* we have something on this line *)
              BEGIN
                indentProc(indent);
                i := col - 1 - extra;
                WHILE ((ch = ' ') OR (ch = CHR(9))) AND (i > 0) DO BEGIN
                (* skip at most "col-1" white space chars at start of line *)
                  IF nChars > 0
                    THEN BEGIN ch := CRS.CharAt(bp); INC(bp); DEC(nChars); END
                    ELSE EXIT;
                  DEC(i);
                END;
              END;
          END;
          (* Handle extra blanks *)
          i := 0;
          WHILE ch = ' ' DO BEGIN
            IF nChars > 0
              THEN BEGIN ch := CRS.CharAt(bp); INC(bp); DEC(nChars) END
              ELSE EXIT;
            INC(i);
          END;
          IF (ch <> CR) AND (ch <> LF) AND (ch <> EF) THEN
            BEGIN
              IF i > 0 THEN PutB(i);
              Write(syn, ch);
              IF nChars > 0
                THEN BEGIN ch := CRS.CharAt(bp); INC(bp); DEC(nChars) END
                ELSE GOTO 999;
            END;
        END;
      999:
      END;
  END;

(* GenErrorMsg          Generate an error message and return its number
----------------------------------------------------------------------*) 

PROCEDURE GenErrorMsg (errTyp, errSym : INTEGER; VAR errNr : INTEGER);
  VAR
    i : INTEGER;
    name : CRTable.Name;
    sn : CRTable.SymbolNode;

  BEGIN
    INC(errorNr);
    errNr := errorNr;
    CRTable.GetSym(errSym, sn);
    name := sn.name;
    FOR i := 1 TO Length(name) DO
      IF name[i] = '''' THEN name[i] := '"';
    Write(err, ' ', errNr:3, ' : Msg(''');
    CASE errTyp OF
      tErr    : Write(err, name, ' expected');
      altErr  : Write(err, 'invalid ', name);
      syncErr : Write(err, 'this symbol not expected in ', name);
    END;
    WriteLn(err, ''');');
  END;

(* NewCondSet    Generate a new condition set, if set not yet exists
----------------------------------------------------------------------*) 

FUNCTION NewCondSet (newSet : CRTable.CRTSet) : INTEGER;
  VAR
    i : INTEGER;
  BEGIN
    i := 1; (*skip symSet[0]*)
    WHILE i <= maxSS DO BEGIN
      IF Sets.Equal(newSet, symSet[i]) THEN BEGIN NewCondSet := i; EXIT END;
      INC(i)
    END;
    INC(maxSS);
    IF maxSS > symSetSize THEN CRTable.Restriction(5, symSetSize);
    symSet[maxSS] := newSet;
    NewCondSet := maxSS
  END;

(* GenCond              Generate code to check if sym is in set
----------------------------------------------------------------------*) 

PROCEDURE GenCond (newSet : CRTable.CRTSet; indent : INTEGER);
  VAR
    i, n : INTEGER;

  FUNCTION Small (s : CRTable.CRTSet) : BOOLEAN;
    BEGIN
      i := Sets.size;
      WHILE i <= CRTable.maxT DO BEGIN
        IF Sets.IsIn(s, i) THEN BEGIN Small := FALSE; EXIT END;
        INC(i)
      END;
      Small := TRUE
    END;

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

(* GenCode              Generate code for graph gp in production curSy
----------------------------------------------------------------------*) 

PROCEDURE GenCode (gp, indent : INTEGER; checked : CRTable.CRTSet);
  VAR
    gn, gn2 : CRTable.GraphNode;
    sn : CRTable.SymbolNode;
    s1, s2 :CRTable.CRTSet;
    gp2, errNr, alts, indent1, addInd, errSemNod : INTEGER;
    FirstCase, equal, OldNewLine : BOOLEAN;
  BEGIN
    WHILE gp > 0 DO BEGIN
      CRTable.GetNode(gp, gn);
      CASE gn.typ OF
        CRTable.nt :
          BEGIN
            IndentProc(indent); CRTable.GetSym(gn.p1, sn);
            PutS('_'); PutS(sn.name);
            IF gn.pos.beg >= 0 THEN
              BEGIN
                Put('('); NewLine := FALSE;
                indent1 := indent + Length(sn.name) + 2;
                CopySourcePart(gn.pos, indent1, IndentProc);
                (* was      CopySourcePart(gn.pos, 0, IndentProc); ++++ *)
                Put(')')
              END;