X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fexoma.pas;h=be3de720219d9935d04be0aea6aa633322688127;hb=06ce403977f0da3911c62eed46414ad03afa9111;hp=9d628e583b3f553a31f3400b6f3aaebc7459ac23;hpb=dd969f579db2bf70f6ddfcb5d377b2b95b994a6e;p=d2df-sdl.git diff --git a/src/shared/exoma.pas b/src/shared/exoma.pas index 9d628e5..be3de72 100644 --- a/src/shared/exoma.pas +++ b/src/shared/exoma.pas @@ -1,9 +1,8 @@ -(* Copyright (C) DooM 2D:Forever Developers +(* Copyright (C) Doom 2D: Forever Developers * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. + * the Free Software Foundation, version 3 of the License ONLY. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,12 +18,31 @@ unit exoma; interface uses - typinfo, Variants, hashtable, xparser; + {$IFDEF USE_MEMPOOL}mempool,{$ENDIF} + typinfo, SysUtils, Variants, + hashtable, xparser; // ////////////////////////////////////////////////////////////////////////// // type - TPropHash = class + TExomaException = class(Exception) + public + constructor Create (const amsg: AnsiString); + constructor CreateFmt (const afmt: AnsiString; const args: array of const); + end; + + TExomaParseException = class(TExomaException) + public + tokLine, tokCol: Integer; + + public + constructor Create (pr: TTextParser; const amsg: AnsiString); + constructor CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const); + end; + +// ////////////////////////////////////////////////////////////////////////// // +type + TPropHash = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} private mClass: TClass; mNames: THashStrInt; @@ -32,7 +50,7 @@ type pc: Integer; public - constructor Create (aklass: TClass); + constructor Create (aklass: TClass; const apfx: AnsiString=''); destructor Destroy (); override; function get (obj: TObject; const fldname: AnsiString; out v: Variant): Boolean; @@ -42,22 +60,45 @@ type // ////////////////////////////////////////////////////////////////////////// // type - TExprScope = class + TExprConstList = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} public + function valid (const cname: AnsiString): Boolean; virtual; abstract; + function get (const cname: AnsiString; out v: Variant): Boolean; virtual; abstract; + end; + + +// ////////////////////////////////////////////////////////////////////////// // +type + TExprScope = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} + public + class procedure error (const amsg: AnsiString); + class procedure errorfmt (const afmt: AnsiString; const args: array of const); + function getObj (const aname: AnsiString): TObject; virtual; function getField (obj: TObject; const afldname: AnsiString): Variant; virtual; procedure setField (obj: TObject; const afldname: AnsiString; var aval: Variant); virtual; end; - TExprBase = class + TExprBase = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} public class function coerce2bool (var v0: Variant): Boolean; class function toInt (var v: Variant): LongInt; public - class procedure error (); - class function parse (pr: TTextParser; allowAssign: Boolean=false): TExprBase; - class function parse (const str: AnsiString; allowAssign: Boolean=false): TExprBase; - class function parseStatList (const str: AnsiString): TExprBase; + class procedure error (const amsg: AnsiString); + class procedure errorfmt (const afmt: AnsiString; const args: array of const); + + class procedure parseError (pr: TTextParser; const amsg: AnsiString); + class procedure parseErrorFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const); + + class function parse (clist: TExprConstList; pr: TTextParser; allowAssign: Boolean=false): TExprBase; + class function parse (clist: TExprConstList; const str: AnsiString; allowAssign: Boolean=false): TExprBase; + class function parseStatList (clist: TExprConstList; const str: AnsiString): TExprBase; + + class function isFloat (var v: Variant): Boolean; inline; + class function isInt (var v: Variant): Boolean; inline; + class function isBool (var v: Variant): Boolean; inline; + class function isStr (var v: Variant): Boolean; inline; + public function value (scope: TExprScope): Variant; virtual; abstract; procedure assign (scope: TExprScope; var v: Variant); virtual; @@ -70,6 +111,7 @@ type public constructor Create (); destructor Destroy (); override; + procedure append (e: TExprBase); function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; function clone (): TExprBase; override; @@ -93,6 +135,7 @@ type constructor Create (aval: Boolean); constructor Create (aval: LongInt); constructor Create (const aval: AnsiString); + constructor Create (var v: Variant); function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; @@ -108,8 +151,17 @@ type function clone (): TExprBase; override; end; - TUnExprNeg = class(TUnExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end; - TUnExprNot = class(TUnExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end; + TUnExprNeg = class(TUnExpr) + public + function value (scope: TExprScope): Variant; override; + function toString (): AnsiString; override; + end; + + TUnExprNot = class(TUnExpr) + public + function value (scope: TExprScope): Variant; override; + function toString (): AnsiString; override; + end; TDotExpr = class(TExprBase) private @@ -152,6 +204,17 @@ type TBinAssign = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end; + TExprCond = class(TExprBase) + private + mCond, mTrue, mFalse: TExprBase; + public + constructor Create (); + destructor Destroy (); override; + function value (scope: TExprScope): Variant; override; + function toString (): AnsiString; override; + function clone (): TExprBase; override; + end; + // ////////////////////////////////////////////////////////////////////////// // function typeKind2Str (t: TTypeKind): AnsiString; @@ -160,7 +223,33 @@ function typeKind2Str (t: TTypeKind): AnsiString; implementation uses - SysUtils, utils; + utils; + + +// ////////////////////////////////////////////////////////////////////////// // +constructor TExomaException.Create (const amsg: AnsiString); +begin + inherited Create(amsg); +end; + +constructor TExomaException.CreateFmt (const afmt: AnsiString; const args: array of const); +begin + inherited Create(formatstrf(afmt, args)); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +constructor TExomaParseException.Create (pr: TTextParser; const amsg: AnsiString); +begin + if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end; + inherited Create(amsg); +end; + +constructor TExomaParseException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const); +begin + if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end; + inherited Create(formatstrf(afmt, args)); +end; // ////////////////////////////////////////////////////////////////////////// // @@ -249,19 +338,34 @@ end; // ////////////////////////////////////////////////////////////////////////// // -constructor TPropHash.Create (aklass: TClass); +constructor TPropHash.Create (aklass: TClass; const apfx: AnsiString=''); var pi: PTypeInfo; pt: PTypeData; idx: Integer; + n: AnsiString; begin mClass := aklass; - mNames := hashNewStrInt(); + mNames := THashStrInt.Create(); pi := aklass.ClassInfo; pt := GetTypeData(pi); GetMem(pl, pt^.PropCount*sizeof(Pointer)); pc := GetPropList(pi, [tkInteger, tkBool, tkSString, tkLString, tkAString, {tkSet,} tkEnumeration], pl); - for idx := 0 to pc-1 do mNames.put(pl^[idx].name, idx); + for idx := 0 to pc-1 do + begin + if (Length(apfx) > 0) then + begin + if (Length(pl^[idx].name) < Length(apfx)) then continue; + n := pl^[idx].name; + if (Copy(n, 1, Length(apfx)) <> apfx) then continue; + Delete(n, 1, Length(apfx)); + mNames.put(n, idx); + end + else + begin + mNames.put(pl^[idx].name, idx); + end; + end; end; destructor TPropHash.Destroy (); @@ -323,13 +427,20 @@ end; // ////////////////////////////////////////////////////////////////////////// // -function TExprScope.getObj (const aname: AnsiString): TObject; begin result := nil; TExprBase.error(); end; -function TExprScope.getField (obj: TObject; const afldname: AnsiString): Variant; begin result := Unassigned; TExprBase.error(); end; -procedure TExprScope.setField (obj: TObject; const afldname: AnsiString; var aval: Variant); begin TExprBase.error(); end; +class procedure TExprScope.error (const amsg: AnsiString); begin raise TExomaException.Create(amsg); end; +class procedure TExprScope.errorfmt (const afmt: AnsiString; const args: array of const); begin raise TExomaException.CreateFmt(afmt, args); end; + +function TExprScope.getObj (const aname: AnsiString): TObject; begin result := nil; errorfmt('unknown object ''%s''', [aname]); end; +function TExprScope.getField (obj: TObject; const afldname: AnsiString): Variant; begin result := Unassigned; errorfmt('unknown field ''%s''', [afldname]); end; +procedure TExprScope.setField (obj: TObject; const afldname: AnsiString; var aval: Variant); begin errorfmt('unknown field ''%s''', [afldname]); end; // ////////////////////////////////////////////////////////////////////////// // -class procedure TExprBase.error (); begin raise Exception.Create('math error'); end; +class procedure TExprBase.error (const amsg: AnsiString); begin raise TExomaException.Create(amsg); end; +class procedure TExprBase.errorfmt (const afmt: AnsiString; const args: array of const); begin raise TExomaException.CreateFmt(afmt, args); end; + +class procedure TExprBase.parseError (pr: TTextParser; const amsg: AnsiString); begin raise TExomaParseException.Create(pr, amsg); end; +class procedure TExprBase.parseErrorFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const); begin raise TExomaParseException.CreateFmt(pr, afmt, args); end; class function TExprBase.coerce2bool (var v0: Variant): Boolean; begin @@ -343,10 +454,36 @@ begin varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := (LongInt(v0) <> 0); varInt64: result := (Int64(v0) <> 0); varQWord: result := (UInt64(v0) <> 0); - else begin result := false; error(); end; + else begin result := false; error('can''t coerce type to boolean'); end; + end; +end; + +class function TExprBase.isFloat (var v: Variant): Boolean; inline; +begin + case varType(v) of + varSingle, varDouble: result := true; + else result := false; + end; +end; + +class function TExprBase.isInt (var v: Variant): Boolean; inline; +begin + case varType(v) of + varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := true; + else result := false; end; end; +class function TExprBase.isBool (var v: Variant): Boolean; inline; +begin + result := (varType(v) = varBoolean); +end; + +class function TExprBase.isStr (var v: Variant): Boolean; inline; +begin + result := (varType(v) = varString); +end; + class function TExprBase.toInt (var v: Variant): LongInt; begin case varType(v) of @@ -355,17 +492,26 @@ begin varBoolean: if Boolean(v) then result := 1 else result := 0; varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := LongInt(v); varInt64: result := LongInt(Int64(v)); - else begin result := 0; TExprBase.error(); end; + else begin result := 0; TExprBase.error('can''t coerce type to integer'); end; end; end; -procedure TExprBase.assign (scope: TExprScope; var v: Variant); begin error(); end; +procedure TExprBase.assign (scope: TExprScope; var v: Variant); begin error('not an lvalue'); end; // ////////////////////////////////////////////////////////////////////////// // constructor TExprStatList.Create (); begin mList := nil; end; destructor TExprStatList.Destroy (); var f: Integer; begin for f := 0 to High(mList) do mList[f].Free(); mList := nil; end; +procedure TExprStatList.append (e: TExprBase); +begin + if (e <> nil) then + begin + SetLength(mList, Length(mList)+1); + mList[High(mList)] := e; + end; +end; + function TExprStatList.value (scope: TExprScope): Variant; var f: Integer; @@ -397,6 +543,27 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // +constructor TExprCond.Create (); begin mCond := nil; mTrue := nil; mFalse := nil; end; +destructor TExprCond.Destroy (); begin mFalse.Free(); mTrue.Free(); mCond.Free(); end; + +function TExprCond.value (scope: TExprScope): Variant; +begin + result := mCond.value(scope); + if coerce2bool(result) then result := mTrue.value(scope) else result := mFalse.value(scope); +end; + +function TExprCond.toString (): AnsiString; begin result := '('+mCond.toString()+'?'+mTrue.toString()+':'+mFalse.toString()+')'; end; + +function TExprCond.clone (): TExprBase; +begin + result := TExprCond.Create(); + TExprCond(result).mCond := mCond.clone(); + TExprCond(result).mTrue := mTrue.clone(); + TExprCond(result).mFalse := mFalse.clone(); +end; + + // ////////////////////////////////////////////////////////////////////////// // constructor TObjExpr.Create (const aval: AnsiString); begin mName := aval; end; function TObjExpr.value (scope: TExprScope): Variant; begin result := UInt64(PtrUInt(Pointer(scope.getObj(mName)))); end; @@ -408,8 +575,9 @@ function TObjExpr.clone (): TExprBase; begin result := TObjExpr.Create(mName); e constructor TLitExpr.Create (aval: Boolean); begin mValue := aval; end; constructor TLitExpr.Create (aval: LongInt); begin mValue := aval; end; constructor TLitExpr.Create (const aval: AnsiString); begin mValue := aval; end; +constructor TLitExpr.Create (var v: Variant); begin mValue := v; end; function TLitExpr.value (scope: TExprScope): Variant; begin result := mValue; end; -function TLitExpr.toString (): AnsiString; begin result := VarToStr(mValue); end; +function TLitExpr.toString (): AnsiString; begin result := VarToStr(mValue); if isStr(mValue) then result := quoteStr(result); end; function TLitExpr.clone (): TExprBase; begin result := TLitExpr.Create(0); (result as TLitExpr).mValue := mValue; end; @@ -427,7 +595,7 @@ begin varShortInt, varSmallInt, varInteger, varByte, varWord: result := -LongInt(result); varInt64: result := -Int64(result); varLongWord: result := -LongInt(result); - else error(); + else error('can''t negate non-number'); end; end; @@ -452,7 +620,7 @@ end; function TDotExpr.value (scope: TExprScope): Variant; begin result := mOp0.value(scope); - if (varType(result) <> varQWord) then error(); + if (varType(result) <> varQWord) then errorfmt('can''t take field ''%s'' value of non-object', [mField]); result := scope.getField(TObject(PtrUInt(UInt64(result))), mField); end; @@ -461,7 +629,7 @@ var o: Variant; begin o := mOp0.value(scope); - if (varType(o) <> varQWord) then error(); + if (varType(o) <> varQWord) then errorfmt('can''t assign value to field ''%s'' of non-object', [mField]); scope.setField(TObject(PtrUInt(UInt64(o))), mField, v); end; @@ -476,32 +644,6 @@ destructor TBinExpr.Destroy (); begin mOp1.Free(); mOp0.Free(); inherited; end; function TBinExpr.clone (): TExprBase; begin result := (self.ClassType.Create() as TBinExpr); (result as TBinExpr).mOp0 := mOp0.clone(); (result as TBinExpr).mOp1 := mOp1.clone(); end; class procedure TBinExpr.coerce (var v0, v1: Variant); - function isFloat (var v: Variant): Boolean; inline; - begin - case varType(v) of - varSingle, varDouble: result := true; - else result := false; - end; - end; - - function isInt (var v: Variant): Boolean; inline; - begin - case varType(v) of - varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := true; - else result := false; - end; - end; - - function isBool (var v: Variant): Boolean; inline; - begin - result := (varType(v) = varBoolean); - end; - - function isStr (var v: Variant): Boolean; inline; - begin - result := (varType(v) = varString); - end; - begin if (varType(v0) <> varType(v1)) then begin @@ -511,36 +653,36 @@ begin else if isInt(v0) then v0 := formatstrf('%s', [LongInt(v0)]) else if isBool(v0) then v0 := formatstrf('%s', [Boolean(v0)]) else if isStr(v0) then begin end - else error(); + else error('can''t coerce value to string'); if isFloat(v1) then v1 := formatstrf('%s', [Double(v1)]) else if isInt(v1) then v1 := formatstrf('%s', [LongInt(v1)]) else if isBool(v1) then v1 := formatstrf('%s', [Boolean(v1)]) else if isStr(v0) then begin end - else error(); + else error('can''t coerce value to string'); end else if isFloat(v0) or isFloat(v1) then begin if isFloat(v0) or isInt(v0) then v0 := Double(v0) else if isBool(v0) then begin if Boolean(v0) then v0 := Double(1.0) else v0 := Double(0.0); end - else error(); + else error('can''t coerce value to float'); if isFloat(v1) or isInt(v1) then v1 := Double(v1) else if isBool(v1) then begin if Boolean(v1) then v1 := Double(1.0) else v1 := Double(0.0); end - else error(); + else error('can''t coerce value to float'); end else if isInt(v0) or isInt(v1) then begin if isBool(v0) then begin if Boolean(v0) then v0 := LongInt(1) else v0 := LongInt(0); end else if isFloat(v0) then v0 := LongInt(trunc(Double(v0))) else if isInt(v0) then begin end - else error(); + else error('can''t coerce value to integer'); if isBool(v1) then begin if Boolean(v1) then v1 := LongInt(1) else v1 := LongInt(0); end else if isFloat(v1) then v1 := LongInt(trunc(Double(v1))) else if isInt(v1) then begin end - else error(); + else error('can''t coerce value to integer'); end else begin - error(); + error('can''t operate with value of invalid type'); end; end; end; @@ -559,7 +701,7 @@ begin varString: result := AnsiString(result)+AnsiString(r1); varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := LongInt(result)+LongInt(r1); varInt64: result := Int64(result)+Int64(r1); - else error(); + else error('can''t add non-numbers and non-strings'); end; end; function TBinExprAdd.toString (): AnsiString; begin result := '('+mOp0.toString()+'+'+mOp1.toString+')'; end; @@ -575,7 +717,7 @@ begin varSingle, varDouble: result := Double(result)-Double(r1); varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := LongInt(result)-LongInt(r1); varInt64: result := Int64(result)-Int64(r1); - else error(); + else error('can''t subtract non-numbers'); end; end; function TBinExprSub.toString (): AnsiString; begin result := '('+mOp0.toString()+'-'+mOp1.toString+')'; end; @@ -591,7 +733,7 @@ begin varSingle, varDouble: result := Double(result)*Double(r1); varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := LongInt(result)*LongInt(r1); varInt64: result := Int64(result)*Int64(r1); - else error(); + else error('can''t multiply non-numbers'); end; end; function TBinExprMul.toString (): AnsiString; begin result := '('+mOp0.toString()+'*'+mOp1.toString+')'; end; @@ -607,7 +749,7 @@ begin varSingle, varDouble: result := Double(result)/Double(r1); varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := LongInt(result) div LongInt(r1); varInt64: result := Int64(result) div Int64(r1); - else error(); + else error('can''t divide non-numbers'); end; end; function TBinExprDiv.toString (): AnsiString; begin result := '('+mOp0.toString()+'/'+mOp1.toString+')'; end; @@ -622,7 +764,7 @@ begin case varType(result) of varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := LongInt(result) mod LongInt(r1); varInt64: result := Int64(result) mod Int64(r1); - else error(); + else error('can''t do modulo on non-numbers'); end; end; function TBinExprMod.toString (): AnsiString; begin result := '('+mOp0.toString()+'%'+mOp1.toString+')'; end; @@ -657,7 +799,7 @@ begin varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := Boolean(LongInt(result) < LongInt(r1)); varInt64: result := Boolean(Int64(result) < Int64(r1)); varString: result := Boolean(AnsiString(result) < AnsiString(r1)); - else error(); + else error('can''t compare non-numbers and non-strings'); end; end; function TBinExprCmpLess.toString (): AnsiString; begin result := '('+mOp0.toString()+'<'+mOp1.toString+')'; end; @@ -674,7 +816,7 @@ begin varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := Boolean(LongInt(result) > LongInt(r1)); varInt64: result := Boolean(Int64(result) > Int64(r1)); varString: result := Boolean(AnsiString(result) > AnsiString(r1)); - else error(); + else error('can''t compare non-numbers and non-strings'); end; end; function TBinExprCmpGreat.toString (): AnsiString; begin result := '('+mOp0.toString()+'>'+mOp1.toString+')'; end; @@ -691,7 +833,7 @@ begin varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := Boolean(LongInt(result) <= LongInt(r1)); varInt64: result := Boolean(Int64(result) <= Int64(r1)); varString: result := Boolean(AnsiString(result) <= AnsiString(r1)); - else error(); + else error('can''t compare non-numbers and non-strings'); end; end; function TBinExprCmpLessEqu.toString (): AnsiString; begin result := '('+mOp0.toString()+'<='+mOp1.toString+')'; end; @@ -708,7 +850,7 @@ begin varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := Boolean(LongInt(result) >= LongInt(r1)); varInt64: result := Boolean(Int64(result) >= Int64(r1)); varString: result := Boolean(AnsiString(result) >= AnsiString(r1)); - else error(); + else error('can''t compare non-numbers and non-strings'); end; end; function TBinExprCmpGreatEqu.toString (): AnsiString; begin result := '('+mOp0.toString()+'>='+mOp1.toString+')'; end; @@ -727,7 +869,7 @@ begin varString: result := Boolean(AnsiString(result) = AnsiString(r1)); varBoolean: result := (Boolean(result) = Boolean(r1)); varQWord: result := (UInt64(result) = UInt64(r1)); - else error(); + else error('can''t compare non-numbers and non-strings'); end; end; function TBinExprCmpEqu.toString (): AnsiString; begin result := '('+mOp0.toString()+'=='+mOp1.toString+')'; end; @@ -746,7 +888,7 @@ begin varString: result := Boolean(AnsiString(result) <> AnsiString(r1)); varBoolean: result := (Boolean(result) <> Boolean(r1)); varQWord: result := (UInt64(result) <> UInt64(r1)); - else error(); + else error('can''t compare non-numbers and non-strings'); end; end; function TBinExprCmpNotEqu.toString (): AnsiString; begin result := '('+mOp0.toString()+'<>'+mOp1.toString+')'; end; @@ -763,43 +905,54 @@ function TBinAssign.toString (): AnsiString; begin result := mOp0.toString()+'=' // ////////////////////////////////////////////////////////////////////////// // -class function TExprBase.parse (const str: AnsiString; allowAssign: Boolean=false): TExprBase; +class function TExprBase.parse (clist: TExprConstList; const str: AnsiString; allowAssign: Boolean=false): TExprBase; var pr: TTextParser; begin pr := TStrTextParser.Create(str); try - result := parse(pr, allowAssign); - if (pr.tokType <> pr.TTEOF) then begin result.Free(); error(); end; + result := parse(clist, pr, allowAssign); + if (pr.tokType <> pr.TTEOF) then begin result.Free(); parseError(pr, 'extra code in expression'); end; finally pr.Free(); end; end; -class function TExprBase.parseStatList (const str: AnsiString): TExprBase; +class function TExprBase.parseStatList (clist: TExprConstList; const str: AnsiString): TExprBase; var - pr: TTextParser; - r: TExprStatList; - e: TExprBase; + pr: TTextParser = nil; + r: TExprStatList = nil; + e: TExprBase = nil; begin pr := TStrTextParser.Create(str); if (pr.tokType = pr.TTEOF) then begin pr.Free(); result := nil; exit; end; r := TExprStatList.Create(); result := nil; try - while true do - begin - while pr.eatTT(pr.TTSemi) do begin end; - if (pr.tokType = pr.TTEOF) then break; - e := parse(pr, true); - if (e = nil) then break; - SetLength(r.mList, Length(r.mList)+1); - r.mList[High(r.mList)] := e; - if (pr.tokType = pr.TTEOF) then break; - pr.expectTT(pr.TTSemi); + try + while true do + begin + while pr.eatDelim(';') do begin end; + if (pr.tokType = pr.TTEOF) then break; + e := parse(clist, pr, true); + if (e = nil) then break; + //writeln(': ', e.toString()); + r.append(e); + if (pr.tokType = pr.TTEOF) then break; + //writeln('tt=', pr.tokType, ' <', pr.tokStr, '>'); + //writeln(r.toString()); + pr.expectDelim(';'); + end; + result := r; + r := nil; + except + on e: TExomaException do + raise TExomaParseException.Create(pr, e.message); + on e: Exception do + raise TExomaParseException.Create(pr, e.message); + else + raise; end; - result := r; - r := nil; finally r.Free(); pr.Free(); @@ -807,26 +960,39 @@ begin end; -class function TExprBase.parse (pr: TTextParser; allowAssign: Boolean=false): TExprBase; +class function TExprBase.parse (clist: TExprConstList; pr: TTextParser; allowAssign: Boolean=false): TExprBase; function expr (): TExprBase; forward; function doTerm (): TExprBase; + var + id: AnsiString; + v: Variant; begin result := nil; try if pr.eatDelim('(') then begin result := expr(); pr.expectDelim(')'); exit; end; - if pr.eatDelim('!') then begin result := expr(); result := TUnExprNot.Create(result); exit; end; - if pr.eatDelim('-') then begin result := expr(); result := TUnExprNeg.Create(result); exit; end; - if pr.eatDelim('+') then begin result := expr(); exit; end; + if pr.eatDelim('!') then begin result := doTerm(); result := TUnExprNot.Create(result); exit; end; + if pr.eatDelim('+') then begin result := doTerm(); exit; end; + if pr.eatDelim('-') then begin result := doTerm(); result := TUnExprNeg.Create(result); exit; end; if (pr.tokType = pr.TTInt) then begin result := TLitExpr.Create(pr.expectInt()); exit; end; if (pr.tokType = pr.TTStr) then begin result := TLitExpr.Create(pr.expectStr(true)); exit; end; if (pr.tokType = pr.TTId) then begin if (pr.tokStr = 'true') then begin result := TLitExpr.Create(true); pr.skipToken(); exit; end; if (pr.tokStr = 'false') then begin result := TLitExpr.Create(false); pr.skipToken(); exit; end; - if (CompareText(pr.tokStr, 'true') = 0) or (CompareText(pr.tokStr, 'false') = 0) then error(); - result := TObjExpr.Create(pr.expectId()); + if (CompareText(pr.tokStr, 'true') = 0) or (CompareText(pr.tokStr, 'false') = 0) then parseError(pr, '`true` and `false` are case-sensitive'); + id := pr.expectId(); + if (clist <> nil) then + begin + if clist.get(id, v) then + begin + result := TLitExpr.Create(v); + exit; + end; + if not clist.valid(id) then parseErrorFmt(pr, 'unknown identifier ''%s''', [id]); + end; + result := TObjExpr.Create(id); while (pr.tokType = pr.TTDelim) and (pr.tokChar = '.') do begin pr.skipToken(); @@ -838,7 +1004,7 @@ class function TExprBase.parse (pr: TTextParser; allowAssign: Boolean=false): TE result.Free(); raise; end; - error(); + parseError(pr, 'invalid term'); end; function doMulDiv (): TExprBase; @@ -949,32 +1115,82 @@ class function TExprBase.parse (pr: TTextParser; allowAssign: Boolean=false): TE // && // || + function expr0 (): TExprBase; + var + neg: Boolean; + e: TExprBase = nil; + list: TExprStatList = nil; + begin + result := nil; + try + while true do + begin + if pr.eatDelim('-') then neg := true + else if pr.eatDelim('+') then neg := false + else neg := false; + e := doLogOr(); + if neg then e := TUnExprNeg.Create(e); + if allowAssign and pr.eatDelim('=') then e := TBinAssign.Create(e, expr()); + if not pr.eatDelim(',') then + begin + if (result = nil) then result := e else list.append(e); + break; + end; + //assert(false); + if (list = nil) then + begin + list := TExprStatList.Create(); + result := list; + end; + list.append(e); + e := nil; + end; + except + e.Free(); + list.Free(); + end; + end; + function expr (): TExprBase; var - neg: Boolean = false; + c: TExprCond; begin - if pr.eatDelim('-') then neg := true - else if pr.eatDelim('+') then neg := false; - result := doLogOr(); - if neg then result := TUnExprNeg.Create(result); + result := expr0(); + // ternary + if pr.eatDelim('?') then + begin + c := TExprCond.Create(); + c.mCond := result; + try + c.mTrue := expr(); + pr.expectDelim(':'); + c.mFalse := expr(); + result := c; + except + c.Free(); + end; + end; 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; - pr.allowSignedNumbers := false; + oas := pr.options; try - result := expr(); - if allowAssign and pr.eatDelim('=') then + pr.options := pr.options-[pr.TOption.SignedNumbers]; try - result := TBinAssign.Create(result, expr()); - except - result.Free(); + result := expr(); + finally + pr.options := oas; end; - finally - pr.allowSignedNumbers := oas; + except + on e: TExomaException do + raise TExomaParseException.Create(pr, e.message); + on e: Exception do + raise TExomaParseException.Create(pr, e.message); + else + raise; end; end;