cra.mod

一个Modula-2语言分析器

  (* Find states reached by a context transition *)
    VAR
      a: Action;
      s: INTEGER;
    BEGIN
      s := rootState;
      WHILE s <= lastState DO
        a := state[s].firstAction;
        WHILE a # NIL DO
          IF a^.tc = CRT.contextTrans THEN
            state[a^.target^.state].ctx := TRUE
          END;
          a := a^.next
        END;
        INC(s)
      END;
    END FindCtxStates;

  BEGIN
    out := CRS.lst;
    lastSimState := lastState;
    FindCtxStates;
    s := rootState;
    WHILE s <= lastState DO
      REPEAT MakeUnique(s, changed) UNTIL ~ changed;
      INC(s)
    END;
    correct := TRUE;
    s := rootState;
    WHILE s <= lastState DO MeltStates(s, correct); INC(s) END;
    DeleteRedundantStates;
    CombineShifts;
(* ====    IF CRT.ddt["A"] THEN PrintStates END ==== *)
  END MakeDeterministic;



(* GenComment            Generate a procedure to scan comments
-------------------------------------------------------------------------*)
PROCEDURE GenComment (leftMarg: CARDINAL; com: Comment);

  PROCEDURE GenBody (leftMarg: CARDINAL);
    BEGIN
      PutB(leftMarg); PutS("LOOP$");
      PutB(leftMarg + 2); PutS("IF ");
      PutChCond(com^.stop[0]); PutS(" THEN$");
      IF FileIO.SLENGTH(com^.stop) = 1 THEN
        PutB(leftMarg + 4);
        PutS("DEC(level); oldEols := curLine - startLine; NextCh;$");
        PutB(leftMarg + 4); PutS("IF level = 0 THEN RETURN TRUE END;$");
      ELSE
        PutB(leftMarg + 4); PutS("NextCh;$");
        PutB(leftMarg + 4); PutS("IF ");
        PutChCond(com^.stop[1]); PutS(" THEN$");
        PutB(leftMarg + 6); PutS("DEC(level); NextCh;$");
        PutB(leftMarg + 6); PutS("IF level = 0 THEN RETURN TRUE END$");
        PutB(leftMarg + 4); PutS("END;$");
      END;
      IF com^.nested THEN
        PutB(leftMarg + 2); PutS("ELSIF "); PutChCond(com^.start[0]);
        PutS(" THEN$");
        IF FileIO.SLENGTH(com^.start) = 1 THEN
          PutB(leftMarg + 4); PutS("INC(level); NextCh;$");
        ELSE
          PutB(leftMarg + 4); PutS("NextCh;$");
          PutB(leftMarg + 4); PutS("IF "); PutChCond(com^.start[1]);
          PutS(" THEN "); PutS("INC(level); NextCh "); PutS("END;$");
        END;
      END;
      PutB(leftMarg + 2); PutS("ELSIF ch = EOF THEN RETURN FALSE$");
      PutB(leftMarg + 2); PutS("ELSE NextCh END;$");
      PutB(leftMarg); PutS("END; (* LOOP *)$");
    END GenBody;

  BEGIN
    PutS("IF "); PutChCond(com^.start[0]); PutS(" THEN$");
    IF FileIO.SLENGTH(com^.start) = 1 THEN
      PutB(leftMarg + 2); PutS("NextCh;$");
      GenBody(leftMarg + 2);
    ELSE
      PutB(leftMarg + 2); PutS("NextCh;$");
      PutB(leftMarg + 2); PutS("IF ");
      PutChCond(com^.start[1]); PutS(" THEN$");
      PutB(leftMarg + 4); PutS("NextCh;$");
      GenBody(leftMarg + 4);
      PutB(leftMarg + 2); PutS("ELSE$");
      PutB(leftMarg + 4);
      PutS("IF (ch = CR) OR (ch = LF) THEN$");
      PutB(leftMarg + 6);
      PutS("DEC(curLine); lineStart := oldLineStart$");
      PutB(leftMarg + 4); PutS("END;$");
      PutB(leftMarg + 4);
      PutS("DEC(bp); ch := lastCh;$");
      PutB(leftMarg + 2); PutS("END;$");
    END;
    PutB(leftMarg); PutS("END;$"); PutB(leftMarg);
  END GenComment;

(* CopyFramePart   Copy from file <fram> to file <framOut> until <stopStr>
-------------------------------------------------------------------------*)
PROCEDURE CopyFramePart (stopStr: ARRAY OF CHAR; VAR leftMarg: CARDINAL;
                         VAR framIn, framOut:FileIO.File);
  VAR
    ch, startCh: CHAR;
    slen, i: CARDINAL;
    temp: ARRAY [0 .. 63] OF CHAR;
  BEGIN
    startCh := stopStr[0]; FileIO.Read(framIn, ch);
    slen := FileIO.SLENGTH(stopStr);
    WHILE FileIO.Okay DO
      IF (ch = FileIO.EOL) OR (ch = FileIO.CR) OR (ch = FileIO.LF)
        THEN leftMarg := 0
        ELSE INC(leftMarg)
      END;
(* ProgArgs.Assert(leftMarg <= 100); for gpm version *)
      IF ch = startCh
        THEN (* check if stopString occurs *)
          i := 0;
          WHILE (i + 1 < slen) & (ch = stopStr[i]) & FileIO.Okay DO
            temp[i] := ch; INC(i); FileIO.Read(framIn, ch)
          END;
          IF ch = stopStr[i] THEN DEC(leftMarg); RETURN END;
          (* found ==> exit , else continue *)
          FileIO.WriteText(framOut, temp, i);
          FileIO.Write(framOut, ch);
          INC(leftMarg, i);
        ELSE FileIO.Write(framOut, ch)
      END;
      FileIO.Read(framIn, ch)
    END;
  END CopyFramePart;

(* ImportSymConsts      Generates the import of the named symbol constants
-------------------------------------------------------------------------*)
PROCEDURE ImportSymConsts (putS: PutSProc);
  VAR
    i, len,
    oldLen, pos: INTEGER;
    cname: CRT.Name;
    gn: CRT.GraphNode;
    sn: CRT.SymbolNode;
    gramName: ARRAY [0 .. 31] OF CHAR;

  PROCEDURE PutImportSym;
    BEGIN
      IF pos + oldLen > MaxSourceLineLength THEN putS("$  "); pos := 2 END;
      putS(cname); INC(pos, oldLen + 1);
      (* This is not strictly correct, as the increase of 2 should be
         lower. I omitted it, because to separate it would be too
         complicated, and no unexpected side effects are likely, since it
         is only called again outside the loop - after which "pos" is not
         used again
      *)
    END PutImportSym;

  BEGIN
    (* ----- Import list of the generated Symbol Constants Module ----- *)
    putS(";$$FROM  ");
    CRT.GetNode(CRT.root, gn); CRT.GetSym(gn.p1, sn);
    FileIO.Extract(sn.name, 0, 7, gramName);
    putS(gramName); putS("G  IMPORT ");
    i := 0; pos := MaxSourceLineLength + 1; oldLen := 0;
    LOOP
      CRT.GetSym(i, sn); len := FileIO.SLENGTH(sn.constant);
      IF len > 0 THEN
        IF oldLen > 0 THEN PutImportSym; putS(", ") END;
        oldLen := len + 1; cname := sn.constant;
      END;
      IF i = CRT.maxP THEN EXIT END;
      INC(i);
    END; (* LOOP *)
    PutImportSym;
  END ImportSymConsts;

(* GenLiterals           Generate CASE for the recognition of literals
-------------------------------------------------------------------------*)
PROCEDURE GenLiterals (leftMarg: CARDINAL);
  VAR
    FirstLine: BOOLEAN;
    i, j, k: INTEGER;
    key: ARRAY [0 .. CRT.maxLiterals] OF CRT.Name;
    knr: ARRAY [0 .. CRT.maxLiterals] OF INTEGER;
    ch: CHAR;
    sn: CRT.SymbolNode;
  BEGIN
    (*-- sort literal list*)
    i := 0; k := 0;
    WHILE i <= CRT.maxT DO
      CRT.GetSym(i, sn);
      IF sn.struct = CRT.litToken THEN
        j := k-1;
        WHILE (j >= 0) & (FileIO.Compare(sn.name, key[j]) < 0) DO
          key[j + 1] := key[j]; knr[j + 1] := knr[j]; DEC(j)
        END;
        key[j + 1] := sn.name; knr[j + 1] := i;
        INC(k); IF k > CRT.maxLiterals THEN CRT.Restriction(10, CRT.maxLiterals) END;
      END;
      INC(i)
    END;
    (*-- print CASE statement*)
    IF k # 0 THEN
      PutS("CASE CurrentCh(bp0) OF$"); PutB(leftMarg);
      i := 0; FirstLine := TRUE;
      WHILE i < k DO
        ch := key[i, 1]; (*key[i, 0] = quote*)
        IF i # 0 THEN PutLn; PutB(leftMarg) END;
        IF FirstLine THEN
          FirstLine := FALSE; PutS("  ") ELSE PutS("| ")
        END;
        PutC(ch); j := i;
        REPEAT
          IF i = j THEN
            PutS(": IF") ELSE PutB(leftMarg + 6); PutS(" ELSIF")
          END;
          PutS(" Equal("); PutS(key[i]); PutS(") THEN ");
          PutSE(knr[i]); PutLn;
          INC(i);
        UNTIL (i = k) OR (key[i, 1] # ch);
        PutB(leftMarg + 6); PutS(" END");
      END;
      PutLn; PutB(leftMarg); PutS("ELSE$");
      PutB(leftMarg); PutS("END")
    END;
  END GenLiterals;

(* WriteState           Write the source text of a scanner state
-------------------------------------------------------------------------*)
PROCEDURE WriteState (leftMarg, s: INTEGER; VAR FirstState: BOOLEAN);
  VAR
    action: Action;
    ind: INTEGER;
    first, ctxEnd: BOOLEAN;
    sn: CRT.SymbolNode;
    endOf: INTEGER;
    set: CRT.Set;
  BEGIN
    endOf := state[s].endOf;
    IF (endOf > CRT.maxT) & (endOf # CRT.noSym) THEN
      (*pragmas have been moved*)
      endOf := CRT.maxT + CRT.maxSymbols - endOf
    END;
(* ProgArgs.Assert(leftMarg <= 100); for gpm version *)
    Indent(leftMarg);
    IF FirstState THEN FirstState := FALSE; PutS("  ") ELSE PutS("| ") END;
    PutI2(s, 2); PutS(": ");
    first := TRUE; ctxEnd := state[s].ctx;
    action := state[s].firstAction;
    WHILE action # NIL DO
      IF first
        THEN PutS("IF "); first := FALSE; ind := leftMarg + 3;
        ELSE PutB(leftMarg + 6); PutS("ELSIF "); ind := leftMarg + 6;
      END;
      IF action^.typ = CRT.char THEN PutChCond(CHR(action^.sym))
      ELSE CRT.GetClass(action^.sym, set); PutRange(set,leftMarg + ind)
      END;
      PutS(" THEN");
      IF action^.target^.state # s THEN
        PutS(" state := "); PutI(action^.target^.state); Put(";")
      END;
      IF action^.tc = CRT.contextTrans
        THEN PutS(" INC(apx)"); ctxEnd := FALSE
        ELSIF state[s].ctx THEN PutS(" apx := Long0")
      END;
      PutS(" $");
      action := action^.next
    END;
    IF state[s].firstAction # NIL THEN
      PutB(leftMarg + 6); PutS("ELSE ")
    END;
    IF endOf = CRT.noSym THEN PutS("sym := noSym; ");
    ELSE (*final state*)
      CRT.GetSym(endOf, sn);
      IF ctxEnd THEN (*cut appendix*)
        PutS("bp := bp - apx - Long1;");
        PutS(" DEC(nextLen, ORDL(apx)); NextCh; ")
      END;
      PutSE(endOf);
      IF sn.struct = CRT.classLitToken THEN PutS("CheckLiteral; ") END
    END;
    PutS("RETURN$");
    IF state[s].firstAction # NIL THEN
      PutB(leftMarg + 6); PutS("END;$")
    END
  END WriteState;

(* WriteScanner         Write the scanner source file
-------------------------------------------------------------------------*)
PROCEDURE WriteScanner;
  CONST
    ListingWidth = 78;
  VAR
    gramName: ARRAY [0 .. 31] OF CHAR;
    fGramName, fn: ARRAY [0 .. 63] OF CHAR;
    startTab: ARRAY [0 .. 255] OF INTEGER;
    com: Comment;
    i, j, s: INTEGER;
    gn: CRT.GraphNode;
    sn: CRT.SymbolNode;

  PROCEDURE FillStartTab;
    VAR
      action: Action;
      i, targetState, undefState: INTEGER;
      class: CRT.Set;
    BEGIN
      undefState := lastState + 2;
      startTab[0] := lastState + 1; (*eof*)
      i := 1;
      WHILE i < 256 (*PDT*) DO startTab[i] := undefState; INC(i) END;
      action := state[rootState].firstAction;
      WHILE action # NIL DO
        targetState := action^.target^.state;
        IF action^.typ = CRT.char THEN
          startTab[action^.sym] := targetState
        ELSE
          CRT.GetClass(action^.sym, class); i := 0;
          WHILE i < 256 (*PDT*) DO
            IF Sets.In(class, i) THEN startTab[i] := targetState END;
            INC(i)
          END
        END;
        action := action^.next
      END
    END FillStartTab;

VAR
  LeftMargin: CARDINAL;
  FirstState: BOOLEAN;
  ScannerFrame: ARRAY [0 .. 63] OF CHAR;

  BEGIN
    FillStartTab;
    FileIO.Concat(CRS.directory, "scanner.frm", ScannerFrame);
    FileIO.Open(fram, ScannerFrame, FALSE);
    IF ~ FileIO.Okay THEN
      FileIO.SearchFile(fram, "CRFRAMES", "scanner.frm", FALSE);
      IF ~ FileIO.Okay THEN
        FileIO.WriteLn(FileIO.StdOut);
        FileIO.WriteString(FileIO.StdOut, "'scanner.frm' not found.");
        FileIO.WriteLn(FileIO.StdOut);
        FileIO.WriteString(FileIO.StdOut, "Aborted.");
        FileIO.QuitExecution
      END
    END;
    LeftMargin := 0;

    CRT.GetNode(CRT.root, gn); CRT.GetSym(gn.p1, sn);
    FileIO.Extract(sn.name, 0, 7, gramName);
    FileIO.Concat(CRS.directory, gramName, fGramName);

    (*------- *S.MOD -------*)
    FileIO.Concat(fGramName, "S", fn);
    FileIO.Concat(fn, FileIO.ModExt, fn);
(* ++
    FileIO.WriteLn(FileIO.StdOut);
    FileIO.WriteString(FileIO.StdOut, "  ");
    FileIO.WriteString(FileIO.StdOut, fn);
 ++ *)
    FileIO.Open(scanner, fn, TRUE);
    out := scanner;
    CopyFramePart("-->modulename", LeftMargin, fram, out);
    PutS(gramName); Put("S");
    IF CRT.ddt["N"] OR CRT.symNames THEN ImportSymConsts(PutS) END;

    CopyFramePart("-->unknownsym", LeftMargin, fram, out);
    IF CRT.ddt["N"] OR CRT.symNames
      THEN PutSN(CRT.maxT)
      ELSE PutI(CRT.maxT)
    END;
    CopyFramePart("-->comment", LeftMargin, fram, out);
    com := firstComment;
    WHILE com # NIL DO GenComment(LeftMargin, com); com := com^.next END;

    CopyFramePart("-->literals", LeftMargin, fram, out);
    GenLiterals(LeftMargin);

    CopyFramePart("-->GetSy1", LeftMargin, fram, out);
    NewLine := FALSE;
    IF ~ Sets.In(CRT.ignored, ORD(cr)) THEN
      Indent(LeftMargin);
      PutS("IF oldEols > 0 THEN DEC(bp);");
      PutS(" DEC(oldEols); ch := CR END;$")
    END;
    Indent(LeftMargin); PutS("WHILE (ch=' ')");
    IF ~ Sets.Empty(CRT.ignored) THEN
      PutS(" OR$"); Indent(LeftMargin + 6)
    END;
    PutRange(CRT.ignored, LeftMargin + 6); PutS(" DO NextCh END;");
    IF firstComment # NIL THEN
      PutLn; PutB(LeftMargin); PutS("IF ("); com := firstComment;
      WHILE com # NIL DO
        PutChCond(com^.start[0]);
        IF com^.next # NIL THEN PutS(" OR ") END;
        com := com^.next
      END;
      PutS(") & Comment() THEN Get(sym); RETURN END;");
    END;

    CopyFramePart("-->GetSy2", LeftMargin, fram, out);
    NewLine := FALSE; s := rootState + 1; FirstState := TRUE;
(* ProgArgs.Assert(leftMarg <= 100); for gpm version *)
    WHILE s <= lastState DO
      WriteState(LeftMargin, s, FirstState); INC(s)
    END;
    PutB(LeftMargin); PutS("| "); PutI2(lastState + 1, 2);
    PutS(": "); PutSE(0); PutS("ch := 0C; DEC(bp); RETURN");

    CopyFramePart("-->initializations", LeftMargin, fram, out);
    IF CRT.ignoreCase
      THEN PutS("CurrentCh := CapChAt;$")
      ELSE PutS("CurrentCh := CharAt;$")
    END;
    PutB(LeftMargin);
    i := 0;
    WHILE i < 64 (*PDT*) DO
      IF i # 0 THEN PutLn; PutB(LeftMargin); END;
      j := 0;
      WHILE j < 4 DO
        PutS("start["); PutI2(4*i + j,3); PutS("] := ");
        PutI2(startTab[4*i + j],2); PutS("; "); INC(j);
      END;
      INC(i);
    END;

    CopyFramePart("-->modulename", LeftMargin, fram, out);
    PutS(gramName); Put("S");
    CopyFramePart("-->definition", LeftMargin, fram, out);
    FileIO.Close(scanner);

    (*------- *S.DEF -------*)
    IF ~ CRT.ddt["D"] THEN
      FileIO.Concat(fGramName, "S", fn);
      FileIO.Concat(fn, FileIO.DefExt, fn);
(* ++
      FileIO.WriteLn(FileIO.StdOut);
      FileIO.WriteString(FileIO.StdOut, "  ");
      FileIO.WriteString(FileIO.StdOut, fn);
 ++ *)
      FileIO.Open(scanner, fn, TRUE);
      out := scanner;
      CopyFramePart("-->modulename", LeftMargin, fram, out);
      PutS(gramName); Put("S");

      CopyFramePart("-->modulename", LeftMargin, fram, out);
      PutS(gramName); Put("S");

      CopyFramePart("-->implementation", LeftMargin, fram, out);
      FileIO.Close(scanner);
    END;
    FileIO.Close(fram);
  END WriteScanner;

BEGIN (* CRA *)
  lastState := -1; rootState := NewState();
  firstMelted := NIL; firstComment := NIL;
  NewLine := TRUE;
END CRA.