IMPLEMENTATION MODULE YaflLex;

FROM Conversions IMPORT IntConversions, RealConversions;
IMPORT String;
IMPORT Space;
FROM YaflCfg IMPORT YaflCfg;
FROM YaflError IMPORT MainErrorHandler;
IMPORT SYSTEM;

  CLASS Comment;
    VAR
      TheText: ARRAY OF CHAR;
      TheLineNr, TheColNr: INTEGER;

    REDEFINE METHOD CREATE (LineNr, ColNr: INTEGER;
                            Text: ARRAY OF CHAR);
      BEGIN
      ASSERT Text <> VOID;
      TheLineNr := LineNr;
      TheColNr := ColNr;
      TheText := Text;
      END CREATE;

    METHOD LineNr: INTEGER;
      BEGIN
      RESULT := TheLineNr;
      END LineNr;

    METHOD ColNr: INTEGER;
      BEGIN
      RESULT := TheColNr;
      END ColNr;

    METHOD Text: ARRAY OF CHAR;
      BEGIN
      RESULT := TheText;
      END Text;
      
    METHOD IsTrivial: BOOLEAN;
      BEGIN
      RESULT := TRUE;
      ASSERT TheText <> VOID;
      FOR i := 0 TO TheText.SIZE - 1 WHILE RESULT DO
        IF (TheText[i] <> ' ') AND (TheText[i] <> '-') THEN
          RESULT := FALSE;
          END;
        END;       
      END IsTrivial;

   END Comment;
----------------------------------------------------------
  ONCE CLASS CharStream;
    VAR
      FlagEof: BOOLEAN;
      TheLex: LexicalAnalyzer;
      CurLine: ARRAY OF CHAR;
      LineLength, TheLineNr, TheColNr: INTEGER;

    METHOD Attach(Lex: LexicalAnalyzer);
      BEGIN
      TheLex := Lex;
      TheLineNr := 0;
      TheColNr := 0;
      CurLine := VOID;
      LineLength := -1;
      FlagEof := FALSE;
      END Attach;

    METHOD GetNextLine;
      BEGIN
      CurLine := TheLex.GetLine;
      IF CurLine = VOID THEN
        FlagEof := TRUE;
        LineLength := 0;
       ELSE
        TheLineNr := TheLineNr + 1;
        TheColNr := 0;
        LineLength := CurLine.SIZE;
        END;
      END GetNextLine;

    METHOD Trail: ARRAY OF CHAR;  -- What remains of current line
      BEGIN
      IF CurLine <> VOID THEN
        RESULT := String.Right (CurLine, CurLine.SIZE - TheColNr);
	ASSERT RESULT <> VOID;
        END;
      END Trail;

    METHOD GetCh: CHAR;
      BEGIN
      IF (TheLineNr = 0) OR (TheColNr > LineLength) THEN
        RESULT := ' ';
        GetNextLine;
       ELSIF TheColNr = LineLength THEN
        RESULT := ' ';
        TheColNr := TheColNr + 1;
       ELSE
        RESULT := CurLine [TheColNr];
        TheColNr := TheColNr + 1;
        END;
      END GetCh;

    METHOD Next: CHAR;
      BEGIN
      IF (CurLine <> VOID) AND (TheColNr < CurLine.SIZE) THEN
        RESULT := CurLine [TheColNr];
        END;
      END Next;

    METHOD IsEof: BOOLEAN;
      BEGIN
      RESULT := FlagEof;
      END IsEof;

    METHOD LineNr: INTEGER;
      BEGIN
      RESULT := TheLineNr;
      END LineNr;

    METHOD ColNr: INTEGER;
      BEGIN
      RESULT := TheColNr;
      END ColNr;

    END CharStream;
----------------------------------------------------------
  CLASS LexicalAnalyzer;
    VAR
      Ch: ONCE CHAR;
      Buffer: ONCE ARRAY OF CHAR;

      TheLexemeLineNr, TheLexemeColNr,
      NbrErr: INTEGER;
      CommentsFlag,
      OkFlag: BOOLEAN;

      TheReal: REAL;
      TheInteger: INTEGER;
      TheString,
      TheIdent,
      TheInline: ARRAY OF CHAR;

      TheToken: INTEGER;
      TheUdfCode : INTEGER;

      CommentList: List(Comment);

    REDEFINE METHOD CREATE (KeepComments: BOOLEAN);
      BEGIN
      IF Buffer = VOID THEN
        Buffer.CREATE (512);
        END;
      Ch := " ";
      OkFlag := TRUE;
      CharStream.Attach (THIS);
      CommentsFlag := KeepComments;
      END CREATE;

    METHOD GetNum;
      VAR
        Ind, TempInt : INTEGER;
        TempReal : REAL;
      BEGIN
      Buffer[0] := Ch;
      Ind := Ind + 1;
      Ch := CharStream.GetCh;
      WHILE (Ch >= '0') AND (Ch <= '9') DO
        Buffer[Ind] := Ch;
        Ind := Ind + 1;
        Ch := CharStream.GetCh;
        END;
      IF Ch = '.' THEN -- Temp represents a real number
        Buffer[Ind] := Ch;
        Ind := Ind + 1;
        Ch := CharStream.GetCh;
        IF (Ch >= '0') AND (Ch <= '9') THEN
          Buffer[Ind] := Ch;
          Ind := Ind + 1;
          Ch := CharStream.GetCh;
          WHILE (Ch >= '0') AND (Ch <= '9') DO
            Buffer[Ind] := Ch;
            Ind := Ind + 1;
            Ch := CharStream.GetCh;
            END;
          TempReal := RealConversions.StringToReal(Buffer.SLICE(0, Ind));
          IF (RealConversions.ErrorCode = RealConversions.NoError) THEN
            TheReal := TempReal;
            TheToken := Real;
            END;
          END;
       ELSE  -- Temp represents an integer number
        TempInt := IntConversions.StringToInt(Buffer.SLICE(0, Ind));
        IF (IntConversions.ErrorCode = IntConversions.NoError) THEN
          TheInteger := TempInt;
          TheToken := Integer;
          END;
        END;
      IF TheToken = 0 THEN
        TheToken := ErrorToken;
        NbrErr := NbrErr + 1;
        END;
      END GetNum;

    METHOD LineNr: INTEGER;
     BEGIN
     RESULT := TheLexemeLineNr;
     END LineNr;

    METHOD ColNr: INTEGER;
     BEGIN
     RESULT := TheLexemeColNr;
     END ColNr;

    METHOD GetIdent;
      VAR
        Ind : INTEGER;
        StringEl: StringElement;

      BEGIN
      WHILE SYSTEM.IsLetter(Ch) OR SYSTEM.IsDigit(Ch) OR (Ch = '_') DO
        ASSERT Ind < 40;
        Buffer[Ind] := Ch;
        Ind := Ind + 1;
        Ch := CharStream.GetCh;
        END;
      ASSERT Ind > 0;
      StringEl := Space.StorePartialElement (Buffer, Ind);
      ASSERT StringEl <> VOID;
      ASSERT String.LimitedCompare (StringEl.Text, Buffer, Ind) = String.Equal;
      WHAT StringEl OF
        -----------------------------------
        -- IS instead of IN for performance
        -----------------------------------
        IS TokenElement:
          TheToken := TAG.TokenNr;
          TheIdent := VOID;
          END;
        IS UserDefinedToken:
          TheToken := UdfToken;
          TheUdfCode := TAG.Code;
          TheIdent := VOID;
          END;
       ELSE
        TheToken := Ident;
        TheIdent := StringEl.Text;
        END;
      END GetIdent;

    METHOD GetString(QuoteChar: CHAR);
      VAR
        OrgTheLineNr, Used: INTEGER;
      BEGIN
      Ch := CharStream.GetCh;
      OrgTheLineNr := CharStream.LineNr;
      WHILE (Ch <> QuoteChar) AND (CharStream.LineNr = OrgTheLineNr) DO
        Buffer[Used] := Ch;
        Used := Used + 1;
        Ch := CharStream.GetCh;
        END;
      Ch := CharStream.GetCh;
      TheString := Buffer.SLICE (0, Used);
      TheToken := StringToken;
      END GetString;

    METHOD GetInline;
      VAR
        b: ONCE ARRAY OF CHAR;
        OrgTheLineNr, Used: INTEGER;
      BEGIN
      IF b = VOID THEN
        b.CREATE (500);
        END;
      Ch := CharStream.GetCh;
      OrgTheLineNr := CharStream.LineNr;
      WHILE CharStream.LineNr = OrgTheLineNr DO
        b[Used] := Ch;
        Used := Used + 1;
        Ch := CharStream.GetCh;
        END;
      ASSERT Used <> 0;
      TheInline := b.SLICE(0, Used);
      TheToken := InlineString;
      END GetInline;

    METHOD GetComment;
      VAR
        Comm: Comment;
      BEGIN
      Comm.CREATE (CharStream.LineNr, CharStream.ColNr - 2, CharStream.Trail);
      IF CommentList = VOID THEN
        CommentList.CREATE;
        END;
      CommentList.Append (Comm);
      END GetComment;
      
    VAR
      CharToken: ONCE ARRAY OF INTEGER;
    CONST
      WhiteSpace = -1;
      
    METHOD InitCharToken;
    
      VAR
        a: ARRAY OF CHAR;
        p: ARRAY OF ARRAY OF CHAR;
        
      METHOD SetChar (Ch: CHAR;
                      Code: INTEGER);
        BEGIN
        CharToken[SYSTEM.ORD(Ch)] := Code;
        END SetChar;
                              
      BEGIN             
      ASSERT CharToken = VOID;
      CharToken.CREATE (256);
      SetChar ('(', LeftParen);
      SetChar (')', RightParen);
      SetChar ('[', LeftBracket);
      SetChar (']', RightBracket);
      SetChar ('{', LeftBrace);
      SetChar ('}', RightBrace);
      SetChar ('=', Equal);
      SetChar (',', Comma);
      SetChar ('.', Dot);
      SetChar (';', SemiColon);
      SetChar ('+', Plus);
      SetChar ('\', BackSlash);
      SetChar ('/', Slash);
      SetChar ('*', Star);
      SetChar ('?', QuestionMark      );
      SetChar ('|', Bar               );
      SetChar ('#', Sharp             );
      SetChar ('@', Arobas            );
      SetChar ('$', Dollar            );
      SetChar ('\', BackSlash         );
      SetChar ('&', Ampersand         );
      SetChar (' ', WhiteSpace        );
      FOR i := SYSTEM.Tab TO SYSTEM.NewLine DO
        CharToken [i] := WhiteSpace;
        END;
      a := YaflCfg.FindValue ("LEX_WS");
      IF a <> VOID THEN
        p := String.BreakInWords (a, " ,:.", VOID);
        IF p <> VOID THEN
          FOR i := 0 TO p.SIZE - 1 DO
            CharToken [IntConversions.StringToInt(p[i])] := WhiteSpace;
            END;
          END;
        END;
      END InitCharToken;

    METHOD GetToken;
      BEGIN
      IF CharStream.IsEof THEN
        TheToken := Eof;
       ELSE
        TheToken := 0;
        IF CharToken = VOID THEN
          InitCharToken;
          END;           
        WHILE TheToken = 0 DO
          WHILE (CharToken[SYSTEM.ORD(Ch)] = WhiteSpace) AND
                                   NOT CharStream.IsEof DO
            Ch := CharStream.GetCh;
            END;
          TheLexemeColNr := CharStream.ColNr;
          TheLexemeLineNr := CharStream.LineNr;
          IF CharStream.IsEof THEN
            TheToken := Eof;
           ELSE
            IF CharToken[SYSTEM.ORD(Ch)] > 0 THEN
              TheToken := CharToken[SYSTEM.ORD(Ch)];
              Ch := CharStream.GetCh;
             ELSIF SYSTEM.IsLetter (Ch) THEN
              GetIdent;
             ELSIF SYSTEM.IsDigit (Ch) THEN
              GetNum;
             ELSE  
              CASE Ch OF
               '<':
                 Ch := CharStream.GetCh;
                 IF Ch = '>' THEN
                   TheToken := NonEqual;
                   Ch := CharStream.GetCh;
                  ELSIF Ch = '=' THEN
                   TheToken := SmallerEqual;
                   Ch := CharStream.GetCh;
                  ELSE
                   TheToken := Smaller;
                   END;
                 END;
               '"', "'":
                 GetString(Ch);
                 END;
               '>':
                 Ch := CharStream.GetCh;
                 IF Ch = '=' THEN
                   TheToken := GreaterEqual;
                   Ch := CharStream.GetCh;
                  ELSE
                   TheToken := Greater;
                   END;
                 END;
               '-':
                 Ch := CharStream.GetCh;
                 IF Ch = '-' THEN
                   IF CommentsFlag THEN -- Add the comment to the comment pool
                     GetComment;
                     END;
                   CharStream.GetNextLine;
                   Ch := CharStream.GetCh;
                  ELSE
                   TheToken := Minus;
                   END;
                 END;
               ':':
                 Ch := CharStream.GetCh;
                 CASE Ch OF
                   '=':
                     TheToken := Becomes;
                     Ch := CharStream.GetCh;
                     END;
                   '-':
                     TheToken := BigDot;  
                     Ch := CharStream.GetCh;
                     END;
                  ELSE
                   TheToken := Colon;
                   END;
                 END;
               '%':
                 GetInline;
                 END;
             ELSE
              Error ("Unexpected character (" + 
                     IntConversions.IntToString (SYSTEM.ORD(Ch),0) +
                     ")" );
              Ch := CharStream.GetCh;
              TheToken := ErrorToken;
              END;
            END;
          END;
        END;
      END;
    END GetToken;

    METHOD SkipWhiteSpace;
      BEGIN
      WHILE (Ch = ' ') AND NOT CharStream.IsEof DO
        WHILE (Ch = ' ') AND NOT CharStream.IsEof DO
          Ch := CharStream.GetCh;
          END;
        IF (Ch = '-') AND (CharStream.Next = '-') THEN
          Ch := CharStream.GetCh;
          GetComment;
          CharStream.GetNextLine;
          Ch := ' ';
          END;
        END;
      TheLexemeLineNr := CharStream.LineNr;
      TheLexemeColNr := CharStream.ColNr;
      END SkipWhiteSpace;

    METHOD CurrentToken: INTEGER;
      BEGIN
      RESULT := TheToken;
      END CurrentToken;

    METHOD Error (Message: ARRAY OF CHAR);
      BEGIN
      MainErrorHandler.SetError (CharStream.LineNr, CharStream.ColNr,
                                 Message);
      OkFlag := FALSE;
      END Error;

    METHOD Ok: BOOLEAN;
      BEGIN
      RESULT := OkFlag;
      END Ok;

    METHOD Reset;
      BEGIN
      OkFlag := TRUE;
      END Reset;

    METHOD Accept (Status: INTEGER);
      BEGIN
      IF TheToken = 0 THEN
        GetToken;
        END;
      IF TheToken = Status THEN
        GetToken;
       ELSE
        Error ('"'+ TokenString(Status) + '" expected, got "'
                       + TokenString(TheToken) + '"');
        END;
      END Accept;

    METHOD Skip (Status: INTEGER);
      BEGIN
      IF TheToken = Status THEN
        GetToken;
        END;
      END Skip;

    METHOD CurrentString: ARRAY OF CHAR;
      BEGIN
      RESULT := TheString;
      END CurrentString;

    METHOD CurrentInline: ARRAY OF CHAR;
      BEGIN
      RESULT := TheInline;
      END CurrentInline;

    METHOD CurrentIdent: ARRAY OF CHAR;
      BEGIN
      RESULT := TheIdent;
      END CurrentIdent;

    METHOD CurrentInteger: INTEGER;
      BEGIN
      RESULT := TheInteger;
      END CurrentInteger;

    METHOD CurrentReal: REAL;
      BEGIN
      RESULT := TheReal;
      END CurrentReal;
      
    METHOD CurrentUdfCode: INTEGER;
      BEGIN
      RESULT := TheUdfCode;
      END CurrentUdfCode;

    METHOD Init;
      BEGIN
      ReservedWords.Init;
      END Init;

    METHOD TokenString(Status: INTEGER): ARRAY OF CHAR;
      BEGIN
      CASE Status OF
        FirstSeparator TO LastSeparator:
          RESULT := Separators.GetSeparator (Status);
          END;
        FirstReserved TO LastReserved:
          RESULT := ReservedWords.GetReserved (Status);
          END;
        Integer:
          RESULT :=  "<integer>";
          END;
        Ident:
          RESULT :=  "<identifier[" + CurrentIdent + "]>";
          END;
        StringToken:
          RESULT :=  "<string>";
          END;
        Real:
          RESULT :=  "<real>";
          END;
        ErrorToken:
          RESULT :=  "<error>";
          END;
        Eof:
          RESULT :=  "<eof>";
          END;
        InlineString:
          RESULT := "%" + CurrentInline;
          END;    
        END;
      FOR i := 0 TO CharToken.SIZE - 1 WHILE RESULT = VOID DO
        IF CharToken[i] = Status THEN
          RESULT.CREATE(1);
          RESULT[0] := SYSTEM.CHR(i);
	  RESULT := RESULT + " (" + IntConversions.IntToString (i,0) + ")" ;
          END;
        END;
      END TokenString;

    METHOD CommentPool: List(Comment);
      BEGIN
      RESULT := CommentList;
      END CommentPool;

    METHOD ResetCommentPool;
      BEGIN
      CommentList := VOID;
      END ResetCommentPool;
      
  END LexicalAnalyzer;
------------------------------
  ONCE CLASS Separators;

    VAR
      Rsvd: ONCE ARRAY OF ARRAY OF CHAR;

    METHOD GetSeparator (Num: INTEGER): ARRAY OF CHAR;
      BEGIN
      RESULT := Rsvd [ Num - LexicalAnalyzer.FirstSeparator ];
      END GetSeparator;

    REDEFINE METHOD CREATE;
      BEGIN
      Rsvd.CREATE(LexicalAnalyzer.LastSeparator -
                  LexicalAnalyzer.FirstSeparator + 1);
      Rsvd[0] := "(";
      Rsvd[1] := ")";
      Rsvd[2] := "[";
      Rsvd[3] := "]";
      Rsvd[4] := "=";
      Rsvd[5] := ">";
      Rsvd[6] := ">=";
      Rsvd[7] := "<";
      Rsvd[8] := "<=";
      Rsvd[9] := "<>";
      Rsvd[10] := ",";
      Rsvd[11] := ".";
      Rsvd[12] := ":";
      Rsvd[13] := ";";
      Rsvd[14] := "+";
      Rsvd[15] := "-";
      Rsvd[16] := "*";
      Rsvd[17] := "/";
      Rsvd[18] := ":=";
      Rsvd[19] := ":-";
      END CREATE;

  END Separators;
--------------------------
  CLASS TokenElement;
    INHERITS StringElement;
    VAR
      TheTokenNr: INTEGER;

      REDEFINE METHOD CREATE (Text: ARRAY OF CHAR;
                              TokenNr: INTEGER);
        BEGIN
        TheTokenNr := TokenNr;
        BASE(Text);
        END CREATE;

      METHOD TokenNr: INTEGER;
        BEGIN
        RESULT := TheTokenNr;
        END TokenNr;

    END TokenElement;
--------------------------
  ONCE CLASS ReservedWords;
    VAR
      Data: ARRAY OF TokenElement;

    METHOD GetReserved ( Num: INTEGER ) : ARRAY OF CHAR;
      VAR
        i: INTEGER;
      BEGIN
      i := Num - LexicalAnalyzer.FirstReserved;
      ASSERT (i >= 0) AND (i < Data.SIZE);
      ASSERT Data[i] <> VOID;
      RESULT := Data [i].Text;
      END GetReserved;

    METHOD MakeKeyword (Text: ARRAY OF CHAR;
                        TokenNr: INTEGER);
      VAR
        TokEl: TokenElement;
        i: INTEGER;
      BEGIN
      TokEl.CREATE (Text, TokenNr);
      Space.StoreElement (TokEl);
      i := TokenNr - LexicalAnalyzer.FirstReserved;
      Data [i] := TokEl;
      END MakeKeyword;

    METHOD Init;
      BEGIN
      Data.CREATE (1+LexicalAnalyzer.LastReserved
                    -LexicalAnalyzer.FirstReserved);
      MakeKeyword ("ALL", LexicalAnalyzer.All);
      MakeKeyword ("AND", LexicalAnalyzer.And);
      MakeKeyword ("ARRAY", LexicalAnalyzer.Array);
      MakeKeyword ("ASSERT", LexicalAnalyzer.Assert);
      MakeKeyword ("BEGIN", LexicalAnalyzer.Begin);
      MakeKeyword ("BY", LexicalAnalyzer.By);
      MakeKeyword ("CASE", LexicalAnalyzer.Case);
      MakeKeyword ("CLASS", LexicalAnalyzer.Class);
      MakeKeyword ("CONST", LexicalAnalyzer.Const);
      MakeKeyword ("DEBUG", LexicalAnalyzer.Debug);
      MakeKeyword ("DEFERRED", LexicalAnalyzer.Deferred);
      MakeKeyword ("DEFINITION", LexicalAnalyzer.Definition);
      MakeKeyword ("DO", LexicalAnalyzer.Do);
      MakeKeyword ("ELSE", LexicalAnalyzer.Else);
      MakeKeyword ("ELSIF", LexicalAnalyzer.Elsif);
      MakeKeyword ("END", LexicalAnalyzer.End);
      MakeKeyword ("FIRST", LexicalAnalyzer.First);
      MakeKeyword ("FOR", LexicalAnalyzer.For);
      MakeKeyword ("FROM", LexicalAnalyzer.From);
      MakeKeyword ("HIDE", LexicalAnalyzer.Hide);
      MakeKeyword ("IF", LexicalAnalyzer.If);
      MakeKeyword ("IFF", LexicalAnalyzer.Iff);
      MakeKeyword ("IMPLEMENTATION", LexicalAnalyzer.Implementation);
      MakeKeyword ("IMPLIES", LexicalAnalyzer.Implies);
      MakeKeyword ("IMPORT", LexicalAnalyzer.Import);
      MakeKeyword ("IN", LexicalAnalyzer.In);
      MakeKeyword ("INHERITS", LexicalAnalyzer.Inherits);
      MakeKeyword ("INLINE", LexicalAnalyzer.Inline);
      MakeKeyword ("IS", LexicalAnalyzer.Is);
      MakeKeyword ("LAST", LexicalAnalyzer.Last);
      MakeKeyword ("METHOD", LexicalAnalyzer.Method);
      MakeKeyword ("MOD", LexicalAnalyzer.Mod);
      MakeKeyword ("MODULE", LexicalAnalyzer.Module);
      MakeKeyword ("NOT", LexicalAnalyzer.Not);
      MakeKeyword ("OF", LexicalAnalyzer.Of);
      MakeKeyword ("ONCE", LexicalAnalyzer.Once);
      MakeKeyword ("OR", LexicalAnalyzer.Or);
      MakeKeyword ("PRAGMA", LexicalAnalyzer.PragmaToken);
      MakeKeyword ("REDEFINE", LexicalAnalyzer.Redefine);
      MakeKeyword ("THEN", LexicalAnalyzer.Then);
      MakeKeyword ("TO", LexicalAnalyzer.To);
      MakeKeyword ("VAR", LexicalAnalyzer.Var);
      MakeKeyword ("WHAT", LexicalAnalyzer.What);
      MakeKeyword ("WHILE", LexicalAnalyzer.While);
      
      MakeKeyword ("PRE", LexicalAnalyzer.Pre);
      MakeKeyword ("POST", LexicalAnalyzer.Post);
      MakeKeyword ("INVARIANT", LexicalAnalyzer.Invariant);
      MakeKeyword ("OLD", LexicalAnalyzer.Old);
      MakeKeyword ("FOR_ALL", LexicalAnalyzer.ForAll);
      MakeKeyword ("THERE_IS", LexicalAnalyzer.ThereIs); 
      END Init;

    REDEFINE METHOD CREATE;
      BEGIN
      Init;
      END CREATE;

  END ReservedWords;
------------------------------------------
  CLASS UserDefinedToken;
    INHERITS StringElement;
    VAR
      TheCode: INTEGER;
    
    REDEFINE METHOD CREATE (Keyword: ARRAY OF CHAR;
                            Code: INTEGER);
      BEGIN
      TheCode := Code;
      BASE(Keyword);
      Space.StoreElement (THIS);
      END CREATE;
      
    METHOD Code: INTEGER;
      BEGIN
      RESULT := TheCode;
      END Code;
                                  
  END UserDefinedToken;                            
  
END YaflLex;
