roka/bds.mr.dpg
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
5666f85e9940359ef0ab65608807eeeb2431d385
bds.mr.dpg/src.lib/grammar/dpglib.TokenLexer.pas
T
roka 5666f85e99 Initial check in lib
2026-01-03 18:33:48 +01:00

623 lines
15 KiB
ObjectPascal
Raw Blame History

// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar: dpglib.tokenLexer.g
// ============================================================================
unit dpglib.TokenLexer;
interface
uses
System.Classes,
dpglib.TokenLexerTokens,
dpgrtl.lexer,
dpgrtl.types,
System.SysUtils;
type
// =========================================================================
// Class TTokenLexer declaration
// =========================================================================
TTokenLexer = class( TLexer)
public // Protected grammar rules
// Must callable from parser too
procedure mDIGIT ( pCreate: boolean);
procedure mXDIGIT ( pCreate: boolean);
public // Public grammar rules
procedure mLPAREN ( pCreate: boolean);
procedure mRPAREN ( pCreate: boolean);
procedure mASSIGN ( pCreate: boolean);
procedure mSTRING ( pCreate: boolean);
procedure mID ( pCreate: boolean);
procedure mINT ( pCreate: boolean);
procedure mWS ( pCreate: boolean);
procedure mSLCOMMENT ( pCreate: boolean);
procedure mMLCOMMENT ( pCreate: boolean);
public
function NextToken: IToken; override;
end;
implementation
uses
dpgrtl.exception,
dpgrtl.token;
// ============================================================================
// mLPAREN
// ============================================================================
procedure TTokenLexer.mLPAREN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_LPAREN;
match('(');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mRPAREN
// ============================================================================
procedure TTokenLexer.mRPAREN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_RPAREN;
match(')');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mASSIGN
// ============================================================================
procedure TTokenLexer.mASSIGN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_ASSIGN;
match('=');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mSTRING
// ============================================================================
procedure TTokenLexer.mSTRING( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_STRING;
match('"');
while(true) do
begin
if (( LA(1) in [#1..'!','#'..#255])) then
begin
matchNot('"');
end
else
break;
end;
match('"');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mDIGIT
// ============================================================================
procedure TTokenLexer.mDIGIT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_DIGIT;
match( ['0'..'9']);
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mXDIGIT
// ============================================================================
procedure TTokenLexer.mXDIGIT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_XDIGIT;
if (( LA(1) in ['0'..'9'])) then
begin
match( ['0'..'9']);
end
else if (( LA(1) in ['a'..'f'])) then
begin
match( ['a'..'f']);
end
else if (( LA(1) in ['A'..'F'])) then
begin
match( ['A'..'F']);
end
else
Raise EMismatchedChar.Create( LA(1), ['0'..'9','A'..'F','a'..'f'], InputState.FileName, InputState.Line, InputState.Column);
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mID
// ============================================================================
procedure TTokenLexer.mID( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_ID;
if (( LA(1) in ['a'..'z'])) then
begin
match( ['a'..'z']);
end
else if (( LA(1) in ['A'..'Z'])) then
begin
match( ['A'..'Z']);
end
else
Raise EMismatchedChar.Create( LA(1), ['A'..'Z','a'..'z'], InputState.FileName, InputState.Line, InputState.Column);
while(true) do
begin
if (( LA(1) in ['a'..'z'])) then
begin
match( ['a'..'z']);
end
else if (( LA(1) in ['A'..'Z'])) then
begin
match( ['A'..'Z']);
end
else if (( LA(1) in ['_'])) then
begin
match('_');
end
else if (( LA(1) in ['0'..'9'])) then
begin
match( ['0'..'9']);
end
else
break;
end;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mINT
// ============================================================================
procedure TTokenLexer.mINT( pCreate: boolean);
var
_begin: integer;
_cnt_15: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_INT;
_cnt_15 := 0;
while(true) do
begin
if (( LA(1) in ['0'..'9'])) then
begin
mDIGIT(false);
end
else
begin
if _cnt_15 >= 1 then
break
else
Raise EMismatchedChar.Create( LA(1), ['0'..'9'], InputState.FileName, InputState.Line, InputState.Column);
end;
INC(_cnt_15);
end;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mWS
// ============================================================================
procedure TTokenLexer.mWS( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_WS;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [' '])) then
begin
match(' ');
end
else if (( LA(1) in [#9])) then
begin
match(#9);
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else
Raise EMismatchedChar.Create( LA(1), [#9..#10,#13,' '], InputState.FileName, InputState.Line, InputState.Column);
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mSLCOMMENT
// ============================================================================
procedure TTokenLexer.mSLCOMMENT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_SLCOMMENT;
match('//');
while(true) do
begin
if (( LA(1) in [#1..#9,#11..#12,#14..#255])) then
begin
match( [#1..#9,#11..#12,#14..#255]);
end
else
break;
end;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else
Raise EMismatchedChar.Create( LA(1), [#10,#13], InputState.FileName, InputState.Line, InputState.Column);
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mMLCOMMENT
// ============================================================================
procedure TTokenLexer.mMLCOMMENT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_MLCOMMENT;
match('(*');
while(true) do
begin
// non-greedy exit test
if( LA(1) in ['*']) and (LA(2) in [')']) then
break;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else if (( LA(1) in [#1..#9,#11..#12,#14..#255])) then
begin
match( [#1..#9,#11..#12,#14..#255]);
end
else
break;
end;
match('*)');
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ----------------------------------------------------------------------------
// NextToken
// ----------------------------------------------------------------------------
function TTokenLexer.NextToken : IToken;
var
_first : TCharSet;
begin
_first := [#9..#10,#13,' ','"','('..')','/'..'9','=','A'..'Z','a'..'z'];
while( true) do
begin
ResetText;
try
if (( LA(1) in ['(']) and (LA(2) in ['*'])) then
begin
mMLCOMMENT(true);
result := ReturnToken;
end
else if (( LA(1) in ['('])) then
begin
mLPAREN(true);
result := ReturnToken;
end
else if (( LA(1) in [')'])) then
begin
mRPAREN(true);
result := ReturnToken;
end
else if (( LA(1) in ['='])) then
begin
mASSIGN(true);
result := ReturnToken;
end
else if (( LA(1) in ['"'])) then
begin
mSTRING(true);
result := ReturnToken;
end
else if (( LA(1) in ['A'..'Z','a'..'z'])) then
begin
mID(true);
result := ReturnToken;
end
else if (( LA(1) in ['0'..'9'])) then
begin
mINT(true);
result := ReturnToken;
end
else if (( LA(1) in [#9..#10,#13,' '])) then
begin
mWS(true);
result := ReturnToken;
end
else if (( LA(1) in ['/'])) then
begin
mSLCOMMENT(true);
result := ReturnToken;
end
else
begin
if LA(1) = EOF_CHAR then
begin
uponEof;
result := TToken.Create(TT_EOF);
end
else
Raise EMismatchedChar.Create(LA(1), _first, InputState.FileName, InputState.Line, InputState.Column);
end;
// --------------------------------------------------------------
// If we found a SKIP token, then try again...
// --------------------------------------------------------------
if result = nil then
continue;
// --------------------------------------------------------------
// Now we have a valid token, so exit the function
// --------------------------------------------------------------
break;
except
Raise;
end;
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink