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