431 lines
10 KiB
ObjectPascal
431 lines
10 KiB
ObjectPascal
// ============================================================================
|
|
// This file is generated by the Delphi Parser Generator.
|
|
// ----------------------------------------------------------------------------
|
|
// DPG version: 1.0.1.0d
|
|
// Grammar: calcLexer
|
|
// ============================================================================
|
|
unit calcLexer;
|
|
|
|
interface
|
|
|
|
uses
|
|
calcLexerTokens,
|
|
Classes,
|
|
Contnrs,
|
|
dpgLexer,
|
|
dpgToken,
|
|
dpgTypes,
|
|
SysUtils;
|
|
|
|
type
|
|
// =========================================================================
|
|
// Class TcalcLexer declaration
|
|
// =========================================================================
|
|
TcalcLexer = class( TdpgLexer)
|
|
|
|
protected // Public grammar rules ("rescoped")
|
|
procedure mLPAREN ( pCreate: boolean);
|
|
procedure mRPAREN ( pCreate: boolean);
|
|
procedure mPLUS ( pCreate: boolean);
|
|
procedure mMINUS ( pCreate: boolean);
|
|
procedure mSTAR ( pCreate: boolean);
|
|
procedure mSLASH ( pCreate: boolean);
|
|
procedure mSEMI ( pCreate: boolean);
|
|
procedure mINT ( pCreate: boolean);
|
|
procedure mWS ( pCreate: boolean);
|
|
|
|
public
|
|
function NextToken: IdpgToken; override;
|
|
end;
|
|
|
|
implementation
|
|
uses
|
|
dpgException,
|
|
dpgExceptionSemantic,
|
|
dpgExceptionMismatchedChar;
|
|
|
|
// ============================================================================
|
|
// mLPAREN
|
|
// ============================================================================
|
|
procedure TcalcLexer.mLPAREN( pCreate: boolean);
|
|
var
|
|
_begin: integer;
|
|
_save: integer;
|
|
_token: IdpgToken;
|
|
_ttype: integer;
|
|
|
|
begin
|
|
_begin := Length( fText) +1;
|
|
_token := nil;
|
|
_ttype := TT_LPAREN;
|
|
|
|
match('(');
|
|
|
|
if (_ttype <> TT_SKIP) and (pCreate = true) then
|
|
begin
|
|
_token := makeToken( _ttype);
|
|
_token.TokenText := Copy( fText, _begin, Length(fText)-_begin+1);
|
|
end;
|
|
|
|
fReturnToken := _token;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// mRPAREN
|
|
// ============================================================================
|
|
procedure TcalcLexer.mRPAREN( pCreate: boolean);
|
|
var
|
|
_begin: integer;
|
|
_save: integer;
|
|
_token: IdpgToken;
|
|
_ttype: integer;
|
|
|
|
begin
|
|
_begin := Length( fText) +1;
|
|
_token := nil;
|
|
_ttype := TT_RPAREN;
|
|
|
|
match(')');
|
|
|
|
if (_ttype <> TT_SKIP) and (pCreate = true) then
|
|
begin
|
|
_token := makeToken( _ttype);
|
|
_token.TokenText := Copy( fText, _begin, Length(fText)-_begin+1);
|
|
end;
|
|
|
|
fReturnToken := _token;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// mPLUS
|
|
// ============================================================================
|
|
procedure TcalcLexer.mPLUS( pCreate: boolean);
|
|
var
|
|
_begin: integer;
|
|
_save: integer;
|
|
_token: IdpgToken;
|
|
_ttype: integer;
|
|
|
|
begin
|
|
_begin := Length( fText) +1;
|
|
_token := nil;
|
|
_ttype := TT_PLUS;
|
|
|
|
match('+');
|
|
|
|
if (_ttype <> TT_SKIP) and (pCreate = true) then
|
|
begin
|
|
_token := makeToken( _ttype);
|
|
_token.TokenText := Copy( fText, _begin, Length(fText)-_begin+1);
|
|
end;
|
|
|
|
fReturnToken := _token;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// mMINUS
|
|
// ============================================================================
|
|
procedure TcalcLexer.mMINUS( pCreate: boolean);
|
|
var
|
|
_begin: integer;
|
|
_save: integer;
|
|
_token: IdpgToken;
|
|
_ttype: integer;
|
|
|
|
begin
|
|
_begin := Length( fText) +1;
|
|
_token := nil;
|
|
_ttype := TT_MINUS;
|
|
|
|
match('-');
|
|
|
|
if (_ttype <> TT_SKIP) and (pCreate = true) then
|
|
begin
|
|
_token := makeToken( _ttype);
|
|
_token.TokenText := Copy( fText, _begin, Length(fText)-_begin+1);
|
|
end;
|
|
|
|
fReturnToken := _token;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// mSTAR
|
|
// ============================================================================
|
|
procedure TcalcLexer.mSTAR( pCreate: boolean);
|
|
var
|
|
_begin: integer;
|
|
_save: integer;
|
|
_token: IdpgToken;
|
|
_ttype: integer;
|
|
|
|
begin
|
|
_begin := Length( fText) +1;
|
|
_token := nil;
|
|
_ttype := TT_STAR;
|
|
|
|
match('*');
|
|
|
|
if (_ttype <> TT_SKIP) and (pCreate = true) then
|
|
begin
|
|
_token := makeToken( _ttype);
|
|
_token.TokenText := Copy( fText, _begin, Length(fText)-_begin+1);
|
|
end;
|
|
|
|
fReturnToken := _token;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// mSLASH
|
|
// ============================================================================
|
|
procedure TcalcLexer.mSLASH( pCreate: boolean);
|
|
var
|
|
_begin: integer;
|
|
_save: integer;
|
|
_token: IdpgToken;
|
|
_ttype: integer;
|
|
|
|
begin
|
|
_begin := Length( fText) +1;
|
|
_token := nil;
|
|
_ttype := TT_SLASH;
|
|
|
|
match('/');
|
|
|
|
if (_ttype <> TT_SKIP) and (pCreate = true) then
|
|
begin
|
|
_token := makeToken( _ttype);
|
|
_token.TokenText := Copy( fText, _begin, Length(fText)-_begin+1);
|
|
end;
|
|
|
|
fReturnToken := _token;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// mSEMI
|
|
// ============================================================================
|
|
procedure TcalcLexer.mSEMI( pCreate: boolean);
|
|
var
|
|
_begin: integer;
|
|
_save: integer;
|
|
_token: IdpgToken;
|
|
_ttype: integer;
|
|
|
|
begin
|
|
_begin := Length( fText) +1;
|
|
_token := nil;
|
|
_ttype := TT_SEMI;
|
|
|
|
match(';');
|
|
|
|
if (_ttype <> TT_SKIP) and (pCreate = true) then
|
|
begin
|
|
_token := makeToken( _ttype);
|
|
_token.TokenText := Copy( fText, _begin, Length(fText)-_begin+1);
|
|
end;
|
|
|
|
fReturnToken := _token;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// mINT
|
|
// ============================================================================
|
|
procedure TcalcLexer.mINT( pCreate: boolean);
|
|
var
|
|
_begin: integer;
|
|
_cnt_10: integer;
|
|
_save: integer;
|
|
_token: IdpgToken;
|
|
_ttype: integer;
|
|
|
|
begin
|
|
_begin := Length( fText) +1;
|
|
_token := nil;
|
|
_ttype := TT_INT;
|
|
|
|
_cnt_10 := 0;
|
|
|
|
while(true) do
|
|
begin
|
|
if (( LA(1) in ['0'..'9'])) then
|
|
begin
|
|
match( ['0'..'9']);
|
|
end
|
|
|
|
else
|
|
begin
|
|
if _cnt_10 >= 1 then
|
|
break
|
|
else
|
|
Raise EdpgMismatchedChar.Create( LA(1), ['0'..'9'], FileName, Line, Column);
|
|
end;
|
|
|
|
INC(_cnt_10);
|
|
end;
|
|
|
|
if (_ttype <> TT_SKIP) and (pCreate = true) then
|
|
begin
|
|
_token := makeToken( _ttype);
|
|
_token.TokenText := Copy( fText, _begin, Length(fText)-_begin+1);
|
|
end;
|
|
|
|
fReturnToken := _token;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// mWS
|
|
// ============================================================================
|
|
procedure TcalcLexer.mWS( pCreate: boolean);
|
|
var
|
|
_begin: integer;
|
|
_save: integer;
|
|
_token: IdpgToken;
|
|
_ttype: integer;
|
|
|
|
begin
|
|
_begin := Length( fText) +1;
|
|
_token := nil;
|
|
_ttype := TT_WS;
|
|
|
|
if (( LA(1) in [#13])) 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 [#9])) then
|
|
begin
|
|
match(#9);
|
|
tab;
|
|
end
|
|
|
|
else if (( LA(1) in [' '])) then
|
|
begin
|
|
match(' ');
|
|
end
|
|
|
|
else
|
|
Raise EdpgMismatchedChar.Create( LA(1), [#9..#10,#13,' '], FileName, Line, Column);
|
|
_ttype := TT_SKIP;
|
|
|
|
if (_ttype <> TT_SKIP) and (pCreate = true) then
|
|
begin
|
|
_token := makeToken( _ttype);
|
|
_token.TokenText := Copy( fText, _begin, Length(fText)-_begin+1);
|
|
end;
|
|
|
|
fReturnToken := _token;
|
|
end;
|
|
|
|
// ----------------------------------------------------------------------------
|
|
// NextToken
|
|
// ----------------------------------------------------------------------------
|
|
function TcalcLexer.NextToken : IdpgToken;
|
|
var
|
|
_first : TdpgCharSet;
|
|
|
|
begin
|
|
_first := [#9..#10,#13,' ','('..'+','-','/'..'9',';'];
|
|
|
|
while( true) do
|
|
begin
|
|
ResetText;
|
|
|
|
try
|
|
if (( LA(1) in ['('])) then
|
|
begin
|
|
mLPAREN(true);
|
|
result := fReturnToken;
|
|
end
|
|
|
|
else if (( LA(1) in [')'])) then
|
|
begin
|
|
mRPAREN(true);
|
|
result := fReturnToken;
|
|
end
|
|
|
|
else if (( LA(1) in ['+'])) then
|
|
begin
|
|
mPLUS(true);
|
|
result := fReturnToken;
|
|
end
|
|
|
|
else if (( LA(1) in ['-'])) then
|
|
begin
|
|
mMINUS(true);
|
|
result := fReturnToken;
|
|
end
|
|
|
|
else if (( LA(1) in ['*'])) then
|
|
begin
|
|
mSTAR(true);
|
|
result := fReturnToken;
|
|
end
|
|
|
|
else if (( LA(1) in ['/'])) then
|
|
begin
|
|
mSLASH(true);
|
|
result := fReturnToken;
|
|
end
|
|
|
|
else if (( LA(1) in [';'])) then
|
|
begin
|
|
mSEMI(true);
|
|
result := fReturnToken;
|
|
end
|
|
|
|
else if (( LA(1) in ['0'..'9'])) then
|
|
begin
|
|
mINT(true);
|
|
result := fReturnToken;
|
|
end
|
|
|
|
else if (( LA(1) in [#9..#10,#13,' '])) then
|
|
begin
|
|
mWS(true);
|
|
result := fReturnToken;
|
|
end
|
|
|
|
else
|
|
begin
|
|
if LA(1) = EOF_CHAR then
|
|
begin
|
|
uponEof;
|
|
result := TdpgToken.Create(TT_EOF);
|
|
end
|
|
|
|
else
|
|
Raise EdpgMismatchedChar.Create(LA(1), _first, FileName, Line, 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.
|