crq.pas

一个Pascal语言分析器

        107 : Msg('name declared twice');
        108 : Msg('this type not allowed on left side of production');
        109 : Msg('earlier semantic action was not terminated');
        111 : Msg('missing production for grammar name');
        112 : Msg('grammar symbol must not have attributes');
        113 : Msg('a literal must not be declared with a structure');
        114 : Msg('semantic action not allowed here');
        115 : Msg('undefined name');
        116 : Msg('attributes not allowed in token declaration');
        117 : Msg('name does not match grammar name');
        118 : Msg('unacceptable constant value');
        119 : Msg('may not ignore CHR(0)');
        120 : Msg('token may not be empty');
        121 : Msg('token must not start with an iteration');
        122 : Msg('only characters allowed in comment declaration');
        123 : Msg('only terminals may be weak');
        124 : Msg('literal tokens may not contain white space');
        125 : Msg('comment delimiter must be 1 or 2 characters long');
        126 : Msg('character set contains more than one character');
        127 : Msg('could not make deterministic automaton');
        128 : Msg('semantic action text too long - please split it');
        129 : Msg('literal tokens may not be empty');
        ELSE BEGIN Msg('Error: '); Write(lst, nr) END
      END;
      WriteLn(lst);
    END;

  PROCEDURE PrintListing;
  (* Print a source listing with error messages *)
    VAR
      nextErr:   Err;
      eof:       BOOLEAN;
      lnr, errC: INTEGER;
      srcPos:    LONGINT;
      line:      STRING;
    BEGIN
      IF NOT IDE THEN BEGIN WriteLn(lst, 'Listing:'); WriteLn(lst) END;
      srcPos := 0; nextErr := firstErr;
      GetLine(srcPos, line, eof); lnr := 1; errC := 0;
      WHILE NOT eof DO BEGIN
        IF NOT IDE THEN WriteLn(lst, lnr:5, '  ', line);
        WHILE (nextErr <> NIL) AND (nextErr^.line = lnr) DO BEGIN
          IF IDE THEN
            Write(lst, ATGFileName, ' (', lnr:1, ', ', nextErr^.col - 1, ') ');
          PrintErr(line, nextErr^.nr, nextErr^.col); INC(errC);
          nextErr := nextErr^.next
        END;
        GetLine(srcPos, line, eof); INC(lnr);
      END;
      IF nextErr <> NIL THEN BEGIN
        IF NOT IDE THEN WriteLn(lst, lnr:5);
        WHILE nextErr <> NIL DO BEGIN
          IF IDE THEN
            Write(lst, ATGFileName, ' (', lnr:1, ', ', nextErr^.col - 1, ') ');
          PrintErr(line, nextErr^.nr, nextErr^.col); INC(errC);
          nextErr := nextErr^.next
        END
      END;
      IF NOT IDE AND (errC > 0) THEN
        BEGIN
          WriteLn(lst);
          Write(lst, errC:5, ' error');
          IF errC <> 1 THEN Write(lst, 's');
          WriteLn(lst); WriteLn(lst); WriteLn(lst);
        END;
    END;

PROCEDURE SetOption (s : STRING);
(* Set compiler options *) 
  VAR
    i : INTEGER;
  BEGIN
    FOR i := 2 TO Length(s) DO
      BEGIN
        s[i] := UpCase(s[i]);
        IF s[i] IN ['A' .. 'Z'] THEN CRTable.ddt[s[i]] := TRUE
      END;
  END;

PROCEDURE Msg (S : STRING);
  BEGIN
    WriteLn(S);
  END;

(* --------------------------- Help ------------------------------- *)

PROCEDURE Help;
  BEGIN
    WriteLn('Coco/R (MS-DOS) - Compiler-Compiler V', Version);
    WriteLn('Turbo Pascal (TM) version by Pat Terry/Volker Pohlers ', ReleaseDate);
    Msg('Usage: COCOR [-Options] [Grammar[.atg]] [-Options]');
    Msg('Example: COCOR -cs Test');
    Msg('');
    Msg('Options are');
    Msg('a  - Trace automaton');
    Msg('c  - Generate compiler module');
    Msg('f  - Give Start and Follower sets');
    Msg('g  - Print top-down graph');
    Msg('i  - Trace start set computations');
    Msg('l  - Force listing');
    Msg('n  - Generate symbolic names');
    Msg('p  - Generate parser only');
    Msg('q  - Generate error messages to interface with editor');
    Msg('s  - Print symbol table');
    Msg('t  - Grammar tests only - no code generated');
    Msg('x  - Print cross reference list');
    Msg('COMPILER.FRM, SCANNER.FRM and PARSER.FRM must be in the working directory,');
    Msg('or on the path specified by the environment variable CRFRAMES');
  END;

BEGIN
  firstErr := NIL; Extra := 1; P := 1;
  GrammarName := ParamStr(1);
  IF (GrammarName = '?') OR (GrammarName = '') OR (GrammarName = '/?') THEN
    BEGIN Help; HALT END;
  WHILE (Length(GrammarName) > 0) AND (GrammarName[1] IN ['-', '/']) DO BEGIN
    (* accept options before filename *)
    SetOption(GrammarName);
    INC(P); GrammarName := ParamStr(P);
  END;
  ok := GrammarName <> '';
  REPEAT
    IF NOT ok THEN
      BEGIN
        Write('Grammar[.atg] ? : ');
        ReadLn(GrammarName);
        IF GrammarName = '' THEN HALT;
      END;
    FileIO.AppendExtension(GrammarName, ATGExt, ATGFileName);
    GrammarName := ATGFileName;
    Assign(src, GrammarName);
    {$I-} Reset(src, 1); {$I+}
    ok := IOResult = 0;
    IF NOT ok THEN WriteLn('File <', GrammarName, '> not found.');
  UNTIL ok;
  INC(P); Options := ParamStr(P);
  IF Options <> '' THEN SetOption(Options);
  IDE := CRTable.ddt['Q'];
  FileIO.ExtractDirectory(GrammarName, directory);
  IF IDE
    THEN lstFileName := ''
    ELSE FileIO.ChangeExtension(GrammarName, LSTExt, lstFileName);
  FileIO.Open(lst, lstFileName, TRUE);
  WriteLn(lst, 'Coco/R - Compiler-Compiler V', Version);
  IF NOT IDE THEN
    BEGIN
      WriteLn(lst, 'Turbo Pascal (TM) version by Volker Pohlers/Pat Terry ', ReleaseDate);
      WriteLn(lst, 'Source file: ', GrammarName);
      WriteLn(lst);
      WriteLn; WriteLn('parsing file ', GrammarName)
    END;
  CRS.Error := StoreError;
  CRP.Parse;
  IF errors = 0
    THEN
      BEGIN
        IF NOT IDE
          THEN
            BEGIN
              Msg('testing grammar');
              WriteLn(lst, 'Grammar Tests:'); WriteLn(lst);
            END
          ELSE
            BEGIN
              WriteLn(lst); WriteLn(lst, ATGFileName, ' (0, 0) Grammar tests');
            END;
        CRTable.CompSymbolSets;
        IF IDE THEN
          BEGIN
            WriteLn(lst); WriteLn(lst, ATGFileName, ' (0, 0) Undefined tests');
          END;
        CRTable.TestCompleteness(ok);
        IF ok THEN
          BEGIN
            IF IDE THEN
              BEGIN
                WriteLn(lst); WriteLn(lst, ATGFileName, ' (0, 0) Unreachable tests');
              END;
            CRTable.TestIfAllNtReached(ok)
          END;
        IF ok THEN
          BEGIN
            IF IDE THEN
              BEGIN
                WriteLn(lst); WriteLn(lst, ATGFileName, ' (0, 0) Circular tests');
              END;
            CRTable.FindCircularProductions(ok)
          END;
        IF ok THEN
          BEGIN
            IF IDE THEN
              BEGIN
                WriteLn(lst); WriteLn(lst, ATGFileName, ' (0, 0) Underivable tests');
              END;
            CRTable.TestIfNtToTerm(ok)
          END;
        IF ok THEN
          BEGIN
            IF IDE THEN
              BEGIN
                WriteLn(lst); WriteLn(lst, ATGFileName, ' (0, 0) LL(1) tests');
              END;
            CRTable.LL1Test(ll1)
          END;
        WriteLn(lst);
        IF CRTable.genScanner AND CRTable.ddt['A'] THEN CRA.PrintStates;
        IF NOT ok OR NOT ll1 OR CRTable.ddt['L'] OR CRTable.ddt['X'] THEN
          BEGIN
            IF NOT IDE THEN Msg('listing'); PrintListing;
            IF CRTable.ddt['X'] THEN CRTable.XRef;
          END;
        IF CRTable.ddt['N'] OR CRTable.symNames THEN
          BEGIN
            IF NOT IDE THEN Msg('symbol name assignment');
            CRTable.AssignSymNames(CRTable.ddt['N'], CRTable.symNames);
          END;
        IF ok AND NOT CRTable.ddt['T'] THEN
          BEGIN
            IF NOT IDE THEN Msg('generating parser');
            CRX.GenCompiler;
            IF CRTable.genScanner AND NOT CRTable.ddt['P'] THEN
              BEGIN
                IF NOT IDE THEN Msg('generating scanner');
                CRA.WriteScanner
              END;
            IF CRTable.ddt['C'] THEN
              BEGIN
                IF NOT IDE THEN Msg('generating compiler');
                CRC.WriteDriver
              END;
            IF NOT IDE THEN CRX.WriteStatistics;
          END;
        IF NOT ok
          THEN
            BEGIN
              IF IDE THEN Write(lst, ATGFileName, ' (0, 0) ');
              Msg('Compilation ended with errors in grammar tests.')
            END
          ELSE IF NOT ll1 THEN
            BEGIN
              IF IDE THEN Write(lst, ATGFileName, ' (0, 0) ');
              Msg('Compilation ended with LL(1) errors.')
            END
          ELSE Msg('Compilation completed. No errors detected.');
      END
    ELSE
      BEGIN
        IF NOT IDE THEN Msg('listing'); PrintListing;
        IF CRTable.ddt['X'] THEN CRTable.XRef;
        IF NOT IDE THEN Msg('*** errors detected ***');
      END;
  WriteLn;
  IF CRTable.ddt['G'] THEN CRTable.PrintGraph;
  IF CRTable.ddt['S'] THEN CRTable.PrintSymbolTable;
  Close(lst);
  Close(src);
END. (* CR *)