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