unit Myc.Ast.Evaluator; interface uses System.SysUtils, System.Classes, // For TStrings System.Generics.Collections, Myc.Data.POD, Myc.Ast.Nodes, Myc.Ast; type // TEvaluatorVisitor is the base implementation for evaluating an AST. TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor) private FScope: IExecutionScope; protected function IsTruthy(const AValue: TAstValue): Boolean; function CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; virtual; public constructor Create(const AScope: IExecutionScope); function VisitConstant(const Node: IConstantNode): TAstValue; virtual; function VisitIdentifier(const Node: IIdentifierNode): TAstValue; virtual; function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; virtual; function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; virtual; function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; virtual; function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; virtual; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; virtual; function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; virtual; function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; virtual; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; virtual; function VisitAssignment(const Node: IAssignmentNode): TAstValue; virtual; function VisitIndexer(const Node: IIndexerNode): TAstValue; 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): TAstValue; override; function VisitIdentifier(const Node: IIdentifierNode): TAstValue; override; function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; override; function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; override; function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; override; function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; override; function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; override; function VisitAssignment(const Node: IAssignmentNode): TAstValue; override; function VisitIndexer(const Node: IIndexerNode): TAstValue; override; end; // Registers all native core functions in the given scope. procedure RegisterNativeFunctions(const AScope: IExecutionScope); implementation uses Myc.Data.Decimal, Myc.Ast.Scope, Myc.Ast.Printer, Myc.Ast.RttiUtils; // Added for JsonToRecordDefinition type // The signature for a native Delphi function callable from the script. TNativeFunction = function(const Args: TArray): TAstValue; // Concrete implementation of the IEvaluatorClosure interface for script-defined functions. TClosureValue = class(TInterfacedObject, IEvaluatorClosure) private FBody: IExpressionNode; FParameters: TArray; FClosureScope: IExecutionScope; function GetBody: IExpressionNode; function GetParameters: TArray; function GetClosureScope: IExecutionScope; public constructor Create(ABody: IExpressionNode; const AParameters: TArray; const AClosureScope: IExecutionScope); end; // Concrete implementation of IEvaluatorClosure for native Delphi functions. TNativeClosure = class(TInterfacedObject, IEvaluatorClosure) private FMethod: TNativeFunction; function GetBody: IExpressionNode; function GetParameters: TArray; function GetClosureScope: IExecutionScope; public constructor Create(const AMethod: TNativeFunction); property Method: TNativeFunction read FMethod; end; // --- Native Functions Implementation --- function NativeCreateRecordSeries(const Args: TArray): TAstValue; var jsonDef: string; recordDef: TScalarRecordDefinition; series: TScalarRecordSeries; begin if (Length(Args) <> 1) or (Args[0].Kind <> avkText) 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 := TAstValue.FromRecordSeries(series); end; // --- Registration Procedure --- procedure RegisterNativeFunctions(const AScope: IExecutionScope); var closure: IEvaluatorClosure; begin // Register CreateRecordSeries closure := TNativeClosure.Create(NativeCreateRecordSeries); AScope.SetValue('CreateRecordSeries', TAstValue.FromClosure(closure)); end; { TClosureValue } constructor TClosureValue.Create(ABody: IExpressionNode; const AParameters: TArray; const AClosureScope: IExecutionScope); begin inherited Create; FBody := ABody; FParameters := AParameters; FClosureScope := AClosureScope; end; function TClosureValue.GetBody: IExpressionNode; begin Result := FBody; end; function TClosureValue.GetClosureScope: IExecutionScope; begin Result := FClosureScope; end; function TClosureValue.GetParameters: TArray; begin Result := FParameters; end; { TNativeClosure } constructor TNativeClosure.Create(const AMethod: TNativeFunction); begin inherited Create; FMethod := AMethod; end; function TNativeClosure.GetBody: IExpressionNode; begin Result := nil; end; function TNativeClosure.GetClosureScope: IExecutionScope; begin Result := nil; end; function TNativeClosure.GetParameters: TArray; begin Result := nil; 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: TAstValue): Boolean; begin if (AValue.Kind <> avkScalar) 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.VisitAssignment(const Node: IAssignmentNode): TAstValue; var varName: string; value: TAstValue; begin // Evaluate the right-hand side of the assignment. value := Node.Value.Accept(Self); varName := Node.Identifier.Name; // Assign the value to the variable in the scope chain. FScope.AssignValue(varName, value); // Assignment expressions return the assigned value. Result := value; end; function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TAstValue; begin Result := TAstValue.FromScalar(Node.Value); end; function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue; var val: TAstValue; begin if FScope.FindValue(Node.Name, val) then Result := val else raise EArgumentException.CreateFmt('Identifier not found: "%s"', [Node.Name]); end; function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue; var baseValue, indexValue: TAstValue; series: TScalarRecordSeries; rec: TScalarRecord; index: Int64; indexScalar: TScalar; begin baseValue := Node.Base.Accept(Self); indexValue := Node.Index.Accept(Self); if (baseValue.Kind <> avkRecordSeries) then raise EArgumentException.Create('Indexer `[]` can only be applied to a RecordSeries.'); if (indexValue.Kind <> avkScalar) 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; 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]); rec := series.Items[Integer(index)]; Result := TAstValue.FromRecord(rec); end; function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; var varName: string; begin varName := Node.Identifier.Name; if Assigned(Node.Initializer) then Result := Node.Initializer.Accept(Self) else Result := TAstValue.Void; FScope.SetValue(varName, Result); end; function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; var closureImpl: IEvaluatorClosure; begin closureImpl := TClosureValue.Create(Node.Body, Node.Parameters, FScope); Result := TAstValue.FromClosure(closureImpl); end; function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; var calleeValue: TAstValue; closure: IEvaluatorClosure; i: Integer; argValues: TArray; callScope: IExecutionScope; innerVisitor: IAstVisitor; begin calleeValue := Node.Callee.Accept(Self); if calleeValue.Kind <> avkClosure then raise EArgumentException.Create('Expression is not a callable closure.'); closure := calleeValue.AsClosure; // Distinguish between native and script-defined closures. if closure is TNativeClosure then begin // Native function call SetLength(argValues, Node.Arguments.Count); for i := 0 to Node.Arguments.Count - 1 do begin argValues[i] := Node.Arguments[i].Accept(Self); end; Result := (closure as TNativeClosure).Method(argValues); end else if closure is TClosureValue then begin // Script function call (original logic) if (Node.Arguments.Count <> Length(closure.Parameters)) then raise EArgumentException .CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), Node.Arguments.Count]); callScope := TExecutionScope.Create(closure.ClosureScope); for i := 0 to Node.Arguments.Count - 1 do begin argValues := [Node.Arguments[i].Accept(Self)]; callScope.SetValue(closure.Parameters[i].Name, argValues[0]); end; innerVisitor := Self.CreateVisitorForScope(callScope); callScope.SetValue('Result', TAstValue.Void); Result := closure.Body.Accept(innerVisitor); end else raise EArgumentException.Create('Unknown closure implementation type.'); end; function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; var leftValue, rightValue: TAstValue; leftScalar, rightScalar: TScalar; leftVal, rightVal: Int64; boolResult: Boolean; intResult: Int64; begin leftValue := Node.Left.Accept(Self); rightValue := Node.Right.Accept(Self); if leftValue.Kind <> rightValue.Kind then raise ENotSupportedException.Create('Binary operations are only supported for compatible types.'); if leftValue.Kind <> avkScalar then begin raise ENotSupportedException.Create('Binary operations are only supported for scalar types.'); end; leftScalar := leftValue.AsScalar; rightScalar := rightValue.AsScalar; if (leftScalar.Kind <> skInt64) or (rightScalar.Kind <> skInt64) then begin raise ENotSupportedException.Create('Binary operations currently only support Int64.'); end; leftVal := leftScalar.Value.AsInt64; rightVal := rightScalar.Value.AsInt64; case Node.Operator of boEqual: boolResult := (leftVal = rightVal); boNotEqual: boolResult := (leftVal <> rightVal); boLess: boolResult := (leftVal < rightVal); boGreater: boolResult := (leftVal > rightVal); boLessOrEqual: boolResult := (leftVal <= rightVal); boGreaterOrEqual: boolResult := (leftVal >= rightVal); else case Node.Operator of boAdd: intResult := leftVal + rightVal; boSubtract: intResult := leftVal - rightVal; boMultiply: intResult := leftVal * rightVal; boDivide: intResult := leftVal div rightVal; else raise ENotSupportedException.Create('Operator not supported.'); end; Result := TAstValue.FromScalar(TScalar.FromInt64(intResult)); exit; end; if boolResult then Result := TAstValue.FromScalar(TScalar.FromBoolean(true)) else Result := TAstValue.FromScalar(TScalar.FromBoolean(false)); end; function TEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; var rightValue: TAstValue; rightScalar: TScalar; begin rightValue := Node.Right.Accept(Self); if rightValue.Kind <> avkScalar then raise ENotSupportedException.Create('Unary operations are only supported for scalar types.'); rightScalar := rightValue.AsScalar; case Node.Operator of uoNegate: begin if (rightScalar.Kind = skInt64) then Result := TAstValue.FromScalar(TScalar.FromInt64(-rightScalar.Value.AsInt64)) else raise ENotSupportedException.Create('Unary "-" not supported for this scalar type.'); end; uoNot: raise ENotImplemented.Create('Unary "not" operator is not yet implemented'); else raise ENotSupportedException.Create('Unary operator not supported'); end; end; function TEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue; var conditionValue: TAstValue; begin conditionValue := Node.Condition.Accept(Self); if IsTruthy(conditionValue) then Result := Node.ThenBranch.Accept(Self) else Result := Node.ElseBranch.Accept(Self); end; function TEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; var conditionValue: TAstValue; 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): TAstValue; var expression: IExpressionNode; lastValue: TAstValue; begin lastValue := TAstValue.Void; for expression in Node.Expressions do begin lastValue := expression.Accept(Self); end; Result := lastValue; end; { TDebugEvaluatorVisitor } constructor TDebugEvaluatorVisitor.Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0); 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; 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.VisitAssignment(const Node: IAssignmentNode): TAstValue; begin AppendLine(Format('Assignment %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): TAstValue; begin AppendLine(Format('Constant (%s)', [Node.Value.ToString])); Result := inherited VisitConstant(Node); end; function TDebugEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue; begin Result := inherited VisitIdentifier(Node); AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.ToString])); end; function TDebugEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; 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): TAstValue; 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): TAstValue; begin AppendLine('IfExpr{'); Indent; try Result := inherited VisitIfExpression(Node); finally Unindent; end; AppendLine(Format('} -> %s', [Result.ToString])); end; function TDebugEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue; begin AppendLine('Indexer {'); Indent; try Result := inherited VisitIndexer(Node); finally Unindent; end; AppendLine(Format('} -> %s', [Result.ToString])); end; function TDebugEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; begin AppendLine('TernaryExpr{'); Indent; try Result := inherited VisitTernaryExpression(Node); finally Unindent; end; AppendLine(Format('} -> %s', [Result.ToString])); end; function TDebugEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; begin AppendLine('LambdaExpr{'); Indent; try var pp: IAstVisitor := TPrettyPrintVisitor.Create(0); pp.VisitLambdaExpression(Node); AppendMultiline((pp as TPrettyPrintVisitor).GetResult); Result := inherited VisitLambdaExpression(Node); finally Unindent; end; AppendLine(Format('} -> %s', [Result.ToString])); end; function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; begin AppendLine('FunctionCall{'); Indent; try Result := inherited VisitFunctionCall(Node); finally Unindent; end; AppendLine(Format('} -> %s', [Result.ToString])); end; function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; begin AppendLine('Block{'); Indent; try ShowScope; Result := inherited VisitBlockExpression(Node); finally Unindent; end; AppendLine(Format('} -> %s', [Result.ToString])); end; function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; begin AppendLine(Format('VarDecl %s :=', [Node.Identifier.Name])); Indent; try Result := inherited VisitVariableDeclaration(Node); finally Unindent; end; end; end.