dws2exprs.pas

script language

  TConstructorVirtualExpr = class(TMethodVirtualExpr)
  private
    FExternalObject: TObject;
  protected
    function PostCall(ScriptObj: IScriptObj): Variant; override;
    function PreCall(var ScriptObj: IScriptObj): TFuncSymbol; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Func: TMethodSymbol; Base:
      TDataExpr; IsInstruction: Boolean = True);
    property ExternalObject: TObject read FExternalObject write FExternalObject;
  end;

  TDestructorVirtualExpr = class(TMethodVirtualExpr)
  end;

  // left := right;
  TAssignExpr = class(TExpr)
  protected
    FLeft: TDataExpr;
    FRight: TExpr;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Left, Right: TExpr);
    destructor Destroy; override;
    function Eval: Variant; override;
    function Optimize: TExpr; override;
    procedure Initialize; override;
    procedure TypeCheck; override;
  end;

  // left := right;
  TAssignDataExpr = class(TAssignExpr)
  protected
    FSize: Integer;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Left, Right: TExpr);
    function Eval: Variant; override;
    function Optimize: TExpr; override;
  end;

  // statement; statement; statement;
  TBlockExpr = class(TExpr)
  private
    FStatements: TExprList;
    FTable: TSymbolTable;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos);
    destructor Destroy; override;
    procedure AddStatement(Expr: TExpr);
    function Eval: Variant; override;
    function Optimize: TExpr; override;
    procedure Initialize; override;
    property Table: TSymbolTable read FTable;
  end;

  TIncrExpr = class(TExpr)
  private
    FLeft: TDataExpr;
    FRight: TExpr;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Left, right: TExpr);
    destructor Destroy; override;
    function Eval: Variant; override;
    procedure Initialize; override;
    function Optimize: TExpr; override;
  end;

  // if FCond then FThen else FElse
  TIfExpr = class(TExpr)
    FCond: TExpr;
    FElse: TExpr;
    FThen: TExpr;
  public
    destructor Destroy; override;
    function Eval: Variant; override;
    procedure Initialize; override;
    procedure TypeCheck; override;
    function Optimize: TExpr; override;
  end;

  // Part of a case statement
  TCaseCondition = class
  private
    FOwnsTrueExpr: Boolean;
    FTrueExpr: TExpr;
    FValueExpr: TExpr;
  public
    constructor Create(ValueExpr: TExpr);
    destructor Destroy; override;
    procedure Initialize; virtual;
    function IsTrue(Value: Variant): Boolean; virtual; abstract;
    procedure Optimize; virtual;
    procedure TypeCheck(Typ: TSymbol); virtual; abstract;
    property TrueExpr: TExpr read FTrueExpr write FTrueExpr;
    property OwnsTrueExpr: Boolean read FOwnsTrueExpr write FOwnsTrueExpr;
  end;

  TCompareCaseCondition = class(TCaseCondition)
  private
    FCompareExpr: TExpr;
  public
    constructor Create(ValueExpr, CompareExpr: TExpr);
    destructor Destroy; override;
    procedure Initialize; override;
    function IsTrue(Value: Variant): Boolean; override;
    procedure Optimize; override;
    procedure TypeCheck(Typ: TSymbol); override;
  end;

  TRangeCaseCondition = class(TCaseCondition)
  private
    FFromExpr: TExpr;
    FToExpr: TExpr;
  public
    constructor Create(ValueExpr, FromExpr, ToExpr: TExpr);
    destructor Destroy; override;
    procedure Initialize; override;
    function IsTrue(Value: Variant): Boolean; override;
    procedure Optimize; override;
    procedure TypeCheck(Typ: TSymbol); override;
  end;

  // case FValueExpr of {CaseConditions} else FElseExpr end;
  TCaseExpr = class(TExpr)
  private
    FCaseConditions: TList;
    FElseExpr: TExpr;
    FValueExpr: TExpr;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos);
    destructor Destroy; override;
    function Eval: Variant; override;
    procedure Initialize; override;
    function Optimize: TExpr; override;
    procedure TypeCheck; override;
    property ValueExpr: TExpr read FValueExpr write FValueExpr;
    property CaseConditions: TList read FCaseConditions;
    property ElseExpr: TExpr read FElseExpr write FElseExpr;
  end;

  // for FVarExpr := FFromExpr to FToExpr do FDoExpr;
  TForExpr = class(TExpr)
  private
    FDoExpr: TExpr;
    FFromExpr: TExpr;
    FToExpr: TExpr;
    FVarExpr: TDataExpr;
    FIsUpWard: Boolean;
  public
    destructor Destroy; override;
    function Eval: Variant; override;
    procedure Initialize; override;
    function Optimize: TExpr; override;
    procedure TypeCheck; override;
    property DoExpr: TExpr read FDoExpr write FDoExpr;
    property FromExpr: TExpr read FFromExpr write FFromExpr;
    property ToExpr: TExpr read FToExpr write FToExpr;
    property IsUpward: Boolean read FIsUpWard write FIsUpWard;
    property VarExpr: TDataExpr read FVarExpr write FVarExpr;
  end;

  TLoopExpr = class(TExpr)
  private
    FCondExpr: TExpr;
    FLoopExpr: TExpr;
  public
    destructor Destroy; override;
    procedure Initialize; override;
    procedure TypeCheck; override;
    function Optimize: TExpr; override;
    property CondExpr: TExpr read FCondExpr write FCondExpr;
    property LoopExpr: TExpr read FLoopExpr write FLoopExpr;
  end;

  // while FCondExpr do FLoopExpr
  TWhileExpr = class(TLoopExpr)
  public
    function Eval: Variant; override;
  end;

  // repeat FLoopExpr while FCondExpr
  TRepeatExpr = class(TLoopExpr)
  public
    function Eval: Variant; override;
  end;

  TBreakExpr = class(TExpr)
  public
    function Eval: Variant; override;
  end;

  TExitExpr = class(TExpr)
  public
    function Eval: Variant; override;
  end;

  TContinueExpr = class(TExpr)
  public
    function Eval: Variant; override;
  end;

  // raise TExceptionClass.Create;
  TRaiseExpr = class(TExpr)
  private
    FExceptionExpr: TExpr;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; ExceptionExpr: TExpr);
    destructor Destroy; override;
    function Eval: Variant; override;
    procedure Initialize; override;
    procedure TypeCheck; override;
    function Optimize: TExpr; override;
  end;

  TExceptionExpr = class(TExpr)
  private
    FTryExpr: TExpr;
    FHandlerExpr: TExpr;
  public
    destructor Destroy; override;
    procedure Initialize; override;
    function Optimize: TExpr; override;
    property TryExpr: TExpr read FTryExpr write FTryExpr;
    property HandlerExpr: TExpr read FHandlerExpr write FHandlerExpr;
  end;

  // try FTryExpr except {FDoExprs}; else FElseExpr end;
  TExceptExpr = class(TExceptionExpr)
  private
    FDoExprs: TExprList;
    FElseExpr: TExpr;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos);
    destructor Destroy; override;
    function Eval: Variant; override;
    procedure Initialize; override;
    function Optimize: TExpr; override;
    property DoExprs: TExprList read FDoExprs write FDoExprs;
    property ElseExpr: TExpr read FElseExpr write FElseExpr;
  end;

  // try..except on FExceptionVar: FExceptionVar.Typ do FDoBlockExpr; ... end;
  TExceptDoExpr = class(TExpr)
  private
    FExceptionVar: TDataSymbol;
    FDoBlockExpr: TExpr;
  public
    destructor Destroy; override;
    function Eval: Variant; override;
    procedure Initialize; override;
    function Optimize: TExpr; override;
    property DoBlockExpr: TExpr read FDoBlockExpr write FDoBlockExpr;
    property ExceptionVar: TDataSymbol read FExceptionVar write FExceptionVar;
  end;

  // try FTryExpr finally FHandlerExpr end;
  TFinallyExpr = class(TExceptionExpr)
  public
    function Eval: Variant; override;
  end;

  TStringArraySetExpr = class(TExpr)
  private
    FStringExpr: TExpr;
    FIndexExpr: TExpr;
    FValueExpr: TExpr;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; StringExpr, IndexExpr, ValueExpr: TExpr);
    destructor Destroy; override;
    function Eval: Variant; override;
    procedure Initialize; override;
    function Optimize: TExpr; override;
  end;

  TUnaryOpExpr = class(TExpr)
  private
    FExpr: TExpr;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Expr: TExpr);
    destructor Destroy; override;
    procedure Initialize; override;
    function Optimize: TExpr; override;
    property Expr: TExpr read FExpr write FExpr;
  end;

  // left "op" right
  TBinaryOpExpr = class(TExpr)
  private
    FLeft: TExpr;
    FRight: TExpr;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Left, Right: TExpr);
    destructor Destroy; override;
    function Eval: Variant; override;
    procedure Initialize; override;
    function Optimize: TExpr; override;
    procedure TypeCheck; override;
    property Left: TExpr read FLeft write FLeft;
    property right: TExpr read FRight write FRight;
  end;

  TStringArrayOpExpr = class(TBinaryOpExpr)
    constructor Create(Prog: TProgram; Pos: TScriptPos; Left, Right: TExpr);
    function Eval: Variant; override;
    procedure TypeCheck; override;
  end;

  // obj is TMyClass
  TIsOpExpr = class(TBinaryOpExpr)
    constructor Create(Prog: TProgram; Pos: TScriptPos; Left, Right: TExpr);
    function Eval: Variant; override;
    procedure TypeCheck; override;
  end;

  // obj as TMyClass
  TAsOpExpr = class(TBinaryOpExpr)
    function Eval: Variant; override;
    procedure TypeCheck; override;
  end;

  // >, <, =, <=, >=, <>
  TRelOpExpr = class(TBinaryOpExpr)
    FRelOp: TRelOps;
    constructor Create(Prog: TProgram; Pos: TScriptPos; Left, Right: TExpr; RelOp:
      TRelOps);
    function Eval: Variant; override;
    procedure TypeCheck; override;
  end;

  // -x
  TNegExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
    procedure TypeCheck; override;
  end;

  TNumberOpExpr = class(TBinaryOpExpr)
    procedure TypeCheck; override;
  end;

  TNumberBooleanOpExpr = class(TBinaryOpExpr)
  protected
    FMode: (omBoolean, omInteger);
  public
    procedure TypeCheck; override;
  end;

  TNumberStringOpExpr = class(TBinaryOpExpr)
    procedure TypeCheck; override;
  end;

  // a + b
  TAddExpr = class(TNumberStringOpExpr)
    function Eval: Variant; override;
  end;

  // a - b
  TSubExpr = class(TNumberOpExpr)
    function Eval: Variant; override;
  end;

  // a * b
  TMultExpr = class(TNumberOpExpr)
    function Eval: Variant; override;
  end;

  // a / b
  TDivideExpr = class(TNumberOpExpr)
    function Eval: Variant; override;
  end;

  // a div b
  TDivExpr = class(TNumberOpExpr)
    function Eval: Variant; override;
  end;

  // a mod b
  TModExpr = class(TNumberOpExpr)
    function Eval: Variant; override;
  end;

  // not a
  TNotExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
    procedure TypeCheck; override;
  end;

  // a and b
  TAndExpr = class(TNumberBooleanOpExpr)
    function Eval: Variant; override;
  end;

  // a or b