1 (* Copyright (C) DooM 2D:Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
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.
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/>.
16 {$INCLUDE a_modes.inc}
17 {.$DEFINE XPARSER_DEBUG}
26 // ////////////////////////////////////////////////////////////////////////// //
28 TTextParser
= class(TPoolObject
)
35 //TTFloat = 3; // not yet
37 TTDelim
= 5; // one-char delimiters
42 TTGreatEqu
= 14; // >=
44 TTEqu
= 16; // == or <>
53 SignedNumbers
, // allow signed numbers; otherwise sign will be TTDelim
54 DollarIsId
, // allow dollar in identifiers; otherwise dollar will be TTDelim
55 DotIsId
, // allow dot in identifiers; otherwise dot will be TTDelim
56 PascalComments
// allow `{}` pascal comments
58 TOptions
= set of TOption
;
62 TAnsiCharSet
= set of AnsiChar
;
66 mCurChar
, mNextChar
: AnsiChar
;
70 mTokLine
, mTokCol
: Integer; // token start
72 mTokStr
: AnsiString
; // string or identifier
73 mTokChar
: AnsiChar
; // for delimiters
77 procedure warmup (); // called in constructor to warm up the system
78 procedure loadNextChar (); virtual; abstract; // loads next char into mNextChar; #0 means 'eof'
81 constructor Create (aopts
: TOptions
=[TOption
.SignedNumbers
]);
82 destructor Destroy (); override;
84 function isEOF (): Boolean; inline;
86 function skipChar (): Boolean; // returns `false` on eof
88 function skipBlanks (): Boolean; // ...and comments; returns `false` on eof
90 function skipToken (): Boolean; // returns `false` on eof
91 {$IFDEF XPARSER_DEBUG}
92 function skipToken1 (): Boolean;
95 function expectId (): AnsiString
;
96 procedure expectId (const aid
: AnsiString
);
97 function eatId (const aid
: AnsiString
): Boolean;
99 function expectStr (allowEmpty
: Boolean=false): AnsiString
;
100 function expectInt (): Integer;
102 function expectStrOrId (allowEmpty
: Boolean=false): AnsiString
;
104 procedure expectTT (ttype
: Integer);
105 function eatTT (ttype
: Integer): Boolean;
107 procedure expectDelim (const ch
: AnsiChar
);
108 function expectDelims (const ch
: TAnsiCharSet
): AnsiChar
;
109 function eatDelim (const ch
: AnsiChar
): Boolean;
111 function isDelim (const ch
: AnsiChar
): Boolean; inline;
114 property options
: TOptions read mOptions write mOptions
;
117 property col
: Integer read mCol
;
118 property line
: Integer read mLine
;
120 property curChar
: AnsiChar read mCurChar
;
121 property nextChar
: AnsiChar read mNextChar
;
124 property tokCol
: Integer read mTokCol
;
125 property tokLine
: Integer read mTokLine
;
127 property tokType
: Integer read mTokType
; // see TTXXX constants
128 property tokStr
: AnsiString read mTokStr
; // string or identifier
129 property tokChar
: AnsiChar read mTokChar
; // for delimiters
130 property tokInt
: Integer read mTokInt
;
134 // ////////////////////////////////////////////////////////////////////////// //
136 TFileTextParser
= class(TTextParser
)
138 const BufSize
= 16384;
142 mStreamOwned
: Boolean;
148 procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
151 constructor Create (const fname
: AnsiString
; aopts
: TOptions
=[TOption
.SignedNumbers
]);
152 constructor Create (st
: TStream
; astOwned
: Boolean=true; aopts
: TOptions
=[TOption
.SignedNumbers
]);
153 destructor Destroy (); override;
156 TStrTextParser
= class(TTextParser
)
162 procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
165 constructor Create (const astr
: AnsiString
; aopts
: TOptions
=[TOption
.SignedNumbers
]);
166 destructor Destroy (); override;
170 // ////////////////////////////////////////////////////////////////////////// //
177 procedure putBuf (constref buf
; len
: SizeUInt
); virtual; abstract;
180 constructor Create ();
182 procedure flush (); virtual;
184 procedure put (const s
: AnsiString
); overload
;
185 procedure put (v
: Byte); overload
;
186 procedure put (v
: Integer); overload
;
187 procedure put (const fmt
: AnsiString
; args
: array of const); overload
;
188 procedure putIndent ();
190 procedure unindent ();
193 property curIndent
: Integer read mIndent
;
197 // ////////////////////////////////////////////////////////////////////////// //
199 TFileTextWriter
= class(TTextWriter
)
201 const BufSize
= 16384;
205 mStreamOwned
: Boolean;
210 procedure putBuf (constref buf
; len
: SizeUInt
); override;
213 constructor Create (const fname
: AnsiString
);
214 constructor Create (ast
: TStream
; astOwned
: Boolean=true); // will own the stream by default
215 destructor Destroy (); override;
217 procedure flush (); override;
220 TStrTextWriter
= class(TTextWriter
)
225 procedure putBuf (constref buf
; len
: SizeUInt
); override;
228 constructor Create ();
229 destructor Destroy (); override;
231 property str
: AnsiString read mStr
;
241 // ////////////////////////////////////////////////////////////////////////// //
242 constructor TTextParser
.Create (aopts
: TOptions
=[TOption
.SignedNumbers
]);
258 destructor TTextParser
.Destroy ();
264 function TTextParser
.isEOF (): Boolean; inline; begin result
:= (mCurChar
= #0); end;
267 procedure TTextParser
.warmup ();
271 mCurChar
:= mNextChar
;
272 if (mNextChar
<> #0) then loadNextChar();
276 function TTextParser
.skipChar (): Boolean;
278 if (mCurChar
= #0) then begin result
:= false; exit
; end;
279 if (mCurChar
= #10) then begin mCol
:= 1; Inc(mLine
); end else Inc(mCol
);
280 mCurChar
:= mNextChar
;
281 if (mCurChar
= #0) then begin result
:= false; exit
; end;
284 if (mCurChar
= #13) then
286 if (mNextChar
= #10) then loadNextChar();
293 function TTextParser
.skipBlanks (): Boolean;
299 if (curChar
= '/') then
301 // single-line comment
302 if (nextChar
= '/') then
304 while not isEOF
and (curChar
<> #10) do skipChar();
305 skipChar(); // skip EOL
309 if (nextChar
= '*') then
311 // skip comment start
316 if (curChar
= '*') and (nextChar
= '/') then
327 // nesting multline comment
328 if (nextChar
= '+') then
330 // skip comment start
336 if (curChar
= '+') and (nextChar
= '/') then
342 if (level
= 0) then break
;
345 if (curChar
= '/') and (nextChar
= '+') then
347 // skip comment start
358 else if (curChar
= '(') and (nextChar
= '*') then
360 // pascal comment; skip comment start
365 if (curChar
= '*') and (nextChar
= ')') then
376 else if (curChar
= '{') and (TOption
.PascalComments
in mOptions
) then
378 // pascal comment; skip comment start
382 if (curChar
= '}') then
392 if (curChar
> ' ') then break
;
393 skipChar(); // skip blank
399 {$IFDEF XPARSER_DEBUG}
400 function TTextParser
.skipToken (): Boolean;
402 writeln('getting token...');
403 result
:= skipToken1();
404 writeln(' got token: ', mTokType
, ' <', mTokStr
, '> : <', mTokChar
, '>');
407 function TTextParser
.skipToken1 (): Boolean;
409 function TTextParser
.skipToken (): Boolean;
411 procedure parseInt ();
413 neg
: Boolean = false;
417 if (TOption
.SignedNumbers
in mOptions
) then
419 if (curChar
= '+') or (curChar
= '-') then
421 neg
:= (curChar
= '-');
423 if (curChar
< '0') or (curChar
> '9') then
426 if (neg
) then mTokChar
:= '-' else mTokChar
:= '+';
431 if (curChar
= '0') then
447 if (base
< 0) then base
:= 10;
448 if (digitInBase(curChar
, base
) < 0) then raise Exception
.Create('invalid number');
450 mTokInt
:= 0; // just in case
453 n
:= digitInBase(curChar
, base
);
454 if (n
< 0) then break
;
456 if (n
< 0) or (n
< mTokInt
) then raise Exception
.Create('integer overflow');
460 // check for valid number end
463 if (curChar
= '.') then raise Exception
.Create('floating numbers aren''t supported yet');
464 if (curChar
= '_') or ((curChar
>= 'A') and (curChar
<= 'Z')) or ((curChar
>= 'a') and (curChar
<= 'z')) or (curChar
>= #128) then
466 raise Exception
.Create('invalid number');
469 if neg
then mTokInt
:= -mTokInt
;
472 procedure parseString ();
478 mTokStr
:= ''; // just in case
480 skipChar(); // skip starting quote
484 if (qch
= '"') and (curChar
= '\') then
486 if (nextChar
= #0) then raise Exception
.Create('unterminated string escape');
488 // skip backslash and escape type
497 'x', 'X': // hex escape
499 n
:= digitInBase(curChar
, 16);
500 if (n
< 0) then raise Exception
.Create('invalid hexstr escape');
502 if (digitInBase(curChar
, 16) > 0) then
504 n
:= n
*16+digitInBase(curChar
, 16);
507 mTokStr
+= AnsiChar(n
);
513 // duplicate single quote (pascal style)
514 if (qch
= '''') and (curChar
= '''') and (nextChar
= '''') then
522 if (curChar
= qch
) then
524 skipChar(); // skip ending quote
532 procedure parseId ();
535 mTokStr
:= ''; // just in case
536 while (curChar
= '_') or ((curChar
>= '0') and (curChar
<= '9')) or
537 ((curChar
>= 'A') and (curChar
<= 'Z')) or
538 ((curChar
>= 'a') and (curChar
<= 'z')) or
540 ((TOption
.DollarIsId
in mOptions
) and (curChar
= '$')) or
541 ((TOption
.DotIsId
in mOptions
) and (curChar
= '.') and (nextChar
<> '.')) do
554 if not skipBlanks() then
568 if (TOption
.SignedNumbers
in mOptions
) and ((curChar
= '+') or (curChar
= '-')) then begin parseInt(); exit
; end;
569 if (curChar
>= '0') and (curChar
<= '9') then begin parseInt(); exit
; end;
572 if (curChar
= '"') or (curChar
= '''') then begin parseString(); exit
; end;
575 if (curChar
= '_') or ((curChar
>= 'A') and (curChar
<= 'Z')) or ((curChar
>= 'a') and (curChar
<= 'z')) or (curChar
>= #128) then begin parseId(); exit
; end;
576 if (TOption
.DollarIsId
in mOptions
) and (curChar
= '$') then begin parseId(); exit
; end;
577 if (TOption
.DotIsId
in mOptions
) and (curChar
= '.') and (nextChar
<> '.') then begin parseId(); exit
; end;
583 if (curChar
= '=') then
586 '<': begin mTokType
:= TTLessEqu
; mTokStr
:= '<='; skipChar(); exit
; end;
587 '>': begin mTokType
:= TTGreatEqu
; mTokStr
:= '>='; skipChar(); exit
; end;
588 '!': begin mTokType
:= TTNotEqu
; mTokStr
:= '!='; skipChar(); exit
; end;
589 '=': begin mTokType
:= TTEqu
; mTokStr
:= '=='; skipChar(); exit
; end;
590 ':': begin mTokType
:= TTAss
; mTokStr
:= ':='; skipChar(); exit
; end;
593 else if (mTokChar
= curChar
) then
596 '<': begin mTokType
:= TTShl
; mTokStr
:= '<<'; skipChar(); exit
; end;
597 '>': begin mTokType
:= TTShr
; mTokStr
:= '>>'; skipChar(); exit
; end;
598 '&': begin mTokType
:= TTLogAnd
; mTokStr
:= '&&'; skipChar(); exit
; end;
599 '|': begin mTokType
:= TTLogOr
; mTokStr
:= '||'; skipChar(); exit
; end;
605 '<': if (curChar
= '>') then begin mTokType
:= TTNotEqu
; mTokStr
:= '<>'; skipChar(); exit
; end;
606 '.': if (curChar
= '.') then begin mTokType
:= TTDotDot
; mTokStr
:= '..'; skipChar(); exit
; end;
612 function TTextParser
.expectId (): AnsiString
;
614 if (mTokType
<> TTId
) then raise Exception
.Create('identifier expected');
620 procedure TTextParser
.expectId (const aid
: AnsiString
);
622 if (mTokType
<> TTId
) or (mTokStr
<> aid
) then raise Exception
.Create('identifier '''+aid
+''' expected');
627 function TTextParser
.eatId (const aid
: AnsiString
): Boolean;
629 result
:= (mTokType
= TTId
) and (mTokStr
= aid
);
630 if result
then skipToken();
634 function TTextParser
.expectStr (allowEmpty
: Boolean=false): AnsiString
;
636 if (mTokType
<> TTStr
) then raise Exception
.Create('string expected');
637 if (not allowEmpty
) and (Length(mTokStr
) = 0) then raise Exception
.Create('non-empty string expected');
643 function TTextParser
.expectStrOrId (allowEmpty
: Boolean=false): AnsiString
;
647 if (not allowEmpty
) and (Length(mTokStr
) = 0) then raise Exception
.Create('non-empty string expected');
651 raise Exception
.Create('string or identifier expected');
658 function TTextParser
.expectInt (): Integer;
660 if (mTokType
<> TTInt
) then raise Exception
.Create('string expected');
666 procedure TTextParser
.expectTT (ttype
: Integer);
668 if (mTokType
<> ttype
) then raise Exception
.Create('unexpected token');
673 function TTextParser
.eatTT (ttype
: Integer): Boolean;
675 result
:= (mTokType
= ttype
);
676 if result
then skipToken();
680 procedure TTextParser
.expectDelim (const ch
: AnsiChar
);
682 if (mTokType
<> TTDelim
) or (mTokChar
<> ch
) then raise Exception
.CreateFmt('delimiter ''%s'' expected', [ch
]);
687 function TTextParser
.expectDelims (const ch
: TAnsiCharSet
): AnsiChar
;
689 if (mTokType
<> TTDelim
) then raise Exception
.Create('delimiter expected');
690 if not (mTokChar
in ch
) then raise Exception
.Create('delimiter expected');
696 function TTextParser
.eatDelim (const ch
: AnsiChar
): Boolean;
698 result
:= (mTokType
= TTDelim
) and (mTokChar
= ch
);
699 if result
then skipToken();
703 function TTextParser
.isDelim (const ch
: AnsiChar
): Boolean; inline;
705 result
:= (mTokType
= TTDelim
) and (mTokChar
= ch
);
709 // ////////////////////////////////////////////////////////////////////////// //
710 constructor TFileTextParser
.Create (const fname
: AnsiString
; aopts
: TOptions
=[TOption
.SignedNumbers
]);
713 mFile
:= openDiskFileRO(fname
);
714 mStreamOwned
:= true;
715 GetMem(mBuffer
, BufSize
);
717 mBufLen
:= mFile
.Read(mBuffer
^, BufSize
);
718 if (mBufLen
< 0) then raise Exception
.Create('TFileTextParser: read error');
719 inherited Create(aopts
);
723 constructor TFileTextParser
.Create (st
: TStream
; astOwned
: Boolean=true; aopts
: TOptions
=[TOption
.SignedNumbers
]);
725 if (st
= nil) then raise Exception
.Create('cannot create parser for nil stream');
727 mStreamOwned
:= astOwned
;
728 GetMem(mBuffer
, BufSize
);
730 mBufLen
:= mFile
.Read(mBuffer
^, BufSize
);
731 if (mBufLen
< 0) then raise Exception
.Create('TFileTextParser: read error');
732 inherited Create(aopts
);
736 destructor TFileTextParser
.Destroy ();
738 if (mBuffer
<> nil) then FreeMem(mBuffer
);
742 if mStreamOwned
then mFile
.Free();
748 procedure TFileTextParser
.loadNextChar ();
750 if (mBufLen
= 0) then begin mNextChar
:= #0; exit
; end;
751 if (mBufPos
>= mBufLen
) then
753 mBufLen
:= mFile
.Read(mBuffer
^, BufSize
);
754 if (mBufLen
< 0) then raise Exception
.Create('TFileTextParser: read error');
755 if (mBufLen
= 0) then begin mNextChar
:= #0; exit
; end;
758 assert(mBufPos
< mBufLen
);
759 mNextChar
:= mBuffer
[mBufPos
];
761 if (mNextChar
= #0) then mNextChar
:= ' ';
765 // ////////////////////////////////////////////////////////////////////////// //
766 constructor TStrTextParser
.Create (const astr
: AnsiString
; aopts
: TOptions
=[TOption
.SignedNumbers
]);
770 inherited Create(aopts
);
774 destructor TStrTextParser
.Destroy ();
781 procedure TStrTextParser
.loadNextChar ();
784 if (mPos
> Length(mStr
)) then exit
;
785 mNextChar
:= mStr
[mPos
]; Inc(mPos
);
786 if (mNextChar
= #0) then mNextChar
:= ' ';
790 // ////////////////////////////////////////////////////////////////////////// //
791 constructor TTextWriter
.Create (); begin mIndent
:= 0; end;
792 procedure TTextWriter
.flush (); begin end;
793 procedure TTextWriter
.put (const s
: AnsiString
); overload
; begin if (Length(s
) > 0) then putBuf((@(s
[1]))^, Length(s
)); end;
794 procedure TTextWriter
.put (v
: Byte); overload
; begin put('%d', [v
]); end;
795 procedure TTextWriter
.put (v
: Integer); overload
; begin put('%d', [v
]); end;
796 procedure TTextWriter
.put (const fmt
: AnsiString
; args
: array of const); overload
; begin put(formatstrf(fmt
, args
)); end;
797 procedure TTextWriter
.putIndent (); var f
: Integer; begin for f
:= 1 to mIndent
do put(' '); end;
798 procedure TTextWriter
.indent (); begin Inc(mIndent
, 2); end;
799 procedure TTextWriter
.unindent (); begin Dec(mIndent
, 2); end;
802 // ////////////////////////////////////////////////////////////////////////// //
803 constructor TFileTextWriter
.Create (const fname
: AnsiString
);
805 mFile
:= createDiskFile(fname
);
806 mStreamOwned
:= true;
808 GetMem(mBuffer
, BufSize
);
809 assert(mBuffer
<> nil);
814 constructor TFileTextWriter
.Create (ast
: TStream
; astOwned
: Boolean=true);
816 if (ast
= nil) then raise Exception
.Create('cannot write to nil stream');
818 mStreamOwned
:= astOwned
;
820 GetMem(mBuffer
, BufSize
);
821 assert(mBuffer
<> nil);
825 destructor TFileTextWriter
.Destroy ();
828 if (mBuffer
<> nil) then FreeMem(mBuffer
);
831 if (mStreamOwned
) then mFile
.Free();
837 procedure TFileTextWriter
.flush ();
839 if (mFile
<> nil) and (mBufUsed
> 0) then
841 mFile
.WriteBuffer(mBuffer
^, mBufUsed
);
847 procedure TFileTextWriter
.putBuf (constref buf
; len
: SizeUInt
);
852 if (len
= 0) then exit
;
856 left
:= BufSize
-mBufUsed
;
860 left
:= BufSize
-mBufUsed
;
863 if (left
> len
) then left
:= Integer(len
);
864 Move(pc
^, (mBuffer
+mBufUsed
)^, left
);
872 // ////////////////////////////////////////////////////////////////////////// //
873 constructor TStrTextWriter
.Create ();
879 destructor TStrTextWriter
.Destroy ();
886 procedure TStrTextWriter
.putBuf (constref buf
; len
: SizeUInt
);
892 SetLength(st
, Integer(len
));
893 Move(buf
, PChar(st
)^, Integer(len
));