crt.mod

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

        GetNode(gp, gn);
        IF gn.typ = alt THEN
          p := gp; Sets.Clear(s1);
          WHILE p # 0 DO (*for all alternatives*)
            GetNode(p, gn1); CompExpected(gn1.p1, curSy, s2);
            Check(1, s1, s2);
            Sets.Unite(s1, s2);
            CheckAlternatives(gn1.p1);
            p := gn1.p2
          END
        ELSIF (gn.typ = opt) OR (gn.typ = iter) THEN
          CompExpected(gn.p1, curSy, s1);
          CompExpected(ABS(gn.next), curSy, s2);
          Check(2, s1, s2);
          CheckAlternatives(gn.p1)
        ELSIF gn.typ = any THEN
          GetSet(gn.p1, s1);
          IF Sets.Empty(s1) THEN LL1Error(3, 0) END
          (*e.g. {ANY} ANY or [ANY] ANY*)
        END;
        gp := gn.next
      END
    END CheckAlternatives;

  BEGIN (* LL1Test *)
    FileIO.WriteString(CRS.lst, "LL(1) conditions:");
    curSy := firstNt; ll1 := TRUE;
    WHILE curSy <= lastNt DO (*for all nonterminals*)
      GetSym(curSy, sn); CheckAlternatives(sn.struct);
      INC(curSy)
    END;
    IF ll1 THEN FileIO.WriteString(CRS.lst, "         --  ok  --") END;
    FileIO.WriteLn(CRS.lst);
  END LL1Test;

(* TestCompleteness     Test if all nonterminals have productions
----------------------------------------------------------------------*)
PROCEDURE TestCompleteness (VAR ok: BOOLEAN);
  VAR
    sp: INTEGER;
    sn: SymbolNode;
  BEGIN
    FileIO.WriteString(CRS.lst, "Undefined nonterminals:  ");
    sp := firstNt; ok := TRUE;
    WHILE sp <= lastNt DO (*for all nonterminals*)
      GetSym(sp, sn);
      IF sn.struct = 0 THEN
        ok := FALSE;
        FileIO.WriteLn(CRS.lst); FileIO.WriteString(CRS.lst, "     ");
        FileIO.WriteString(CRS.lst, sn.name);
      END;
      INC(sp)
    END;
    IF ok THEN FileIO.WriteString(CRS.lst, " -- none --") END;
    FileIO.WriteLn(CRS.lst);
  END TestCompleteness;

(* TestIfAllNtReached   Test if all nonterminals can be reached
----------------------------------------------------------------------*)
PROCEDURE TestIfAllNtReached (VAR ok: BOOLEAN);
  VAR
    gn: GraphNode;
    sp: INTEGER;
    reached: MarkList;
    sn: SymbolNode;

  PROCEDURE MarkReachedNts (gp: INTEGER);
    VAR
      gn: GraphNode;
      sn: SymbolNode;
    BEGIN
      WHILE gp > 0 DO
        GetNode(gp, gn);
        IF gn.typ = nt THEN
          IF ~ Sets.In(reached, gn.p1) THEN (*new nt reached*)
            Sets.Incl(reached, gn.p1);
            GetSym(gn.p1, sn); MarkReachedNts(sn.struct)
          END
        ELSIF (gn.typ = alt) OR (gn.typ = iter) OR (gn.typ = opt) THEN
          MarkReachedNts(gn.p1);
          IF gn.typ = alt THEN MarkReachedNts(gn.p2) END
        END;
        gp := gn.next
      END
    END MarkReachedNts;

  BEGIN (* TestIfAllNtReached *)
    ClearMarkList(reached);
    GetNode(root, gn); Sets.Incl(reached, gn.p1);
    GetSym(gn.p1, sn); MarkReachedNts(sn.struct);

    FileIO.WriteString(CRS.lst, "Unreachable nonterminals:");
    sp := firstNt; ok := TRUE;
    WHILE sp <= lastNt DO (*for all nonterminals*)
      IF ~ Sets.In(reached, sp) THEN
        ok := FALSE; GetSym(sp, sn);
        FileIO.WriteLn(CRS.lst); FileIO.WriteString(CRS.lst, "     ");
        FileIO.WriteString(CRS.lst, sn.name)
      END;
      INC(sp)
    END;
    IF ok THEN FileIO.WriteString(CRS.lst, " -- none --") END;
    FileIO.WriteLn(CRS.lst);
  END TestIfAllNtReached;

(* TestIfNtToTerm   Test if all nonterminals can be derived to terminals
----------------------------------------------------------------------*)
PROCEDURE TestIfNtToTerm (VAR ok: BOOLEAN);
  VAR
    changed: BOOLEAN;
    sp: INTEGER;
    sn: SymbolNode;
    termList: MarkList;

  PROCEDURE IsTerm (gp: INTEGER): BOOLEAN;
    VAR
      gn: GraphNode;
    BEGIN
      WHILE gp > 0 DO
        GetNode(gp, gn);
        IF (gn.typ = nt) & ~ Sets.In(termList, gn.p1)
           OR (gn.typ = alt) & ~ IsTerm(gn.p1)
              & ((gn.p2 = 0) OR ~ IsTerm(gn.p2)) THEN
             RETURN FALSE
        END;
        gp := gn.next
      END;
      RETURN TRUE
    END IsTerm;

  BEGIN (* TestIfNtToTerm *)
    ClearMarkList(termList);
    REPEAT
      sp := firstNt; changed := FALSE;
      WHILE sp <= lastNt DO
        IF ~ Sets.In(termList, sp) THEN
          GetSym(sp, sn);
          IF IsTerm(sn.struct) THEN
            Sets.Incl(termList, sp); changed := TRUE
          END
        END;
        INC(sp)
      END
    UNTIL ~ changed;

    FileIO.WriteString(CRS.lst, "Underivable nonterminals:");
    sp := firstNt; ok := TRUE;
    WHILE sp <= lastNt DO
      IF ~ Sets.In(termList, sp) THEN
        ok := FALSE; GetSym(sp, sn);
        FileIO.WriteLn(CRS.lst); FileIO.WriteString(CRS.lst, "     ");
        FileIO.WriteString(CRS.lst, sn.name);
      END;
      INC(sp)
    END;
    IF ok THEN FileIO.WriteString(CRS.lst, " -- none --") END;
    FileIO.WriteLn(CRS.lst);
  END TestIfNtToTerm;

(* ASCIIName            Assigns the wellknown ASCII-Name in lowercase
----------------------------------------------------------------------*)
PROCEDURE ASCIIName (ascii: CHAR; VAR asciiname: Name);
  VAR
    N : CARDINAL;
  BEGIN
    CASE ascii OF
      00C : asciiname := "nul"
    | 01C : asciiname := "soh"
    | 02C : asciiname := "stx"
    | 03C : asciiname := "etx"
    | 04C : asciiname := "eot"
    | 05C : asciiname := "enq"
    | 06C : asciiname := "ack"
    | 07C : asciiname := "bel"
    | 10C : asciiname := "bs"
    | 11C : asciiname := "ht"
    | 12C : asciiname := "lf"
    | 13C : asciiname := "vt"
    | 14C : asciiname := "ff"
    | 15C : asciiname := "cr"
    | 16C : asciiname := "so"
    | 17C : asciiname := "si"
    | 20C : asciiname := "dle"
    | 21C : asciiname := "dc1"
    | 22C : asciiname := "dc2"
    | 23C : asciiname := "dc3"
    | 24C : asciiname := "dc4"
    | 25C : asciiname := "nak"
    | 26C : asciiname := "syn"
    | 27C : asciiname := "etb"
    | 30C : asciiname := "can"
    | 31C : asciiname := "em"
    | 32C : asciiname := "sub"
    | 33C : asciiname := "esc"
    | 34C : asciiname := "fs"
    | 35C : asciiname := "gs"
    | 36C : asciiname := "rs"
    | 37C : asciiname := "us"
    | " " : asciiname := "sp"
    | "!" : asciiname := "bang"
    | '"' : asciiname := "dquote"
    | "#" : asciiname := "hash"
    | "$" : asciiname := "dollar"
    | "%" : asciiname := "percent"
    | "&" : asciiname := "and"
    | "'" : asciiname := "squote"
    | "(" : asciiname := "lparen"
    | ")" : asciiname := "rparen"
    | "*" : asciiname := "star"
    | "+" : asciiname := "plus"
    | "," : asciiname := "comma"
    | "-" : asciiname := "minus"
    | "." : asciiname := "point"
    | "/" : asciiname := "slash"
    | "0" : asciiname := "zero"
    | "1" : asciiname := "one"
    | "2" : asciiname := "two"
    | "3" : asciiname := "three"
    | "4" : asciiname := "four"
    | "5" : asciiname := "five"
    | "6" : asciiname := "six"
    | "7" : asciiname := "seven"
    | "8" : asciiname := "eight"
    | "9" : asciiname := "nine"
    | ":" : asciiname := "colon"
    | ";" : asciiname := "semicolon"
    | "<" : asciiname := "less"
    | "=" : asciiname := "equal"
    | ">" : asciiname := "greater"
    | "?" : asciiname := "query"
    | "@" : asciiname := "at"
    | "A" .. "Z", "a" .. "z"
          : asciiname := " "; asciiname[0] := ascii
    | "[" : asciiname := "lbrack"
    | "\" : asciiname := "backslash"
    | "]" : asciiname := "rbrack"
    | "^" : asciiname := "uparrow"
    | "_" : asciiname := "underscore"
    | "`" : asciiname := "accent"
    | "{" : asciiname := "lbrace"
    | "|" : asciiname := "bar"
    | "}" : asciiname := "rbrace"
    | "~" : asciiname := "tilde"
    | 177C: asciiname := "delete"
    ELSE
      N := ORD(ascii);
      asciiname := 'ascii  ';
      asciiname[6] := CHR(N MOD 10 + ORD('0'));
      N := N DIV 10;
      asciiname[5] := CHR(N MOD 10 + ORD('0'));
      asciiname[4] := CHR(N DIV 10 + ORD('0'));
    END
  END ASCIIName;

(* BuildName            Build new Name to represent old string
----------------------------------------------------------------------*)
PROCEDURE BuildName (VAR old, new: ARRAY OF CHAR);
  VAR
    ForLoop, I, TargetIndex: CARDINAL;
    AsciiName: Name;
  BEGIN
    TargetIndex := 0;
    FOR ForLoop := 1 TO FileIO.SLENGTH(old) - 2 DO
      CASE old[ForLoop] OF
        "A" .. "Z", "a" .. "z":
          IF TargetIndex <= HIGH(new) THEN
            new[TargetIndex] := old[ForLoop];
            INC(TargetIndex);
          END;
        ELSE
          ASCIIName(old[ForLoop], AsciiName);
          FOR I := 0 TO FileIO.SLENGTH(AsciiName) - 1 DO
            IF TargetIndex <= HIGH(new) THEN
              new[TargetIndex] := AsciiName[I];
              INC(TargetIndex);
            END;
          END;
      END;
    END;
    IF TargetIndex <= HIGH(new) THEN new[TargetIndex] := 0C END;
  END BuildName;

(* SymName              Generates a new name for a symbol constant
----------------------------------------------------------------------*)
PROCEDURE SymName (symn: Name; VAR conn: Name);
  BEGIN
    IF (symn[0] = '"') OR (symn[0] = "'") THEN
      IF FileIO.SLENGTH(symn) = 3 THEN
        ASCIIName(symn[1], conn);
      ELSE
        BuildName(symn, conn);
      END;
    ELSE
      conn := symn;
    END;
    FileIO.Concat(conn, "Sym", conn);
  END SymName;

(* AssignSymNames     Assigns the user defined or generated token names
----------------------------------------------------------------------*)
PROCEDURE AssignSymNames (default: BOOLEAN; VAR thereExists: BOOLEAN);

  PROCEDURE AssignDef (VAR n (*is not modified*), const: Name);
    VAR
      ForLoop: CARDINAL;
    BEGIN
      FOR ForLoop := 1 TO lastName DO
        IF FileIO.Compare(n, tt[ForLoop].definition) = 0 THEN
          const := tt[ForLoop].name; thereExists := TRUE; RETURN;
        END;
      END;
      IF default THEN SymName(n, const); ELSE const := ""; END;
    END AssignDef;

  VAR
    ForLoop: INTEGER;

  BEGIN
    thereExists := default;
    st^[0].constant := "EOFSYM";
    FOR ForLoop := 1 TO maxP DO
      AssignDef(st^[ForLoop].name, st^[ForLoop].constant)
    END;
    st^[maxT].constant := "NOSYM";
  END AssignSymNames;

BEGIN (* CRT *)
  ch := "A"; WHILE ch <= "Z" DO ddt[ch] := FALSE; INC(ch) END;
  maxSet := 0; Sets.Clear(set[0]); Sets.Incl(set[0], eofSy);
  firstNt := maxSymbols; maxP := maxSymbols; maxT := -1; maxC := -1;
  lastNt := maxP - 1;
  dummyName := 0; lastName := 0; symNames := FALSE;
  (* The dummy node gn^[0] ensures that none of the procedures
     above have to check for 0 indices. *)
  Storage.ALLOCATE(gn, SYSTEM.TSIZE(GraphList));
  Storage.ALLOCATE(st, SYSTEM.TSIZE(SymbolTable));
  nNodes := 0;
  gn^[0].typ := -1; gn^[0].p1 := 0; gn^[0].p2 := 0;
  gn^[0].next := 0; gn^[0].line := 0;
  gn^[0].pos.beg := - FileIO.Long1;
  gn^[0].pos.len := 0; gn^[0].pos.col := 0;
(* debug info when choosing constants - PDT
  FileIO.WriteString(FileIO.StdOut, "Symbol table");
  FileIO.WriteCard(FileIO.StdOut, SIZE(SymbolTable), 1);
  FileIO.WriteLn(FileIO.StdOut);
  FileIO.WriteString(FileIO.StdOut, "Class table ");
  FileIO.WriteCard(FileIO.StdOut, SIZE(ClassTable), 1);
  FileIO.WriteLn(FileIO.StdOut);
  FileIO.WriteString(FileIO.StdOut, "Name table  ");
  FileIO.WriteCard(FileIO.StdOut, SIZE(NameTable), 1);
  FileIO.WriteLn(FileIO.StdOut);
  FileIO.WriteString(FileIO.StdOut, "Graph list  ");
  FileIO.WriteCard(FileIO.StdOut, SIZE(GraphList), 1);
  FileIO.WriteLn(FileIO.StdOut);
*)
END CRT.