$LSC (*ACFGILMOSX*)
(* COCO/R for MS-DOS grammar used to generate COCO/R itself
   as adapted by P.D. Terry, January 1992
   version 1.48p last modified Tue  11-17-98

   This is the special version for the TurboPascal compiler/compiler *)

COMPILER CR
USES CRTable, CRA, Sets;

CONST
  ident = 0; stringSym = 1;  (* symbol kind *)

PROCEDURE FixString (VAR name: STRING; len: INTEGER);
  VAR
    double, spaces: BOOLEAN;
    i: INTEGER;
  BEGIN
    IF len = 2 THEN BEGIN SemError(129); EXIT END;
    IF CRTable.ignoreCase THEN (* force uppercase *)
      FOR i := 2 TO len - 1 DO name[i] := UpCase(name[i]);
    double := FALSE; spaces := FALSE;
    FOR i := 2 TO len - 1 DO (* search for interior " or spaces *) BEGIN
      IF name[i] = '"' THEN double := TRUE;
      IF name[i] <= ' ' THEN spaces := TRUE;
    END;
    IF NOT double THEN (* force delimiters to be " quotes *) BEGIN
      name[1] := '"'; name[len] := '"'
    END;
    IF spaces THEN SemError(124);
  END;

PROCEDURE MatchLiteral (sp: INTEGER);
(* store string either as token or as literal *)
  VAR
    sn, sn1:  CRTable.SymbolNode;
    matchedSp: INTEGER;
  BEGIN
    CRTable.GetSym(sp, sn);
    CRA.MatchDFA(sn.name, sp, matchedSp);
    IF matchedSp <> CRTable.noSym
      THEN
        BEGIN
          CRTable.GetSym(matchedSp, sn1);
          sn1.struct := CRTable.classLitToken;
          CRTable.PutSym(matchedSp, sn1);
          sn.struct := CRTable.litToken
        END
      ELSE sn.struct := CRTable.classToken;
    CRTable.PutSym(sp, sn)
  END;

PROCEDURE SetCtx (gp: INTEGER);
(* set transition code to CRTable.contextTrans *)
  VAR
    gn: CRTable.GraphNode;
  BEGIN
    WHILE gp > 0 DO BEGIN
      CRTable.GetNode(gp, gn);
      IF (gn.typ = CRTable.chart) OR (gn.typ = CRTable.class)
        THEN BEGIN gn.p2 := CRTable.contextTrans; CRTable.PutNode(gp, gn) END
        ELSE IF (gn.typ = CRTable.opt) OR (gn.typ = CRTable.iter) THEN SetCtx(gn.p1)
        ELSE IF gn.typ = CRTable.alt THEN BEGIN SetCtx(gn.p1); SetCtx(gn.p2) END;
      gp := gn.next
    END
  END;

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

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

CHARACTERS

  letter   = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_".
  digit    = "0123456789".
  ctrl     = CHR(1) .. CHR(31).
  tab      = CHR(9).
  eol      = CHR(13).
  lf       = CHR(10).
  noQuote1 = ANY - '"' - ctrl.
  noQuote2 = ANY - "'" - ctrl.

IGNORE tab + eol + lf

TOKENS

  ident     = letter {letter | digit}.
  string    = '"' {noQuote1} '"' | "'" {noQuote2} "'".
  badstring = '"' {noQuote1} (eol | lf) | "'" {noQuote2} (eol | lf).
  number    = digit {digit}.

PRAGMAS

  Options = "$" {letter | digit} .
                (.CRS.GetName(CRS.nextPos, CRS.nextLen, s); SetOption(s);  .)

COMMENTS FROM "(*" TO "*)" NESTED
COMMENTS FROM "/*" TO "*/"

PRODUCTIONS

CR                             (. VAR
                                    ok, undef, hasAttrs: BOOLEAN;
                                    unknownSy,
                                    eofSy, gR:       INTEGER;
                                    gramLine, sp:    INTEGER;
                                    name, gramName:  CRTable.Name;
                                    sn:              CRTable.SymbolNode; .)
=
"COMPILER"
                               (. gramLine := CRS.line;
                                  eofSy := CRTable.NewSym(CRTable.t, 'EOF', 0);
                                  CRTable.genScanner := TRUE; CRTable.ignoreCase := FALSE;
                                  Sets.Clear(CRTable.ignored) .)
Ident <gramName>
[ "USES"                       (. CRTable.useDeclPos.beg := CRS.nextPos;
                                  CRTable.hasUses := TRUE .)
  ident { "," ident }          (. CRTable.useDeclPos.len := CRS.nextPos - CRTable.useDeclPos.beg;
                                  CRTable.useDeclPos.col := 0 .)
  ";" ]                        (. CRTable.semDeclPos.beg := CRS.nextPos .)
{ ANY }                        (. CRTable.semDeclPos.len := CRS.nextPos - CRTable.semDeclPos.beg;
                                  CRTable.semDeclPos.col := 0 .)
{ Declaration }
SYNC
"PRODUCTIONS"                  (. ok := Successful;
                                  IF ok AND CRTable.genScanner THEN CRA.MakeDeterministic(ok);
                                  IF NOT ok THEN SemError(127);
                                  CRTable.nNodes := 0 .)
{ Ident <name>                 (. sp := CRTable.FindSym(name); undef := sp = CRTable.noSym;
                                  IF undef
                                    THEN BEGIN
                                        sp := CRTable.NewSym(CRTable.nt, name, CRS.line);
                                        CRTable.GetSym(sp, sn)
                                      END
                                    ELSE BEGIN
                                      CRTable.GetSym(sp, sn);
                                      IF sn.typ = CRTable.nt
                                        THEN
                                          BEGIN IF sn.struct > 0 THEN SemError(107) END
                                        ELSE SemError(108);
                                      sn.line := CRS.line
                                    END;
                                  hasAttrs := sn.attrPos.beg >= 0 .)
  ( Attribs <sn.attrPos>       (. IF NOT undef AND NOT hasAttrs THEN SemError(105);
                                  CRTable.PutSym(sp, sn) .)
  |                            (. IF NOT undef AND hasAttrs THEN SemError(105) .)
  )
  [ SemText <sn.semPos>]
  WEAK "="
  Expression <sn.struct, gR>   (. CRTable.CompleteGraph(gR); CRTable.PutSym(sp, sn) .)
  WEAK "."
  }
  "END" Ident <name>           (. sp := CRTable.FindSym(gramName);
                                  IF sp = CRTable.noSym THEN SemError(111)
                                  ELSE BEGIN
                                    CRTable.GetSym(sp, sn);
                                    IF sn.attrPos.beg >= 0 THEN SemError(112);
                                    CRTable.root := CRTable.NewNode(CRTable.nt, sp, gramLine);
                                  END;
                                  IF name <> gramName THEN SemError(117)  .)
"."                            (. unknownSy := CRTable.NewSym(CRTable.t, 'not', 0) .)

.

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

Declaration                    (. VAR
                                    gL1, gR1, gL2, gR2: INTEGER;
                                    nested:             BOOLEAN; .)
= "CHARACTERS" { SetDecl }
| "TOKENS"     { TokenDecl <CRTable.t> }
| "NAMES"      { NameDecl }
| "PRAGMAS"    { TokenDecl <CRTable.pr> }
| "COMMENTS"
  "FROM" TokenExpr <gL1, gR1>
  "TO" TokenExpr <gL2, gR2>
  ( "NESTED"                   (. nested := TRUE .)
    |                          (. nested := FALSE .)
  )
                               (. CRA.NewComment(gL1, gL2, nested) .)
| "IGNORE"
  ( "CASE"                     (. CRTable.ignoreCase := TRUE .)
  | Set <CRTable.ignored>      (. IF Sets.IsIn(CRTable.ignored, 0) THEN SemError(119) .)
  )
.


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

SetDecl                        (. VAR
                                    c:    INTEGER;
                                    oneSet:  CRTable.CRTSet;
                                    name: CRTable.Name; .)
= Ident <name>                 (. c := CRTable.ClassWithName(name);
                                  IF c >= 0 THEN SemError(107) .)
  "=" Set <oneSet>                 (.c := CRTable.NewClass(name, oneSet) .)
  ".".

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

Set <VAR oneSet: CRTable.CRTSet>
                               (. VAR
                                    set2: CRTable.CRTSet; .)
= SimSet <oneSet>
  { "+" SimSet <set2>          (. Sets.Unite(oneSet, set2) .)
  | "-" SimSet <set2>          (. Sets.Differ(oneSet, set2) .)
  }.

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

SimSet <VAR oneSet: CRTable.CRTSet>
                               (. VAR
                                    i, n1, n2: INTEGER;
                                    c:         INTEGER;
                                    name:      CRTable.Name;
                                    s:         STRING; .)
= Ident <name>                 (. c := CRTable.ClassWithName(name);
                                  IF c < 0
                                    THEN BEGIN SemError(115); Sets.Clear(oneSet) END
                                    ELSE CRTable.GetClass(c, oneSet)  .)
| string                       (. CRS.GetName(CRS.pos, CRS.len, s);
                                  Sets.Clear(oneSet); i := 2;
                                  WHILE s[i] <> s[1] DO BEGIN
                                    IF CRTable.ignoreCase THEN s[i] := UpCase(s[i]);
                                    Sets.Incl(oneSet, ORD(s[i])); INC(i)
                                  END .)
| SingleChar <n1>
                               (. Sets.Clear(oneSet); Sets.Incl(oneSet, n1) .)

  [ ".." SingleChar <n2>       (. FOR i := n1 TO n2 DO Sets.Incl(oneSet, i) .)
                          ]