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; class var procedure HandleTCO(var ResultValue: TDataValue); protected function VisitConstant(const Node: IConstantNode): TDataValue; override; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; function VisitKeyword(const Node: IKeywordNode): 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 VisitMacroExpansionNode(const Node: IMacroExpansionNode): 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 VisitRecordLiteral(const Node: IRecordLiteralNode): 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.Keyword, Myc.Data.Decimal, Myc.Data.Series, Myc.Data.Scalar.JSON, Myc.Ast.Binding.Nodes; // 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; // --- Native Functions Implementation --- function NativeCreateRecordSeries(const Args: TArray): TDataValue; var jsonDef: string; recordDef: IScalarRecordDefinition; 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; { TDynamicRecord } type // Runtime implementation for generic records using linear search TDynamicRecord = class(TInterfacedObject, IKeywordMapping) private FFields: TArray>; function GetFields: TArray>; public constructor Create(const AFields: TArray>); function IndexOf(const Key: IKeyword): Integer; end; constructor TDynamicRecord.Create(const AFields: TArray>); begin inherited Create; FFields := AFields; end; function TDynamicRecord.GetFields: TArray>; begin Result := FFields; end; function TDynamicRecord.IndexOf(const Key: IKeyword): Integer; begin // Linear search (O(n)) as requested for Result := 0 to High(FFields) do begin if FFields[Result].Key.Idx = Key.Idx then exit; end; Result := -1; 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; var callee := thunk.Callee.AsMethod(); ResultValue := callee(thunk.Args); 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; else Result := false; end; end; function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; var boundNode: TBoundLambdaExpressionNode; capturedCells: TArray; i: Integer; sourceAddresses: TArray; 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; var cNode: ILambdaExpressionNode := Node; // [unsafe] prevents a reference cycle since the closure captures itself for 'recur'. var [unsafe] closure: TDataValue.TFunc; closure := function(const ArgValues: TArray): 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] := 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; 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.Create(calleeValue, argValues, false)); 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.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; begin // The evaluator simply "unwraps" the macro expansion node // and executes the expanded body it contains. Result := Node.ExpandedBody.Accept(Self); end; function TEvaluatorVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue; var argValues: TArray; 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.Create(calleeValue, argValues, true)); 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.VisitKeyword(const Node: IKeywordNode): TDataValue; begin // Return the keyword as a TScalar value Result := TDataValue(TScalar.FromKeyword(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; series: ISeries; recSeries: IRecordSeries; 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 series := baseValue.AsSeries; 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]); Result := series.Items[Integer(index)]; end; vkRecordSeries: begin recSeries := baseValue.AsRecordSeries; if (index < 0) or (index >= recSeries.TotalCount) then raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, recSeries.TotalCount]); // Accessing a record series by index materializes the TScalarRecord var rec := TScalarRecord.Create(recSeries.Def, nil); // Nil fields, needs implementation // TODO: This path (materializing a record from TScalarRecordSeries) is not fully implemented. // We need to fetch the underlying TScalar.TValue array slice. // For now, returning an empty record shell. raise ENotSupportedException.Create('Indexing a RecordSeries to materialize a Record is not yet implemented.'); Result := TDataValue.FromRecord(rec); 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; begin baseValue := Node.Base.Accept(Self); case baseValue.Kind of vkRecordSeries: Result := TDataValue.FromSeries(baseValue.AsRecordSeries[Node.Member.Value]); vkRecord: Result := baseValue.AsRecord[Node.Member.Value]; // --- NEW GENERIC PATH --- vkGenericRecord: begin var rec := baseValue.AsGenericRecord; var fieldIndex := rec.IndexOf(Node.Member.Value); if fieldIndex < 0 then raise EArgumentException.CreateFmt('Member ":%s" not found in record.', [Node.Member.Value.Name]); Result := rec.Fields[fieldIndex].Value; end; else raise EArgumentException.Create('Member access operator `.` is not supported for this value type.'); end; end; function TEvaluatorVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; var i: Integer; begin // Check which type the binder created if Node is TBoundGenericRecordLiteralNode then begin // --- NEW GENERIC PATH --- var boundNode := Node as TBoundGenericRecordLiteralNode; var genFields: TArray>; SetLength(genFields, Length(boundNode.Fields)); // Evaluate all field values for i := 0 to High(boundNode.Fields) do begin genFields[i] := TPair.Create( boundNode.Fields[i].Key.Value, boundNode.Fields[i].Value.Accept(Self) // Evaluate expression ); end; // Create the new runtime object and wrap it var dynRec := TDynamicRecord.Create(genFields); Result := TDataValue.FromGenericRecord(dynRec); end else if Node is TBoundRecordLiteralNode then begin // --- EXISTING SCALAR PATH --- var boundNode := Node as TBoundRecordLiteralNode; var values: TArray; SetLength(values, Length(boundNode.Fields)); for i := 0 to High(boundNode.Fields) do begin var valData := boundNode.Fields[i].Value.Accept(Self); // Binder guarantees these are vkScalar values[i] := valData.AsScalar.Value; end; var rec := TScalarRecord.Create(boundNode.Definition, values); Result := TDataValue.FromRecord(rec); end else raise EInvalidOpException.Create('Unknown record literal node type during evaluation.'); 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; resScalar: TScalar; begin leftValue := Node.Left.Accept(Self); rightValue := Node.Right.Accept(Self); // Standard scalar operations if (leftValue.Kind <> vkScalar) or (rightValue.Kind <> vkScalar) then raise ENotSupportedException.Create('Binary operations are only supported for scalar types.'); if not TScalar.TryBinaryOperation(Node.Operator, leftValue.AsScalar, rightValue.AsScalar, resScalar) then raise ENotSupportedException.Create( 'Binary operation not supported for scalar types ' + leftValue.AsScalar.Kind.ToString + ' and ' + rightValue.AsScalar.Kind.ToString + ' .'); Result := resScalar; 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.