Files
MycLib/Src/AST/Myc.Ast.Evaluator.pas
T
Michael Schimmel 9c90a92b04 Ast Binding
2025-09-04 01:41:09 +02:00

973 lines
34 KiB
ObjectPascal

unit Myc.Ast.Evaluator;
interface
uses
System.SysUtils,
System.Classes, // For TStrings
System.Generics.Collections,
Myc.Data.Scalar,
Myc.Ast.Nodes,
Myc.Ast;
type
// TEvaluatorVisitor is the base implementation for evaluating an AST.
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor)
private
FScope: IExecutionScope;
protected
function IsTruthy(const AValue: TAstValue): Boolean;
function CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; virtual;
public
constructor Create(const AScope: IExecutionScope);
function VisitConstant(const Node: IConstantNode): TAstValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TAstValue; virtual;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; virtual;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; virtual;
function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; virtual;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; virtual;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; virtual;
function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; virtual;
function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; virtual;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; virtual;
function VisitAssignment(const Node: IAssignmentNode): TAstValue; virtual;
function VisitIndexer(const Node: IIndexerNode): TAstValue; virtual;
function VisitMemberAccess(const Node: IMemberAccessNode): TAstValue; virtual;
function VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue; virtual;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue; virtual;
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue; virtual;
end;
// TDebugEvaluatorVisitor now overrides all visit methods for full tracing
TDebugEvaluatorVisitor = class(TEvaluatorVisitor)
private
FLog: TStrings;
FIndentLevel: Integer;
FShowScope: Boolean;
procedure Indent;
procedure Unindent;
procedure AppendLine(const S: string);
procedure AppendMultiline(const S: string);
procedure ShowScope;
protected
function CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; override;
public
constructor Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0);
function VisitConstant(const Node: IConstantNode): TAstValue; override;
function VisitIdentifier(const Node: IIdentifierNode): TAstValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; override;
function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; override;
function VisitAssignment(const Node: IAssignmentNode): TAstValue; override;
function VisitIndexer(const Node: IIndexerNode): TAstValue; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TAstValue; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue; override;
end;
// Registers all native core functions in the given scope.
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
implementation
uses
System.TypInfo,
Myc.Data.Decimal,
Myc.Data.Series,
Myc.Ast.Scope,
Myc.Ast.Printer,
Myc.Data.Scalar.JSON;
type
// The signature for a native Delphi function callable from the script.
TNativeFunction = function(const Args: TArray<TAstValue>): TAstValue;
// Concrete implementation of the IEvaluatorClosure interface for script-defined functions.
TClosureValue = class(TInterfacedObject, IEvaluatorClosure)
private
FBody: IExpressionNode;
FParameters: TArray<IIdentifierNode>;
FClosureScope: IExecutionScope;
function GetBody: IExpressionNode;
function GetParameters: TArray<IIdentifierNode>;
function GetClosureScope: IExecutionScope;
public
constructor Create(ABody: IExpressionNode; const AParameters: TArray<IIdentifierNode>; const AClosureScope: IExecutionScope);
end;
// Concrete implementation of IEvaluatorClosure for native Delphi functions.
TNativeClosure = class(TInterfacedObject, IEvaluatorClosure)
private
FMethod: TNativeFunction;
function GetBody: IExpressionNode;
function GetParameters: TArray<IIdentifierNode>;
function GetClosureScope: IExecutionScope;
public
constructor Create(const AMethod: TNativeFunction);
property Method: TNativeFunction read FMethod;
end;
// --- Helper Functions ---
function ScalarKindToString(AKind: TScalarKind): string;
begin
case AKind of
skInteger: Result := 'integer';
skInt64: Result := 'int64';
skUInt64: Result := 'uint64';
skSingle: Result := 'single';
skDouble: Result := 'double';
skDateTime: Result := 'datetime';
skTimestamp: Result := 'timestamp';
skBoolean: Result := 'boolean';
skChar: Result := 'char';
skPChar: Result := 'pchar';
skString: Result := 'string';
skBytes: Result := 'bytes';
skDecimal: Result := 'decimal';
else
Result := 'unknown';
end;
end;
function StringToScalarKind(const AName: string): TScalarKind;
begin
if SameText(AName, 'integer') then
Result := skInteger
else if SameText(AName, 'int64') then
Result := skInt64
else if SameText(AName, 'uint64') then
Result := skUInt64
else if SameText(AName, 'single') then
Result := skSingle
else if SameText(AName, 'double') then
Result := skDouble
else if SameText(AName, 'datetime') then
Result := skDateTime
else if SameText(AName, 'timestamp') then
Result := skTimestamp
else if SameText(AName, 'boolean') then
Result := skBoolean
else if SameText(AName, 'char') then
Result := skChar
else if SameText(AName, 'pchar') then
Result := skPChar
else if SameText(AName, 'string') then
Result := skString
else if SameText(AName, 'bytes') then
Result := skBytes
else if SameText(AName, 'decimal') then
Result := skDecimal
else
raise EArgumentException.CreateFmt('Unknown scalar type name: "%s"', [AName]);
end;
// --- Native Functions Implementation ---
function NativeCreateRecordSeries(const Args: TArray<TAstValue>): TAstValue;
var
jsonDef: string;
recordDef: TScalarRecordDefinition;
series: TScalarRecordSeries;
begin
if (Length(Args) <> 1) or (Args[0].Kind <> avkText) then
raise EArgumentException.Create('CreateRecordSeries requires one string argument.');
jsonDef := Args[0].AsText;
recordDef := TRttiAstHelper.JsonToRecordDefinition(jsonDef);
if Length(recordDef.Fields) = 0 then
raise EArgumentException.Create('Failed to parse record definition from JSON.');
series := TScalarRecordSeries.Create(recordDef);
Result := TAstValue.FromRecordSeries(series);
end;
// --- Registration Procedure ---
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
var
closure: IEvaluatorClosure;
begin
// Use 'Define' to clearly state that we are adding a new variable
// to the global scope before the binder runs.
closure := TNativeClosure.Create(NativeCreateRecordSeries);
AScope.Define('CreateRecordSeries', TAstValue.FromClosure(closure));
end;
{ TClosureValue }
constructor TClosureValue.Create(ABody: IExpressionNode; const AParameters: TArray<IIdentifierNode>; const AClosureScope: IExecutionScope);
begin
inherited Create;
FBody := ABody;
FParameters := AParameters;
FClosureScope := AClosureScope;
end;
function TClosureValue.GetBody: IExpressionNode;
begin
Result := FBody;
end;
function TClosureValue.GetClosureScope: IExecutionScope;
begin
Result := FClosureScope;
end;
function TClosureValue.GetParameters: TArray<IIdentifierNode>;
begin
Result := FParameters;
end;
{ TNativeClosure }
constructor TNativeClosure.Create(const AMethod: TNativeFunction);
begin
inherited Create;
FMethod := AMethod;
end;
function TNativeClosure.GetBody: IExpressionNode;
begin
Result := nil;
end;
function TNativeClosure.GetClosureScope: IExecutionScope;
begin
Result := nil;
end;
function TNativeClosure.GetParameters: TArray<IIdentifierNode>;
begin
Result := nil;
end;
{ TEvaluatorVisitor }
constructor TEvaluatorVisitor.Create(const AScope: IExecutionScope);
begin
inherited Create;
Assert(Assigned(AScope));
FScope := AScope;
end;
function TEvaluatorVisitor.CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor;
begin
Result := TEvaluatorVisitor.Create(AScope);
end;
function TEvaluatorVisitor.IsTruthy(const AValue: TAstValue): Boolean;
begin
if (AValue.Kind <> avkScalar) then
begin
Exit(False);
end;
case AValue.AsScalar.Kind of
skInteger: Result := (AValue.AsScalar.Value.AsInteger <> 0);
skInt64: Result := (AValue.AsScalar.Value.AsInt64 <> 0);
skUInt64: Result := (AValue.AsScalar.Value.AsUInt64 <> 0);
skBoolean: Result := (AValue.AsScalar.Value.AsBoolean);
else
Result := False;
end;
end;
function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue;
var
itemValue, lookbackValue, seriesVar: TAstValue;
lookback: Int64;
depth, index: Integer;
begin
// The target series must have been resolved by the binder.
if not Node.Series.Resolve(depth, index) then
raise EArgumentException
.CreateFmt('Identifier could not be resolved: "%s". This should have been caught by the binder.', [Node.Series.Name]);
seriesVar := FScope.GetValue(depth, index);
itemValue := Node.Value.Accept(Self);
lookback := -1;
if Assigned(Node.Lookback) then
begin
lookbackValue := Node.Lookback.Accept(Self);
if (lookbackValue.Kind <> avkScalar) or not (lookbackValue.AsScalar.Kind in [skInteger, skInt64]) then
raise EArgumentException.Create('Lookback parameter must be an integer.');
if lookbackValue.AsScalar.Kind = skInteger then
lookback := lookbackValue.AsScalar.Value.AsInteger
else
lookback := lookbackValue.AsScalar.Value.AsInt64;
end;
// Dispatch based on series type
case seriesVar.Kind of
avkSeries:
begin
if (itemValue.Kind <> avkScalar) then
raise EArgumentException.Create('Can only add scalar values to a TScalarSeries.');
with seriesVar.AsSeries.Value do
begin
if (itemValue.AsScalar.Kind <> Kind) then
raise EArgumentException.CreateFmt(
'Type mismatch: Cannot add %s to a series of %s.',
[ScalarKindToString(itemValue.AsScalar.Kind), ScalarKindToString(Kind)]);
Items.Add(itemValue.AsScalar.Value, lookback);
end;
end;
avkRecordSeries:
begin
if (itemValue.Kind <> avkRecord) then
raise EArgumentException.Create('Can only add record values to a TScalarRecordSeries.');
with seriesVar.AsRecordSeries.Value do
begin
Add(itemValue.AsRecord, lookback);
end;
end;
else
raise EArgumentException.Create('"add" operation is only supported for series types.');
end;
end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue;
var
value: TAstValue;
depth, index: Integer;
begin
value := Node.Value.Accept(Self);
if not Node.Identifier.Resolve(depth, index) then
raise EArgumentException
.CreateFmt('Identifier could not be resolved: "%s". This should have been caught by the binder.', [Node.Identifier.Name]);
FScope.AssignValue(depth, index, value);
Result := value;
end;
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TAstValue;
begin
Result := TAstValue.FromScalar(Node.Value);
end;
function TEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue;
var
def: string;
begin
def := Node.Definition.Trim;
if def.StartsWith('[') then
begin
var recordDef := TRttiAstHelper.JsonToRecordDefinition(def);
if Length(recordDef.Fields) = 0 then
raise EArgumentException.Create('Failed to parse record definition from JSON array.');
var recordSeries := TScalarRecordSeries.Create(recordDef);
Result := TAstValue.FromRecordSeries(recordSeries);
end
else
begin
var scalarKind := StringToScalarKind(def);
var scalarSeries := TScalarSeries.Create(scalarKind, Default(TSeries<TScalarValue>));
Result := TAstValue.FromSeries(scalarSeries);
end;
end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
var
depth, index: Integer;
begin
if Node.Resolve(depth, index) then
Result := FScope.GetValue(depth, index)
else
// This should not happen if the binder ran successfully.
raise EArgumentException
.CreateFmt('Identifier could not be resolved: "%s". This should have been caught by the binder.', [Node.Name]);
end;
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue;
var
baseValue, indexValue: TAstValue;
index: Int64;
indexScalar: TScalar;
begin
baseValue := Node.Base.Accept(Self);
indexValue := Node.Index.Accept(Self);
if (indexValue.Kind <> avkScalar) then
raise EArgumentException.Create('Indexer `[]` requires a scalar integer argument.');
indexScalar := indexValue.AsScalar;
case indexScalar.Kind of
skInteger: index := indexScalar.Value.AsInteger;
skInt64: index := indexScalar.Value.AsInt64;
else
raise EArgumentException.Create('Indexer `[]` requires an integer type argument.');
end;
case baseValue.Kind of
avkSeries:
begin
with baseValue.AsSeries.Value do
begin
if (index < 0) or (index >= Items.TotalCount) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, Items.TotalCount]);
Result := TAstValue.FromScalar(TScalar.Create(Kind, Items[Integer(index)]));
end;
end;
avkRecordSeries:
begin
var series := baseValue.AsRecordSeries.Value;
if (index < 0) or (index >= series.TotalCount) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, series.TotalCount]);
var recordValue := series.Items[Integer(index)];
Result := TAstValue.FromRecord(recordValue);
end;
avkMemberSeries:
begin
var memberSeries := baseValue.AsMemberSeries.Value;
if (index < 0) or (index >= memberSeries.Count) then
raise EArgumentException
.CreateFmt('Index %d is out of bounds for member series with %d elements.', [index, memberSeries.Count]);
var scalarValue := memberSeries.Items[Integer(index)];
Result := TAstValue.FromScalar(scalarValue);
end;
else
raise EArgumentException.Create('Indexer `[]` is not supported for this value type.');
end;
end;
function TEvaluatorVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TAstValue;
var
baseValue: TAstValue;
memberName: string;
begin
baseValue := Node.Base.Accept(Self);
memberName := Node.Member.Name;
case baseValue.Kind of
avkSeries:
begin
with baseValue.AsSeries.Value do
begin
if SameText(memberName, 'Count') then
Result := TAstValue.FromScalar(TScalar.FromInt64(Items.Count))
else if SameText(memberName, 'TotalCount') then
Result := TAstValue.FromScalar(TScalar.FromInt64(Items.TotalCount))
else if SameText(memberName, 'Kind') then
Result := TAstValue.FromText(ScalarKindToString(Kind))
else
raise EArgumentException.CreateFmt('Member "%s" not found on TScalarSeries.', [memberName]);
end;
end;
avkRecordSeries: Result := TAstValue.FromMemberSeries(baseValue.AsRecordSeries.Value.CreateMemberSeries(memberName));
avkRecord: Result := TAstValue.FromScalar(baseValue.AsRecord.Items[memberName]);
else
raise EArgumentException.Create('Member access operator `.` is not supported for this value type.');
end;
end;
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
var
value: TAstValue;
begin
if Assigned(Node.Initializer) then
value := Node.Initializer.Accept(Self)
else
value := TAstValue.Void;
FScope.Define(Node.Identifier.Name, value);
Result := value;
end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
var
closureImpl: IEvaluatorClosure;
begin
closureImpl := TClosureValue.Create(Node.Body, Node.Parameters, FScope);
Result := TAstValue.FromClosure(closureImpl);
end;
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue;
var
calleeValue: TAstValue;
closure: IEvaluatorClosure;
i: Integer;
argValues: TArray<TAstValue>;
callScope: IExecutionScope;
innerVisitor: IAstVisitor;
begin
calleeValue := Node.Callee.Accept(Self);
if calleeValue.Kind <> avkClosure then
raise EArgumentException.Create('Expression is not a callable closure.');
closure := calleeValue.AsClosure;
if closure is TNativeClosure then
begin
SetLength(argValues, Node.Arguments.Count);
for i := 0 to Node.Arguments.Count - 1 do
begin
argValues[i] := Node.Arguments[i].Accept(Self);
end;
Result := (closure as TNativeClosure).Method(argValues);
end
else if closure is TClosureValue then
begin
if (Node.Arguments.Count <> Length(closure.Parameters)) then
raise EArgumentException
.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), Node.Arguments.Count]);
callScope := TExecutionScope.Create(closure.ClosureScope);
// The order of definitions must exactly match the binder's order.
// Define 'Self' first.
callScope.Define('Self', calleeValue);
// 2. Then, define the parameters.
for i := 0 to Node.Arguments.Count - 1 do
begin
var argValue := Node.Arguments[i].Accept(Self);
callScope.Define(closure.Parameters[i].Name, argValue);
end;
innerVisitor := Self.CreateVisitorForScope(callScope);
Result := closure.Body.Accept(innerVisitor);
end
else
raise EArgumentException.Create('Unknown closure implementation type.');
end;
function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue;
var
leftValue, rightValue: TAstValue;
leftScalar, rightScalar: TScalar;
begin
leftValue := Node.Left.Accept(Self);
rightValue := Node.Right.Accept(Self);
if (leftValue.Kind <> avkScalar) or (rightValue.Kind <> avkScalar) then
raise ENotSupportedException.Create('Binary operations are only supported for scalar types.');
leftScalar := leftValue.AsScalar;
rightScalar := rightValue.AsScalar;
if (leftScalar.Kind <> rightScalar.Kind) then
begin
if (leftScalar.Kind = skInt64) and (rightScalar.Kind = skDouble) then
begin
leftScalar := TScalar.FromDouble(leftScalar.Value.AsInt64);
end
else if (leftScalar.Kind = skDouble) and (rightScalar.Kind = skInt64) then
begin
rightScalar := TScalar.FromDouble(rightScalar.Value.AsInt64);
end
else
begin
raise ENotSupportedException.Create(
'Binary operations are only supported for compatible types. ' + leftScalar.ToString + ' ' + rightScalar.ToString);
end;
end;
case leftScalar.Kind of
skInt64:
begin
var leftVal := leftScalar.Value.AsInt64;
var rightVal := rightScalar.Value.AsInt64;
case Node.Operator of
boAdd: Result := TAstValue.FromScalar(TScalar.FromInt64(leftVal + rightVal));
boSubtract: Result := TAstValue.FromScalar(TScalar.FromInt64(leftVal - rightVal));
boMultiply: Result := TAstValue.FromScalar(TScalar.FromInt64(leftVal * rightVal));
boDivide: Result := TAstValue.FromScalar(TScalar.FromInt64(leftVal div rightVal));
boEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal = rightVal));
boNotEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal <> rightVal));
boLess: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal < rightVal));
boGreater: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal > rightVal));
boLessOrEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal <= rightVal));
boGreaterOrEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal >= rightVal));
else
raise ENotSupportedException.Create('Operator not supported for Int64.');
end;
end;
skDouble:
begin
var leftVal := leftScalar.Value.AsDouble;
var rightVal := rightScalar.Value.AsDouble;
case Node.Operator of
boAdd: Result := TAstValue.FromScalar(TScalar.FromDouble(leftVal + rightVal));
boSubtract: Result := TAstValue.FromScalar(TScalar.FromDouble(leftVal - rightVal));
boMultiply: Result := TAstValue.FromScalar(TScalar.FromDouble(leftVal * rightVal));
boDivide: Result := TAstValue.FromScalar(TScalar.FromDouble(leftVal / rightVal));
boEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal = rightVal));
boNotEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal <> rightVal));
boLess: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal < rightVal));
boGreater: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal > rightVal));
boLessOrEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal <= rightVal));
boGreaterOrEqual: Result := TAstValue.FromScalar(TScalar.FromBoolean(leftVal >= rightVal));
else
raise ENotSupportedException.Create('Operator not supported for Double.');
end;
end;
else
raise ENotSupportedException.Create('Binary operations are not supported for this scalar type.');
end;
end;
function TEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue;
var
rightValue: TAstValue;
rightScalar: TScalar;
begin
rightValue := Node.Right.Accept(Self);
case Node.Operator of
uoNegate:
begin
if (rightValue.Kind <> avkScalar) then
raise ENotSupportedException.Create('Unary "-" is only supported for scalar types.');
rightScalar := rightValue.AsScalar;
case rightScalar.Kind of
skInt64: Result := TAstValue.FromScalar(TScalar.FromInt64(-rightScalar.Value.AsInt64));
skDouble: Result := TAstValue.FromScalar(TScalar.FromDouble(-rightScalar.Value.AsDouble));
else
raise ENotSupportedException.Create('Unary "-" is not supported for this scalar type.');
end;
end;
uoNot:
begin
Result := TAstValue.FromScalar(TScalar.FromBoolean(not IsTruthy(rightValue)));
end;
else
raise ENotSupportedException.Create('Unary operator not supported');
end;
end;
function TEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue;
var
conditionValue: TAstValue;
begin
conditionValue := Node.Condition.Accept(Self);
if IsTruthy(conditionValue) then
Result := Node.ThenBranch.Accept(Self)
else
begin
if Assigned(Node.ElseBranch) then
Result := Node.ElseBranch.Accept(Self)
else
Result := TAstValue.Void;
end;
end;
function TEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue;
var
conditionValue: TAstValue;
begin
conditionValue := Node.Condition.Accept(Self);
if IsTruthy(conditionValue) then
Result := Node.ThenBranch.Accept(Self)
else
Result := Node.ElseBranch.Accept(Self);
end;
function TEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
var
expression: IExpressionNode;
begin
// The result of a block is the result of its last expression.
Result := TAstValue.Void;
for expression in Node.Expressions do
begin
Result := expression.Accept(Self);
end;
end;
function TEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue;
var
seriesValue: TAstValue;
len: Int64;
begin
seriesValue := Node.Series.Accept(Self);
case seriesValue.Kind of
avkSeries: len := seriesValue.AsSeries.Value.Items.Count;
avkRecordSeries: len := seriesValue.AsRecordSeries.Value.Count;
avkMemberSeries: len := seriesValue.AsMemberSeries.Value.Count;
else
raise EArgumentException.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TAstValueKind), Ord(seriesValue.Kind))]);
end;
Result := TAstValue.FromScalar(TScalar.FromInt64(len));
end;
{ TDebugEvaluatorVisitor }
constructor TDebugEvaluatorVisitor.Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0);
begin
inherited Create(AScope);
Assert(Assigned(ALog));
FLog := ALog;
FIndentLevel := AInitialIndent;
FShowScope := AShowScope;
ShowScope;
end;
function TDebugEvaluatorVisitor.CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor;
begin
Result := TDebugEvaluatorVisitor.Create(AScope, FLog, FShowScope, FIndentLevel);
end;
procedure TDebugEvaluatorVisitor.Indent;
begin
inc(FIndentLevel);
end;
procedure TDebugEvaluatorVisitor.Unindent;
begin
dec(FIndentLevel);
end;
procedure TDebugEvaluatorVisitor.AppendLine(const S: string);
var
pad: string;
i: Integer;
begin
pad := '';
for i := 0 to FIndentLevel - 1 do
begin
pad := pad + ':' + ''.PadLeft(3);
end;
FLog.Add(pad + S);
end;
procedure TDebugEvaluatorVisitor.AppendMultiline(const S: string);
begin
var Str := TStringList.Create;
try
Str.Text := s;
for var i := 0 to Str.Count - 1 do
AppendLine(Str[i]);
finally
Str.Free;
end;
end;
procedure TDebugEvaluatorVisitor.ShowScope;
var
scopeDump: TArray<string>;
line: string;
begin
if FShowScope then
begin
AppendLine('-- Scope --');
scopeDump := FScope.Dump.Split([sLineBreak]);
for line in scopeDump do
begin
AppendLine(line);
end;
AppendLine('-----------');
end;
end;
function TDebugEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue;
begin
AppendLine('AddSeriesItem {');
Indent;
try
Result := inherited VisitAddSeriesItem(Node);
finally
Unindent;
end;
AppendLine('} -> (void)');
end;
function TDebugEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue;
begin
// The name is not easily available anymore for logging.
AppendLine(Format('Assignment to "%s" {', [Node.Identifier.Name]));
Indent;
try
Result := inherited VisitAssignment(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TAstValue;
begin
AppendLine(Format('Constant (%s)', [Node.Value.ToString]));
Result := inherited VisitConstant(Node);
end;
function TDebugEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue;
begin
AppendLine('CreateSeries {');
Indent;
try
Result := inherited VisitCreateSeries(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
begin
Result := inherited VisitIdentifier(Node);
AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue;
begin
AppendLine(Format('BinaryExpr "%s" {', [Node.Operator.ToString]));
Indent;
try
Result := inherited VisitBinaryExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue;
begin
AppendLine(Format('UnaryExpr "%s" {', [Node.Operator.ToString]));
Indent;
try
Result := inherited VisitUnaryExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue;
begin
AppendLine('IfExpr{');
Indent;
try
Result := inherited VisitIfExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue;
begin
AppendLine('Indexer {');
Indent;
try
Result := inherited VisitIndexer(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TAstValue;
begin
AppendLine(Format('MemberAccess (Member: %s) {', [Node.Member.Name]));
Indent;
try
Result := inherited VisitMemberAccess(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue;
begin
AppendLine('TernaryExpr{');
Indent;
try
Result := inherited VisitTernaryExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
begin
AppendLine('LambdaExpr{');
Indent;
try
var pp: IAstVisitor := TPrettyPrintVisitor.Create(0);
pp.VisitLambdaExpression(Node);
AppendMultiline((pp as TPrettyPrintVisitor).GetResult);
Result := inherited VisitLambdaExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue;
begin
AppendLine('FunctionCall{');
Indent;
try
Result := inherited VisitFunctionCall(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
begin
AppendLine('Block{');
Indent;
try
ShowScope;
Result := inherited VisitBlockExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
begin
AppendLine(Format('VarDecl %s :=', [Node.Identifier.Name]));
Indent;
try
Result := inherited VisitVariableDeclaration(Node);
finally
Unindent;
end;
end;
function TDebugEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue;
begin
AppendLine('SeriesLength {');
Indent;
try
Result := inherited VisitSeriesLength(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
end.