// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar:     dpglib.tokenLexer.g
// ============================================================================
unit dpglib.TokenLexer;

interface

uses
   System.Classes,
   dpglib.TokenLexerTokens,
   dpgrtl.lexer,
   dpgrtl.types,
   System.SysUtils;

type
   // =========================================================================
   // Class TTokenLexer declaration
   // =========================================================================
   TTokenLexer = class( TLexer)
   
   public // Protected grammar rules
          // Must callable from parser too
      procedure mDIGIT     ( pCreate: boolean);
      procedure mXDIGIT    ( pCreate: boolean);
   
   public   // Public grammar rules
      procedure mLPAREN    ( pCreate: boolean);
      procedure mRPAREN    ( pCreate: boolean);
      procedure mASSIGN    ( pCreate: boolean);
      procedure mSTRING    ( pCreate: boolean);
      procedure mID        ( pCreate: boolean);
      procedure mINT       ( pCreate: boolean);
      procedure mWS        ( pCreate: boolean);
      procedure mSLCOMMENT ( pCreate: boolean);
      procedure mMLCOMMENT ( pCreate: boolean);
   
   public
      function  NextToken: IToken; override;
   end;

implementation
uses
   dpgrtl.exception,
   dpgrtl.token;


// ============================================================================
// mLPAREN
// ============================================================================
procedure TTokenLexer.mLPAREN( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_LPAREN;
   
   match('(');
   
   if (_ttype <> TT_SKIP) and (pCreate = true) then
   begin
      _token            := makeToken( _ttype);
      _token.TokenText  := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
   end;
   
   ReturnToken := _token;
end;

// ============================================================================
// mRPAREN
// ============================================================================
procedure TTokenLexer.mRPAREN( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_RPAREN;
   
   match(')');
   
   if (_ttype <> TT_SKIP) and (pCreate = true) then
   begin
      _token            := makeToken( _ttype);
      _token.TokenText  := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
   end;
   
   ReturnToken := _token;
end;

// ============================================================================
// mASSIGN
// ============================================================================
procedure TTokenLexer.mASSIGN( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_ASSIGN;
   
   match('=');
   
   if (_ttype <> TT_SKIP) and (pCreate = true) then
   begin
      _token            := makeToken( _ttype);
      _token.TokenText  := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
   end;
   
   ReturnToken := _token;
end;

// ============================================================================
// mSTRING
// ============================================================================
procedure TTokenLexer.mSTRING( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_STRING;
   
   match('"');
   
   while(true) do
   begin
      if (( LA(1) in [#1..'!','#'..#255])) then
      begin
         matchNot('"');
      end
      
      else
         break;
   end;
   
   match('"');
   
   if (_ttype <> TT_SKIP) and (pCreate = true) then
   begin
      _token            := makeToken( _ttype);
      _token.TokenText  := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
   end;
   
   ReturnToken := _token;
end;

// ============================================================================
// mDIGIT
// ============================================================================
procedure TTokenLexer.mDIGIT( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_DIGIT;
   
   match( ['0'..'9']);
   
   if (_ttype <> TT_SKIP) and (pCreate = true) then
   begin
      _token            := makeToken( _ttype);
      _token.TokenText  := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
   end;
   
   ReturnToken := _token;
end;

// ============================================================================
// mXDIGIT
// ============================================================================
procedure TTokenLexer.mXDIGIT( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_XDIGIT;
   
   if (( LA(1) in ['0'..'9'])) then
   begin
      match( ['0'..'9']);
   end
   
   else if (( LA(1) in ['a'..'f'])) then
   begin
      match( ['a'..'f']);
   end
   
   else if (( LA(1) in ['A'..'F'])) then
   begin
      match( ['A'..'F']);
   end
   
   else
      Raise EMismatchedChar.Create( LA(1), ['0'..'9','A'..'F','a'..'f'], InputState.FileName, InputState.Line, InputState.Column);
   
   if (_ttype <> TT_SKIP) and (pCreate = true) then
   begin
      _token            := makeToken( _ttype);
      _token.TokenText  := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
   end;
   
   ReturnToken := _token;
end;

// ============================================================================
// mID
// ============================================================================
procedure TTokenLexer.mID( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_ID;
   
   if (( LA(1) in ['a'..'z'])) then
   begin
      match( ['a'..'z']);
   end
   
   else if (( LA(1) in ['A'..'Z'])) then
   begin
      match( ['A'..'Z']);
   end
   
   else
      Raise EMismatchedChar.Create( LA(1), ['A'..'Z','a'..'z'], InputState.FileName, InputState.Line, InputState.Column);
   
   while(true) do
   begin
      if (( LA(1) in ['a'..'z'])) then
      begin
         match( ['a'..'z']);
      end
      
      else if (( LA(1) in ['A'..'Z'])) then
      begin
         match( ['A'..'Z']);
      end
      
      else if (( LA(1) in ['_'])) then
      begin
         match('_');
      end
      
      else if (( LA(1) in ['0'..'9'])) then
      begin
         match( ['0'..'9']);
      end
      
      else
         break;
   end;
   
   
   if (_ttype <> TT_SKIP) and (pCreate = true) then
   begin
      _token            := makeToken( _ttype);
      _token.TokenText  := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
   end;
   
   ReturnToken := _token;
end;

// ============================================================================
// mINT
// ============================================================================
procedure TTokenLexer.mINT( pCreate: boolean);
var
   _begin: integer;
   _cnt_15: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_INT;
   
   _cnt_15 := 0;
   
   while(true) do
   begin
      if (( LA(1) in ['0'..'9'])) then
      begin
         mDIGIT(false);
      end
      
      else
      begin
         if _cnt_15 >= 1 then
            break
         else
            Raise EMismatchedChar.Create( LA(1), ['0'..'9'], InputState.FileName, InputState.Line, InputState.Column);
      end;
      
      INC(_cnt_15);
   end;
   
   if (_ttype <> TT_SKIP) and (pCreate = true) then
   begin
      _token            := makeToken( _ttype);
      _token.TokenText  := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
   end;
   
   ReturnToken := _token;
end;

// ============================================================================
// mWS
// ============================================================================
procedure TTokenLexer.mWS( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_WS;
   
   if (( LA(1) in [#13]) and (LA(2) in [#10])) then
   begin
      match(#13);
      match(#10);
      newLine;
   end
   
   else if (( LA(1) in [' '])) then
   begin
      match(' ');
   end
   
   else if (( LA(1) in [#9])) then
   begin
      match(#9);
   end
   
   else if (( LA(1) in [#13])) then
   begin
      match(#13);
      newLine;
   end
   
   else if (( LA(1) in [#10])) then
   begin
      match(#10);
      newLine;
   end
   
   else
      Raise EMismatchedChar.Create( LA(1), [#9..#10,#13,' '], InputState.FileName, InputState.Line, InputState.Column);
   _ttype := TT_SKIP;
   
   if (_ttype <> TT_SKIP) and (pCreate = true) then
   begin
      _token            := makeToken( _ttype);
      _token.TokenText  := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
   end;
   
   ReturnToken := _token;
end;

// ============================================================================
// mSLCOMMENT
// ============================================================================
procedure TTokenLexer.mSLCOMMENT( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_SLCOMMENT;
   
   match('//');
   
   while(true) do
   begin
      if (( LA(1) in [#1..#9,#11..#12,#14..#255])) then
      begin
         match( [#1..#9,#11..#12,#14..#255]);
      end
      
      else
         break;
   end;
   
   if (( LA(1) in [#13]) and (LA(2) in [#10])) then
   begin
      match(#13);
      match(#10);
      newLine;
   end
   
   else if (( LA(1) in [#13])) then
   begin
      match(#13);
      newLine;
   end
   
   else if (( LA(1) in [#10])) then
   begin
      match(#10);
      newLine;
   end
   
   else
      Raise EMismatchedChar.Create( LA(1), [#10,#13], InputState.FileName, InputState.Line, InputState.Column);
   _ttype := TT_SKIP;
   
   if (_ttype <> TT_SKIP) and (pCreate = true) then
   begin
      _token            := makeToken( _ttype);
      _token.TokenText  := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
   end;
   
   ReturnToken := _token;
end;

// ============================================================================
// mMLCOMMENT
// ============================================================================
procedure TTokenLexer.mMLCOMMENT( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_MLCOMMENT;
   
   match('(*');
   
   while(true) do
   begin
      // non-greedy exit test
      if( LA(1) in ['*']) and (LA(2) in [')']) then
         break;
         
      if (( LA(1) in [#13]) and (LA(2) in [#10])) then
      begin
         match(#13);
         match(#10);
         newLine;
      end
      
      else if (( LA(1) in [#13])) then
      begin
         match(#13);
         newLine;
      end
      
      else if (( LA(1) in [#10])) then
      begin
         match(#10);
         newLine;
      end
      
      else if (( LA(1) in [#1..#9,#11..#12,#14..#255])) then
      begin
         match( [#1..#9,#11..#12,#14..#255]);
      end
      
      else
         break;
   end;
   
   match('*)');
   _ttype := TT_SKIP;
   
   if (_ttype <> TT_SKIP) and (pCreate = true) then
   begin
      _token            := makeToken( _ttype);
      _token.TokenText  := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
   end;
   
   ReturnToken := _token;
end;

// ----------------------------------------------------------------------------
// NextToken
// ----------------------------------------------------------------------------
function TTokenLexer.NextToken : IToken;
var
   _first   : TCharSet;

begin
   _first := [#9..#10,#13,' ','"','('..')','/'..'9','=','A'..'Z','a'..'z'];
   
   while( true) do
   begin
      ResetText;
      
      try
         if (( LA(1) in ['(']) and (LA(2) in ['*'])) then
         begin
            mMLCOMMENT(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['('])) then
         begin
            mLPAREN(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in [')'])) then
         begin
            mRPAREN(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['='])) then
         begin
            mASSIGN(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['"'])) then
         begin
            mSTRING(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['A'..'Z','a'..'z'])) then
         begin
            mID(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['0'..'9'])) then
         begin
            mINT(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in [#9..#10,#13,' '])) then
         begin
            mWS(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['/'])) then
         begin
            mSLCOMMENT(true);
            result := ReturnToken;
         end
         
         else
         begin
            if LA(1) = EOF_CHAR then
            begin
               uponEof;
               result := TToken.Create(TT_EOF);
            end
            
            else
               Raise EMismatchedChar.Create(LA(1), _first, InputState.FileName, InputState.Line, InputState.Column);
         end;
         
         // --------------------------------------------------------------
         // If we found a SKIP token, then try again...
         // --------------------------------------------------------------
         if result = nil then
            continue;
            
         // --------------------------------------------------------------
         // Now we have a valid token, so exit the function
         // --------------------------------------------------------------
         break;
         
      except
         Raise;
      end;
   end;
end;

end.