{**********************************************************************}

{ }

{ "The contents of this file are subject to the Mozilla Public }

{ License Version 1.1 (the "License"); you may not use this }

{ file except in compliance with the License. You may obtain }

{ a copy of the License at http://www.mozilla.org/MPL/ }

{ }

{ Software distributed under the License is distributed on an }

{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express }

{ or implied. See the License for the specific language }

{ governing rights and limitations under the License. }

{ }

{ The Initial Developer of the Original Code is Matthias }

{ Ackermann. For other initial contributors, see contributors.txt }

{ Subsequent portions Copyright Creative IT. }

{ }

{ Current maintainer: Eric Grange }

{ }

{**********************************************************************}

unit dwsCoreExprs;

{$I dws.inc}

interface

uses

Classes, SysUtils,

dwsUtils, dwsXPlatform, dwsUnicode,

dwsDataContext, dwsCompilerContext, dwsExprList,

dwsSymbols, dwsErrors, dwsStrings, dwsConvExprs,

dwsStack, dwsExprs, dwsScriptSource,

dwsConstExprs, dwsTokenizer, dwsUnitSymbols;

type

TVarExpr = class (TDataExpr)

protected

FStackAddr : Integer;

FDataSym : TDataSymbol;

public

constructor Create(dataSym : TDataSymbol);

class function CreateTyped(context : TdwsCompilerContext; dataSym : TDataSymbol) : TVarExpr;

procedure Orphan(context : TdwsCompilerContext); override;

procedure AssignDataExpr(exec : TdwsExecution; DataExpr: TDataExpr); override;

procedure AssignExpr(exec : TdwsExecution; Expr: TTypedExpr); override;

procedure AssignValue(exec : TdwsExecution; const value : Variant); override;

procedure AssignValueAsInteger(exec : TdwsExecution; const value : Int64); override;

procedure AssignValueAsBoolean(exec : TdwsExecution; const value : Boolean); override;

procedure AssignValueAsFloat(exec : TdwsExecution; const value : Double); override;

procedure AssignValueAsString(exec : TdwsExecution; const value : String); override;

procedure AssignValueAsScriptObj(exec : TdwsExecution; const value : IScriptObj); override;

procedure EvalAsVariant(exec : TdwsExecution; var Result : Variant); override;

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

procedure GetRelativeDataPtr(exec : TdwsExecution; var result : IDataContext); override;

function IsWritable : Boolean; override;

function ReferencesVariable(varSymbol : TDataSymbol) : Boolean; override;

function SameDataExpr(expr : TTypedExpr) : Boolean; override;

function DataSymbol : TDataSymbol; override;

function SpecializeDataExpr(const context : ISpecializationContext) : TDataExpr; override;

property StackAddr : Integer read FStackAddr;

property DataSym : TDataSymbol read FDataSym write FDataSym;

end;

TBaseTypeVarExpr = class (TVarExpr)

public

procedure EvalAsVariant(exec : TdwsExecution; var Result : Variant); override;

procedure EvalAsInterface(exec : TdwsExecution; var result : IUnknown); override;

end;

TIntVarExpr = class (TBaseTypeVarExpr)

public

procedure AssignExpr(exec : TdwsExecution; Expr: TTypedExpr); override;

procedure AssignValue(exec : TdwsExecution; const Value: Variant); override;

procedure AssignValueAsInteger(exec : TdwsExecution; const Value: Int64); override;

procedure IncValue(exec : TdwsExecution; const value: Int64);

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

function EvalAsFloat(exec : TdwsExecution) : Double; override;

function EvalAsPInteger(exec : TdwsExecution) : PInt64; inline;

end;

TFloatVarExpr = class sealed (TBaseTypeVarExpr)

protected

public

procedure AssignExpr(exec : TdwsExecution; Expr: TTypedExpr); override;

procedure AssignValue(exec : TdwsExecution; const Value: Variant); override;

procedure AssignValueAsFloat(exec : TdwsExecution; const Value: Double); override;

function EvalAsFloat(exec : TdwsExecution) : Double; override;

end;

TStrVarExpr = class sealed (TBaseTypeVarExpr)

protected

public

procedure AssignExpr(exec : TdwsExecution; Expr: TTypedExpr); override;

procedure AssignValue(exec : TdwsExecution; const Value: Variant); override;

procedure AssignValueAsString(exec : TdwsExecution; const Value: String); override;

procedure AssignValueAsUnicodeString(exec : TdwsExecution; const Value: UnicodeString); inline;

procedure AssignValueAsWideChar(exec : TdwsExecution; aChar : WideChar);

function SetChar(exec : TdwsExecution; index : Integer; c : WideChar) : Boolean;

procedure EvalAsString(exec : TdwsExecution; var result : String); override;

procedure Append(exec : TdwsExecution; const value : String);

function EvalAsPString(exec : TdwsExecution) : PString; inline;

end;

TBoolVarExpr = class (TBaseTypeVarExpr)

protected

public

procedure AssignExpr(exec : TdwsExecution; Expr: TTypedExpr); override;

procedure AssignValue(exec : TdwsExecution; const Value: Variant); override;

procedure AssignValueAsBoolean(exec : TdwsExecution; const value : Boolean); override;

function EvalAsBoolean(exec : TdwsExecution) : Boolean; override;

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

end;

TObjectVarExpr = class (TBaseTypeVarExpr)

public

procedure AssignExpr(exec : TdwsExecution; Expr: TTypedExpr); override;

procedure EvalAsScriptObj(exec : TdwsExecution; var Result : IScriptObj); override;

procedure EvalAsScriptDynArray(exec : TdwsExecution; var result : IScriptDynArray); override;

end;

TSelfVarExpr = class (TVarExpr)

public

function IsWritable : Boolean; override;

end;

TSelfObjectVarExpr = class (TObjectVarExpr)

public

function IsWritable : Boolean; override;

end;

TVarParentExpr = class(TVarExpr)

protected

FScriptPos : TScriptPos;

FLevel: Integer;

public

constructor Create(const aScriptPos: TScriptPos; dataSym : TDataSymbol);

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

procedure GetRelativeDataPtr(exec : TdwsExecution; var result : IDataContext); override;

procedure EvalAsVariant(exec : TdwsExecution; var Result : Variant); override;

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

function EvalAsFloat(exec : TdwsExecution) : Double; override;

function ScriptPos : TScriptPos; override;

property Level : Integer read FLevel;

end;

TExternalVarExpr = class(TVarExpr)

public

function IsExternal : Boolean; override;

procedure EvalAsVariant(exec : TdwsExecution; var Result : Variant); override;

end;

// Encapsulates a lazy parameter

TLazyParamExpr = class(TTypedExpr)

private

FDataSym : TLazyParamSymbol;

FStackAddr : Integer;

FLevel : Integer;

public

constructor Create(context : TdwsCompilerContext; dataSym : TLazyParamSymbol);

procedure EvalAsVariant(exec : TdwsExecution; var Result : Variant); override;

function SameDataExpr(expr : TTypedExpr) : Boolean; override;

property DataSym : TLazyParamSymbol read FDataSym write FDataSym;

property StackAddr : Integer read FStackAddr write FStackAddr;

property Level : Integer read FLevel write FLevel;

end;

// Encapsulates a var parameter

TByRefParamExpr = class (TVarExpr)

public

constructor CreateFromVarExpr(expr : TVarExpr);

function GetVarParamDataAsPointer(exec : TdwsExecution) : Pointer; inline;

procedure GetVarParamData(exec : TdwsExecution; var result : IDataContext);

function GetVarParamEval(exec : TdwsExecution) : PVariant; inline;

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

procedure GetRelativeDataPtr(exec : TdwsExecution; var result : IDataContext); override;

procedure AssignDataExpr(exec : TdwsExecution; dataExpr: TDataExpr); override;

procedure AssignExpr(exec : TdwsExecution; Expr: TTypedExpr); override;

procedure AssignValue(exec : TdwsExecution; const Value: Variant); override;

procedure AssignValueAsInteger(exec : TdwsExecution; const value : Int64); override;

procedure AssignValueAsBoolean(exec : TdwsExecution; const value : Boolean); override;

procedure AssignValueAsFloat(exec : TdwsExecution; const value : Double); override;

procedure AssignValueAsString(exec : TdwsExecution; const value : String); override;

procedure AssignValueAsScriptObj(exec : TdwsExecution; const value : IScriptObj); override;

procedure EvalAsVariant(exec : TdwsExecution; var result : Variant); override;

procedure EvalAsInterface(exec : TdwsExecution; var result : IUnknown); override;

function EvalAsFloat(exec : TdwsExecution) : Double; override;

function SpecializeDataExpr(const context : ISpecializationContext) : TDataExpr; override;

end;

TVarParamExpr = class sealed (TByRefParamExpr)

public

function SpecializeDataExpr(const context : ISpecializationContext) : TDataExpr; override;

end;

TConstParamExpr = class sealed (TByRefParamExpr)

public

function IsWritable : Boolean; override;

function SpecializeDataExpr(const context : ISpecializationContext) : TDataExpr; override;

end;

// Encapsulates a var parameter

TByRefParentParamExpr = class(TByRefParamExpr)

protected

FLevel: Integer;

public

constructor Create(dataSym : TDataSymbol);

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

procedure AssignExpr(exec : TdwsExecution; Expr: TTypedExpr); override;

procedure EvalAsVariant(exec : TdwsExecution; var result : Variant); override;

function EvalAsFloat(exec : TdwsExecution) : Double; override;

end;

TVarParamParentExpr = class(TByRefParentParamExpr)

end;

TConstParamParentExpr = class(TByRefParentParamExpr)

public

function IsWritable : Boolean; override;

end;

// TResourceStringExpr

//

// Returns a localized version of a resourcestring

TResourceStringExpr = class sealed (TTypedExpr)

private

FResSymbol : TResourceStringSymbol;

FScriptPos : TScriptPos;

public

constructor Create(context : TdwsCompilerContext; const aScriptPos : TScriptPos; aRes : TResourceStringSymbol);

function ScriptPos : TScriptPos; override;

procedure EvalAsVariant(exec : TdwsExecution; var result : Variant); override;

procedure EvalAsString(exec : TdwsExecution; var result : String); override;

property ResSymbol : TResourceStringSymbol read FResSymbol;

end;

// Array expressions x[index]

TArrayExpr = class(TPosDataExpr)

protected

FBaseExpr : TDataExpr;

FIndexExpr : TTypedExpr;

FElementSize : Integer;

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

function GetBaseType : TTypeSymbol; override;

public

constructor Create(const aScriptPos: TScriptPos;

BaseExpr: TDataExpr; IndexExpr: TTypedExpr;

arraySymbol : TArraySymbol);

destructor Destroy; override;

procedure Orphan(context : TdwsCompilerContext); override;

function IsWritable : Boolean; override;

function SameDataExpr(expr : TTypedExpr) : Boolean; override;

property BaseExpr : TDataExpr read FBaseExpr;

property IndexExpr : TTypedExpr read FIndexExpr;

end;

EScriptOutOfBounds = class (EScriptError);

// Array expressions x[index] for static arrays

TStaticArrayExpr = class (TArrayExpr)

private

FLowBound : Integer;

FCount : Integer;

protected

function GetIndex(exec : TdwsExecution) : Integer; virtual;

function GetIsConstant : Boolean; override;

public

constructor Create(const aScriptPos: TScriptPos;

baseExpr : TDataExpr; indexExpr : TTypedExpr;

arraySymbol : TStaticArraySymbol);

function Optimize(context : TdwsCompilerContext) : TProgramExpr; override;

procedure AssignExpr(exec : TdwsExecution; expr : TTypedExpr); override;

procedure AssignValueAsInteger(exec : TdwsExecution; const value : Int64); override;

procedure AssignValueAsBoolean(exec : TdwsExecution; const value : Boolean); override;

procedure AssignValueAsFloat(exec : TdwsExecution; const value : Double); override;

procedure AssignValueAsString(exec : TdwsExecution; const value: String); override;

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

function EvalAsFloat(exec : TdwsExecution) : Double; override;

function EvalAsBoolean(exec : TdwsExecution) : Boolean; override;

procedure EvalAsVariant(exec : TdwsExecution; var result : Variant); override;

procedure EvalAsString(exec : TdwsExecution; var result : String); override;

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

property LowBound : Integer read FLowBound write FLowBound;

property Count : Integer read FCount write FCount;

end;

// Array expressions x[bool] for static arrays

TStaticArrayBoolExpr = class (TStaticArrayExpr)

protected

function GetIndex(exec : TdwsExecution) : Integer; override;

end;

// Array expressions x[index] for open arrays

TOpenArrayExpr = class(TArrayExpr)

public

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

function IsWritable : Boolean; override;

end;

// Array expressions: x[index0] for dynamic arrays

TDynamicArrayExpr = class(TArrayExpr)

protected

function EvalItem(exec : TdwsExecution; var dyn : IScriptDynArray) : PVariant;

public

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

function EvalAsFloat(exec : TdwsExecution) : Double; override;

procedure EvalAsVariant(exec : TdwsExecution; var result : Variant); override;

procedure EvalAsString(exec : TdwsExecution; var result : String); override;

function SpecializeDataExpr(const context : ISpecializationContext) : TDataExpr; override;

end;

// Array expressions: x[index0] for dynamic arrays where BaseExpr is a TObjectVarExpr

TDynamicArrayVarExpr = class sealed (TDynamicArrayExpr)

protected

function EvalItem(exec : TdwsExecution) : PVariant;

public

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

function EvalAsFloat(exec : TdwsExecution) : Double; override;

procedure EvalAsString(exec : TdwsExecution; var result : String); override;

function SpecializeDataExpr(const context : ISpecializationContext) : TDataExpr; override;

end;

// array[index]:=val for dynamic arrays

TDynamicArraySetExpr = class(TNoResultExpr)

private

FArrayExpr : TTypedExpr;

FIndexExpr : TTypedExpr;

FValueExpr : TTypedExpr;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

public

constructor Create(context : TdwsCompilerContext; const scriptPos : TScriptPos;

arrayExpr, indexExpr, valueExpr : TTypedExpr);

destructor Destroy; override;

procedure EvalNoResult(exec : TdwsExecution); override;

property ArrayExpr : TTypedExpr read FArrayExpr;

property IndexExpr : TTypedExpr read FIndexExpr;

property ValueExpr : TTypedExpr read FValueExpr;

end;

// array[index]:=val for dynamic arrays when ArrayExpr is TObjectVarExpr and size=1

TDynamicArraySetVarExpr = class(TDynamicArraySetExpr)

public

procedure EvalNoResult(exec : TdwsExecution); override;

end;

// array[index]:=val for dynamic arrays with elements larger than size = 1

TDynamicArraySetDataExpr = class(TDynamicArraySetExpr)

public

procedure EvalNoResult(exec : TdwsExecution); override;

end;

// Associative array x[key] for expressions

TAssociativeArrayGetExpr = class (TPosDataExpr)

protected

FBaseExpr : TDataExpr;

FKeyExpr : TTypedExpr;

FElementSize : Integer;

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

function GetBaseType : TTypeSymbol; override;

public

constructor Create(const aScriptPos: TScriptPos;

baseExpr: TDataExpr; keyExpr: TTypedExpr;

arraySymbol : TAssociativeArraySymbol);

destructor Destroy; override;

function IsWritable : Boolean; override;

function SameDataExpr(expr : TTypedExpr) : Boolean; override;

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

property BaseExpr : TDataExpr read FBaseExpr;

property KeyExpr : TTypedExpr read FKeyExpr;

end;

TAssociativeArraySetExpr = class (TNoResultExpr)

protected

FBaseExpr : TDataExpr;

FKeyExpr : TTypedExpr;

FValueExpr : TTypedExpr;

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

public

constructor Create(const aScriptPos: TScriptPos; baseExpr: TDataExpr;

keyExpr, valueExpr: TTypedExpr);

destructor Destroy; override;

procedure EvalNoResult(exec : TdwsExecution); override;

property BaseExpr : TDataExpr read FBaseExpr;

property KeyExpr : TTypedExpr read FKeyExpr;

property ValueExpr : TTypedExpr read FValueExpr;

end;

TAssociativeArrayContainsKeyExpr = class (TBooleanBinOpExpr)

public

function EvalAsBoolean(exec : TdwsExecution) : Boolean; override;

end;

// Record expression: record.member

TRecordExpr = class(TPosDataExpr)

protected

FBaseExpr : TDataExpr;

FMemberOffset : Integer;

FFieldSymbol : TFieldSymbol;

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

function GetIsConstant : Boolean; override;

public

constructor Create(const aScriptPos: TScriptPos; BaseExpr: TDataExpr;

fieldSymbol: TFieldSymbol);

destructor Destroy; override;

procedure Orphan(context : TdwsCompilerContext); override;

procedure AssignExpr(exec : TdwsExecution; Expr: TTypedExpr); override;

procedure AssignValueAsInteger(exec : TdwsExecution; const value : Int64); override;

procedure AssignValueAsBoolean(exec : TdwsExecution; const value : Boolean); override;

procedure AssignValueAsFloat(exec : TdwsExecution; const value : Double); override;

procedure AssignValueAsString(exec : TdwsExecution; const value: String); override;

procedure AssignValueAsScriptObj(exec : TdwsExecution; const value : IScriptObj); override;

function EvalAsBoolean(exec : TdwsExecution) : Boolean; override;

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

function EvalAsFloat(exec : TdwsExecution) : Double; override;

procedure EvalAsVariant(exec : TdwsExecution; var result : Variant); override;

procedure EvalAsString(exec : TdwsExecution; var result : String); override;

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

function SameDataExpr(expr : TTypedExpr) : Boolean; override;

function SpecializeDataExpr(const context : ISpecializationContext) : TDataExpr; override;

property BaseExpr : TDataExpr read FBaseExpr;

property MemberOffset : Integer read FMemberOffset;

property FieldSymbol : TFieldSymbol read FFieldSymbol;

function IsWritable : Boolean; override;

end;

// Record expression: record.member when BaseExpr is a TVarExpr

TRecordVarExpr = class(TRecordExpr)

private

FVarPlusMemberOffset : Integer;

public

constructor Create(const aScriptPos: TScriptPos; baseExpr: TVarExpr;

fieldSymbol : TFieldSymbol);

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

function EvalAsFloat(exec : TdwsExecution) : Double; override;

procedure EvalAsVariant(exec : TdwsExecution; var result : Variant); override;

procedure EvalAsString(exec : TdwsExecution; var result : String); override;

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

property VarPlusMemberOffset : Integer read FVarPlusMemberOffset write FVarPlusMemberOffset;

end;

TInitDataExpr = class sealed (TNoResultExpr)

protected

FExpr : TDataExpr;

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

public

constructor Create(context : TdwsCompilerContext; const aScriptPos: TScriptPos; Expr: TDataExpr);

destructor Destroy; override;

function SpecializeProgramExpr(const context : ISpecializationContext) : TProgramExpr; override;

procedure EvalNoResult(exec : TdwsExecution); override;

property Expr : TDataExpr read FExpr;

end;

// dynamic anonymous record

TDynamicRecordExpr = class(TPosDataExpr)

private

FAddr : Integer;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

public

constructor Create(context : TdwsCompilerContext; const aPos : TScriptPos;

recordTyp : TRecordSymbol);

procedure EvalNoResult(exec : TdwsExecution); override;

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

property Addr : Integer read FAddr;

end;

// Field expression: obj.Field

TFieldExpr = class(TPosDataExpr)

protected

FObjectExpr : TTypedExpr;

FFieldSym : TFieldSymbol;

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

function GetScriptObj(exec : TdwsExecution) : IScriptObj; inline;

public

constructor Create(const aScriptPos: TScriptPos;

fieldSym : TFieldSymbol; objExpr: TTypedExpr);

destructor Destroy; override;

procedure AssignValueAsInteger(exec : TdwsExecution; const value : Int64); override;

procedure AssignValueAsBoolean(exec : TdwsExecution; const value : Boolean); override;

procedure AssignValueAsFloat(exec : TdwsExecution; const value : Double); override;

procedure AssignValueAsString(exec : TdwsExecution; const value: String); override;

procedure AssignValueAsScriptObj(exec : TdwsExecution; const value : IScriptObj); override;

procedure EvalAsString(exec : TdwsExecution; var result : String); override;

procedure EvalAsVariant(exec : TdwsExecution; var Result : Variant); override;

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

function EvalAsFloat(exec : TdwsExecution) : Double; override;

function EvalAsBoolean(exec : TdwsExecution) : Boolean; override;

procedure EvalAsScriptObj(exec : TdwsExecution; var Result : IScriptObj); override;

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

function SameDataExpr(expr : TTypedExpr) : Boolean; override;

property ObjectExpr : TTypedExpr read FObjectExpr;

property FieldSym : TFieldSymbol read FFieldSym;

end;

// Field expression: obj.Field

TFieldVarExpr = class sealed (TFieldExpr)

protected

function GetPIScriptObj(exec : TdwsExecution) : PIScriptObj; inline;

public

procedure AssignValueAsInteger(exec : TdwsExecution; const value : Int64); override;

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

function EvalAsFloat(exec : TdwsExecution) : Double; override;

function EvalAsBoolean(exec : TdwsExecution) : Boolean; override;

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

function SpecializeDataExpr(const context : ISpecializationContext) : TDataExpr; override;

end;

TReadOnlyFieldExpr = class sealed (TFieldExpr)

public

constructor Create(const aScriptPos: TScriptPos;

fieldSym : TFieldSymbol; objExpr: TTypedExpr;

propertyType : TTypeSymbol);

function IsWritable: Boolean; override;

function SpecializeDataExpr(const context : ISpecializationContext) : TDataExpr; override;

end;

// length of dynamic arrays

TArrayLengthExpr = class (TUnaryOpIntExpr)

private

FDelta : Integer;

FCapture : Boolean;

public

constructor Create(context : TdwsCompilerContext; expr : TTypedExpr; captureExpr : Boolean); reintroduce; virtual;

destructor Destroy; override;

function SpecializeTypedExpr(const context : ISpecializationContext) : TTypedExpr; override;

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

property Delta : Integer read FDelta write FDelta;

end;

TArrayLengthExprClass = class of TArrayLengthExpr;

// length of an open array

TOpenArrayLengthExpr = class (TArrayLengthExpr)

public

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

end;

// length of an associative array

TAssociativeArrayLengthExpr = class(TUnaryOpIntExpr)

public

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

end;

// left[right] String read access

TStringArrayOpExpr = class(TStringBinOpExpr)

private

FScriptPos : TScriptPos;

public

constructor CreatePos(context : TdwsCompilerContext; const aScriptPos: TScriptPos; Left, Right: TTypedExpr);

procedure EvalAsString(exec : TdwsExecution; var result : String); override;

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

function ScriptPos : TScriptPos; override;

end;

TStringLengthExpr = class(TUnaryOpIntExpr)

public

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

end;

// returns a dynamic array

TDynamicArrayDataExpr = class(TPosDataExpr)

public

procedure EvalAsVariant(exec : TdwsExecution; var Result : Variant); override;

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

end;

// new array[length,...]

TNewArrayExpr = class(TDynamicArrayDataExpr)

private

FLengthExprs : TTightList;

FTyps : TTightList;

function GetLengthExpr(idx : Integer) : TTypedExpr; inline;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

public

constructor Create(context : TdwsCompilerContext; const scriptPos: TScriptPos;

elementTyp : TTypeSymbol); overload;

constructor Create(const scriptPos: TScriptPos; arrayTyp : TDynamicArraySymbol); overload;

destructor Destroy; override;

procedure EvalAsScriptDynArray(exec : TdwsExecution; var Result : IScriptDynArray); override;

procedure AddLengthExpr(expr : TTypedExpr; indexTyp : TTypeSymbol);

property LengthExpr[idx : Integer] : TTypedExpr read GetLengthExpr;

property LengthExprCount : Integer read FLengthExprs.FCount;

end;

// Pseudo-method for dynamic and associative arrays

TArrayPseudoMethodExpr = class(TNoResultExpr)

private

FBaseExpr : TTypedExpr;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

public

constructor Create(const scriptPos: TScriptPos; aBase : TTypedExpr);

destructor Destroy; override;

property BaseExpr : TTypedExpr read FBaseExpr;

end;

// SetLength of dynamic array

TArraySetLengthExpr = class(TArrayPseudoMethodExpr)

private

FLengthExpr : TTypedExpr;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

public

constructor Create(const scriptPos: TScriptPos; aBase, aLength : TTypedExpr);

destructor Destroy; override;

procedure EvalNoResult(exec : TdwsExecution); override;

property LengthExpr : TTypedExpr read FLengthExpr;

end;

// Swap two elements of a dynamic array

TArraySwapExpr = class(TArrayPseudoMethodExpr)

private

FIndex1Expr : TTypedExpr;

FIndex2Expr : TTypedExpr;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

public

constructor Create(const scriptPos: TScriptPos; aBase, aIndex1, aIndex2 : TTypedExpr);

destructor Destroy; override;

procedure EvalNoResult(exec : TdwsExecution); override;

property Index1Expr : TTypedExpr read FIndex1Expr;

property Index2Expr : TTypedExpr read FIndex2Expr;

end;

// TypedExpr for dynamic array

TArrayTypedExpr = class(TTypedExpr)

private

FBaseExpr : TTypedExpr;

FScriptPos : TScriptPos;

public

constructor Create(context : TdwsCompilerContext; const scriptPos: TScriptPos;

aBaseExpr : TTypedExpr);

destructor Destroy; override;

function ScriptPos : TScriptPos; override;

property BaseExpr : TTypedExpr read FBaseExpr;

end;

// TypedExpr for dynamic array that returns the array (for fluent-style)

TArrayTypedFluentExpr = class(TArrayTypedExpr)

public

constructor Create(context : TdwsCompilerContext; const scriptPos: TScriptPos;

aBaseExpr : TTypedExpr);

procedure EvalAsVariant(exec : TdwsExecution; var Result : Variant); override;

end;

// Sort a dynamic array

TArraySortExpr = class(TArrayTypedFluentExpr)

private

FCompareExpr : TFuncPtrExpr;

FLeft, FRight : TDataSymbol;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

public

constructor Create(context : TdwsCompilerContext; const scriptPos: TScriptPos;

aBase : TTypedExpr; aCompare : TFuncPtrExpr);

destructor Destroy; override;

procedure EvalAsScriptDynArray(exec : TdwsExecution; var result : IScriptDynArray); override;

property CompareExpr : TFuncPtrExpr read FCompareExpr write FCompareExpr;

end;

// Sort a dynamic array (natural order)

TArraySortNaturalExpr = class(TArrayTypedFluentExpr)

public

procedure SetCompareMethod(var qs : TQuickSort; dyn : TScriptDynamicValueArray); virtual;

procedure EvalAsScriptDynArray(exec : TdwsExecution; var result : IScriptDynArray); override;

end;

TArraySortNaturalStringExpr = class(TArraySortNaturalExpr)

public

procedure SetCompareMethod(var qs : TQuickSort; {%H-}dyn : TScriptDynamicValueArray); override;

end;

TArraySortNaturalIntegerExpr = class(TArraySortNaturalExpr)

public

procedure SetCompareMethod(var qs : TQuickSort; {%H-}dyn : TScriptDynamicValueArray); override;

end;

TArraySortNaturalFloatExpr = class(TArraySortNaturalExpr)

public

procedure SetCompareMethod(var qs : TQuickSort; {%H-}dyn : TScriptDynamicValueArray); override;

end;

// Map a dynamic array

TArrayMapExpr = class(TArrayTypedExpr)

private

FMapFuncExpr : TFuncPtrExpr;

FItem : TDataSymbol;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

public

constructor Create(context : TdwsCompilerContext; const scriptPos: TScriptPos;

aBase : TTypedExpr; aMapFunc : TFuncPtrExpr);

destructor Destroy; override;

procedure EvalAsVariant(exec : TdwsExecution; var Result : Variant); override;

procedure EvalAsScriptDynArray(exec : TdwsExecution; var result : IScriptDynArray); override;

property MapFuncExpr : TFuncPtrExpr read FMapFuncExpr write FMapFuncExpr;

end;

// Reverse a dynamic array

TArrayReverseExpr = class(TArrayPseudoMethodExpr)

public

procedure EvalNoResult(exec : TdwsExecution); override;

end;

// Add an item to a dynamic array

TArrayAddExpr = class sealed (TArrayPseudoMethodExpr)

private

FArgs : TTightList;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

function GetItemExpr(idx : Integer) : TTypedExpr;

procedure DoEval(exec : TdwsExecution; var base : IScriptDynArray);

public

constructor Create(const scriptPos: TScriptPos;

aBase : TTypedExpr; argExprs : TTypedExprList);

destructor Destroy; override;

procedure EvalNoResult(exec : TdwsExecution); override;

procedure AddArg(expr : TTypedExpr);

procedure ExtractArgs(destination : TArrayAddExpr);

function SpecializeProgramExpr(const context : ISpecializationContext) : TProgramExpr; override;

property ArgExpr[idx : Integer] : TTypedExpr read GetItemExpr;

property ArgCount : Integer read FArgs.FCount;

end;

// base class for dynamic array expr that return a value

TArrayDataExpr = class(TPosDataExpr)

private

FBaseExpr : TTypedExpr;

FResultAddr : Integer;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

function GetBaseDynArray(exec : TdwsExecution) : TScriptDynamicArray;

public

constructor Create(context : TdwsCompilerContext; const scriptPos: TScriptPos;

aBase : TTypedExpr);

destructor Destroy; override;

procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override;

property BaseExpr : TTypedExpr read FBaseExpr write FBaseExpr;

end;

// Peek the last value of a dynamic array

TArrayPeekExpr = class (TArrayDataExpr)

public

procedure EvalNoResult(exec : TdwsExecution); override;

function SpecializeDataExpr(const context : ISpecializationContext) : TDataExpr; override;

end;

// Pop the last value of a dynamic array

TArrayPopExpr = class sealed (TArrayPeekExpr)

public

procedure EvalNoResult(exec : TdwsExecution); override;

function SpecializeDataExpr(const context : ISpecializationContext) : TDataExpr; override;

end;

// Delete one or N elements of a dynamic array

TArrayDeleteExpr = class(TArrayPseudoMethodExpr)

private

FIndexExpr : TTypedExpr;

FCountExpr : TTypedExpr;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

public

constructor Create(const scriptPos: TScriptPos;

aBase, aIndex, aCount : TTypedExpr);

destructor Destroy; override;

procedure EvalNoResult(exec : TdwsExecution); override;

property IndexExpr : TTypedExpr read FIndexExpr;

property CountExpr : TTypedExpr read FCountExpr;

end;

// Shallow-copy of a subset of an array

TArrayCopyExpr = class(TArrayTypedExpr)

private

FIndexExpr : TTypedExpr;

FCountExpr : TTypedExpr;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

public

constructor Create(context : TdwsCompilerContext; const scriptPos: TScriptPos;

aBase, aIndex, aCount : TTypedExpr);

destructor Destroy; override;

procedure EvalAsVariant(exec : TdwsExecution; var Result : Variant); override;

procedure EvalAsScriptDynArray(exec : TdwsExecution; var result : IScriptDynArray); override;

property IndexExpr : TTypedExpr read FIndexExpr;

property CountExpr : TTypedExpr read FCountExpr;

end;

TArrayIndexOfMethod = function (exec : TdwsExecution; dyn : TScriptDynamicArray) : Integer of object;

// Find element in a dynamic array (shallow comparison)

TArrayIndexOfExpr = class(TArrayTypedExpr)

private

FItemExpr : TTypedExpr;

FFromIndexExpr : TTypedExpr;

FMethod : TArrayIndexOfMethod;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;

function DoEvalValue(exec : TdwsExecution; dyn : TScriptDynamicArray) : Integer;

function DoEvalString(exec : TdwsExecution; dyn : TScriptDynamicArray) : Integer;

function DoEvalInteger(exec : TdwsExecution; dyn : TScriptDynamicArray) : Integer;

function DoEvalFuncPtr(exec : TdwsExecution; dyn : TScriptDynamicArray) : Integer;

function DoEvalData(exec : TdwsExecution; dyn : TScriptDynamicArray) : Integer;

public

constructor Create(context : TdwsCompilerContext; const scriptPos : TScriptPos;

aBase : TTypedExpr; aItem : TTypedExpr; aFromIndex : TTypedExpr);

destructor Destroy; override;

procedure EvalAsVariant(exec : TdwsExecution; var Result : Variant); override;

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

property ItemExpr : TTypedExpr read FItemExpr;

property FromIndexExpr : TTypedExpr read FFromIndexExpr;

end;

// Remove an element in a dynamic array (shallow comparison)

TArrayRemoveExpr = class(TArrayIndexOfExpr)

public

function EvalAsInteger(exec : TdwsExecution) : Int64; override;

end;

// Insert an elemet at a given index of a dynamic array

TArrayInsertExpr = class(TArrayPseudoMethodExpr)

private

FIndexExpr : TTypedExpr;

FItemExpr : TTypedExpr;

protected

function GetSubExpr(i : Integer) : TExprBase; override;

function GetSubExprCount : Integer; override;