crtable.pas

一个Pascal语言分析器

PROCEDURE GetSet (nr : INTEGER; VAR s : CRTSet);
  BEGIN
    s := cset[nr]
  END;

(* PrintSymbolTable     Print symbol table
----------------------------------------------------------------------*) 

PROCEDURE PrintSymbolTable;
  VAR
    i : INTEGER;

  PROCEDURE WriteBool (b : BOOLEAN);
    BEGIN
      IF b
        THEN Write(CRS.lst, '  TRUE ')
        ELSE Write(CRS.lst, '  FALSE');
    END;

  PROCEDURE WriteTyp1 (typ : INTEGER);
    BEGIN
      CASE typ OF
        unknown : Write(CRS.lst, ' unknown');
        t :       Write(CRS.lst, ' t      ');
        pr :      Write(CRS.lst, ' pr     ');
        nt :      Write(CRS.lst, ' nt     ');
      END;
    END;

  BEGIN (* PrintSymbolTable *)
    WriteLn(CRS.lst, 'SymbolTable:');
    WriteLn(CRS.lst);
    Write(CRS.lst, 'nr    definition                ');
    IF (*CRTable.*) ddt['N'] OR (*CRTable.*) symNames THEN
      Write(CRS.lst, 'constant        ');
    WriteLn(CRS.lst, 'typ    hasAttrs struct del  line');
    WriteLn(CRS.lst);
    i := 0;
    WHILE i < maxSymbols DO BEGIN
      Write(CRS.lst, i:3);
      Write(CRS.lst, ' ':3);
      WriteText(CRS.lst, st^[i].name, 26);
      IF (*CRTable.*) ddt['N'] OR (*CRTable.*) symNames THEN
        IF i <= maxT
          THEN WriteText(CRS.lst, st^[i].constant, 16)
          ELSE Write(CRS.lst, ' ':16);
      WriteTyp1(st^[i].typ);
      WriteBool(st^[i].attrPos.beg >= 0);
      Write(CRS.lst, st^[i].struct:5);
      WriteBool(st^[i].deletable);
      WriteLn(CRS.lst, st^[i].line:5);
      IF i = maxT THEN i := firstNt ELSE INC(i);
    END;
    WriteLn(CRS.lst);
    WriteLn(CRS.lst);
  END;

(* NewClass             Define a new character class
----------------------------------------------------------------------*) 

FUNCTION NewClass (n : Name; cset : CRTSet) : INTEGER;
  BEGIN
    INC(maxC);
    IF maxC > maxClasses THEN Restriction(4, maxClasses);
    IF n[1] = '#' THEN
      BEGIN
        n[2] := CHR(ORD('A') + dummyName);
        INC(dummyName)
      END;
    chClass[maxC].name := n; chClass[maxC].cset := NewSet(cset);
    NewClass := maxC
  END;

(* ClassWithName        Return index of class with name n
----------------------------------------------------------------------*) 

FUNCTION ClassWithName (n : Name) : INTEGER;
  VAR
    i : INTEGER;
  BEGIN
    i := maxC;
    WHILE (i >= 0) AND (chClass[i].name <> n) DO DEC(i);
    ClassWithName := i
  END;

(* ClassWithSet        Return index of class with the specified set
----------------------------------------------------------------------*) 

FUNCTION ClassWithSet (s : CRTSet) : INTEGER;
  VAR
    i : INTEGER;
  BEGIN
    i := maxC;
    WHILE (i >= 0) AND NOT Sets.Equal(cset[chClass[i].cset], s) DO DEC(i);
    ClassWithSet := i
  END;

(* GetClass             Return character class n
----------------------------------------------------------------------*) 

PROCEDURE GetClass (n : INTEGER; VAR s : CRTSet);
  BEGIN
    GetSet(chClass[n].cset, s);
  END;

(* GetClassName         Get the name of class n
----------------------------------------------------------------------*) 

PROCEDURE GetClassName (n : INTEGER; VAR name : Name);
  BEGIN
    name := chClass[n].name
  END;

(* XRef                 Produce a cross reference listing of all symbols
----------------------------------------------------------------------*) 

PROCEDURE XRef;
  CONST
    maxLineLen = 80;
  TYPE
    ListPtr = ^ ListNode;
    ListNode = 
      RECORD
        next : ListPtr;
        line : INTEGER;
      END;
    ListHdr = 
      RECORD
        name : Name;
        lptr : ListPtr;
      END;
  VAR
    gn : GraphNode;
    col, i : INTEGER;
    l, p, q : ListPtr;
    sn : SymbolNode;
    xList : ARRAY [0 .. maxSymbols] OF ListHdr;
  BEGIN (* XRef *)
    IF maxT <= 0 THEN EXIT;
    MovePragmas;
    (* initialize cross reference list *);
    i := 0;
    WHILE i <= lastNt DO BEGIN (* for all symbols *)
      GetSym(i, sn);
      xList[i].name := sn.name; xList[i].lptr := NIL;
      IF i = maxP THEN i := firstNt ELSE INC(i)
    END;
    (* search lines where symbol has been referenced *) 
    i := 1;
    WHILE i <= nNodes DO BEGIN (* for all graph nodes *)
      GetNode(i, gn);
      IF (gn.typ = t) OR (gn.typ = wt) OR (gn.typ = nt) THEN
        BEGIN
          NEW(l);
          l^.next := xList[gn.p1].lptr; l^.line := gn.line;
          xList[gn.p1].lptr := l
        END;
      INC(i);
    END;
    (* search lines where symbol has been defined and insert in order *) 
    i := 1;
    WHILE i <= lastNt DO BEGIN (*for all symbols*)
      GetSym(i, sn);
      p := xList[i].lptr;
      q := NIL;
      WHILE (p <> NIL) AND (p^.line > sn.line) DO BEGIN
        q := p; p := p^.next
      END;
      NEW(l);
      l^.next := p; l^.line :=  -sn.line;
      IF q <> NIL THEN q^.next := l ELSE xList[i].lptr := l;
      IF i = maxP THEN i := firstNt ELSE INC(i)
    END;
    (* print cross reference listing *) 
    Write(CRS.lst, 'Cross reference list:');
    WriteLn(CRS.lst);
    WriteLn(CRS.lst);
    Write(CRS.lst, 'Terminals:');
    WriteLn(CRS.lst);
    Write(CRS.lst, '  0  EOF');
    WriteLn(CRS.lst);
    i := 1;
    WHILE i <= lastNt DO BEGIN (* for all symbols *)
      IF i = maxT
        THEN
          BEGIN WriteLn(CRS.lst); WriteLn(CRS.lst, 'Pragmas:'); END
        ELSE
          BEGIN
            Write(CRS.lst, i:3, '  ');
            WriteText(CRS.lst, xList[i].name, 25);
            l := xList[i].lptr;
            col := 35;
            WHILE l <> NIL DO BEGIN
              IF col + 5 > maxLineLen THEN
                BEGIN WriteLn(CRS.lst); Write(CRS.lst, ' ':30); col := 35 END;
              IF l^.line = 0
                THEN Write(CRS.lst, 'undef')
                ELSE Write(CRS.lst, l^.line: 5);
              INC(col, 5);
              l := l^.next
            END;
            WriteLn(CRS.lst);
          END;
      IF i = maxP
        THEN
          BEGIN
            WriteLn(CRS.lst); WriteLn(CRS.lst, 'Nonterminals:'); i := firstNt
          END
        ELSE INC(i)
    END;
    WriteLn(CRS.lst);
    WriteLn(CRS.lst);
  END;

(* NewNode              Generate a new graph node and return its index gp
----------------------------------------------------------------------*) 

FUNCTION NewNode (typ, p1, line : INTEGER) : INTEGER;
  BEGIN
    INC(nNodes);
    IF nNodes > maxNodes THEN Restriction(1, maxNodes);
    gn^[nNodes].typ := typ; gn^[nNodes].next := 0;
    gn^[nNodes].p1 := p1;   gn^[nNodes].p2 := 0;
    gn^[nNodes].pos.beg :=  -1;
    gn^[nNodes].pos.len := 0; gn^[nNodes].pos.col := 0;
    gn^[nNodes].line := line;
    NewNode := nNodes;
  END;

(* CompleteGraph        Set right ends of graph gp to 0
----------------------------------------------------------------------*) 

PROCEDURE CompleteGraph (gp : INTEGER);
  VAR
    p : INTEGER;
  BEGIN
    WHILE gp <> 0 DO BEGIN
      p := gn^[gp].next; gn^[gp].next := 0; gp := p
    END
  END;

(* ConcatAlt            Make (gL2, gR2) an alternative of (gL1, gR1)
----------------------------------------------------------------------*) 

PROCEDURE ConcatAlt (VAR gL1, gR1 : INTEGER; gL2, gR2 : INTEGER);
  VAR
    p : INTEGER;
  BEGIN
    gL2 := NewNode(alt, gL2, 0);
    p := gL1; WHILE gn^[p].p2 <> 0 DO p := gn^[p].p2; gn^[p].p2 := gL2;
    p := gR1; WHILE gn^[p].next <> 0 DO p := gn^[p].next; gn^[p].next := gR2
  END;

(* ConcatSeq            Make (gL2, gR2) a successor of (gL1, gR1)
----------------------------------------------------------------------*) 

PROCEDURE ConcatSeq (VAR gL1, gR1 : INTEGER; gL2, gR2 : INTEGER);
  VAR
    p, q : INTEGER;
  BEGIN
    p := gn^[gR1].next; gn^[gR1].next := gL2; (*head node*)
    WHILE p <> 0 DO BEGIN (*substructure*)
      q := gn^[p].next; gn^[p].next :=  - gL2; p := q
    END;
    gR1 := gR2
  END;

(* MakeFirstAlt         Generate alt-node with (gL,gR) as only alternative
----------------------------------------------------------------------*) 

PROCEDURE MakeFirstAlt (VAR gL, gR : INTEGER);
  BEGIN
    gL := NewNode(alt, gL, 0); gn^[gL].next := gR; gR := gL
  END;

(* MakeIteration        Enclose (gL, gR) into iteration node
----------------------------------------------------------------------*) 

PROCEDURE MakeIteration (VAR gL, gR : INTEGER);
  VAR
    p, q : INTEGER;
  BEGIN
    gL := NewNode(iter, gL, 0); p := gR; gR := gL;
    WHILE p <> 0 DO BEGIN
      q := gn^[p].next; gn^[p].next :=  - gL; p := q
    END
  END;

(* MakeOption           Enclose (gL, gR) into option node
----------------------------------------------------------------------*) 

PROCEDURE MakeOption (VAR gL, gR : INTEGER);
  BEGIN
    gL := NewNode(opt, gL, 0); gn^[gL].next := gR; gR := gL
  END;

(* StrToGraph           Generate node chain from characters in s
----------------------------------------------------------------------*) 

PROCEDURE StrToGraph (s : STRING; VAR gL, gR : INTEGER);
  VAR
    i, len : INTEGER;
  BEGIN
    gR := 0; i := 2; len := Length(s); (*strip quotes*)
    WHILE i < len DO BEGIN
      gn^[gR].next := NewNode(chart, ORD(s[i]), 0); gR := gn^[gR].next;
      INC(i)
    END;
    gL := gn^[0].next; gn^[0].next := 0
  END;

(* DelGraph             Check if graph starting with index gp is deletable
----------------------------------------------------------------------*) 

FUNCTION DelGraph (gp : INTEGER) : BOOLEAN;
  VAR
    gn : GraphNode;
  BEGIN
    IF gp = 0 THEN BEGIN DelGraph := TRUE; EXIT END; (*end of graph found*)
    GetNode(gp, gn);
    DelGraph := DelNode(gn) AND DelGraph(ABS(gn.next));
  END;

(* DelNode              Check if graph node gn is deletable
----------------------------------------------------------------------*) 

FUNCTION DelNode (gn : GraphNode) : BOOLEAN;
  VAR
    sn : SymbolNode;

  FUNCTION DelAlt (gp : INTEGER) : BOOLEAN;
    VAR
      gn : GraphNode;
    BEGIN
      IF gp <= 0 THEN BEGIN DelAlt := TRUE; EXIT END; (*end of graph found*)
      GetNode(gp, gn);
      DelAlt := DelNode(gn) AND DelAlt(gn.next);
    END;

  BEGIN
    IF gn.typ = nt
      THEN
        BEGIN GetSym(gn.p1, sn); DelNode := sn.deletable END
      ELSE IF gn.typ = alt THEN
        DelNode := DelAlt(gn.p1) OR (gn.p2 <> 0) AND DelAlt(gn.p2)
      ELSE
        DelNode := (gn.typ = eps) OR (gn.typ = iter) OR (gn.typ = opt) OR (gn.typ = sem) OR (gn.typ = sync)
  END;

(* PrintGraph           Print the graph
----------------------------------------------------------------------*) 

PROCEDURE PrintGraph;
  VAR
    i : INTEGER;

  PROCEDURE WriteTyp2 (typ : INTEGER);
    BEGIN
      CASE typ OF
        nt   : Write(CRS.lst, 'nt  ');
        t    : Write(CRS.lst, 't   ');
        wt   : Write(CRS.lst, 'wt  ');
        any  : Write(CRS.lst, 'any ');
        eps  : Write(CRS.lst, 'eps ');
        sem  : Write(CRS.lst, 'sem ');
        sync : Write(CRS.lst, 'sync');
        alt  : Write(CRS.lst, 'alt ');
        iter : Write(CRS.lst, 'iter');
        opt  : Write(CRS.lst, 'opt ');
        ELSE Write(CRS.lst, '--- ')
      END;
    END;

  BEGIN (* PrintGraph *)
    WriteLn(CRS.lst, 'GraphList:');
    WriteLn(CRS.lst);
    Write(CRS.lst, ' nr   typ    next     p1     p2   line');
    (* useful for debugging - PDT *) 
    Write(CRS.lst, ' posbeg poslen poscol');
    (* *) 
    WriteLn(CRS.lst);
    WriteLn(CRS.lst);
    i := 0;
    WHILE i <= nNodes DO BEGIN
      Write(CRS.lst, i:3);
      Write(CRS.lst, '   ');
      WriteTyp2(gn^[i].typ);
      Write(CRS.lst, gn^[i].next:7);
      Write(CRS.lst, gn^[i].p1:7);
      Write(CRS.lst, gn^[i].p2:7);
      Write(CRS.lst, gn^[i].line:7);
      (* useful for debugging - PDT *) 
      Write(CRS.lst, gn^[i].pos.beg:7);
      Write(CRS.lst, gn^[i].pos.len:7);
      Write(CRS.lst, gn^[i].pos.col:7);
      (*  *) 
      WriteLn(CRS.lst);
      INC(i);
    END;
    WriteLn(CRS.lst);
    WriteLn(CRS.lst);
  END;

(* FindCircularProductions      Test grammar for circular derivations
----------------------------------------------------------------------*) 

PROCEDURE FindCircularProductions (VAR ok : BOOLEAN);
  TYPE
    ListEntry = 
      RECORD
        left : INTEGER;
        right : INTEGER;
        deleted : BOOLEAN;
      END;
  VAR
    changed, onLeftSide, onRightSide : BOOLEAN;
    i, j, listLength : INTEGER;
    list : ARRAY [0 .. maxList] OF ListEntry;
    singles : MarkList;
    sn : SymbolNode;

  PROCEDURE GetSingles (gp : INTEGER; VAR singles : MarkList);
    VAR
      gn : GraphNode;
    BEGIN
      IF gp <= 0 THEN EXIT;
      (* end of graph found *) 
      GetNode(gp, gn);
      IF gn.typ = nt
        THEN
          IF DelGraph(ABS(gn.next)) THEN InclMarkList(singles, gn.p1)
        ELSE IF (gn.typ = alt) OR (gn.typ = iter) OR (gn.typ = opt) THEN
          IF DelGraph(ABS(gn.next)) THEN
            BEGIN
              GetSingles(gn.p1, singles);
              IF gn.typ = alt THEN GetSingles(gn.p2, singles)
            END;
      IF DelNode(gn) THEN GetSingles(gn.next, singles)
    END;

  BEGIN (* FindCircularProductions *)
    i := firstNt;
    listLength := 0;
    WHILE i <= lastNt DO BEGIN (* for all nonterminals i *)
      ClearMarkList(singles);
      GetSym(i, sn);
      GetSingles(sn.struct, singles);
      (* get nt's j such that i-->j *) 
      j := firstNt;
      WHILE j <= lastNt DO BEGIN (* for all nonterminals j *)
        IF IsInMarkList(singles, j) THEN
          BEGIN
            list[listLength].left := i;
            list[listLength].right := j;