test/derived/CalcLex.m3


MODULE CalcLex;
Generated by klex
IMPORT CalcTok;
IMPORT TextRd;
IMPORT Rd, Thread;
IMPORT SeekRd;
FROM CalcTok IMPORT Token;
<* FATAL Rd.Failure, Thread.Alerted *>

REVEAL
  T = Public BRANDED "CalcLex" OBJECT
    textCache: TEXT;
    charCache: CHAR;
    posBeforeToken: INTEGER;
    rd: Rd.T;
    allocate_LETTER: CalcTok.Allocator := NIL;
    allocate_DIGIT: CalcTok.Allocator := NIL;
  OVERRIDES
    setRd := SetRd;
    get := Get;
    unget := Unget;
    error := Error;
    rewind := Rewind;
    fromText := FromText;
    getRd := GetRd;
    getText := GetText;
    purge := Purge;
    LETTER := LETTER;
    DIGIT := DIGIT;
    char := char;
    skip := skip;
  END;

TYPE
  Byte = BITS 8 FOR [0..255];
  StateRef = BITS 4 FOR [0..8];
  TransRef = BITS 2 FOR [0..2];
  OutCode = BITS 3 FOR [0..6];

  S = RECORD
    keyBegin, keyEnd: Byte;
    target: StateRef;
    next: TransRef;
    output: OutCode;
  END;
  X = RECORD
    keyBegin, keyEnd: Byte;
    target: StateRef;
    next: TransRef;
  END;

CONST
  First = ARRAY CHAR OF [0..8] {
    0, 2, 2, 2, 2, 2, 2, 2, 2, 3, 4, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
    2, 2, 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, 2, 4, 4, 4, 4, 2, 4, 2, 4, 5, 5,
    5, 5, 5, 5, 5, 5, 5, 5, 6, 2, 2, 2, 2, 2, 2, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 2, 2, 2, 2, 7, 2, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 2, 2,
    2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
    2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
    2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
    2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
    2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
    2, 2, 2, 2, 2, 2};

  States = ARRAY [1..8] OF S {
    S{0,0,0,0,5}, S{1,255,0,0,6}, S{9,9,3,2,5}, S{1,255,0,0,4},
    S{1,255,0,0,3}, S{61,61,8,1,6}, S{1,255,0,0,2}, S{1,255,0,0,1}};

  Trans = ARRAY [1..2] OF X {
    X{1,255,0,0}, X{32,32,3,1}};

PROCEDURE SetRd(self: T; rd: Rd.T): CalcTok.RdLexer =
  BEGIN
    self.textCache := "";
    self.charCache := '\000';
    self.posBeforeToken := -1;
    self.rd := rd;
    RETURN self;
  END SetRd;

PROCEDURE NextCode(self: T): OutCode RAISES {Rd.EndOfFile} =
  VAR
    rd := self.rd;
    lastAcceptingOutput: INTEGER := 0;
    lastAcceptingPos: INTEGER := Rd.Index(rd);
    firstChar := Rd.GetChar(rd);
    curState := First[firstChar];
    curTrans: INTEGER;
    c: Byte;
  BEGIN
    self.charCache := firstChar;
    self.posBeforeToken := lastAcceptingPos;
    TRY
      WHILE curState # 0 DO
        WITH state = States[curState] DO
          IF state.output # 0 THEN
            lastAcceptingOutput := state.output;
            lastAcceptingPos := Rd.Index(rd);
          END;
          IF state.keyBegin = 1 AND state.keyEnd = 255 THEN
            curState := state.target;
          ELSE
            c := ORD(Rd.GetChar(rd));
            IF c >= state.keyBegin AND c <= state.keyEnd THEN
              curState := state.target;
            ELSE
              curTrans := state.next;
              WHILE curTrans # 0 DO
                WITH trans = Trans[curTrans] DO
                  IF c >= trans.keyBegin AND c <= trans.keyEnd THEN
                    curState := trans.target;
                    curTrans := 0;
                  ELSE
                    curTrans := trans.next;
                  END;
                END;
              END;
            END;
          END;
        END;
      END;
    EXCEPT
    | Rd.EndOfFile =>
      IF lastAcceptingOutput = 0 THEN
        Rd.Seek(rd, lastAcceptingPos);
        RAISE Rd.EndOfFile;
      END;
    END;
    Rd.Seek(rd, lastAcceptingPos);
    RETURN lastAcceptingOutput;
  END NextCode;

PROCEDURE Get(self: T): Token RAISES {Rd.EndOfFile} =
  VAR
    result: Token;
  BEGIN
    SeekRd.DiscardPrevious(self.rd);
    REPEAT
      self.textCache := NIL;
      CASE NextCode(self) OF
      | 0 => <* ASSERT FALSE *> (* unmatched *)
      | 2 => result := self.LETTER();
      | 3 => result := self.DIGIT();
      | 4 => result := self.char();
      | 5 => result := self.skip();
      | 1 => result := CalcTok.NewConstToken(CalcTok.ASSIGN);
      | 6 => result := CalcTok.NewConstToken(CalcTok.ERROR);
      END;
    UNTIL result # NIL;
    RETURN result;
  END Get;

PROCEDURE Unget(self: T) =
  BEGIN
    <* ASSERT self.posBeforeToken # -1 *>
    Rd.Seek(self.rd, self.posBeforeToken);
    self.posBeforeToken := -1;
  END Unget;

PROCEDURE GetText(self: T): TEXT =
  VAR
    len: INTEGER;
  BEGIN
    IF self.textCache = NIL THEN
      <* ASSERT self.posBeforeToken # -1 *>
      len := Rd.Index(self.rd) - self.posBeforeToken;
      Rd.Seek(self.rd, self.posBeforeToken);
      self.textCache := Rd.GetText(self.rd, len);
    END;
    RETURN self.textCache;
  END GetText;

PROCEDURE Purge(self: T): INTEGER =
  BEGIN
    RETURN 0
    + CalcTok.Purge(self.allocate_LETTER)
    + CalcTok.Purge(self.allocate_DIGIT);
  END Purge;

PROCEDURE GetRd(self: T): Rd.T =
  BEGIN RETURN self.rd; END GetRd;

PROCEDURE Rewind(self: T) =
  BEGIN Rd.Seek(self.rd, 0); EVAL self.setRd(self.rd); END Rewind;

PROCEDURE FromText(self: T; t: TEXT): CalcTok.RdLexer =
  BEGIN RETURN self.setRd(TextRd.New(t)); END FromText;

PROCEDURE Error(self: T; message: TEXT) =
  BEGIN SeekRd.E(self.rd, message); END Error;
default token methods
PROCEDURE LETTER(self: T): Token = BEGIN
 RETURN CalcTok.NewPT(self.allocate_LETTER, TYPECODE(CalcTok.LETTER));END LETTER;

PROCEDURE DIGIT(self: T): Token = BEGIN
 RETURN CalcTok.NewPT(self.allocate_DIGIT, TYPECODE(CalcTok.DIGIT));END DIGIT;

PROCEDURE skip(self: T): Token = BEGIN
 EVAL self; RETURN NIL;END skip;

PROCEDURE char(self: T): Token =
  BEGIN RETURN CalcTok.NewConstToken(ORD(self.charCache)); END char;

BEGIN
END CalcLex.