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