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

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;
    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;
    end;

implementation

uses
    Myc.Data.Decimal,
    Myc.Ast.Scope,
    Myc.Ast.Printer;

type
    // Concrete implementation of the IEvaluatorClosure interface, private to this unit.
    TClosureValue = class(TInterfacedObject, IEvaluatorClosure)
    private
        FBody: IExpressionNode;
        FParameters: TArray<IIdentifierNode>;
        FClosureScope: IExecutionScope;
        function GetBody: IExpressionNode;
        function GetParameters: TArray<IIdentifierNode>;
        function GetClosureScope: IExecutionScope;
    public
        constructor Create(ABody: IExpressionNode; const AParameters: TArray<IIdentifierNode>; const AClosureScope: IExecutionScope);
    end;

{ TClosureValue }

constructor TClosureValue.Create(ABody: IExpressionNode; const AParameters: TArray<IIdentifierNode>; 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<IIdentifierNode>;
begin
    Result := FParameters;
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.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;
    arguments: TList<IExpressionNode>;
    closure: IEvaluatorClosure;
    callScope: IExecutionScope;
    innerVisitor: IAstVisitor;
    i: Integer;
    argValue: TAstValue;
begin
    calleeValue := Node.Callee.Accept(Self);
    arguments := Node.Arguments;

    if calleeValue.Kind <> avkClosure then
        raise EArgumentException.Create('Expression is not a callable closure.');

    closure := calleeValue.AsClosure;

    if (arguments.Count <> Length(closure.Parameters)) then
        raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), arguments.Count]);

    callScope := TExecutionScope.Create(closure.ClosureScope);

    for i := 0 to arguments.Count - 1 do
    begin
        argValue := arguments[i].Accept(Self);
        callScope.SetValue(closure.Parameters[i].Name, argValue);
    end;

    innerVisitor := Self.CreateVisitorForScope(callScope);

    // Introduce 'Result' variable for imperative-style assignments within the closure.
    callScope.SetValue('Result', TAstValue.Void);

    // The return value of the function is the value of its body expression.
    // This supports both functional-style returns (direct value) and
    // imperative-style returns (via an assignment, which also returns the value).
    Result := closure.Body.Accept(innerVisitor);
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<string>;
    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.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.