Turbo Toolbox/Turbo_Toolbox.iso/dtx9202/pretty/prscan.mod

Modula Implementation | 1991-02-18 | 6.2 KB | 255 lines

IMPLEMENTATION MODULE PRSCAN;
(*****************************************************************************)
(*                              Modula-2 Scanner                             *)
(*                       (c) Peter Engels       1990                         *)
(*****************************************************************************)

FROM FIO IMPORT File,EOF,RdChar;

TYPE charset = SET OF CHAR;

VAR doubleperiod : BOOLEAN;
    crlfseen : BOOLEAN;
    lastch : CHAR;
    again : BOOLEAN;

  PROCEDURE InitScanner;

  BEGIN
    doubleperiod := FALSE;
    crlfseen := TRUE;
    again := FALSE
  END InitScanner;

  PROCEDURE ReadAgain;

  BEGIN
    again := TRUE
  END ReadAgain;

  PROCEDURE ReadChar (tin : File;
                      VAR ch : CHAR);

  BEGIN
    IF again THEN
      ch := lastch;
      again := FALSE
    ELSE
      ch := RdChar (tin);
      lastch := ch
    END
  END ReadChar;

  PROCEDURE GetToken (tin : File;
                      VAR token : TokenTyp);

  VAR ch : CHAR;

    PROCEDURE Letters (ch : CHAR) : BOOLEAN;

    BEGIN
      RETURN ch IN charset {'a'..'z','A'..'Z','_'}
    END Letters;

    PROCEDURE Numbers (ch : CHAR) : BOOLEAN;

    BEGIN
      RETURN ch IN charset {'0'..'9'}
    END Numbers;

    PROCEDURE getnextchar;

    BEGIN
      WITH token DO
        value [length] := ch;
        INC (length)
      END;
      ReadChar (tin,ch);
    END getnextchar;

    PROCEDURE getidentifier;

    BEGIN
      REPEAT
        getnextchar
      UNTIL ~ (Letters (ch) OR Numbers (ch));
      token.symbol := identifier
    END getidentifier;

    PROCEDURE getnumber;

    BEGIN
      REPEAT
        getnextchar
      UNTIL ~ Numbers (ch);
      IF ch = '.' THEN
        getnextchar;
        IF ~ Numbers (ch) THEN
          IF ch = '.' THEN
            doubleperiod := TRUE;
            DEC (token.length);
            token.symbol := number
          END;
          RETURN
        ELSE
          REPEAT
            getnextchar
          UNTIL ~ Numbers (ch);
          ch := CAP (ch);
          IF (ch = 'E') OR (ch = 'D') THEN
            getnextchar;
            IF (ch = '+') OR (ch = '-') THEN
              getnextchar;
              IF ~ Numbers (ch) THEN
                RETURN
              ELSE
                REPEAT
                  getnextchar
                UNTIL ~ Numbers (ch)
              END
            ELSE
              WHILE Numbers (ch) DO
                getnextchar
              END
            END
          END
        END
      ELSE
        ch := CAP (ch);
        IF ((ch >= 'A') & (ch <= 'F')) OR (ch = 'O') OR (ch = 'L') OR (ch =
           'H') THEN
          getnumber
        END
      END;
      token.symbol := number
    END getnumber;

    PROCEDURE getspecialchar;

    VAR lastchar : CHAR;

      PROCEDURE getstring;

      BEGIN
        WHILE (ch # lastchar) DO
          getnextchar;
          IF EOF THEN
            RETURN
          END
        END;
        getnextchar;
        token.symbol := stringsy
      END getstring;

    BEGIN
      WITH token DO
        lastchar := ch;
        getnextchar;
        CASE lastchar OF
        | '(' : IF ch = '*' THEN
                  symbol := opencom;
                  getnextchar;
                ELSE
                  symbol := lpar
                END
        | '.' : IF ch = '.' THEN
                  symbol := dblperiod;
                  getnextchar
                ELSE
                  symbol := period
                END
        | '<' : CASE ch OF
                | '=' : symbol := lesseq;
                        getnextchar
                | '>' : symbol := notequal;
                        getnextchar
                | '<' : symbol := shiftl;
                        getnextchar
                ELSE
                  symbol := less
                END
        | ':' : CASE ch OF
                | ':' : getnextchar;
                        IF ch = '=' THEN
                          symbol := alias;
                          getnextchar
                        ELSE
                          symbol := notallowed
                        END
                | '=' : symbol := define;
                        getnextchar
                ELSE
                  symbol := colon;
                END
        | '*' : IF ch = ')' THEN
                  symbol := closecom;
                  getnextchar;
                ELSE
                  symbol := operationsy
                END
        | '>' : IF ch = '=' THEN
                  symbol := greq;
                  getnextchar
                ELSIF ch = '>' THEN
                  symbol := shiftr;
                  getnextchar
                ELSE
                  symbol := gr
                END
        | ',' : symbol := comma
        | ';' : symbol := semicolon
        | '#' : symbol := notequal
        | '=' : symbol := equal
        | '~' : symbol := notsy
        | '&' : symbol := andsy
        | '^' : symbol := drefsy
        | ')' : symbol := rpar
        | '{' : symbol := lbr;
        | '}' : symbol := rbr;
        | '[' : symbol := lbk;
        | ']' : symbol := rbk;
        | "'",'"' : getstring
        | '|','!' : symbol := bar;
        | '+','-','/' : symbol := operationsy
        END
      END
    END getspecialchar;

  BEGIN
    WITH token DO
      length := 0;
      IF doubleperiod THEN
        ReadChar (tin,ch);
        value := '..';
        symbol := dblperiod;
        doubleperiod := FALSE
      ELSE
        symbol := notallowed;
        REPEAT
          ReadChar (tin,ch);
          IF ch = 12C THEN
            crlfseen := TRUE
          END
        UNTIL (ch > ' ') OR EOF;
        IF Letters (ch) THEN
          getidentifier
        ELSIF Numbers (ch) THEN
          getnumber
        ELSIF ch > ' ' THEN
          getspecialchar;
          IF (symbol = opencom) & crlfseen THEN
            value := '  (*';
            value [0] := CHR (13);
            value [1] := CHR (10);
            length := 4
          END
        END;
        crlfseen := FALSE;
        value [length] := 0C;
        ReadAgain
      END
    END
  END GetToken;

END PRSCAN.