crt.mod

来自「一个Modula-2语言分析器」· MOD 代码 · 共 1,434 行 · 第 1/4 页

IMPLEMENTATION MODULE CRT;

(* CRT   Table Handler
   ===   =============

  (1) handles a symbol table for terminals, pragmas and nonterminals
  (2) handles a table for character classes (for scanner generation)
  (3) handles a top-down graph for productions
  (4) computes various sets (start symbols, followers, any sets)
  (5) contains procedures for grammar tests

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

IMPORT CRS, FileIO, Sets, Storage;
IMPORT SYSTEM (* for TSIZE only *);

CONST
  maxSetNr   = 256;  (* max. number of symbol sets *)
(* moved next declaration to def module Fri  08-20-1993, and was 150
  maxClasses = 250;  (* max. number of character classes *) *)
  maxNames   = 100;  (* max. number of declared token names *)

TYPE
  FirstSets   = ARRAY [0 .. maxNt] OF RECORD
    ts:    Set;      (* terminal symbols *)
    ready: BOOLEAN;  (* TRUE = ts is complete *)
  END;
  FollowSets  = ARRAY [0 .. maxNt] OF RECORD
    ts:  Set;        (* terminal symbols *)
    nts: Set;        (* nts whose start set is to be included in ts *)
  END;
  CharClass   = RECORD
    name: Name;      (* class name *)
    set:  INTEGER    (* ptr to set representing the class *)
  END;
  SymbolTable = ARRAY [0 .. maxSymbols] OF SymbolNode;
  ClassTable  = ARRAY [0 .. maxClasses] OF CharClass;
  GraphList   = ARRAY [0 .. maxNodes] OF GraphNode;
  SymbolSet   = ARRAY [0 .. maxSetNr] OF Set;
  NameTable   = ARRAY [1 .. maxNames] OF RECORD name, definition: Name END;

VAR
  (* moved symbol table to the heap Fri  08-20-1993 to allow larger one *)
  st:        POINTER TO SymbolTable; (* symbol table for terminals,
                                         pragmas, and nonterminals *)
  gn:        POINTER TO GraphList; (* top-down graph *)
  tt:        NameTable;   (* table of token name declarations *)
  first:     FirstSets;   (* first[i]  = first symbols of st[i+firstNt] *)
  follow:    FollowSets;  (* follow[i] = followers of st[i+firstNt] *)
  chClass:   ClassTable;  (* character classes *)
  set:       SymbolSet;   (* set[0] = all SYNC symbols *)
  maxSet:    INTEGER;     (* index of last symbol set *)
  lastName,
  dummyName: CARDINAL;    (* for unnamed character classes *)
  ch:        CHAR;


(* Restriction          Implementation restriction
----------------------------------------------------------------------*)
PROCEDURE Restriction (n, limit: INTEGER);
(* Fri  08-20-1993 extended *)
  BEGIN
    FileIO.WriteLn(FileIO.StdOut);
    FileIO.WriteString(FileIO.StdOut, "Restriction  ");
    FileIO.WriteInt(FileIO.StdOut, n, 1); FileIO.WriteLn(FileIO.StdOut);
    CASE n OF
      1  : FileIO.WriteString(FileIO.StdOut, "Too many graph nodes")
    | 2  : FileIO.WriteString(FileIO.StdOut, "Too many symbols")
    | 3  : FileIO.WriteString(FileIO.StdOut, "Too many sets")
    | 4  : FileIO.WriteString(FileIO.StdOut, "Too many character classes")
    | 5  : FileIO.WriteString(FileIO.StdOut, "Too many symbol sets")
    | 6  : FileIO.WriteString(FileIO.StdOut, "Too many token names")
    | 7  : FileIO.WriteString(FileIO.StdOut, "Too many states")
    | 8  : FileIO.WriteString(FileIO.StdOut, "Semantic text buffer overflow")
    | 9  : FileIO.WriteString(FileIO.StdOut, "Circular check buffer overflow")
    | 10 : FileIO.WriteString(FileIO.StdOut, "Too many literal terminals")
    | -1 : FileIO.WriteString(FileIO.StdOut, "Compiler error")
    END;
    IF n > 0 THEN
      FileIO.WriteString(FileIO.StdOut, " (limited to ");
      FileIO.WriteInt(FileIO.StdOut, limit, 1);
      FileIO.Write(FileIO.StdOut, ")");
    END;
(* maybe we want CRX.WriteStatistics; *)
    FileIO.QuitExecution
  END Restriction;

(* MovePragmas          Move pragmas after terminals
----------------------------------------------------------------------*)
PROCEDURE MovePragmas;
  VAR
    i: INTEGER;
  BEGIN
    IF maxP > firstNt THEN
      i := maxSymbols - 1; maxP := maxT;
      WHILE i > lastNt DO
        INC(maxP); IF maxP >= firstNt THEN Restriction(2, maxSymbols) END;
        st^[maxP] := st^[i]; DEC(i)
      END;
    END
  END MovePragmas;

(* ClearMarkList        Clear mark list m
----------------------------------------------------------------------*)
PROCEDURE ClearMarkList (VAR m: MarkList);
  VAR
    i: INTEGER;
  BEGIN
    i := 0;
    WHILE i < maxNodes DIV Sets.size DO m[i] := BITSET{}; INC(i) END;
  END ClearMarkList;

(* GetNode              Get node with index gp in n
----------------------------------------------------------------------*)
PROCEDURE GetNode (gp: INTEGER; VAR n: GraphNode);
  BEGIN
    n := gn^[gp]
  END GetNode;

(* PutNode              Replace node with index gp by n
----------------------------------------------------------------------*)
PROCEDURE PutNode (gp: INTEGER; n: GraphNode);
  BEGIN
    gn^[gp] := n
  END PutNode;

(* NewName              Collects a user defined token name
----------------------------------------------------------------------*)
PROCEDURE NewName (n: Name; s: ARRAY OF CHAR);
  BEGIN
    IF lastName = maxNames THEN Restriction(6, maxNames)
    ELSE
      INC(lastName); symNames := TRUE;
      tt[lastName].name := n; FileIO.Assign(s, tt[lastName].definition);
    END;
  END NewName;

(* NewSym               Generate a new symbol and return its index
----------------------------------------------------------------------*)
PROCEDURE NewSym (typ: INTEGER; name: Name; line: INTEGER): INTEGER;
  VAR
    i: INTEGER;
  BEGIN
    IF maxT + 1 = firstNt THEN Restriction(2, maxSymbols)
    ELSE
      CASE typ OF
        t:  INC(maxT); i := maxT;
      | pr: DEC(maxP); DEC(firstNt); DEC(lastNt); i := maxP;
      | nt, unknown: DEC(firstNt); i := firstNt;
      END;
      IF maxT + 1 >= firstNt THEN Restriction(2, maxSymbols) END;
      st^[i].typ := typ; st^[i].name := name;
      st^[i].constant := ""; (* Bug fix - PDT *)
      st^[i].struct := 0;  st^[i].deletable := FALSE;
      st^[i].attrPos.beg := - FileIO.Long1;
      st^[i].semPos.beg  := - FileIO.Long1;
      st^[i].line := line;
    END;
    RETURN i;
  END NewSym;

(* GetSym               Get symbol sp in sn
----------------------------------------------------------------------*)
PROCEDURE GetSym (sp: INTEGER; VAR sn: SymbolNode);
  BEGIN
    sn := st^[sp]
  END GetSym;

(* PutSym               Replace symbol with index snix by sn
----------------------------------------------------------------------*)
PROCEDURE PutSym (sp: INTEGER; sn: SymbolNode);
  BEGIN
    st^[sp] := sn
  END PutSym;

(* FindSym              Find index of symbol with name n
----------------------------------------------------------------------*)
PROCEDURE FindSym (n: Name): INTEGER;
  VAR
    i: INTEGER;
  BEGIN
    i := 0; (*search in terminal list*)
    WHILE (i <= maxT) & (FileIO.Compare(st^[i].name, n) # 0) DO
      INC(i)
    END;
    IF i <= maxT THEN RETURN i END;
    i := firstNt; (*search in nonterminal/pragma list*)
    WHILE (i < maxSymbols) & (FileIO.Compare(st^[i].name, n) # 0) DO
      INC(i)
    END;
    IF i < maxSymbols THEN RETURN i ELSE RETURN noSym END
  END FindSym;

(* PrintSet             Print set s
----------------------------------------------------------------------*)
PROCEDURE PrintSet (f: FileIO.File; s: ARRAY OF BITSET; 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
      IF Sets.In(s, i) THEN
        empty := FALSE; GetSym(i, sn); len := FileIO.SLENGTH(sn.name);
        IF col + len + 2 > maxLineLen THEN
          FileIO.WriteLn(f); col := 1;
          WHILE col < indent DO FileIO.Write(f, " "); INC(col) END
        END;
        FileIO.WriteString(f, sn.name);
        FileIO.WriteString(f, "  ");
        INC(col, len + 2)
      END;
      INC(i)
    END;
    IF empty THEN FileIO.WriteString(f, "-- empty set --") END;
    FileIO.WriteLn(f)
  END PrintSet;

(* NewSet               Stores s as a new set and return its index
----------------------------------------------------------------------*)
PROCEDURE NewSet (s: Set): INTEGER;
(*any-set computation requires not to search if s is already in set*)
  BEGIN
    INC(maxSet); IF maxSet > maxSetNr THEN Restriction(3, maxSetNr) END;
    set[maxSet] := s; RETURN maxSet
  END NewSet;

(* CompFirstSet         Compute first symbols of (sub) graph at gp
----------------------------------------------------------------------*)
PROCEDURE CompFirstSet (gp: INTEGER; VAR fs: Set);
  VAR
    visited: MarkList;

  PROCEDURE CompFirst (gp: INTEGER; VAR fs: Set);
    VAR
      s: Set;
      gn: GraphNode;
      sn: SymbolNode;
    BEGIN
      Sets.Clear(fs);
      WHILE (gp # 0) & ~ Sets.In(visited, gp) DO
        GetNode(gp, gn); Sets.Incl(visited, gp);
        CASE gn.typ OF
          nt:
            IF first[gn.p1 - firstNt].ready THEN
              Sets.Unite(fs, first[gn.p1 - firstNt].ts);
            ELSE
              GetSym(gn.p1, sn);
              CompFirst(sn.struct, s); Sets.Unite(fs, s);
            END;
        | t, wt:
            Sets.Incl(fs, gn.p1);
        | any:
            Sets.Unite(fs, set[gn.p1])
        | alt, iter, opt:
            CompFirst(gn.p1, s); Sets.Unite(fs, s);
            IF gn.typ = alt THEN CompFirst(gn.p2, s); Sets.Unite(fs, s) END
        ELSE (* eps, sem, sync, ind: nothing *)
        END;
        IF ~ DelNode(gn) THEN RETURN END;
        gp := ABS(gn.next)
       END
    END CompFirst;

  BEGIN (* ComputeFirstSet *)
    ClearMarkList(visited);
    CompFirst(gp, fs);
    IF ddt["I"] THEN
      FileIO.WriteLn(FileIO.StdOut);
      FileIO.WriteString(FileIO.StdOut, "ComputeFirstSet: gp = ");
      FileIO.WriteInt(FileIO.StdOut, gp, 1);
      FileIO.WriteLn(FileIO.StdOut);
      PrintSet(FileIO.StdOut, fs, 0);
    END;
  END CompFirstSet;

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

(* CompExpected     Compute symbols expected at location gp in Symbol sp
----------------------------------------------------------------------*)
PROCEDURE CompExpected (gp, sp: INTEGER; VAR exp: Set);
  BEGIN
    CompFirstSet(gp, exp);
    IF DelGraph(gp) THEN Sets.Unite(exp, follow[sp - firstNt].ts) END
  END CompExpected;

(* CompFollowSets       Get follow symbols of nonterminals
----------------------------------------------------------------------*)
PROCEDURE CompFollowSets;
  VAR
    sn: SymbolNode;
    curSy, i, size: INTEGER;
    visited: MarkList;

  PROCEDURE CompFol (gp: INTEGER);
    VAR
      s: Set;
      gn: GraphNode;
    BEGIN
      WHILE (gp > 0) & ~ Sets.In(visited, gp) DO
        GetNode(gp, gn); Sets.Incl(visited, gp);
        IF gn.typ = nt THEN
          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
        ELSIF (gn.typ=opt) OR (gn.typ=iter) THEN CompFol(gn.p1)
        ELSIF gn.typ = alt THEN CompFol(gn.p1); CompFol(gn.p2)
        END;
        gp := gn.next
      END
    END CompFol;

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

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