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

{ }

{ "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 dwsComp;

{$I dws.inc}

interface

uses

Classes, SysUtils, TypInfo, Variants,

dwsCompiler, dwsExprs, dwsSymbols, dwsDataContext, dwsExprList, dwsScriptSource,

dwsStack, dwsFunctions, dwsStrings, dwsLanguageExtension, dwsCompilerContext,

dwsTokenizer, dwsUtils, dwsOperators, dwsUnitSymbols, dwsXPlatform, dwsUnicode,

// Built-In functions

{$IFNDEF DWS_NO_BUILTIN_FUNCTIONS}

dwsMathFunctions, dwsStringFunctions, dwsTimeFunctions, dwsVariantFunctions,

{$ENDIF}

dwsMagicExprs, dwsErrors;

type

TDelphiWebScript = class;

// TdwsCustomLangageExtension

//

TdwsCustomLangageExtension = class (TComponent)

private

FExtension : TdwsLanguageExtension;

FScript : TDelphiWebScript;

protected

function CreateExtension : TdwsLanguageExtension; virtual; abstract;

procedure SetScript(const val : TDelphiWebScript);

procedure Notification(AComponent: TComponent; Operation: TOperation); override;

property Extension : TdwsLanguageExtension read FExtension write FExtension;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

property Script : TDelphiWebScript read FScript write SetScript;

end;

TdwsEmptyUnit = class (TComponent, IUnknown, IdwsUnit, IdwsUnitTableFactory)

private

procedure BeforeAdditionTo(dwscript : TObject);

function GetUnitName: String;

function GetDependencies : TStringList;

function GetUnitTable(systemTable : TSystemSymbolTable;

unitSyms : TUnitMainSymbols;

operators : TOperators;

rootTable : TSymbolTable) : TUnitSymbolTable;

function GetUnitFlags : TIdwsUnitFlags;

function GetDeprecatedMessage : String;

protected

FUnitName : String;

FDependencies : TStringList;

procedure AddUnitSymbols(SymbolTable: TSymbolTable); virtual; abstract;

function GetSelf : TObject;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

end;

TdwsUnitComponent = class(TdwsEmptyUnit)

private

FScript: TDelphiWebScript;

protected

procedure SetScript(const Value: TDelphiWebScript);

procedure Notification(AComponent: TComponent; Operation: TOperation); override;

public

destructor Destroy; override;

published

property Script: TDelphiWebScript read FScript write SetScript;

end;

TNeedLocalizerEvent = function (Sender : TObject) : IdwsLocalizer;

// TDelphiWebScript

//

TDelphiWebScript = class (TdwsEmptyUnit)

private

FCompiler : IdwsCompiler;

FConfig : TdwsConfiguration;

FExtensions : TdwsLanguageExtensionAggregator;

FLock : TdwsCriticalSection;

protected

function GetOnInclude: TIncludeEvent;

procedure SetOnInclude(const Value: TIncludeEvent);

function GetOnExecutionStarted : TdwsExecutionEvent;

procedure SetOnExecutionStarted(const val : TdwsExecutionEvent);

function GetOnExecutionEnded : TdwsExecutionEvent;

procedure SetOnExecutionEnded(const val : TdwsExecutionEvent);

function GetVersion: String;

procedure SetVersion(const Value: String);

function GetOnNeedUnit : TdwsOnNeedUnitEvent;

procedure SetOnNeedUnit(const val : TdwsOnNeedUnitEvent);

function GetOnResource : TdwsResourceEvent;

procedure SetOnResource(const val : TdwsResourceEvent);

procedure SetConfig(const Value: TdwsConfiguration);

procedure AddUnitSymbols(SymbolTable: TSymbolTable); override;

procedure Notification(AComponent: TComponent; Operation: TOperation); override;

procedure SetupExtensions;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure AddUnit(const aUnit : IdwsUnit); overload;

function RemoveUnit(const aUnit : IdwsUnit): Boolean;

function Compile(const text : String; const mainFileName : String = '') : IdwsProgram; overload;

procedure RecompileInContext(const prog : IdwsProgram; const text : String); overload;

procedure AbortCompilation;

procedure Lock;

procedure UnLock;

property Compiler : IdwsCompiler read FCompiler;

property Extensions : TdwsLanguageExtensionAggregator read FExtensions;

published

property Config : TdwsConfiguration read FConfig write SetConfig stored True;

property OnNeedUnit : TdwsOnNeedUnitEvent read GetOnNeedUnit write SetOnNeedUnit stored False;

property OnInclude : TIncludeEvent read GetOnInclude write SetOnInclude stored False;

property OnResource : TdwsResourceEvent read GetOnResource write SetOnResource;

property OnExecutionStarted : TdwsExecutionEvent read GetOnExecutionStarted write SetOnExecutionStarted;

property OnExecutionEnded : TdwsExecutionEvent read GetOnExecutionEnded write SetOnExecutionEnded;

property Version : String read GetVersion write SetVersion stored False;

end;

TLocalizeSymbolEvent = procedure (Sender : TObject; aResSymbol : TResourceStringSymbol; var result : String) of object;

TLocalizeStringEvent = procedure (Sender : TObject; const aString : String; var result : String) of object;

TGetLocalizerEvent = procedure (Sender : TObject; var localizer : IdwsLocalizer) of object;

TEventBasedLocalizer = class (TInterfacedSelfObject, IdwsLocalizer)

private

FSender : TObject;

FOnLocalizeSymbol : TLocalizeSymbolEvent;

FOnLocalizeString : TLocalizeStringEvent;

public

procedure LocalizeSymbol(aResSymbol : TResourceStringSymbol; var Result : String);

procedure LocalizeString(const aString : String; var Result : String);

property Sender : TObject read FSender write FSender;

property OnLocalizeSymbol : TLocalizeSymbolEvent read FOnLocalizeSymbol write FOnLocalizeSymbol;

property OnLocalizeString : TLocalizeStringEvent read FOnLocalizeString write FOnLocalizeString;

end;

// TdwsCustomLocalizer

//

TdwsCustomLocalizer = class (TdwsLocalizerComponent)

private

FOnLocalizeSymbol : TLocalizeSymbolEvent;

FOnLocalizeString : TLocalizeStringEvent;

FOnGetLocalizer : TGetLocalizerEvent;

public

function GetLocalizer : IdwsLocalizer; override;

published

property OnLocalizeSymbol : TLocalizeSymbolEvent read FOnLocalizeSymbol write FOnLocalizeSymbol;

property OnLocalizeString : TLocalizeStringEvent read FOnLocalizeString write FOnLocalizeString;

property OnGetLocalizer : TGetLocalizerEvent read FOnGetLocalizer write FOnGetLocalizer;

end;

// TdwsAbstractUnit

//

TdwsAbstractUnit = class(TComponent, IUnknown, IdwsUnit, IdwsUnitTableFactory)

private

FDependencies : TStringList;

FScript : TDelphiWebScript;

FUnitName : String;

FDeprecatedMessage : String;

FImplicitUse : Boolean;

function GetDependencies : TStringList;

procedure SetScript(const Value: TDelphiWebScript);

procedure SetUnitName(const Value: String);

protected

procedure Notification(AComponent: TComponent; Operation: TOperation); override;

procedure BeforeAdditionTo(dwscript : TObject);

function GetSelf : TObject;

function GetUnitName: String;

function GetUnitTable(systemTable : TSystemSymbolTable; unitSyms : TUnitMainSymbols;

operators : TOperators; rootTable : TSymbolTable) : TUnitSymbolTable; virtual; abstract;

function GetUnitFlags : TIdwsUnitFlags;

function GetDeprecatedMessage : String;

{$WARNINGS OFF}

property UnitName: String read FUnitName write SetUnitName;

{$WARNINGS ON}

property DeprecatedMessage : String read FDeprecatedMessage write FDeprecatedMessage;

property ImplicitUse : Boolean read FImplicitUse write FImplicitUse;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

property Script: TDelphiWebScript read FScript write SetScript;

end;

TSymbolTableType = (sttDefault, sttStatic, sttLinked);

// TdwsAbstractStaticUnit

//

TdwsAbstractStaticUnit = class(TdwsAbstractUnit)

private

FStaticSymbols : Boolean;

FStaticTable : IStaticSymbolTable;

protected

function GetUnitTable(systemTable : TSystemSymbolTable; unitSyms : TUnitMainSymbols;

operators : TOperators; rootTable : TSymbolTable) : TUnitSymbolTable; override;

function CreateUnitTable(parent, rootTable: TSymbolTable; tableType: TSymbolTableType): TUnitSymbolTable; virtual;

procedure SetStaticSymbols(const Value: Boolean); // static symbols

procedure InitUnitTable(systemTable : TSystemSymbolTable; unitSyms : TUnitMainSymbols;

operators : TOperators; UnitTable: TUnitSymbolTable); virtual;

procedure AddUnitSymbols(systemTable : TSystemSymbolTable; table : TSymbolTable; operators : TOperators); virtual; abstract;

property StaticSymbols : Boolean read FStaticSymbols write SetStaticSymbols;

property StaticTable : IStaticSymbolTable read FStaticTable;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure BeforeDestruction; override;

function InitStaticSymbols(systemTable : TSystemSymbolTable; unitSyms : TUnitMainSymbols; operators : TOperators): Boolean;

procedure ReleaseStaticSymbols;

end;

TDataType = String;

TdwsUnit = class;

TdwsGlobal = class;

TdwsSymbol = class(TCollectionItem)

private

FName: String;

FIsGenerating: Boolean;

FUnit: TdwsUnit;

protected

procedure AssignTo(Dest: TPersistent); override;

procedure CheckName(aTable : TSymbolTable; const aName : String; overloaded : Boolean = False);

function GetDataType(systemTable : TSystemSymbolTable; aTable : TSymbolTable; const aName : String) : TTypeSymbol;

procedure Reset;

procedure SetName(const val : String);

function Parse(const Value : String): String; virtual;

property IsGenerating: Boolean read FIsGenerating write FIsGenerating;

public

constructor Create(Collection: TCollection); override;

procedure Assign(Source: TPersistent); override;

function Generate(systemTable : TSystemSymbolTable; table: TSymbolTable; parentSym: TSymbol = nil): TSymbol;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable; ParentSym: TSymbol = nil): TSymbol; virtual; abstract;

function GetNamePath: String; override;

function GetUnit: TdwsUnit;

published

property Name: String read FName write SetName;

end;

TdwsSymbolArray = array of TdwsSymbol;

TdwsSymbolClass = class of TdwsSymbol;

TdwsCollection = class(TOwnedCollection)

private

FUnit: TdwsUnit;

protected

class function GetSymbolClass : TdwsSymbolClass; virtual; abstract;

function GetSymbols(const Name: String): TdwsSymbol;

function GetItem(Index: Integer): TdwsSymbol;

procedure SetItem(Index: Integer; Value: TdwsSymbol);

procedure Reset;

public

constructor Create(AOwner: TPersistent);

function GetOwner: TPersistent; override;

function GetUnit: TdwsUnit;

function IndexOf(const Name: String): Integer;

property Symbols[const Name: String]: TdwsSymbol read GetSymbols;

property Items[Index: Integer]: TdwsSymbol read GetItem write SetItem;

end;

TdwsVariable = class(TdwsSymbol)

private

FDataType: TDataType;

protected

function GetDisplayName: String; override;

public

procedure Assign(Source: TPersistent); override;

published

property DataType: TDataType read FDataType write FDataType;

end;

TdwsVariables = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

function GetDisplayName: String;

public

function Add : TdwsGlobal; overload;

function Add(const name, typName : String) : TdwsGlobal; overload;

end;

TdwsVariablesClass = class of TdwsVariables;

// TdwsParameter

//

TdwsParameter = class(TdwsVariable)

private

FIsVarParam : Boolean;

FIsLazy : Boolean;

FIsWritable : Boolean;

FDefaultValue : Variant;

FHasDefaultValue : Boolean;

protected

procedure SetIsVarParam(const Value: Boolean);

procedure SetHasDefaultValue(const Value: Boolean);

procedure SetIsWritable(const Value: Boolean);

procedure SetIsLazy(const val : Boolean);

procedure SetDefaultValue(const Value: Variant);

function GetDisplayName: String; override;

function Parse(const Value : String): String; override;

public

constructor Create(Collection: TCollection); override;

procedure Assign(Source: TPersistent); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable; ParentSym: TSymbol = nil): TSymbol; override;

// not supported here yet, experimental

property IsLazy : Boolean read FIsLazy write SetIsLazy default False;

published

property IsVarParam : Boolean read FIsVarParam write SetIsVarParam default False;

property IsWritable : Boolean read FIsWritable write SetIsWritable default True;

property HasDefaultValue : Boolean read FHasDefaultValue write SetHasDefaultValue default False;

property DefaultValue: Variant read FDefaultValue write SetDefaultValue;

end;

TdwsParameters = class(TdwsVariables)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

public

function Add : TdwsParameter; overload; inline;

function Add(const name, typeName : String) : TdwsParameter; overload;

end;

TFuncEvalEvent = procedure(info : TProgramInfo) of object;

TFuncFastEvalEvent = function(const args : TExprBaseListExec) : Variant of object;

TInitSymbolEvent = procedure(sender : TObject; symbol : TSymbol) of object;

TInitExprEvent = procedure(sender : TObject; expr : TExprBase) of object;

TdwsCallable = class(TInterfacedSelfObject, IExecutable, ICallable)

private

FOwner : TObject;

FOnInitSymbol : TInitSymbolEvent;

FOnInitExpr : TInitExprEvent;

protected

procedure Call(exec : TdwsProgramExecution; func : TFuncSymbol); virtual; abstract;

procedure CompileTimeCheck(context : TdwsCompilerContext; expr : TFuncExprBase); virtual;

procedure InitSymbol(symbol : TSymbol; const msgs : TdwsCompileMessageList);

procedure InitExpression(expr : TExprBase);

function SubExpr(i : Integer) : TExprBase;

function SubExprCount : Integer;

function Specialize(const context : ISpecializationContext) : IExecutable;

public

constructor Create(owner : TObject);

property OnInitSymbol : TInitSymbolEvent read FOnInitSymbol write FOnInitSymbol;

property OnInitExpr : TInitExprEvent read FOnInitExpr write FOnInitExpr;

end;

TdwsFunctionCallable = class(TdwsCallable)

private

FOnEval : TFuncEvalEvent;

protected

procedure Call(exec : TdwsProgramExecution; func : TFuncSymbol); override;

public

property OnEval : TFuncEvalEvent read FOnEval write FOnEval;

end;

TdwsFunctionSymbol = class(TdwsSymbol)

private

FResultType : TDataType;

FParameters : TdwsParameters;

FDeprecated : String;

FCallable : TdwsCallable;

FOverloaded : Boolean;

protected

function GetDisplayName: String; override;

procedure SetResultType(const val : TDataType); virtual;

procedure SetParameters(const Value: TdwsParameters);

function GetOnInitExpr : TInitExprEvent;

procedure SetOnInitExpr(const val : TInitExprEvent);

function GetOnInitSymbol : TInitSymbolEvent;

procedure SetOnInitSymbol(const val : TInitSymbolEvent);

function StoreParameters : Boolean;

function Parse(const Value : String): String; override;

procedure SetMethodType(const value: TTokenType); virtual;

public

constructor Create(collection : TCollection); override;

destructor Destroy; override;

procedure Assign(Source: TPersistent); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable;

ParentSym: TSymbol = nil): TSymbol; override;

function GetParameters(systemTable : TSystemSymbolTable; Table: TSymbolTable): TParamArray;

published

property Parameters : TdwsParameters read FParameters write SetParameters stored StoreParameters;

property ResultType : TDataType read FResultType write SetResultType;

property OnInitSymbol : TInitSymbolEvent read GetOnInitSymbol write SetOnInitSymbol;

property OnInitExpr : TInitExprEvent read GetOnInitExpr write SetOnInitExpr;

property Deprecated : String read FDeprecated write FDeprecated;

property Overloaded : Boolean read FOverloaded write FOverloaded default False;

end;

TdwsFunction = class(TdwsFunctionSymbol)

private

FOnFastEval : TFuncFastEvalEvent;

protected

function GetOnEval : TFuncEvalEvent;

procedure SetOnEval(const val : TFuncEvalEvent);

public

constructor Create(collection : TCollection); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable; ParentSym: TSymbol = nil): TSymbol; override;

published

property OnEval : TFuncEvalEvent read GetOnEval write SetOnEval;

property OnFastEval : TFuncFastEvalEvent read FOnFastEval write FOnFastEval;

end;

TdwsFunctions = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

public

function Add : TdwsFunction; overload; inline;

function Add(const name : String; const resultType : String = '') : TdwsFunction; overload;

end;

TdwsFunctionsClass = class of TdwsFunctions;

// It would have better sense to derive both TdwsFunctionSymbol and TdwsDelegate

// from a common ancestor.

TdwsDelegate = class(TdwsSymbol)

private

FResultType : TDataType;

FParameters : TdwsParameters;

FDeprecated : String;

protected

function GetDisplayName: String; override;

procedure SetResultType(const Value: TDataType); virtual;

procedure SetParameters(const Value: TdwsParameters);

function StoreParameters : Boolean;

function Parse(const Value : String): String; override;

public

constructor Create(Collection: TCollection); override;

destructor Destroy; override;

procedure Assign(Source: TPersistent); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable; ParentSym: TSymbol = nil): TSymbol; override;

function GetParameters(systemTable : TSystemSymbolTable; Table: TSymbolTable): TParamArray;

published

property Parameters : TdwsParameters read FParameters write SetParameters stored StoreParameters;

property ResultType : TDataType read FResultType write SetResultType;

property Deprecated : String read FDeprecated write FDeprecated;

end;

TdwsDelegates = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

public

function Add: TdwsDelegate; overload; inline;

function Add(const Name: String; const ResultType: String = '') : TdwsDelegate; overload;

end;

TdwsDelegatesClass = class of TdwsDelegates;

TdwsArray = class(TdwsSymbol)

private

FDataType: TDataType;

FLowBound: Integer;

FHighBound: Integer;

protected

procedure SetIsDynamic(const Value: Boolean);

function GetIsDynamic: Boolean;

function GetDisplayName: String; override;

function GetBoundStored: Boolean;

public

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable; ParentSym: TSymbol = nil): TSymbol;

override;

procedure Assign(Source: TPersistent); override;

published

property DataType: TDataType read FDataType write FDataType;

property LowBound: Integer read FLowBound write FLowBound stored GetBoundStored;

property HighBound: Integer read FHighBound write FHighBound stored GetBoundStored;

property IsDynamic: Boolean read GetIsDynamic write SetIsDynamic default False;

end;

TdwsArrays = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

public

function Add : TdwsArray;

end;

TdwsArraysClass = class of TdwsArrays;

TdwsConstant = class(TdwsVariable)

protected

FValue: Variant;

function GetDisplayName: String; override;

public

procedure Assign(Source: TPersistent); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable;

ParentSym: TSymbol = nil): TSymbol; override;

published

property Value: Variant read FValue write FValue;

end;

TdwsConstants = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

function GetValues(const name : String) : Variant;

procedure SetValues(const name : String; const v : Variant);

public

function Add : TdwsConstant; inline;

property Values[const name : String] : Variant read GetValues write SetValues;

end;

TdwsConstantsClass = class of TdwsConstants;

TdwsForward = class(TdwsSymbol)

protected

function GetDisplayName: String; override;

public

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable;

ParentSym: TSymbol = nil): TSymbol; override;

end;

TdwsForwards = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

public

function Add : TdwsForward; inline;

end;

TdwsForwardsClass = class of TdwsForwards;

TdwsField = class(TdwsVariable)

private

FVisibility : TdwsVisibility;

FDefaultValue : Variant;

FHasDefaultValue : Boolean;

protected

function GetDisplayName: String; override;

procedure SetDefaultValue(const Value: Variant);

function GetHasDefaultValue : Boolean;

function Parse(const Value : String): String; override;

public

constructor Create(Collection: TCollection); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable;

ParentSym: TSymbol = nil): TSymbol; override;

published

property Visibility : TdwsVisibility read FVisibility write FVisibility default cvPublic;

property DefaultValue : Variant read FDefaultValue write SetDefaultValue stored GetHasDefaultValue;

property HasDefaultValue : Boolean read FHasDefaultValue write FHasDefaultValue default False;

end;

TdwsFields = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

public

function Add : TdwsField;

end;

TdwsProperty = class(TdwsSymbol)

private

FDataType: TDataType;

FReadAccess: String;

FWriteAccess: String;

FParameters: TdwsParameters;

FDeprecated : String;

FIndexValue: Variant;

FIsDefault: Boolean;

FIndexType: TDataType;

FVisibility : TdwsVisibility;

procedure SetReadAccess(const Value: String);

procedure SetWriteAccess(const Value: String);

protected

function GetDisplayName: String; override;

function GetIsDefault: Boolean;

procedure SetIsDefault(Value: Boolean);

procedure SetParameters(const Value: TdwsParameters);

function StoreParameters : Boolean;

function Parse(const Value : String): String; override;

public

constructor Create(Collection: TCollection); override;

destructor Destroy; override;

procedure Assign(Source: TPersistent); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable;

ParentSym: TSymbol = nil): TSymbol; override;

published

property DataType: TDataType read FDataType write FDataType;

property Deprecated : String read FDeprecated write FDeprecated;

property Visibility : TdwsVisibility read FVisibility write FVisibility default cvPublic;

property ReadAccess: String read FReadAccess write SetReadAccess;

property WriteAccess: String read FWriteAccess write SetWriteAccess;

property Parameters: TdwsParameters read FParameters write SetParameters stored StoreParameters;

property IsDefault: Boolean read GetIsDefault write SetIsDefault default False;

property IndexType: TDataType read FIndexType write FIndexType;

property IndexValue: Variant read FIndexValue write FIndexValue;

end;

TdwsProperties = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

public

function Add : TdwsProperty;

end;

TdwsClassOperator = class(TdwsSymbol)

private

FOperator: TTokenType;

FDataType: TDataType;

FUsesAccess: String;

protected

function GetDisplayName: String; override;

public

procedure Assign(Source: TPersistent); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable;

ParentSym: TSymbol = nil): TSymbol; override;

published

property DataType: TDataType read FDataType write FDataType;

property &Operator : TTokenType read FOperator write FOperator;

property UsesAccess : String read FUsesAccess write FUsesAccess;

end;

TdwsClassOperators = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

end;

TdwsTypeSymbol = class(TCollectionItem)

private

FName: String;

protected

function GetDisplayName: String; override;

public

procedure Assign(Source: TPersistent); override;

published

property Name : String read FName write FName;

end;

TdwsTypeSymbols = class(TOwnedCollection)

public

constructor Create(AOwner: TPersistent);

function Add : TdwsTypeSymbol;

end;

TdwsOperator = class(TdwsSymbol)

private

FOperator: TTokenType;

FResultType: TDataType;

FParams : TdwsTypeSymbols;

FUsesAccess: String;

protected

function GetDisplayName: String; override;

public

constructor Create(Collection: TCollection); override;

destructor Destroy; override;

procedure Assign(Source: TPersistent); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable;

ParentSym: TSymbol = nil): TSymbol; override;

published

property ResultType : TDataType read FResultType write FResultType;

property Params : TdwsTypeSymbols read FParams write FParams;

property &Operator : TTokenType read FOperator write FOperator;

property UsesAccess : String read FUsesAccess write FUsesAccess;

end;

TdwsOperators = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

public

function Add : TdwsOperator;

end;

TdwsOperatorsClass = class of TdwsOperators;

TAssignExternalObjectEvent = procedure(Info: TProgramInfo; var ExtObject: TObject) of object;

TMethodEvalEvent = procedure(Info: TProgramInfo; ExtObject: TObject) of object;

TdwsMethodCallable = class(TdwsCallable)

private

FOnEval : TMethodEvalEvent;

protected

procedure Call(exec : TdwsProgramExecution; func : TFuncSymbol); override;

public

property OnEval : TMethodEvalEvent read FOnEval write FOnEval;

end;

TdwsMethod = class(TdwsFunctionSymbol)

private

FAttributes : TMethodAttributes;

FKind : TMethodKind;

FVisibility : TdwsVisibility;

protected

function GetDisplayName: String; override;

function GetOnEval : TMethodEvalEvent;

procedure SetOnEval(const val : TMethodEvalEvent);

procedure SetResultType(const val : TDataType); override;

procedure SetAttributes(const attribs : TMethodAttributes);

procedure SetMethodType(const value: TTokenType); override;

public

constructor Create(collection : TCollection); override;

procedure Assign(Source: TPersistent); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable;

ParentSym: TSymbol = nil): TSymbol; override;

published

property Attributes: TMethodAttributes read FAttributes write SetAttributes default [];

property OnEval : TMethodEvalEvent read GetOnEval write SetOnEval;

property Visibility : TdwsVisibility read FVisibility write FVisibility default cvPublic;

property Kind: TMethodKind read FKind write FKind;

end;

TdwsMethods = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

public

function Add : TdwsMethod; overload; inline;

function Add(const name : String; const resultType : String = '') : TdwsMethod; overload;

end;

TdwsConstructorCallable = class(TdwsCallable)

private

FOnEval : TAssignExternalObjectEvent;

protected

procedure Call(exec : TdwsProgramExecution; func : TFuncSymbol); override;

public

property OnEval : TAssignExternalObjectEvent read FOnEval write FOnEval;

end;

TdwsConstructor = class(TdwsFunctionSymbol)

private

FAttributes: TMethodAttributes;

FVisibility : TdwsVisibility;

protected

function GetResultType: String;

function GetDisplayName: String; override;

function GetOnEval : TAssignExternalObjectEvent;

procedure SetOnEval(const val : TAssignExternalObjectEvent);

procedure SetAttributes(const attribs : TMethodAttributes);

public

constructor Create(Collection: TCollection); override;

procedure Assign(Source: TPersistent); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable;

ParentSym: TSymbol = nil): TSymbol; override;

published

property Visibility : TdwsVisibility read FVisibility write FVisibility default cvPublic;

property OnEval : TAssignExternalObjectEvent read GetOnEval write SetOnEval;

property Attributes: TMethodAttributes read FAttributes write SetAttributes default [];

property ResultType: String read GetResultType;

end;

TdwsConstructors = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

public

function Add : TdwsConstructor;

end;

TdwsClassConstant = class(TdwsConstant)

private

FVisibility : TdwsVisibility;

protected

function GetDisplayName: String; override;

public

constructor Create(Collection: TCollection); override;

procedure Assign(Source: TPersistent); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable;

ParentSym: TSymbol = nil): TSymbol; override;

published

property Visibility : TdwsVisibility read FVisibility write FVisibility default cvPublic;

end;

TdwsClassConstants = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

public

function Add : TdwsClassConstant;

end;

// TdwsClass

//

TdwsClass = class(TdwsSymbol)

private

FAncestor : String;

FConstructors : TdwsConstructors;

FFields : TdwsFields;

FMethods : TdwsMethods;

FOnObjectDestroy : TObjectDestroyEvent;

FProperties : TdwsProperties;

FOperators : TdwsClassOperators;

FConstants : TdwsClassConstants;

FHelperObject : TObject;

FIsSealed : Boolean;

FIsAbstract : Boolean;

FIsStatic : Boolean;

FDeprecated : String;

protected

function GetDisplayName : String; override;

function StoreConstructors : Boolean;

function StoreFields : Boolean;

function StoreMethods : Boolean;

function StoreOperators : Boolean;

function StoreConstants : Boolean;

function StoreProperties : Boolean;

public

constructor Create(Collection: TCollection); override;

destructor Destroy; override;

procedure Assign(Source: TPersistent); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable;

ParentSym: TSymbol = nil): TSymbol; override;

{: User-side helper object, freed by the TdwsClass. }

property HelperObject : TObject read FHelperObject write FHelperObject;

published

property Ancestor : String read FAncestor write FAncestor;

property IsSealed : Boolean read FIsSealed write FIsSealed default False;

property IsAbstract : Boolean read FIsAbstract write FIsAbstract default False;

property IsStatic : Boolean read FIsStatic write FIsStatic default False;

property Deprecated : String read FDeprecated write FDeprecated;

property Constructors : TdwsConstructors read FConstructors write FConstructors stored StoreConstructors;

property Fields : TdwsFields read FFields write FFields stored StoreFields;

property Methods : TdwsMethods read FMethods write FMethods stored StoreMethods;

property Operators : TdwsClassOperators read FOperators write FOperators stored StoreOperators;

property Constants : TdwsClassConstants read FConstants write FConstants stored StoreConstants;

property Properties: TdwsProperties read FProperties write FProperties stored StoreProperties;

property OnCleanUp : TObjectDestroyEvent read FOnObjectDestroy write FOnObjectDestroy;

end;

TdwsClasses = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

public

function Add : TdwsClass;

end;

TdwsClassesClass = class of TdwsClasses;

// TdwsInterface

//

TdwsInterface = class(TdwsSymbol)

private

FAncestor : String;

FMethods : TdwsMethods;

FProperties : TdwsProperties;

protected

function GetDisplayName : String; override;

function StoreMethods : Boolean;

function StoreProperties : Boolean;

public

constructor Create(Collection: TCollection); override;

destructor Destroy; override;

procedure Assign(Source: TPersistent); override;

function DoGenerate(systemTable : TSystemSymbolTable; Table: TSymbolTable;

ParentSym: TSymbol = nil): TSymbol; override;

published

property Ancestor : String read FAncestor write FAncestor;

property Methods : TdwsMethods read FMethods write FMethods stored StoreMethods;

property Properties: TdwsProperties read FProperties write FProperties stored StoreProperties;

end;

TdwsInterfaces = class(TdwsCollection)

protected

class function GetSymbolClass : TdwsSymbolClass; override;

public

function Add : TdwsInterface;

end;