unit FpPascalParser;

Classes, sysutils, math, fgl, DbgIntfBaseTypes, LazDebuggerIntfFloatTypes, LazDebuggerIntf,

FpDbgInfo, FpdMemoryTools, FpErrorMessages,

FpDbgDwarf, FpDbgClasses, FpDbgCommon,

{$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif},

LazClasses;

MAX_ERR_EXPR_QUOTE_LEN = 200;

TFpPascalExpression = class;

TFpPascalExpressionPart = class;

TFpPascalExpressionPartContainer = class;

TFpPascalExpressionPartWithPrecedence = class;

TFpPascalExpressionPartBracket = class;

TFpPascalExpressionPartOperator = class;

TFpPascalExpressionPartIntrinsicBase = class;

TFpPascalExpressionPartOperatorArraySlice = class;

PFpPascalExpressionPartOperatorArraySlice = ^TFpPascalExpressionPartOperatorArraySlice;

TFpPascalExpressionPartClass = class of TFpPascalExpressionPart;

TFpPascalExpressionPartBracketClass = class of TFpPascalExpressionPartBracket;

TSeparatorType = (ppstComma);

TFpIntrinsicFunc = (

ifErrorNotFound,

ifChildClass, ifClassName,

ifTry, ifTryN,

ifObj,

ifFlatten, ifFlattenPlaceholder,

ifLength, ifRefCount, ifPos, ifSubStr, ifLower, ifUpper,

ifOrd,

ifRound, ifTrunc, ifSqrt, ifPi, ifLn, ifLog, ifSin, ifCos, ifTan

);

TFpPascalParserGetSymbolForIdentProc = function(APart: TFpPascalExpressionPart; AnIdent: String): TFpValue of object;

TFpPascalParserGetIntrinsicForIdentProc = function(AnExpression: TFpPascalExpression; AStart: PChar; ALen: Integer): TFpPascalExpressionPartIntrinsicBase of object;

TFpPascalParserCallFunctionProc = function (AnExpressionPart: TFpPascalExpressionPart;

AFunctionValue: TFpValue; ASelfValue: TFpValue; AParams: TFpValueListIntf;

out AResult: TFpValue; var AnError: TFpError): boolean of object;

TFpPascalParserResolvePropertyProc = procedure(APropValue, ASelfValue: TFpValue;

AParams: TFpValueListIntf; out AnErr: TFpError) of object;

{ TFpPascalExpressionSharedData }

TFpPascalExpressionSharedData = class(TRefCountedObject)

// Data used while EVALUATING the expression result

strict private

FErrorKind: TLzDbgErrorKind;

FTextExpression: String;

FScope: TFpDbgSymbolScope;

FError: TFpError;

FAutoDeref: Boolean;

FFixPCharIndexAccess: Boolean;

FOnFunctionCall: TFpPascalParserCallFunctionProc;

FGlobalCache: TFpDbgDataCache;

function GetTextExpressionAddr: PChar; inline;

function GetValid: Boolean;

protected

FHasPCharIndexAccess: Boolean;

public

constructor Create(ATextExpression: String; AScope: TFpDbgSymbolScope);

destructor Destroy; override;

function GetDbgSymbolForIdentifier({%H-}AnIdent: String; AFindFlags: TFindExportedSymbolsFlags = []): TFpValue;

function GetRegisterValue({%H-}AnIdent: String): TFpValue;

procedure ResolveProperty(APropValue, ASelfValue: TFpValue; AParams: TFpValueListIntf; out AnErr: TFpError);

procedure SetError(AMsg: String; AnErrKind: TLzDbgErrorKind = dekUnknown); // deprecated;

procedure SetError(AnErrorCode: TFpErrorCode; const AnNestedErr: TFpError = nil; AnErrKind: TLzDbgErrorKind = dekUnknown);

procedure SetError(AnErrorCode: TFpErrorCode; AData: array of const; const AnNestedErr: TFpError = nil; AnErrKind: TLzDbgErrorKind = dekUnknown);

procedure SetError(const AnErr: TFpError; AnErrKind: TLzDbgErrorKind = dekUnknown);

procedure ClearError;

function PosFromPChar(APChar: PChar): Integer;

property TextExpression: String read FTextExpression;

property TextExpressionAddr: PChar read GetTextExpressionAddr;

property Scope: TFpDbgSymbolScope read FScope;

property Error: TFpError read FError;

property ErrorKind: TLzDbgErrorKind read FErrorKind;

property Valid: Boolean read GetValid;

(* *** CONFIG *** *)

property AutoDeref: Boolean read FAutoDeref write FAutoDeref;

property HasPCharIndexAccess: Boolean read FHasPCharIndexAccess; // Set by GetResultValue

property FixPCharIndexAccess: Boolean read FFixPCharIndexAccess write FFixPCharIndexAccess; // handle pchar as string (adjust index)

property OnFunctionCall: TFpPascalParserCallFunctionProc read FOnFunctionCall write FOnFunctionCall;

property GlobalCache: TFpDbgDataCache read FGlobalCache write FGlobalCache;

end;

{ TFpPascalExpression }

TFpPascalExpression = class

strict private

FSharedData: TFpPascalExpressionSharedData;

function GetAutoDeref: Boolean; inline;

function GetFixPCharIndexAccess: Boolean; inline;

function GetHasPCharIndexAccess: Boolean; inline;

function GetGlobalCache: TFpDbgDataCache; inline;

function GetOnFunctionCall: TFpPascalParserCallFunctionProc; inline;

procedure SetAutoDeref(AValue: Boolean); inline;

procedure SetFixPCharIndexAccess(AValue: Boolean); inline;

procedure SetGlobalCache(AValue: TFpDbgDataCache); inline;

procedure SetOnFunctionCall(AValue: TFpPascalParserCallFunctionProc); inline;

function GetError: TFpError; inline;

function GetValid: Boolean; inline;

strict private

FOnFindIntrinsc: TFpPascalParserGetIntrinsicForIdentProc;

FIntrinsicPrefix: TFpIntrinsicPrefix;

FExpressionPart: TFpPascalExpressionPart;

FPreviousArraySlice: TFpPascalExpressionPartOperatorArraySlice;

function GetErrorKind: TLzDbgErrorKind;

function GetResultValue: TFpValue;

function LookupIntrinsic(AStart: PChar; ALen: Integer): TFpPascalExpressionPart;

protected

procedure SetError(AnErrorCode: TFpErrorCode; const AnNestedErr: TFpError = nil; AnErrKind: TLzDbgErrorKind = dekUnknown);

procedure SetError(AnErrorCode: TFpErrorCode; AData: array of const; const AnNestedErr: TFpError = nil; AnErrKind: TLzDbgErrorKind = dekUnknown);

protected

property ExpressionPart: TFpPascalExpressionPart read FExpressionPart;

public

constructor Create(ATextExpression: String; AScope: TFpDbgSymbolScope; ASkipParse: Boolean = False);

destructor Destroy; override;

procedure Parse;

function DebugDump(AWithResults: Boolean = False): String;

procedure ResetEvaluation;

procedure ResolveProperty(APropValue, ASelfValue: TFpValue; AParams: TFpValueListIntf; out AnErr: TFpError);

property Error: TFpError read GetError;

property ErrorKind: TLzDbgErrorKind read GetErrorKind;

property Valid: Boolean read GetValid;

// ResultValue

// - May be a type, if expression is a type

// - Only valid, as long as the expression is not destroyed

property ResultValue: TFpValue read GetResultValue;

(* *** CONFIG *** *)

// Parser-only

property IntrinsicPrefix: TFpIntrinsicPrefix read FIntrinsicPrefix write FIntrinsicPrefix;

property OnFindIntrinsc: TFpPascalParserGetIntrinsicForIdentProc read FOnFindIntrinsc write FOnFindIntrinsc;

// Shared, available during evaluation

property AutoDeref: Boolean read GetAutoDeref write SetAutoDeref;

property HasPCharIndexAccess: Boolean read GetHasPCharIndexAccess; // Set by GetResultValue

property FixPCharIndexAccess: Boolean read GetFixPCharIndexAccess write SetFixPCharIndexAccess; // handle pchar as string (adjust index)

property OnFunctionCall: TFpPascalParserCallFunctionProc read GetOnFunctionCall write SetOnFunctionCall;

property GlobalCache: TFpDbgDataCache read GetGlobalCache write SetGlobalCache;

property SharedData: TFpPascalExpressionSharedData read FSharedData;

end;

TFindInParentsFlag = (fipIncludeBracketFunction);

TFindInParentsFlags = set of TFindInParentsFlag;

{ TFpPascalExpressionPart }

TFpPascalExpressionPart = class

private

FExpressionData: TFpPascalExpressionSharedData;

FEndChar: PChar;

FParent: TFpPascalExpressionPartContainer;

FStartChar: PChar;

FResultValue: TFpValue;

FResultValDone: Boolean;

FIsCopy: Boolean;

function GetResultValue: TFpValue;

function GetSurroundingOpenBracket: TFpPascalExpressionPartBracket;

function GetTopParent: TFpPascalExpressionPart;

procedure SetEndChar(AValue: PChar);

procedure SetParent(AValue: TFpPascalExpressionPartContainer); virtual;

procedure SetStartChar(AValue: PChar);

function CreateErrorWithPos(AnErrorCode: TFpErrorCode; AData: array of const; APos: integer = -1): TFpError;

procedure SetErrorWithPos(AnErrorCode: TFpErrorCode; AData: array of const; AnErrKind: TLzDbgErrorKind = dekUnknown);

protected

function DebugText(AIndent: String; {%H-}AWithResults: Boolean): String; virtual; // Self desc only

function DebugDump(AIndent: String; AWithResults: Boolean): String; virtual;

protected

FPrecedence: Integer;

procedure Init; virtual;

procedure Assign(ASourcePart: TFpPascalExpressionPart); virtual;

function FindCopiedInParents(ASourcePart, AFindInSourcePart: TFpPascalExpressionPart; AFindFlags: TFindInParentsFlags = []): TFpPascalExpressionPart;

function DoGetIsTypeCast: Boolean; virtual; deprecated;

function DoGetResultValue: TFpValue; virtual;

procedure SetError(AMsg: String = ''; AnErrKind: TLzDbgErrorKind = dekUnknown); // deprecated;

procedure SetError(APart: TFpPascalExpressionPart; AMsg: String = ''; AnErrKind: TLzDbgErrorKind = dekUnknown); // deprecated;

//procedure SetError(AnErrorCode: TFpErrorCode; const AnNestedErr: TFpError = nil);

procedure SetError(AnErrorCode: TFpErrorCode; AData: array of const; const AnNestedErr: TFpError = nil; AnErrKind: TLzDbgErrorKind = dekUnknown);

procedure SetError(AnError: TFpError; AnErrKind: TLzDbgErrorKind = dekUnknown);

procedure ResetEvaluation; virtual;

procedure ResetEvaluationRecursive; virtual;

procedure ResetEvaluationForAnchestors; virtual;

Procedure ReplaceInParent(AReplacement: TFpPascalExpressionPart);

procedure DoHandleEndOfExpression; virtual;

procedure DoParentIndexBraceClosed(APreviousArraySliceList: PFpPascalExpressionPartOperatorArraySlice); virtual; // called on index-Item in array[XXX]

function IsValidNextPart(APart: TFpPascalExpressionPart): Boolean; virtual;

function IsValidAfterPart({%H-}APrevPart: TFpPascalExpressionPart): Boolean; virtual;

function MaybeHandlePrevPart({%H-}APrevPart: TFpPascalExpressionPart;

var {%H-}AResult: TFpPascalExpressionPart): Boolean; virtual;

// HasPrecedence: an operator with follows precedence rules: the last operand can be taken by the next operator

function HasPrecedence: Boolean; virtual;

function FindLeftSideOperandByPrecedence({%H-}AnOperator: TFpPascalExpressionPartWithPrecedence):

TFpPascalExpressionPart; virtual;

function CanHaveOperatorAsNext: Boolean; virtual; // True

function HandleSeparator(ASeparatorType: TSeparatorType; var APart: TFpPascalExpressionPart): Boolean; virtual; // False

procedure GetFirstLastChar(out AFirst, ALast: PChar); virtual;

public

constructor Create(AnExpressionData: TFpPascalExpressionSharedData; AStartChar: PChar; AnEndChar: PChar = nil);

destructor Destroy; override;

function CreateCopy(ACopiedParent: TFpPascalExpressionPartContainer): TFpPascalExpressionPart;

procedure BeginNeedCopy; virtual;

procedure EndNeedCopy; virtual;

function HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; virtual;

procedure HandleEndOfExpression; virtual;

// AcceptParamAsSeparator: called on the first Item in TFpPascalExpressionPartBracketArgumentList

function AcceptParamAsSeparator(AParamPart: TFpPascalExpressionPart;

ABracketsPart: TFpPascalExpressionPartContainer;

var AResult: TFpPascalExpressionPart): boolean; virtual;

// HandleNewParameterInList: called on the first Item in TFpPascalExpressionPartBracketArgumentList

procedure HandleNewParameterInList(AParamPart: TFpPascalExpressionPart; ABracketsPart: TFpPascalExpressionPartContainer); virtual;

procedure HandleEndOfParameterInList(AParamPart: TFpPascalExpressionPart; ABracketsPart: TFpPascalExpressionPartContainer); virtual;

function GetText(AMaxLen: Integer=0): String;

function GetPos: Integer;

function GetFullText(AMaxLen: Integer=0): String; virtual; // including children

function ReturnsVariant: boolean; virtual;

function IsClosed: boolean; virtual; // for brackets

property StartChar: PChar read FStartChar write SetStartChar;

property EndChar: PChar read FEndChar write SetEndChar;

property Parent: TFpPascalExpressionPartContainer read FParent write SetParent;

function FindInParents(APart: TFpPascalExpressionPart): Boolean;

property TopParent: TFpPascalExpressionPart read GetTopParent; // or self

property Precedence: Integer read FPrecedence;

property SurroundingBracket: TFpPascalExpressionPartBracket read GetSurroundingOpenBracket; // incl self

property ResultValue: TFpValue read GetResultValue;

property ExpressionData: TFpPascalExpressionSharedData read FExpressionData;

end;

{ TFpPascalExpressionPartContainer }

TFpPascalExpressionPartContainer = class(TFpPascalExpressionPart)

private

FList: TList;

function GetCount: Integer;

function GetItems(AIndex: Integer): TFpPascalExpressionPart;

function GetLastItem: TFpPascalExpressionPart;

procedure SetItems(AIndex: Integer; AValue: TFpPascalExpressionPart);

procedure SetLastItem(AValue: TFpPascalExpressionPart);

protected

procedure Init; override;

procedure Assign(ASourcePart: TFpPascalExpressionPart); override;

procedure ResetEvaluationRecursive; override;

procedure GetFirstLastChar(out AFirst, ALast: PChar); override;

function DebugDump(AIndent: String; AWithResults: Boolean): String; override;

public

destructor Destroy; override;

procedure BeginNeedCopy; override;

procedure EndNeedCopy; override;

function GetFullText(AMaxLen: Integer=0): String; override; // including children

function Add(APart: TFpPascalExpressionPart): Integer;

function IndexOf(APart: TFpPascalExpressionPart): Integer;

procedure Clear;

property Count: Integer read GetCount;

property Items[AIndex: Integer]: TFpPascalExpressionPart read GetItems write SetItems;

property LastItem: TFpPascalExpressionPart read GetLastItem write SetLastItem;

end;

{ TFpPascalExpressionPartIdentifier }

TFpPascalExpressionPartIdentifier = class(TFpPascalExpressionPartContainer)

private

FOnGetSymbol: TFpPascalParserGetSymbolForIdentProc;

protected

function DoGetIsTypeCast: Boolean; override;

function DoGetResultValue: TFpValue; override;

property OnGetSymbol: TFpPascalParserGetSymbolForIdentProc read FOnGetSymbol write FOnGetSymbol;

procedure Assign(ASourcePart: TFpPascalExpressionPart); override;

procedure ResetEvaluation; override;

end;

{ TFpPascalExpressionPartCpuRegister }

TFpPascalExpressionPartCpuRegister = class(TFpPascalExpressionPartContainer)

protected

function DoGetResultValue: TFpValue; override;

end;

TFpPascalExpressionPartBracketArgumentList = class;

{ TFpPascalExpressionPartIntrinsicBase }

TFpPascalExpressionPartIntrinsicBase = class(TFpPascalExpressionPartContainer)

protected

function CheckArgumentCount(AParams: TFpPascalExpressionPartBracketArgumentList; ARequiredCount: Integer; AMaxAccepted: Integer = -1): Boolean;

// GetArg; ANum is 1 based

function GetArg(AParams: TFpPascalExpressionPartBracketArgumentList; ANum: Integer; out AValue: TFpValue;

AnErr: String = ''): Boolean;

function DoGetResultValue: TFpValue; override;

function DoGetResultValue(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue; virtual;

end;

{ TFpPascalExpressionPartIntrinsic }

TFpPascalExpressionPartIntrinsic = class(TFpPascalExpressionPartIntrinsicBase)

private

FIntrinsic: TFpIntrinsicFunc;

FChildClassCastType: TFpValue;

FFlattenCurrentVal, FFlattenCurrentValOrig: TFpValue;

FFlattenMemberName: String;

FFlattenMemberNotFound: boolean;

function DoGetMemberForFlattenExpr(APart: TFpPascalExpressionPart; AnIdent: String): TFpValue;

protected

function DoTry(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoTryN(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoObj(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoOrd(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoLength(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoChildClass(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoClassName(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoFlatten(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoFlattenPlaceholder(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoRefCnt(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoPos(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoSubStr(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoLower(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoUpper(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoRound(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoTrunc(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoSqrt(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoPi(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoLn(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoLog(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoSin(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoCos(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoTan(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;

function DoGetResultValue: TFpValue; override;

function DoGetResultValue(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue; override;

procedure Assign(ASourcePart: TFpPascalExpressionPart); override;

public

constructor Create(AnExpressionData: TFpPascalExpressionSharedData; AStartChar: PChar;

AnEndChar: PChar; AnIntrinsic: TFpIntrinsicFunc);

destructor Destroy; override;

function ReturnsVariant: boolean; override;

function AcceptParamAsSeparator(AParamPart: TFpPascalExpressionPart;

ABracketsPart: TFpPascalExpressionPartContainer; var AResult: TFpPascalExpressionPart

): boolean; override;

procedure HandleNewParameterInList(AParamPart: TFpPascalExpressionPart; ABracketsPart: TFpPascalExpressionPartContainer); override;

procedure HandleEndOfParameterInList(AParamPart: TFpPascalExpressionPart;

ABracketsPart: TFpPascalExpressionPartContainer); override;

end;

TFpPascalExpressionPartConstant = class(TFpPascalExpressionPartContainer)

end;

{ TFpPascalExpressionPartConstantNumber }

TFpPascalExpressionPartConstantNumber = class(TFpPascalExpressionPartConstant)

protected

function DoGetResultValue: TFpValue; override;

end;

{ TFpPascalExpressionPartConstantNumberFloat }

TFpPascalExpressionPartConstantNumberFloat = class(TFpPascalExpressionPartConstantNumber)

protected

function DoGetResultValue: TFpValue; override;

end;

{ TFpPascalExpressionPartConstantText }

TFpPascalExpressionPartConstantText = class(TFpPascalExpressionPartConstant)

protected

FValue: String;

function DoGetResultValue: TFpValue; override;

procedure Assign(ASourcePart: TFpPascalExpressionPart); override;

end;

{ TFpPascalExpressionPartWithPrecedence }

TFpPascalExpressionPartWithPrecedence = class(TFpPascalExpressionPartContainer)

protected

function HasPrecedence: Boolean; override;

end;

{ TFpPascalExpressionPartBracket }

TFpPascalExpressionPartBracket = class(TFpPascalExpressionPartWithPrecedence)

// some, but not all bracket expr have precedence

private

FIsClosed: boolean;

FIsClosing: boolean;

FIsSeparatorChecking: boolean;

FAfterComma: Integer;

FFullEndChar: PChar;

function GetAfterComma: Boolean;

protected

procedure Init; override;

function HasPrecedence: Boolean; override;

procedure DoHandleEndOfExpression; override;

function CanHaveOperatorAsNext: Boolean; override;

function HandleNextPartInBracket(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; virtual;

procedure SetAfterCommaFlag;

property AfterComma: Boolean read GetAfterComma;

procedure GetFirstLastChar(out AFirst, ALast: PChar); override;

procedure CheckBeforeSeparator(APart: TFpPascalExpressionPart);

procedure Assign(ASourcePart: TFpPascalExpressionPart); override;

public

procedure CloseBracket(ALastAddedPart: TFpPascalExpressionPart;

APreviousArraySliceList: PFpPascalExpressionPartOperatorArraySlice;

AStartChar: PChar; AnEndChar: PChar = nil); virtual;

function HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override;

procedure HandleEndOfExpression; override;

function IsClosed: boolean; override;

end;

{ TFpPascalExpressionPartRoundBracket }

TFpPascalExpressionPartRoundBracket = class(TFpPascalExpressionPartBracket)

protected

end;

{ TFpPascalExpressionPartBracketSubExpression }

TFpPascalExpressionPartBracketSubExpression = class(TFpPascalExpressionPartRoundBracket)

protected

function HandleNextPartInBracket(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override;

function DoGetResultValue: TFpValue; override;

function HandleSeparator(ASeparatorType: TSeparatorType; var APart: TFpPascalExpressionPart): Boolean; override;

public

procedure CloseBracket(ALastAddedPart: TFpPascalExpressionPart;

APreviousArraySliceList: PFpPascalExpressionPartOperatorArraySlice;

AStartChar: PChar; AnEndChar: PChar = nil); override;

end;

{ TFpPascalExpressionPartBracketArgumentList }

TFpPascalExpressionPartBracketArgumentList = class(TFpPascalExpressionPartRoundBracket)

// function arguments or type cast // this acts a operator: first element is the function/type

protected

procedure Init; override;

function DoGetResultValue: TFpValue; override;

function DoGetIsTypeCast: Boolean; override;

function IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean; override;

function HandleNextPartInBracket(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override;

function MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart;

var AResult: TFpPascalExpressionPart): Boolean; override;

function HandleSeparator(ASeparatorType: TSeparatorType; var APart: TFpPascalExpressionPart): Boolean; override;

public

procedure CloseBracket(ALastAddedPart: TFpPascalExpressionPart;

APreviousArraySliceList: PFpPascalExpressionPartOperatorArraySlice;

AStartChar: PChar; AnEndChar: PChar = nil); override;

function ReturnsVariant: boolean; override;

function IntrinsicType: TFpIntrinsicFunc;

end;

{ TFpPascalExpressionPartSquareBracket }

TFpPascalExpressionPartSquareBracket = class(TFpPascalExpressionPartBracket)

end;

{ TFpPascalExpressionPartBracketSet }

TFpPascalExpressionPartBracketSet = class(TFpPascalExpressionPartSquareBracket)

// a in [x, y, z]

protected

function DoGetResultValue: TFpValue; override;

function HandleNextPartInBracket(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override;

function HandleSeparator(ASeparatorType: TSeparatorType; var APart: TFpPascalExpressionPart): Boolean; override;

end;

{ TFpPascalExpressionPartBracketIndex }

TFpPascalExpressionPartBracketIndex = class(TFpPascalExpressionPartSquareBracket, TFpValueListIntf)

// array[1]

protected

FUsedByFirstChild: boolean;

function GetValueItems(AnIndex: Integer): TFpValue;

function GetValueCount: integer;

function TFpValueListIntf.GetItems = GetValueItems;

function TFpValueListIntf.Count = GetValueCount;

protected

procedure Init; override;

function DoGetResultValue: TFpValue; override;

function IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean; override;

function HandleNextPartInBracket(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override;

function MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart;

var AResult: TFpPascalExpressionPart): Boolean; override;

procedure DoHandleEndOfExpression; override;

function HandleSeparator(ASeparatorType: TSeparatorType; var APart: TFpPascalExpressionPart): Boolean; override;

public

procedure CloseBracket(ALastAddedPart: TFpPascalExpressionPart;

APreviousArraySliceList: PFpPascalExpressionPartOperatorArraySlice;

AStartChar: PChar; AnEndChar: PChar = nil); override;

function ReturnsVariant: boolean; override;

end;

{ TFpPascalExpressionPartOperator }

TFpPascalExpressionPartOperator = class(TFpPascalExpressionPartWithPrecedence)

protected

function DebugText(AIndent: String; AWithResults: Boolean): String; override;

function CanHaveOperatorAsNext: Boolean; override;

function FindLeftSideOperandByPrecedence(AnOperator: TFpPascalExpressionPartWithPrecedence):

TFpPascalExpressionPart; override;

function HasAllOperands: Boolean; virtual; abstract;

function MaybeAddLeftOperand(APrevPart: TFpPascalExpressionPart;

var AResult: TFpPascalExpressionPart): Boolean;

procedure DoHandleEndOfExpression; override;

function HandleSeparator(ASeparatorType: TSeparatorType; var APart: TFpPascalExpressionPart): Boolean; override;

public

function HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override;

end;

{ TFpPascalExpressionPartUnaryOperator }

TFpPascalExpressionPartUnaryOperator = class(TFpPascalExpressionPartOperator)

protected

function HasAllOperands: Boolean; override;

public

end;

{ TFpPascalExpressionPartBinaryOperator }

TFpPascalExpressionPartBinaryOperator = class(TFpPascalExpressionPartOperator)

protected

function HasAllOperands: Boolean; override;

function IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean; override;

function IsValidAfterPartWithPrecedence(APrevPart: TFpPascalExpressionPart): Boolean; virtual;

public

function HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override;

function MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart;

var AResult: TFpPascalExpressionPart): Boolean; override;

end;

{ TFpPascalExpressionPartOperatorAddressOf }

TFpPascalExpressionPartOperatorAddressOf = class(TFpPascalExpressionPartUnaryOperator) // @

protected

procedure Init; override;

function DoGetResultValue: TFpValue; override;

end;

{ TFpPascalExpressionPartOperatorMakeRef }

TFpPascalExpressionPartOperatorMakeRef = class(TFpPascalExpressionPartUnaryOperator) // ^TTYpe

protected

procedure Init; override;

function IsValidNextPart(APart: TFpPascalExpressionPart): Boolean; override;

function DoGetResultValue: TFpValue; override;

function DoGetIsTypeCast: Boolean; override;

end;

{ TFpPascalExpressionPartOperatorDeRef }

TFpPascalExpressionPartOperatorDeRef = class(TFpPascalExpressionPartUnaryOperator) // ptrval^

protected

procedure Init; override;

function DoGetResultValue: TFpValue; override;

function MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart;

var AResult: TFpPascalExpressionPart): Boolean; override;

function FindLeftSideOperandByPrecedence({%H-}AnOperator: TFpPascalExpressionPartWithPrecedence):

TFpPascalExpressionPart;

override;

// IsValidAfterPart: same as binary op

function IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean; override;

end;

{ TFpPascalExpressionPartOperatorUnaryPlusMinus }

TFpPascalExpressionPartOperatorUnaryPlusMinus = class(TFpPascalExpressionPartUnaryOperator) // + -

// Unary + -

protected

procedure Init; override;

function DoGetResultValue: TFpValue; override;

end;

{ TFpPascalExpressionPartOperatorQuestionMark }

TFpPascalExpressionPartOperatorQuestionMark = class(TFpPascalExpressionPartBinaryOperator) // ? :

protected

procedure Init; override;

function DoGetResultValue: TFpValue; override;

function FindLeftSideOperandByPrecedence(AnOperator: TFpPascalExpressionPartWithPrecedence

): TFpPascalExpressionPart; override;

function IsValidAfterPartWithPrecedence(APrevPart: TFpPascalExpressionPart): Boolean; override;

procedure DoHandleEndOfExpression; override;

public

function ReturnsVariant: boolean; override;

function IsClosed: boolean; override;

end;

{ TFpPascalExpressionPartOperatorColon }

TFpPascalExpressionPartOperatorColon = class(TFpPascalExpressionPartBinaryOperator) // ? :

private

FIsClosed: boolean;

protected

procedure Init; override;

function DoGetResultValue: TFpValue; override;

function FindLeftSideOperandByPrecedence(AnOperator: TFpPascalExpressionPartWithPrecedence

): TFpPascalExpressionPart; override;

function IsValidAfterPartWithPrecedence(APrevPart: TFpPascalExpressionPart): Boolean; override;

procedure DoHandleEndOfExpression; override;

public

function IsClosed: boolean; override;

end;

{ TFpPascalExpressionPartOperatorPlusMinus }

TFpPascalExpressionPartOperatorPlusMinus = class(TFpPascalExpressionPartBinaryOperator) // + -

// Binary + -

protected

procedure Init; override;

function DoGetResultValue: TFpValue; override;

end;

{ TFpPascalExpressionPartOperatorMulDiv }

TFpPascalExpressionPartOperatorMulDiv = class(TFpPascalExpressionPartBinaryOperator) // * /

protected

procedure Init; override;

function DoGetResultValue: TFpValue; override;

end;

{ TFpPascalExpressionPartOperatorUnaryNot }

TFpPascalExpressionPartOperatorUnaryNot = class(TFpPascalExpressionPartUnaryOperator) // not

protected

procedure Init; override;

function DoGetResultValue: TFpValue; override;

end;

{ TFpPascalExpressionPartOperatorAnd }

TFpPascalExpressionPartOperatorAnd = class(TFpPascalExpressionPartBinaryOperator) // AND

protected

procedure Init; override;

function DoGetResultValue: TFpValue; override;

end;

{ TFpPascalExpressionPartOperatorBitShift }

TFpPascalExpressionPartOperatorBitShift = class(TFpPascalExpressionPartBinaryOperator) // shr shl << >>

protected

procedure Init; override;

function CheckOperators(out AVal, AShift: QWord): boolean;

end;

{ TFpPascalExpressionPartOperatorShr }

TFpPascalExpressionPartOperatorShr = class(TFpPascalExpressionPartOperatorBitShift) // shr >>

protected

function DoGetResultValue: TFpValue; override;

end;

{ TFpPascalExpressionPartOperatorShl }

TFpPascalExpressionPartOperatorShl = class(TFpPascalExpressionPartOperatorBitShift) // shl <<

protected

function DoGetResultValue: TFpValue; override;

end;

{ TFpPascalExpressionPartOperatorOr }

TFpPascalExpressionPartOperatorOr = class(TFpPascalExpressionPartBinaryOperator) // OR XOR

public type

TOpOrType = (ootOr, ootXor);

protected

FOp: TOpOrType;

procedure Init; override;

function DoGetResultValue: TFpValue; override;

procedure Assign(ASourcePart: TFpPascalExpressionPart); override;

public

constructor Create(AnExpressionData: TFpPascalExpressionSharedData; AnOp: TOpOrType; AStartChar: PChar;

AnEndChar: PChar = nil);

end;

{ TFpPascalExpressionPartOperatorCompare }

TFpPascalExpressionPartOperatorCompare = class(TFpPascalExpressionPartBinaryOperator) // = < > <> ><

protected

procedure Init; override;

function DoGetResultValue: TFpValue; override;

end;

{ TFpPascalExpressionPartOperatorMemberOf }

TFpPascalExpressionPartOperatorMemberOf = class(TFpPascalExpressionPartBinaryOperator) // struct.member

protected

procedure Init; override;

function IsValidNextPart(APart: TFpPascalExpressionPart): Boolean; override;

function DoGetResultValue: TFpValue; override;

end;

{ TFpPascalExpressionPartOperatorMemberIn }

TFpPascalExpressionPartOperatorMemberIn = class(TFpPascalExpressionPartBinaryOperator) // enum in set

protected

procedure Init; override;

function DoGetResultValue: TFpValue; override;

end;

{ TFpPascalExpressionPartOperatorArraySliceController }

TFpPascalExpressionPartOperatorArraySliceController = class(TFpPascalExpressionPartBracketSubExpression)

private

FDisableSlice: boolean;

FSlicePart: TFpPascalExpressionPartOperatorArraySlice;

FInResetEvaluationForIndex: Boolean;

FHasVariantPart: Boolean;

FCheckedForVariantPart: Boolean;

FNeedCopy: integer;

function GetCanDisableSlice: boolean;

protected

function DoGetResultValue: TFpValue; override;

function InternalDoGetResultValue(ANeedCopy: boolean): TFpValue;

procedure DoParentIndexBraceClosed(APreviousArraySliceList: PFpPascalExpressionPartOperatorArraySlice); override;

procedure ResetEvaluation; override;

procedure ResetEvaluationForIndex;

procedure ResetEvaluationForAnchestors; override;

public

constructor Create(AnExpressionData: TFpPascalExpressionSharedData;

ASlicePart: TFpPascalExpressionPartOperatorArraySlice;

AStartChar: PChar; AnEndChar: PChar = nil);

procedure BeginNeedCopy; override;

procedure EndNeedCopy; override;

function GetFullText(AMaxLen: Integer = 0): String; override;

function DebugText(AIndent: String; AWithResults: Boolean): String; override;

property SlicePart: TFpPascalExpressionPartOperatorArraySlice read FSlicePart;

property DisableSlice: boolean read FDisableSlice write FDisableSlice;

property CanDisableSlice: boolean read GetCanDisableSlice;

end;

{ TFpPascalExpressionPartOperatorArraySlice }

TFpPascalExpressionPartOperatorArraySlice = class(TFpPascalExpressionPartBinaryOperator) // enum in set

private

FCurrentIndex: Int64;

FController: TFpPascalExpressionPartOperatorArraySliceController;

FPreviousArraySlice: TFpPascalExpressionPartOperatorArraySlice;

FHasUpperLimit: Boolean;

FUpperLimit: Integer;

protected

FTouched: boolean;

procedure Init; override;

procedure DoParentIndexBraceClosed(APreviousArraySliceList: PFpPascalExpressionPartOperatorArraySlice); override;

function DoGetResultValue: TFpValue; override;

function StartValue: Int64;

function EndValue: Int64;

procedure CheckForVariantExpressionParts;

procedure Assign(ASourcePart: TFpPascalExpressionPart); override;

public

destructor Destroy; override;

function IsClosed: boolean; override;

function AddController(ACurPart: TFpPascalExpressionPart): TFpPascalExpressionPart;

function AddControllerRecursive(ACurPart: TFpPascalExpressionPart): TFpPascalExpressionPart;

property Controller: TFpPascalExpressionPartOperatorArraySliceController read FController;

end;

{ TFpPasParserValueSlicedArrayIndex }

TFpPasParserValueSlicedArrayIndex = class(TFpSymbol)

private

FLowBound: Int64;

public

function GetValueLowBound(AValueObj: TFpValue; out ALowBound: Int64): Boolean; override;

end;

{ TFpPasParserValue }

TFpPasParserValue = class(TFpValue)

private

FContext: TFpDbgSimpleLocationContext;

// Pos and Text from expressionpart / used in errors

FExprPos: Integer;

FExprText: String;

protected

function DebugText(AIndent: String): String; virtual;

function CreateErrorWithPos(AnErrorCode: TFpErrorCode; AData: array of const): TFpError;

public

constructor Create(AnExpressionPart: TFpPascalExpressionPart);

constructor Create(AContext: TFpDbgSimpleLocationContext; AnExprPos: Integer; AnExprText: String);

property Context: TFpDbgSimpleLocationContext read FContext;

end;

{ TFpPasParserValueSlicedArray }

TFpPasParserValueSlicedArray = class(TFpPasParserValue)

private

FLowBoundIndex: TFpPasParserValueSlicedArrayIndex;

FArraySlice: TFpPascalExpressionPartOperatorArraySliceController;

FOwnsController: Boolean;

FExpressionPartInValue: TFpPascalExpressionPart;

protected

//function DebugText(AIndent: String): String; override;

function SlicePart: TFpPascalExpressionPartOperatorArraySlice; inline;

protected

function GetKind: TDbgSymbolKind; override;

function GetFieldFlags: TFpValueFieldFlags; override;

function GetTypeInfo: TFpSymbol; override;

function GetMember(AIndex: Int64): TFpValue; override;

function GetMemberCount: Integer; override;

function GetIndexType(AIndex: Integer): TFpSymbol; override;

function GetIndexTypeCount: Integer; override;

function GetOrdLowBound: Int64; override;

public

constructor Create(ASlice: TFpPascalExpressionPartOperatorArraySliceController; AnOwnsController: boolean = False);

destructor Destroy; override;

function SliceBracketStartOffs: integer;

function SliceBracketLength: integer;

end;

DBG_WARNINGS: PLazLoggerLogGroup;

// 1 highest

PRECEDENCE_MEMBER_OF = 1; // foo.bar

PRECEDENCE_MAKE_REF = 1; // ^TFoo

PRECEDENCE_ARG_LIST = 2; // foo() / TFoo()

PRECEDENCE_ARRAY_IDX = 2; // foo[1]

PRECEDENCE_DEREF = 5; // a^ // Precedence acts only to the left side

PRECEDENCE_ADRESS_OF = 6; // @a

//PRECEDENCE_POWER = 10; // ** (power) must be stronger than unary -

PRECEDENCE_UNARY_SIGN = 11; // -a

PRECEDENCE_UNARY_NOT = 11; // NOT a

PRECEDENCE_MUL_DIV = 12; // a * b

PRECEDENCE_AND = 12; // a AND b

PRECEDENCE_BIT_SHIFT = 12; // << >> shr shr

PRECEDENCE_PLUS_MINUS = 13; // a + b

PRECEDENCE_OR = 13; // a OR b // XOR

PRECEDENCE_IN = 19; // enum IN set // officially the same as PRECEDENCE_COMPARE

PRECEDENCE_COMPARE = 20; // a <> b // a=b

PRECEDENCE_QUEST_COLON= 27; // ? :

PRECEDENCE_ARRAY_SLICE= 30; // array[5..9] // array slice

PRECEDENCE_SEPARATOR_COLON= MaxInt; // : used as separator in intrinsics // Operator used to hold both sides

{ TFpPascalExpressionPartListForwarder }

TFpPascalExpressionPartListForwarder = class(TObject, TFpValueListIntf)

private

FExpressionPart: TFpPascalExpressionPartContainer;

FListOffset, FCount: Integer;

protected

function GetItems(AIndex: Integer): TFpValue;

public

constructor Create(AnExpressionPart: TFpPascalExpressionPartContainer; AListOffset, ACount: Integer);

function Count: Integer;

end;

{%region DebugSymbol }

{ TPasParserSymbolPointer

TPasParserSymbolPointer = class(TFpSymbol)

private

FPointerLevels: Integer;

FPointedTo: TFpSymbol;

FContext: TFpDbgSimpleLocationContext;

// Pos and Text from expressionpart / used in errors

FExprPos: Integer;

FExprText: String;

protected

// NameNeeded // "^TPointedTo"

procedure TypeInfoNeeded; override;

function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override;

public

constructor Create(const APointedTo: TFpSymbol; AContext: TFpDbgSimpleLocationContext; AnExprPos: Integer; AnExprText: String; APointerLevels: Integer);

constructor Create(const APointedTo: TFpSymbol; AnExpressionPart: TFpPascalExpressionPart; APointerLevels: Integer);

constructor Create(const APointedTo: TFpSymbol; AnExpressionPart: TFpPascalExpressionPart);

destructor Destroy; override;

function TypeCastValue(AValue: TFpValue): TFpValue; override;

end;

{ TPasParserSymbolArrayDeIndex }

TPasParserSymbolArrayDeIndex = class(TFpSymbolForwarder) // 1 index level off

private

FArray: TFpSymbol;

protected

//procedure ForwardToSymbolNeeded; override;

function GetNestedSymbolCount: Integer; override;

function GetNestedSymbol(AIndex: Int64): TFpSymbol; override;

public

constructor Create(const AnArray: TFpSymbol);

destructor Destroy; override;

end;

{%endregion DebugSymbol }

{%region DebugSymbolValue }

{ TFpPasParserValueCastToPointer

TFpPasParserValueCastToPointer = class(TFpPasParserValue)

private

FValue: TFpValue;

FTypeSymbol: TFpSymbol;

protected

function DebugText(AIndent: String): String; override;

protected

function GetKind: TDbgSymbolKind; override;

function GetFieldFlags: TFpValueFieldFlags; override;

function GetTypeInfo: TFpSymbol; override;

function GetAsCardinal: QWord; override;

function GetAsString: AnsiString; override;

function GetAsWideString: WideString; override;

function GetAddress: TFpDbgMemLocation; override;

function GetDerefAddress: TFpDbgMemLocation; override;

function GetMember(AIndex: Int64): TFpValue; override;

public

constructor Create(AValue: TFpValue; ATypeInfo: TFpSymbol; AContext: TFpDbgSimpleLocationContext; AnExprPos: Integer; AnExprText: String);

destructor Destroy; override;

end;

{ TFpPasParserValueMakeReftype }

TFpPasParserValueMakeReftype = class(TFpPasParserValue)

private

FSourceTypeSymbol, FTypeSymbol: TFpSymbol;

FRefLevel: Integer;

protected

function DebugText(AIndent: String): String; override;

protected

function GetDbgSymbol: TFpSymbol; override; // returns a TPasParserSymbolPointer

public

constructor Create(ATypeInfo: TFpSymbol; AnExpressionPart: TFpPascalExpressionPart);

destructor Destroy; override;

procedure IncRefLevel;

function GetTypeCastedValue(ADataVal: TFpValue): TFpValue; override;

end;

{ TFpPasParserValueDerefPointer