X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxparser.pas;h=5332f0afe7c4af022019799a6d2eb4ce796f40c0;hb=6cfc4749e77a32dc356f8dc4b4f26788626bbb4e;hp=d0f0d3af202bef33b10715f495e13db098ce7dd3;hpb=223356cbae3197afc861efa6241c4ae91bd92885;p=d2df-sdl.git diff --git a/src/shared/xparser.pas b/src/shared/xparser.pas index d0f0d3a..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,18 +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; // == 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; @@ -53,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 (loadToken: Boolean=true); + 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 @@ -67,20 +104,35 @@ type function skipBlanks (): Boolean; // ...and comments; returns `false` on eof function skipToken (): Boolean; // returns `false` on eof + {$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 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 options: TOptions read mOptions write mOptions; + public property col: Integer read mCol; property line: Integer read mLine; @@ -103,10 +155,11 @@ type type TFileTextParser = class(TTextParser) private - const BufSize = 65536; + const BufSize = 16384; private mFile: TStream; + mStreamOwned: Boolean; mBuffer: PChar; mBufLen: Integer; mBufPos: Integer; @@ -115,8 +168,8 @@ type procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof' public - constructor Create (const fname: AnsiString; loadToken: Boolean=true); - constructor Create (st: TStream; loadToken: Boolean=true); // will take ownership on st + constructor Create (const fname: AnsiString; aopts: TOptions=[TOption.SignedNumbers]); + constructor Create (st: TStream; astOwned: Boolean=true; aopts: TOptions=[TOption.SignedNumbers]); destructor Destroy (); override; end; @@ -129,7 +182,7 @@ type procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof' public - constructor Create (const astr: AnsiString; loadToken: Boolean=true); + constructor Create (const astr: AnsiString; aopts: TOptions=[TOption.SignedNumbers]); destructor Destroy (); override; end; @@ -146,6 +199,8 @@ type public constructor Create (); + procedure flush (); virtual; + procedure put (const s: AnsiString); overload; procedure put (v: Byte); overload; procedure put (v: Integer); overload; @@ -153,69 +208,72 @@ type procedure putIndent (); procedure indent (); procedure unindent (); + + public + property curIndent: Integer read mIndent; end; // ////////////////////////////////////////////////////////////////////////// // type TFileTextWriter = class(TTextWriter) + private + const BufSize = 16384; + private mFile: TStream; + mStreamOwned: Boolean; + mBuffer: PAnsiChar; + mBufUsed: Integer; protected procedure putBuf (constref buf; len: SizeUInt); override; public constructor Create (const fname: AnsiString); + constructor Create (ast: TStream; astOwned: Boolean=true); // will own the stream by default destructor Destroy (); override; + + procedure flush (); override; end; + TStrTextWriter = class(TTextWriter) + private + mStr: AnsiString; -implementation + protected + procedure putBuf (constref buf; len: SizeUInt); override; -uses - SysUtils, utils; + public + constructor Create (); + destructor Destroy (); override; + property str: AnsiString read mStr; + end; -var - wc2shitmap: array[0..65535] of AnsiChar; - wc2shitmapInited: Boolean = false; + +implementation + +uses + utils; // ////////////////////////////////////////////////////////////////////////// // -procedure initShitMap (); -const - cp1251: array[0..127] of Word = ( - $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F, - $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F, - $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407, - $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457, - $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F, - $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F, - $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F, - $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F - ); -var - f: Integer; +constructor TParserException.Create (pr: TTextParser; const amsg: AnsiString); begin - for f := 0 to High(wc2shitmap) do wc2shitmap[f] := '?'; - for f := 0 to 127 do wc2shitmap[f] := AnsiChar(f); - for f := 0 to 127 do wc2shitmap[cp1251[f]] := AnsiChar(f+128); - wc2shitmapInited := true; + if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end; + inherited Create(amsg); end; - -// ////////////////////////////////////////////////////////////////////////// // -// TODO: make a hash or something -function wcharTo1251 (wc: WideChar): AnsiChar; inline; +constructor TParserException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const); begin - if not wc2shitmapInited then initShitMap(); - if (LongWord(wc) > 65535) then result := '?' else result := wc2shitmap[LongWord(wc)]; + if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end; + inherited Create(formatstrf(afmt, args)); end; // ////////////////////////////////////////////////////////////////////////// // -constructor TTextParser.Create (loadToken: Boolean=true); +constructor TTextParser.Create (aopts: TOptions=[TOption.SignedNumbers]); begin mLine := 1; mCol := 1; @@ -225,9 +283,9 @@ begin mTokStr := ''; mTokChar := #0; mTokInt := 0; - mAllowSignedNumbers := true; - warmup(); // change `mAllowSignedNumbers` there, if necessary - if loadToken then skipToken(); + mOptions := aopts; + warmup(); + skipToken(); end; @@ -237,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 (); @@ -270,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(); @@ -301,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(); @@ -318,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(); @@ -330,29 +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 := '+'; @@ -360,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; @@ -377,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'); @@ -390,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; @@ -408,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(); @@ -428,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); @@ -443,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(); @@ -451,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; @@ -465,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; @@ -484,6 +601,7 @@ begin if not skipBlanks() then begin result := false; + mTokType := TTEOF; mTokLine := mLine; mTokCol := mCol; exit; @@ -495,26 +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? - case curChar of - ',': mTokType := TTComma; - ':': mTokType := TTColon; - ';': mTokType := TTSemi; - '{': mTokType := TTBegin; - '}': mTokType := TTEnd; - else mTokType := TTDelim; - end; - mTokChar := curChar; + mTokChar := mCurChar; + mTokType := TTDelim; skipChar(); + 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; +end; + + +function TTextParser.isIdOrStr (): Boolean; inline; +begin + result := (mTokType = TTId) or (mTokType = TTStr); end; @@ -526,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 (CompareText(mTokStr, aid) <> 0) 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 (CompareText(mTokStr, aid) <> 0) 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; @@ -551,6 +730,21 @@ begin end; +function TTextParser.expectIdOrStr (allowEmpty: Boolean=false): AnsiString; +begin + case mTokType of + TTStr: + if (not allowEmpty) and (Length(mTokStr) = 0) then raise Exception.Create('non-empty string expected'); + TTId: + begin end; + else + raise Exception.Create('string or identifier expected'); + end; + result := mTokStr; + skipToken(); +end; + + function TTextParser.expectInt (): Integer; begin if (mTokType <> TTInt) then raise Exception.Create('string expected'); @@ -573,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; @@ -583,42 +785,52 @@ 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; loadToken: Boolean=true); +constructor TFileTextParser.Create (const fname: AnsiString; aopts: TOptions=[TOption.SignedNumbers]); begin mBuffer := nil; mFile := openDiskFileRO(fname); + mStreamOwned := true; GetMem(mBuffer, BufSize); mBufPos := 0; mBufLen := mFile.Read(mBuffer^, BufSize); if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error'); - inherited Create(loadToken); + inherited Create(aopts); end; -constructor TFileTextParser.Create (st: TStream; loadToken: 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; + mStreamOwned := astOwned; GetMem(mBuffer, BufSize); mBufPos := 0; mBufLen := mFile.Read(mBuffer^, BufSize); if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error'); - inherited Create(loadToken); + inherited Create(aopts); end; destructor TFileTextParser.Destroy (); begin if (mBuffer <> nil) then FreeMem(mBuffer); - mFile.Free(); + mBuffer := nil; + mBufPos := 0; + mBufLen := 0; + if mStreamOwned then mFile.Free(); + mFile := nil; inherited; end; @@ -641,11 +853,11 @@ end; // ////////////////////////////////////////////////////////////////////////// // -constructor TStrTextParser.Create (const astr: AnsiString; loadToken: Boolean=true); +constructor TStrTextParser.Create (const astr: AnsiString; aopts: TOptions=[TOption.SignedNumbers]); begin mStr := astr; mPos := 1; - inherited Create(loadToken); + inherited Create(aopts); end; @@ -667,6 +879,7 @@ end; // ////////////////////////////////////////////////////////////////////////// // constructor TTextWriter.Create (); begin mIndent := 0; end; +procedure TTextWriter.flush (); begin end; procedure TTextWriter.put (const s: AnsiString); overload; begin if (Length(s) > 0) then putBuf((@(s[1]))^, Length(s)); end; procedure TTextWriter.put (v: Byte); overload; begin put('%d', [v]); end; procedure TTextWriter.put (v: Integer); overload; begin put('%d', [v]); end; @@ -680,33 +893,96 @@ procedure TTextWriter.unindent (); begin Dec(mIndent, 2); end; constructor TFileTextWriter.Create (const fname: AnsiString); begin mFile := createDiskFile(fname); + mStreamOwned := true; + mBufUsed := 0; + GetMem(mBuffer, BufSize); + assert(mBuffer <> nil); inherited Create(); end; +constructor TFileTextWriter.Create (ast: TStream; astOwned: Boolean=true); +begin + if (ast = nil) then raise Exception.Create('cannot write to nil stream'); + mFile := ast; + mStreamOwned := astOwned; + mBufUsed := 0; + GetMem(mBuffer, BufSize); + assert(mBuffer <> nil); +end; + + destructor TFileTextWriter.Destroy (); begin - mFile.Free(); + flush(); + if (mBuffer <> nil) then FreeMem(mBuffer); + mBufUsed := 0; + mBuffer := nil; + if (mStreamOwned) then mFile.Free(); + mFile := nil; inherited; end; +procedure TFileTextWriter.flush (); +begin + if (mFile <> nil) and (mBufUsed > 0) then + begin + mFile.WriteBuffer(mBuffer^, mBufUsed); + end; + mBufUsed := 0; +end; + + procedure TFileTextWriter.putBuf (constref buf; len: SizeUInt); var pc: PChar; + left: Integer; begin - if (len > 0) then + if (len = 0) then exit; + pc := @buf; + while (len > 0) do begin - pc := @buf; - mFile.WriteBuffer(pc^, len); - { - while (len > 0) do + left := BufSize-mBufUsed; + if (left = 0) then begin - write(pc^); - Inc(pc); - Dec(len); + flush(); + left := BufSize-mBufUsed; + assert(left > 0); end; - } + if (left > len) then left := Integer(len); + Move(pc^, (mBuffer+mBufUsed)^, left); + Inc(mBufUsed, left); + pc += left; + len -= left; + end; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +constructor TStrTextWriter.Create (); +begin + mStr := ''; +end; + + +destructor TStrTextWriter.Destroy (); +begin + mStr := ''; + inherited; +end; + + +procedure TStrTextWriter.putBuf (constref buf; len: SizeUInt); +var + st: AnsiString = ''; +begin + if (len > 0) then + begin + SetLength(st, Integer(len)); + Move(buf, PChar(st)^, Integer(len)); + mStr += st; + st := ''; end; end;