DEADSOFTWARE

al: fix build with sdl 1.2
[d2df-sdl.git] / 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, version 3 of the License ONLY.
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;
20 interface
22 uses
23 SysUtils, Classes{$IFDEF USE_MEMPOOL}, mempool{$ENDIF};
26 // ////////////////////////////////////////////////////////////////////////// //
27 type
28 TTextParser = class;
30 TParserException = class(Exception)
31 public
32 tokLine, tokCol: Integer;
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;
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; // ..
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 DashIsId, // '-' can be part of identifier (but identifier cannot start with '-')
68 HtmlColors, // #rgb or #rrggbb colors
69 PascalComments // allow `{}` pascal comments
70 );
71 TOptions = set of TOption;
73 private
74 type
75 TAnsiCharSet = set of AnsiChar;
76 const
77 CharBufSize = 8;
79 private
80 mLine, mCol: Integer;
81 // chars for 'unget'
82 mCharBuf: packed array [0..CharBufSize-1] of AnsiChar;
83 mCharBufUsed: Integer;
84 mCharBufPos: Integer;
85 mEofHit: Boolean; // no more chars to load into mCharBuf
87 mOptions: TOptions;
89 mTokLine, mTokCol: Integer; // token start
90 mTokType: Integer;
91 mTokStr: AnsiString; // string or identifier
92 mTokChar: AnsiChar; // for delimiters
93 mTokInt: Integer;
95 private
96 procedure fillCharBuf ();
97 function popFrontChar (): AnsiChar; inline; // never drains char buffer (except on "total EOF")
98 function peekCurChar (): AnsiChar; inline;
99 function peekNextChar (): AnsiChar; inline;
100 function peekChar (dest: Integer): AnsiChar; inline;
102 protected
103 function loadChar (): AnsiChar; virtual; abstract; // loads next char; #0 means 'eof'
105 public
106 function isIdStartChar (ch: AnsiChar): Boolean; inline;
107 function isIdMidChar (ch: AnsiChar): Boolean; inline;
109 public
110 constructor Create (aopts: TOptions=[TOption.SignedNumbers]);
111 destructor Destroy (); override;
113 procedure error (const amsg: AnsiString); noreturn;
114 procedure errorfmt (const afmt: AnsiString; const args: array of const); noreturn;
116 function skipChar (): Boolean; // returns `false` on eof
118 function skipBlanks (): Boolean; // ...and comments; returns `false` on eof
120 function skipToken (): Boolean; // returns `false` on eof
121 {$IFDEF XPARSER_DEBUG}
122 function skipToken1 (): Boolean;
123 {$ENDIF}
125 function isEOF (): Boolean; inline;
126 function isId (): Boolean; inline;
127 function isInt (): Boolean; inline;
128 function isStr (): Boolean; inline;
129 function isDelim (): Boolean; inline;
130 function isIdOrStr (): Boolean; inline;
132 function expectId (): AnsiString;
133 procedure expectId (const aid: AnsiString; caseSens: Boolean=true);
134 function eatId (const aid: AnsiString; caseSens: Boolean=true): Boolean;
135 function eatIdOrStr (const aid: AnsiString; caseSens: Boolean=true): Boolean;
136 function eatIdOrStrCI (const aid: AnsiString): Boolean; inline;
138 function expectStr (allowEmpty: Boolean=false): AnsiString;
139 function expectInt (): Integer;
141 function expectIdOrStr (allowEmpty: Boolean=false): AnsiString;
143 procedure expectTT (ttype: Integer);
144 function eatTT (ttype: Integer): Boolean;
146 procedure expectDelim (const ch: AnsiChar);
147 function expectDelims (const ch: TAnsiCharSet): AnsiChar;
148 function eatDelim (const ch: AnsiChar): Boolean;
150 function isDelim (const ch: AnsiChar): Boolean; inline;
152 public
153 property options: TOptions read mOptions write mOptions;
155 public
156 property col: Integer read mCol;
157 property line: Integer read mLine;
159 property curChar: AnsiChar read peekCurChar;
160 property nextChar: AnsiChar read peekNextChar;
162 // token start
163 property tokCol: Integer read mTokCol;
164 property tokLine: Integer read mTokLine;
166 property tokType: Integer read mTokType; // see TTXXX constants
167 property tokStr: AnsiString read mTokStr; // string or identifier
168 property tokChar: AnsiChar read mTokChar; // for delimiters
169 property tokInt: Integer read mTokInt;
170 end;
173 // ////////////////////////////////////////////////////////////////////////// //
174 type
175 TFileTextParser = class(TTextParser)
176 private
177 const BufSize = 16384;
179 private
180 mFile: TStream;
181 mStreamOwned: Boolean;
182 mBuffer: PChar;
183 mBufLen: Integer;
184 mBufPos: Integer;
186 protected
187 function loadChar (): AnsiChar; override; // loads next char; #0 means 'eof'
189 public
190 constructor Create (const fname: AnsiString; aopts: TOptions=[TOption.SignedNumbers]);
191 constructor Create (st: TStream; astOwned: Boolean=true; aopts: TOptions=[TOption.SignedNumbers]);
192 destructor Destroy (); override;
193 end;
195 TStrTextParser = class(TTextParser)
196 private
197 mStr: AnsiString;
198 mPos: Integer;
200 protected
201 function loadChar (): AnsiChar; override; // loads next char; #0 means 'eof'
203 public
204 constructor Create (const astr: AnsiString; aopts: TOptions=[TOption.SignedNumbers]);
205 destructor Destroy (); override;
206 end;
209 // ////////////////////////////////////////////////////////////////////////// //
210 type
211 TTextWriter = class
212 protected
213 mIndent: Integer;
215 protected
216 procedure putBuf (constref buf; len: SizeUInt); virtual; abstract;
218 public
219 constructor Create ();
221 procedure flush (); virtual;
223 procedure put (const s: AnsiString); overload;
224 procedure put (v: Byte); overload;
225 procedure put (v: Integer); overload;
226 procedure put (const fmt: AnsiString; args: array of const); overload;
227 procedure putIndent ();
228 procedure indent ();
229 procedure unindent ();
231 public
232 property curIndent: Integer read mIndent;
233 end;
236 // ////////////////////////////////////////////////////////////////////////// //
237 type
238 TFileTextWriter = class(TTextWriter)
239 private
240 const BufSize = 16384;
242 private
243 mFile: TStream;
244 mStreamOwned: Boolean;
245 mBuffer: PAnsiChar;
246 mBufUsed: Integer;
248 protected
249 procedure putBuf (constref buf; len: SizeUInt); override;
251 public
252 constructor Create (const fname: AnsiString);
253 constructor Create (ast: TStream; astOwned: Boolean=true); // will own the stream by default
254 destructor Destroy (); override;
256 procedure flush (); override;
257 end;
259 TStrTextWriter = class(TTextWriter)
260 private
261 mStr: AnsiString;
263 protected
264 procedure putBuf (constref buf; len: SizeUInt); override;
266 public
267 constructor Create ();
268 destructor Destroy (); override;
270 property str: AnsiString read mStr;
271 end;
274 implementation
276 uses
277 utils;
280 // ////////////////////////////////////////////////////////////////////////// //
281 constructor TParserException.Create (pr: TTextParser; const amsg: AnsiString);
282 begin
283 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end;
284 inherited Create(amsg);
285 end;
287 constructor TParserException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
288 begin
289 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end;
290 inherited Create(formatstrf(afmt, args));
291 end;
294 // ////////////////////////////////////////////////////////////////////////// //
295 constructor TTextParser.Create (aopts: TOptions=[TOption.SignedNumbers]);
296 begin
297 mLine := 1;
298 mCol := 1;
299 mCharBufUsed := 0;
300 mCharBufPos := 0;
301 mEofHit := false;
302 mTokType := TTNone;
303 mTokStr := '';
304 mTokChar := #0;
305 mTokInt := 0;
306 mOptions := aopts;
307 skipToken();
308 // fuck you, BOM!
310 if (mBufLen >= 3) and (mBuffer[0] = #$EF) and (mBuffer[1] = #$BB) and (mBuffer[2] = #$BF) then
311 begin
312 for f := 3 to mBufLen-1 do mBuffer[f-3] := mBuffer[f];
313 Dec(mBufLen, 3);
314 end;
316 end;
319 destructor TTextParser.Destroy ();
320 begin
321 inherited;
322 end;
325 procedure TTextParser.error (const amsg: AnsiString); noreturn;
326 begin
327 raise TParserException.Create(self, amsg);
328 end;
331 procedure TTextParser.errorfmt (const afmt: AnsiString; const args: array of const); noreturn;
332 begin
333 raise TParserException.CreateFmt(self, afmt, args);
334 end;
337 function TTextParser.isIdStartChar (ch: AnsiChar): Boolean; inline;
338 begin
339 result :=
340 (ch = '_') or
341 ((ch >= 'A') and (ch <= 'Z')) or
342 ((ch >= 'a') and (ch <= 'z')) or
343 (ch >= #128) or
344 ((ch = '$') and (TOption.DollarIsId in mOptions)) or
345 ((ch = '.') and (TOption.DotIsId in mOptions));
346 end;
348 function TTextParser.isIdMidChar (ch: AnsiChar): Boolean; inline;
349 begin
350 result :=
351 ((ch >= '0') and (ch <= '9')) or
352 ((ch = '-') and (TOption.DashIsId in mOptions)) or
353 isIdStartChar(ch);
354 end;
357 procedure TTextParser.fillCharBuf ();
358 var
359 ch: AnsiChar;
360 begin
361 if (mEofHit) then begin mCharBuf[mCharBufPos] := #0; exit; end;
362 while (not mEofHit) and (mCharBufUsed < CharBufSize) do
363 begin
364 ch := loadChar();
365 mCharBuf[(mCharBufPos+mCharBufUsed) mod CharBufSize] := ch;
366 if (ch = #0) then begin mEofHit := true; break; end;
367 Inc(mCharBufUsed);
368 end;
369 end;
372 // never drains char buffer (except on "total EOF")
373 function TTextParser.popFrontChar (): AnsiChar; inline;
374 begin
375 if (mEofHit) and (mCharBufUsed = 0) then begin result := #0; exit; end;
376 assert(mCharBufUsed > 0);
377 result := mCharBuf[mCharBufPos];
378 mCharBufPos := (mCharBufPos+1) mod CharBufSize;
379 Dec(mCharBufUsed);
380 if (not mEofHit) and (mCharBufUsed = 0) then fillCharBuf();
381 end;
383 function TTextParser.peekCurChar (): AnsiChar; inline;
384 begin
385 if (mCharBufUsed = 0) and (not mEofHit) then fillCharBuf();
386 result := mCharBuf[mCharBufPos]; // it is safe, 'cause `fillCharBuf()` will put #0 on "total EOF"
387 end;
389 function TTextParser.peekNextChar (): AnsiChar; inline;
390 begin
391 if (mCharBufUsed < 2) and (not mEofHit) then fillCharBuf();
392 if (mCharBufUsed < 2) then result := #0 else result := mCharBuf[(mCharBufPos+1) mod CharBufSize];
393 end;
395 function TTextParser.peekChar (dest: Integer): AnsiChar; inline;
396 begin
397 if (dest < 0) or (dest >= CharBufSize) then error('internal text parser error');
398 if (mCharBufUsed < dest+1) then fillCharBuf();
399 if (mCharBufUsed < dest+1) then result := #0 else result := mCharBuf[(mCharBufPos+dest) mod CharBufSize];
400 end;
403 function TTextParser.skipChar (): Boolean;
404 var
405 ch: AnsiChar;
406 begin
407 ch := popFrontChar();
408 if (ch = #0) then begin result := false; exit; end;
409 result := true;
410 // CR?
411 case ch of
412 #10:
413 begin
414 mCol := 1;
415 Inc(mLine);
416 end;
417 #13:
418 begin
419 mCol := 1;
420 Inc(mLine);
421 if (mCharBufUsed > 0) and (mCharBuf[0] = #10) then
422 begin
423 if (popFrontChar() = #0) then result := false;
424 end;
425 end;
426 else
427 Inc(mCol);
428 end;
429 end;
432 function TTextParser.skipBlanks (): Boolean;
433 var
434 level: Integer;
435 begin
436 //writeln('line=', mLine, '; col=', mCol, '; char0=', Integer(peekChar(0)));
437 if (mLine = 1) and (mCol = 1) and
438 (peekChar(0) = #$EF) and
439 (peekChar(1) = #$BB) and
440 (peekChar(2) = #$BF) then
441 begin
442 skipChar();
443 skipChar();
444 skipChar();
445 end;
447 while (curChar <> #0) do
448 begin
449 if (curChar = '/') then
450 begin
451 // single-line comment
452 if (nextChar = '/') then
453 begin
454 //writeln('spos=(', mLine, ',', mCol, ')');
455 while (curChar <> #0) and (curChar <> #10) and (curChar <> #13) do skipChar();
456 skipChar(); // skip EOL
457 //writeln('{', curChar, '}');
458 //writeln('epos=(', mLine, ',', mCol, ')');
459 continue;
460 end;
461 // multline comment
462 if (nextChar = '*') then
463 begin
464 // skip comment start
465 skipChar();
466 skipChar();
467 while (curChar <> #0) do
468 begin
469 if (curChar = '*') and (nextChar = '/') then
470 begin
471 // skip comment end
472 skipChar();
473 skipChar();
474 break;
475 end;
476 skipChar();
477 end;
478 continue;
479 end;
480 // nesting multline comment
481 if (nextChar = '+') then
482 begin
483 // skip comment start
484 skipChar();
485 skipChar();
486 level := 1;
487 while (curChar <> #0) do
488 begin
489 if (curChar = '+') and (nextChar = '/') then
490 begin
491 // skip comment end
492 skipChar();
493 skipChar();
494 Dec(level);
495 if (level = 0) then break;
496 continue;
497 end;
498 if (curChar = '/') and (nextChar = '+') then
499 begin
500 // skip comment start
501 skipChar();
502 skipChar();
503 Inc(level);
504 continue;
505 end;
506 skipChar();
507 end;
508 continue;
509 end;
510 end
511 else if (curChar = '(') and (nextChar = '*') then
512 begin
513 // pascal comment; skip comment start
514 skipChar();
515 skipChar();
516 while (curChar <> #0) do
517 begin
518 if (curChar = '*') and (nextChar = ')') then
519 begin
520 // skip comment end
521 skipChar();
522 skipChar();
523 break;
524 end;
525 skipChar();
526 end;
527 continue;
528 end
529 else if (curChar = '{') and (TOption.PascalComments in mOptions) then
530 begin
531 // pascal comment; skip comment start
532 skipChar();
533 while (curChar <> #0) do
534 begin
535 if (curChar = '}') then
536 begin
537 // skip comment end
538 skipChar();
539 break;
540 end;
541 skipChar();
542 end;
543 continue;
544 end;
545 if (curChar > ' ') then break;
546 skipChar(); // skip blank
547 end;
548 result := (curChar <> #0);
549 end;
552 {$IFDEF XPARSER_DEBUG}
553 function TTextParser.skipToken (): Boolean;
554 begin
555 writeln('getting token...');
556 result := skipToken1();
557 writeln(' got token: ', mTokType, ' <', mTokStr, '> : <', mTokChar, '>');
558 end;
560 function TTextParser.skipToken1 (): Boolean;
561 {$ELSE}
562 function TTextParser.skipToken (): Boolean;
563 {$ENDIF}
564 procedure parseInt ();
565 var
566 neg: Boolean = false;
567 base: Integer = -1;
568 n: Integer;
569 begin
570 if (TOption.SignedNumbers in mOptions) then
571 begin
572 if (curChar = '+') or (curChar = '-') then
573 begin
574 neg := (curChar = '-');
575 skipChar();
576 if (curChar < '0') or (curChar > '9') then
577 begin
578 mTokType := TTDelim;
579 if (neg) then mTokChar := '-' else mTokChar := '+';
580 exit;
581 end;
582 end;
583 end;
584 if (curChar = '0') then
585 begin
586 case nextChar of
587 'b','B': base := 2;
588 'o','O': base := 8;
589 'd','D': base := 10;
590 'h','H': base := 16;
591 end;
592 if (base > 0) then
593 begin
594 // skip prefix
595 skipChar();
596 skipChar();
597 end;
598 end;
599 // default base
600 if (base < 0) then base := 10;
601 if (digitInBase(curChar, base) < 0) then error('invalid number');
602 mTokType := TTInt;
603 mTokInt := 0; // just in case
604 while (curChar <> #0) do
605 begin
606 if (curChar = '_') then
607 begin
608 skipChar();
609 if (curChar = #0) then break;
610 end;
611 n := digitInBase(curChar, base);
612 if (n < 0) then break;
613 n := mTokInt*10+n;
614 if (n < 0) or (n < mTokInt) then error('integer overflow');
615 mTokInt := n;
616 skipChar();
617 end;
618 // check for valid number end
619 if (curChar <> #0) then
620 begin
621 if (curChar = '.') then error('floating numbers aren''t supported yet');
622 if (isIdMidChar(curChar)) then error('invalid number');
623 end;
624 if neg then mTokInt := -mTokInt;
625 end;
627 procedure parseString ();
628 var
629 qch, ch: AnsiChar;
630 n: Integer;
631 begin
632 mTokType := TTStr;
633 mTokStr := ''; // just in case
634 qch := curChar;
635 skipChar(); // skip starting quote
636 while (curChar <> #0) do
637 begin
638 // escape
639 if (qch = '"') and (curChar = '\') then
640 begin
641 if (nextChar = #0) then error('unterminated string escape');
642 ch := nextChar;
643 // skip backslash and escape type
644 skipChar();
645 skipChar();
646 case ch of
647 't': mTokStr += #9;
648 'n': mTokStr += #10;
649 'r': mTokStr += #13;
650 'z': mTokStr += #0;
651 'e': mTokStr += #27;
652 'x', 'X': // hex escape
653 begin
654 n := digitInBase(curChar, 16);
655 if (n < 0) then error('invalid hexstr escape');
656 skipChar();
657 if (digitInBase(curChar, 16) > 0) then
658 begin
659 n := n*16+digitInBase(curChar, 16);
660 skipChar();
661 end;
662 mTokStr += AnsiChar(n);
663 end;
664 else mTokStr += ch;
665 end;
666 continue;
667 end;
668 // duplicate single quote (pascal style)
669 if (qch = '''') and (curChar = '''') and (nextChar = '''') then
670 begin
671 // skip both quotes
672 skipChar();
673 skipChar();
674 mTokStr += '''';
675 continue;
676 end;
677 if (curChar = qch) then
678 begin
679 skipChar(); // skip ending quote
680 break;
681 end;
682 mTokStr += curChar;
683 skipChar();
684 end;
685 end;
687 procedure parseId ();
688 begin
689 mTokType := TTId;
690 mTokStr := ''; // just in case
691 while (isIdMidChar(curChar)) do
692 begin
693 if (curChar = '.') and (nextChar = '.') then break; // dotdot is a token by itself
694 mTokStr += curChar;
695 skipChar();
696 end;
697 end;
699 var
700 xpos: Integer;
701 begin
702 mTokType := TTNone;
703 mTokStr := '';
704 mTokChar := #0;
705 mTokInt := 0;
707 if not skipBlanks() then
708 begin
709 result := false;
710 mTokType := TTEOF;
711 mTokLine := mLine;
712 mTokCol := mCol;
713 exit;
714 end;
716 mTokLine := mLine;
717 mTokCol := mCol;
719 result := true;
721 // number?
722 if (TOption.SignedNumbers in mOptions) and ((curChar = '+') or (curChar = '-')) then begin parseInt(); exit; end;
723 if (curChar >= '0') and (curChar <= '9') then begin parseInt(); exit; end;
725 // string?
726 if (curChar = '"') or (curChar = '''') or (curChar = '`') then begin parseString(); exit; end;
728 // html color?
729 if (curChar = '#') and (TOption.HtmlColors in mOptions) then
730 begin
731 if (digitInBase(peekChar(1), 16) >= 0) and (digitInBase(peekChar(2), 16) >= 0) and (digitInBase(peekChar(3), 16) >= 0) then
732 begin
733 if (digitInBase(peekChar(4), 16) >= 0) and (digitInBase(peekChar(5), 16) >= 0) and (digitInBase(peekChar(6), 16) >= 0) then xpos := 7 else xpos := 4;
734 if (not isIdMidChar(peekChar(xpos))) then
735 begin
736 mTokType := TTId;
737 mTokStr := '';
738 while (xpos > 0) do
739 begin
740 mTokStr += curChar;
741 skipChar();
742 Dec(xpos);
743 end;
744 exit;
745 end;
746 end;
747 end;
749 // identifier?
750 if (isIdStartChar(curChar)) then
751 begin
752 if (curChar = '.') and (nextChar = '.') then
753 begin
754 // nothing to do here, as dotdot is a token by itself
755 end
756 else
757 begin
758 parseId();
759 exit;
760 end;
761 end;
763 // known delimiters?
764 mTokChar := curChar;
765 mTokType := TTDelim;
766 skipChar();
767 if (curChar = '=') then
768 begin
769 case mTokChar of
770 '<': begin mTokType := TTLessEqu; mTokStr := '<='; skipChar(); exit; end;
771 '>': begin mTokType := TTGreatEqu; mTokStr := '>='; skipChar(); exit; end;
772 '!': begin mTokType := TTNotEqu; mTokStr := '!='; skipChar(); exit; end;
773 '=': begin mTokType := TTEqu; mTokStr := '=='; skipChar(); exit; end;
774 ':': begin mTokType := TTAss; mTokStr := ':='; skipChar(); exit; end;
775 end;
776 end
777 else if (mTokChar = curChar) then
778 begin
779 case mTokChar of
780 '<': begin mTokType := TTShl; mTokStr := '<<'; skipChar(); exit; end;
781 '>': begin mTokType := TTShr; mTokStr := '>>'; skipChar(); exit; end;
782 '&': begin mTokType := TTLogAnd; mTokStr := '&&'; skipChar(); exit; end;
783 '|': begin mTokType := TTLogOr; mTokStr := '||'; skipChar(); exit; end;
784 end;
785 end
786 else
787 begin
788 case mTokChar of
789 '<': if (curChar = '>') then begin mTokType := TTNotEqu; mTokStr := '<>'; skipChar(); exit; end;
790 '.': if (curChar = '.') then begin mTokType := TTDotDot; mTokStr := '..'; skipChar(); exit; end;
791 end;
792 end;
793 end;
796 function TTextParser.isEOF (): Boolean; inline; begin result := (mTokType = TTEOF); end;
797 function TTextParser.isId (): Boolean; inline; begin result := (mTokType = TTId); end;
798 function TTextParser.isInt (): Boolean; inline; begin result := (mTokType = TTInt); end;
799 function TTextParser.isStr (): Boolean; inline; begin result := (mTokType = TTStr); end;
800 function TTextParser.isDelim (): Boolean; inline; begin result := (mTokType = TTDelim); end;
801 function TTextParser.isIdOrStr (): Boolean; inline; begin result := (mTokType = TTId) or (mTokType = TTStr); end;
804 function TTextParser.expectId (): AnsiString;
805 begin
806 if (mTokType <> TTId) then error('identifier expected');
807 result := mTokStr;
808 skipToken();
809 end;
812 procedure TTextParser.expectId (const aid: AnsiString; caseSens: Boolean=true);
813 begin
814 if caseSens then
815 begin
816 if (mTokType <> TTId) or (mTokStr <> aid) then error('identifier '''+aid+''' expected');
817 end
818 else
819 begin
820 if (mTokType <> TTId) or (not strEquCI1251(mTokStr, aid)) then error('identifier '''+aid+''' expected');
821 end;
822 skipToken();
823 end;
826 function TTextParser.eatId (const aid: AnsiString; caseSens: Boolean=true): Boolean;
827 begin
828 if caseSens then
829 begin
830 result := (mTokType = TTId) and (mTokStr = aid);
831 end
832 else
833 begin
834 result := (mTokType = TTId) and strEquCI1251(mTokStr, aid);
835 end;
836 if result then skipToken();
837 end;
840 function TTextParser.eatIdOrStr (const aid: AnsiString; caseSens: Boolean=true): Boolean;
841 begin
842 if caseSens then
843 begin
844 result := (mTokType = TTId) and (mTokStr = aid);
845 if not result then result := (mTokType = TTStr) and (mTokStr = aid);
846 end
847 else
848 begin
849 result := (mTokType = TTId) and strEquCI1251(mTokStr, aid);
850 if not result then result := (mTokType = TTStr) and strEquCI1251(mTokStr, aid);
851 end;
852 if result then skipToken();
853 end;
856 function TTextParser.eatIdOrStrCI (const aid: AnsiString): Boolean; inline;
857 begin
858 result := eatIdOrStr(aid, false);
859 end;
862 function TTextParser.expectStr (allowEmpty: Boolean=false): AnsiString;
863 begin
864 if (mTokType <> TTStr) then error('string expected');
865 if (not allowEmpty) and (Length(mTokStr) = 0) then error('non-empty string expected');
866 result := mTokStr;
867 skipToken();
868 end;
871 function TTextParser.expectIdOrStr (allowEmpty: Boolean=false): AnsiString;
872 begin
873 case mTokType of
874 TTStr:
875 if (not allowEmpty) and (Length(mTokStr) = 0) then error('non-empty string expected');
876 TTId:
877 begin end;
878 else
879 error('string or identifier expected');
880 end;
881 result := mTokStr;
882 skipToken();
883 end;
886 function TTextParser.expectInt (): Integer;
887 begin
888 if (mTokType <> TTInt) then error('string expected');
889 result := mTokInt;
890 skipToken();
891 end;
894 procedure TTextParser.expectTT (ttype: Integer);
895 begin
896 if (mTokType <> ttype) then error('unexpected token');
897 skipToken();
898 end;
901 function TTextParser.eatTT (ttype: Integer): Boolean;
902 begin
903 result := (mTokType = ttype);
904 if result then skipToken();
905 end;
908 procedure TTextParser.expectDelim (const ch: AnsiChar);
909 begin
910 if (mTokType <> TTDelim) or (mTokChar <> ch) then errorfmt('delimiter ''%s'' expected', [ch]);
911 skipToken();
912 end;
915 function TTextParser.expectDelims (const ch: TAnsiCharSet): AnsiChar;
916 begin
917 if (mTokType <> TTDelim) then error('delimiter expected');
918 if not (mTokChar in ch) then error('delimiter expected');
919 result := mTokChar;
920 skipToken();
921 end;
924 function TTextParser.eatDelim (const ch: AnsiChar): Boolean;
925 begin
926 result := (mTokType = TTDelim) and (mTokChar = ch);
927 if result then skipToken();
928 end;
931 function TTextParser.isDelim (const ch: AnsiChar): Boolean; inline;
932 begin
933 result := (mTokType = TTDelim) and (mTokChar = ch);
934 end;
937 // ////////////////////////////////////////////////////////////////////////// //
938 constructor TFileTextParser.Create (const fname: AnsiString; aopts: TOptions=[TOption.SignedNumbers]);
939 begin
940 mBuffer := nil;
941 mFile := openDiskFileRO(fname);
942 mStreamOwned := true;
943 GetMem(mBuffer, BufSize);
944 mBufPos := 0;
945 mBufLen := mFile.Read(mBuffer^, BufSize);
946 if (mBufLen < 0) then error('TFileTextParser: read error');
947 inherited Create(aopts);
948 end;
951 constructor TFileTextParser.Create (st: TStream; astOwned: Boolean=true; aopts: TOptions=[TOption.SignedNumbers]);
952 begin
953 if (st = nil) then error('cannot create parser for nil stream');
954 mFile := st;
955 mStreamOwned := astOwned;
956 GetMem(mBuffer, BufSize);
957 mBufPos := 0;
958 mBufLen := mFile.Read(mBuffer^, BufSize);
959 if (mBufLen < 0) then error('TFileTextParser: read error');
960 inherited Create(aopts);
961 end;
964 destructor TFileTextParser.Destroy ();
965 begin
966 if (mBuffer <> nil) then FreeMem(mBuffer);
967 mBuffer := nil;
968 mBufPos := 0;
969 mBufLen := 0;
970 if (mStreamOwned) then FreeAndNil(mFile) else mFile := nil;
971 inherited;
972 end;
975 function TFileTextParser.loadChar (): AnsiChar;
976 begin
977 if (mBufLen = 0) then begin result := #0; exit; end;
978 if (mBufPos >= mBufLen) then
979 begin
980 mBufLen := mFile.Read(mBuffer^, BufSize);
981 if (mBufLen < 0) then error('TFileTextParser: read error');
982 if (mBufLen = 0) then begin result := #0; exit; end;
983 mBufPos := 0;
984 end;
985 assert(mBufPos < mBufLen);
986 result := mBuffer[mBufPos];
987 Inc(mBufPos);
988 if (result = #0) then result := ' ';
989 end;
992 // ////////////////////////////////////////////////////////////////////////// //
993 constructor TStrTextParser.Create (const astr: AnsiString; aopts: TOptions=[TOption.SignedNumbers]);
994 begin
995 mStr := astr;
996 mPos := 1;
997 inherited Create(aopts);
998 end;
1001 destructor TStrTextParser.Destroy ();
1002 begin
1003 mStr := '';
1004 inherited;
1005 end;
1008 function TStrTextParser.loadChar (): AnsiChar;
1009 begin
1010 result := #0;
1011 if (mPos > Length(mStr)) then exit;
1012 result := mStr[mPos];
1013 Inc(mPos);
1014 if (result = #0) then result := ' ';
1015 end;
1018 // ////////////////////////////////////////////////////////////////////////// //
1019 constructor TTextWriter.Create (); begin mIndent := 0; end;
1020 procedure TTextWriter.flush (); begin end;
1021 procedure TTextWriter.put (const s: AnsiString); overload; begin if (Length(s) > 0) then putBuf((@(s[1]))^, Length(s)); end;
1022 procedure TTextWriter.put (v: Byte); overload; begin put('%d', [v]); end;
1023 procedure TTextWriter.put (v: Integer); overload; begin put('%d', [v]); end;
1024 procedure TTextWriter.put (const fmt: AnsiString; args: array of const); overload; begin put(formatstrf(fmt, args)); end;
1025 procedure TTextWriter.putIndent (); var f: Integer; begin for f := 1 to mIndent do put(' '); end;
1026 procedure TTextWriter.indent (); begin Inc(mIndent, 2); end;
1027 procedure TTextWriter.unindent (); begin Dec(mIndent, 2); end;
1030 // ////////////////////////////////////////////////////////////////////////// //
1031 constructor TFileTextWriter.Create (const fname: AnsiString);
1032 begin
1033 mFile := createDiskFile(fname);
1034 mStreamOwned := true;
1035 mBufUsed := 0;
1036 GetMem(mBuffer, BufSize);
1037 assert(mBuffer <> nil);
1038 inherited Create();
1039 end;
1042 constructor TFileTextWriter.Create (ast: TStream; astOwned: Boolean=true);
1043 begin
1044 if (ast = nil) then raise Exception.Create('cannot write to nil stream');
1045 mFile := ast;
1046 mStreamOwned := astOwned;
1047 mBufUsed := 0;
1048 GetMem(mBuffer, BufSize);
1049 assert(mBuffer <> nil);
1050 end;
1053 destructor TFileTextWriter.Destroy ();
1054 begin
1055 flush();
1056 if (mBuffer <> nil) then FreeMem(mBuffer);
1057 mBufUsed := 0;
1058 mBuffer := nil;
1059 if (mStreamOwned) then mFile.Free();
1060 mFile := nil;
1061 inherited;
1062 end;
1065 procedure TFileTextWriter.flush ();
1066 begin
1067 if (mFile <> nil) and (mBufUsed > 0) then
1068 begin
1069 mFile.WriteBuffer(mBuffer^, mBufUsed);
1070 end;
1071 mBufUsed := 0;
1072 end;
1075 procedure TFileTextWriter.putBuf (constref buf; len: SizeUInt);
1076 var
1077 pc: PChar;
1078 left: Integer;
1079 begin
1080 if (len = 0) then exit;
1081 pc := @buf;
1082 while (len > 0) do
1083 begin
1084 left := BufSize-mBufUsed;
1085 if (left = 0) then
1086 begin
1087 flush();
1088 left := BufSize-mBufUsed;
1089 assert(left > 0);
1090 end;
1091 if (left > len) then left := Integer(len);
1092 Move(pc^, (mBuffer+mBufUsed)^, left);
1093 Inc(mBufUsed, left);
1094 pc += left;
1095 len -= left;
1096 end;
1097 end;
1100 // ////////////////////////////////////////////////////////////////////////// //
1101 constructor TStrTextWriter.Create ();
1102 begin
1103 mStr := '';
1104 end;
1107 destructor TStrTextWriter.Destroy ();
1108 begin
1109 mStr := '';
1110 inherited;
1111 end;
1114 procedure TStrTextWriter.putBuf (constref buf; len: SizeUInt);
1115 var
1116 st: AnsiString = '';
1117 begin
1118 if (len > 0) then
1119 begin
1120 SetLength(st, Integer(len));
1121 Move(buf, PChar(st)^, Integer(len));
1122 mStr += st;
1123 st := '';
1124 end;
1125 end;
1128 end.