src/shared/xparser.pas

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