1880 lines
45 KiB
ObjectPascal
1880 lines
45 KiB
ObjectPascal
// ============================================================================
|
|
// This file is generated by the Delphi Parser Generator.
|
|
// ----------------------------------------------------------------------------
|
|
// DPG version: 2.0.1.0r
|
|
// Grammar: dpglib.dpgLexer.g
|
|
// ============================================================================
|
|
unit dpglib.DpgLexer;
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes,
|
|
SysUtils,
|
|
dpglib.DpgLexerTokens,
|
|
dpgrtl.lexer,
|
|
dpgrtl.types;
|
|
|
|
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.
|