roka/bds.fx2.prgc
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
7a64fa18fb430757de58948be86c70541e6eb205
bds.fx2.prgc/src.prgc/grammar/prgLexer.pas
T
roka 7a64fa18fb Initial check in
2026-01-03 18:57:08 +01:00

610 lines
14 KiB
ObjectPascal
Raw Blame History

// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar: prgLexer.g
// ============================================================================
unit prgLexer;
interface
uses
Classes,
dpgrtl.lexer,
dpgrtl.types,
prgLexerTokens,
SysUtils;
type
// =========================================================================
// Type declarations from grammar.
// =========================================================================
// =========================================================================
// Class TprgLexer declaration
// =========================================================================
TprgLexer = class( TLexer)
protected // Internals
procedure initialize; override;
public // Public grammar rules
procedure mCOMMA ( pCreate: boolean);
procedure mCOLON ( pCreate: boolean);
procedure mPLUS ( pCreate: boolean);
procedure mMINUS ( pCreate: boolean);
procedure mDOT ( pCreate: boolean);
procedure mEQ ( pCreate: boolean);
procedure mID ( pCreate: boolean);
procedure mINT ( pCreate: boolean);
procedure mREXP ( pCreate: boolean);
procedure mNEWLINE ( pCreate: boolean);
procedure mWS ( pCreate: boolean);
public
function NextToken: IToken; override;
end;
implementation
uses
dpgrtl.exception,
dpgrtl.token;
// ============================================================================
// mCOMMA
// ============================================================================
procedure TprgLexer.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;
// ============================================================================
// mCOLON
// ============================================================================
procedure TprgLexer.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;
// ============================================================================
// mPLUS
// ============================================================================
procedure TprgLexer.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;
// ============================================================================
// mMINUS
// ============================================================================
procedure TprgLexer.mMINUS( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_MINUS;
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;
// ============================================================================
// mDOT
// ============================================================================
procedure TprgLexer.mDOT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_DOT;
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;
// ============================================================================
// mEQ
// ============================================================================
procedure TprgLexer.mEQ( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_EQ;
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;
// ============================================================================
// mID
// ============================================================================
procedure TprgLexer.mID( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_ID;
var c := LA(1);
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 ['&'])) then
begin
match('&');
end
else if (( LA(1) in ['*'])) then
begin
match('*');
end
else
Raise EMismatchedChar.Create( LA(1), ['&','*','/','A'..'Z','a'..'z'], InputState.FileName, InputState.Line, InputState.Column);
while(true) do
begin
c := LA(1);
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 ['0'..'9'])) then
begin
match( ['0'..'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 ['.'])) then
begin
match('.');
_ttype := TT_QID;
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;
// ============================================================================
// mINT
// ============================================================================
procedure TprgLexer.mINT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_INT;
match( ['0'..'9']);
while(true) do
begin
if (( LA(1) in ['0'..'9'])) then
begin
match( ['0'..'9']);
end
else
break;
end;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mREXP
// ============================================================================
procedure TprgLexer.mREXP( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_REXP;
SaveConsumedInput := false;
match('<');
SaveConsumedInput := true;
while(true) do
begin
if (( LA(1) in [#1..'=','?'..#255])) then
begin
match( [#1..'=','?'..#255]);
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;
// ============================================================================
// mNEWLINE
// ============================================================================
procedure TprgLexer.mNEWLINE( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_NEWLINE;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else
Raise EMismatchedChar.Create( LA(1), [#10,#13], InputState.FileName, InputState.Line, InputState.Column);
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mWS
// ============================================================================
procedure TprgLexer.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 [' '])) then
begin
match(' ');
end
else if (( LA(1) in [#9])) then
begin
match(#9);
tab;
end
else
Raise EMismatchedChar.Create( LA(1), [#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;
// ----------------------------------------------------------------------------
// NextToken
// ----------------------------------------------------------------------------
function TprgLexer.NextToken : IToken;
var
_first : TCharSet;
begin
_first := [#9..#10,#13,' ','&','*'..':','<'..'=','A'..'Z','a'..'z'];
while( true) do
begin
ResetText;
try
if (( LA(1) in [','])) then
begin
mCOMMA(true);
result := ReturnToken;
end
else if (( LA(1) in [':'])) then
begin
mCOLON(true);
result := ReturnToken;
end
else if (( LA(1) in ['+'])) then
begin
mPLUS(true);
result := ReturnToken;
end
else if (( LA(1) in ['-'])) then
begin
mMINUS(true);
result := ReturnToken;
end
else if (( LA(1) in ['.'])) then
begin
mDOT(true);
result := ReturnToken;
end
else if (( LA(1) in ['='])) then
begin
mEQ(true);
result := ReturnToken;
end
else if (( LA(1) in ['&','*','/','A'..'Z','a'..'z'])) then
begin
mID(true);
result := ReturnToken;
end
else if (( LA(1) in ['0'..'9'])) then
begin
mINT(true);
result := ReturnToken;
end
else if (( LA(1) in ['<'])) then
begin
mREXP(true);
result := ReturnToken;
end
else if (( LA(1) in [#10,#13])) then
begin
mNEWLINE(true);
result := ReturnToken;
end
else if (( LA(1) in [#9,' '])) 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 TprgLexer.initialize;
begin
fCaseSensitive := false;
fLiterals.CaseSensitive := false;
fLiterals['/cmd' ] := 12;
fLiterals['fx2' ] := 6;
fLiterals['/id' ] := 8;
fLiterals['/pos' ] := 9;
fLiterals['/v' ] := 13;
fLiterals['/loc' ] := 10;
fLiterals['/list' ] := 7;
fLiterals['/perm' ] := 11;
fLiterals['dso' ] := 4;
fLiterals['/v1' ] := 14;
fLiterals['jtag' ] := 5;
end;
end.
Reference in New Issue View Git Blame Copy Permalink