diff --git a/src/shared/xparser.pas b/src/shared/xparser.pas
index b704c4b7016a65f119192cc325e07fe49e51bf85..4e45fc6849cf1e6861e94c87664996b1153e6b6d 100644 (file)
--- a/src/shared/xparser.pas
+++ b/src/shared/xparser.pas
-(* Copyright (C) DooM 2D:Forever Developers
+(* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
+ * Understanding is not required. Only obedience.
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
- * along with this program. If not, see <http://www.gnu.org/licenses/>.
+ * along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
{$INCLUDE a_modes.inc}
+{.$DEFINE XPARSER_DEBUG}
unit xparser;
interface
uses
- Classes, mempool;
+ SysUtils, Classes{$IFDEF USE_MEMPOOL}, mempool{$ENDIF};
// ////////////////////////////////////////////////////////////////////////// //
type
- TTextParser = class(TPoolObject)
+ TTextParser = class;
+
+ TParserException = class(Exception)
+ public
+ tokLine, tokCol: Integer;
+
+ public
+ constructor Create (pr: TTextParser; const amsg: AnsiString);
+ constructor CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
+ end;
+
+ TTextParser = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
public
const
TTNone = -1;
TOption = (
SignedNumbers, // allow signed numbers; otherwise sign will be TTDelim
DollarIsId, // allow dollar in identifiers; otherwise dollar will be TTDelim
- DotIsId // allow dot in identifiers; otherwise dot will be TTDelim
+ DotIsId, // allow dot in identifiers; otherwise dot will be TTDelim
+ PascalComments // allow `{}` pascal comments
);
TOptions = set of TOption;
constructor Create (aopts: TOptions=[TOption.SignedNumbers]);
destructor Destroy (); override;
+ procedure error (const amsg: AnsiString); noreturn;
+ procedure errorfmt (const afmt: AnsiString; const args: array of const); noreturn;
+
function isEOF (): Boolean; inline;
function skipChar (): Boolean; // returns `false` on eof
function skipBlanks (): Boolean; // ...and comments; returns `false` on eof
function skipToken (): Boolean; // returns `false` on eof
- //function skipToken1 (): Boolean;
+ {$IFDEF XPARSER_DEBUG}
+ function skipToken1 (): Boolean;
+ {$ENDIF}
+
+ function isIdOrStr (): Boolean; inline;
function expectId (): AnsiString;
- procedure expectId (const aid: AnsiString);
- function eatId (const aid: AnsiString): Boolean;
+ procedure expectId (const aid: AnsiString; caseSens: Boolean=true);
+ function eatId (const aid: AnsiString; caseSens: Boolean=true): Boolean;
+ function eatIdOrStr (const aid: AnsiString; caseSens: Boolean=true): Boolean;
+ function eatIdOrStrCI (const aid: AnsiString): Boolean; inline;
function expectStr (allowEmpty: Boolean=false): AnsiString;
function expectInt (): Integer;
implementation
uses
- SysUtils, utils;
+ utils;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TParserException.Create (pr: TTextParser; const amsg: AnsiString);
+begin
+ if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end;
+ inherited Create(amsg);
+end;
+
+constructor TParserException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
+begin
+ if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end;
+ inherited Create(formatstrf(afmt, args));
+end;
// ////////////////////////////////////////////////////////////////////////// //
end;
+procedure TTextParser.error (const amsg: AnsiString); noreturn;
+begin
+ raise TParserException.Create(self, amsg);
+end;
+
+
+procedure TTextParser.errorfmt (const afmt: AnsiString; const args: array of const); noreturn;
+begin
+ raise TParserException.CreateFmt(self, afmt, args);
+end;
+
+
function TTextParser.isEOF (): Boolean; inline; begin result := (mCurChar = #0); end;
skipChar();
end;
continue;
+ end
+ else if (curChar = '{') and (TOption.PascalComments in mOptions) then
+ begin
+ // pascal comment; skip comment start
+ skipChar();
+ while not isEOF do
+ begin
+ if (curChar = '}') then
+ begin
+ // skip comment end
+ skipChar();
+ break;
+ end;
+ skipChar();
+ end;
+ continue;
end;
if (curChar > ' ') then break;
skipChar(); // skip blank
end;
-{
+{$IFDEF XPARSER_DEBUG}
function TTextParser.skipToken (): Boolean;
begin
writeln('getting token...');
result := skipToken1();
writeln(' got token: ', mTokType, ' <', mTokStr, '> : <', mTokChar, '>');
end;
-}
-
+function TTextParser.skipToken1 (): Boolean;
+{$ELSE}
function TTextParser.skipToken (): Boolean;
-
+{$ENDIF}
procedure parseInt ();
var
neg: Boolean = false;
end;
+function TTextParser.isIdOrStr (): Boolean; inline;
+begin
+ result := (mTokType = TTId) or (mTokType = TTStr);
+end;
+
+
function TTextParser.expectId (): AnsiString;
begin
if (mTokType <> TTId) then raise Exception.Create('identifier expected');
end;
-procedure TTextParser.expectId (const aid: AnsiString);
+procedure TTextParser.expectId (const aid: AnsiString; caseSens: Boolean=true);
begin
- if (mTokType <> TTId) or (mTokStr <> aid) then raise Exception.Create('identifier '''+aid+''' expected');
+ if caseSens then
+ begin
+ if (mTokType <> TTId) or (mTokStr <> aid) then raise Exception.Create('identifier '''+aid+''' expected');
+ end
+ else
+ begin
+ if (mTokType <> TTId) or (not strEquCI1251(mTokStr, aid)) then raise Exception.Create('identifier '''+aid+''' expected');
+ end;
skipToken();
end;
-function TTextParser.eatId (const aid: AnsiString): Boolean;
+function TTextParser.eatId (const aid: AnsiString; caseSens: Boolean=true): Boolean;
+begin
+ if caseSens then
+ begin
+ result := (mTokType = TTId) and (mTokStr = aid);
+ end
+ else
+ begin
+ result := (mTokType = TTId) and strEquCI1251(mTokStr, aid);
+ end;
+ if result then skipToken();
+end;
+
+
+function TTextParser.eatIdOrStr (const aid: AnsiString; caseSens: Boolean=true): Boolean;
begin
- result := (mTokType = TTId) and (mTokStr = aid);
+ if caseSens then
+ begin
+ result := (mTokType = TTId) and (mTokStr = aid);
+ if not result then result := (mTokType = TTStr) and (mTokStr = aid);
+ end
+ else
+ begin
+ result := (mTokType = TTId) and strEquCI1251(mTokStr, aid);
+ if not result then result := (mTokType = TTStr) and strEquCI1251(mTokStr, aid);
+ end;
if result then skipToken();
end;
+function TTextParser.eatIdOrStrCI (const aid: AnsiString): Boolean; inline;
+begin
+ result := eatIdOrStr(aid, false);
+end;
+
+
function TTextParser.expectStr (allowEmpty: Boolean=false): AnsiString;
begin
if (mTokType <> TTStr) then raise Exception.Create('string expected');