MycLib/Src/AST/Myc.Ast.Evaluator.pas

// https://g.co/gemini/share/f8965e72f968

unit Myc.Ast.Evaluator;

interface

uses
    System.SysUtils,
    System.Classes, // For TStrings
    System.Generics.Collections,
    Myc.Data.Types,
    Myc.Ast;

type
    // Manages the scope of execution, holding variables and their values.
    TExecutionScope = class
    private
        FParent: TExecutionScope;
        FVariables: TDictionary<string, IDataValue>;
        // Added for recursive dumping
        procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
    public
        constructor Create(AParent: TExecutionScope = nil);
        destructor Destroy; override;
        function FindValue(const Name: string; out Value: IDataValue): Boolean;
        procedure SetValue(const Name: string; const Value: IDataValue);
        // Dumps the content of this scope and all parent scopes to a string.
        function Dump: string;
    end;

    // A closure is a specific kind of method value that is defined by the evaluator.
    // It holds the AST body and its captured scope.
    IDataClosureValue = interface(IDataMethodValue)
        ['{2704586B-E4BD-47AA-B05D-FD441AE6D818}']
        {$region 'private'}
        function GetBody: IExpressionNode;
        function GetParameters: TList<IIdentifierNode>;
        function GetClosureScope: TExecutionScope;
        {$endregion}
        property Body: IExpressionNode read GetBody;
        property Parameters: TList<IIdentifierNode> read GetParameters;
        property ClosureScope: TExecutionScope read GetClosureScope;
    end;

    // 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

type
    { TDataClosureValueImpl }
    // Concrete implementation of the IDataClosureValue interface.
    TDataClosureValueImpl = class(TInterfacedObject, IDataValue, IDataClosureValue)
    private
        FMethodType: IDataMethodType;
        FBody: IExpressionNode;
        FParameters: TList<IIdentifierNode>;
        FClosureScope: TExecutionScope;
        // IDataValue
        function GetDataType: IDataType;
        function GetAsString: string;
        // IDataMethodValue
        function GetValue: TDataMethodProc;
        // IDataClosureValue
        function GetBody: IExpressionNode;
        function GetParameters: TList<IIdentifierNode>;
        function GetClosureScope: TExecutionScope;
    public
        constructor Create(
            AMethodType: IDataMethodType;
            ABody: IExpressionNode;
            AParameters: TList<IIdentifierNode>;
            ACClosureScope: TExecutionScope
        );
    end;

constructor TDataClosureValueImpl.Create(
    AMethodType: IDataMethodType;
    ABody: IExpressionNode;
    AParameters: TList<IIdentifierNode>;
    ACClosureScope: TExecutionScope
);
begin
    inherited Create;
    FMethodType := AMethodType;
    FBody := ABody;
    FParameters := AParameters; // Note: We are taking ownership of the list reference
    FClosureScope := ACClosureScope;
end;

function TDataClosureValueImpl.GetAsString: string;
begin
    Result := '<CLOSURE>';
end;

function TDataClosureValueImpl.GetBody: IExpressionNode;
begin
    Result := FBody;
end;

function TDataClosureValueImpl.GetClosureScope: TExecutionScope;
begin
    Result := FClosureScope;
end;

function TDataClosureValueImpl.GetDataType: IDataType;
begin
    Result := FMethodType;
end;

function TDataClosureValueImpl.GetParameters: TList<IIdentifierNode>;
begin
    Result := FParameters;
end;

function TDataClosureValueImpl.GetValue: TDataMethodProc;
begin
    // This direct execution path is no longer used for closures.
    raise ENotSupportedException.Create('Cannot get raw method proc from a closure object.');
end;

{ TExecutionScope }

constructor TExecutionScope.Create(AParent: TExecutionScope = nil);
begin
    inherited Create;
    FParent := AParent;
    FVariables := TDictionary<string, IDataValue>.Create;
end;

destructor TExecutionScope.Destroy;
begin
    FVariables.Free;
    inherited Destroy;
end;

procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
var
    pair: TPair<string, IDataValue>;
    indentStr: string;
begin
    indentStr := ''.PadLeft(AIndent);
    if FVariables.Count > 0 then
    begin
        for pair in FVariables do
            ABuilder.AppendLine(indentStr + Format('  %s: %s', [pair.Key, pair.Value.AsString]));
    end
    else
    begin
        ABuilder.AppendLine(indentStr + '  (empty)');
    end;

    if Assigned(FParent) then
    begin
        ABuilder.AppendLine(indentStr + '[Parent Scope]');
        FParent.DumpScope(ABuilder, AIndent + 2);
    end;
end;

function TExecutionScope.Dump: string;
var
    builder: TStringBuilder;
begin
    builder := TStringBuilder.Create;
    try
        builder.AppendLine('[Current Scope]');
        DumpScope(builder, 0);
        Result := builder.ToString.TrimRight;
    finally
        builder.Free;
    end;
end;

function TExecutionScope.FindValue(const Name: string; out Value: IDataValue): Boolean;
begin
    Result := FVariables.TryGetValue(Name, Value);
    if not Result and Assigned(FParent) then
    begin
        Result := FParent.FindValue(Name, Value);
    end;
end;

procedure TExecutionScope.SetValue(const Name: string; const Value: IDataValue);
begin
    // This defines a variable in the current scope. It can shadow a parent variable.
    FVariables.AddOrSetValue(Name, Value);
end;

{ 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
    Result := TDataClosureValueImpl.Create(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.