Michael Schimmel
956 lines
33 KiB
ObjectPascal
956 lines
33 KiB
ObjectPascal
unit Myc.Ast.Evaluator;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Classes,
|
|
System.Generics.Collections,
|
|
Myc.Data.Scalar,
|
|
Myc.Data.Value,
|
|
Myc.Ast.Nodes,
|
|
Myc.Ast.Scope,
|
|
Myc.Ast;
|
|
|
|
type
|
|
// TEvaluatorVisitor is the base implementation for evaluating an AST.
|
|
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor)
|
|
private
|
|
FScope: IExecutionScope;
|
|
protected
|
|
function IsTruthy(const AValue: TDataValue): Boolean;
|
|
function CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; virtual;
|
|
public
|
|
constructor Create(const AScope: IExecutionScope);
|
|
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
|
|
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
|
|
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual;
|
|
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; virtual;
|
|
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; virtual;
|
|
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; virtual;
|
|
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual;
|
|
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; virtual;
|
|
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; virtual;
|
|
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; virtual;
|
|
function VisitAssignment(const Node: IAssignmentNode): TDataValue; virtual;
|
|
function VisitIndexer(const Node: IIndexerNode): TDataValue; virtual;
|
|
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; virtual;
|
|
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; virtual;
|
|
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; virtual;
|
|
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; 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): TDataValue; override;
|
|
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
|
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
|
|
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
|
|
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
|
|
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
|
|
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
|
|
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
|
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
|
|
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
|
|
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
|
|
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
|
|
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
|
|
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
|
|
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
|
|
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
|
|
end;
|
|
|
|
// Registers all native core functions in the given scope.
|
|
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.TypInfo,
|
|
System.Generics.Defaults,
|
|
Myc.Data.Decimal,
|
|
Myc.Data.Series,
|
|
Myc.Ast.Printer,
|
|
Myc.Data.Scalar.JSON;
|
|
|
|
type
|
|
// The signature for a native Delphi function callable from the script.
|
|
TNativeFunction = function(const Args: TArray<TDataValue>): TDataValue;
|
|
|
|
TClosureValue = class(TInterfacedObject, TDataValue.ICallable)
|
|
private
|
|
FLambdaNode: ILambdaExpressionNode;
|
|
FClosureScope: IExecutionScope;
|
|
FUpvalues: TArray<IValueCell>;
|
|
public
|
|
constructor Create(
|
|
const ALambdaNode: ILambdaExpressionNode;
|
|
const AClosureScope: IExecutionScope;
|
|
const AUpvalues: TArray<IValueCell>
|
|
);
|
|
// ICallable implementation (the generic, slower path)
|
|
function GetArity: Integer;
|
|
function Invoke(const AVisitor: IInterface; const ASelf: TDataValue; const AArgs: TArray<TDataValue>): TDataValue;
|
|
// Fast Path
|
|
function InvokeFast(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): TDataValue;
|
|
end;
|
|
|
|
TNativeClosure = class(TInterfacedObject, TDataValue.ICallable)
|
|
private
|
|
FMethod: TNativeFunction;
|
|
FArity: Integer;
|
|
public
|
|
constructor Create(const AMethod: TNativeFunction; AArity: Integer);
|
|
// ICallable implementation
|
|
function GetArity: Integer;
|
|
function Invoke(const AVisitor: IInterface; const ASelf: TDataValue; const AArgs: TArray<TDataValue>): TDataValue;
|
|
end;
|
|
|
|
// --- Native Functions Implementation ---
|
|
|
|
function NativeCreateRecordSeries(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
jsonDef: string;
|
|
recordDef: TScalarRecordDefinition;
|
|
series: TScalarRecordSeries;
|
|
begin
|
|
// Arity check is now done by the caller (TNativeClosure.Invoke)
|
|
if Args[0].Kind <> vkText then
|
|
raise EArgumentException.Create('CreateRecordSeries requires a 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 := TDataValue.FromRecordSeries(series);
|
|
end;
|
|
|
|
// --- Registration Procedure ---
|
|
|
|
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
|
|
begin
|
|
// Use 'Define' to clearly state that we are adding a new variable
|
|
// to the global scope before the binder runs.
|
|
AScope.Define('CreateRecordSeries', TNativeClosure.Create(NativeCreateRecordSeries, 1));
|
|
end;
|
|
|
|
{ TClosureValue }
|
|
|
|
constructor TClosureValue.Create(
|
|
const ALambdaNode: ILambdaExpressionNode;
|
|
const AClosureScope: IExecutionScope;
|
|
const AUpvalues: TArray<IValueCell>
|
|
);
|
|
begin
|
|
inherited Create;
|
|
FLambdaNode := ALambdaNode;
|
|
FClosureScope := AClosureScope;
|
|
FUpvalues := AUpvalues;
|
|
end;
|
|
|
|
function TClosureValue.GetArity: Integer;
|
|
begin
|
|
Result := Length(FLambdaNode.Parameters);
|
|
end;
|
|
|
|
// This is the generic, slightly slower path, kept for compatibility with ICallable.
|
|
function TClosureValue.Invoke(const AVisitor: IInterface; const ASelf: TDataValue; const AArgs: TArray<TDataValue>): TDataValue;
|
|
var
|
|
i: Integer;
|
|
descriptor: IScopeDescriptor;
|
|
callScope: IExecutionScope;
|
|
adr: TResolvedAddress;
|
|
callVisitor: IAstVisitor;
|
|
begin
|
|
descriptor := FLambdaNode.ScopeDescriptor;
|
|
if not Assigned(descriptor) then
|
|
raise EParserError.Create('Lambda has no scope descriptor. Did the binder run?');
|
|
|
|
callScope := TExecutionScope.Create(FClosureScope, descriptor, FUpvalues);
|
|
|
|
adr.Kind := akLocalOrParent;
|
|
adr.ScopeDepth := 0;
|
|
adr.SlotIndex := 0;
|
|
callScope[adr].Value := ASelf;
|
|
|
|
for i := 0 to High(AArgs) do
|
|
begin
|
|
adr.SlotIndex := FLambdaNode.Parameters[i].Address.SlotIndex;
|
|
callScope[adr].Value := AArgs[i];
|
|
end;
|
|
|
|
callVisitor := (AVisitor as TEvaluatorVisitor).CreateVisitorForScope(callScope);
|
|
Result := FLambdaNode.Body.Accept(callVisitor);
|
|
end;
|
|
|
|
// This is the new, optimized method that evaluates argument nodes directly.
|
|
function TClosureValue.InvokeFast(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): TDataValue;
|
|
var
|
|
i: Integer;
|
|
descriptor: IScopeDescriptor;
|
|
callScope: IExecutionScope;
|
|
adr: TResolvedAddress;
|
|
begin
|
|
// Arity check
|
|
if (AArgNodes.Count <> Length(FLambdaNode.Parameters)) then
|
|
raise EArgumentException
|
|
.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(FLambdaNode.Parameters), AArgNodes.Count]);
|
|
|
|
descriptor := FLambdaNode.ScopeDescriptor;
|
|
if not Assigned(descriptor) then
|
|
raise EParserError.Create('Lambda has no scope descriptor. Did the binder run?');
|
|
|
|
// Create the scope for the call directly
|
|
callScope := TExecutionScope.Create(FClosureScope, descriptor, FUpvalues);
|
|
|
|
adr.Kind := akLocalOrParent;
|
|
adr.ScopeDepth := 0;
|
|
|
|
// Set the 'Self' variable
|
|
adr.SlotIndex := 0;
|
|
callScope[adr].Value := ASelf;
|
|
|
|
// Evaluate arguments DIRECTLY into the new scope (no temporary array!)
|
|
for i := 0 to AArgNodes.Count - 1 do
|
|
begin
|
|
adr.SlotIndex := FLambdaNode.Parameters[i].Address.SlotIndex;
|
|
// Evaluate in CALLER'S scope (AVisitor), place in CALLEE'S scope (callScope)
|
|
callScope[adr].Value := AArgNodes[i].Accept(AVisitor);
|
|
end;
|
|
|
|
// Execute the body with a new visitor for the new scope
|
|
Result := FLambdaNode.Body.Accept((AVisitor as TEvaluatorVisitor).CreateVisitorForScope(callScope));
|
|
end;
|
|
|
|
{ TNativeClosure }
|
|
|
|
constructor TNativeClosure.Create(const AMethod: TNativeFunction; AArity: Integer);
|
|
begin
|
|
inherited Create;
|
|
FMethod := AMethod;
|
|
FArity := AArity;
|
|
end;
|
|
|
|
function TNativeClosure.GetArity: Integer;
|
|
begin
|
|
Result := FArity;
|
|
end;
|
|
|
|
function TNativeClosure.Invoke(const AVisitor: IInterface; const ASelf: TDataValue; const AArgs: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
// Arity check
|
|
if (FArity <> -1) and (Length(AArgs) <> FArity) then
|
|
raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [FArity, Length(AArgs)]);
|
|
|
|
// AVisitor and ASelf are ignored for native calls.
|
|
Result := FMethod(AArgs);
|
|
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: TDataValue): Boolean;
|
|
begin
|
|
if (AValue.Kind <> vkScalar) 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.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
|
var
|
|
calleeValue: TDataValue;
|
|
callable: TDataValue.ICallable;
|
|
i: Integer;
|
|
begin
|
|
calleeValue := Node.Callee.Accept(Self);
|
|
|
|
if calleeValue.Kind <> vkCallable then
|
|
raise EArgumentException.Create('Expression is not a callable value.');
|
|
|
|
callable := calleeValue.AsCallable;
|
|
|
|
if callable is TClosureValue then
|
|
begin
|
|
// "Fast Path": Call the optimized method directly.
|
|
Result := (callable as TClosureValue).InvokeFast(Self, calleeValue, Node.Arguments);
|
|
end
|
|
else
|
|
begin
|
|
// "Generic Path": For other ICallable types (e.g., TNativeClosure).
|
|
// Evaluate arguments into a temporary array first.
|
|
var argValues: TArray<TDataValue>;
|
|
SetLength(argValues, Node.Arguments.Count);
|
|
for i := 0 to Node.Arguments.Count - 1 do
|
|
argValues[i] := Node.Arguments[i].Accept(Self);
|
|
|
|
// Call the generic Invoke method.
|
|
Result := callable.Invoke(Self, calleeValue, argValues);
|
|
end;
|
|
end;
|
|
|
|
{ TEvaluatorVisitor }
|
|
|
|
function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
|
var
|
|
itemValue, lookbackValue, seriesVar: TDataValue;
|
|
lookback: Int64;
|
|
begin
|
|
// The target series must have been resolved by the binder.
|
|
seriesVar := FScope[Node.Series.Address].Value;
|
|
itemValue := Node.Value.Accept(Self);
|
|
lookback := -1;
|
|
|
|
if Assigned(Node.Lookback) then
|
|
begin
|
|
lookbackValue := Node.Lookback.Accept(Self);
|
|
if (lookbackValue.Kind <> vkScalar) 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
|
|
vkSeries:
|
|
begin
|
|
if (itemValue.Kind <> vkScalar) 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.', [itemValue.AsScalar.Kind.ToString, Kind.ToString]);
|
|
|
|
Items.Add(itemValue.AsScalar.Value, lookback);
|
|
end;
|
|
end;
|
|
vkRecordSeries:
|
|
begin
|
|
if (itemValue.Kind <> vkRecord) then
|
|
raise EArgumentException.Create('Can only add record values to a TScalarRecordSeries.');
|
|
|
|
with seriesVar.AsRecordSeries.Value do
|
|
begin
|
|
Add(itemValue.AsRecord.Value, lookback);
|
|
end;
|
|
end;
|
|
else
|
|
raise EArgumentException.Create('"add" operation is only supported for series types.');
|
|
end;
|
|
Result := TDataValue.Void; // 'add' is a procedure, returns void
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
|
begin
|
|
Result := Node.Value.Accept(Self);
|
|
FScope[Node.Identifier.Address].Value := Result;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
|
|
begin
|
|
Result := Node.Value;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
|
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 := TDataValue.FromRecordSeries(recordSeries);
|
|
end
|
|
else
|
|
begin
|
|
var scalarKind := TScalar.StringToKind(def);
|
|
var scalarSeries := TScalarSeries.Create(scalarKind, Default(TSeries<TScalarValue>));
|
|
Result := TDataValue.FromSeries(scalarSeries);
|
|
end;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
|
begin
|
|
Result := FScope[Node.Address].Value;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
|
var
|
|
baseValue, indexValue: TDataValue;
|
|
index: Int64;
|
|
indexScalar: TScalar;
|
|
begin
|
|
baseValue := Node.Base.Accept(Self);
|
|
indexValue := Node.Index.Accept(Self);
|
|
|
|
if (indexValue.Kind <> vkScalar) 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
|
|
vkSeries:
|
|
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 := TScalar.Create(Kind, Items[Integer(index)]);
|
|
end;
|
|
end;
|
|
vkRecordSeries:
|
|
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 := TDataValue.FromRecord(recordValue);
|
|
end;
|
|
vkMemberSeries:
|
|
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]);
|
|
|
|
Result := memberSeries.Items[Integer(index)];
|
|
end;
|
|
else
|
|
raise EArgumentException.Create('Indexer `[]` is not supported for this value type.');
|
|
end;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
|
var
|
|
baseValue: TDataValue;
|
|
memberName: string;
|
|
begin
|
|
baseValue := Node.Base.Accept(Self);
|
|
memberName := Node.Member.Name;
|
|
|
|
case baseValue.Kind of
|
|
vkSeries:
|
|
begin
|
|
with baseValue.AsSeries.Value do
|
|
begin
|
|
if SameText(memberName, 'Count') then
|
|
Result := TScalar.FromInt64(Items.Count)
|
|
else if SameText(memberName, 'TotalCount') then
|
|
Result := TScalar.FromInt64(Items.TotalCount)
|
|
else if SameText(memberName, 'Kind') then
|
|
Result := Kind.ToString
|
|
else
|
|
raise EArgumentException.CreateFmt('Member "%s" not found on TScalarSeries.', [memberName]);
|
|
end;
|
|
end;
|
|
vkRecordSeries: Result := TDataValue.FromMemberSeries(baseValue.AsRecordSeries.Value.CreateMemberSeries(memberName));
|
|
vkRecord: Result := baseValue.AsRecord.Value.Items[memberName];
|
|
else
|
|
raise EArgumentException.Create('Member access operator `.` is not supported for this value type.');
|
|
end;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
|
var
|
|
value: TDataValue;
|
|
begin
|
|
if Assigned(Node.Initializer) then
|
|
value := Node.Initializer.Accept(Self)
|
|
else
|
|
value := TDataValue.Void;
|
|
|
|
FScope[Node.Identifier.Address].Value := value;
|
|
|
|
Result := value;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
|
var
|
|
capturedCells: TArray<IValueCell>;
|
|
i: Integer;
|
|
sourceAddresses: TArray<TResolvedAddress>;
|
|
begin
|
|
// The binder has identified the upvalues. Capture the cells from the current scope
|
|
// using the original source addresses provided by the binder.
|
|
sourceAddresses := Node.Upvalues;
|
|
SetLength(capturedCells, Length(sourceAddresses));
|
|
for i := 0 to High(sourceAddresses) do
|
|
capturedCells[i] := FScope.GetCell(sourceAddresses[i]);
|
|
|
|
Result := TClosureValue.Create(Node, FScope, capturedCells);
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
|
var
|
|
leftValue, rightValue: TDataValue;
|
|
leftScalar, rightScalar: TScalar;
|
|
begin
|
|
leftValue := Node.Left.Accept(Self);
|
|
rightValue := Node.Right.Accept(Self);
|
|
|
|
if (leftValue.Kind <> vkScalar) or (rightValue.Kind <> vkScalar) 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 := TScalar.FromInt64(leftVal + rightVal);
|
|
boSubtract: Result := TScalar.FromInt64(leftVal - rightVal);
|
|
boMultiply: Result := TScalar.FromInt64(leftVal * rightVal);
|
|
boDivide: Result := TScalar.FromInt64(leftVal div rightVal);
|
|
boEqual: Result := TScalar.FromBoolean(leftVal = rightVal);
|
|
boNotEqual: Result := TScalar.FromBoolean(leftVal <> rightVal);
|
|
boLess: Result := TScalar.FromBoolean(leftVal < rightVal);
|
|
boGreater: Result := TScalar.FromBoolean(leftVal > rightVal);
|
|
boLessOrEqual: Result := TScalar.FromBoolean(leftVal <= rightVal);
|
|
boGreaterOrEqual: Result := 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 := TScalar.FromDouble(leftVal + rightVal);
|
|
boSubtract: Result := TScalar.FromDouble(leftVal - rightVal);
|
|
boMultiply: Result := TScalar.FromDouble(leftVal * rightVal);
|
|
boDivide: Result := TScalar.FromDouble(leftVal / rightVal);
|
|
boEqual: Result := TScalar.FromBoolean(leftVal = rightVal);
|
|
boNotEqual: Result := TScalar.FromBoolean(leftVal <> rightVal);
|
|
boLess: Result := TScalar.FromBoolean(leftVal < rightVal);
|
|
boGreater: Result := TScalar.FromBoolean(leftVal > rightVal);
|
|
boLessOrEqual: Result := TScalar.FromBoolean(leftVal <= rightVal);
|
|
boGreaterOrEqual: Result := 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): TDataValue;
|
|
var
|
|
rightValue: TDataValue;
|
|
rightScalar: TScalar;
|
|
begin
|
|
rightValue := Node.Right.Accept(Self);
|
|
|
|
case Node.Operator of
|
|
uoNegate:
|
|
begin
|
|
if (rightValue.Kind <> vkScalar) then
|
|
raise ENotSupportedException.Create('Unary "-" is only supported for scalar types.');
|
|
rightScalar := rightValue.AsScalar;
|
|
case rightScalar.Kind of
|
|
skInt64: Result := TScalar.FromInt64(-rightScalar.Value.AsInt64);
|
|
skDouble: Result := TScalar.FromDouble(-rightScalar.Value.AsDouble);
|
|
else
|
|
raise ENotSupportedException.Create('Unary "-" is not supported for this scalar type.');
|
|
end;
|
|
end;
|
|
uoNot:
|
|
begin
|
|
Result := TScalar.FromBoolean(not IsTruthy(rightValue));
|
|
end;
|
|
else
|
|
raise ENotSupportedException.Create('Unary operator not supported');
|
|
end;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
|
var
|
|
conditionValue: TDataValue;
|
|
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 := TDataValue.Void;
|
|
end;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
|
var
|
|
conditionValue: TDataValue;
|
|
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): TDataValue;
|
|
var
|
|
expression: IAstNode;
|
|
begin
|
|
// The result of a block is the result of its last expression.
|
|
Result := TDataValue.Void;
|
|
for expression in Node.Expressions do
|
|
begin
|
|
Result := expression.Accept(Self);
|
|
end;
|
|
end;
|
|
|
|
function TEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
|
var
|
|
seriesValue: TDataValue;
|
|
len: Int64;
|
|
begin
|
|
seriesValue := Node.Series.Accept(Self);
|
|
|
|
case seriesValue.Kind of
|
|
vkSeries: len := seriesValue.AsSeries.Value.Items.Count;
|
|
vkRecordSeries: len := seriesValue.AsRecordSeries.Value.Count;
|
|
vkMemberSeries: len := seriesValue.AsMemberSeries.Value.Count;
|
|
else
|
|
raise EArgumentException.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TDataValueKind), Ord(seriesValue.Kind))]);
|
|
end;
|
|
|
|
Result := TScalar.FromInt64(len);
|
|
end;
|
|
|
|
{ TDebugEvaluatorVisitor }
|
|
|
|
constructor TDebugEvaluatorVisitor.Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer);
|
|
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): TDataValue;
|
|
begin
|
|
AppendLine('AddSeriesItem {');
|
|
Indent;
|
|
try
|
|
Result := inherited VisitAddSeriesItem(Node);
|
|
finally
|
|
Unindent;
|
|
end;
|
|
AppendLine('} -> (void)');
|
|
end;
|
|
|
|
function TDebugEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
|
begin
|
|
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): TDataValue;
|
|
begin
|
|
AppendLine(Format('Constant (%s)', [Node.Value.ToString]));
|
|
Result := inherited VisitConstant(Node);
|
|
end;
|
|
|
|
function TDebugEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
|
begin
|
|
AppendLine('CreateSeries {');
|
|
Indent;
|
|
try
|
|
Result := inherited VisitCreateSeries(Node);
|
|
finally
|
|
Unindent;
|
|
end;
|
|
AppendLine(Format('} -> %s', [Result.ToString]));
|
|
end;
|
|
|
|
function TDebugEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
|
begin
|
|
Result := inherited VisitIdentifier(Node);
|
|
AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.ToString]));
|
|
end;
|
|
|
|
function TDebugEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
|
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): TDataValue;
|
|
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): TDataValue;
|
|
begin
|
|
AppendLine('IfExpr{');
|
|
Indent;
|
|
try
|
|
Result := inherited VisitIfExpression(Node);
|
|
finally
|
|
Unindent;
|
|
end;
|
|
AppendLine(Format('} -> %s', [Result.ToString]));
|
|
end;
|
|
|
|
function TDebugEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
|
begin
|
|
AppendLine('Indexer {');
|
|
Indent;
|
|
try
|
|
Result := inherited VisitIndexer(Node);
|
|
finally
|
|
Unindent;
|
|
end;
|
|
AppendLine(Format('} -> %s', [Result.ToString]));
|
|
end;
|
|
|
|
function TDebugEvaluatorVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
|
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): TDataValue;
|
|
begin
|
|
AppendLine('TernaryExpr{');
|
|
Indent;
|
|
try
|
|
Result := inherited VisitTernaryExpression(Node);
|
|
finally
|
|
Unindent;
|
|
end;
|
|
AppendLine(Format('} -> %s', [Result.ToString]));
|
|
end;
|
|
|
|
function TDebugEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
|
begin
|
|
AppendLine('LambdaExpr{');
|
|
Indent;
|
|
try
|
|
var pp: IAstVisitor := TPrettyPrintVisitor.Create(0);
|
|
pp.VisitLambdaExpression(Node);
|
|
|
|
AppendMultiline((pp as TPrettyPrintVisitor).GetResult);
|
|
|
|
ShowScope;
|
|
Result := inherited VisitLambdaExpression(Node);
|
|
finally
|
|
Unindent;
|
|
end;
|
|
AppendLine(Format('} -> %s', [Result.ToString]));
|
|
end;
|
|
|
|
function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
|
begin
|
|
AppendLine('FunctionCall{');
|
|
Indent;
|
|
try
|
|
ShowScope;
|
|
Result := inherited VisitFunctionCall(Node);
|
|
finally
|
|
Unindent;
|
|
end;
|
|
AppendLine(Format('} -> %s', [Result.ToString]));
|
|
end;
|
|
|
|
function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
|
begin
|
|
AppendLine('Block{');
|
|
Indent;
|
|
try
|
|
Result := inherited VisitBlockExpression(Node);
|
|
ShowScope;
|
|
finally
|
|
Unindent;
|
|
end;
|
|
AppendLine(Format('} -> %s', [Result.ToString]));
|
|
end;
|
|
|
|
function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
|
begin
|
|
AppendLine(Format('VarDecl %s :=', [Node.Identifier.Name]));
|
|
Indent;
|
|
try
|
|
Result := inherited VisitVariableDeclaration(Node);
|
|
finally
|
|
Unindent;
|
|
end;
|
|
end;
|
|
|
|
function TDebugEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
|
begin
|
|
AppendLine('SeriesLength {');
|
|
Indent;
|
|
try
|
|
Result := inherited VisitSeriesLength(Node);
|
|
finally
|
|
Unindent;
|
|
end;
|
|
AppendLine(Format('} -> %s', [Result.ToString]));
|
|
end;
|
|
|
|
end.
|