src/shared/exoma.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   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.
   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 unit exoma;
  18
  19 interface
  20
  21 uses
  22   {$IFDEF USE_MEMPOOL}mempool,{$ENDIF}
  23   typinfo, SysUtils, Variants,
  24   hashtable, xparser;
  25
  26
  27 // ////////////////////////////////////////////////////////////////////////// //
  28 type
  29   TExomaException = class(Exception)
  30   public
  31     constructor Create (const amsg: AnsiString);
  32     constructor CreateFmt (const afmt: AnsiString; const args: array of const);
  33   end;
  34
  35   TExomaParseException = class(TExomaException)
  36   public
  37     tokLine, tokCol: Integer;
  38
  39   public
  40     constructor Create (pr: TTextParser; const amsg: AnsiString);
  41     constructor CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
  42   end;
  43
  44 // ////////////////////////////////////////////////////////////////////////// //
  45 type
  46   TPropHash = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
  47   private
  48     mClass: TClass;
  49     mNames: THashStrInt;
  50     pl: PPropList;
  51     pc: Integer;
  52
  53   public
  54     constructor Create (aklass: TClass; const apfx: AnsiString='');
  55     destructor Destroy (); override;
  56
  57     function get (obj: TObject; const fldname: AnsiString; out v: Variant): Boolean;
  58     function put (obj: TObject; const fldname: AnsiString; var v: Variant): Boolean;
  59   end;
  60
  61
  62 // ////////////////////////////////////////////////////////////////////////// //
  63 type
  64   TExprConstList = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
  65   public
  66     function valid (const cname: AnsiString): Boolean; virtual; abstract;
  67     function get (const cname: AnsiString; out v: Variant): Boolean; virtual; abstract;
  68   end;
  69
  70
  71 // ////////////////////////////////////////////////////////////////////////// //
  72 type
  73   TExprScope = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
  74   public
  75     class procedure error (const amsg: AnsiString);
  76     class procedure errorfmt (const afmt: AnsiString; const args: array of const);
  77
  78     function getObj (const aname: AnsiString): TObject; virtual;
  79     function getField (obj: TObject; const afldname: AnsiString): Variant; virtual;
  80     procedure setField (obj: TObject; const afldname: AnsiString; var aval: Variant); virtual;
  81   end;
  82
  83   TExprBase = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
  84   public
  85     class function coerce2bool (var v0: Variant): Boolean;
  86     class function toInt (var v: Variant): LongInt;
  87   public
  88     class procedure error (const amsg: AnsiString);
  89     class procedure errorfmt (const afmt: AnsiString; const args: array of const);
  90
  91     class procedure parseError (pr: TTextParser; const amsg: AnsiString);
  92     class procedure parseErrorFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
  93
  94     class function parse (clist: TExprConstList; pr: TTextParser; allowAssign: Boolean=false): TExprBase;
  95     class function parse (clist: TExprConstList; const str: AnsiString; allowAssign: Boolean=false): TExprBase;
  96     class function parseStatList (clist: TExprConstList; const str: AnsiString): TExprBase;
  97
  98     class function isFloat (var v: Variant): Boolean; inline;
  99     class function isInt (var v: Variant): Boolean; inline;
 100     class function isBool (var v: Variant): Boolean; inline;
 101     class function isStr (var v: Variant): Boolean; inline;
 102
 103   public
 104     function value (scope: TExprScope): Variant; virtual; abstract;
 105     procedure assign (scope: TExprScope; var v: Variant); virtual;
 106     function clone (): TExprBase; virtual; abstract;
 107   end;
 108
 109   TExprStatList = class(TExprBase)
 110   private
 111     mList: array of TExprBase;
 112   public
 113     constructor Create ();
 114     destructor Destroy (); override;
 115     procedure append (e: TExprBase);
 116     function value (scope: TExprScope): Variant; override;
 117     function toString (): AnsiString; override;
 118     function clone (): TExprBase; override;
 119   end;
 120
 121   TObjExpr = class(TExprBase)
 122   private
 123     mName: AnsiString;
 124   public
 125     constructor Create (const aval: AnsiString);
 126
 127     function value (scope: TExprScope): Variant; override;
 128     function toString (): AnsiString; override;
 129     function clone (): TExprBase; override;
 130   end;
 131
 132   TLitExpr = class(TExprBase)
 133   private
 134     mValue: Variant;
 135   public
 136     constructor Create (aval: Boolean);
 137     constructor Create (aval: LongInt);
 138     constructor Create (const aval: AnsiString);
 139     constructor Create (var v: Variant);
 140
 141     function value (scope: TExprScope): Variant; override;
 142     function toString (): AnsiString; override;
 143     function clone (): TExprBase; override;
 144   end;
 145
 146   TUnExpr = class(TExprBase)
 147   private
 148     mOp0: TExprBase;
 149   public
 150     constructor Create (aop0: TExprBase);
 151     destructor Destroy (); override;
 152     function clone (): TExprBase; override;
 153   end;
 154
 155   TUnExprNeg = class(TUnExpr)
 156   public
 157     function value (scope: TExprScope): Variant; override;
 158     function toString (): AnsiString; override;
 159   end;
 160
 161   TUnExprNot = class(TUnExpr)
 162   public
 163     function value (scope: TExprScope): Variant; override;
 164     function toString (): AnsiString; override;
 165   end;
 166
 167   TDotExpr = class(TExprBase)
 168   private
 169     mOp0: TExprBase;
 170     mField: AnsiString;
 171   public
 172     constructor Create (aop0: TExprBase; const afield: AnsiString);
 173     function value (scope: TExprScope): Variant; override;
 174     procedure assign (scope: TExprScope; var v: Variant); override;
 175     function toString (): AnsiString; override;
 176     function clone (): TExprBase; override;
 177   end;
 178
 179   TBinExpr = class(TExprBase)
 180   private
 181     mOp0, mOp1: TExprBase;
 182   private
 183     class procedure coerce (var v0, v1: Variant); // modifies both variants
 184   public
 185     constructor Create (aop0, aop1: TExprBase);
 186     destructor Destroy (); override;
 187     function clone (): TExprBase; override;
 188   end;
 189
 190   TBinExprAdd = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 191   TBinExprSub = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 192   TBinExprMul = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 193   TBinExprDiv = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 194   TBinExprMod = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 195
 196   TBinExprLogAnd = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 197   TBinExprLogOr = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 198
 199   TBinExprCmpLess = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 200   TBinExprCmpGreat = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 201   TBinExprCmpLessEqu = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 202   TBinExprCmpGreatEqu = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 203   TBinExprCmpEqu = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 204   TBinExprCmpNotEqu = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 205
 206   TBinAssign = class(TBinExpr) public function value (scope: TExprScope): Variant; override; function toString (): AnsiString; override; end;
 207
 208   TExprCond = class(TExprBase)
 209   private
 210     mCond, mTrue, mFalse: TExprBase;
 211   public
 212     constructor Create ();
 213     destructor Destroy (); override;
 214     function value (scope: TExprScope): Variant; override;
 215     function toString (): AnsiString; override;
 216     function clone (): TExprBase; override;
 217   end;
 218
 219
 220 // ////////////////////////////////////////////////////////////////////////// //
 221 function typeKind2Str (t: TTypeKind): AnsiString;
 222
 223
 224 implementation
 225
 226 uses
 227   utils;
 228
 229
 230 // ////////////////////////////////////////////////////////////////////////// //
 231 constructor TExomaException.Create (const amsg: AnsiString);
 232 begin
 233   inherited Create(amsg);
 234 end;
 235
 236 constructor TExomaException.CreateFmt (const afmt: AnsiString; const args: array of const);
 237 begin
 238   inherited Create(formatstrf(afmt, args));
 239 end;
 240
 241
 242 // ////////////////////////////////////////////////////////////////////////// //
 243 constructor TExomaParseException.Create (pr: TTextParser; const amsg: AnsiString);
 244 begin
 245   if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
 246   inherited Create(amsg);
 247 end;
 248
 249 constructor TExomaParseException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
 250 begin
 251   if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
 252   inherited Create(formatstrf(afmt, args));
 253 end;
 254
 255
 256 // ////////////////////////////////////////////////////////////////////////// //
 257 function typeKind2Str (t: TTypeKind): AnsiString;
 258 begin
 259   case t of
 260     tkUnknown: result := 'Unknown';
 261     tkInteger: result := 'Integer';
 262     tkChar: result := 'AnsiChar';
 263     tkEnumeration: result := 'Enumeration';
 264     tkFloat: result := 'Float';
 265     tkSet: result := 'Set';
 266     tkMethod: result := 'Method';
 267     tkSString: result := 'ShortString';
 268     tkLString: result := 'LString';
 269     tkAString: result := 'AnsiString';
 270     tkWString: result := 'WideString';
 271     tkVariant: result := 'Variant';
 272     tkArray: result := 'Array';
 273     tkRecord: result := 'Record';
 274     tkInterface: result := 'Interface';
 275     tkClass: result := 'Class';
 276     tkObject: result := 'Object';
 277     tkWChar: result := 'WideChar';
 278     tkBool: result := 'Boolean';
 279     tkInt64: result := 'Int64';
 280     tkQWord: result := 'UInt64';
 281     tkDynArray: result := 'DynArray';
 282     tkInterfaceRaw: result := 'InterfaceRaw';
 283     tkProcVar: result := 'ProcVar';
 284     tkUString: result := 'UString';
 285     tkUChar: result := 'UChar';
 286     tkHelper: result := 'Helper';
 287     tkFile: result := 'File';
 288     tkClassRef: result := 'ClassRef';
 289     tkPointer: result := 'Pointer';
 290     else result := '<unknown>';
 291   end;
 292 end;
 293
 294
 295 // ////////////////////////////////////////////////////////////////////////// //
 296 (*
 297 procedure dumpPublishedProperties (obj: TObject);
 298 var
 299   pt: PTypeData;
 300   pi: PTypeInfo;
 301   i, j: Integer;
 302   pp: PPropList;
 303 begin
 304   if (obj = nil) then exit;
 305   //e_LogWritefln('Object of type ''%s'':', [obj.ClassName]);
 306   pi := obj.ClassInfo;
 307   pt := GetTypeData(pi);
 308   //e_LogWritefln('property count: %s', [pt.PropCount]);
 309   GetMem(pp, pt^.PropCount*sizeof(Pointer));
 310   try
 311     j := GetPropList(pi, [tkInteger, tkBool, tkSString, tkLString, tkAString, tkSet, tkEnumeration], pp);
 312     //e_LogWritefln('ordinal property count: %s', [j]);
 313     for i := 0 to j-1 do
 314     begin
 315       {
 316       if (typinfo.PropType(obj, pp^[i].name) in [tkSString, tkLString, tkAString]) then
 317       begin
 318         e_LogWritefln('  #%s: <%s>; type: %s; value: <%s>', [i+1, pp^[i].name, typeKind2Str(typinfo.PropType(obj, pp^[i].name)), GetStrProp(obj, pp^[i])]);
 319       end
 320       else if (typinfo.PropType(obj, pp^[i].name) = tkSet) then
 321       begin
 322         e_LogWritefln('  #%s: <%s>; type: %s; value: %s', [i+1, pp^[i].name, typeKind2Str(typinfo.PropType(obj, pp^[i].name)), GetSetProp(obj, pp^[i], true)]);
 323       end
 324       else if (typinfo.PropType(obj, pp^[i].name) = tkEnumeration) then
 325       begin
 326         e_LogWritefln('  #%s: <%s>; type: %s; value: <%s>', [i+1, pp^[i].name, typeKind2Str(typinfo.PropType(obj, pp^[i].name)), GetEnumProp(obj, pp^[i])]);
 327       end
 328       else
 329       begin
 330         e_LogWritefln('  #%s: <%s>; type: %s; value: %s', [i+1, pp^[i].name, typeKind2Str(typinfo.PropType(obj, pp^[i].name)), GetOrdProp(obj, pp^[i])]);
 331       end;
 332       }
 333     end;
 334   finally
 335     FreeMem(pp);
 336   end;
 337 end;
 338 *)
 339
 340
 341 // ////////////////////////////////////////////////////////////////////////// //
 342 constructor TPropHash.Create (aklass: TClass; const apfx: AnsiString='');
 343 var
 344   pi: PTypeInfo;
 345   pt: PTypeData;
 346   idx: Integer;
 347   n: AnsiString;
 348 begin
 349   mClass := aklass;
 350   mNames := THashStrInt.Create();
 351   pi := aklass.ClassInfo;
 352   pt := GetTypeData(pi);
 353   GetMem(pl, pt^.PropCount*sizeof(Pointer));
 354   pc := GetPropList(pi, [tkInteger, tkBool, tkSString, tkLString, tkAString, {tkSet,} tkEnumeration], pl);
 355   for idx := 0 to pc-1 do
 356   begin
 357     if (Length(apfx) > 0) then
 358     begin
 359       if (Length(pl^[idx].name) < Length(apfx)) then continue;
 360       n := pl^[idx].name;
 361       if (Copy(n, 1, Length(apfx)) <> apfx) then continue;
 362       Delete(n, 1, Length(apfx));
 363       mNames.put(n, idx);
 364     end
 365     else
 366     begin
 367       mNames.put(pl^[idx].name, idx);
 368     end;
 369   end;
 370 end;
 371
 372 destructor TPropHash.Destroy ();
 373 begin
 374   mNames.Free();
 375   mNames := nil;
 376   if (pl <> nil) then FreeMem(pl);
 377   pl := nil;
 378   pc := 0;
 379   mClass := nil;
 380 end;
 381
 382 function TPropHash.get (obj: TObject; const fldname: AnsiString; out v: Variant): Boolean;
 383 var
 384   idx: Integer;
 385 begin
 386   result := false;
 387   if mNames.get(fldname, idx) then
 388   begin
 389     result := true;
 390     case pl^[idx].PropType.Kind of
 391       tkSString, tkLString, tkAString: v := GetStrProp(obj, pl^[idx]);
 392       tkEnumeration: v := GetEnumProp(obj, pl^[idx]);
 393       tkBool: if (GetOrdProp(obj, pl^[idx]) = 0) then v := false else v := true;
 394       tkInteger, tkChar: v := LongInt(GetOrdProp(obj, pl^[idx]));
 395       //tkFloat: result := 'Float';
 396       //tkClass: result := 'Class';
 397       //tkInt64: result := 'Int64';
 398       //tkClassRef: result := 'ClassRef';
 399       else result := false;
 400     end;
 401     if result then exit;
 402   end;
 403   v := Unassigned;
 404 end;
 405
 406 function TPropHash.put (obj: TObject; const fldname: AnsiString; var v: Variant): Boolean;
 407 var
 408   idx: Integer;
 409 begin
 410   result := false;
 411   if mNames.get(fldname, idx) then
 412   begin
 413     result := true;
 414     case pl^[idx].PropType.Kind of
 415       tkSString, tkLString, tkAString: SetStrProp(obj, pl^[idx], VarToStr(v));
 416       tkEnumeration: SetEnumProp(obj, pl^[idx], VarToStr(v));
 417       tkBool: if TExprBase.coerce2bool(v) then SetOrdProp(obj, pl^[idx], 1) else SetOrdProp(obj, pl^[idx], 0);
 418       tkInteger, tkChar: SetOrdProp(obj, pl^[idx], TExprBase.toInt(v));
 419       //tkFloat: result := 'Float';
 420       //tkClass: result := 'Class';
 421       //tkInt64: result := 'Int64';
 422       //tkClassRef: result := 'ClassRef';
 423       else result := false;
 424     end;
 425     if result then exit;
 426   end;
 427 end;
 428
 429
 430 // ////////////////////////////////////////////////////////////////////////// //
 431 class procedure TExprScope.error (const amsg: AnsiString); begin raise TExomaException.Create(amsg); end;
 432 class procedure TExprScope.errorfmt (const afmt: AnsiString; const args: array of const); begin raise TExomaException.CreateFmt(afmt, args); end;
 433
 434 function TExprScope.getObj (const aname: AnsiString): TObject; begin result := nil; errorfmt('unknown object ''%s''', [aname]); end;
 435 function TExprScope.getField (obj: TObject; const afldname: AnsiString): Variant; begin result := Unassigned; errorfmt('unknown field ''%s''', [afldname]); end;
 436 procedure TExprScope.setField (obj: TObject; const afldname: AnsiString; var aval: Variant); begin errorfmt('unknown field ''%s''', [afldname]); end;
 437
 438
 439 // ////////////////////////////////////////////////////////////////////////// //
 440 class procedure TExprBase.error (const amsg: AnsiString); begin raise TExomaException.Create(amsg); end;
 441 class procedure TExprBase.errorfmt (const afmt: AnsiString; const args: array of const); begin raise TExomaException.CreateFmt(afmt, args); end;
 442
 443 class procedure TExprBase.parseError (pr: TTextParser; const amsg: AnsiString); begin raise TExomaParseException.Create(pr, amsg); end;
 444 class procedure TExprBase.parseErrorFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const); begin raise TExomaParseException.CreateFmt(pr, afmt, args); end;
 445
 446 class function TExprBase.coerce2bool (var v0: Variant): Boolean;
 447 begin
 448   case varType(v0) of
 449     varEmpty: result := false;
 450     varNull: result := false;
 451     varSingle: result := (Single(v0) <> 0.0);
 452     varDouble: result := (Double(v0) <> 0.0);
 453     varString: result := (Length(AnsiString(v0)) <> 0);
 454     varBoolean: result := Boolean(v0);
 455     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := (LongInt(v0) <> 0);
 456     varInt64: result := (Int64(v0) <> 0);
 457     varQWord: result := (UInt64(v0) <> 0);
 458     else begin result := false; error('can''t coerce type to boolean'); end;
 459   end;
 460 end;
 461
 462 class function TExprBase.isFloat (var v: Variant): Boolean; inline;
 463 begin
 464   case varType(v) of
 465     varSingle, varDouble: result := true;
 466     else result := false;
 467   end;
 468 end;
 469
 470 class function TExprBase.isInt (var v: Variant): Boolean; inline;
 471 begin
 472   case varType(v) of
 473     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := true;
 474     else result := false;
 475   end;
 476 end;
 477
 478 class function TExprBase.isBool (var v: Variant): Boolean; inline;
 479 begin
 480   result := (varType(v) = varBoolean);
 481 end;
 482
 483 class function TExprBase.isStr (var v: Variant): Boolean; inline;
 484 begin
 485   result := (varType(v) = varString);
 486 end;
 487
 488 class function TExprBase.toInt (var v: Variant): LongInt;
 489 begin
 490   case varType(v) of
 491     varSingle: result := trunc(Single(v));
 492     varDouble: result := trunc(Double(v));
 493     varBoolean: if Boolean(v) then result := 1 else result := 0;
 494     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := LongInt(v);
 495     varInt64: result := LongInt(Int64(v));
 496     else begin result := 0; TExprBase.error('can''t coerce type to integer'); end;
 497   end;
 498 end;
 499
 500 procedure TExprBase.assign (scope: TExprScope; var v: Variant); begin error('not an lvalue'); end;
 501
 502
 503 // ////////////////////////////////////////////////////////////////////////// //
 504 constructor TExprStatList.Create (); begin mList := nil; end;
 505 destructor TExprStatList.Destroy (); var f: Integer; begin for f := 0 to High(mList) do mList[f].Free(); mList := nil; end;
 506
 507 procedure TExprStatList.append (e: TExprBase);
 508 begin
 509   if (e <> nil) then
 510   begin
 511     SetLength(mList, Length(mList)+1);
 512     mList[High(mList)] := e;
 513   end;
 514 end;
 515
 516 function TExprStatList.value (scope: TExprScope): Variant;
 517 var
 518   f: Integer;
 519 begin
 520   result := false;
 521   for f := 0 to High(mList) do result := mList[f].value(scope);
 522 end;
 523 function TExprStatList.toString (): AnsiString;
 524 var
 525   f: Integer;
 526 begin
 527   result := '';
 528   for f := 0 to High(mList) do result += mList[f].toString()+';';
 529 end;
 530 function TExprStatList.clone (): TExprBase;
 531 var
 532   r: TExprStatList;
 533   f: Integer;
 534 begin
 535   r := TExprStatList.Create();
 536   SetLength(r.mList, Length(mList));
 537   for f := 0 to High(mList) do r.mList[f] := nil;
 538   try
 539     for f := 0 to High(mList) do r.mList[f] := mList[f].clone();
 540   except
 541     r.Free();
 542   end;
 543   result := r;
 544 end;
 545
 546
 547 // ////////////////////////////////////////////////////////////////////////// //
 548 constructor TExprCond.Create (); begin mCond := nil; mTrue := nil; mFalse := nil; end;
 549 destructor TExprCond.Destroy (); begin mFalse.Free(); mTrue.Free(); mCond.Free(); end;
 550
 551 function TExprCond.value (scope: TExprScope): Variant;
 552 begin
 553   result := mCond.value(scope);
 554   if coerce2bool(result) then result := mTrue.value(scope) else result := mFalse.value(scope);
 555 end;
 556
 557 function TExprCond.toString (): AnsiString; begin result := '('+mCond.toString()+'?'+mTrue.toString()+':'+mFalse.toString()+')'; end;
 558
 559 function TExprCond.clone (): TExprBase;
 560 begin
 561   result := TExprCond.Create();
 562   TExprCond(result).mCond := mCond.clone();
 563   TExprCond(result).mTrue := mTrue.clone();
 564   TExprCond(result).mFalse := mFalse.clone();
 565 end;
 566
 567
 568 // ////////////////////////////////////////////////////////////////////////// //
 569 constructor TObjExpr.Create (const aval: AnsiString); begin mName := aval; end;
 570 function TObjExpr.value (scope: TExprScope): Variant; begin result := UInt64(PtrUInt(Pointer(scope.getObj(mName)))); end;
 571 function TObjExpr.toString (): AnsiString; begin result := mName; end;
 572 function TObjExpr.clone (): TExprBase; begin result := TObjExpr.Create(mName); end;
 573
 574
 575 // ////////////////////////////////////////////////////////////////////////// //
 576 constructor TLitExpr.Create (aval: Boolean); begin mValue := aval; end;
 577 constructor TLitExpr.Create (aval: LongInt); begin mValue := aval; end;
 578 constructor TLitExpr.Create (const aval: AnsiString); begin mValue := aval; end;
 579 constructor TLitExpr.Create (var v: Variant); begin mValue := v; end;
 580 function TLitExpr.value (scope: TExprScope): Variant; begin result := mValue; end;
 581 function TLitExpr.toString (): AnsiString; begin result := VarToStr(mValue); if isStr(mValue) then result := quoteStr(result); end;
 582 function TLitExpr.clone (): TExprBase; begin result := TLitExpr.Create(0); (result as TLitExpr).mValue := mValue; end;
 583
 584
 585 // ////////////////////////////////////////////////////////////////////////// //
 586 constructor TUnExpr.Create (aop0: TExprBase); begin mOp0 := aop0; end;
 587 destructor TUnExpr.Destroy (); begin mOp0.Free(); inherited; end;
 588 function TUnExpr.clone (): TExprBase; begin result := (self.ClassType.Create() as TUnExpr); (result as TUnExpr).mOp0 := mOp0.clone(); end;
 589
 590 function TUnExprNeg.value (scope: TExprScope): Variant;
 591 begin
 592   result := mOp0.value(scope);
 593   case varType(result) of
 594     varSingle: result := -Single(result);
 595     varDouble: result := -Double(result);
 596     varShortInt, varSmallInt, varInteger, varByte, varWord: result := -LongInt(result);
 597     varInt64: result := -Int64(result);
 598     varLongWord: result := -LongInt(result);
 599     else error('can''t negate non-number');
 600   end;
 601 end;
 602
 603 function TUnExprNeg.toString (): AnsiString; begin result := '-('+mOp0.toString()+')'; end;
 604
 605 function TUnExprNot.value (scope: TExprScope): Variant;
 606 begin
 607   result := mOp0.value(scope);
 608   result := not coerce2bool(result);
 609 end;
 610
 611 function TUnExprNot.toString (): AnsiString; begin result := '!('+mOp0.toString()+')'; end;
 612
 613
 614 // ////////////////////////////////////////////////////////////////////////// //
 615 constructor TDotExpr.Create (aop0: TExprBase; const afield: AnsiString);
 616 begin
 617   mOp0 := aop0;
 618   mField := afield;
 619 end;
 620
 621 function TDotExpr.value (scope: TExprScope): Variant;
 622 begin
 623   result := mOp0.value(scope);
 624   if (varType(result) <> varQWord) then errorfmt('can''t take field ''%s'' value of non-object', [mField]);
 625   result := scope.getField(TObject(PtrUInt(UInt64(result))), mField);
 626 end;
 627
 628 procedure TDotExpr.assign (scope: TExprScope; var v: Variant);
 629 var
 630   o: Variant;
 631 begin
 632   o := mOp0.value(scope);
 633   if (varType(o) <> varQWord) then errorfmt('can''t assign value to field ''%s'' of non-object', [mField]);
 634   scope.setField(TObject(PtrUInt(UInt64(o))), mField, v);
 635 end;
 636
 637 function TDotExpr.clone (): TExprBase; begin result := TDotExpr.Create(mOp0, mField); end;
 638
 639 function TDotExpr.toString (): AnsiString; begin result := mOp0.toString()+'.'+mField; end;
 640
 641
 642 // ////////////////////////////////////////////////////////////////////////// //
 643 constructor TBinExpr.Create (aop0, aop1: TExprBase); begin mOp0 := aop0; mOp1 := aop1; end;
 644 destructor TBinExpr.Destroy (); begin mOp1.Free(); mOp0.Free(); inherited; end;
 645 function TBinExpr.clone (): TExprBase; begin result := (self.ClassType.Create() as TBinExpr); (result as TBinExpr).mOp0 := mOp0.clone(); (result as TBinExpr).mOp1 := mOp1.clone(); end;
 646
 647 class procedure TBinExpr.coerce (var v0, v1: Variant);
 648 begin
 649   if (varType(v0) <> varType(v1)) then
 650   begin
 651     if isStr(v0) or isStr(v1) then
 652     begin
 653            if isFloat(v0) then v0 := formatstrf('%s', [Double(v0)])
 654       else if isInt(v0) then v0 := formatstrf('%s', [LongInt(v0)])
 655       else if isBool(v0) then v0 := formatstrf('%s', [Boolean(v0)])
 656       else if isStr(v0) then begin end
 657       else error('can''t coerce value to string');
 658            if isFloat(v1) then v1 := formatstrf('%s', [Double(v1)])
 659       else if isInt(v1) then v1 := formatstrf('%s', [LongInt(v1)])
 660       else if isBool(v1) then v1 := formatstrf('%s', [Boolean(v1)])
 661       else if isStr(v0) then begin end
 662       else error('can''t coerce value to string');
 663     end
 664     else if isFloat(v0) or isFloat(v1) then
 665     begin
 666            if isFloat(v0) or isInt(v0) then v0 := Double(v0)
 667       else if isBool(v0) then begin if Boolean(v0) then v0 := Double(1.0) else v0 := Double(0.0); end
 668       else error('can''t coerce value to float');
 669            if isFloat(v1) or isInt(v1) then v1 := Double(v1)
 670       else if isBool(v1) then begin if Boolean(v1) then v1 := Double(1.0) else v1 := Double(0.0); end
 671       else error('can''t coerce value to float');
 672     end
 673     else if isInt(v0) or isInt(v1) then
 674     begin
 675            if isBool(v0) then begin if Boolean(v0) then v0 := LongInt(1) else v0 := LongInt(0); end
 676       else if isFloat(v0) then v0 := LongInt(trunc(Double(v0)))
 677       else if isInt(v0) then begin end
 678       else error('can''t coerce value to integer');
 679            if isBool(v1) then begin if Boolean(v1) then v1 := LongInt(1) else v1 := LongInt(0); end
 680       else if isFloat(v1) then v1 := LongInt(trunc(Double(v1)))
 681       else if isInt(v1) then begin end
 682       else error('can''t coerce value to integer');
 683     end
 684     else
 685     begin
 686       error('can''t operate with value of invalid type');
 687     end;
 688   end;
 689 end;
 690
 691
 692 // ////////////////////////////////////////////////////////////////////////// //
 693 function TBinExprAdd.value (scope: TExprScope): Variant;
 694 var
 695   r1: Variant;
 696 begin
 697   result := mOp0.value(scope);
 698   r1 := mOp1.value(scope);
 699   coerce(result, r1);
 700   case varType(result) of
 701     varSingle, varDouble: result := Double(result)+Double(r1);
 702     varString: result := AnsiString(result)+AnsiString(r1);
 703     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := LongInt(result)+LongInt(r1);
 704     varInt64: result := Int64(result)+Int64(r1);
 705     else error('can''t add non-numbers and non-strings');
 706   end;
 707 end;
 708 function TBinExprAdd.toString (): AnsiString; begin result := '('+mOp0.toString()+'+'+mOp1.toString+')'; end;
 709
 710 function TBinExprSub.value (scope: TExprScope): Variant;
 711 var
 712   r1: Variant;
 713 begin
 714   result := mOp0.value(scope);
 715   r1 := mOp1.value(scope);
 716   coerce(result, r1);
 717   case varType(result) of
 718     varSingle, varDouble: result := Double(result)-Double(r1);
 719     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := LongInt(result)-LongInt(r1);
 720     varInt64: result := Int64(result)-Int64(r1);
 721     else error('can''t subtract non-numbers');
 722   end;
 723 end;
 724 function TBinExprSub.toString (): AnsiString; begin result := '('+mOp0.toString()+'-'+mOp1.toString+')'; end;
 725
 726 function TBinExprMul.value (scope: TExprScope): Variant;
 727 var
 728   r1: Variant;
 729 begin
 730   result := mOp0.value(scope);
 731   r1 := mOp1.value(scope);
 732   coerce(result, r1);
 733   case varType(result) of
 734     varSingle, varDouble: result := Double(result)*Double(r1);
 735     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := LongInt(result)*LongInt(r1);
 736     varInt64: result := Int64(result)*Int64(r1);
 737     else error('can''t multiply non-numbers');
 738   end;
 739 end;
 740 function TBinExprMul.toString (): AnsiString; begin result := '('+mOp0.toString()+'*'+mOp1.toString+')'; end;
 741
 742 function TBinExprDiv.value (scope: TExprScope): Variant;
 743 var
 744   r1: Variant;
 745 begin
 746   result := mOp0.value(scope);
 747   r1 := mOp1.value(scope);
 748   coerce(result, r1);
 749   case varType(result) of
 750     varSingle, varDouble: result := Double(result)/Double(r1);
 751     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := LongInt(result) div LongInt(r1);
 752     varInt64: result := Int64(result) div Int64(r1);
 753     else error('can''t divide non-numbers');
 754   end;
 755 end;
 756 function TBinExprDiv.toString (): AnsiString; begin result := '('+mOp0.toString()+'/'+mOp1.toString+')'; end;
 757
 758 function TBinExprMod.value (scope: TExprScope): Variant;
 759 var
 760   r1: Variant;
 761 begin
 762   result := mOp0.value(scope);
 763   r1 := mOp1.value(scope);
 764   coerce(result, r1);
 765   case varType(result) of
 766     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := LongInt(result) mod LongInt(r1);
 767     varInt64: result := Int64(result) mod Int64(r1);
 768     else error('can''t do modulo on non-numbers');
 769   end;
 770 end;
 771 function TBinExprMod.toString (): AnsiString; begin result := '('+mOp0.toString()+'%'+mOp1.toString+')'; end;
 772
 773 function TBinExprLogAnd.value (scope: TExprScope): Variant;
 774 begin
 775   result := mOp0.value(scope);
 776   if not coerce2bool(result) then begin result := false; exit; end;
 777   result := mOp1.value(scope);
 778   result := coerce2bool(result);
 779 end;
 780 function TBinExprLogAnd.toString (): AnsiString; begin result := '('+mOp0.toString()+'&&'+mOp1.toString+')'; end;
 781
 782 function TBinExprLogOr.value (scope: TExprScope): Variant;
 783 begin
 784   result := mOp0.value(scope);
 785   if coerce2bool(result) then begin result := true; exit; end;
 786   result := mOp1.value(scope);
 787   result := coerce2bool(result);
 788 end;
 789 function TBinExprLogOr.toString (): AnsiString; begin result := '('+mOp0.toString()+'||'+mOp1.toString+')'; end;
 790
 791 function TBinExprCmpLess.value (scope: TExprScope): Variant;
 792 var
 793   r1: Variant;
 794 begin
 795   result := mOp0.value(scope);
 796   r1 := mOp1.value(scope);
 797   coerce(result, r1);
 798   case varType(result) of
 799     varSingle, varDouble: result := Boolean(Double(result) < Double(r1));
 800     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := Boolean(LongInt(result) < LongInt(r1));
 801     varInt64: result := Boolean(Int64(result) < Int64(r1));
 802     varString: result := Boolean(AnsiString(result) < AnsiString(r1));
 803     else error('can''t compare non-numbers and non-strings');
 804   end;
 805 end;
 806 function TBinExprCmpLess.toString (): AnsiString; begin result := '('+mOp0.toString()+'<'+mOp1.toString+')'; end;
 807
 808 function TBinExprCmpGreat.value (scope: TExprScope): Variant;
 809 var
 810   r1: Variant;
 811 begin
 812   result := mOp0.value(scope);
 813   r1 := mOp1.value(scope);
 814   coerce(result, r1);
 815   case varType(result) of
 816     varSingle, varDouble: result := Boolean(Double(result) > Double(r1));
 817     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := Boolean(LongInt(result) > LongInt(r1));
 818     varInt64: result := Boolean(Int64(result) > Int64(r1));
 819     varString: result := Boolean(AnsiString(result) > AnsiString(r1));
 820     else error('can''t compare non-numbers and non-strings');
 821   end;
 822 end;
 823 function TBinExprCmpGreat.toString (): AnsiString; begin result := '('+mOp0.toString()+'>'+mOp1.toString+')'; end;
 824
 825 function TBinExprCmpLessEqu.value (scope: TExprScope): Variant;
 826 var
 827   r1: Variant;
 828 begin
 829   result := mOp0.value(scope);
 830   r1 := mOp1.value(scope);
 831   coerce(result, r1);
 832   case varType(result) of
 833     varSingle, varDouble: result := Boolean(Double(result) <= Double(r1));
 834     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := Boolean(LongInt(result) <= LongInt(r1));
 835     varInt64: result := Boolean(Int64(result) <= Int64(r1));
 836     varString: result := Boolean(AnsiString(result) <= AnsiString(r1));
 837     else error('can''t compare non-numbers and non-strings');
 838   end;
 839 end;
 840 function TBinExprCmpLessEqu.toString (): AnsiString; begin result := '('+mOp0.toString()+'<='+mOp1.toString+')'; end;
 841
 842 function TBinExprCmpGreatEqu.value (scope: TExprScope): Variant;
 843 var
 844   r1: Variant;
 845 begin
 846   result := mOp0.value(scope);
 847   r1 := mOp1.value(scope);
 848   coerce(result, r1);
 849   case varType(result) of
 850     varSingle, varDouble: result := Boolean(Double(result) >= Double(r1));
 851     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := Boolean(LongInt(result) >= LongInt(r1));
 852     varInt64: result := Boolean(Int64(result) >= Int64(r1));
 853     varString: result := Boolean(AnsiString(result) >= AnsiString(r1));
 854     else error('can''t compare non-numbers and non-strings');
 855   end;
 856 end;
 857 function TBinExprCmpGreatEqu.toString (): AnsiString; begin result := '('+mOp0.toString()+'>='+mOp1.toString+')'; end;
 858
 859 function TBinExprCmpEqu.value (scope: TExprScope): Variant;
 860 var
 861   r1: Variant;
 862 begin
 863   result := mOp0.value(scope);
 864   r1 := mOp1.value(scope);
 865   coerce(result, r1);
 866   case varType(result) of
 867     varSingle, varDouble: result := Boolean(Double(result) = Double(r1));
 868     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := Boolean(LongInt(result) = LongInt(r1));
 869     varInt64: result := Boolean(Int64(result) = Int64(r1));
 870     varString: result := Boolean(AnsiString(result) = AnsiString(r1));
 871     varBoolean: result := (Boolean(result) = Boolean(r1));
 872     varQWord: result := (UInt64(result) = UInt64(r1));
 873     else error('can''t compare non-numbers and non-strings');
 874   end;
 875 end;
 876 function TBinExprCmpEqu.toString (): AnsiString; begin result := '('+mOp0.toString()+'=='+mOp1.toString+')'; end;
 877
 878 function TBinExprCmpNotEqu.value (scope: TExprScope): Variant;
 879 var
 880   r1: Variant;
 881 begin
 882   result := mOp0.value(scope);
 883   r1 := mOp1.value(scope);
 884   coerce(result, r1);
 885   case varType(result) of
 886     varSingle, varDouble: result := Boolean(Double(result) <> Double(r1));
 887     varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord: result := Boolean(LongInt(result) <> LongInt(r1));
 888     varInt64: result := Boolean(Int64(result) <> Int64(r1));
 889     varString: result := Boolean(AnsiString(result) <> AnsiString(r1));
 890     varBoolean: result := (Boolean(result) <> Boolean(r1));
 891     varQWord: result := (UInt64(result) <> UInt64(r1));
 892     else error('can''t compare non-numbers and non-strings');
 893   end;
 894 end;
 895 function TBinExprCmpNotEqu.toString (): AnsiString; begin result := '('+mOp0.toString()+'<>'+mOp1.toString+')'; end;
 896
 897
 898 // ////////////////////////////////////////////////////////////////////////// //
 899 function TBinAssign.value (scope: TExprScope): Variant;
 900 begin
 901   result := mOp1.value(scope);
 902   mOp0.assign(scope, result);
 903 end;
 904
 905 function TBinAssign.toString (): AnsiString; begin result := mOp0.toString()+'='+mOp1.toString(); end;
 906
 907
 908 // ////////////////////////////////////////////////////////////////////////// //
 909 class function TExprBase.parse (clist: TExprConstList; const str: AnsiString; allowAssign: Boolean=false): TExprBase;
 910 var
 911   pr: TTextParser;
 912 begin
 913   pr := TStrTextParser.Create(str);
 914   try
 915     result := parse(clist, pr, allowAssign);
 916     if (pr.tokType <> pr.TTEOF) then begin result.Free(); parseError(pr, 'extra code in expression'); end;
 917   finally
 918     pr.Free();
 919   end;
 920 end;
 921
 922 class function TExprBase.parseStatList (clist: TExprConstList; const str: AnsiString): TExprBase;
 923 var
 924   pr: TTextParser = nil;
 925   r: TExprStatList = nil;
 926   e: TExprBase = nil;
 927 begin
 928   pr := TStrTextParser.Create(str);
 929   if (pr.tokType = pr.TTEOF) then begin pr.Free(); result := nil; exit; end;
 930   r := TExprStatList.Create();
 931   result := nil;
 932   try
 933     try
 934       while true do
 935       begin
 936         while pr.eatDelim(';') do begin end;
 937         if (pr.tokType = pr.TTEOF) then break;
 938         e := parse(clist, pr, true);
 939         if (e = nil) then break;
 940         //writeln(': ', e.toString());
 941         r.append(e);
 942         if (pr.tokType = pr.TTEOF) then break;
 943         //writeln('tt=', pr.tokType, ' <', pr.tokStr, '>');
 944         //writeln(r.toString());
 945         pr.expectDelim(';');
 946       end;
 947       result := r;
 948       r := nil;
 949     except
 950       on e: TExomaException do
 951         raise TExomaParseException.Create(pr, e.message);
 952       on e: Exception do
 953         raise TExomaParseException.Create(pr, e.message);
 954       else
 955         raise;
 956     end;
 957   finally
 958     r.Free();
 959     pr.Free();
 960   end;
 961 end;
 962
 963
 964 class function TExprBase.parse (clist: TExprConstList; pr: TTextParser; allowAssign: Boolean=false): TExprBase;
 965
 966   function expr (): TExprBase; forward;
 967
 968   function doTerm (): TExprBase;
 969   var
 970     id: AnsiString;
 971     v: Variant;
 972   begin
 973     result := nil;
 974     try
 975       if pr.eatDelim('(') then begin result := expr(); pr.expectDelim(')'); exit; end;
 976       if pr.eatDelim('!') then begin result := doTerm(); result := TUnExprNot.Create(result); exit; end;
 977       if pr.eatDelim('+') then begin result := doTerm(); exit; end;
 978       if pr.eatDelim('-') then begin result := doTerm(); result := TUnExprNeg.Create(result); exit; end;
 979       if (pr.tokType = pr.TTInt) then begin result := TLitExpr.Create(pr.expectInt()); exit; end;
 980       if (pr.tokType = pr.TTStr) then begin result := TLitExpr.Create(pr.expectStr(true)); exit; end;
 981       if (pr.tokType = pr.TTId) then
 982       begin
 983         if (pr.tokStr = 'true') then begin result := TLitExpr.Create(true); pr.skipToken(); exit; end;
 984         if (pr.tokStr = 'false') then begin result := TLitExpr.Create(false); pr.skipToken(); exit; end;
 985         if (CompareText(pr.tokStr, 'true') = 0) or (CompareText(pr.tokStr, 'false') = 0) then parseError(pr, '`true` and `false` are case-sensitive');
 986         id := pr.expectId();
 987         if (clist <> nil) then
 988         begin
 989           if clist.get(id, v) then
 990           begin
 991             result := TLitExpr.Create(v);
 992             exit;
 993           end;
 994           if not clist.valid(id) then parseErrorFmt(pr, 'unknown identifier ''%s''', [id]);
 995         end;
 996         result := TObjExpr.Create(id);
 997         while (pr.tokType = pr.TTDelim) and (pr.tokChar = '.') do
 998         begin
 999           pr.skipToken();
1000           result := TDotExpr.Create(result, pr.expectId());
1001         end;
1002         exit;
1003       end;
1004     except
1005       result.Free();
1006       raise;
1007     end;
1008     parseError(pr, 'invalid term');
1009   end;
1010
1011   function doMulDiv (): TExprBase;
1012   begin
1013     result := doTerm();
1014     try
1015       while true do
1016       begin
1017              if pr.eatDelim('*') then result := TBinExprMul.Create(result, doTerm())
1018         else if pr.eatDelim('/') then result := TBinExprDiv.Create(result, doTerm())
1019         else if pr.eatDelim('%') then result := TBinExprMod.Create(result, doTerm())
1020         else break;
1021       end;
1022     except
1023       result.Free();
1024       raise;
1025     end;
1026   end;
1027
1028   function doPlusMinus (): TExprBase;
1029   begin
1030     result := doMulDiv();
1031     try
1032       while true do
1033       begin
1034              if pr.eatDelim('+') then result := TBinExprAdd.Create(result, doMulDiv())
1035         else if pr.eatDelim('-') then result := TBinExprSub.Create(result, doMulDiv())
1036         else break;
1037       end;
1038     except
1039       result.Free();
1040       raise;
1041     end;
1042   end;
1043
1044   function doCmp (): TExprBase;
1045   begin
1046     result := doPlusMinus();
1047     try
1048       while true do
1049       begin
1050              if pr.eatDelim('<') then result := TBinExprCmpLess.Create(result, doPlusMinus())
1051         else if pr.eatDelim('>') then result := TBinExprCmpGreat.Create(result, doPlusMinus())
1052         else if pr.eatTT(pr.TTLessEqu) then result := TBinExprCmpLessEqu.Create(result, doPlusMinus())
1053         else if pr.eatTT(pr.TTGreatEqu) then result := TBinExprCmpGreatEqu.Create(result, doPlusMinus())
1054         else break;
1055       end;
1056     except
1057       result.Free();
1058       raise;
1059     end;
1060   end;
1061
1062   function doCmpEqu (): TExprBase;
1063   begin
1064     result := doCmp();
1065     try
1066       while true do
1067       begin
1068              if pr.eatTT(pr.TTEqu) then result := TBinExprCmpEqu.Create(result, doCmp())
1069         else if pr.eatTT(pr.TTNotEqu) then result := TBinExprCmpNotEqu.Create(result, doCmp())
1070         else break;
1071       end;
1072     except
1073       result.Free();
1074       raise;
1075     end;
1076   end;
1077
1078   function doLogAnd (): TExprBase;
1079   begin
1080     result := doCmpEqu();
1081     try
1082       while true do
1083       begin
1084         if pr.eatTT(pr.TTLogAnd) then result := TBinExprLogAnd.Create(result, doCmpEqu()) else break;
1085       end;
1086     except
1087       result.Free();
1088       raise;
1089     end;
1090   end;
1091
1092   function doLogOr (): TExprBase;
1093   begin
1094     result := doLogAnd();
1095     try
1096       while true do
1097       begin
1098         if pr.eatTT(pr.TTLogOr) then result := TBinExprLogOr.Create(result, doLogAnd()) else break;
1099       end;
1100     except
1101       result.Free();
1102       raise;
1103     end;
1104   end;
1105
1106   // funcall, [], dot
1107   // !, ~
1108   // *, /, %
1109   // +, -
1110   // <<, >>
1111   // <, <=, >, >=
1112   // ==, !=
1113   // &
1114   // ^
1115   // |
1116   // &&
1117   // ||
1118
1119   function expr0 (): TExprBase;
1120   var
1121     neg: Boolean;
1122     e: TExprBase = nil;
1123     list: TExprStatList = nil;
1124   begin
1125     result := nil;
1126     try
1127       while true do
1128       begin
1129              if pr.eatDelim('-') then neg := true
1130         else if pr.eatDelim('+') then neg := false
1131         else neg := false;
1132         e := doLogOr();
1133         if neg then e := TUnExprNeg.Create(e);
1134         if allowAssign and pr.eatDelim('=') then e := TBinAssign.Create(e, expr());
1135         if not pr.eatDelim(',') then
1136         begin
1137           if (result = nil) then result := e else list.append(e);
1138           break;
1139         end;
1140         //assert(false);
1141         if (list = nil) then
1142         begin
1143           list := TExprStatList.Create();
1144           result := list;
1145         end;
1146         list.append(e);
1147         e := nil;
1148       end;
1149     except
1150       e.Free();
1151       list.Free();
1152     end;
1153   end;
1154
1155   function expr (): TExprBase;
1156   var
1157     c: TExprCond;
1158   begin
1159     result := expr0();
1160     // ternary
1161     if pr.eatDelim('?') then
1162     begin
1163       c := TExprCond.Create();
1164       c.mCond := result;
1165       try
1166         c.mTrue := expr();
1167         pr.expectDelim(':');
1168         c.mFalse := expr();
1169         result := c;
1170       except
1171         c.Free();
1172       end;
1173     end;
1174   end;
1175
1176 var
1177   oas: TTextParser.TOptions;
1178 begin
1179   if (pr = nil) or (pr.tokType = pr.TTEOF) then begin result := nil; exit; end;
1180   oas := pr.options;
1181   try
1182     pr.options := pr.options-[pr.TOption.SignedNumbers];
1183     try
1184       result := expr();
1185     finally
1186       pr.options := oas;
1187     end;
1188   except
1189     on e: TExomaException do
1190       raise TExomaParseException.Create(pr, e.message);
1191     on e: Exception do
1192       raise TExomaParseException.Create(pr, e.message);
1193     else
1194       raise;
1195   end;
1196 end;
1197
1198
1199 {
1200     varEmpty:
1201     varNull:
1202     varSingle:
1203     varDouble:
1204     varDecimal:
1205     varCurrency:
1206     varDate:
1207     varOleStr:
1208     varStrArg:
1209     varString:
1210     varDispatch:
1211     varBoolean:
1212     varVariant:
1213     varUnknown:
1214     varShortInt:
1215     varSmallint:
1216     varInteger:
1217     varInt64:
1218     varByte:
1219     varWord:
1220     varLongWord:
1221     varQWord:
1222     varError:
1223 }
1224 end.