dws2exprs.pas

script language

  protected
    function IsBooleanType(Typ: TSymbol): Boolean;
    function IsDateTimeType(Typ: TSymbol): Boolean;
    function IsFloatType(Typ: TSymbol): Boolean;
    function IsIntegerType(Typ: TSymbol): Boolean;
    function IsNumberType(Typ: TSymbol): Boolean;
    function IsStringType(Typ: TSymbol): Boolean;
    function IsVariantType(Typ: TSymbol): Boolean;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos);
    function Eval: Variant; virtual; abstract;
    procedure Initialize; virtual;
    function Optimize: TExpr; virtual;
    procedure TypeCheck; virtual;
    property Pos: TScriptPos read FPos;
    property Prog: TProgram read FProg;
    property Typ: TSymbol read FTyp write FTyp;
  end;

  // Does nothing! E. g.: "for x := 1 to 10 do {TNullExpr};"
  TNullExpr = class(TExpr)
    function Eval: Variant; override;
  end;

  // Encapsulates data
  TDataExpr = class(TExpr)
  private
    FIsWritable: Boolean;
    FOffset: Integer;
    function GetAddr: Integer; virtual;
    function GetData: TData; virtual; abstract;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Typ: TSymbol);
    procedure AddOffset(Delta: Integer);
    function Eval: Variant; override;
    procedure SetValue(const Value: Variant); virtual;
    procedure SetValueInt(Value: Integer);
    procedure AssignExpr(Right: TExpr); virtual;
    procedure AssignDataExpr(Right: TExpr); virtual;
    property Addr: Integer read GetAddr;
    property Data: TData read GetData;
    property IsWritable: Boolean read FIsWritable write FIsWritable;
    property Offset: Integer read FOffset;
  end;

  // Encapsulates a local variable (on the stack)
  TVarExpr = class(TDataExpr)
  private
    FDataSym: TDataSymbol;
    function GetAddr: Integer; override;
    function GetData: TData; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Typ: TSymbol; DataSym: TDataSymbol);
    procedure SetValue(const Value: Variant); override;
    function Eval: Variant; override;
    property DataSym: TDataSymbol read FDataSym;
  end;

  TVarParentExpr = class(TVarExpr)
  private
    FLevel: Integer;
    function GetAddr: Integer; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Typ: TSymbol; DataSym: TDataSymbol);
    procedure SetValue(const Value: Variant); override;
    function Eval: Variant; override;
  end;

  // Encapsulates a var parameter
  TVarParamExpr = class(TVarExpr)
  private
    FSymOffset: Integer;
    function GetAddr: Integer; override;
    function GetData: TData; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Typ: TSymbol; DataSym: TDataSymbol);
    procedure SetValue(const Value: Variant); override;
    function Eval: Variant; override;
  end;

  // Encapsulates a var parameter
  TVarParamParentExpr = class(TVarParamExpr)
  private
    FLevel: Integer;
    function GetAddr: Integer; override;
    function GetData: TData; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Typ: TSymbol; DataSym: TDataSymbol);
    procedure SetValue(const Value: Variant); override;
    function Eval: Variant; override;
  end;

  // A constant value (like 0, 3.14159, 'Hello' or true)
  TConstExpr = class(TDataExpr)
  private
    FData: TData;
    function GetData: TData; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Typ: TSymbol; Value:
      Variant); overload;
    constructor Create(Prog: TProgram; Pos: TScriptPos; Typ: TSymbol; Data: TData);
      overload;
    function Eval: Variant; override;
  end;

  TInitDataExpr = class(TExpr)
  private
    FExpr: TDataExpr;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Expr: TDataExpr);
    destructor Destroy; override;
    function Eval: Variant; override;
  end;

  TCustomArrayExpr = class(TDataExpr)
  private
    FBase: TDataExpr;
    FIndices: TExprList;
  protected
    function GetAddr: Integer; override;
    function GetData: TData; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Base: TDataExpr);
    destructor Destroy; override;
    procedure AddIndex(Expr: TExpr); virtual;
    function Optimize: TExpr; override;
    procedure Initialize; override;
    property Indices: TExprList read FIndices;
  end;

  // Array expressions: x[index0, index1, ...]
  TArrayExpr = class(TCustomArrayExpr)
  public
    procedure AddIndex(Expr: TExpr); override;
  end;

  // format(fmt_str, ---> ['test',1,3] <--- )
  TStaticArrayExpr = class(TCustomArrayExpr)
  protected
    function GetAddr: Integer; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Base: TDataExpr);
    procedure TypeCheck; override;
    function Eval: Variant; override;
    procedure AddIndex(Expr: TExpr); override;
    procedure UpdateTyp(ATyp: TSymbol);
  end;

  // length of dynamic arrays
  TArrayLengthExpr = class(TDataExpr)
  private
    FBase: TDataExpr;
  protected
    function GetData: TData; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Base: TDataExpr);
    destructor Destroy; override;
    procedure Initialize; override;
    function Eval: Variant; override;
  end;

  // Field expression: obj.Field
  TFieldExpr = class(TDataExpr)
  private
    FObjectExpr: TExpr;
    function GetData: TData; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Typ: TSymbol; FieldSym:
      TFieldSymbol; ObjExpr: TDataExpr);
    destructor Destroy; override;
    procedure Initialize; override;
  end;

  TPushExpr = class(TExpr)
  protected
    FStackAddr: Integer;
    FArgExpr: TExpr;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; StackAddr: Integer;
      ArgExpr: TExpr);
    procedure Execute; virtual; abstract;
    function Eval: Variant; override;
    property ArgExpr: TExpr read FArgExpr write FArgExpr;
  end;

  TPushAddrExpr = class(TPushExpr)
    procedure Execute; override;
  end;

  TPushResultExpr = class(TPushExpr)
    procedure Execute; override;
  end;

  TPushDataExpr = class(TPushExpr)
  private
    FParamSym: TSymbol;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; StackAddr: Integer;
      ArgExpr: TExpr; ParamSym: TSymbol);
    procedure Execute; override;
  end;

  // Function call: func(arg0, arg1, ...);
  TFuncExpr = class(TDataExpr)
  private
    FArgs: TExprList;
    FFunc: TFuncSymbol;
    FInitResultExpr: TExpr;
    FIsInstruction: Boolean;
    FPushExprs: TExprList;
    FHasResult: Boolean;
    FResultAddr: Integer;
    FCodeExpr : TDataExpr;
  protected
    function PostCall(ScriptObj: IScriptObj): Variant; virtual;
    function PreCall(var ScriptObj: IScriptObj): TFuncSymbol; virtual;
    function OptimizeExecutable: TExpr; virtual;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Func: TFuncSymbol;
      IsInstruction: Boolean = True; CodeExpr: TDataExpr = nil;
      IsWritable: Boolean = False);
    destructor Destroy; override;
    procedure AddArg(Arg: TExpr);
    procedure AddPushExprs;
    function Eval: Variant; override;
    function GetData: TData; override;
    function GetAddr: Integer; override;
    function Optimize: TExpr; override;
    function GetCode(Func : TFuncSymbol) : ICallable; virtual;
    procedure Initialize; override;
    procedure SetResultAddr(ResultAddr: Integer = -1);
    procedure TypeCheck; override;
    property Args: TExprList read FArgs;
    property FuncSym: TFuncSymbol read FFunc;
    property CodeExpr : TDataExpr read FCodeExpr;
  end;

  TFuncCodeExpr = class(TDataExpr)
  private
    FFuncExpr : TFuncExpr;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; FuncExpr: TFuncExpr);
    destructor Destroy; override;
    procedure TypeCheck; override;
    procedure AssignDataExpr(Right: TExpr); override;
    function Eval: Variant; override;
    function GetData: TData; override;
    function GetAddr: Integer; override;
    property FuncExpr : TFuncExpr read FFuncExpr;
  end;

  TMethodObjExpr = class(TDataExpr)
  private
    FBaseExpr : TDataExpr;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; BaseExpr: TDataExpr);
    function GetData: TData; override;
    function GetAddr: Integer; override;
  end;

  TConnectorCallExpr = class(TDataExpr)
  private
    FArgs: TExprList;
    FBaseExpr: TExpr;                    
    FConnectorArgs: TConnectorArgs;
    FConnectorCall: IConnectorCall;
    FConnectorParams: TConnectorParams;
    FIsInstruction: Boolean;
    FName: string;
    FResultData: TData;
    FIsIndex: Boolean;
    function GetData: TData; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Name: string; BaseExpr:
      TExpr; IsWritable: Boolean = True; IsIndex: Boolean = False);
    destructor Destroy; override;
    function AssignConnectorSym(ConnectorType: IConnectorType): Boolean;
    procedure AddArg(ArgExpr: TExpr);
    function Eval: Variant; override;
    procedure Initialize; override;
    function Optimize: TExpr; override;
  end;

  TConnectorReadExpr = class(TDataExpr)
  private
    FBaseExpr: TExpr;
    FConnectorMember: IConnectorMember;
    FName: string;
    FResultData: TData;
    function GetData: TData; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Name: string; BaseExpr:
      TExpr);
    destructor Destroy; override;
    function AssignConnectorSym(ConnectorType: IConnectorType): Boolean;
    function Eval: Variant; override;
    procedure Initialize; override;
    function Optimize: TExpr; override;
    property BaseExpr: TExpr write FBaseExpr;
  end;

  TConnectorWriteExpr = class(TExpr)
  private
    FBaseExpr: TExpr;
    FValueExpr: TExpr;
    FConnectorMember: IConnectorMember;
    FName: string;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Name: string; BaseExpr,
      ValueExpr: TExpr);
    destructor Destroy; override;
    function AssignConnectorSym(ConnectorType: IConnectorType): Boolean;
    function Eval: Variant; override;
    procedure Initialize; override;
    function Optimize: TExpr; override;
  end;

  // Call of static methods (not virtual)
  TMethodStaticExpr = class(TFuncExpr)
  private
    FBaseExpr: TDataExpr;
    FSelfAddr: Integer;
  protected
    function PreCall(var ScriptObj: IScriptObj): TFuncSymbol; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Func: TMethodSymbol;
      BaseExpr: TDataExpr; IsInstruction: Boolean = True;
      CodeExpr: TDataExpr = nil; IsWritable: Boolean = False);
    destructor Destroy; override;
    procedure Initialize; override;
    function Optimize: TExpr; override;
    property BaseExpr: TDataExpr read FBaseExpr;
  end;

  // Class methods
  TClassMethodStaticExpr = class(TMethodStaticExpr)
  protected
    function PreCall(var ScriptObj: IScriptObj): TFuncSymbol; override;
  end;

  TConstructorStaticExpr = class(TMethodStaticExpr)
  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);
    procedure TypeCheck; override;
    property ExternalObject: TObject read FExternalObject write FExternalObject;
  end;

  TDestructorStaticExpr = class(TMethodStaticExpr)
  end;

  TMethodVirtualExpr = class(TMethodStaticExpr)
  private
    FMethName: string;
  protected
    function FindVirtualMethod(ClassSym: TClassSymbol): TMethodSymbol;
    function PreCall(var ScriptObj: IScriptObj): TFuncSymbol; override;
    function OptimizeExecutable: TExpr; override;
  public
    constructor Create(Prog: TProgram; Pos: TScriptPos; Func: TMethodSymbol; Base:
      TDataExpr; IsInstruction: Boolean = True);
    property MethName: string read FMethName;
  end;

  // Call to Class method with class reference: TMyClass.ClassMethod(..)
  TClassMethodVirtualExpr = class(TMethodVirtualExpr)
  protected
    function PreCall(var ScriptObj: IScriptObj): TFuncSymbol; override;
  end;

  TClassMethodVirtualNameExpr = class(TMethodVirtualExpr)
  protected
    function PreCall(var ScriptObj: IScriptObj): TFuncSymbol; override;
    function OptimizeExecutable: TExpr; override;
  end;

  // Call to Class method with object reference: obj.ClassMethod(..)
  TClassMethodObjVirtualExpr = class(TMethodVirtualExpr)
  protected
    function PreCall(var ScriptObj: IScriptObj): TFuncSymbol; override;
  end;

  TClassMethodObjVirtualNameExpr = class(TMethodVirtualExpr)
  protected
    function PreCall(var ScriptObj: IScriptObj): TFuncSymbol; override;
    function OptimizeExecutable: TExpr; override;
  end;