Files
bds.mr.dpg/src.lib/grammar/dpglib.DpgLexer.pas
T
2026-01-03 18:33:48 +01:00

1880 lines
45 KiB
ObjectPascal

// ============================================================================
// 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.