MODULE M3CLex EXPORTS M3CLex, M3CLexF;

(***************************************************************************)
(*                      Copyright (C) Olivetti 1989                        *)
(*                          All Rights reserved                            *)
(*                                                                         *)
(* Use and copy of this software and preparation of derivative works based *)
(* upon this software are permitted to any person, provided this same      *)
(* copyright notice and the following Olivetti warranty disclaimer are     *) 
(* included in any copy of the software or any modification thereof or     *)
(* derivative work therefrom made by any person.                           *)
(*                                                                         *)
(* This software is made available AS IS and Olivetti disclaims all        *)
(* warranties with respect to this software, whether expressed or implied  *)
(* under any law, including all implied warranties of merchantibility and  *)
(* fitness for any purpose. In no event shall Olivetti be liable for any   *)
(* damages whatsoever resulting from loss of use, data or profits or       *)
(* otherwise arising out of or in connection with the use or performance   *)
(* of this software.                                                       *)
(***************************************************************************)

IMPORT Text, Fmt;
IMPORT IO, CharType;
IMPORT M3CToken, M3CHash, M3CReservedWord, M3CSrcPos, M3CLexF;


CONST
  MaxLookahead = 3;
(* Need three characters lookahead for lexing, for example
   3.2E+A
which is not going to parse but lexes as a real literal followed by an
identifier followed by plus followed by another identifier.
  Actual lookahead buffer allows one more character for use when disabling the
lexer *)

REVEAL
  Buffer = BRANDED REF RECORD
    chars: ARRAY [0..2047] OF CHAR;
    overflow: Buffer := NIL;
  END;

REVEAL
  T = M3CLexF.T_public BRANDED OBJECT
    current := M3CToken.T.Void;
    disabled := FALSE;
    lookahead: CARDINAL := 0;
    lookaheadBuffer: ARRAY [0..MaxLookahead] OF CHAR;
  END;


PROCEDURE New(
    s: IO.Stream;
    identifiers: M3CReservedWord.Table;
    literals: M3CHash.Table;
    callBack: CallBack;
    init: T := NIL)
    : T
    RAISES {}=
  VAR
    t: T;
  BEGIN
    IF init = NIL THEN t := NEW(T) ELSE t := init END;
    t.stream := s;
    t.identifiers := identifiers;
    t.literals := literals;
    t.callBack := callBack;
    t.line := 1;
    t.offset := 0;
    t.hashValue := M3CHash.NewValue();
    t.tokenBuffer := NEW(Buffer);
    RETURN t;
  END New;



<*INLINE*> PROCEDURE Get(t: T): CHAR RAISES {IO.Error, IO.EndOfStream}=
  BEGIN
    IF t.lookahead > 0 THEN
      DEC(t.lookahead);
      RETURN t.lookaheadBuffer[t.lookahead];
    ELSE
      RETURN IO.Get(t.stream);
    END;
  END Get;


<*INLINE*> PROCEDURE Unget(t: T; ch: CHAR) RAISES {}=
  BEGIN
    t.lookaheadBuffer[t.lookahead] := ch;
    INC(t.lookahead);
  END Unget;


(* Managing the token buffer; putting characters into the buffer and building
arrays or texts from the completed buffer *)

PROCEDURE BufferToChars(
    buffer: Buffer;
    length: CARDINAL)
    : REF ARRAY OF CHAR
    RAISES {}=
  VAR
    chars := NEW(REF ARRAY OF CHAR, length);
  BEGIN
    VAR
      mod: CARDINAL := length MOD NUMBER(buffer.chars);
      pos: CARDINAL;
    BEGIN
      IF mod = 0 THEN mod := NUMBER(buffer.chars) END;
      pos := length - mod;
      IF mod # 0 THEN
        SUBARRAY(chars^, pos, mod) := SUBARRAY(buffer.chars, 0, mod);
      END;
      WHILE pos # 0 DO
        buffer := buffer.overflow;
        DEC(pos, NUMBER(buffer.chars));
        SUBARRAY(chars^, pos, NUMBER(buffer.chars)) := buffer.chars;
      END;
    END;
    RETURN chars;
  END BufferToChars;


PROCEDURE BufferToText(buffer: Buffer; length: CARDINAL): Text.T RAISES {}=
  BEGIN
    IF length <= NUMBER(buffer.chars) THEN
      RETURN Text.FromChars(SUBARRAY(buffer.chars, 0, length));
    ELSE
      RETURN Text.FromChars(BufferToChars(buffer, length)^);
    END;
  END BufferToText;


PROCEDURE AddOverflow(buffer: Buffer): Buffer RAISES {}=
  BEGIN
    RETURN NEW(Buffer, overflow := buffer);
  END AddOverflow;


<*INLINE*> PROCEDURE BufferPut(
    VAR buffer: Buffer;
    pos: CARDINAL;
    ch: CHAR)
    RAISES {}=
  VAR
    mod: CARDINAL := pos MOD NUMBER(buffer.chars);
  BEGIN
    IF mod = 0 AND pos # 0 THEN buffer := AddOverflow(buffer) END;
    buffer.chars[mod] := ch;
  END BufferPut;


<*INLINE*> PROCEDURE HashAndBufferPut(
    ch: CHAR;
    hashValue: M3CHash.Value;
    VAR buffer: Buffer;
    VAR pos: CARDINAL)
    RAISES {}=
  BEGIN
    BufferPut(buffer, pos, ch);
    M3CHash.AddCharToValue(ch, hashValue);
    INC(pos);
  END HashAndBufferPut;


(* Reading an identifier or reserved word *)

<*INLINE*> PROCEDURE IdOrReservedWord(
    t: T;
    hashValue: M3CHash.Value;
    READONLY chars: ARRAY OF CHAR)
    : M3CToken.T
    RAISES {}=
  VAR
    id := M3CHash.EnterCharsWithValue(t.identifiers, hashValue, chars);
  BEGIN
    TYPECASE id OF
    | M3CReservedWord.Id(r) =>
        RETURN M3CReservedWord.Token(r);
    | Symbol_rep(s) =>
        t.identifier := s;
        RETURN M3CToken.T.Identifier;
    END;
  END IdOrReservedWord;


PROCEDURE ReadId(t: T; firstCh: CHAR): M3CToken.T RAISES {IO.Error}=
  CONST
    IdentChars = CharType.AlphaNumeric + CharType.Set{'_'};
  VAR
    ch := firstCh;
    hashValue := t.hashValue;
    buffer := t.tokenBuffer;
    pos: CARDINAL := 0;
  BEGIN
    M3CHash.ResetValue(hashValue);
    TRY
      REPEAT
        HashAndBufferPut(ch, hashValue, buffer, pos);
        ch := Get(t);
      UNTIL NOT ch IN IdentChars;
      Unget(t, ch);
    EXCEPT
    | IO.EndOfStream =>
    END;
    INC(t.offset, pos - 1);
    IF pos <= NUMBER(buffer.chars) THEN
      WITH chars = SUBARRAY(buffer.chars, 0, pos) DO
        RETURN IdOrReservedWord(t, hashValue, chars);
      END;
    ELSE
      RETURN IdOrReservedWord(t, hashValue, BufferToChars(buffer, pos)^);
    END;
  END ReadId;


(* Reading numeric literals *)

CONST
  BadLiteralTail = " (bad literal)"; (* Appended to all bad literals *)

PROCEDURE EnterLiteral(
    t: T;
    ok: BOOLEAN;
    hashValue: M3CHash.Value;
    buffer: Buffer;
    length: CARDINAL)
    RAISES {}=
  BEGIN
    IF NOT ok THEN
      FOR i := 0 TO Text.Length(BadLiteralTail) - 1 DO
        HashAndBufferPut(
            Text.GetChar(BadLiteralTail, i), hashValue, buffer, length);
      END;
    END;
    IF length <= NUMBER(buffer.chars) THEN
      WITH chars = SUBARRAY(buffer.chars, 0, length) DO
        t.literal := M3CHash.EnterCharsWithValue(t.literals, hashValue, chars);
      END;
    ELSE
      t.literal := M3CHash.EnterCharsWithValue(
          t.literals, hashValue, BufferToChars(buffer, length)^);
    END;
  END EnterLiteral;


PROCEDURE CheckedGet(t: T; VAR eof: BOOLEAN): CHAR RAISES {IO.Error}=
  BEGIN
    TRY
      eof := FALSE;
      RETURN Get(t);
    EXCEPT
    | IO.EndOfStream =>
        eof := TRUE;
        RETURN '\000';
    END;
  END CheckedGet;


PROCEDURE CalculateBase(buffer: Buffer; pos: CARDINAL): CARDINAL RAISES {}=
  VAR
    mod := pos MOD NUMBER(buffer.chars);
    val := ORD(buffer.chars[mod]) - ORD('0');
  BEGIN
    IF pos > 0 THEN
      IF mod = 0 THEN buffer := buffer.overflow END;
      INC(val, CalculateBase(buffer, pos - 1) * 10);
    END;
    RETURN val;
  END CalculateBase;


PROCEDURE HexValue(ch: CHAR; VAR val: CARDINAL): BOOLEAN RAISES {}=
  BEGIN
    IF 'a' <= ch AND ch <= 'z' THEN
      val := ORD(ch) - ORD('a') + 10;
      RETURN TRUE;
    ELSIF 'A' <= ch AND ch <= 'Z' THEN
      val := ORD(ch) - ORD('A') + 10;
      RETURN TRUE;
    ELSIF '0' <= ch AND ch <= '9' THEN
      val := ORD(ch) - ORD('0');
      RETURN TRUE;
    ELSE
      RETURN FALSE;
    END; (* if *)
  END HexValue;


PROCEDURE ReadHexDigits(
    t: T;
    hashValue: M3CHash.Value;
    VAR buffer: Buffer;
    VAR pos: CARDINAL)
    : BOOLEAN
    RAISES {IO.Error}=
  VAR
    start := pos;
    eof: BOOLEAN;
    ch := CheckedGet(t, eof);
    val, base: CARDINAL;
    ok := TRUE;
  BEGIN
    IF HexValue(ch, val) THEN
      IF pos > 2 THEN
        base := 17; (* will force error; saves worry about overflow *)
      ELSE
        base := CalculateBase(buffer, pos - 1);
      END;
      IF 2 > base OR base > 16 THEN base := 16; ok := FALSE END;
      HashAndBufferPut('_', hashValue, buffer, pos);
      REPEAT
        IF val >= base THEN ok := FALSE END;
        HashAndBufferPut(ch, hashValue, buffer, pos);
        ch := CheckedGet(t, eof);
      UNTIL NOT HexValue(ch, val);
    END;
    IF NOT eof THEN Unget(t, ch) END;
    IF pos = start THEN Unget(t, '_') END;
    RETURN ok;
  END ReadHexDigits;


PROCEDURE ReadExponent(
    t: T;
    exponent: CHAR;
    hashValue: M3CHash.Value;
    VAR buffer: Buffer;
    VAR pos: CARDINAL)
    : M3CToken.T
    RAISES {IO.Error}=
  VAR
    sign := '\000';
    eof: BOOLEAN;
    ch := CheckedGet(t, eof);
  BEGIN
    IF ch = '-' OR ch = '+' THEN
      sign := ch;
      ch := CheckedGet(t, eof);
    END;
    IF ch IN CharType.Digit THEN
      HashAndBufferPut(exponent, hashValue, buffer, pos);
      IF sign # '\000' THEN
        HashAndBufferPut(sign, hashValue, buffer, pos);
      END;
      REPEAT
        HashAndBufferPut(ch, hashValue, buffer, pos);
        ch := CheckedGet(t, eof);
      UNTIL NOT ch IN CharType.Digit;
      IF NOT eof THEN Unget(t, ch) END;
      IF CharType.ToUpper(exponent) = 'D' THEN
        RETURN M3CToken.T.LongRealLiteral;
      ELSIF CharType.ToUpper(exponent) = 'X' THEN
        RETURN M3CToken.T.ExtendedLiteral;
      ELSE
        RETURN M3CToken.T.RealLiteral;
      END;
    ELSE
      IF NOT eof THEN Unget(t, ch) END;
      IF sign # '\000' THEN Unget(t, sign) END;
      Unget(t, exponent);
      RETURN M3CToken.T.RealLiteral;
    END;
  END ReadExponent;


PROCEDURE ReadRealOrRange(
    t: T;
    hashValue: M3CHash.Value;
    VAR buffer: Buffer;
    VAR pos: CARDINAL)
    : M3CToken.T
    RAISES {IO.Error}=
  VAR
    eof: BOOLEAN;
    ch := CheckedGet(t, eof);
  BEGIN
    IF ch IN CharType.Digit THEN
      HashAndBufferPut('.', hashValue, buffer, pos);
      REPEAT
        HashAndBufferPut(ch, hashValue, buffer, pos);
        ch := CheckedGet(t, eof);
      UNTIL NOT ch IN CharType.Digit;
      IF ch IN CharType.Set{'D', 'd', 'E', 'e', 'X', 'x'} THEN
        RETURN ReadExponent(t, ch, hashValue, buffer, pos);
      ELSE
        IF NOT eof THEN Unget(t, ch) END;
        RETURN M3CToken.T.RealLiteral;
      END;
    ELSE
      Unget(t, ch);
      Unget(t, '.');
      RETURN M3CToken.T.IntegerLiteral;
    END;
  END ReadRealOrRange;


PROCEDURE ReadNumericLiteral(
    t: T;
    firstCh: CHAR)
    : M3CToken.T
    RAISES {IO.Error}=
  VAR
    ch := firstCh;
    hashValue := t.hashValue;
    buffer := t.tokenBuffer;
    pos: CARDINAL := 0;
    result := M3CToken.T.IntegerLiteral;
    ok := TRUE;
  BEGIN
    M3CHash.ResetValue(hashValue);
    TRY
      REPEAT
        HashAndBufferPut(ch, hashValue, buffer, pos);
        ch := Get(t);
      UNTIL NOT ch IN CharType.Digit;
      IF ch = '_' THEN
        ok := ReadHexDigits(t, hashValue, buffer, pos);
      ELSIF ch = '.' THEN
        result := ReadRealOrRange(t, hashValue, buffer, pos);
      ELSE
        Unget(t, ch);
      END;
    EXCEPT
    | IO.EndOfStream =>
    END;
    INC(t.offset, pos - 1);
    EnterLiteral(t, ok, hashValue, buffer, pos);
    RETURN result;
  END ReadNumericLiteral;


(* Reading character and text literals *)

PROCEDURE ReadEscape(
    t: T;
    hashValue: M3CHash.Value;
    VAR buffer: Buffer;
    VAR pos: CARDINAL)
    : BOOLEAN
    RAISES {IO.Error, IO.EndOfStream}=
  CONST
    OctalDigits = CharType.Set{'0'..'7'};
    ValidEscapes = CharType.Set{
        'n', 't', 'r', 'f', M3CToken.Backslash, '\'', '\"'} +
        OctalDigits;
  VAR
    ch: CHAR;
  BEGIN
    ch := Get(t);
    IF ch IN ValidEscapes THEN
      HashAndBufferPut(ch, hashValue, buffer, pos);
      IF ch IN OctalDigits THEN
        FOR i := 1 TO 2 DO
          ch := Get(t);
          IF ch IN OctalDigits THEN
            HashAndBufferPut(ch, hashValue, buffer, pos);
          ELSE
            Unget(t, ch);
            RETURN FALSE;
          END;
        END;
      END;
      RETURN TRUE;
    ELSE
      Unget(t, ch);
      RETURN FALSE;
    END;
  END ReadEscape;


PROCEDURE ReadCharLiteral(t: T): M3CToken.T RAISES {IO.Error}=
  VAR
    ch: CHAR;
    hashValue := t.hashValue;
    buffer := t.tokenBuffer;
    pos: CARDINAL := 0;
    ok := TRUE;
  BEGIN
    M3CHash.ResetValue(hashValue);
    HashAndBufferPut('\'', hashValue, buffer, pos);
    TRY
      ch := Get(t);
      IF ch IN CharType.Printable - CharType.Set{'\''} THEN
        HashAndBufferPut(ch, hashValue, buffer, pos);
        IF ch = M3CToken.Backslash THEN
          ok := ReadEscape(t, hashValue, buffer, pos);
        END;
        ch := Get(t);
        IF ch = '\'' THEN
          HashAndBufferPut(ch, hashValue, buffer, pos);
        ELSE
          Unget(t, ch);
          ok := FALSE;
        END;
      ELSE
        Unget(t, ch);
        ok := FALSE;
      END;
    EXCEPT
    | IO.EndOfStream => ok := FALSE;
    END;
    INC(t.offset, pos - 1);
    EnterLiteral(t, ok, hashValue, buffer, pos);
    RETURN M3CToken.T.CharLiteral;
  END ReadCharLiteral;


PROCEDURE ReadTextLiteral(t: T): M3CToken.T RAISES {IO.Error}=
  VAR
    ch: CHAR;
    hashValue := t.hashValue;
    buffer := t.tokenBuffer;
    pos: CARDINAL := 0;
    ok := TRUE;
  BEGIN
    M3CHash.ResetValue(hashValue);
    HashAndBufferPut('\"', hashValue, buffer, pos);
    TRY
      LOOP
        ch := Get(t);
        IF ch IN CharType.Printable THEN
          HashAndBufferPut(ch, hashValue, buffer, pos);
          IF ch = M3CToken.Backslash THEN
            IF NOT ReadEscape(t, hashValue, buffer, pos) THEN ok := FALSE END;
          ELSIF ch = '\"' THEN
            EXIT;
          ELSE
            (* loop *)
          END;
        ELSE
          Unget(t, ch);
          ok := FALSE;
          EXIT;
        END;
      END;
    EXCEPT
    | IO.EndOfStream => ok := FALSE;
    END;
    INC(t.offset, pos - 1);
    EnterLiteral(t, ok, hashValue, buffer, pos);
    RETURN M3CToken.T.TextLiteral;
  END ReadTextLiteral;


(* Comments and pragmas *)

PROCEDURE ReadCommentOrPragmaSection(
    t: T;
    READONLY endOfSection: CharType.Set;
    VAR buffer: Buffer;
    VAR pos: CARDINAL)
    : CHAR
    RAISES {IO.Error, IO.EndOfStream}=
  BEGIN
    WITH n = NUMBER(buffer.chars) DO
      LOOP
        VAR
          mod: CARDINAL := pos MOD n;
          wanted: CARDINAL := n - mod;
          got: CARDINAL;
        BEGIN
          IF mod = 0 AND pos # 0 THEN buffer := AddOverflow(buffer) END;
          got := IO.GetUntil(t.stream,
              SUBARRAY(buffer.chars, mod, wanted), endOfSection);
          INC(pos, got);
          IF got > wanted THEN
            (* buffer overflow - loop to get new overflow section added *)
            DEC(pos);
          ELSE
            VAR
              save: Buffer := NIL;
            BEGIN
              IF mod = 0 AND got = 0 AND pos # 0 THEN
                (* new overflow section is empty and may not be needed if we
                 hit end of stream *)
                save := buffer;
                buffer := save.overflow;
              END;
              WITH ch = IO.Get(t.stream) DO
                IF save # NIL THEN
                  save.chars[0] := ch;
                  buffer := save;
                ELSE
                  BufferPut(buffer, pos, ch);
                END;
                INC(pos);
                RETURN ch;
              END;
            END;
          END;
        END;
      END;
    END;
  END ReadCommentOrPragmaSection;


PROCEDURE ReadCommentOrPragma(t: T; isComment: BOOLEAN) RAISES {IO.Error}=
  VAR
    nesting := 0;
    pos: CARDINAL := 2;
    startOfLine := pos - t.offset;
    startChar, endChar, ch: CHAR;
    endOfSection: CharType.Set;
    buffer := t.tokenBuffer;
  BEGIN
    IF isComment THEN
      startChar := '(';
      endChar := ')';
      endOfSection := CharType.EndOfLine + CharType.Set{'(', '*'};
    ELSE
      startChar := '<';
      endChar := '>';
      endOfSection := CharType.EndOfLine + CharType.Set{'<', '*'};
    END;

    BufferPut(buffer, 0, startChar);
    BufferPut(buffer, 1, '*');
    (* we know the lookahead buffer is empty at this point so we can safely
     use 'ReadCommentSection' which ignores the lookahead buffer *)
    TRY
      REPEAT
        ch := ReadCommentOrPragmaSection(t, endOfSection, buffer, pos);
        REPEAT
          VAR
            next: CHAR;
          BEGIN
            IF ch # startChar AND ch # '*' THEN
              (* must be newline *)
              INC(t.linesInToken);
              startOfLine := pos;
            END;
            next := IO.Get(t.stream);
            BufferPut(buffer, pos, next); INC(pos);
            IF ch = startChar THEN
              IF next = '*' THEN INC(nesting); EXIT END;
            ELSIF ch = '*' THEN
              IF next = endChar THEN DEC(nesting); EXIT END;
            END;
            ch := next;
          END;
        UNTIL NOT ch IN endOfSection;
      UNTIL nesting < 0;
    EXCEPT
    | IO.EndOfStream =>
    END;
    WITH text = BufferToText(buffer, pos) DO
      INC(t.line, t.linesInToken);
      t.offset := pos - startOfLine;
      IF startChar = '(' THEN
        t.callBack.comment(text);
      ELSE
        t.callBack.pragma(text);
      END;
    END;
    t.linesInToken := 0;
  END ReadCommentOrPragma;


(* Get next token *)

PROCEDURE GetNext(t: T) RAISES {IO.Error}=
  VAR
    ch: CHAR;
  BEGIN
    TRY
      t.linesInToken := 0;
      t.current := M3CToken.T.Void;
      LOOP
        t.startOfToken := t.offset;
        ch := Get(t); INC(t.offset);
        CASE ch OF
        | '\t', ' ', '\013', '\f' =>
        | '\n', '\r' =>
            INC(t.line);
            t.offset := 0;
        | 'A'..'Z', 'a'..'z' =>
            t.current := ReadId(t, ch);
            EXIT;
        | '0'..'9'=>
            t.current := ReadNumericLiteral(t, ch);
            EXIT;
        | '\'' =>
            t.current := ReadCharLiteral(t);
            EXIT;
        | '\"' =>
            t.current := ReadTextLiteral(t);
            EXIT;
        | '+' =>
            t.current := M3CToken.T.Plus;
            EXIT;
        | '-' =>
            t.current := M3CToken.T.Minus;
            EXIT;
        | '*' =>
            t.current := M3CToken.T.Times;
            EXIT;
        | '/' =>
            t.current := M3CToken.T.Divide;
            EXIT;
        | '<' =>
            t.current := M3CToken.T.LessThan;
            ch := Get(t); INC(t.offset);
            IF ch = '=' THEN
              t.current := M3CToken.T.LessThanOrEqual;
              EXIT;
            ELSIF ch = ':' THEN
              t.current := M3CToken.T.Subtype;
              EXIT;
            ELSIF ch = '*' THEN
              ReadCommentOrPragma(t, IsPragma);
            ELSE
              Unget(t, ch); DEC(t.offset);
              EXIT;
            END; (* if *)
        | '>' =>
            ch := Get(t); INC(t.offset);
            IF ch = '=' THEN
              t.current := M3CToken.T.GreaterThanOrEqual;
            ELSE
              Unget(t, ch); DEC(t.offset);
              t.current := M3CToken.T.GreaterThan;
            END; (* if *)
            EXIT;
        | '#' =>
            t.current := M3CToken.T.NotEqual;
            EXIT;
        | '=' =>
            t.current := M3CToken.T.Equal;
            ch := Get(t); INC(t.offset);
            IF ch = '>' THEN
              t.current := M3CToken.T.Implies;
            ELSE
              Unget(t, ch); DEC(t.offset);
            END; (* if *)
            EXIT;
        | '{' =>
            t.current := M3CToken.T.CurlyBra;
            EXIT;
        | '}' =>
            t.current := M3CToken.T.CurlyKet;
            EXIT;
        | '[' =>
            t.current := M3CToken.T.SquareBra;
            EXIT;
        | ']' =>
            t.current := M3CToken.T.SquareKet;
            EXIT;
        | '(' =>
            t.current := M3CToken.T.Bra;
            ch := Get(t); INC(t.offset);
            IF ch = '*' THEN
              ReadCommentOrPragma(t, IsComment);
            ELSE
              Unget(t, ch); DEC(t.offset);
              EXIT;
            END; (* if *)
        | ')' =>
            t.current := M3CToken.T.Ket;
            EXIT;
        | ';' =>
            t.current := M3CToken.T.Semicolon;
            EXIT;
        | '|' =>
            t.current := M3CToken.T.Bar;
            EXIT;
        | '^' =>
            t.current := M3CToken.T.Dereference;
            EXIT;
        | '.' =>
            t.current := M3CToken.T.Dot;
            ch := Get(t); INC(t.offset);
            IF ch = '.' THEN
              t.current := M3CToken.T.Range;
            ELSE
              Unget(t, ch); DEC(t.offset);
            END; (* if *)
            EXIT;
        | ':' =>
            t.current := M3CToken.T.Colon;
            ch := Get(t); INC(t.offset);
            IF ch = '=' THEN
              t.current := M3CToken.T.Becomes;
            ELSE
              Unget(t, ch); DEC(t.offset);
            END; (* if *)
            EXIT;
        | ',' =>
            t.current := M3CToken.T.Comma;
            EXIT;
        | '&' =>
            t.current := M3CToken.T.Ampersand;
            EXIT;
        ELSE
          IF t.disabled THEN
            Unget(t, '\000'); DEC(t.offset);
            EXIT;
          ELSE
            t.callBack.badChar(ch);
          END;
        END; (* case *)
      END;
    EXCEPT
    | IO.EndOfStream =>
    END;
  END GetNext;


<*INLINE*> PROCEDURE Current(t: T): M3CToken.T RAISES {}=
  BEGIN
    RETURN t.current;
  END Current;


<*INLINE*> PROCEDURE Next(t: T): M3CToken.T RAISES {IO.Error}=
  BEGIN
    GetNext(t);
    RETURN t.current;
  END Next;


<*INLINE*> PROCEDURE Position(t: T): M3CSrcPos.T RAISES {}=
  BEGIN
    RETURN M3CSrcPos.Pack(t.line - t.linesInToken, t.startOfToken);
  END Position;


<*INLINE*> PROCEDURE Literal(t: T): Literal_rep RAISES {}=
  BEGIN
    RETURN t.literal;
  END Literal;


<*INLINE*> PROCEDURE Identifier(t: T): Symbol_rep RAISES {}=
  BEGIN
    RETURN t.identifier;
  END Identifier;


PROCEDURE Reset(t: T; pos := M3CSrcPos.Null; s: IO.Stream := NIL) RAISES {}=
  BEGIN
    IF s # NIL THEN
      t.stream := s;
      IF pos = M3CSrcPos.Null THEN
        t.line := 1; t.offset := 0;
      END;
    END;
    IF pos # M3CSrcPos.Null THEN
      t.line := M3CSrcPos.Unpack(pos, t.offset);
    END;
    t.current := M3CToken.T.Void;
    t.identifier := NIL;
    t.literal := NIL;
    t.disabled := FALSE;
    t.linesInToken := 0;
    t.startOfToken := 0;
    t.lookahead := 0;
  END Reset;


PROCEDURE Disable(t: T) RAISES {}=
  BEGIN
    Unget(t, '\000');
    t.disabled := TRUE;
  END Disable;


PROCEDURE Disabled(t: T): BOOLEAN RAISES {}=
  BEGIN
    RETURN t.disabled;
  END Disabled;


PROCEDURE TokenToText(token: M3CToken.T): Text.T RAISES {}=
  BEGIN
    CASE token OF
    | FIRST(M3CToken.ReservedWord)..LAST(M3CToken.ReservedWord) =>
        RETURN M3CReservedWord.Array[token];
    | M3CToken.T.Identifier =>
        RETURN "identifier"
    | M3CToken.T.CharLiteral =>
        RETURN "char literal";
    | M3CToken.T.TextLiteral =>
        RETURN "text literal";
    | M3CToken.T.IntegerLiteral =>
        RETURN "integer literal";
    | M3CToken.T.RealLiteral =>
        RETURN "real literal";
    | M3CToken.T.LongRealLiteral =>
        RETURN "longreal literal";
    | M3CToken.T.ExtendedLiteral =>
        RETURN "extended literal";
    | M3CToken.T.Plus =>
        RETURN "\'+\'";
    | M3CToken.T.Minus =>
        RETURN "\'-\'";
    | M3CToken.T.Times =>
        RETURN "\'*\'";
    | M3CToken.T.Divide =>
        RETURN "\'/\'";
    | M3CToken.T.Equal =>
        RETURN "\'=\'";
    | M3CToken.T.NotEqual =>
        RETURN "\'#\'";
    | M3CToken.T.LessThan =>
        RETURN "\'<\'";
    | M3CToken.T.GreaterThan =>
        RETURN "\'>\'";
    | M3CToken.T.LessThanOrEqual =>
        RETURN "\'<=\'";
    | M3CToken.T.GreaterThanOrEqual =>
        RETURN "\'>=\'";
    | M3CToken.T.Ampersand =>
        RETURN "\'&\'";
    | M3CToken.T.Dereference =>
        RETURN "\'^\'";
    | M3CToken.T.Dot =>
        RETURN "\'.\'";
    | M3CToken.T.Bra =>
        RETURN "\'(\'";
    | M3CToken.T.Ket =>
        RETURN "\')\'";
    | M3CToken.T.CurlyBra =>
        RETURN "\'{\'";
    | M3CToken.T.CurlyKet =>
        RETURN "\'}\'";
    | M3CToken.T.SquareBra =>
        RETURN "\'[\'";
    | M3CToken.T.SquareKet =>
        RETURN "\']\'";
    | M3CToken.T.Becomes =>
        RETURN "\':=\'";
    | M3CToken.T.Semicolon =>
        RETURN "\';\'";
    | M3CToken.T.Comma =>
        RETURN "\',\'";
    | M3CToken.T.Colon =>
        RETURN "\':\'";
    | M3CToken.T.Bar =>
        RETURN "\'|\'";
    | M3CToken.T.Range =>
        RETURN "\'..\'";
    | M3CToken.T.Subtype =>
        RETURN "\'<:\'";
    | M3CToken.T.Implies =>
        RETURN "\'=>\'";
    | M3CToken.T.Void =>
        RETURN "end of stream";
    END; (* case *)
  END TokenToText;


PROCEDURE CurrentTokenToText(t: T): Text.T RAISES {}=
  VAR
    text := TokenToText(t.current);
  BEGIN
    CASE t.current OF
    | M3CToken.T.Identifier =>
        text := Fmt.F("identifier \'%s\'", M3CHash.IdToText(t.identifier));
    | FIRST(M3CToken.Literal)..LAST(M3CToken.Literal) =>
        text := Fmt.F("%s %s", text, M3CHash.IdToText(t.literal));
    ELSE
    END;
    RETURN text;
  END CurrentTokenToText;


BEGIN
END M3CLex.