Files
MycLib/Src/AST/Myc.Ast.Evaluator.pas
T
Michael Schimmel 9419f5cd03 AST refactoring
2025-08-28 15:14:08 +02:00

447 lines
16 KiB
ObjectPascal

unit Myc.Ast.Evaluator;
interface
uses
System.SysUtils,
System.Classes, // For TStrings
System.Generics.Collections,
Myc.Data.Types,
Myc.Ast,
Myc.Ast.Scope,
Myc.Ast.Closure;
type
// TEvaluatorVisitor is the base implementation for evaluating an AST.
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor)
protected // Changed to protected to be accessible by descendants
FScope: TExecutionScope;
function IsTruthy(const AValue: IDataValue): Boolean;
// Factory method to create a new visitor for a sub-scope (e.g., lambda body)
function CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; virtual;
public
constructor Create(AScope: TExecutionScope);
function VisitConstant(const Node: IConstantNode): IDataValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): IDataValue; virtual;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue; virtual;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue; virtual;
function VisitIfExpression(const Node: IIfExpressionNode): IDataValue; virtual;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; virtual;
function VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; virtual;
function VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; virtual;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; 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 ShowScope;
protected
// Override the factory method to create a debug visitor
function CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; override;
public
constructor Create(AScope: TExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0);
// Override all visit methods
function VisitConstant(const Node: IConstantNode): IDataValue; override;
function VisitIdentifier(const Node: IIdentifierNode): IDataValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue; override;
function VisitIfExpression(const Node: IIfExpressionNode): IDataValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; override;
end;
implementation
{ TEvaluatorVisitor }
constructor TEvaluatorVisitor.Create(AScope: TExecutionScope);
begin
inherited Create;
Assert(Assigned(AScope));
FScope := AScope;
end;
function TEvaluatorVisitor.CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor;
begin
// Base implementation creates a standard evaluator
Result := TEvaluatorVisitor.Create(AScope);
end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue;
var
methodType: IDataMethodType;
begin
// Instead of creating an anonymous method, we now create a data object
// that holds all information required to execute the lambda later.
methodType := TDataType.MethodOf(TDataType.Ordinal, TDataType.Ordinal); // TODO: Infer this
// Use the factory function from the Myc.Ast.Closure unit.
Result := CreateDataClosureValue(methodType, Node.Body, Node.Parameters, FScope);
end;
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IDataValue;
var
calleeValue: IDataValue;
arguments: TList<IExpressionNode>;
closure: IDataClosureValue;
callScope: TExecutionScope;
innerVisitor: IAstVisitor;
begin
calleeValue := Node.Callee.Accept(Self);
arguments := Node.Arguments;
if not Supports(calleeValue, IDataClosureValue, closure) then
raise EArgumentException.Create('Expression is not a callable closure.');
if (arguments.Count <> 1) then
raise EArgumentException.Create('This simple implementation only supports single-argument calls.');
// --- New execution logic is now inside the caller ---
// Create the new scope for the function call, parented by the closure's captured scope.
callScope := TExecutionScope.Create(closure.ClosureScope);
try
// Set argument value
var argValue := arguments[0].Accept(Self);
callScope.SetValue(closure.Parameters[0].Name, argValue);
// Use the factory method to create the visitor with the correct context (and indent).
innerVisitor := Self.CreateVisitorForScope(callScope);
// Execute the body with the new visitor.
Result := closure.Body.Accept(innerVisitor);
finally
callScope.Free;
end;
end;
function TEvaluatorVisitor.IsTruthy(const AValue: IDataValue): Boolean;
begin
// Defines the language's concept of "truthiness".
// For now, only ordinals can be conditions. 0 is false, everything else is true.
if not Assigned(AValue) then
Exit(False);
case AValue.DataType.Kind of
dkOrdinal: Result := (TDataType.TValue(AValue).AsOrdinal.Value <> 0);
else
Result := False;
end;
end;
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): IDataValue;
begin
Result := Node.Value;
end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): IDataValue;
var
val: IDataValue;
begin
if FScope.FindValue(Node.Name, val) then
Result := val
else
raise EArgumentException.CreateFmt('Identifier not found: "%s"', [Node.Name]);
end;
function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue;
var
leftValue, rightValue: IDataValue;
comparisonResult: Boolean;
begin
leftValue := Node.Left.Accept(Self);
rightValue := Node.Right.Accept(Self);
// Handle comparison operators separately as they can work on different types (for now)
// and always return an Ordinal (boolean).
case Node.Operator of
boEqual, boNotEqual, boLess, boGreater, boLessOrEqual, boGreaterOrEqual:
begin
// Basic comparison for Ordinals
if (leftValue.DataType.Kind = dkOrdinal) and (rightValue.DataType.Kind = dkOrdinal) then
begin
var leftVal := TDataType.TValue(leftValue).AsOrdinal.Value;
var rightVal := TDataType.TValue(rightValue).AsOrdinal.Value;
case Node.Operator of
boEqual: comparisonResult := (leftVal = rightVal);
boNotEqual: comparisonResult := (leftVal <> rightVal);
boLess: comparisonResult := (leftVal < rightVal);
boGreater: comparisonResult := (leftVal > rightVal);
boLessOrEqual: comparisonResult := (leftVal <= rightVal);
boGreaterOrEqual: comparisonResult := (leftVal >= rightVal);
end;
if comparisonResult then
Result := TDataType.Ordinal.CreateValue(1)
else
Result := TDataType.Ordinal.CreateValue(0);
exit;
end
else
raise ENotSupportedException.Create('Comparison is only supported for Ordinal types.');
end;
end;
if (leftValue.DataType.Kind <> rightValue.DataType.Kind) then
raise ENotSupportedException.CreateFmt(
'Binary operations on different types (%s and %s) are not supported',
[leftValue.DataType.Name, rightValue.DataType.Name]);
case leftValue.DataType.Kind of
dkOrdinal:
begin
var leftOrdinal := TDataType.TValue(leftValue).AsOrdinal;
var rightOrdinal := TDataType.TValue(rightValue).AsOrdinal;
var resultVal: Int64;
case Node.Operator of
boAdd: resultVal := leftOrdinal.Value + rightOrdinal.Value;
boSubtract: resultVal := leftOrdinal.Value - rightOrdinal.Value;
boMultiply: resultVal := leftOrdinal.Value * rightOrdinal.Value;
boDivide: resultVal := leftOrdinal.Value div rightOrdinal.Value;
else
raise ENotSupportedException.Create('Operator not supported for Ordinal type');
end;
Result := TDataType.Ordinal.CreateValue(resultVal);
end;
dkText:
begin
if (Node.Operator = boAdd) then
begin
var leftText := TDataType.TValue(leftValue).AsText;
var rightText := TDataType.TValue(rightValue).AsText;
Result := TDataType.Text.CreateValue(leftText.Value + rightText.Value);
end
else
raise ENotSupportedException.Create('Operator not supported for Text type');
end;
else
raise ENotSupportedException.CreateFmt('Binary operation not supported for type %s', [leftValue.DataType.Name]);
end;
end;
function TEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue;
var
rightValue: IDataValue;
ordinalVal: IDataOrdinalValue;
begin
rightValue := Node.Right.Accept(Self);
case Node.Operator of
uoNegate:
begin
if (rightValue.DataType.Kind = dkOrdinal) then
begin
ordinalVal := TDataType.TValue(rightValue).AsOrdinal;
Result := TDataType.Ordinal.CreateValue(-ordinalVal.Value);
end
else
raise ENotSupportedException.CreateFmt('Unary "-" not supported for type %s', [rightValue.DataType.Name]);
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): IDataValue;
var
conditionValue: IDataValue;
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): IDataValue;
var
expression: IExpressionNode;
lastValue: IDataValue;
begin
lastValue := TDataType.Void.Value;
for expression in Node.Expressions do
begin
lastValue := expression.Accept(Self);
end;
Result := lastValue;
end;
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue;
var
varName: string;
initValue: IDataValue;
begin
varName := Node.Identifier.Name;
// 1. Declare the name in the scope first with a placeholder value (void).
// This makes the name available to the initializer (e.g., a lambda).
FScope.SetValue(varName, TDataType.Void.Value);
// 2. Evaluate the initializer, which can now recursively reference its own name.
if Assigned(Node.Initializer) then
initValue := Node.Initializer.Accept(Self)
else
initValue := TDataType.Void.Value;
// 3. Update the variable with the actual initialized value.
FScope.SetValue(varName, initValue);
Result := TDataType.Void.Value;
end;
{ TDebugEvaluatorVisitor }
constructor TDebugEvaluatorVisitor.Create(AScope: TExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0);
begin
inherited Create(AScope);
Assert(Assigned(ALog));
FLog := ALog;
FIndentLevel := AInitialIndent;
FShowScope := AShowScope;
end;
function TDebugEvaluatorVisitor.CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor;
begin
// Pass the current indent level to the new child visitor
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);
begin
var pad := '';
for var i := 0 to FIndentLevel - 1 do
pad := pad + ':' + ''.PadLeft(3);
FLog.Add(pad + S);
end;
procedure TDebugEvaluatorVisitor.ShowScope;
begin
if FShowScope then
begin
// Dump the scope content upon entering a block
AppendLine('-- Scope --');
var scopeDump := FScope.Dump.Split([sLineBreak]);
for var line in scopeDump do
AppendLine(line);
AppendLine('-----------');
end;
end;
function TDebugEvaluatorVisitor.VisitConstant(const Node: IConstantNode): IDataValue;
begin
AppendLine(Format('Constant (%s)', [Node.Value.AsString]));
Result := inherited VisitConstant(Node);
end;
function TDebugEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): IDataValue;
begin
Result := inherited VisitIdentifier(Node);
AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.AsString]));
end;
function TDebugEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue;
begin
AppendLine(Format('BinaryExpr "%s" {', [Node.Operator.ToString]));
Indent;
try
Result := inherited VisitBinaryExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.AsString]));
end;
function TDebugEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue;
begin
AppendLine(Format('UnaryExpr "%s" {', [Node.Operator.ToString]));
Indent;
try
Result := inherited VisitUnaryExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.AsString]));
end;
function TDebugEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): IDataValue;
begin
AppendLine('IfExpr{');
Indent;
try
Result := inherited VisitIfExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.AsString]));
end;
function TDebugEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue;
begin
AppendLine('LambdaExpr{');
Indent;
try
Result := inherited VisitLambdaExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.AsString]));
end;
function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IDataValue;
begin
AppendLine('FunctionCall{');
Indent;
try
ShowScope;
Result := inherited VisitFunctionCall(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.AsString]));
end;
function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue;
begin
AppendLine('Block{');
Indent;
try
ShowScope;
Result := inherited VisitBlockExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.AsString]));
end;
function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue;
begin
AppendLine(Format('VarDecl %s :=', [Node.Identifier.Name]));
Indent;
try
Result := inherited VisitVariableDeclaration(Node);
finally
Unindent;
end;
end;
end.