src/shared/xparser.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE a_modes.inc}
  17 {.$DEFINE XPARSER_DEBUG}
  18 unit xparser;
  19
  20 interface
  21
  22 uses
  23   SysUtils, Classes{$IFDEF USE_MEMPOOL}, mempool{$ENDIF};
  24
  25
  26 // ////////////////////////////////////////////////////////////////////////// //
  27 type
  28   TTextParser = class;
  29
  30   TParserException = class(Exception)
  31   public
  32     tokLine, tokCol: Integer;
  33
  34   public
  35     constructor Create (pr: TTextParser; const amsg: AnsiString);
  36     constructor CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
  37   end;
  38
  39   TTextParser = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
  40   public
  41     const
  42       TTNone = -1;
  43       TTEOF = 0;
  44       TTId = 1;
  45       TTInt = 2;
  46       //TTFloat = 3; // not yet
  47       TTStr = 4; // string
  48       TTDelim = 5; // one-char delimiters
  49       //
  50       TTLogAnd = 11; // &&
  51       TTLogOr = 12; // ||
  52       TTLessEqu = 13; // <=
  53       TTGreatEqu = 14; // >=
  54       TTNotEqu = 15; // !=
  55       TTEqu = 16; // == or <>
  56       TTAss = 17; // :=
  57       TTShl = 18; // <<
  58       TTShr = 19; // >>
  59       TTDotDot = 19; // ..
  60
  61   public
  62     type
  63       TOption = (
  64         SignedNumbers, // allow signed numbers; otherwise sign will be TTDelim
  65         DollarIsId, // allow dollar in identifiers; otherwise dollar will be TTDelim
  66         DotIsId, // allow dot in identifiers; otherwise dot will be TTDelim
  67         PascalComments // allow `{}` pascal comments
  68       );
  69       TOptions = set of TOption;
  70
  71   private
  72     type
  73       TAnsiCharSet = set of AnsiChar;
  74
  75   private
  76     mLine, mCol: Integer;
  77     mCurChar, mNextChar: AnsiChar;
  78
  79     mOptions: TOptions;
  80
  81     mTokLine, mTokCol: Integer; // token start
  82     mTokType: Integer;
  83     mTokStr: AnsiString; // string or identifier
  84     mTokChar: AnsiChar; // for delimiters
  85     mTokInt: Integer;
  86
  87   protected
  88     procedure warmup (); // called in constructor to warm up the system
  89     procedure loadNextChar (); virtual; abstract; // loads next char into mNextChar; #0 means 'eof'
  90
  91   public
  92     constructor Create (aopts: TOptions=[TOption.SignedNumbers]);
  93     destructor Destroy (); override;
  94
  95     procedure error (const amsg: AnsiString); noreturn;
  96     procedure errorfmt (const afmt: AnsiString; const args: array of const); noreturn;
  97
  98     function isEOF (): Boolean; inline;
  99
 100     function skipChar (): Boolean; // returns `false` on eof
 101
 102     function skipBlanks (): Boolean; // ...and comments; returns `false` on eof
 103
 104     function skipToken (): Boolean; // returns `false` on eof
 105     {$IFDEF XPARSER_DEBUG}
 106     function skipToken1 (): Boolean;
 107     {$ENDIF}
 108
 109     function isIdOrStr (): Boolean; inline;
 110
 111     function expectId (): AnsiString;
 112     procedure expectId (const aid: AnsiString; caseSens: Boolean=true);
 113     function eatId (const aid: AnsiString; caseSens: Boolean=true): Boolean;
 114     function eatIdOrStr (const aid: AnsiString; caseSens: Boolean=true): Boolean;
 115     function eatIdOrStrCI (const aid: AnsiString): Boolean; inline;
 116
 117     function expectStr (allowEmpty: Boolean=false): AnsiString;
 118     function expectInt (): Integer;
 119
 120     function expectStrOrId (allowEmpty: Boolean=false): AnsiString;
 121
 122     procedure expectTT (ttype: Integer);
 123     function eatTT (ttype: Integer): Boolean;
 124
 125     procedure expectDelim (const ch: AnsiChar);
 126     function expectDelims (const ch: TAnsiCharSet): AnsiChar;
 127     function eatDelim (const ch: AnsiChar): Boolean;
 128
 129     function isDelim (const ch: AnsiChar): Boolean; inline;
 130
 131   public
 132     property options: TOptions read mOptions write mOptions;
 133
 134   public
 135     property col: Integer read mCol;
 136     property line: Integer read mLine;
 137
 138     property curChar: AnsiChar read mCurChar;
 139     property nextChar: AnsiChar read mNextChar;
 140
 141     // token start
 142     property tokCol: Integer read mTokCol;
 143     property tokLine: Integer read mTokLine;
 144
 145     property tokType: Integer read mTokType; // see TTXXX constants
 146     property tokStr: AnsiString read mTokStr; // string or identifier
 147     property tokChar: AnsiChar read mTokChar; // for delimiters
 148     property tokInt: Integer read mTokInt;
 149   end;
 150
 151
 152 // ////////////////////////////////////////////////////////////////////////// //
 153 type
 154   TFileTextParser = class(TTextParser)
 155   private
 156     const BufSize = 16384;
 157
 158   private
 159     mFile: TStream;
 160     mStreamOwned: Boolean;
 161     mBuffer: PChar;
 162     mBufLen: Integer;
 163     mBufPos: Integer;
 164
 165   protected
 166     procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
 167
 168   public
 169     constructor Create (const fname: AnsiString; aopts: TOptions=[TOption.SignedNumbers]);
 170     constructor Create (st: TStream; astOwned: Boolean=true; aopts: TOptions=[TOption.SignedNumbers]);
 171     destructor Destroy (); override;
 172   end;
 173
 174   TStrTextParser = class(TTextParser)
 175   private
 176     mStr: AnsiString;
 177     mPos: Integer;
 178
 179   protected
 180     procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
 181
 182   public
 183     constructor Create (const astr: AnsiString; aopts: TOptions=[TOption.SignedNumbers]);
 184     destructor Destroy (); override;
 185   end;
 186
 187
 188 // ////////////////////////////////////////////////////////////////////////// //
 189 type
 190   TTextWriter = class
 191   protected
 192     mIndent: Integer;
 193
 194   protected
 195     procedure putBuf (constref buf; len: SizeUInt); virtual; abstract;
 196
 197   public
 198     constructor Create ();
 199
 200     procedure flush (); virtual;
 201
 202     procedure put (const s: AnsiString); overload;
 203     procedure put (v: Byte); overload;
 204     procedure put (v: Integer); overload;
 205     procedure put (const fmt: AnsiString; args: array of const); overload;
 206     procedure putIndent ();
 207     procedure indent ();
 208     procedure unindent ();
 209
 210   public
 211     property curIndent: Integer read mIndent;
 212   end;
 213
 214
 215 // ////////////////////////////////////////////////////////////////////////// //
 216 type
 217   TFileTextWriter = class(TTextWriter)
 218   private
 219     const BufSize = 16384;
 220
 221   private
 222     mFile: TStream;
 223     mStreamOwned: Boolean;
 224     mBuffer: PAnsiChar;
 225     mBufUsed: Integer;
 226
 227   protected
 228     procedure putBuf (constref buf; len: SizeUInt); override;
 229
 230   public
 231     constructor Create (const fname: AnsiString);
 232     constructor Create (ast: TStream; astOwned: Boolean=true); // will own the stream by default
 233     destructor Destroy (); override;
 234
 235     procedure flush (); override;
 236   end;
 237
 238   TStrTextWriter = class(TTextWriter)
 239   private
 240     mStr: AnsiString;
 241
 242   protected
 243     procedure putBuf (constref buf; len: SizeUInt); override;
 244
 245   public
 246     constructor Create ();
 247     destructor Destroy (); override;
 248
 249     property str: AnsiString read mStr;
 250   end;
 251
 252
 253 implementation
 254
 255 uses
 256   utils;
 257
 258
 259 // ////////////////////////////////////////////////////////////////////////// //
 260 constructor TParserException.Create (pr: TTextParser; const amsg: AnsiString);
 261 begin
 262   if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end;
 263   inherited Create(amsg);
 264 end;
 265
 266 constructor TParserException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
 267 begin
 268   if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end;
 269   inherited Create(formatstrf(afmt, args));
 270 end;
 271
 272
 273 // ////////////////////////////////////////////////////////////////////////// //
 274 constructor TTextParser.Create (aopts: TOptions=[TOption.SignedNumbers]);
 275 begin
 276   mLine := 1;
 277   mCol := 1;
 278   mCurChar := #0;
 279   mNextChar := #0;
 280   mTokType := TTNone;
 281   mTokStr := '';
 282   mTokChar := #0;
 283   mTokInt := 0;
 284   mOptions := aopts;
 285   warmup();
 286   skipToken();
 287 end;
 288
 289
 290 destructor TTextParser.Destroy ();
 291 begin
 292   inherited;
 293 end;
 294
 295
 296 procedure TTextParser.error (const amsg: AnsiString); noreturn;
 297 begin
 298   raise TParserException.Create(self, amsg);
 299 end;
 300
 301
 302 procedure TTextParser.errorfmt (const afmt: AnsiString; const args: array of const); noreturn;
 303 begin
 304   raise TParserException.CreateFmt(self, afmt, args);
 305 end;
 306
 307
 308 function TTextParser.isEOF (): Boolean; inline; begin result := (mCurChar = #0); end;
 309
 310
 311 procedure TTextParser.warmup ();
 312 begin
 313   mNextChar := ' ';
 314   loadNextChar();
 315   mCurChar := mNextChar;
 316   if (mNextChar <> #0) then loadNextChar();
 317 end;
 318
 319
 320 function TTextParser.skipChar (): Boolean;
 321 begin
 322   if (mCurChar = #0) then begin result := false; exit; end;
 323   if (mCurChar = #10) then begin mCol := 1; Inc(mLine); end else Inc(mCol);
 324   mCurChar := mNextChar;
 325   if (mCurChar = #0) then begin result := false; exit; end;
 326   loadNextChar();
 327   // skip CR in CR/LF
 328   if (mCurChar = #13) then
 329   begin
 330     if (mNextChar = #10) then loadNextChar();
 331     mCurChar := #10;
 332   end;
 333   result := true;
 334 end;
 335
 336
 337 function TTextParser.skipBlanks (): Boolean;
 338 var
 339   level: Integer;
 340 begin
 341   while not isEOF do
 342   begin
 343     if (curChar = '/') then
 344     begin
 345       // single-line comment
 346       if (nextChar = '/') then
 347       begin
 348         while not isEOF and (curChar <> #10) do skipChar();
 349         skipChar(); // skip EOL
 350         continue;
 351       end;
 352       // multline comment
 353       if (nextChar = '*') then
 354       begin
 355         // skip comment start
 356         skipChar();
 357         skipChar();
 358         while not isEOF do
 359         begin
 360           if (curChar = '*') and (nextChar = '/') then
 361           begin
 362             // skip comment end
 363             skipChar();
 364             skipChar();
 365             break;
 366           end;
 367           skipChar();
 368         end;
 369         continue;
 370       end;
 371       // nesting multline comment
 372       if (nextChar = '+') then
 373       begin
 374         // skip comment start
 375         skipChar();
 376         skipChar();
 377         level := 1;
 378         while not isEOF do
 379         begin
 380           if (curChar = '+') and (nextChar = '/') then
 381           begin
 382             // skip comment end
 383             skipChar();
 384             skipChar();
 385             Dec(level);
 386             if (level = 0) then break;
 387             continue;
 388           end;
 389           if (curChar = '/') and (nextChar = '+') then
 390           begin
 391             // skip comment start
 392             skipChar();
 393             skipChar();
 394             Inc(level);
 395             continue;
 396           end;
 397           skipChar();
 398         end;
 399         continue;
 400       end;
 401     end
 402     else if (curChar = '(') and (nextChar = '*') then
 403     begin
 404       // pascal comment; skip comment start
 405       skipChar();
 406       skipChar();
 407       while not isEOF do
 408       begin
 409         if (curChar = '*') and (nextChar = ')') then
 410         begin
 411           // skip comment end
 412           skipChar();
 413           skipChar();
 414           break;
 415         end;
 416         skipChar();
 417       end;
 418       continue;
 419     end
 420     else if (curChar = '{') and (TOption.PascalComments in mOptions) then
 421     begin
 422       // pascal comment; skip comment start
 423       skipChar();
 424       while not isEOF do
 425       begin
 426         if (curChar = '}') then
 427         begin
 428           // skip comment end
 429           skipChar();
 430           break;
 431         end;
 432         skipChar();
 433       end;
 434       continue;
 435     end;
 436     if (curChar > ' ') then break;
 437     skipChar(); // skip blank
 438   end;
 439   result := not isEOF;
 440 end;
 441
 442
 443 {$IFDEF XPARSER_DEBUG}
 444 function TTextParser.skipToken (): Boolean;
 445 begin
 446   writeln('getting token...');
 447   result := skipToken1();
 448   writeln('  got token: ', mTokType, ' <', mTokStr, '> : <', mTokChar, '>');
 449 end;
 450
 451 function TTextParser.skipToken1 (): Boolean;
 452 {$ELSE}
 453 function TTextParser.skipToken (): Boolean;
 454 {$ENDIF}
 455   procedure parseInt ();
 456   var
 457     neg: Boolean = false;
 458     base: Integer = -1;
 459     n: Integer;
 460   begin
 461     if (TOption.SignedNumbers in mOptions) then
 462     begin
 463       if (curChar = '+') or (curChar = '-') then
 464       begin
 465         neg := (curChar = '-');
 466         skipChar();
 467         if (curChar < '0') or (curChar > '9') then
 468         begin
 469           mTokType := TTDelim;
 470           if (neg) then mTokChar := '-' else mTokChar := '+';
 471           exit;
 472         end;
 473       end;
 474     end;
 475     if (curChar = '0') then
 476     begin
 477       case nextChar of
 478         'b','B': base := 2;
 479         'o','O': base := 8;
 480         'd','D': base := 10;
 481         'h','H': base := 16;
 482       end;
 483       if (base > 0) then
 484       begin
 485         // skip prefix
 486         skipChar();
 487         skipChar();
 488       end;
 489     end;
 490     // default base
 491     if (base < 0) then base := 10;
 492     if (digitInBase(curChar, base) < 0) then raise Exception.Create('invalid number');
 493     mTokType := TTInt;
 494     mTokInt := 0; // just in case
 495     while not isEOF do
 496     begin
 497       n := digitInBase(curChar, base);
 498       if (n < 0) then break;
 499       n := mTokInt*10+n;
 500       if (n < 0) or (n < mTokInt) then raise Exception.Create('integer overflow');
 501       mTokInt := n;
 502       skipChar();
 503     end;
 504     // check for valid number end
 505     if not isEOF then
 506     begin
 507       if (curChar = '.') then raise Exception.Create('floating numbers aren''t supported yet');
 508       if (curChar = '_') or ((curChar >= 'A') and (curChar <= 'Z')) or ((curChar >= 'a') and (curChar <= 'z')) or (curChar >= #128) then
 509       begin
 510         raise Exception.Create('invalid number');
 511       end;
 512     end;
 513     if neg then mTokInt := -mTokInt;
 514   end;
 515
 516   procedure parseString ();
 517   var
 518     qch, ch: AnsiChar;
 519     n: Integer;
 520   begin
 521     mTokType := TTStr;
 522     mTokStr := ''; // just in case
 523     qch := curChar;
 524     skipChar(); // skip starting quote
 525     while not isEOF do
 526     begin
 527       // escape
 528       if (qch = '"') and (curChar = '\') then
 529       begin
 530         if (nextChar = #0) then raise Exception.Create('unterminated string escape');
 531         ch := nextChar;
 532         // skip backslash and escape type
 533         skipChar();
 534         skipChar();
 535         case ch of
 536           't': mTokStr += #9;
 537           'n': mTokStr += #10;
 538           'r': mTokStr += #13;
 539           'z': mTokStr += #0;
 540           'e': mTokStr += #27;
 541           'x', 'X': // hex escape
 542             begin
 543               n := digitInBase(curChar, 16);
 544               if (n < 0) then raise Exception.Create('invalid hexstr escape');
 545               skipChar();
 546               if (digitInBase(curChar, 16) > 0) then
 547               begin
 548                 n := n*16+digitInBase(curChar, 16);
 549                 skipChar();
 550               end;
 551               mTokStr += AnsiChar(n);
 552             end;
 553           else mTokStr += ch;
 554         end;
 555         continue;
 556       end;
 557       // duplicate single quote (pascal style)
 558       if (qch = '''') and (curChar = '''') and (nextChar = '''') then
 559       begin
 560         // skip both quotes
 561         skipChar();
 562         skipChar();
 563         mTokStr += '''';
 564         continue;
 565       end;
 566       if (curChar = qch) then
 567       begin
 568         skipChar(); // skip ending quote
 569         break;
 570       end;
 571       mTokStr += curChar;
 572       skipChar();
 573     end;
 574   end;
 575
 576   procedure parseId ();
 577   begin
 578     mTokType := TTId;
 579     mTokStr := ''; // just in case
 580     while (curChar = '_') or ((curChar >= '0') and (curChar <= '9')) or
 581           ((curChar >= 'A') and (curChar <= 'Z')) or
 582           ((curChar >= 'a') and (curChar <= 'z')) or
 583           (curChar >= #128) or
 584           ((TOption.DollarIsId in mOptions) and (curChar = '$')) or
 585           ((TOption.DotIsId in mOptions) and (curChar = '.') and (nextChar <> '.')) do
 586     begin
 587       mTokStr += curChar;
 588       skipChar();
 589     end;
 590   end;
 591
 592 begin
 593   mTokType := TTEOF;
 594   mTokStr := '';
 595   mTokChar := #0;
 596   mTokInt := 0;
 597
 598   if not skipBlanks() then
 599   begin
 600     result := false;
 601     mTokLine := mLine;
 602     mTokCol := mCol;
 603     exit;
 604   end;
 605
 606   mTokLine := mLine;
 607   mTokCol := mCol;
 608
 609   result := true;
 610
 611   // number?
 612   if (TOption.SignedNumbers in mOptions) and ((curChar = '+') or (curChar = '-')) then begin parseInt(); exit; end;
 613   if (curChar >= '0') and (curChar <= '9') then begin parseInt(); exit; end;
 614
 615   // string?
 616   if (curChar = '"') or (curChar = '''') then begin parseString(); exit; end;
 617
 618   // identifier?
 619   if (curChar = '_') or ((curChar >= 'A') and (curChar <= 'Z')) or ((curChar >= 'a') and (curChar <= 'z')) or (curChar >= #128) then begin parseId(); exit; end;
 620   if (TOption.DollarIsId in mOptions) and (curChar = '$') then begin parseId(); exit; end;
 621   if (TOption.DotIsId in mOptions) and (curChar = '.') and (nextChar <> '.') then begin parseId(); exit; end;
 622
 623   // known delimiters?
 624   mTokChar := curChar;
 625   mTokType := TTDelim;
 626   skipChar();
 627   if (curChar = '=') then
 628   begin
 629     case mTokChar of
 630       '<': begin mTokType := TTLessEqu; mTokStr := '<='; skipChar(); exit; end;
 631       '>': begin mTokType := TTGreatEqu; mTokStr := '>='; skipChar(); exit; end;
 632       '!': begin mTokType := TTNotEqu; mTokStr := '!='; skipChar(); exit; end;
 633       '=': begin mTokType := TTEqu; mTokStr := '=='; skipChar(); exit; end;
 634       ':': begin mTokType := TTAss; mTokStr := ':='; skipChar(); exit; end;
 635     end;
 636   end
 637   else if (mTokChar = curChar) then
 638   begin
 639     case mTokChar of
 640       '<': begin mTokType := TTShl; mTokStr := '<<'; skipChar(); exit; end;
 641       '>': begin mTokType := TTShr; mTokStr := '>>'; skipChar(); exit; end;
 642       '&': begin mTokType := TTLogAnd; mTokStr := '&&'; skipChar(); exit; end;
 643       '|': begin mTokType := TTLogOr; mTokStr := '||'; skipChar(); exit; end;
 644     end;
 645   end
 646   else
 647   begin
 648     case mTokChar of
 649       '<': if (curChar = '>') then begin mTokType := TTNotEqu; mTokStr := '<>'; skipChar(); exit; end;
 650       '.': if (curChar = '.') then begin mTokType := TTDotDot; mTokStr := '..'; skipChar(); exit; end;
 651     end;
 652   end;
 653 end;
 654
 655
 656 function TTextParser.isIdOrStr (): Boolean; inline;
 657 begin
 658   result := (mTokType = TTId) or (mTokType = TTStr);
 659 end;
 660
 661
 662 function TTextParser.expectId (): AnsiString;
 663 begin
 664   if (mTokType <> TTId) then raise Exception.Create('identifier expected');
 665   result := mTokStr;
 666   skipToken();
 667 end;
 668
 669
 670 procedure TTextParser.expectId (const aid: AnsiString; caseSens: Boolean=true);
 671 begin
 672   if caseSens then
 673   begin
 674     if (mTokType <> TTId) or (mTokStr <> aid) then raise Exception.Create('identifier '''+aid+''' expected');
 675   end
 676   else
 677   begin
 678     if (mTokType <> TTId) or (not strEquCI1251(mTokStr, aid)) then raise Exception.Create('identifier '''+aid+''' expected');
 679   end;
 680   skipToken();
 681 end;
 682
 683
 684 function TTextParser.eatId (const aid: AnsiString; caseSens: Boolean=true): Boolean;
 685 begin
 686   if caseSens then
 687   begin
 688     result := (mTokType = TTId) and (mTokStr = aid);
 689   end
 690   else
 691   begin
 692     result := (mTokType = TTId) and strEquCI1251(mTokStr, aid);
 693   end;
 694   if result then skipToken();
 695 end;
 696
 697
 698 function TTextParser.eatIdOrStr (const aid: AnsiString; caseSens: Boolean=true): Boolean;
 699 begin
 700   if caseSens then
 701   begin
 702     result := (mTokType = TTId) and (mTokStr = aid);
 703     if not result then result := (mTokType = TTStr) and (mTokStr = aid);
 704   end
 705   else
 706   begin
 707     result := (mTokType = TTId) and strEquCI1251(mTokStr, aid);
 708     if not result then result := (mTokType = TTStr) and strEquCI1251(mTokStr, aid);
 709   end;
 710   if result then skipToken();
 711 end;
 712
 713
 714 function TTextParser.eatIdOrStrCI (const aid: AnsiString): Boolean; inline;
 715 begin
 716   result := eatIdOrStr(aid, false);
 717 end;
 718
 719
 720 function TTextParser.expectStr (allowEmpty: Boolean=false): AnsiString;
 721 begin
 722   if (mTokType <> TTStr) then raise Exception.Create('string expected');
 723   if (not allowEmpty) and (Length(mTokStr) = 0) then raise Exception.Create('non-empty string expected');
 724   result := mTokStr;
 725   skipToken();
 726 end;
 727
 728
 729 function TTextParser.expectStrOrId (allowEmpty: Boolean=false): AnsiString;
 730 begin
 731   case mTokType of
 732     TTStr:
 733       if (not allowEmpty) and (Length(mTokStr) = 0) then raise Exception.Create('non-empty string expected');
 734     TTId:
 735       begin end;
 736     else
 737       raise Exception.Create('string or identifier expected');
 738   end;
 739   result := mTokStr;
 740   skipToken();
 741 end;
 742
 743
 744 function TTextParser.expectInt (): Integer;
 745 begin
 746   if (mTokType <> TTInt) then raise Exception.Create('string expected');
 747   result := mTokInt;
 748   skipToken();
 749 end;
 750
 751
 752 procedure TTextParser.expectTT (ttype: Integer);
 753 begin
 754   if (mTokType <> ttype) then raise Exception.Create('unexpected token');
 755   skipToken();
 756 end;
 757
 758
 759 function TTextParser.eatTT (ttype: Integer): Boolean;
 760 begin
 761   result := (mTokType = ttype);
 762   if result then skipToken();
 763 end;
 764
 765
 766 procedure TTextParser.expectDelim (const ch: AnsiChar);
 767 begin
 768   if (mTokType <> TTDelim) or (mTokChar <> ch) then raise Exception.CreateFmt('delimiter ''%s'' expected', [ch]);
 769   skipToken();
 770 end;
 771
 772
 773 function TTextParser.expectDelims (const ch: TAnsiCharSet): AnsiChar;
 774 begin
 775   if (mTokType <> TTDelim) then raise Exception.Create('delimiter expected');
 776   if not (mTokChar in ch) then raise Exception.Create('delimiter expected');
 777   result := mTokChar;
 778   skipToken();
 779 end;
 780
 781
 782 function TTextParser.eatDelim (const ch: AnsiChar): Boolean;
 783 begin
 784   result := (mTokType = TTDelim) and (mTokChar = ch);
 785   if result then skipToken();
 786 end;
 787
 788
 789 function TTextParser.isDelim (const ch: AnsiChar): Boolean; inline;
 790 begin
 791   result := (mTokType = TTDelim) and (mTokChar = ch);
 792 end;
 793
 794
 795 // ////////////////////////////////////////////////////////////////////////// //
 796 constructor TFileTextParser.Create (const fname: AnsiString; aopts: TOptions=[TOption.SignedNumbers]);
 797 begin
 798   mBuffer := nil;
 799   mFile := openDiskFileRO(fname);
 800   mStreamOwned := true;
 801   GetMem(mBuffer, BufSize);
 802   mBufPos := 0;
 803   mBufLen := mFile.Read(mBuffer^, BufSize);
 804   if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
 805   inherited Create(aopts);
 806 end;
 807
 808
 809 constructor TFileTextParser.Create (st: TStream; astOwned: Boolean=true; aopts: TOptions=[TOption.SignedNumbers]);
 810 begin
 811   if (st = nil) then raise Exception.Create('cannot create parser for nil stream');
 812   mFile := st;
 813   mStreamOwned := astOwned;
 814   GetMem(mBuffer, BufSize);
 815   mBufPos := 0;
 816   mBufLen := mFile.Read(mBuffer^, BufSize);
 817   if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
 818   inherited Create(aopts);
 819 end;
 820
 821
 822 destructor TFileTextParser.Destroy ();
 823 begin
 824   if (mBuffer <> nil) then FreeMem(mBuffer);
 825   mBuffer := nil;
 826   mBufPos := 0;
 827   mBufLen := 0;
 828   if mStreamOwned then mFile.Free();
 829   mFile := nil;
 830   inherited;
 831 end;
 832
 833
 834 procedure TFileTextParser.loadNextChar ();
 835 begin
 836   if (mBufLen = 0) then begin mNextChar := #0; exit; end;
 837   if (mBufPos >= mBufLen) then
 838   begin
 839     mBufLen := mFile.Read(mBuffer^, BufSize);
 840     if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
 841     if (mBufLen = 0) then begin mNextChar := #0; exit; end;
 842     mBufPos := 0;
 843   end;
 844   assert(mBufPos < mBufLen);
 845   mNextChar := mBuffer[mBufPos];
 846   Inc(mBufPos);
 847   if (mNextChar = #0) then mNextChar := ' ';
 848 end;
 849
 850
 851 // ////////////////////////////////////////////////////////////////////////// //
 852 constructor TStrTextParser.Create (const astr: AnsiString; aopts: TOptions=[TOption.SignedNumbers]);
 853 begin
 854   mStr := astr;
 855   mPos := 1;
 856   inherited Create(aopts);
 857 end;
 858
 859
 860 destructor TStrTextParser.Destroy ();
 861 begin
 862   mStr := '';
 863   inherited;
 864 end;
 865
 866
 867 procedure TStrTextParser.loadNextChar ();
 868 begin
 869   mNextChar := #0;
 870   if (mPos > Length(mStr)) then exit;
 871   mNextChar := mStr[mPos]; Inc(mPos);
 872   if (mNextChar = #0) then mNextChar := ' ';
 873 end;
 874
 875
 876 // ////////////////////////////////////////////////////////////////////////// //
 877 constructor TTextWriter.Create (); begin mIndent := 0; end;
 878 procedure TTextWriter.flush (); begin end;
 879 procedure TTextWriter.put (const s: AnsiString); overload; begin if (Length(s) > 0) then putBuf((@(s[1]))^, Length(s)); end;
 880 procedure TTextWriter.put (v: Byte); overload; begin put('%d', [v]); end;
 881 procedure TTextWriter.put (v: Integer); overload; begin put('%d', [v]); end;
 882 procedure TTextWriter.put (const fmt: AnsiString; args: array of const); overload; begin put(formatstrf(fmt, args)); end;
 883 procedure TTextWriter.putIndent (); var f: Integer; begin for f := 1 to mIndent do put(' '); end;
 884 procedure TTextWriter.indent (); begin Inc(mIndent, 2); end;
 885 procedure TTextWriter.unindent (); begin Dec(mIndent, 2); end;
 886
 887
 888 // ////////////////////////////////////////////////////////////////////////// //
 889 constructor TFileTextWriter.Create (const fname: AnsiString);
 890 begin
 891   mFile := createDiskFile(fname);
 892   mStreamOwned := true;
 893   mBufUsed := 0;
 894   GetMem(mBuffer, BufSize);
 895   assert(mBuffer <> nil);
 896   inherited Create();
 897 end;
 898
 899
 900 constructor TFileTextWriter.Create (ast: TStream; astOwned: Boolean=true);
 901 begin
 902   if (ast = nil) then raise Exception.Create('cannot write to nil stream');
 903   mFile := ast;
 904   mStreamOwned := astOwned;
 905   mBufUsed := 0;
 906   GetMem(mBuffer, BufSize);
 907   assert(mBuffer <> nil);
 908 end;
 909
 910
 911 destructor TFileTextWriter.Destroy ();
 912 begin
 913   flush();
 914   if (mBuffer <> nil) then FreeMem(mBuffer);
 915   mBufUsed := 0;
 916   mBuffer := nil;
 917   if (mStreamOwned) then mFile.Free();
 918   mFile := nil;
 919   inherited;
 920 end;
 921
 922
 923 procedure TFileTextWriter.flush ();
 924 begin
 925   if (mFile <> nil) and (mBufUsed > 0) then
 926   begin
 927     mFile.WriteBuffer(mBuffer^, mBufUsed);
 928   end;
 929   mBufUsed := 0;
 930 end;
 931
 932
 933 procedure TFileTextWriter.putBuf (constref buf; len: SizeUInt);
 934 var
 935   pc: PChar;
 936   left: Integer;
 937 begin
 938   if (len = 0) then exit;
 939   pc := @buf;
 940   while (len > 0) do
 941   begin
 942     left := BufSize-mBufUsed;
 943     if (left = 0) then
 944     begin
 945       flush();
 946       left := BufSize-mBufUsed;
 947       assert(left > 0);
 948     end;
 949     if (left > len) then left := Integer(len);
 950     Move(pc^, (mBuffer+mBufUsed)^, left);
 951     Inc(mBufUsed, left);
 952     pc += left;
 953     len -= left;
 954   end;
 955 end;
 956
 957
 958 // ////////////////////////////////////////////////////////////////////////// //
 959 constructor TStrTextWriter.Create ();
 960 begin
 961   mStr := '';
 962 end;
 963
 964
 965 destructor TStrTextWriter.Destroy ();
 966 begin
 967   mStr := '';
 968   inherited;
 969 end;
 970
 971
 972 procedure TStrTextWriter.putBuf (constref buf; len: SizeUInt);
 973 var
 974   st: AnsiString = '';
 975 begin
 976   if (len > 0) then
 977   begin
 978     SetLength(st, Integer(len));
 979     Move(buf, PChar(st)^, Integer(len));
 980     mStr += st;
 981     st := '';
 982   end;
 983 end;
 984
 985
 986 end.