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