From: Ketmar Dark Date: Sun, 17 Sep 2017 03:15:50 +0000 (+0300) Subject: parser and parser-dependent modules cosmetix X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=eced4802da504c41b09ae360c602ee2afb94d91b;p=d2df-sdl.git parser and parser-dependent modules cosmetix --- diff --git a/src/game/g_map.pas b/src/game/g_map.pas index bd94957..cf60d78 100644 --- a/src/game/g_map.pas +++ b/src/game/g_map.pas @@ -257,6 +257,21 @@ const FLAG_SIGNATURE = $47414C46; // 'FLAG' +// ////////////////////////////////////////////////////////////////////////// // +procedure mapWarningCB (const msg: AnsiString; line, col: Integer); +begin + if (line > 0) then + begin + e_LogWritefln('parse error at (%s,%s): %s', [line, col, msg], TMsgType.Warning); + end + else + begin + e_LogWritefln('parse error: %s', [msg], TMsgType.Warning); + end; +end; + + +// ////////////////////////////////////////////////////////////////////////// // var panByGUID: array of TPanel = nil; @@ -3253,4 +3268,6 @@ begin end; +begin + DynWarningCB := mapWarningCB; end. diff --git a/src/shared/exoma.pas b/src/shared/exoma.pas index ec9bbf8..1931dbb 100644 --- a/src/shared/exoma.pas +++ b/src/shared/exoma.pas @@ -931,7 +931,7 @@ begin try while true do begin - while pr.eatTT(pr.TTSemi) do begin end; + while pr.eatDelim(';') do begin end; if (pr.tokType = pr.TTEOF) then break; e := parse(clist, pr, true); if (e = nil) then break; @@ -940,7 +940,7 @@ begin if (pr.tokType = pr.TTEOF) then break; //writeln('tt=', pr.tokType, ' <', pr.tokStr, '>'); //writeln(r.toString()); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); end; result := r; r := nil; @@ -1130,7 +1130,7 @@ class function TExprBase.parse (clist: TExprConstList; pr: TTextParser; allowAss e := doLogOr(); if neg then e := TUnExprNeg.Create(e); if allowAssign and pr.eatDelim('=') then e := TBinAssign.Create(e, expr()); - if not pr.eatTT(pr.TTComma) then + if not pr.eatDelim(',') then begin if (result = nil) then result := e else list.append(e); break; @@ -1162,7 +1162,7 @@ class function TExprBase.parse (clist: TExprConstList; pr: TTextParser; allowAss c.mCond := result; try c.mTrue := expr(); - pr.expectTT(pr.TTColon); + pr.expectDelim(':'); c.mFalse := expr(); result := c; except @@ -1172,16 +1172,16 @@ class function TExprBase.parse (clist: TExprConstList; pr: TTextParser; allowAss end; var - oas: Boolean; + oas: TTextParser.TOptions; begin if (pr = nil) or (pr.tokType = pr.TTEOF) then begin result := nil; exit; end; - oas := pr.allowSignedNumbers; + oas := pr.options; try - pr.allowSignedNumbers := false; + pr.options := pr.options-[pr.TOption.SignedNumbers]; try result := expr(); finally - pr.allowSignedNumbers := oas; + pr.options := oas; end; except on e: TExomaException do diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index 8b6534c..a9d3bbe 100644 --- a/src/shared/xdynrec.pas +++ b/src/shared/xdynrec.pas @@ -489,12 +489,15 @@ type procedure xdynDumpProfiles (); {$ENDIF} +var + DynWarningCB: procedure (const msg: AnsiString; line, col: Integer) = nil; implementation +{$IF DEFINED(D2D_DYNREC_PROFILER)} uses - e_log - {$IF DEFINED(D2D_DYNREC_PROFILER)},xprofiler{$ENDIF}; + xprofiler; +{$ENDIF} // ////////////////////////////////////////////////////////////////////////// // @@ -1178,7 +1181,7 @@ begin // field name fldname := pr.expectStrOrId(); - while (pr.tokType <> pr.TTSemi) do + while (not pr.isDelim(';')) do begin if pr.eatId('type') then begin @@ -1311,7 +1314,7 @@ begin lebs := TDynField.TEBS.TRec; end; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); // create field mName := fldname; @@ -1918,7 +1921,7 @@ var edim: AnsiChar; begin if (pr.tokType = pr.TTEOF) then raise TDynParseException.Create(pr, 'field value expected'); - if (pr.tokType = pr.TTSemi) then raise TDynParseException.Create(pr, 'extra semicolon'); + if (pr.isDelim(';')) then raise TDynParseException.Create(pr, 'extra semicolon'); // if this field should contain struct, convert type and parse struct case mEBS of TEBS.TNone: begin end; @@ -1927,12 +1930,11 @@ begin // ugly hack. sorry. if (mType = TType.TTrigData) then begin - pr.expectTT(pr.TTBegin); - if (pr.tokType = pr.TTEnd) then + pr.expectDelim('{'); + if (pr.eatDelim('}')) then begin // '{}' mRecRef := nil; - pr.expectTT(pr.TTEnd); end else begin @@ -1950,7 +1952,7 @@ begin mRecRef := rc; end; mDefined := true; - pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records + pr.eatDelim(';'); // hack: allow (but don't require) semicolon after inline records exit; end; // other record types @@ -1975,10 +1977,10 @@ begin pr.expectId(); end; mDefined := true; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end - else if (pr.tokType = pr.TTBegin) then + else if (pr.isDelim('{')) then begin //rec := mOwner.mOwner.recType[mEBSTypeName]; // find in mapdef rec := nil; @@ -1993,10 +1995,10 @@ begin begin raise TDynParseException.CreateFmt(pr, 'duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mTypeName]); end; - pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records + pr.eatDelim(';'); // hack: allow (but don't require) semicolon after inline records exit; end; - pr.expectTT(pr.TTBegin); + pr.expectDelim('{'); end; TEBS.TEnum: begin @@ -2010,7 +2012,7 @@ begin mSVal := tk; //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal); mDefined := true; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TEBS.TBitSet: @@ -2031,7 +2033,7 @@ begin pr.skipToken(); // plus or pipe end; mDefined := true; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; else raise TDynParseException.Create(pr, 'ketmar forgot to handle some EBS type'); @@ -2044,7 +2046,7 @@ begin else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then mIVal := 0 else raise TDynParseException.CreateFmt(pr, 'invalid bool value for field ''%s''', [mName]); mDefined := true; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TChar: @@ -2064,50 +2066,50 @@ begin if (Length(mSVal) > mMaxDim) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]); end; mDefined := true; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TByte: begin parseInt(-128, 127); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TUByte: begin parseInt(0, 255); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TShort: begin parseInt(-32768, 32768); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TUShort: begin parseInt(0, 65535); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TInt: begin parseInt(Integer($80000000), $7fffffff); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TUInt: begin parseInt(0, $7fffffff); //FIXME - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TString: begin mSVal := pr.expectStr(true); mDefined := true; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TPoint, @@ -2126,7 +2128,7 @@ begin end; mDefined := true; pr.expectDelim(edim); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TColor: @@ -2149,7 +2151,7 @@ begin end; mDefined := true; pr.expectDelim(edim); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TList: @@ -2591,7 +2593,7 @@ begin begin while true do begin - while pr.eatTT(pr.TTComma) do begin end; + while (pr.eatDelim(',')) do begin end; if pr.eatDelim(')') then break; tdn := pr.expectId(); if isForTrig[tdn] then raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s'' trigtype ''%s''', [mTypeName, tdn]); @@ -2610,7 +2612,7 @@ begin else begin mTypeName := pr.expectStrOrId(); - while (pr.tokType <> pr.TTBegin) do + while (not pr.isDelim('{')) do begin if pr.eatId('header') then begin mHeader := true; continue; end; if pr.eatId('size') then @@ -2643,9 +2645,9 @@ begin end; end; - pr.expectTT(pr.TTBegin); + pr.expectDelim('{'); // load fields - while (pr.tokType <> pr.TTEnd) do + while (not pr.isDelim('}')) do begin fld := TDynField.Create(pr); // append @@ -2657,7 +2659,7 @@ begin end; // done with field end; - pr.expectTT(pr.TTEnd); + pr.expectDelim('}'); end; @@ -2732,7 +2734,10 @@ var rt := findRecordByTypeId(fld.mEBSTypeName, fld.mRecRefId); if (rt = nil) then begin - e_LogWritefln('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mTypeName, rec.mId, fld.mEBSTypeName, fld.mRecRefId], TMsgType.Warning); + if assigned(DynWarningCB) then + begin + DynWarningCB(formatstrf('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mTypeName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]), -1, -1); + end; //raise TDynRecException.CreateFmt('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]); end; //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')'); @@ -3118,8 +3123,8 @@ begin end; //writeln('parsing record <', mName, '>'); - if not beginEaten then pr.expectTT(pr.TTBegin); - while (pr.tokType <> pr.TTEnd) do + if not beginEaten then pr.expectDelim('{'); + while (not pr.isDelim('}')) do begin if (pr.tokType <> pr.TTId) then raise TDynParseException.Create(pr, 'identifier expected'); //writeln('<', mName, '.', pr.tokStr, '>'); @@ -3169,7 +3174,7 @@ begin // something is wrong raise TDynParseException.CreateFmt(pr, 'unknown field ''%s'' in record ''%s''', [pr.tokStr, mTypeName]); end; - pr.expectTT(pr.TTEnd); + pr.expectDelim('}'); if mHeader then begin @@ -3308,7 +3313,7 @@ begin mTypeName := pr.expectId(); mMaxVal := Integer($80000000); if mIsEnum then cv := 0 else cv := 1; - while (pr.tokType <> pr.TTBegin) do + while (not pr.isDelim('{')) do begin if pr.eatId('tip') then begin @@ -3324,8 +3329,8 @@ begin end; break; end; - pr.expectTT(pr.TTBegin); - while (pr.tokType <> pr.TTEnd) do + pr.expectDelim('{'); + while (not pr.isDelim('}')) do begin idname := pr.expectId(); for f := 0 to High(mIds) do @@ -3370,11 +3375,11 @@ begin if mIsEnum then Inc(cv) else cv := cv shl 1; end; end; - if (pr.tokType = pr.TTEnd) then break; - pr.expectTT(pr.TTComma); - while pr.eatTT(pr.TTComma) do begin end; + if (pr.isDelim('}')) then break; + pr.expectDelim(','); + while (pr.eatDelim(',')) do begin end; end; - pr.expectTT(pr.TTEnd); + pr.expectDelim('}'); // add max field if (Length(mMaxName) > 0) then begin diff --git a/src/shared/xparser.pas b/src/shared/xparser.pas index eb56686..b704c4b 100644 --- a/src/shared/xparser.pas +++ b/src/shared/xparser.pas @@ -33,25 +33,37 @@ type TTInt = 2; //TTFloat = 3; // not yet TTStr = 4; // string - TTComma = 5; // ',' - TTColon = 6; // ':' - TTSemi = 7; // ';' - TTBegin = 8; // left curly - TTEnd = 9; // right curly - TTDelim = 10; // other delimiters + TTDelim = 5; // one-char delimiters // TTLogAnd = 11; // && TTLogOr = 12; // || TTLessEqu = 13; // <= TTGreatEqu = 14; // >= TTNotEqu = 15; // != - TTEqu = 16; // == + TTEqu = 16; // == or <> + TTAss = 17; // := + TTShl = 18; // << + TTShr = 19; // >> + TTDotDot = 19; // .. + + public + type + TOption = ( + SignedNumbers, // allow signed numbers; otherwise sign will be TTDelim + DollarIsId, // allow dollar in identifiers; otherwise dollar will be TTDelim + DotIsId // allow dot in identifiers; otherwise dot will be TTDelim + ); + TOptions = set of TOption; + + private + type + TAnsiCharSet = set of AnsiChar; private mLine, mCol: Integer; mCurChar, mNextChar: AnsiChar; - mAllowSignedNumbers: Boolean; // internal control + mOptions: TOptions; mTokLine, mTokCol: Integer; // token start mTokType: Integer; @@ -60,11 +72,11 @@ type mTokInt: Integer; protected - procedure warmup (); virtual; // called in constructor to warm up the system + procedure warmup (); // called in constructor to warm up the system procedure loadNextChar (); virtual; abstract; // loads next char into mNextChar; #0 means 'eof' public - constructor Create (); + constructor Create (aopts: TOptions=[TOption.SignedNumbers]); destructor Destroy (); override; function isEOF (): Boolean; inline; @@ -88,11 +100,14 @@ type procedure expectTT (ttype: Integer); function eatTT (ttype: Integer): Boolean; - function expectDelim (const ch: AnsiChar): AnsiChar; + procedure expectDelim (const ch: AnsiChar); + function expectDelims (const ch: TAnsiCharSet): AnsiChar; function eatDelim (const ch: AnsiChar): Boolean; + function isDelim (const ch: AnsiChar): Boolean; inline; + public - property allowSignedNumbers: Boolean read mAllowSignedNumbers write mAllowSignedNumbers; + property options: TOptions read mOptions write mOptions; public property col: Integer read mCol; @@ -129,8 +144,8 @@ type procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof' public - constructor Create (const fname: AnsiString); - constructor Create (st: TStream; astOwned: Boolean=true); // will take ownership on st by default + constructor Create (const fname: AnsiString; aopts: TOptions=[TOption.SignedNumbers]); + constructor Create (st: TStream; astOwned: Boolean=true; aopts: TOptions=[TOption.SignedNumbers]); destructor Destroy (); override; end; @@ -143,7 +158,7 @@ type procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof' public - constructor Create (const astr: AnsiString); + constructor Create (const astr: AnsiString; aopts: TOptions=[TOption.SignedNumbers]); destructor Destroy (); override; end; @@ -220,11 +235,7 @@ uses // ////////////////////////////////////////////////////////////////////////// // -function StrEqu (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end; - - -// ////////////////////////////////////////////////////////////////////////// // -constructor TTextParser.Create (); +constructor TTextParser.Create (aopts: TOptions=[TOption.SignedNumbers]); begin mLine := 1; mCol := 1; @@ -234,8 +245,8 @@ begin mTokStr := ''; mTokChar := #0; mTokInt := 0; - mAllowSignedNumbers := true; - warmup(); // change `mAllowSignedNumbers` there, if necessary + mOptions := aopts; + warmup(); skipToken(); end; @@ -339,6 +350,24 @@ begin end; continue; end; + end + else if (curChar = '(') and (nextChar = '*') then + begin + // pascal comment; skip comment start + skipChar(); + skipChar(); + while not isEOF do + begin + if (curChar = '*') and (nextChar = ')') then + begin + // skip comment end + skipChar(); + skipChar(); + break; + end; + skipChar(); + end; + continue; end; if (curChar > ' ') then break; skipChar(); // skip blank @@ -365,7 +394,7 @@ function TTextParser.skipToken (): Boolean; base: Integer = -1; n: Integer; begin - if mAllowSignedNumbers then + if (TOption.SignedNumbers in mOptions) then begin if (curChar = '+') or (curChar = '-') then begin @@ -487,7 +516,9 @@ function TTextParser.skipToken (): Boolean; while (curChar = '_') or ((curChar >= '0') and (curChar <= '9')) or ((curChar >= 'A') and (curChar <= 'Z')) or ((curChar >= 'a') and (curChar <= 'z')) or - (curChar >= #128) do + (curChar >= #128) or + ((TOption.DollarIsId in mOptions) and (curChar = '$')) or + ((TOption.DotIsId in mOptions) and (curChar = '.') and (nextChar <> '.')) do begin mTokStr += curChar; skipChar(); @@ -514,7 +545,7 @@ begin result := true; // number? - if mAllowSignedNumbers and ((curChar = '+') or (curChar = '-')) then begin parseInt(); exit; end; + if (TOption.SignedNumbers in mOptions) and ((curChar = '+') or (curChar = '-')) then begin parseInt(); exit; end; if (curChar >= '0') and (curChar <= '9') then begin parseInt(); exit; end; // string? @@ -522,6 +553,8 @@ begin // identifier? if (curChar = '_') or ((curChar >= 'A') and (curChar <= 'Z')) or ((curChar >= 'a') and (curChar <= 'z')) or (curChar >= #128) then begin parseId(); exit; end; + if (TOption.DollarIsId in mOptions) and (curChar = '$') then begin parseId(); exit; end; + if (TOption.DotIsId in mOptions) and (curChar = '.') and (nextChar <> '.') then begin parseId(); exit; end; // known delimiters? mTokChar := curChar; @@ -534,16 +567,24 @@ begin '>': begin mTokType := TTGreatEqu; mTokStr := '>='; skipChar(); exit; end; '!': begin mTokType := TTNotEqu; mTokStr := '!='; skipChar(); exit; end; '=': begin mTokType := TTEqu; mTokStr := '=='; skipChar(); exit; end; + ':': begin mTokType := TTAss; mTokStr := ':='; skipChar(); exit; end; + end; + end + else if (mTokChar = curChar) then + begin + case mTokChar of + '<': begin mTokType := TTShl; mTokStr := '<<'; skipChar(); exit; end; + '>': begin mTokType := TTShr; mTokStr := '>>'; skipChar(); exit; end; + '&': begin mTokType := TTLogAnd; mTokStr := '&&'; skipChar(); exit; end; + '|': begin mTokType := TTLogOr; mTokStr := '||'; skipChar(); exit; end; + end; + end + else + begin + case mTokChar of + '<': if (curChar = '>') then begin mTokType := TTNotEqu; mTokStr := '<>'; skipChar(); exit; end; + '.': if (curChar = '.') then begin mTokType := TTDotDot; mTokStr := '..'; skipChar(); exit; end; end; - end; - case mTokChar of - ',': mTokType := TTComma; - ':': mTokType := TTColon; - ';': mTokType := TTSemi; - '{': mTokType := TTBegin; - '}': mTokType := TTEnd; - '&': if (curChar = '&') then begin mTokType := TTLogAnd; mTokStr := '&&'; skipChar(); exit; end; - '|': if (curChar = '|') then begin mTokType := TTLogOr; mTokStr := '||'; skipChar(); exit; end; end; end; @@ -558,17 +599,15 @@ end; procedure TTextParser.expectId (const aid: AnsiString); begin - if (mTokType <> TTId) or (not StrEqu(mTokStr, aid)) then raise Exception.Create('identifier '''+aid+''' expected'); + if (mTokType <> TTId) or (mTokStr <> aid) then raise Exception.Create('identifier '''+aid+''' expected'); skipToken(); end; function TTextParser.eatId (const aid: AnsiString): Boolean; begin - result := false; - if (mTokType <> TTId) or (not StrEqu(mTokStr, aid)) then exit; - result := true; - skipToken(); + result := (mTokType = TTId) and (mTokStr = aid); + if result then skipToken(); end; @@ -618,9 +657,17 @@ begin end; -function TTextParser.expectDelim (const ch: AnsiChar): AnsiChar; +procedure TTextParser.expectDelim (const ch: AnsiChar); +begin + if (mTokType <> TTDelim) or (mTokChar <> ch) then raise Exception.CreateFmt('delimiter ''%s'' expected', [ch]); + skipToken(); +end; + + +function TTextParser.expectDelims (const ch: TAnsiCharSet): AnsiChar; begin - if (mTokType <> TTDelim) then raise Exception.Create(Format('delimiter ''%s'' expected', [ch])); + if (mTokType <> TTDelim) then raise Exception.Create('delimiter expected'); + if not (mTokChar in ch) then raise Exception.Create('delimiter expected'); result := mTokChar; skipToken(); end; @@ -628,15 +675,19 @@ end; function TTextParser.eatDelim (const ch: AnsiChar): Boolean; begin - result := false; - if (mTokType <> TTDelim) or (mTokChar <> ch) then exit; - result := true; - skipToken(); + result := (mTokType = TTDelim) and (mTokChar = ch); + if result then skipToken(); +end; + + +function TTextParser.isDelim (const ch: AnsiChar): Boolean; inline; +begin + result := (mTokType = TTDelim) and (mTokChar = ch); end; // ////////////////////////////////////////////////////////////////////////// // -constructor TFileTextParser.Create (const fname: AnsiString); +constructor TFileTextParser.Create (const fname: AnsiString; aopts: TOptions=[TOption.SignedNumbers]); begin mBuffer := nil; mFile := openDiskFileRO(fname); @@ -645,11 +696,11 @@ begin mBufPos := 0; mBufLen := mFile.Read(mBuffer^, BufSize); if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error'); - inherited Create(); + inherited Create(aopts); end; -constructor TFileTextParser.Create (st: TStream; astOwned: Boolean=true); +constructor TFileTextParser.Create (st: TStream; astOwned: Boolean=true; aopts: TOptions=[TOption.SignedNumbers]); begin if (st = nil) then raise Exception.Create('cannot create parser for nil stream'); mFile := st; @@ -658,7 +709,7 @@ begin mBufPos := 0; mBufLen := mFile.Read(mBuffer^, BufSize); if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error'); - inherited Create(); + inherited Create(aopts); end; @@ -692,11 +743,11 @@ end; // ////////////////////////////////////////////////////////////////////////// // -constructor TStrTextParser.Create (const astr: AnsiString); +constructor TStrTextParser.Create (const astr: AnsiString; aopts: TOptions=[TOption.SignedNumbers]); begin mStr := astr; mPos := 1; - inherited Create(); + inherited Create(aopts); end;