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