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

interface

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

type
   // =========================================================================
   // Class TDpgLexer declaration
   // =========================================================================
   TDpgLexer = class( TLexer)
   
   protected // Internals
      procedure initialize; override;
   
   public // Protected grammar rules
          // Must callable from parser too
      procedure mESC         ( pCreate: boolean);
      procedure mDNUMBER     ( pCreate: boolean);
      procedure mXNUMBER     ( pCreate: boolean);
      function  mINT_RULEREF ( pCreate: boolean): integer;
      procedure mWS_LOOP     ( pCreate: boolean);
      procedure mSLCOMMENT   ( pCreate: boolean);
      procedure mMLCOMMENT1  ( pCreate: boolean);
      procedure mMLCOMMENT2  ( pCreate: boolean);
      procedure mDDIGIT      ( pCreate: boolean);
      procedure mXDIGIT      ( pCreate: boolean);
   
   public   // Public grammar rules
      procedure mLPAREN      ( pCreate: boolean);
      procedure mRPAREN      ( pCreate: boolean);
      procedure mRCURLY      ( pCreate: boolean);
      procedure mCOLON       ( pCreate: boolean);
      procedure mSEMI        ( pCreate: boolean);
      procedure mCOMMA       ( pCreate: boolean);
      procedure mASSIGN      ( pCreate: boolean);
      procedure mIMPLIES     ( pCreate: boolean);
      procedure mQUEST       ( pCreate: boolean);
      procedure mPLUS        ( pCreate: boolean);
      procedure mSTAR        ( pCreate: boolean);
      procedure mAT          ( pCreate: boolean);
      procedure mNOT         ( pCreate: boolean);
      procedure mOR          ( pCreate: boolean);
      procedure mBANG        ( pCreate: boolean);
      procedure mWILDCARD    ( pCreate: boolean);
      procedure mRANGE       ( pCreate: boolean);
      procedure mOPEN        ( pCreate: boolean);
      procedure mCLOSE       ( pCreate: boolean);
      procedure mCARET       ( pCreate: boolean);
      procedure mTREE_BEGIN  ( pCreate: boolean);
      procedure mCHARLIT     ( pCreate: boolean);
      procedure mSTRINGLIT   ( pCreate: boolean);
      procedure mINTEGER     ( pCreate: boolean);
      procedure mARGACTION   ( pCreate: boolean);
      procedure mACTION      ( pCreate: boolean);
      procedure mTOKENREF    ( pCreate: boolean);
      procedure mRULEREF     ( pCreate: boolean);
      procedure mCOMMENT     ( pCreate: boolean);
      procedure mWS          ( pCreate: boolean);
   
   public
      function  NextToken: IToken; override;
   end;

implementation
uses
   dpgrtl.exception,
   dpgrtl.token;


// ============================================================================
// mLPAREN
// ============================================================================
procedure TDpgLexer.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 TDpgLexer.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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_RCURLY;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_COLON;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_SEMI;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_COMMA;
   
   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 TDpgLexer.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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_IMPLIES;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_QUEST;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_PLUS;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_STAR;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_AT;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_NOT;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_OR;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_BANG;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_WILDCARD;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_RANGE;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_OPEN;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_CLOSE;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_CARET;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_TREE_BEGIN;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_CHARLIT;
   
   SaveConsumedInput := false;
   match('''');
   SaveConsumedInput := true;
   if (( LA(1) in ['\'])) then
   begin
      mESC(false);
   end
   
   else if (( LA(1) in [#1..'&','('..'[',']'..#255])) then
   begin
      matchNot('''');
   end
   
   else
      Raise EMismatchedChar.Create( LA(1), [#1..'&','('..#255], InputState.FileName, InputState.Line, InputState.Column);
   SaveConsumedInput := false;
   match('''');
   SaveConsumedInput := true;
   
   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;

// ============================================================================
// mESC
// ============================================================================
procedure TDpgLexer.mESC( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;
   d1: IToken;
   d2: IToken;
   number: AnsiString;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_ESC;
   
   SaveConsumedInput := false;
   match('\');
   SaveConsumedInput := true;
   if (( LA(1) in ['r'])) then
   begin
      match('r');
      TokenText[ Length( TokenText)] := AnsiChar(13);
   end
   
   else if (( LA(1) in ['n'])) then
   begin
      match('n');
      TokenText[ Length( TokenText)] := AnsiChar(10);
   end
   
   else if (( LA(1) in ['t'])) then
   begin
      match('t');
      TokenText[ Length( TokenText)] := AnsiChar(9);
   end
   
   else if (( LA(1) in ['\'])) then
   begin
      match('\');
   end
   
   else if (( LA(1) in [''''])) then
   begin
      match('''');
   end
   
   else if (( LA(1) in ['"'])) then
   begin
      match('"');
   end
   
   else if (( LA(1) in ['x'])) then
   begin
      match('x');
      _save := Length( TokenText);
      mXDIGIT(true);
      TokenText := Copy(TokenText, 1, _save);
      d1 := ReturnToken;
      _save := Length( TokenText);
      mXDIGIT(true);
      TokenText := Copy(TokenText, 1, _save);
      d2 := ReturnToken;
      number := '$' + d1.TokenText + d2.TokenText;
      TokenText[ Length( TokenText)] := AnsiChar( StrToInt( number));
   end
   
   else
      Raise EMismatchedChar.Create( LA(1), ['"','''','\','n','r','t','x'], 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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_STRINGLIT;
   
   match('"');
   
   while(true) do
   begin
      if (( LA(1) in ['\'])) then
      begin
         mESC(false);
      end
      
      else 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;

// ============================================================================
// mINTEGER
// ============================================================================
procedure TDpgLexer.mINTEGER( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;
   i: integer;
   v: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_INTEGER;
   
   if (( LA(1) in ['0'..'9'])) then
   begin
      mDNUMBER(false);
      v := 0;
      for i:=1 to Length( TokenText) do
      begin
         v := v * 10 + ord( TokenText[i]) - ord('0');
      end;
      
      TokenText := IntToStr( v);
   end
   
   else if (( LA(1) in ['$'])) then
   begin
      mXNUMBER(false);
      v := 0;
      for i:=1 to Length( TokenText) do
      begin
         case TokenText[i] of
            '0'..'9':   v := v * 16 + ord(TokenText[i]) - ord('0');
            'a'..'z':   v := v * 16 + ord(TokenText[i]) - ord('a');
            'A'..'Z':   v := v * 16 + ord(TokenText[i]) - ord('A');
         end;
      end;
      
      TokenText := IntToStr( v);
   end
   
   else
      Raise EMismatchedChar.Create( LA(1), ['$','0'..'9'], 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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_DNUMBER;
   
   match( ['0'..'9']);
   
   while(true) do
   begin
      if (( LA(1) in ['0'..'9'])) then
      begin
         mDDIGIT(false);
      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;

// ============================================================================
// mXNUMBER
// ============================================================================
procedure TDpgLexer.mXNUMBER( pCreate: boolean);
var
   _begin: integer;
   _cnt_64: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_XNUMBER;
   
   SaveConsumedInput := false;
   match('$');
   SaveConsumedInput := true;
   _cnt_64 := 0;
   
   while(true) do
   begin
      if (( LA(1) in ['0'..'9','A'..'F','a'..'f'])) then
      begin
         mXDIGIT(false);
      end
      
      else
      begin
         if _cnt_64 >= 1 then
            break
         else
            Raise EMismatchedChar.Create( LA(1), ['0'..'9','A'..'F','a'..'f'], InputState.FileName, InputState.Line, InputState.Column);
      end;
      
      INC(_cnt_64);
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_ARGACTION;
   
   SaveConsumedInput := false;
   match('[');
   SaveConsumedInput := true;
   
   while(true) do
   begin
      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
         matchNot(']');
      end
      
      else
         break;
   end;
   
   SaveConsumedInput := false;
   match(']');
   SaveConsumedInput := true;
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_ACTION;
   
   match('{');
   
   while(true) do
   begin
      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
         matchNot('}');
      end
      
      else
         break;
   end;
   
   match('}');
   if (( LA(1) in ['?'])) then
   begin
      SaveConsumedInput := false;
      match('?');
      SaveConsumedInput := true;
      _ttype := TT_SEMPRED;
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_TOKENREF;
   
   match( ['A'..'Z']);
   
   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;
   
   _ttype := TestLiteral( _ttype);
   
   
   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;

// ============================================================================
// mRULEREF
// ============================================================================
procedure TDpgLexer.mRULEREF( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;
   t: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_RULEREF;
   
   t := mINT_RULEREF(false);
   _ttype := t;
   if ( t = LT_uses) then
   begin
      mWS_LOOP(false);
      if (( LA(1) in ['{'])) then
      begin
         match('{');
         _ttype := TT_USES;
      end;
   end
   
   else if ( t = LT_options) then
   begin
      mWS_LOOP(false);
      if (( LA(1) in ['{'])) then
      begin
         match('{');
         _ttype := TT_OPTIONS;
      end;
   end
   
   else if ( t = LT_tokens) then
   begin
      mWS_LOOP(false);
      if (( LA(1) in ['{'])) then
      begin
         match('{');
         _ttype := TT_TOKENS;
      end;
   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_RULEREF
// ============================================================================
function  TDpgLexer.mINT_RULEREF( pCreate: boolean): integer;
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_INT_RULEREF;
   
   _ttype := TT_RULEREF;
   
   match( ['a'..'z']);
   
   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;
   
   result := TestLiteral( _ttype);
   
   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_LOOP
// ============================================================================
procedure TDpgLexer.mWS_LOOP( pCreate: boolean);
var
   _begin: integer;
   _save: integer;
   _token: IToken;
   _ttype: integer;

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_WS_LOOP;
   
   
   while(true) do
   begin
      if (( LA(1) in [#9..#10,#13,' '])) then
      begin
         mWS(false);
      end
      
      else if (( LA(1) in ['(','/'])) then
      begin
         mCOMMENT(false);
      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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_COMMENT;
   
   if (( LA(1) in ['/']) and (LA(2) in ['/'])) then
   begin
      mSLCOMMENT(false);
      _ttype := TT_SKIP;
   end
   
   else if (( LA(1) in ['/']) and (LA(2) in ['*'])) then
   begin
      mMLCOMMENT2(false);
      _ttype := TT_SKIP;
   end
   
   else if (( LA(1) in ['('])) then
   begin
      mMLCOMMENT1(false);
      _ttype := TT_SKIP;
   end
   
   else
      Raise EMismatchedChar.Create( LA(1), ['(','/'], 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;

// ============================================================================
// mSLCOMMENT
// ============================================================================
procedure TDpgLexer.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);
   
   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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_MLCOMMENT1;
   
   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
         matchNot( EOF_CHAR );
      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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_MLCOMMENT2;
   
   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
         matchNot( EOF_CHAR );
      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;

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

begin
   _begin   := Length( TokenText) +1;
   _token   := nil;
   _ttype   := TT_DDIGIT;
   
   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 TDpgLexer.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;

// ============================================================================
// mWS
// ============================================================================
procedure TDpgLexer.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);
      tab;
   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;

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

begin
   _first := [#9..#10,#13,' '..'$',''''..',','.'..'[','^','a'..'~'];
   
   while( true) do
   begin
      ResetText;
      
      try
         if (( LA(1) in ['=']) and (LA(2) in ['>'])) then
         begin
            mIMPLIES(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['.']) and (LA(2) in ['.'])) then
         begin
            mRANGE(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['(','/']) and (LA(2) in ['*','/'])) then
         begin
            mCOMMENT(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
            mRCURLY(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in [':'])) then
         begin
            mCOLON(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in [';'])) then
         begin
            mSEMI(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in [','])) then
         begin
            mCOMMA(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['='])) then
         begin
            mASSIGN(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['?'])) then
         begin
            mQUEST(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['+'])) then
         begin
            mPLUS(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['*'])) then
         begin
            mSTAR(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['@'])) then
         begin
            mAT(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['~'])) then
         begin
            mNOT(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['|'])) then
         begin
            mOR(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['!'])) then
         begin
            mBANG(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['.'])) then
         begin
            mWILDCARD(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['<'])) then
         begin
            mOPEN(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['>'])) then
         begin
            mCLOSE(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['^'])) then
         begin
            mCARET(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['#'])) then
         begin
            mTREE_BEGIN(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in [''''])) then
         begin
            mCHARLIT(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['"'])) then
         begin
            mSTRINGLIT(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['$','0'..'9'])) then
         begin
            mINTEGER(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['['])) then
         begin
            mARGACTION(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['{'])) then
         begin
            mACTION(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['A'..'Z'])) then
         begin
            mTOKENREF(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in ['a'..'z'])) then
         begin
            mRULEREF(true);
            result := ReturnToken;
         end
         
         else if (( LA(1) in [#9..#10,#13,' '])) then
         begin
            mWS(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;

// ----------------------------------------------------------------------------
// InitLiterals
// ----------------------------------------------------------------------------
procedure TDpgLexer.initialize;
begin
   fLiterals['finally'    ] := 21;
   fLiterals['returns'    ] := 18;
   fLiterals['public'     ] := 17;
   fLiterals['parser'     ] :=  9;
   fLiterals['unit'       ] :=  4;
   fLiterals['tokens'     ] := 12;
   fLiterals['uses'       ] :=  5;
   fLiterals['treeparser' ] := 10;
   fLiterals['memberdecl' ] := 13;
   fLiterals['local'      ] := 19;
   fLiterals['lexer'      ] :=  8;
   fLiterals['memberdef'  ] := 14;
   fLiterals['except'     ] := 20;
   fLiterals['protected'  ] := 16;
   fLiterals['type'       ] :=  7;
   fLiterals['private'    ] := 15;
   fLiterals['options'    ] := 11;
   fLiterals['const'      ] :=  6;
end;

end.