dws2symbols.pas

script language

{**********************************************************************}
{                                                                      }
{    "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 Original Code is DelphiWebScriptII source code, released      }
{    January 1, 2001                                                   }
{                                                                      }
{    The Initial Developer of the Original Code is Matthias            }
{    Ackermann. Portions created by Matthias Ackermann are             }
{    Copyright (C) 2000 Matthias Ackermann, Switzerland. All           }
{    Rights Reserved.                                                  }
{                                                                      }
{    Contributor(s): Andreas Luleich                                   }
{                                                                      }
{**********************************************************************}

{$I dws2.inc}

unit dws2Symbols;

interface

uses
{$IFDEF NEWVARIANTS}
  Variants,
{$ENDIF}
  Classes, dws2Strings;

type
  TBaseTypeId = Integer;

const
  SymbolCacheSize = 5; // do not make too large!

  TypIntegerID: TBaseTypeId = 1;
  TypFloatID: TBaseTypeId = 2;
  TypStringID: TBaseTypeId = 3;
  TypBooleanID: TBaseTypeId = 4;
  TypDateTimeID: TBaseTypeId = 5;
  TypVariantID: TBaseTypeId = 6;
  TypConnectorID: TBaseTypeId = 7;

type
  // Base class for all Exprs
  TExprBase = class
  end;

  TSymbol = class;
  TBaseSymbol = class;
  TDataSymbol = class;
  TFuncSymbol = class;
  TMethodSymbol = class;
  TFieldSymbol = class;
  TClassSymbol = class;
  TRecordSymbol = class;
  TParamSymbol = class;
  TVarParamSymbol = class;
  IScriptObj = interface;
  TSymbolTable = class;
  TData = array of Variant;
  TDimensions = array of Integer;
  TTypeSymbol = class;

  // All functions callable from the script implement this interface
  IExecutable = interface
    ['{8D534D18-4C6B-11D5-8DCB-0000216D9E86}']
    procedure Initialize;
    function Optimize(FuncExpr: TExprBase): TExprBase;
  end;

  TAddrGeneratorMode = (agmPositive, agmNegative);

  TAddrGenerator = class
  protected
    FDataSize: Integer;
    FLevel: Integer;
    FMode: TAddrGeneratorMode;
    function GetDataSize: Integer;
  public
    constructor Create(Level: Integer; Mode: TAddrGeneratorMode; InitialSize:
      Integer = 0);
    function GetStackAddr(Size: Integer): Integer;
    property DataSize: Integer read GetDataSize;
    property Level: Integer read FLevel;
  end;

  // Named item in the script
  TSymbol = class
  protected
    FName: string;
    FSize: Integer;
    FTyp: TSymbol;
    function GetCaption: string; virtual;
    function GetDescription: string; virtual;
  public
    constructor Create(Name: string; Typ: TSymbol);
    procedure InitData(Dat: TData; Offset: Integer); virtual;
    procedure CopyData(FromData: TData; FromAddr: Integer; ToData: TData;
      ToAddr: Integer); virtual;
    procedure Initialize; virtual;
    function IsCompatible(typSym: TSymbol): Boolean; virtual;
    function BaseType: TTypeSymbol; virtual;
    property Caption: string read GetCaption;
    property Description: string read GetDescription;
    property Name: string read FName write FName;
    property Typ: TSymbol read FTyp write FTyp;
    property Size: Integer read FSize;
  end;

  TSymbolClass = class of TSymbol;

  // All Symbols containing a value
  TValueSymbol = class(TSymbol)
  protected
    function GetCaption: string; override;
    function GetDescription: string; override;
  end;

  // named constant: const x = 123;
  TConstSymbol = class(TValueSymbol)
  protected
    FData: TData;
    function GetCaption: string; override;
    function GetDescription: string; override;
  public
    constructor Create(Name: string; Typ: TSymbol; const Value: Variant); overload;
    constructor Create(Name: string; Typ: TSymbol; Data: TData; Addr: Integer); overload;
    procedure Initialize; override;
    property Data: TData read FData;
  end;

  // variable: var x: Integer;
  TDataSymbol = class(TValueSymbol)
  protected
    FLevel: Integer;
    FStackAddr: Integer;
    function GetDescription: string; override;
  public
    procedure InitData(Dat: TData; Offset: Integer); override;
    property Level: Integer read FLevel write FLevel;
    property StackAddr: Integer read FStackAddr write FStackAddr;
  end;

  // parameter: procedure P(x: Integer);
  TParamSymbol = class(TDataSymbol)
  private
    FDefaultValue : TData;
  protected
    function GetDescription: string; override;
  public
    procedure SetDefaultValue(Data: TData; Addr: Integer); overload;
    procedure SetDefaultValue(const Value: Variant); overload;
    property DefaultValue : TData read FDefaultValue;
  end;

  // var parameter: procedure P(var x: Integer)
  TVarParamSymbol = class(TParamSymbol)
  private
    FIsWritable: Boolean;
  protected
    function GetDescription: string; override;
  public
    constructor Create(Name: string; Typ: TSymbol; IsWritable: Boolean = True);
    property IsWritable: Boolean read FIsWritable;
  end;

  // variable with functions for read/write: var x: integer; extern 'type' in 'selector';
  TExternalVarSymbol = class(TValueSymbol)
  private
    FReadFunc: TFuncSymbol;
    FWriteFunc: TFuncSymbol;
  protected
    function GetReadFunc: TFuncSymbol; virtual;
    function GetWriteFunc: TFuncSymbol; virtual;
  public
    destructor Destroy; override;
    property ReadFunc: TFuncSymbol read GetReadFunc write FReadFunc;
    property WriteFunc: TFuncSymbol read GetWriteFunc write FWriteFunc;
  end;

  // Base class for all types
  TTypeSymbol = class(TSymbol)
    function BaseType: TTypeSymbol; override;
    function IsCompatible(typSym: TSymbol): Boolean; override;
  end;

  TFuncKind = (fkFunction, fkProcedure, fkConstructor, fkDestructor);

  // Record used for TFuncSymbol.Generate
  TParamRec = record
    IsVarParam: Boolean;
    IsWritable: Boolean;
    ParamName: string;
    ParamType: string;
    HasDefaultValue: Boolean;
    DefaultValue: TData;
  end;
  TParamList = array of TParamRec;

  // A script function / procedure: procedure X(param: Integer);
  TFuncSymbol = class(TTypeSymbol)
  protected
    FAddrGenerator: TAddrGenerator;
    FExecutable: IExecutable;
    FInternalParams: TSymbolTable;
    FIsForwarded: Boolean;
    FKind: TFuncKind;
    FParams: TSymbolTable;
    FResult: TDataSymbol;
    procedure SetType(const Value: TSymbol); virtual;
    function GetCaption: string; override;
    function GetDescription: string; override;
    function GetLevel: Integer;
    function GetParamSize: Integer;
  public
    constructor Create(Name: string; FuncKind: TFuncKind; FuncLevel: Integer);
    constructor Generate(Table: TSymbolTable; FuncName: string; FuncParams:
      TParamList; FuncType: string);
    destructor Destroy; override;
    function IsCompatible(typSym: TSymbol): Boolean; override;
    procedure AddParam(param: TParamSymbol); virtual;
    procedure GenerateParams(Table: TSymbolTable; FuncParams: TParamList);
    procedure Initialize; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; virtual;
    procedure InitData(Dat: TData; Offset: Integer); override;
    property Executable: IExecutable read FExecutable write FExecutable;
    property IsForwarded: Boolean read FIsForwarded write FIsForwarded;
    property Kind: TFuncKind read FKind write FKind;
    property Level: Integer read GetLevel;
    property Params: TSymbolTable read FParams;
    property ParamSize: Integer read GetParamSize;
    property Result: TDataSymbol read FResult;
    property Typ: TSymbol read FTyp write SetType;
    property InternalParams: TSymbolTable read FInternalParams;
  end;

  TMethodKind = (mkProcedure, mkFunction, mkConstructor, mkDestructor,
    mkClassProcedure, mkClassFunction);
  TMethodAttribute = (maVirtual, maOverride, maReintroduce, maAbstract);
  TMethodAttributes = set of TMethodAttribute;

  // A method of a script class: TMyClass = class procedure X(param: String); end;
  TMethodSymbol = class(TFuncSymbol)
  private
    FClassSymbol: TClassSymbol;
    FIsAbstract: Boolean;
    FIsVirtual: Boolean;
    FIsOverride: Boolean;
    FIsOverlap: Boolean;
    FParentMeth: TMethodSymbol;
    FSelfSym: TDataSymbol;
  protected
    function GetIsClassMethod: Boolean;
  public
    constructor Create(Name: string; FuncKind: TFuncKind; ClassSym: TSymbol;
      FuncLevel: Integer = 1); virtual;
    constructor Generate(Table: TSymbolTable; MethKind: TMethodKind; Attributes:
      TMethodAttributes; MethName: string; MethParams: TParamList; MethType: string;
      Cls: TClassSymbol);
    procedure SetOverride(meth: TMethodSymbol);
    procedure SetOverlap(meth: TMethodSymbol);
    procedure InitData(Dat: TData; Offset: Integer); override;
    function IsCompatible(typSym: TSymbol): Boolean; override;
    property ClassSymbol: TClassSymbol read FClassSymbol;
    property IsAbstract: Boolean read FIsAbstract write FIsAbstract;
    property IsVirtual: Boolean read FIsVirtual write FIsVirtual;
    property IsOverride: Boolean read FIsOverride;
    property IsOverlap: Boolean read FIsOverlap;
    property IsClassMethod: Boolean read GetIsClassMethod;
    property ParentMeth: TMethodSymbol read FParentMeth;
    property SelfSym: TDataSymbol read FSelfSym write FSelfSym;
  end;

  TNameSymbol = class(TTypeSymbol)
  end;

  // type x = TMyType;
  TAliasSymbol = class(TNameSymbol)
    constructor Create(Name: string; Typ: TTypeSymbol);
    function BaseType: TTypeSymbol; override;
    function IsCompatible(typSym: TSymbol): Boolean; override;
  end;

  // integer/string/float/boolean
  TBaseSymbol = class(TNameSymbol)
  protected
    FDefault: Variant;
    FId: TBaseTypeId;
  public
    constructor Create(Name: string; Id: TBaseTypeId; Default: Variant);
    procedure InitData(Dat: TData; Offset: Integer); override;
    function IsCompatible(typSym: TSymbol): Boolean; override;
    property Id: TBaseTypeId read FId;
  end;

  IConnectorType = interface;

  IConnector = interface
    ['{8D534D1A-4C6B-11D5-8DCB-0000216D9E86}']
    function ConnectorCaption: string;
    function ConnectorName: string;
    function GetUnit(UnitName: string): IConnectorType;
  end;

  TConnectorArgs = array of TData;

  IConnectorCall = interface
    ['{8D534D1B-4C6B-11D5-8DCB-0000216D9E86}']
    function Call(const Base: Variant; Args: TConnectorArgs): TData;
  end;

  IConnectorMember = interface
    ['{8D534D1C-4C6B-11D5-8DCB-0000216D9E86}']
    function Read(const Base: Variant): TData;
    procedure Write(const Base: Variant; Data: TData);
  end;

  TConnectorParam = record
    IsVarParam: Boolean;
    TypSym: TSymbol;
  end;

  TConnectorParams = array of TConnectorParam;

  IConnectorType = interface
    ['{8D534D1D-4C6B-11D5-8DCB-0000216D9E86}']
    function ConnectorCaption: string;
    function HasMethod(MethodName: string; Params: TConnectorParams; var TypSym:
      TSymbol): IConnectorCall;
    function HasMember(MemberName: string; var TypSym: TSymbol; IsWrite: Boolean): IConnectorMember;
    function HasIndex(PropName: string; Params: TConnectorParams; var TypSym: TSymbol; IsWrite: Boolean): IConnectorCall;
  end;

  TConnectorSymbol = class(TBaseSymbol)
  private
    FConnectorType: IConnectorType;
  public
    constructor Create(Name: string; ConnectorType: IConnectorType);
    procedure InitData(Dat: TData; Offset: Integer); override;
    property ConnectorType: IConnectorType read FConnectorType write
      FConnectorType;
  end;

  TCustomArraySymbol = class(TTypeSymbol)
  end;

  // array of FTyp
  TDynamicArraySymbol = class(TCustomArraySymbol)
  protected
    function GetCaption: string; override;
  public
    constructor Create(Name: string; Typ: TSymbol);
    procedure InitData(Dat: TData; Offset: Integer); override;
    function IsCompatible(TypSym: TSymbol): Boolean; override;
  end;

  // array [FLowBound..FHighBound] of FTyp
  TArraySymbol = class(TCustomArraySymbol)
  private
    FHighBound: Integer;
    FLowBound: Integer;
  protected
    function GetElements: Integer;
    function GetCaption: string; override;
  public
    constructor Create(Name: string; LowBound, HighBound: Integer; Typ: TSymbol);
    procedure InitData(Dat: TData; Offset: Integer); override;
    procedure CopyData(FromData: TData; FromAddr: Integer; ToData: TData;
      ToAddr: Integer); override;
    function IsCompatible(typSym: TSymbol): Boolean; override;
    procedure SetBounds(LowBound, HighBound: Integer);
    property HighBound: Integer read FHighBound;
    property LowBound: Integer read FLowBound;
    property Elements: Integer read GetElements;
  end;

  // array of type [x,2.4,'abc']
  TStaticArraySymbol = class(TArraySymbol)
  end;

  // TStaticArraySymbol - Instance
  TOpenArrayConstructorSymbol = class(TDataSymbol)
  public
    constructor Create(Name: string; Typ: TStaticArraySymbol);
    destructor Destroy; override;
    procedure UpdateSize;
  end;

  // Member of a record
  TMemberSymbol = class(TValueSymbol)
  protected
    FRecordSymbol: TRecordSymbol;
    FOffset: Integer;
  public
    procedure InitData(Dat: TData; Offset: Integer); override;
    property Offset: Integer read FOffset write FOffset;
    property RecordSymbol: TRecordSymbol read FRecordSymbol write FRecordSymbol;
  end;

  // record member1: Integer; member2: Integer end;
  TRecordSymbol = class(TTypeSymbol)
  private
  protected
    FMembers: TSymbolTable;
    function GetCaption: string; override;
    function GetDescription: string; override;
  public
    constructor Create(Name: string);
    destructor Destroy; override;
    procedure AddMember(Member: TMemberSymbol);
    procedure CopyData(FromData: TData; FromAddr: Integer; ToData: TData; ToAddr: Integer); override;
    procedure InitData(Dat: TData; Offset: Integer); override;
    function IsCompatible(typSym: TSymbol): Boolean; override;
    property Members: TSymbolTable read FMembers;
  end;

  // Field of a script object
  TFieldSymbol = class(TValueSymbol)
  protected
    FClassSymbol: TClassSymbol;
    FOffset: Integer;
  public
    property Offset: Integer read FOffset;
    property ClassSymbol: TClassSymbol read FClassSymbol write FClassSymbol;
  end;

  // property X: Integer read FReadSym write FWriteSym;
  TPropertySymbol = class(TValueSymbol)
  private
    FClassSymbol: TClassSymbol;
    FReadSym: TSymbol;
    FWriteSym: TSymbol;
    FArrayIndices: TSymbolTable;
    FIndexSym: TSymbol;
    FIndexValue: TData;
  protected
    function GetCaption: string; override;
    function GetDescription: string; override;
    function GetReadSym: TSymbol; virtual;
    function GetWriteSym: TSymbol; virtual;
    function GetIsDefault: Boolean; virtual;
    procedure AddParam(Param: TParamSymbol);
  public
    constructor Create(Name: string; Typ: TSymbol);
    destructor Destroy; override;
    procedure GenerateParams(Table: TSymbolTable; FuncParams: TParamList);
    procedure SetIndex(Data: TData; Addr: Integer; Sym: TSymbol);
    property ArrayIndices: TSymbolTable read FArrayIndices;
    property ReadSym: TSymbol read GetReadSym write FReadSym;
    property WriteSym: TSymbol read GetWriteSym write FWriteSym;
    property ClassSymbol: TClassSymbol read FClassSymbol write FClassSymbol;
    property IsDefault: Boolean read GetIsDefault;
    property IndexValue: TData read FIndexValue;
    property IndexSym: TSymbol read FIndexSym;
  end;

  // type X = class of TMyClass;
  TClassOfSymbol = class(TTypeSymbol)
  protected
    function GetCaption: string; override;
  public
    constructor Create(Name: string; Typ: TClassSymbol);
    procedure InitData(Dat: TData; Offset: Integer); override;
    function IsCompatible(typSym: TSymbol): Boolean; override;
  end;

  TObjectDestroyEvent = procedure(ExternalObject: TObject) of object;

  // type X = class ... end;
  TClassSymbol = class(TTypeSymbol)
  private
    FClassOfSymbol: TClassOfSymbol;
    FIsAbstract: Boolean;
    FIsForward: Boolean;
    FMembers: TSymbolTable;
    FInstanceSize: Integer;
    FOnObjectDestroy: TObjectDestroyEvent;
    FParent: TClassSymbol;
    FDefaultProperty: TPropertySymbol;
  protected
    function CreateMembersTable: TSymbolTable; virtual;
    function GetDescription: string; override;
  public
    constructor Create(Name: string);
    destructor Destroy; override;
    procedure AddField(Sym: TFieldSymbol);
    procedure AddMethod(Sym: TMethodSymbol);
    procedure AddProperty(Sym: TPropertySymbol);
    procedure InheritFrom(Typ: TClassSymbol);
    procedure InitData(Dat: TData; Offset: Integer); override;
    procedure Initialize; override;
    function IsCompatible(typSym: TSymbol): Boolean; override;
    function InstanceSize : Integer; // avoids warning
    property ClassOf: TClassOfSymbol read FClassOfSymbol;
    property IsAbstract: Boolean read FIsAbstract write FIsAbstract;
    property IsForward: Boolean read FIsForward write FIsForward;
    property Members: TSymbolTable read FMembers;
    property OnObjectDestroy: TObjectDestroyEvent read FOnObjectDestroy write FOnObjectDestroy;
    property Parent: TClassSymbol read FParent;
    property DefaultProperty: TPropertySymbol read FDefaultProperty write FDefaultProperty;
  end;

  // nil "class"
  TNilSymbol = class(TTypeSymbol)
  protected
    function GetCaption: string; override;
  public
    constructor Create;
    function IsCompatible(typSym: TSymbol): Boolean; override;
  end;

  // Invisible symbol for units (e. g. for Tdws2Unit)
  TUnitSymbol = class(TNameSymbol)
  private
    FIsTableOwner: Boolean;
    FTable: TSymbolTable;
  public
    constructor Create(Name: string; Table: TSymbolTable; IsTableOwner: Boolean = False);
    destructor Destroy; override;
    procedure Initialize; override;
    property Table: TSymbolTable read FTable write FTable;
  end;

  // Element of an enumeration type. E. g. "type DummyEnum = (Elem1, Elem2, Elem3);"
  TElementSymbol = class(TConstSymbol)
  private
    FIsUserDef: Boolean;
    FUserDefValue: Integer;
  protected
    function GetDescription: string; override;
  public
    constructor Create(Name: string; Typ: TSymbol; Value: Integer; IsUserDef: Boolean);
    property IsUserDef: Boolean read FIsUserDef;
    property UserDefValue: Integer read FUserDefValue;
  end;