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; Recur: Boolean; constructor Create(const ACallee: TDataValue; const AArgs: TArray; ARecur: Boolean); end; constructor TThunk.Create(const ACallee: TDataValue; const AArgs: TArray; 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; 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; 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 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; 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.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; 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.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; 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>; SetLength(genFields, Node.Fields.Count); for i := 0 to Node.Fields.Count - 1 do begin var field := Node.Fields[i]; genFields[i] := TPair.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; 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.