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