Files
MycLib/Src/AST/Myc.Ast.Evaluator.pas
T
2025-12-09 12:59:36 +01:00

640 lines
22 KiB
ObjectPascal

unit Myc.Ast.Evaluator;
interface
uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Ast.Nodes, // Provides EAstException
Myc.Ast.Scope,
Myc.Data.Keyword;
type
// Exception for runtime errors during script evaluation
EEvaluatorException = class(EAstException);
// The standard AST evaluator for production use.
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor, IEvaluatorVisitor)
private
FScope: IExecutionScope;
protected
// IAstVisitor methods made virtual for TDebugEvaluatorVisitor to override
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
function VisitKeyword(const Node: IKeywordNode): TDataValue; virtual;
// List Visitors
function VisitParameterList(const Node: IParameterList): TDataValue; virtual;
function VisitArgumentList(const Node: IArgumentList): TDataValue; virtual;
function VisitExpressionList(const Node: IExpressionList): TDataValue; virtual;
function VisitRecordFieldList(const Node: IRecordFieldList): TDataValue; virtual;
function VisitRecordField(const Node: IRecordFieldNode): TDataValue; virtual;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; virtual;
function VisitCondExpression(const Node: ICondExpressionNode): TDataValue; virtual; // Replaces Ternary
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual;
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; virtual;
function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; virtual;
function VisitUnquote(const Node: IUnquoteNode): TDataValue; virtual;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; virtual;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; virtual;
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): 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 VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; virtual;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; virtual;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; virtual;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual;
function VisitRecurNode(const Node: IRecurNode): TDataValue; virtual;
function VisitNop(const Node: INopNode): TDataValue; virtual;
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;
class procedure HandleTCO(var ResultValue: TDataValue); static;
end;
implementation
uses
System.TypInfo,
System.Generics.Defaults,
Myc.Ast,
Myc.Data.Decimal,
Myc.Data.Series,
Myc.Data.Scalar.JSON,
Myc.Ast.Types,
Myc.Data.Records;
// Helper type for TCO via trampolining.
type
TThunk = record
Callee: TDataValue;
Args: TArray<TDataValue>;
Recur: Boolean;
constructor Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>; ARecur: Boolean);
end;
constructor TThunk.Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>; ARecur: Boolean);
begin
Callee := ACallee;
Args := AArgs;
Recur := ARecur;
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);
try
Result := RootNode.Accept(Self);
HandleTCO(Result);
except
on E: EAstException do
raise; // Already a compiler/runtime exception, pass through
on E: Exception do
// Wrap unexpected RTL exceptions (e.g. EDivByZero, EConvertError)
raise EEvaluatorException.Create('Runtime Error: ' + E.Message);
end;
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;
class procedure TEvaluatorVisitor.HandleTCO(var ResultValue: TDataValue);
begin
// This is the central trampoline loop for Tail Call Optimization.
try
while ResultValue.Kind = vkGeneric do
begin
var thunk := ResultValue.AsGeneric<TThunk>;
var callee := thunk.Callee.AsMethod();
ResultValue := callee(thunk.Args);
end;
except
on E: EAstException do
raise;
on E: Exception do
raise EEvaluatorException.Create('Runtime Error (TCO): ' + E.Message);
end;
end;
function TEvaluatorVisitor.IsTruthy(const AValue: TDataValue): Boolean;
begin
// Other types (Text, Series, etc.) are considered "false" in a boolean context
if (AValue.Kind <> vkScalar) then
exit(false);
case AValue.AsScalar.Kind of
TScalar.TKind.Ordinal: Result := AValue.AsScalar.Value.AsInt64 <> 0;
TScalar.TKind.Float: Result := AValue.AsScalar.Value.AsDouble <> 0.0;
TScalar.TKind.Keyword: Result := AValue.AsScalar.Value.AsInt64 <> 0;
TScalar.TKind.Boolean: Result := AValue.AsScalar.Value.AsInt64 <> 0;
TScalar.TKind.DateTime: Result := AValue.AsScalar.Value.AsDouble <> 0.0;
else
Result := false;
end;
end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
capturedCells: TArray<IValueCell>;
i: Integer;
closureScope: IExecutionScope;
visitorFactory: TEvaluatorFactory;
begin
// 1. Capture Upvalues
if Node.Upvalues <> nil then
begin
SetLength(capturedCells, Length(Node.Upvalues));
for i := 0 to High(Node.Upvalues) do
capturedCells[i] := FScope.Capture(Node.Upvalues[i]);
end
else
capturedCells := nil;
// 2. Determine Parent Scope for Closure
if Node.HasNestedLambdas then
closureScope := FScope
else
closureScope := nil;
// 3. Prepare Visitor Factory
visitorFactory := CreateVisitorFactory();
// 4. Capture Metadata for Closure
var descriptor := Node.Descriptor;
var params := Node.Parameters;
var cNode: ILambdaExpressionNode := Node;
var [unsafe] closure: TDataValue.TFunc;
closure :=
function(const ArgValues: TArray<TDataValue>): TDataValue
var
lambdaScope: IExecutionScope;
bodyVisitor: IAstVisitor;
i: Integer;
adr: TResolvedAddress;
begin
if (Length(ArgValues) <> params.Count) then
raise EEvaluatorException.CreateFmt('Argument count mismatch: expected %d, got %d', [params.Count, Length(ArgValues)]);
// Create the new execution scope for this function call.
lambdaScope := TScope.CreateScope(closureScope, descriptor, capturedCells);
// Capture the closure itself in slot 0 for 'recur' to find it (if needed).
adr.Kind := akLocalOrParent;
adr.ScopeDepth := 0;
adr.SlotIndex := 0;
lambdaScope[adr] := TDataValue(closure);
// Populate the scope with the actual parameters passed to the function.
for i := 0 to params.Count - 1 do
begin
adr := params[i].Address;
Assert(adr.ScopeDepth = 0);
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;
Result := TDataValue(closure);
end;
function TEvaluatorVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
begin
Result := TDataValue.Void;
end;
function TEvaluatorVisitor.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue;
begin
raise EEvaluatorException.Create('Quasiquote nodes are a compile-time construct and cannot be evaluated at runtime.');
end;
function TEvaluatorVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue;
begin
raise EEvaluatorException.Create('Unquote nodes are a compile-time construct and cannot be evaluated at runtime.');
end;
function TEvaluatorVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
begin
raise EEvaluatorException.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>;
i: Integer;
argList: IArgumentList;
begin
if Assigned(Node.StaticTarget) then
begin
// --- Static Path (Optimized) ---
argList := Node.Arguments;
SetLength(argValues, argList.Count);
for i := 0 to argList.Count - 1 do
argValues[i] := argList[i].Accept(Self);
// Call static target. Exceptions here are caught by Execute/HandleTCO.
Result := Node.StaticTarget(argValues);
HandleTCO(Result);
end
else
begin
// --- Dynamic Path (Default) ---
calleeValue := Node.Callee.Accept(Self);
if calleeValue.Kind <> vkMethod then
raise EEvaluatorException.Create('Expression is not invokable in this context.');
argList := Node.Arguments;
SetLength(argValues, argList.Count);
for i := 0 to argList.Count - 1 do
argValues[i] := argList[i].Accept(Self);
if Node.IsTailCall then
begin
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues, false));
end
else
begin
Result := (calleeValue.AsMethod)(argValues);
HandleTCO(Result);
end;
end;
end;
function TEvaluatorVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
begin
Result := Node.ExpandedBody.Accept(Self);
end;
function TEvaluatorVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue;
var
argValues: TArray<TDataValue>;
calleeAddress: TResolvedAddress;
calleeValue: TDataValue;
i: Integer;
begin
SetLength(argValues, Node.Arguments.Count);
for i := 0 to Node.Arguments.Count - 1 do
argValues[i] := Node.Arguments[i].Accept(Self);
calleeAddress.Kind := akLocalOrParent;
calleeAddress.ScopeDepth := 0;
calleeAddress.SlotIndex := 0;
calleeValue := FScope[calleeAddress];
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues, true));
end;
function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
var
itemValue, lookbackValue, seriesVar: TDataValue;
lookback: Int64;
begin
seriesVar := FScope[Node.Series.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 EEvaluatorException.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 EEvaluatorException.Create('Can only add record values to a TScalarRecordSeries.');
with seriesVar.AsRecordSeries do
begin
Add(itemValue.AsRecord, lookback);
end;
end;
else
raise EEvaluatorException.Create('"add" operation is only supported for series types.');
end;
Result := TDataValue.Void;
end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
if Node.Target.Kind <> akIdentifier then
raise EEvaluatorException.Create('Runtime Error: Assignment target must be an identifier.');
Result := Node.Value.Accept(Self);
FScope[Node.Target.AsIdentifier.Address] := Result;
end;
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
begin
Result := Node.Value;
end;
function TEvaluatorVisitor.VisitKeyword(const Node: IKeywordNode): TDataValue;
begin
Result := TDataValue(TScalar.FromKeyword(Node.Value));
end;
function TEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
var
def: string;
begin
def := Node.Definition.Trim;
try
if def.StartsWith('[') then
begin
var recordDef := TRttiAstHelper.JsonToRecordDefinition(def);
if recordDef.Count = 0 then
raise EEvaluatorException.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;
except
on E: EAstException do
raise;
on E: Exception do
raise EEvaluatorException.Create('Invalid series definition: ' + E.Message);
end;
end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
Result := FScope[Node.Address];
end;
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
var
baseValue, indexValue: TDataValue;
index: Int64;
series: ISeries;
recSeries: IRecordSeries;
i, fieldCount: Integer;
values: TArray<TScalar.TValue>;
key: IKeyword;
memberSeries: ISeries;
scalarValue: TScalar;
rec: TScalarRecord;
begin
baseValue := Node.Base.Accept(Self);
indexValue := Node.Index.Accept(Self);
if (indexValue.Kind <> vkScalar) or (indexValue.AsScalar.Kind <> TScalar.TKind.Ordinal) then
raise EEvaluatorException.Create('Indexer `[]` requires an integer argument.');
index := indexValue.AsScalar.Value.AsInt64;
case baseValue.Kind of
vkSeries:
begin
series := baseValue.AsSeries;
if (index < 0) or (index >= series.TotalCount) then
raise EEvaluatorException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, series.TotalCount]);
Result := TDataValue(series.Items[Integer(index)]);
end;
vkRecordSeries:
begin
recSeries := baseValue.AsRecordSeries;
if (index < 0) or (index >= recSeries.TotalCount) then
raise EEvaluatorException
.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, recSeries.TotalCount]);
fieldCount := recSeries.Def.Count;
SetLength(values, fieldCount);
for i := 0 to fieldCount - 1 do
begin
key := recSeries.Def.Items[i].Key;
memberSeries := recSeries[key];
scalarValue := memberSeries[index];
values[i] := scalarValue.Value;
end;
rec := TScalarRecord.Create(recSeries.Def, values);
Result := TDataValue.FromRecord(rec);
end;
else
raise EEvaluatorException.Create('Indexer `[]` is not supported for this value type.');
end;
end;
function TEvaluatorVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
var
baseValue: TDataValue;
begin
baseValue := Node.Base.Accept(Self);
case baseValue.Kind of
vkRecordSeries: Result := TDataValue.FromSeries(baseValue.AsRecordSeries[Node.Member.Value]);
vkRecord: Result := TDataValue(baseValue.AsRecord[Node.Member.Value]);
vkGenericRecord:
begin
var rec := baseValue.AsGenericRecord;
var fieldIndex := rec.IndexOf(Node.Member.Value);
if fieldIndex < 0 then
raise EEvaluatorException.CreateFmt('Member ":%s" not found in record.', [Node.Member.Value.Name]);
Result := rec.Items[fieldIndex].Value;
end;
else
raise EEvaluatorException.Create('Member access operator `.` is not supported for this value type.');
end;
end;
function TEvaluatorVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
var
i: Integer;
begin
if Assigned(Node.GenericDefinition) then
begin
var genFields: TArray<TPair<IKeyword, TDataValue>>;
SetLength(genFields, Node.Fields.Count);
for i := 0 to Node.Fields.Count - 1 do
begin
var field := Node.Fields[i];
genFields[i] := TPair<IKeyword, TDataValue>.Create(field.Key.Value, field.Value.Accept(Self));
end;
var dynRec := TDynamicRecord.Create(genFields);
Result := TDataValue.FromGenericRecord(dynRec);
end
else if Assigned(Node.ScalarDefinition) then
begin
var values: TArray<TScalar.TValue>;
SetLength(values, Node.Fields.Count);
for i := 0 to Node.Fields.Count - 1 do
begin
var field := Node.Fields[i];
var valData := field.Value.Accept(Self);
values[i] := valData.AsScalar.Value;
end;
var rec := TScalarRecord.Create(Node.ScalarDefinition, values);
Result := TDataValue.FromRecord(rec);
end
else
raise EEvaluatorException.Create('RecordLiteral has no definition (Binder/TypeChecker failure).');
end;
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
var
address: TResolvedAddress;
begin
if Node.Target.Kind <> akIdentifier then
raise EEvaluatorException.Create('Runtime Error: Variable declaration target must be an identifier.');
if Assigned(Node.Initializer) then
Result := Node.Initializer.Accept(Self)
else
Result := TDataValue.Void;
address := Node.Target.AsIdentifier.Address;
if Node.IsBoxed then
begin
Assert(address.ScopeDepth = 0);
FScope.DefineBoxed(address.SlotIndex, Result);
end
else
begin
FScope[address] := Result;
end;
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.VisitCondExpression(const Node: ICondExpressionNode): TDataValue;
var
pair: TCondPair;
begin
for pair in Node.Pairs do
begin
if IsTruthy(pair.Condition.Accept(Self)) then
begin
Result := pair.Branch.Accept(Self);
Exit;
end;
end;
// Else branch is mandatory in AST (though can be Nop/Void in source if omitted and normalized)
Result := Node.ElseBranch.Accept(Self);
end;
function TEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
begin
// Delegate to ExpressionList visitor
Result := Node.Expressions.Accept(Self);
end;
function TEvaluatorVisitor.VisitExpressionList(const Node: IExpressionList): TDataValue;
var
i: Integer;
begin
Result := TDataValue.Void;
for i := 0 to Node.Count - 1 do
Result := Node[i].Accept(Self);
end;
function TEvaluatorVisitor.VisitNop(const Node: INopNode): TDataValue;
begin
Result := TDataValue.Void;
end;
function TEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
var
seriesValue: TDataValue;
len: Int64;
begin
seriesValue := FScope[Node.Series.Address];
case seriesValue.Kind of
vkSeries: len := seriesValue.AsSeries.Count;
vkRecordSeries: len := seriesValue.AsRecordSeries.Count;
else
raise EEvaluatorException
.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TDataValueKind), Ord(seriesValue.Kind))]);
end;
Result := TDataValue(TScalar.FromInt64(len));
end;
// --- List Visitor Stubs (Mostly Unused directly, but required by Interface) ---
function TEvaluatorVisitor.VisitParameterList(const Node: IParameterList): TDataValue;
begin
Result := TDataValue.Void;
end;
function TEvaluatorVisitor.VisitArgumentList(const Node: IArgumentList): TDataValue;
begin
// Could evaluate arguments here and return an array-wrapped TDataValue,
// but VisitFunctionCall handles iteration manually for efficiency.
Result := TDataValue.Void;
end;
function TEvaluatorVisitor.VisitRecordFieldList(const Node: IRecordFieldList): TDataValue;
begin
// Handled by VisitRecordLiteral
Result := TDataValue.Void;
end;
function TEvaluatorVisitor.VisitRecordField(const Node: IRecordFieldNode): TDataValue;
begin
// Handled by manual iteration in VisitRecordLiteral
Result := TDataValue.Void;
end;
end.