Files
MycLib/Src/AST/Myc.Ast.Evaluator.pas
T
2025-10-04 19:05:50 +02:00

549 lines
20 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.Visitor,
Myc.Ast.Binding,
Myc.Ast.Scope;
type
// The standard AST evaluator for production use.
TEvaluatorVisitor = class(TAstVisitor, IEvaluatorVisitor)
private
FScope: IExecutionScope;
procedure HandleTCO(var ResultValue: TDataValue);
protected
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 VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override;
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): 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;
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
function IsTruthy(const AValue: TDataValue): Boolean; inline;
// Returns a closure that can create the correct type of visitor for a lambda's body.
function CreateVisitorFactory: TEvaluatorFactory; virtual;
property Scope: IExecutionScope read FScope;
public
constructor Create(const AScope: IExecutionScope);
// Executes an AST with proper TCO handling. This is the main entry point.
function Execute(const RootNode: IAstNode): TDataValue;
end;
// Registers native Delphi functions into a scope.
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
implementation
uses
System.TypInfo,
System.Generics.Defaults,
Myc.Data.Decimal,
Myc.Data.Series,
Myc.Data.Scalar.JSON;
// Helper type for TCO via trampolining.
type
TThunk = record
Callee: TDataValue;
Args: TArray<TDataValue>;
constructor Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>);
end;
constructor TThunk.Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>);
begin
Callee := ACallee;
Args := AArgs;
end;
// --- Native Functions Implementation ---
function NativeCreateRecordSeries(const Args: TArray<TDataValue>): TDataValue;
var
jsonDef: string;
recordDef: TScalarRecordDefinition;
series: IRecordSeries;
begin
if (Length(Args) <> 1) or (Args[0].Kind <> vkText) 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 := TDataValue.FromRecordSeries(series);
end;
// --- Registration Procedure ---
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
begin
AScope.Define('CreateRecordSeries', TDataValue(NativeCreateRecordSeries));
end;
{ TEvaluatorVisitor }
constructor TEvaluatorVisitor.Create(const AScope: IExecutionScope);
begin
inherited Create;
Assert(Assigned(AScope));
FScope := AScope;
end;
function TEvaluatorVisitor.Execute(const RootNode: IAstNode): TDataValue;
begin
if not Assigned(RootNode) then
exit(TDataValue.Void);
Result := RootNode.Accept(Self);
HandleTCO(Result);
end;
function TEvaluatorVisitor.CreateVisitorFactory: TEvaluatorFactory;
begin
// The production visitor returns a factory that creates another production visitor.
Result := function(const AScope: IExecutionScope): IEvaluatorVisitor begin Result := TEvaluatorVisitor.Create(AScope); end;
end;
procedure TEvaluatorVisitor.HandleTCO(var ResultValue: TDataValue);
begin
// This is the central trampoline loop for Tail Call Optimization.
// It runs as long as the evaluation returns a thunk.
while ResultValue.Kind = vkGeneric do
begin
var thunk := ResultValue.AsGeneric<TThunk>;
var callee := thunk.Callee.AsMethod();
ResultValue := callee(thunk.Args);
end;
end;
function TEvaluatorVisitor.IsTruthy(const AValue: TDataValue): Boolean;
begin
if (AValue.Kind <> vkScalar) then
begin
Result := False;
exit;
end;
case AValue.AsScalar.Kind of
TScalar.TKind.Ordinal: Result := (AValue.AsScalar.Value.AsInt64 <> 0);
TScalar.TKind.Float: Result := (AValue.AsScalar.Value.AsDouble <> 0.0);
else
Result := False;
end;
end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
boundNode: TBoundLambdaExpressionNode;
capturedCells: TArray<IValueCell>;
i: Integer;
sourceAddresses: TArray<TResolvedAddress>;
closureScope: IExecutionScope;
visitorFactory: TEvaluatorFactory;
begin
// Cast to the bound node to access binder-specific information.
boundNode := Node as TBoundLambdaExpressionNode;
// Create the closure by capturing the value cells of all upvalues from the current scope.
sourceAddresses := boundNode.Upvalues;
SetLength(capturedCells, Length(sourceAddresses));
for i := 0 to High(sourceAddresses) do
capturedCells[i] := FScope.Capture(sourceAddresses[i]);
// Memory optimization: a lambda's scope does not need to be kept alive as a parent
// if it contains no nested lambdas that might need to capture from it later.
if boundNode.HasNestedLambdas then
closureScope := FScope
else
closureScope := nil;
// Get a factory to create the correct visitor (e.g., debug or production) for the lambda body.
visitorFactory := CreateVisitorFactory();
var scopeDescriptor := boundNode.ScopeDescriptor;
var params := boundNode.Parameters;
// [weak] prevents a reference cycle since the closure captures itself for 'recur'.
var [weak] closure: TDataValue.TFunc;
var cNode: ILambdaExpressionNode := Node;
closure :=
TDataValue.TFunc(
function(const ArgValues: TArray<TDataValue>): TDataValue
var
lambdaScope: IExecutionScope;
bodyVisitor: IAstVisitor;
i: Integer;
adr: TResolvedAddress;
begin
if (Length(ArgValues) <> Length(params)) then
raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(params), Length(ArgValues)]);
// Create the new execution scope for this function call.
lambdaScope := TScope.CreateScope(closureScope, scopeDescriptor, capturedCells);
adr.Kind := akLocalOrParent;
adr.ScopeDepth := 0;
// Capture the closure itself in slot 0 for 'recur' to find it.
adr.SlotIndex := 0;
lambdaScope[adr] := TDataValue(closure);
// Populate the scope with the actual parameters passed to the function.
for i := 0 to High(ArgValues) do
begin
// Parameters in a bound lambda must be bound identifiers.
adr.SlotIndex := (params[i] as TBoundIdentifierNode).Address.SlotIndex;
lambdaScope[adr] := ArgValues[i];
end;
// Create a visitor with the new scope and execute the lambda's body.
bodyVisitor := visitorFactory(lambdaScope);
Result := cNode.Body.Accept(bodyVisitor);
end
);
// The result of visiting a lambda node is the callable closure itself.
Result := closure;
end;
function TEvaluatorVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
begin
// Macro definitions are compile-time constructs and should have been
// processed and removed from the AST by the TMacroExpander.
// If we encounter one here, it's a compiler pipeline error.
raise Exception.Create('Macro definitions cannot be evaluated at runtime.');
end;
function TEvaluatorVisitor.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue;
begin
raise Exception.Create('Quasiquote nodes are a compile-time construct and cannot be evaluated at runtime.');
end;
function TEvaluatorVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue;
begin
raise Exception.Create('Unquote nodes are a compile-time construct and cannot be evaluated at runtime.');
end;
function TEvaluatorVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
begin
raise Exception.Create('Unquote-splicing nodes are a compile-time construct and cannot be evaluated at runtime.');
end;
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
calleeValue: TDataValue;
argValues: TArray<TDataValue>;
boundNode: TBoundFunctionCallNode;
begin
calleeValue := Node.Callee.Accept(Self);
if calleeValue.Kind <> vkMethod then
raise EArgumentException.Create('Expression is not invokable in this context.');
var argNodes := Node.Arguments;
SetLength(argValues, Length(argNodes));
for var i := 0 to High(argNodes) do
argValues[i] := argNodes[i].Accept(Self);
boundNode := Node as TBoundFunctionCallNode;
if boundNode.IsTailCall then
begin
// This is a tail call. Return a thunk to be processed by the trampoline.
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues));
end
else
begin
// This is a non-tail call. It must execute the call and act as the trampoline.
Result := (calleeValue.AsMethod)(argValues);
HandleTCO(Result);
end;
end;
function TEvaluatorVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue;
var
argValues: TArray<TDataValue>;
calleeAddress: TResolvedAddress;
calleeValue: TDataValue;
i: Integer;
begin
// The binder ensures this is only in a tail position.
SetLength(argValues, Length(Node.Arguments));
for i := 0 to High(Node.Arguments) do
argValues[i] := Node.Arguments[i].Accept(Self);
// The callee is the current function, stored in slot 0 of the current scope.
calleeAddress.Kind := akLocalOrParent;
calleeAddress.ScopeDepth := 0;
calleeAddress.SlotIndex := 0;
calleeValue := FScope[calleeAddress];
// Recur always returns a thunk for the trampoline.
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues));
end;
function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
var
itemValue, lookbackValue, seriesVar: TDataValue;
lookback: Int64;
begin
seriesVar := FScope[(Node.Series as TBoundIdentifierNode).Address];
itemValue := Node.Value.Accept(Self);
lookback := -1;
if Assigned(Node.Lookback) then
begin
lookbackValue := Node.Lookback.Accept(Self);
if (lookbackValue.Kind <> vkScalar) or (lookbackValue.AsScalar.Kind <> TScalar.TKind.Ordinal) then
raise EArgumentException.Create('Lookback parameter must be an integer.');
lookback := lookbackValue.AsScalar.Value.AsInt64;
end;
case seriesVar.Kind of
vkRecordSeries:
begin
if (itemValue.Kind <> vkRecord) then
raise EArgumentException.Create('Can only add record values to a TScalarRecordSeries.');
with seriesVar.AsRecordSeries do
begin
Add(itemValue.AsRecord, lookback);
end;
end;
else
raise EArgumentException.Create('"add" operation is only supported for series types.');
end;
Result := TDataValue.Void;
end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
// Evaluate the new value.
Result := Node.Value.Accept(Self);
// Assign it. The scope's SetValues implementation now handles boxing correctly.
FScope[(Node.Identifier as TBoundIdentifierNode).Address] := 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);
Result := TDataValue.FromSeries(TScalarSeries.Create(scalarKind));
end;
end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
// The scope's GetValues implementation now handles unboxing automatically.
Result := FScope[(Node as TBoundIdentifierNode).Address];
end;
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
var
baseValue, indexValue: TDataValue;
index: Int64;
begin
baseValue := Node.Base.Accept(Self);
indexValue := Node.Index.Accept(Self);
if (indexValue.Kind <> vkScalar) or (indexValue.AsScalar.Kind <> TScalar.TKind.Ordinal) then
raise EArgumentException.Create('Indexer `[]` requires an integer argument.');
index := indexValue.AsScalar.Value.AsInt64;
case baseValue.Kind of
vkSeries:
begin
with baseValue.AsSeries do
begin
if (index < 0) or (index >= TotalCount) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, TotalCount]);
Result := Items[Integer(index)];
end;
end;
vkRecordSeries:
begin
var series := baseValue.AsRecordSeries;
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;
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
vkRecordSeries: Result := TDataValue.FromSeries(baseValue.AsRecordSeries.CreateMemberSeries(memberName));
vkRecord: Result := 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): TDataValue;
var
address: TResolvedAddress;
boundNode: TBoundVariableDeclarationNode;
begin
// First, evaluate the initializer to get the variable's initial value.
if Assigned(Node.Initializer) then
Result := Node.Initializer.Accept(Self)
else
Result := TDataValue.Void;
// After binding, all declaration nodes are TBoundVariableDeclarationNode
boundNode := Node as TBoundVariableDeclarationNode;
address := (boundNode.Identifier as TBoundIdentifierNode).Address;
// Check the IsBoxed flag set by the binder.
if boundNode.IsBoxed then
begin
// This is a captured variable. Use the clean scope method to create the box.
Assert(address.ScopeDepth = 0);
FScope.DefineBoxed(address.SlotIndex, Result);
end
else
begin
// This is a standard local variable. Store the raw value directly.
FScope[address] := Result;
end;
end;
function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
var
leftValue, rightValue: TDataValue;
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.');
var res: TScalar;
if not TScalar.TryBinaryOperation(Node.Operator, leftValue.AsScalar, rightValue.AsScalar, res) then
raise ENotSupportedException.Create(
'Binary operation not supported for scalar types '
+ leftValue.AsScalar.Kind.ToString
+ ' and '
+ rightValue.AsScalar.Kind.ToString
+ ' .');
Result := res;
end;
function TEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
var
rightValue: TDataValue;
begin
rightValue := Node.Right.Accept(Self);
if rightValue.Kind <> vkScalar then
raise ENotSupportedException.Create('Unary operations are only supported for scalar types.');
var res: TScalar;
if not TScalar.TryUnaryOperation(Node.Operator, rightValue.AsScalar, res) then
raise ENotSupportedException.Create('Unary operation not supported for scalar type' + rightValue.AsScalar.Kind.ToString + '.');
Result := res;
end;
function TEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
if IsTruthy(Node.Condition.Accept(Self)) then
Result := Node.ThenBranch.Accept(Self)
else if Assigned(Node.ElseBranch) then
Result := Node.ElseBranch.Accept(Self)
else
Result := TDataValue.Void;
end;
function TEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
if IsTruthy(Node.Condition.Accept(Self)) then
Result := Node.ThenBranch.Accept(Self)
else
Result := Node.ElseBranch.Accept(Self);
end;
function TEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
expression: IAstNode;
begin
Result := TDataValue.Void;
for expression in Node.Expressions do
Result := expression.Accept(Self);
end;
function TEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
var
seriesValue: TDataValue;
len: Int64;
begin
seriesValue := FScope[(Node.Series as TBoundIdentifierNode).Address];
case seriesValue.Kind of
vkSeries: len := seriesValue.AsSeries.Count;
vkRecordSeries: len := seriesValue.AsRecordSeries.Count;
else
raise EArgumentException.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TDataValueKind), Ord(seriesValue.Kind))]);
end;
Result := TScalar.FromInt64(len);
end;
end.