crtable.pas

一个Pascal语言分析器

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

FUNCTION FindSym (n : Name) : INTEGER;
  VAR
    i : INTEGER;

  BEGIN
    i := 0;
    (*search in terminal list*) 
    WHILE (i <= maxT) AND (st^[i].name <> n) DO INC(i);
    IF i <= maxT THEN BEGIN FindSym := i; EXIT END;
    i := firstNt;
    (*search in nonterminal/pragma list*) 
    WHILE (i < maxSymbols) AND (st^[i].name <> n) DO INC(i);
    IF i < maxSymbols THEN FindSym := i ELSE FindSym := noSym
  END;

(* PrintSet             Print set s
----------------------------------------------------------------------*) 

PROCEDURE PrintSet (VAR f : TEXT; s : BITARRAY; indent : INTEGER);
  CONST
    maxLineLen = 80;
  VAR
    col, i, len : INTEGER;
    empty : BOOLEAN;
    sn : SymbolNode;
  BEGIN
    i := 0;
    col := indent;
    empty := TRUE;
    WHILE i <= maxT DO BEGIN
      IF Sets.IsIn(s, i) THEN
        BEGIN
          empty := FALSE;
          GetSym(i, sn);
          len := Length(sn.name);
          IF col + len + 2 > maxLineLen THEN
            BEGIN
              WriteLn(f); col := 1;
              WHILE col < indent DO BEGIN Write(f, ' '); INC(col) END
            END;
          Write(f, sn.name, '  ');
          INC(col, len + 2)
        END;
      INC(i)
    END;
    IF empty THEN Write(f, '-- empty set --');
    WriteLn(f)
  END;

(* NewSet               Stores s as a new set and return its index
----------------------------------------------------------------------*) 

FUNCTION NewSet (s : CRTSet) : INTEGER;
(*any-set computation requires not to search if s is already in set*) 
  BEGIN
    INC(maxSet);
    IF maxSet > maxSetNr THEN Restriction(3, maxSetNr);
    cset[maxSet] := s;
    NewSet := maxSet
  END;

(* CompFirstSet         Compute first symbols of (sub) graph at gp
----------------------------------------------------------------------*) 

PROCEDURE CompFirstSet (gp : INTEGER; VAR fs : CRTSet);
  VAR
    visited : MarkList;

  PROCEDURE CompFirst (gp : INTEGER; VAR fs : CRTSet);
    VAR
      s : CRTSet;
      gn : GraphNode;
      sn : SymbolNode;
    BEGIN
      Sets.Clear(fs);
      WHILE (gp <> 0) AND NOT IsInMarkList(visited, gp) DO BEGIN
        GetNode(gp, gn);
        InclMarkList(visited, gp);
        CASE gn.typ OF
          nt : 
            BEGIN
              IF first[gn.p1 - firstNt].ready
                THEN Sets.Unite(fs, first[gn.p1 - firstNt].ts)
                ELSE
                  BEGIN
                    GetSym(gn.p1, sn); CompFirst(sn.struct, s);
                    Sets.Unite(fs, s);
                  END;
            END;
          t, wt : 
            BEGIN Sets.Incl(fs, gn.p1) END;
          any :
            BEGIN Sets.Unite(fs, cset[gn.p1]) END;
          alt, iter, opt : 
            BEGIN
              CompFirst(gn.p1, s);
              Sets.Unite(fs, s);
              IF gn.typ = alt THEN
                BEGIN CompFirst(gn.p2, s); Sets.Unite(fs, s) END
            END;
          ELSE
          (* eps, sem, sync, ind: nothing *) 
        END;
        IF NOT DelNode(gn) THEN EXIT;
        gp := ABS(gn.next)
      END
    END;

  BEGIN (* ComputeFirstSet *)
    ClearMarkList(visited);
    CompFirst(gp, fs);
    IF ddt['I'] THEN
      BEGIN
        WriteLn; WriteLn('ComputeFirstSet: gp = ', gp:1);
        PrintSet(output, fs, 0);
      END;
  END;

(* CompFirstSets        Compute first symbols of nonterminals
----------------------------------------------------------------------*) 

PROCEDURE CompFirstSets;
  VAR
    i : INTEGER;
    sn : SymbolNode;
  BEGIN
    i := firstNt;
    WHILE i <= lastNt DO BEGIN
      first[i - firstNt].ready := FALSE;
      INC(i)
    END;
    i := firstNt;
    WHILE i <= lastNt DO BEGIN (* for all nonterminals *)
      GetSym(i, sn);
      CompFirstSet(sn.struct, first[i - firstNt].ts);
      first[i - firstNt].ready := TRUE;
      INC(i)
    END;
  END;

(* CompExpected     Compute symbols expected at location gp in Symbol sp
----------------------------------------------------------------------*) 

PROCEDURE CompExpected (gp, sp : INTEGER; VAR exp : CRTSet);
  BEGIN
    CompFirstSet(gp, exp);
    IF DelGraph(gp) THEN Sets.Unite(exp, follow[sp - firstNt].ts)
  END;

(* CompFollowSets       Get follow symbols of nonterminals
----------------------------------------------------------------------*) 

PROCEDURE CompFollowSets;
  VAR
    sn : SymbolNode;
    curSy, i, size : INTEGER;
    visited : MarkList;

  PROCEDURE CompFol (gp : INTEGER);
    VAR
      s : CRTSet;
      gn : GraphNode;
    BEGIN
      WHILE (gp > 0) AND NOT IsInMarkList(visited, gp) DO BEGIN
        GetNode(gp, gn); InclMarkList(visited, gp);
        IF gn.typ = nt
          THEN
            BEGIN
              CompFirstSet(ABS(gn.next), s);
              Sets.Unite(follow[gn.p1 - firstNt].ts, s);
              IF DelGraph(ABS(gn.next)) THEN
                Sets.Incl(follow[gn.p1 - firstNt].nts, curSy - firstNt)
            END
          ELSE IF (gn.typ = opt) OR (gn.typ = iter) THEN CompFol(gn.p1)
          ELSE IF gn.typ = alt THEN BEGIN CompFol(gn.p1); CompFol(gn.p2) END;
        gp := gn.next
      END
    END;

  PROCEDURE Complete (i : INTEGER);
    VAR
      j : INTEGER;
    BEGIN
      IF IsInMarkList(visited, i) THEN EXIT;
      InclMarkList(visited, i);
      j := 0;
      WHILE j <= lastNt - firstNt DO BEGIN (* for all nonterminals *)
        IF Sets.IsIn(follow[i].nts, j) THEN
          BEGIN
            Complete(j);
            Sets.Unite(follow[i].ts, follow[j].ts);
            (* fix 1.42 *) IF i = curSy THEN Sets.Excl(follow[i].nts, j)
          END;
        INC(j)
      END;
    END;

  BEGIN (* GetFollowSets *)
    size := (lastNt - firstNt + 2) DIV Sets.size;
    curSy := firstNt;
    WHILE curSy <= lastNt DO BEGIN
      Sets.Clear(follow[curSy - firstNt].ts);
      i := 0;
      WHILE i <= size DO BEGIN
        follow[curSy - firstNt].nts[i] := []; INC(i)
      END;
      INC(curSy)
    END;

    ClearMarkList(visited);
    curSy := firstNt;         (*get direct successors of nonterminals*)
    WHILE curSy <= lastNt DO BEGIN
      GetSym(curSy, sn); CompFol(sn.struct);
      INC(curSy)
    END;

    curSy := 0;               (*add indirect successors to follow.ts*)
    WHILE curSy <= lastNt - firstNt DO BEGIN
      ClearMarkList(visited); Complete(curSy);
      INC(curSy);
    END;
  END;

(* CompAnySets          Compute all any-sets
----------------------------------------------------------------------*) 

PROCEDURE CompAnySets;
  VAR
    curSy : INTEGER;
    sn : SymbolNode;

  FUNCTION LeadingAny (gp : INTEGER; VAR a : GraphNode) : BOOLEAN;
    VAR
      gn : GraphNode;
    BEGIN
      IF gp <= 0 THEN BEGIN LeadingAny := FALSE; EXIT END;
      GetNode(gp, gn);
      IF (gn.typ = any)
        THEN BEGIN a := gn; LeadingAny := TRUE END
        ELSE
          LeadingAny := (gn.typ = alt) AND (LeadingAny(gn.p1, a)
          OR LeadingAny(gn.p2, a)) OR ((gn.typ = opt)
          OR (gn.typ = iter)) AND LeadingAny(gn.p1, a)
          OR DelNode(gn) AND LeadingAny(gn.next, a)
    END;

  PROCEDURE FindAS (gp : INTEGER);
    VAR
      gn, gn2, a : GraphNode;
      s1, s2 : CRTSet;
      p : INTEGER;
    BEGIN
      WHILE gp > 0 DO BEGIN
        GetNode(gp, gn);
        IF (gn.typ = opt) OR (gn.typ = iter)
          THEN
            BEGIN
              FindAS(gn.p1);
              IF LeadingAny(gn.p1, a) THEN
                BEGIN
                  CompExpected(ABS(gn.next), curSy, s1);
                  Sets.Differ(cset[a.p1], s1)
                END
            END
          ELSE IF gn.typ = alt THEN
            BEGIN
              p := gp;
              Sets.Clear(s1);
              WHILE p <> 0 DO BEGIN
                GetNode(p, gn2);
                FindAS(gn2.p1);
                IF LeadingAny(gn2.p1, a)
                  THEN
                    BEGIN
                      CompExpected(gn2.p2, curSy, s2);
                      Sets.Unite(s2, s1);
                      Sets.Differ(cset[a.p1], s2)
                    END
                  ELSE
                    BEGIN
                      CompFirstSet(gn2.p1, s2);
                      Sets.Unite(s1, s2)
                    END;
                p := gn2.p2
              END
            END;
        gp := gn.next
      END
    END;

  BEGIN
    curSy := firstNt;
    WHILE curSy <= lastNt DO BEGIN
    (* for all nonterminals *) 
      GetSym(curSy, sn);
      FindAS(sn.struct);
      INC(curSy)
    END
  END;

(* CompSyncSets         Compute follow symbols of sync-nodes
----------------------------------------------------------------------*) 

PROCEDURE CompSyncSets;
  VAR
    curSy : INTEGER;
    sn : SymbolNode;
    visited : MarkList;

  PROCEDURE CompSync (gp : INTEGER);
    VAR
      s : CRTSet;
      gn : GraphNode;
    BEGIN
      WHILE (gp > 0) AND NOT IsInMarkList(visited, gp) DO BEGIN
        GetNode(gp, gn); InclMarkList(visited, gp);
        IF gn.typ = sync
          THEN
            BEGIN
              CompExpected(ABS(gn.next), curSy, s);
              Sets.Incl(s, eofSy);
              Sets.Unite(cset[0], s);
              gn.p1 := NewSet(s);
              PutNode(gp, gn)
            END
          ELSE IF gn.typ = alt THEN
            BEGIN
              CompSync(gn.p1);
              CompSync(gn.p2)
            END
          ELSE IF (gn.typ = opt) OR (gn.typ = iter) THEN
            BEGIN
              CompSync(gn.p1)
            END;
        gp := gn.next
      END
    END;

  BEGIN
    curSy := firstNt;
    ClearMarkList(visited);
    WHILE curSy <= lastNt DO BEGIN
      GetSym(curSy, sn);
      CompSync(sn.struct);
      INC(curSy);
    END
  END;

(* CompDeletableSymbols Compute all deletable symbols and print them
----------------------------------------------------------------------*) 

PROCEDURE CompDeletableSymbols;
  VAR
    changed, none : BOOLEAN;
    i : INTEGER;
    sn : SymbolNode;
  BEGIN
    REPEAT
      changed := FALSE;
      i := firstNt;
      WHILE i <= lastNt DO BEGIN (*for all nonterminals*)
        GetSym(i, sn);
        IF NOT sn.deletable AND DelGraph(sn.struct) THEN
          BEGIN
            sn.deletable := TRUE;
            PutSym(i, sn);
            changed := TRUE
          END;
        INC(i)
      END;
    UNTIL NOT changed;
    Write(CRS.lst, 'Deletable symbols:');
    i := firstNt;
    none := TRUE;
    WHILE i <= lastNt DO BEGIN
      GetSym(i, sn);
      IF sn.deletable THEN
        BEGIN
          none := FALSE;
          WriteLn(CRS.lst);
          Write(CRS.lst, '     ', sn.name)
        END;
      INC(i);
    END;
    IF none THEN Write(CRS.lst, '        -- none --');
    WriteLn(CRS.lst);
  END;

(* CompSymbolSets       Get first-sets, follow-sets, and sync-set
----------------------------------------------------------------------*) 

PROCEDURE CompSymbolSets;
  VAR
    i : INTEGER;
    sn : SymbolNode;
  BEGIN
    MovePragmas;
    CompDeletableSymbols;
    CompFirstSets;
    CompFollowSets;
    CompAnySets;
    CompSyncSets;
    IF ddt['F'] THEN
      BEGIN
        i := firstNt;
        WriteLn(CRS.lst, 'List of first & follow symbols:');
        WriteLn(CRS.lst);
        WHILE i <= lastNt DO BEGIN (* for all nonterminals *)
          GetSym(i, sn);
          WriteLn(CRS.lst, sn.name);
          Write(CRS.lst, 'first:   ');
          PrintSet(CRS.lst, first[i - firstNt].ts, 10);
          Write(CRS.lst, 'follow:  ');
          PrintSet(CRS.lst, follow[i - firstNt].ts, 10);
          WriteLn(CRS.lst);
          INC(i);
        END;
        i := 0;
        WriteLn(CRS.lst);
        WriteLn(CRS.lst);
        Write(CRS.lst, 'List of sets (ANY, SYNC): ');
        IF maxSet < 0
          THEN Write(CRS.lst, '        -- none --')
          ELSE WriteLn(CRS.lst);
        WHILE i <= maxSet DO BEGIN
          Write(CRS.lst, '     set[', i:2, '] = ');
          PrintSet(CRS.lst, cset[i], 16);
          INC(i)
        END;
        WriteLn(CRS.lst);
      END;
  END;

(* GetFirstSet          Get precomputed first-set for nonterminal sp
----------------------------------------------------------------------*) 

PROCEDURE GetFirstSet (sp : INTEGER; VAR s : CRTSet);
  BEGIN
    s := first[sp - firstNt].ts
  END;

(* GetFollowSet         Get precomputed follow-set for nonterminal snix
----------------------------------------------------------------------*) 

PROCEDURE GetFollowSet (sp : INTEGER; VAR s : CRTSet);
  BEGIN
    s := follow[sp - firstNt].ts
  END;

(* GetSet               Get set with index nr
----------------------------------------------------------------------*)