crp.pas

一个Pascal语言分析器

UNIT CRP;
(* Parser generated by Coco/R (Pascal version) *)

INTERFACE

PROCEDURE Parse;

FUNCTION Successful : BOOLEAN;
(* Returns TRUE if no errors have been recorded while parsing *)

PROCEDURE SynError (errNo: INTEGER);
(* Report syntax error with specified errNo *)

PROCEDURE SemError (errNo: INTEGER);
(* Report semantic error with specified errNo *)

PROCEDURE LexString (VAR Lex : STRING);
(* Retrieves Lex as exact spelling of current token *)

PROCEDURE LexName (VAR Lex : STRING);
(* Retrieves Lex as name of current token (capitalized if IGNORE CASE) *)

PROCEDURE LookAheadString (VAR Lex : STRING);
(* Retrieves Lex as exact spelling of lookahead token *)

PROCEDURE LookAheadName (VAR Lex : STRING);
(* Retrieves Lex as name of lookahead token (capitalized if IGNORE CASE) *)

IMPLEMENTATION

USES CRTable, CRA, Sets, CRS;


CONST
  ident = 0; stringSym = 1;  (* symbol kind *)

PROCEDURE FixString (VAR name: STRING; len: INTEGER);
  VAR
    double, spaces: BOOLEAN;
    i: INTEGER;
  BEGIN
    IF len = 2 THEN BEGIN SemError(129); EXIT END;
    IF CRTable.ignoreCase THEN (* force uppercase *)
      FOR i := 2 TO len - 1 DO name[i] := UpCase(name[i]);
    double := FALSE; spaces := FALSE;
    FOR i := 2 TO len - 1 DO (* search for interior " or spaces *) BEGIN
      IF name[i] = '"' THEN double := TRUE;
      IF name[i] <= ' ' THEN spaces := TRUE;
    END;
    IF NOT double THEN (* force delimiters to be " quotes *) BEGIN
      name[1] := '"'; name[len] := '"'
    END;
    IF spaces THEN SemError(124);
  END;

PROCEDURE MatchLiteral (sp: INTEGER);
(* store string either as token or as literal *)
  VAR
    sn, sn1:  CRTable.SymbolNode;
    matchedSp: INTEGER;
  BEGIN
    CRTable.GetSym(sp, sn);
    CRA.MatchDFA(sn.name, sp, matchedSp);
    IF matchedSp <> CRTable.noSym
      THEN
        BEGIN
          CRTable.GetSym(matchedSp, sn1);
          sn1.struct := CRTable.classLitToken;
          CRTable.PutSym(matchedSp, sn1);
          sn.struct := CRTable.litToken
        END
      ELSE sn.struct := CRTable.classToken;
    CRTable.PutSym(sp, sn)
  END;

PROCEDURE SetCtx (gp: INTEGER);
(* set transition code to CRTable.contextTrans *)
  VAR
    gn: CRTable.GraphNode;
  BEGIN
    WHILE gp > 0 DO BEGIN
      CRTable.GetNode(gp, gn);
      IF (gn.typ = CRTable.chart) OR (gn.typ = CRTable.class)
        THEN BEGIN gn.p2 := CRTable.contextTrans; CRTable.PutNode(gp, gn) END
        ELSE IF (gn.typ = CRTable.opt) OR (gn.typ = CRTable.iter) THEN SetCtx(gn.p1)
        ELSE IF gn.typ = CRTable.alt THEN BEGIN SetCtx(gn.p1); SetCtx(gn.p2) END;
      gp := gn.next
    END
  END;

PROCEDURE SetOption (s: STRING);
  VAR
    i: INTEGER;
  BEGIN
    FOR i := 1 TO Length(s) DO
      BEGIN
        s[i] := UpCase(s[i]);
        IF s[i] IN ['A' .. 'Z'] THEN CRTable.ddt[s[i]] := TRUE;
      END;
  END;

(*----------------------------------------------------------------------------*)



CONST
  maxT = 44;
  maxP = 45;
  minErrDist  =  2;  (* minimal distance (good tokens) between two errors *)
  setsize     = 16;  (* sets are stored in 16 bits *)

TYPE
  BITSET = SET OF 0 .. 15;
  SymbolSet = ARRAY [0 .. maxT DIV setsize] OF BITSET;

VAR
  symSet:  ARRAY [0 ..  18] OF SymbolSet; (*symSet[0] = allSyncSyms*)
  errDist: INTEGER;   (* number of symbols recognized since last error *)
  sym:     INTEGER;   (* current input symbol *)

PROCEDURE  SemError (errNo: INTEGER);
  BEGIN
    IF errDist >= minErrDist THEN BEGIN
      CRS.Error(errNo, CRS.line, CRS.col, CRS.pos);
    END;
    errDist := 0;
  END;

PROCEDURE  SynError (errNo: INTEGER);
  BEGIN
    IF errDist >= minErrDist THEN BEGIN
      CRS.Error(errNo, CRS.nextLine, CRS.nextCol, CRS.nextPos);
    END;
    errDist := 0;
  END;

PROCEDURE  Get;
  VAR
    s: STRING;
  BEGIN
    REPEAT
      CRS.Get(sym);
      IF sym <= maxT THEN
        INC(errDist)
      ELSE BEGIN
        CASE sym OF
          45: BEGIN CRS.GetName(CRS.nextPos, CRS.nextLen, s); SetOption(s); END;
        END;
        CRS.nextPos := CRS.pos;
        CRS.nextCol := CRS.col;
        CRS.nextLine := CRS.line;
        CRS.nextLen := CRS.len;
      END;
    UNTIL sym <= maxT
  END;

FUNCTION  _In (VAR s: SymbolSet; x: INTEGER): BOOLEAN;
  BEGIN
    _In := x MOD setsize IN s[x DIV setsize];
  END;

PROCEDURE  Expect (n: INTEGER);
  BEGIN
    IF sym = n THEN Get ELSE SynError(n);
  END;

PROCEDURE  ExpectWeak (n, follow: INTEGER);
  BEGIN
    IF sym = n
    THEN Get
    ELSE BEGIN
      SynError(n); WHILE NOT _In(symSet[follow], sym) DO Get;
    END
  END;

FUNCTION  WeakSeparator (n, syFol, repFol: INTEGER): BOOLEAN;
  VAR
    s: SymbolSet;
    i: INTEGER;
  BEGIN
    IF sym = n
    THEN BEGIN Get; WeakSeparator := TRUE; EXIT; END
    ELSE IF _In(symSet[repFol], sym) THEN BEGIN WeakSeparator := FALSE; exit END
    ELSE BEGIN
      i := 0;
      WHILE i <= maxT DIV setsize DO BEGIN
        s[i] := symSet[0, i] + symSet[syFol, i] + symSet[repFol, i]; INC(i)
      END;
      SynError(n); WHILE NOT _In(s, sym) DO Get;
      WeakSeparator := _In(symSet[syFol], sym)
    END
  END;

PROCEDURE LexName (VAR Lex : STRING);
  BEGIN
    CRS.GetName(CRS.pos, CRS.len, Lex)
  END;

PROCEDURE LexString (VAR Lex : STRING);
  BEGIN
    CRS.GetString(CRS.pos, CRS.len, Lex)
  END;

PROCEDURE LookAheadName (VAR Lex : STRING);
  BEGIN
    CRS.GetName(CRS.nextPos, CRS.nextLen, Lex)
  END;

PROCEDURE LookAheadString (VAR Lex : STRING);
  BEGIN
    CRS.GetString(CRS.nextPos, CRS.nextLen, Lex)
  END;

FUNCTION Successful : BOOLEAN;
  BEGIN
    Successful := CRS.errors = 0
  END;

PROCEDURE _TokenFactor (VAR gL, gR: INTEGER); FORWARD;
PROCEDURE _TokenTerm (VAR gL, gR: INTEGER); FORWARD;
PROCEDURE _Factor (VAR gL, gR: INTEGER); FORWARD;
PROCEDURE _Term (VAR gL, gR: INTEGER); FORWARD;
PROCEDURE _Symbol (VAR name: CRTable.Name; VAR kind: INTEGER); FORWARD;
PROCEDURE _SingleChar (VAR n: INTEGER); FORWARD;
PROCEDURE _SimSet (VAR oneSet: CRTable.CRTSet); FORWARD;
PROCEDURE _Set (VAR oneSet: CRTable.CRTSet); FORWARD;
PROCEDURE _TokenExpr (VAR gL, gR: INTEGER); FORWARD;
PROCEDURE _NameDecl; FORWARD;
PROCEDURE _TokenDecl (typ: INTEGER); FORWARD;
PROCEDURE _SetDecl; FORWARD;
PROCEDURE _Expression (VAR gL, gR: INTEGER); FORWARD;
PROCEDURE _SemText (VAR semPos: CRTable.Position); FORWARD;
PROCEDURE _Attribs (VAR attrPos: CRTable.Position); FORWARD;
PROCEDURE _Declaration; FORWARD;
PROCEDURE _Ident (VAR name: CRTable.Name); FORWARD;
PROCEDURE _CR; FORWARD;

PROCEDURE _TokenFactor (VAR gL, gR: INTEGER);
  VAR
    kind, c: INTEGER;
    oneSet:  CRTable.CRTSet;
    name:    CRTable.Name;
  BEGIN
    gL :=0; gR := 0;
    IF (sym = 1) OR (sym = 2) THEN BEGIN
      _Symbol(name, kind);
      IF kind = ident
        THEN
          BEGIN
            c := CRTable.ClassWithName(name);
            IF c < 0 THEN BEGIN
              SemError(115);
              Sets.Clear(oneSet); c := CRTable.NewClass(name, oneSet)
            END;
            gL := CRTable.NewNode(CRTable.class, c, 0); gR := gL
          END
        ELSE (* string *)
          CRTable.StrToGraph(name, gL, gR);
    END ELSE IF (sym = 28) THEN BEGIN
      Get;
      _TokenExpr(gL, gR);
      Expect(29);
    END ELSE IF (sym = 32) THEN BEGIN
      Get;
      _TokenExpr(gL, gR);
      Expect(33);
      CRTable.MakeOption(gL, gR);
    END ELSE IF (sym = 34) THEN BEGIN
      Get;
      _TokenExpr(gL, gR);
      Expect(35);
      CRTable.MakeIteration(gL, gR);
    END ELSE BEGIN SynError(45);
    END;
  END;

PROCEDURE _TokenTerm (VAR gL, gR: INTEGER);
  VAR
    gL2, gR2: INTEGER;
  BEGIN
    _TokenFactor(gL, gR);
    WHILE (sym = 1) OR (sym = 2) OR (sym = 28) OR (sym = 32) OR (sym = 34) DO BEGIN
      _TokenFactor(gL2, gR2);
      CRTable.ConcatSeq(gL, gR, gL2, gR2);
    END;
    IF (sym = 37) THEN BEGIN
      Get;
      Expect(28);
      _TokenExpr(gL2, gR2);
      SetCtx(gL2); CRTable.ConcatSeq(gL, gR, gL2, gR2);
      Expect(29);
    END;
  END;

PROCEDURE _Factor (VAR gL, gR: INTEGER);
  VAR
    sp, kind:    INTEGER;
    name:        CRTable.Name;
    gn:          CRTable.GraphNode;
    sn:          CRTable.SymbolNode;
    oneSet:      CRTable.CRTSet;
    undef, weak: BOOLEAN;
    pos:         CRTable.Position;
  BEGIN
    gL :=0; gR := 0; weak := FALSE;
    CASE sym OF
      1, 2, 31 : BEGIN
        IF (sym = 31) THEN BEGIN
          Get;
          weak := TRUE;
        END;
        _Symbol(name, kind);
        sp := CRTable.FindSym(name); undef := sp = CRTable.noSym;
        IF undef THEN
          IF kind = ident
            THEN  (* forward nt *)
              sp := CRTable.NewSym(CRTable.nt, name, 0)
            ELSE IF CRTable.genScanner THEN
              BEGIN
                sp := CRTable.NewSym(CRTable.t, name, CRS.line);
                MatchLiteral(sp)
              END
            ELSE BEGIN (* undefined string in production *)
              SemError(106); sp := 0
            END;
        CRTable.GetSym(sp, sn);
        IF (sn.typ <> CRTable.t) AND (sn.typ <> CRTable.nt) THEN SemError(104);
        IF weak THEN
          IF sn.typ = CRTable.t
            THEN sn.typ := CRTable.wt
            ELSE SemError(123);
        gL := CRTable.NewNode(sn.typ, sp, CRS.line); gR := gL;
        IF (sym = 38) OR (sym = 40) THEN BEGIN
          _Attribs(pos);
          CRTable.GetNode(gL, gn); gn.pos := pos;
          CRTable.PutNode(gL, gn);
          CRTable.GetSym(sp, sn);
          IF sn.typ <> CRTable.nt THEN SemError(103);
          IF undef THEN
            BEGIN sn.attrPos := pos; CRTable.PutSym(sp, sn) END
            ELSE IF sn.attrPos.beg < 0 THEN SemError(105);
        END ELSE IF _In(symSet[1], sym) THEN BEGIN
          CRTable.GetSym(sp, sn);
          IF sn.attrPos.beg >= 0 THEN SemError(105);
        END ELSE BEGIN SynError(46);
        END;
        END;
      28 : BEGIN
        Get;
        _Expression(gL, gR);
        Expect(29);
        END;
      32 : BEGIN
        Get;
        _Expression(gL, gR);
        Expect(33);
        CRTable.MakeOption(gL, gR);
        END;
      34 : BEGIN
        Get;
        _Expression(gL, gR);
        Expect(35);
        CRTable.MakeIteration(gL, gR);
        END;
      42 : BEGIN
        _SemText(pos);
        gL := CRTable.NewNode(CRTable.sem, 0, 0); gR := gL;
        CRTable.GetNode(gL, gn);
        gn.pos := pos;
        CRTable.PutNode(gL, gn);
        END;
      26 : BEGIN
        Get;
        Sets.Fill(oneSet); Sets.Excl(oneSet, CRTable.eofSy);
        gL := CRTable.NewNode(CRTable.any, CRTable.NewSet(oneSet), 0); gR := gL;
        END;
      36 : BEGIN
        Get;
        gL := CRTable.NewNode(CRTable.sync, 0, 0); gR := gL;
        END;
    ELSE BEGIN SynError(47);
        END;
    END;
  END;

PROCEDURE _Term (VAR gL, gR: INTEGER);
  VAR
    gL2, gR2: INTEGER;
  BEGIN
    gL := 0; gR := 0;
    IF _In(symSet[2], sym) THEN BEGIN
      _Factor(gL, gR);
      WHILE _In(symSet[2], sym) DO BEGIN
        _Factor(gL2, gR2);
        CRTable.ConcatSeq(gL, gR, gL2, gR2);
      END;
    END ELSE IF (sym = 11) OR (sym = 29) OR (sym = 30) OR (sym = 33) OR (sym = 35) THEN BEGIN
      gL := CRTable.NewNode(CRTable.eps, 0, 0); gR := gL;
    END ELSE BEGIN SynError(48);
    END;
  END;

PROCEDURE _Symbol (VAR name: CRTable.Name; VAR kind: INTEGER);
  VAR
    myName: STRING;
  BEGIN
    IF (sym = 1) THEN BEGIN
      _Ident(name);
      kind := ident;
    END ELSE IF (sym = 2) THEN BEGIN
      Get;
      CRS.GetName(CRS.pos, CRS.len, myName);
      kind := stringSym;
      FixString(myName, CRS.len);
      name := myName;
    END ELSE BEGIN SynError(49);
    END;
  END;

PROCEDURE _SingleChar (VAR n: INTEGER);
  VAR
    i: INTEGER;
    s: STRING;
  BEGIN
    Expect(27);
    Expect(28);
    Expect(4);
    CRS.GetName(CRS.pos, CRS.len, s);
    Val(s, n, i);
    IF n > 255 THEN BEGIN SemError(118); n := n MOD 256 END;
    IF CRTable.ignoreCase THEN n := ORD(UpCase(CHR(n)));
    Expect(29);
  END;

PROCEDURE _SimSet (VAR oneSet: CRTable.CRTSet);
  VAR
    i, n1, n2: INTEGER;