cra.pas

一个Pascal语言分析器

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

(* CopyFramePart   Copy from file <fram> to file <framOut> until <stopStr>
-------------------------------------------------------------------------*) 

PROCEDURE CopyFramePart (stopStr : STRING; VAR leftMarg : INTEGER; VAR framIn, framOut : TEXT);
  CONST
    CR = #13;
    LF = #10;
  VAR
    ch, startCh : CHAR;
    slen, i, j : INTEGER;
    temp : ARRAY [1 .. 63] OF CHAR;

  BEGIN
    startCh := stopStr[1];
    Read(framIn, ch);
    slen := Length(stopStr);
    WHILE NOT EOF(framIn) DO BEGIN
      IF (ch = CR) OR (ch = LF)
        THEN leftMarg := 0
        ELSE INC(leftMarg);
      IF ch = startCh
        THEN (* check if stopString occurs *)
          BEGIN
            i := 1;
            WHILE (i < slen) AND (ch = stopStr[i]) AND NOT EOF(framIn) DO BEGIN
              temp[i] := ch; INC(i); Read(framIn, ch)
            END;
            IF ch = stopStr[i] THEN BEGIN DEC(leftMarg); EXIT END;
            (* found ==> exit , else continue *) 
            FOR j := 1 TO i-1 DO Write(framOut, temp[j]);
            Write(framOut, ch);
            INC(leftMarg, i);
          END
        ELSE Write(framOut, ch);
      Read(framIn, ch)
    END;
  END;

(* ImportSymConsts      Generates the import of the named symbol constants
-------------------------------------------------------------------------*) 

PROCEDURE ImportSymConsts (leader : STRING; putS : PutSProc);
  VAR
    oldLen, pos : INTEGER;
    cname : CRTable.Name;
    gn : CRTable.GraphNode;
    sn : CRTable.SymbolNode;
    gramName : STRING;

  PROCEDURE PutImportSym;
    BEGIN
      IF pos + oldLen > MaxSourceLineLength THEN
        BEGIN 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;

  BEGIN
  (* ----- Import list of the generated Symbol Constants Module ----- *) 
    CRTable.GetNode(CRTable.root, gn);
    CRTable.GetSym(gn.p1, sn);
    putS(leader);
    gramName := Copy(sn.name, 1, 7);
    putS(gramName);
    putS('G (* Symbol Constants *);$');
  END;

(* GenLiterals           Generate CASE for the recognition of literals
-------------------------------------------------------------------------*) 

PROCEDURE GenLiterals (leftMarg : INTEGER);
  VAR
    i, j, k : INTEGER;
    key : ARRAY [0 .. CRTable.maxLiterals] OF CRTable.Name;
    knr : ARRAY [0 .. CRTable.maxLiterals] OF INTEGER;
    ch : CHAR;
    sn : CRTable.SymbolNode;

  BEGIN
  (*-- sort literal list*) 
    i := 0;
    k := 0;
    WHILE i <= CRTable.maxT DO BEGIN
      CRTable.GetSym(i, sn);
      IF sn.struct = CRTable.litToken THEN
        BEGIN
          j := k - 1;
          WHILE (j >= 0) AND (sn.name < key[j]) DO BEGIN
            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 > CRTable.maxLiterals THEN
            CRTable.Restriction(10, CRTable.maxLiterals);
        END;
      INC(i)
    END;
    (*-- print CASE statement*) 
    IF k <> 0 THEN
      BEGIN
        PutS('CASE CurrentCh(bp0) OF$');
        PutB(leftMarg);
        i := 0;
        WHILE i < k DO BEGIN
          ch := key[i, 2]; (*key[i, 0] = quote*)
          IF i <> 0 THEN BEGIN PutLn; PutB(leftMarg) END;
          PutS('  '); PutC(ch); j := i;
          REPEAT
            IF i = j
              THEN PutS(': IF')
              ELSE BEGIN PutB(leftMarg + 6); PutS(' END ELSE IF') END;
            PutS(' Equal('); PutS1(key[i]); PutS(') THEN ');
            PutSE(knr[i]); PutLn;
            INC(i);
          UNTIL (i = k) OR (key[i, 2] <> ch);
          PutB(leftMarg + 6); PutS(' END;');
        END;
        PutLn; PutB(leftMarg); PutS('ELSE BEGIN END$');
        PutB(leftMarg); PutS('END')
      END;
  END;

(* WriteState           Write the source text of a scanner state
-------------------------------------------------------------------------*) 

PROCEDURE WriteState (leftMarg, s : INTEGER; VAR FirstState : BOOLEAN);
  VAR
    anAction : Action;
    ind : INTEGER;
    first, ctxEnd : BOOLEAN;
    sn : CRTable.SymbolNode;
    endOf : INTEGER;
    sset : CRTable.CRTSet;

  BEGIN
    endOf := stateArray[s].endOf;
    IF (endOf > CRTable.maxT) AND (endOf <> CRTable.noSym)
      THEN (*pragmas have been moved*)
        BEGIN endOf := CRTable.maxT + CRTable.maxSymbols - endOf END;
    Indent(leftMarg);
    IF FirstState THEN FirstState := FALSE;
    PutS('  '); PutI2(s, 2); PutS(': ');
    first := TRUE;
    ctxEnd := stateArray[s].ctx;
    anAction := stateArray[s].firstAction;
    WHILE anAction <> NIL DO BEGIN
      IF first
        THEN
          BEGIN PutS('IF '); first := FALSE; ind := leftMarg + 3 END
        ELSE
          BEGIN PutB(leftMarg + 6); PutS('END ELSE IF '); ind := leftMarg + 6 END;
      IF anAction^.typ = CRTable.chart
        THEN
          BEGIN PutChCond(CHR(anAction^.sym)) END
        ELSE
          BEGIN
            CRTable.GetClass(anAction^.sym, sset);
            PutRange(sset, leftMarg + ind)
          END;
      PutS(' THEN BEGIN');
      IF anAction^.target^.theState <> s THEN
        BEGIN
          PutS(' state := ');
          PutI(anAction^.target^.theState);
          Put(';')
        END;
      IF anAction^.tc = CRTable.contextTrans
        THEN BEGIN PutS(' INC(apx)'); ctxEnd := FALSE END
        ELSE IF stateArray[s].ctx THEN PutS(' apx := 0');
      PutS(' $');
      anAction := anAction^.next
    END;
    IF stateArray[s].firstAction <> NIL THEN
      BEGIN PutB(leftMarg + 6); PutS('END ELSE ') END;
    IF endOf = CRTable.noSym
      THEN
        BEGIN PutS('BEGIN sym := noSym; '); END
      ELSE (*final theState*)
        BEGIN
          CRTable.GetSym(endOf, sn);
          IF ctxEnd THEN (*cut appendix*)
            BEGIN
              PutS('BEGIN bp := bp - apx - 1;');
              PutS(' DEC(nextLen, apx); NextCh; ')
            END;
          PutSE(endOf);
          IF sn.struct = CRTable.classLitToken THEN
            BEGIN PutS('CheckLiteral; ') END
        END;
    IF ctxEnd
      THEN BEGIN PutS('EXIT; END; END;$') END
      ELSE BEGIN PutS('EXIT; END;$'); END;
    (*  IF stateArray[s].firstAction # NIL THEN
        PutB(leftMarg + 6); PutS("END;$")
        END
    *)
  END;

(* WriteScanner         Write the scanner source file
-------------------------------------------------------------------------*) 

PROCEDURE WriteScanner;
  CONST
    ListingWidth = 78;

  VAR
    gramName, fGramName, fn : STRING;
    startTab : ARRAY [0 .. 255] OF INTEGER;
    com : Comment;
    i, j, s : INTEGER;
    gn : CRTable.GraphNode;
    sn : CRTable.SymbolNode;

  PROCEDURE FillStartTab;
    VAR
      anAction : Action;
      i, targetState, undefState : INTEGER;
      class : CRTable.CRTSet;
    BEGIN
      undefState := lastState + 2;
      startTab[0] := lastState + 1; (*eof*)
      i := 1;
      WHILE i < 256 (*PDT*)  DO BEGIN
        startTab[i] := undefState;
        INC(i)
      END;
      anAction := stateArray[rootState].firstAction;
      WHILE anAction <> NIL DO BEGIN
        targetState := anAction^.target^.theState;
        IF anAction^.typ = CRTable.chart
          THEN startTab[anAction^.sym] := targetState
          ELSE
            BEGIN
              CRTable.GetClass(anAction^.sym, class);
              i := 0;
              WHILE i < 256 (*PDT*)  DO BEGIN
                IF Sets.IsIn(class, i) THEN startTab[i] := targetState;
                INC(i)
              END
            END;
        anAction := anAction^.next
      END
    END;

  VAR
    LeftMargin : INTEGER;
    FirstState : BOOLEAN;
    ScannerFrame : STRING;

  BEGIN
    FillStartTab;
    ScannerFrame := Concat(CRS.directory, 'scanner.frm');
    FileIO.Open(fram, ScannerFrame, FALSE);
    IF NOT FileIO.Okay THEN
      BEGIN
        FileIO.SearchFile(fram, 'CRFRAMES', 'scanner.frm', FALSE);
        IF NOT FileIO.Okay THEN
          BEGIN WriteLn; WriteLn('"scanner.frm" not found - aborted.'); HALT END
      END;
    LeftMargin := 0;
    CRTable.GetNode(CRTable.root, gn);
    CRTable.GetSym(gn.p1, sn);
    gramName := Copy(sn.name, 1, 7);
    fGramName := Concat(CRS.directory, gramName);
    (*------- *S.MOD -------*) 
    fn := Concat(fGramName, 'S.PAS');
    FileIO.Open(scanner, fn, TRUE);
    CopyFramePart('-->modulename', LeftMargin, fram, scanner);
    PutS(gramName+'S');
    CopyFramePart('-->unitname', LeftMargin, fram, scanner);
    IF CRTable.ddt['N'] OR CRTable.symNames THEN ImportSymConsts('USES ', PutS);
    CopyFramePart('-->unknownsym', LeftMargin, fram, scanner);
    IF CRTable.ddt['N'] OR CRTable.symNames
      THEN PutSN(CRTable.maxT)
      ELSE PutI(CRTable.maxT);
    CopyFramePart('-->comment', LeftMargin, fram, scanner);
    com := firstComment;
    WHILE com <> NIL DO BEGIN
      GenComment(LeftMargin, com);
      com := com^.next
    END;
    CopyFramePart('-->literals', LeftMargin, fram, scanner);
    GenLiterals(LeftMargin);
    CopyFramePart('-->GetSy1', LeftMargin, fram, scanner);
    NewLine := FALSE;
    IF NOT Sets.IsIn(CRTable.ignored, ORD(cr)) THEN
      BEGIN
        Indent(LeftMargin);
        PutS('IF oldEols > 0 THEN BEGIN DEC(bp);');
        PutS(' DEC(oldEols); ch := CR END;$')
      END;
    Indent(LeftMargin);
    PutS('WHILE (ch = '' '')');
    IF NOT Sets.Empty(CRTable.ignored) THEN
      BEGIN PutS(' OR$'); Indent(LeftMargin + 6) END;
    PutRange(CRTable.ignored, LeftMargin + 6);
    PutS(' DO NextCh;');
    IF firstComment <> NIL THEN
      BEGIN
        PutLn; PutB(LeftMargin); PutS('IF (');
        com := firstComment;
        WHILE com <> NIL DO BEGIN
          PutChCond(com^.start[1]);
          IF com^.next <> NIL THEN PutS(' OR ');
          com := com^.next
        END;
        PutS(') AND Comment THEN BEGIN Get(sym); EXIT; END;');
      END;
    CopyFramePart('-->GetSy2', LeftMargin, fram, scanner);
    NewLine := FALSE;
    s := rootState + 1;
    FirstState := TRUE;
    WHILE s <= lastState DO BEGIN
      WriteState(LeftMargin, s, FirstState);
      INC(s)
    END;
    PutB(LeftMargin); PutS('  '); PutI2(lastState + 1, 2); PutS(': ');
    PutSE(0); PutS('ch := #0; DEC(bp); EXIT END;');
    CopyFramePart('-->initializations', LeftMargin, fram, scanner);
    IF CRTable.ignoreCase
      THEN PutS('CurrentCh := CapChAt;$')
      ELSE PutS('CurrentCh := CharAt;$');
    PutB(LeftMargin);
    i := 0;
    WHILE i < 64 (*PDT*)  DO BEGIN
      IF i <> 0 THEN BEGIN PutLn; PutB(LeftMargin); END;
      j := 0;
      WHILE j < 4 DO BEGIN
        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, scanner);
    PutS(gramName + 'S *)');
    Close(scanner); Close(fram);
  END;

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