X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxparser.pas;h=5332f0afe7c4af022019799a6d2eb4ce796f40c0;hb=6cfc4749e77a32dc356f8dc4b4f26788626bbb4e;hp=bac4e4a8153feb04faf29362eb0fbfc1295766c1;hpb=dd969f579db2bf70f6ddfcb5d377b2b95b994a6e;p=d2df-sdl.git diff --git a/src/shared/xparser.pas b/src/shared/xparser.pas index bac4e4a..5332f0a 100644 --- a/src/shared/xparser.pas +++ b/src/shared/xparser.pas @@ -1,4 +1,5 @@ -(* Copyright (C) DooM 2D:Forever Developers +(* coded by Ketmar // Invisible Vector + * 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 @@ -11,20 +12,32 @@ * 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 . + * along with this program. If not, see . *) {$INCLUDE a_modes.inc} +{.$DEFINE XPARSER_DEBUG} unit xparser; interface uses - Classes; + SysUtils, Classes{$IFDEF USE_MEMPOOL}, mempool{$ENDIF}; // ////////////////////////////////////////////////////////////////////////// // type - TTextParser = class + 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; @@ -33,25 +46,39 @@ type TTInt = 2; //TTFloat = 3; // not yet TTStr = 4; // string - TTComma = 5; // ',' - TTColon = 6; // ':' - TTSemi = 7; // ';' - TTBegin = 8; // left curly - TTEnd = 9; // right curly - TTDelim = 10; // other delimiters + TTDelim = 5; // one-char delimiters // TTLogAnd = 11; // && TTLogOr = 12; // || TTLessEqu = 13; // <= TTGreatEqu = 14; // >= TTNotEqu = 15; // != - TTEqu = 16; // == + TTEqu = 16; // == or <> + TTAss = 17; // := + TTShl = 18; // << + TTShr = 19; // >> + TTDotDot = 19; // .. + + public + type + 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 + DashIsId, // '-' can be part of identifier (but identifier cannot start with '-') + PascalComments // allow `{}` pascal comments + ); + TOptions = set of TOption; + + private + type + TAnsiCharSet = set of AnsiChar; private mLine, mCol: Integer; mCurChar, mNextChar: AnsiChar; - mAllowSignedNumbers: Boolean; // internal control + mOptions: TOptions; mTokLine, mTokCol: Integer; // token start mTokType: Integer; @@ -60,13 +87,16 @@ type mTokInt: Integer; protected - procedure warmup (); virtual; // called in constructor to warm up the system + procedure warmup (); // called in constructor to warm up the system procedure loadNextChar (); virtual; abstract; // loads next char into mNextChar; #0 means 'eof' public - constructor Create (); + 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 @@ -74,25 +104,34 @@ type 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; - function expectStrOrId (allowEmpty: Boolean=false): AnsiString; + function expectIdOrStr (allowEmpty: Boolean=false): AnsiString; procedure expectTT (ttype: Integer); function eatTT (ttype: Integer): Boolean; - function expectDelim (const ch: AnsiChar): AnsiChar; + procedure expectDelim (const ch: AnsiChar); + function expectDelims (const ch: TAnsiCharSet): AnsiChar; function eatDelim (const ch: AnsiChar): Boolean; + function isDelim (const ch: AnsiChar): Boolean; inline; + public - property allowSignedNumbers: Boolean read mAllowSignedNumbers write mAllowSignedNumbers; + property options: TOptions read mOptions write mOptions; public property col: Integer read mCol; @@ -129,8 +168,8 @@ type procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof' public - constructor Create (const fname: AnsiString); - constructor Create (st: TStream; astOwned: Boolean=true); // will take ownership on st by default + constructor Create (const fname: AnsiString; aopts: TOptions=[TOption.SignedNumbers]); + constructor Create (st: TStream; astOwned: Boolean=true; aopts: TOptions=[TOption.SignedNumbers]); destructor Destroy (); override; end; @@ -143,7 +182,7 @@ type procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof' public - constructor Create (const astr: AnsiString); + constructor Create (const astr: AnsiString; aopts: TOptions=[TOption.SignedNumbers]); destructor Destroy (); override; end; @@ -216,15 +255,25 @@ type implementation uses - SysUtils, utils; + utils; // ////////////////////////////////////////////////////////////////////////// // -function StrEqu (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end; +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; // ////////////////////////////////////////////////////////////////////////// // -constructor TTextParser.Create (); +constructor TTextParser.Create (aopts: TOptions=[TOption.SignedNumbers]); begin mLine := 1; mCol := 1; @@ -234,8 +283,8 @@ begin mTokStr := ''; mTokChar := #0; mTokInt := 0; - mAllowSignedNumbers := true; - warmup(); // change `mAllowSignedNumbers` there, if necessary + mOptions := aopts; + warmup(); skipToken(); end; @@ -246,7 +295,19 @@ begin end; -function TTextParser.isEOF (): Boolean; inline; begin result := (mCurChar = #0); 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);} result := (mTokType = TTEOF); end; procedure TTextParser.warmup (); @@ -279,26 +340,26 @@ function TTextParser.skipBlanks (): Boolean; var level: Integer; begin - while not isEOF do + while (mCurChar <> #0) do begin - if (curChar = '/') then + if (mCurChar = '/') then begin // single-line comment - if (nextChar = '/') then + if (mNextChar = '/') then begin - while not isEOF and (curChar <> #10) do skipChar(); + while (mCurChar <> #0) and (mCurChar <> #10) do skipChar(); skipChar(); // skip EOL continue; end; // multline comment - if (nextChar = '*') then + if (mNextChar = '*') then begin // skip comment start skipChar(); skipChar(); - while not isEOF do + while (mCurChar <> #0) do begin - if (curChar = '*') and (nextChar = '/') then + if (mCurChar = '*') and (mNextChar = '/') then begin // skip comment end skipChar(); @@ -310,15 +371,15 @@ begin continue; end; // nesting multline comment - if (nextChar = '+') then + if (mNextChar = '+') then begin // skip comment start skipChar(); skipChar(); level := 1; - while not isEOF do + while (mCurChar <> #0) do begin - if (curChar = '+') and (nextChar = '/') then + if (mCurChar = '+') and (mNextChar = '/') then begin // skip comment end skipChar(); @@ -327,7 +388,7 @@ begin if (level = 0) then break; continue; end; - if (curChar = '/') and (nextChar = '+') then + if (mCurChar = '/') and (mNextChar = '+') then begin // skip comment start skipChar(); @@ -339,39 +400,73 @@ begin end; continue; end; + end + else if (mCurChar = '(') and (mNextChar = '*') then + begin + // pascal comment; skip comment start + skipChar(); + skipChar(); + while (mCurChar <> #0) do + begin + if (mCurChar = '*') and (mNextChar = ')') then + begin + // skip comment end + skipChar(); + skipChar(); + break; + end; + skipChar(); + end; + continue; + end + else if (mCurChar = '{') and (TOption.PascalComments in mOptions) then + begin + // pascal comment; skip comment start + skipChar(); + while (mCurChar <> #0) do + begin + if (mCurChar = '}') then + begin + // skip comment end + skipChar(); + break; + end; + skipChar(); + end; + continue; end; - if (curChar > ' ') then break; + if (mCurChar > ' ') then break; skipChar(); // skip blank end; - result := not isEOF; + result := (mCurChar <> #0); 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; base: Integer = -1; n: Integer; begin - if mAllowSignedNumbers then + if (TOption.SignedNumbers in mOptions) then begin - if (curChar = '+') or (curChar = '-') then + if (mCurChar = '+') or (mCurChar = '-') then begin - neg := (curChar = '-'); + neg := (mCurChar = '-'); skipChar(); - if (curChar < '0') or (curChar > '9') then + if (mCurChar < '0') or (mCurChar > '9') then begin mTokType := TTDelim; if (neg) then mTokChar := '-' else mTokChar := '+'; @@ -379,9 +474,9 @@ function TTextParser.skipToken (): Boolean; end; end; end; - if (curChar = '0') then + if (mCurChar = '0') then begin - case nextChar of + case mNextChar of 'b','B': base := 2; 'o','O': base := 8; 'd','D': base := 10; @@ -396,12 +491,12 @@ function TTextParser.skipToken (): Boolean; end; // default base if (base < 0) then base := 10; - if (digitInBase(curChar, base) < 0) then raise Exception.Create('invalid number'); + if (digitInBase(mCurChar, base) < 0) then raise Exception.Create('invalid number'); mTokType := TTInt; mTokInt := 0; // just in case - while not isEOF do + while (mCurChar <> #0) do begin - n := digitInBase(curChar, base); + n := digitInBase(mCurChar, base); if (n < 0) then break; n := mTokInt*10+n; if (n < 0) or (n < mTokInt) then raise Exception.Create('integer overflow'); @@ -409,10 +504,10 @@ function TTextParser.skipToken (): Boolean; skipChar(); end; // check for valid number end - if not isEOF then + if (mCurChar <> #0) then begin - if (curChar = '.') then raise Exception.Create('floating numbers aren''t supported yet'); - if (curChar = '_') or ((curChar >= 'A') and (curChar <= 'Z')) or ((curChar >= 'a') and (curChar <= 'z')) or (curChar >= #128) then + if (mCurChar = '.') then raise Exception.Create('floating numbers aren''t supported yet'); + if (mCurChar = '_') or ((mCurChar >= 'A') and (mCurChar <= 'Z')) or ((mCurChar >= 'a') and (mCurChar <= 'z')) or (mCurChar >= #128) then begin raise Exception.Create('invalid number'); end; @@ -427,15 +522,15 @@ function TTextParser.skipToken (): Boolean; begin mTokType := TTStr; mTokStr := ''; // just in case - qch := curChar; + qch := mCurChar; skipChar(); // skip starting quote - while not isEOF do + while (mCurChar <> #0) do begin // escape - if (qch = '"') and (curChar = '\') then + if (qch = '"') and (mCurChar = '\') then begin - if (nextChar = #0) then raise Exception.Create('unterminated string escape'); - ch := nextChar; + if (mNextChar = #0) then raise Exception.Create('unterminated string escape'); + ch := mNextChar; // skip backslash and escape type skipChar(); skipChar(); @@ -447,12 +542,12 @@ function TTextParser.skipToken (): Boolean; 'e': mTokStr += #27; 'x', 'X': // hex escape begin - n := digitInBase(curChar, 16); + n := digitInBase(mCurChar, 16); if (n < 0) then raise Exception.Create('invalid hexstr escape'); skipChar(); - if (digitInBase(curChar, 16) > 0) then + if (digitInBase(mCurChar, 16) > 0) then begin - n := n*16+digitInBase(curChar, 16); + n := n*16+digitInBase(mCurChar, 16); skipChar(); end; mTokStr += AnsiChar(n); @@ -462,7 +557,7 @@ function TTextParser.skipToken (): Boolean; continue; end; // duplicate single quote (pascal style) - if (qch = '''') and (curChar = '''') and (nextChar = '''') then + if (qch = '''') and (mCurChar = '''') and (mNextChar = '''') then begin // skip both quotes skipChar(); @@ -470,12 +565,12 @@ function TTextParser.skipToken (): Boolean; mTokStr += ''''; continue; end; - if (curChar = qch) then + if (mCurChar = qch) then begin skipChar(); // skip ending quote break; end; - mTokStr += curChar; + mTokStr += mCurChar; skipChar(); end; end; @@ -484,18 +579,21 @@ function TTextParser.skipToken (): Boolean; begin mTokType := TTId; mTokStr := ''; // just in case - while (curChar = '_') or ((curChar >= '0') and (curChar <= '9')) or - ((curChar >= 'A') and (curChar <= 'Z')) or - ((curChar >= 'a') and (curChar <= 'z')) or - (curChar >= #128) do + while (mCurChar = '_') or ((mCurChar >= '0') and (mCurChar <= '9')) or + ((mCurChar >= 'A') and (mCurChar <= 'Z')) or + ((mCurChar >= 'a') and (mCurChar <= 'z')) or + (mCurChar >= #128) or + ((TOption.DollarIsId in mOptions) and (mCurChar = '$')) or + ((TOption.DotIsId in mOptions) and (mCurChar = '.') and (mNextChar <> '.')) or + ((TOption.DashIsId in mOptions) and (mCurChar = '-')) do begin - mTokStr += curChar; + mTokStr += mCurChar; skipChar(); end; end; begin - mTokType := TTEOF; + mTokType := TTNone; mTokStr := ''; mTokChar := #0; mTokInt := 0; @@ -503,6 +601,7 @@ begin if not skipBlanks() then begin result := false; + mTokType := TTEOF; mTokLine := mLine; mTokCol := mCol; exit; @@ -514,37 +613,53 @@ begin result := true; // number? - if mAllowSignedNumbers and ((curChar = '+') or (curChar = '-')) then begin parseInt(); exit; end; - if (curChar >= '0') and (curChar <= '9') then begin parseInt(); exit; end; + if (TOption.SignedNumbers in mOptions) and ((mCurChar = '+') or (mCurChar = '-')) then begin parseInt(); exit; end; + if (mCurChar >= '0') and (mCurChar <= '9') then begin parseInt(); exit; end; // string? - if (curChar = '"') or (curChar = '''') then begin parseString(); exit; end; + if (mCurChar = '"') or (mCurChar = '''') then begin parseString(); exit; end; // identifier? - if (curChar = '_') or ((curChar >= 'A') and (curChar <= 'Z')) or ((curChar >= 'a') and (curChar <= 'z')) or (curChar >= #128) then begin parseId(); exit; end; + if (mCurChar = '_') or ((mCurChar >= 'A') and (mCurChar <= 'Z')) or ((mCurChar >= 'a') and (mCurChar <= 'z')) or (mCurChar >= #128) then begin parseId(); exit; end; + if (TOption.DollarIsId in mOptions) and (mCurChar = '$') then begin parseId(); exit; end; + if (TOption.DotIsId in mOptions) and (mCurChar = '.') and (mNextChar <> '.') then begin parseId(); exit; end; // known delimiters? - mTokChar := curChar; + mTokChar := mCurChar; mTokType := TTDelim; skipChar(); - if (curChar = '=') then + if (mCurChar = '=') then begin case mTokChar of '<': begin mTokType := TTLessEqu; mTokStr := '<='; skipChar(); exit; end; '>': begin mTokType := TTGreatEqu; mTokStr := '>='; skipChar(); exit; end; '!': begin mTokType := TTNotEqu; mTokStr := '!='; skipChar(); exit; end; '=': begin mTokType := TTEqu; mTokStr := '=='; skipChar(); exit; end; + ':': begin mTokType := TTAss; mTokStr := ':='; skipChar(); exit; end; + end; + end + else if (mTokChar = mCurChar) then + begin + case mTokChar of + '<': begin mTokType := TTShl; mTokStr := '<<'; skipChar(); exit; end; + '>': begin mTokType := TTShr; mTokStr := '>>'; skipChar(); exit; end; + '&': begin mTokType := TTLogAnd; mTokStr := '&&'; skipChar(); exit; end; + '|': begin mTokType := TTLogOr; mTokStr := '||'; skipChar(); exit; end; + end; + end + else + begin + case mTokChar of + '<': if (mCurChar = '>') then begin mTokType := TTNotEqu; mTokStr := '<>'; skipChar(); exit; end; + '.': if (mCurChar = '.') then begin mTokType := TTDotDot; mTokStr := '..'; skipChar(); exit; end; end; end; - case mTokChar of - ',': mTokType := TTComma; - ':': mTokType := TTColon; - ';': mTokType := TTSemi; - '{': mTokType := TTBegin; - '}': mTokType := TTEnd; - '&': if (curChar = '&') then begin mTokType := TTLogAnd; mTokStr := '&&'; skipChar(); exit; end; - '|': if (curChar = '|') then begin mTokType := TTLogOr; mTokStr := '||'; skipChar(); exit; end; - end; +end; + + +function TTextParser.isIdOrStr (): Boolean; inline; +begin + result := (mTokType = TTId) or (mTokType = TTStr); end; @@ -556,19 +671,53 @@ begin end; -procedure TTextParser.expectId (const aid: AnsiString); +procedure TTextParser.expectId (const aid: AnsiString; caseSens: Boolean=true); begin - if (mTokType <> TTId) or (not StrEqu(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 - result := false; - if (mTokType <> TTId) or (not StrEqu(mTokStr, aid)) then exit; - result := true; - skipToken(); + 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 + 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; @@ -581,7 +730,7 @@ begin end; -function TTextParser.expectStrOrId (allowEmpty: Boolean=false): AnsiString; +function TTextParser.expectIdOrStr (allowEmpty: Boolean=false): AnsiString; begin case mTokType of TTStr: @@ -618,9 +767,17 @@ begin end; -function TTextParser.expectDelim (const ch: AnsiChar): AnsiChar; +procedure TTextParser.expectDelim (const ch: AnsiChar); +begin + if (mTokType <> TTDelim) or (mTokChar <> ch) then raise Exception.CreateFmt('delimiter ''%s'' expected', [ch]); + skipToken(); +end; + + +function TTextParser.expectDelims (const ch: TAnsiCharSet): AnsiChar; begin - if (mTokType <> TTDelim) then raise Exception.Create(Format('delimiter ''%s'' expected', [ch])); + if (mTokType <> TTDelim) then raise Exception.Create('delimiter expected'); + if not (mTokChar in ch) then raise Exception.Create('delimiter expected'); result := mTokChar; skipToken(); end; @@ -628,15 +785,19 @@ end; function TTextParser.eatDelim (const ch: AnsiChar): Boolean; begin - result := false; - if (mTokType <> TTDelim) or (mTokChar <> ch) then exit; - result := true; - skipToken(); + result := (mTokType = TTDelim) and (mTokChar = ch); + if result then skipToken(); +end; + + +function TTextParser.isDelim (const ch: AnsiChar): Boolean; inline; +begin + result := (mTokType = TTDelim) and (mTokChar = ch); end; // ////////////////////////////////////////////////////////////////////////// // -constructor TFileTextParser.Create (const fname: AnsiString); +constructor TFileTextParser.Create (const fname: AnsiString; aopts: TOptions=[TOption.SignedNumbers]); begin mBuffer := nil; mFile := openDiskFileRO(fname); @@ -645,11 +806,11 @@ begin mBufPos := 0; mBufLen := mFile.Read(mBuffer^, BufSize); if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error'); - inherited Create(); + inherited Create(aopts); end; -constructor TFileTextParser.Create (st: TStream; astOwned: Boolean=true); +constructor TFileTextParser.Create (st: TStream; astOwned: Boolean=true; aopts: TOptions=[TOption.SignedNumbers]); begin if (st = nil) then raise Exception.Create('cannot create parser for nil stream'); mFile := st; @@ -658,7 +819,7 @@ begin mBufPos := 0; mBufLen := mFile.Read(mBuffer^, BufSize); if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error'); - inherited Create(); + inherited Create(aopts); end; @@ -692,11 +853,11 @@ end; // ////////////////////////////////////////////////////////////////////////// // -constructor TStrTextParser.Create (const astr: AnsiString); +constructor TStrTextParser.Create (const astr: AnsiString; aopts: TOptions=[TOption.SignedNumbers]); begin mStr := astr; mPos := 1; - inherited Create(); + inherited Create(aopts); end;