cr.pas

一个Pascal语言分析器

         32 : Msg('"[" expected');
         33 : Msg('"]" expected');
         34 : Msg('"{" expected');
         35 : Msg('"}" expected');
         36 : Msg('"SYNC" expected');
         37 : Msg('"CONTEXT" expected');
         38 : Msg('"<" expected');
         39 : Msg('">" expected');
         40 : Msg('"<." expected');
         41 : Msg('".>" expected');
         42 : Msg('"(." expected');
         43 : Msg('".)" expected');
         44 : Msg('not expected');
         45 : Msg('invalid TokenFactor');
         46 : Msg('invalid Factor');
         47 : Msg('invalid Factor');
         48 : Msg('invalid Term');
         49 : Msg('invalid Symbol');
         50 : Msg('invalid SimSet');
         51 : Msg('invalid NameDecl');
         52 : Msg('this symbol not expected in TokenDecl');
         53 : Msg('invalid TokenDecl');
         54 : Msg('invalid Attribs');
         55 : Msg('invalid Declaration');
         56 : Msg('invalid Declaration');
         57 : Msg('invalid Declaration');
         58 : Msg('this symbol not expected in CR');
         59 : Msg('invalid CR');
       
        102 : Msg('string literal may not extend over line end');
        103 : Msg('a literal must not have attributes');
        104 : Msg('this symbol kind not allowed in production');
        105 : Msg('attribute mismatch between declaration and use');
        106 : Msg('undefined string in production');
        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
      WriteLn(lst, 'Listing:'); WriteLn(lst);
      srcPos := 0; nextErr := firstErr;
      GetLine(srcPos, line, eof); lnr := 1; errC := 0;
      WHILE NOT eof DO BEGIN
        WriteLn(lst, lnr:5, '  ', line);
        WHILE (nextErr <> NIL) AND (nextErr^.line = lnr) DO BEGIN
          PrintErr(line, nextErr^.nr, nextErr^.col); INC(errC);
          nextErr := nextErr^.next
        END;
        GetLine(srcPos, line, eof); INC(lnr);
      END;
      IF nextErr <> NIL THEN BEGIN
        WriteLn(lst, lnr:5);
        WHILE nextErr <> NIL DO BEGIN
          PrintErr(line, nextErr^.nr, nextErr^.col); INC(errC);
          nextErr := nextErr^.next
        END
      END;
      WriteLn(lst);
      Write(lst, errC:5, ' error');
      IF errC <> 1 THEN Write(lst, 's');
      WriteLn(lst); WriteLn(lst); WriteLn(lst);
    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
    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('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;
  Write('Coco/R (MS-DOS) - Compiler-Compiler V');
  WriteLn(Version);
  WriteLn('Turbo Pascal (TM) version by Pat Terry/Volker Pohlers ', ReleaseDate);
  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);
  FileIO.ExtractDirectory(GrammarName, directory);
  FileIO.ChangeExtension(GrammarName, LSTExt, lstFileName);
  FileIO.Open(lst, lstFileName, TRUE);
  WriteLn(lst, 'Coco/R - Compiler-Compiler V', Version);
  WriteLn(lst, 'Turbo Pascal (TM) version by Volker Pohlers/Pat Terry ', ReleaseDate);
  WriteLn(lst, 'Source file: ', GrammarName);
  WriteLn(lst);
  WriteLn; WriteLn('parsing file ', GrammarName);
  CRS.Error := StoreError;
  CRP.Parse;
  IF errors = 0
    THEN
      BEGIN
        Msg('testing grammar');
        WriteLn(lst, 'Grammar Tests:'); WriteLn(lst);
        CRTable.CompSymbolSets;
        CRTable.TestCompleteness(ok);
        IF ok THEN CRTable.TestIfAllNtReached(ok);
        IF ok THEN CRTable.FindCircularProductions(ok);
        IF ok THEN CRTable.TestIfNtToTerm(ok);
        IF ok THEN CRTable.LL1Test(ll1);
        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
            Msg('listing'); PrintListing;
            IF CRTable.ddt['X'] THEN CRTable.XRef;
          END;
        IF CRTable.ddt['N'] OR CRTable.symNames THEN
          BEGIN
            Msg('symbol name assignment');
            CRTable.AssignSymNames(CRTable.ddt['N'], CRTable.symNames);
          END;
        IF ok AND NOT CRTable.ddt['T'] THEN
          BEGIN
            Msg('generating parser');
            CRX.GenCompiler;
            IF CRTable.genScanner AND NOT CRTable.ddt['P'] THEN
              BEGIN Msg('generating scanner'); CRA.WriteScanner END;
            IF CRTable.ddt['C'] THEN
              BEGIN Msg('generating compiler'); CRC.WriteDriver END;
            CRX.WriteStatistics;
          END;
        IF NOT ok
          THEN Msg('Compilation ended with errors in grammar tests.')
          ELSE IF NOT ll1 THEN Msg('Compilation ended with LL(1) errors.')
          ELSE Msg('Compilation completed. No errors detected.');
      END
    ELSE
      BEGIN
        Msg('listing'); PrintListing;
        IF CRTable.ddt['X'] THEN CRTable.XRef;
        Msg('*** errors detected ***');
      END;
  IF CRTable.ddt['G'] THEN CRTable.PrintGraph;
  IF CRTable.ddt['S'] THEN CRTable.PrintSymbolTable;
  Close(lst);
  Close(src);
END. (* CR *)