unit Myc.Ast.Evaluator;

interface

uses
    System.SysUtils,
    System.Classes,
    System.Generics.Collections,
    Myc.Data.Scalar,
    Myc.Data.Value,
    Myc.Ast.Nodes,
    Myc.Ast.Scope,
    Myc.Ast;

type
    // A factory for creating visitors, primarily used by the debugger subsystem.
    TVisitorFactory = reference to function(const Scope: IExecutionScope): IAstVisitor;

    // The standard AST evaluator for production use.
    TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor)
    private
        FScope: IExecutionScope;
    protected
        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: TVisitorFactory; virtual;

        property Scope: IExecutionScope read FScope;
    public
        constructor Create(const AScope: IExecutionScope);

        function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
        function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
        function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual;
        function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; virtual;
        function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; virtual;
        function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; virtual;
        function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual;
        function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; virtual;
        function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; virtual;
        function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; virtual;
        function VisitAssignment(const Node: IAssignmentNode): TDataValue; virtual;
        function VisitIndexer(const Node: IIndexerNode): TDataValue; virtual;
        function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; virtual;
        function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; virtual;
        function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; virtual;
        function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual;
    end;

// Registers native Delphi functions into a scope.
procedure RegisterNativeFunctions(const AScope: IExecutionScope);

implementation

uses
    System.TypInfo,
    System.Generics.Defaults,
    Myc.Data.Decimal,
    Myc.Data.Series,
    Myc.Data.Scalar.JSON;

// --- Native Functions Implementation ---

function NativeCreateRecordSeries(const Args: TArray<TDataValue>): TDataValue;
var
    jsonDef: string;
    recordDef: TScalarRecordDefinition;
    series: TScalarRecordSeries;
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;

{ TEvaluatorVisitor }

constructor TEvaluatorVisitor.Create(const AScope: IExecutionScope);
begin
    inherited Create;
    Assert(Assigned(AScope));
    FScope := AScope;
end;

function TEvaluatorVisitor.CreateVisitorFactory: TVisitorFactory;
begin
    // The production visitor returns a factory that creates another production visitor.
    Result := function(const AScope: IExecutionScope): IAstVisitor begin Result := TEvaluatorVisitor.Create(AScope); end;
end;

function TEvaluatorVisitor.IsTruthy(const AValue: TDataValue): Boolean;
begin
    if (AValue.Kind <> vkScalar) then
    begin
        Result := False;
        exit;
    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.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
    capturedCells: TArray<IValueCell>;
    i: Integer;
    sourceAddresses: TArray<TResolvedAddress>;
    closureScope: IExecutionScope;
    closureValue: TDataValue;
    visitorFactory: TVisitorFactory;
begin
    sourceAddresses := Node.Upvalues;
    SetLength(capturedCells, Length(sourceAddresses));
    for i := 0 to High(sourceAddresses) do
        capturedCells[i] := FScope.Capture(sourceAddresses[i]);

    if Node.HasNestedLambdas then
        closureScope := FScope
    else
        closureScope := nil;

    // Get the appropriate factory via virtual dispatch.
    visitorFactory := CreateVisitorFactory();

    var scopeDescriptor := Node.ScopeDescriptor;
    var params := Node.Parameters;

    closureValue :=
        TDataValue.TFunc(
            function(const ArgValues: TArray<TDataValue>): 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)]);

                lambdaScope := TExecutionScope.Create(closureScope, scopeDescriptor, capturedCells);

                adr.Kind := akLocalOrParent;
                adr.ScopeDepth := 0;

                // Capture 'Self' (slot 0) for recursion.
                adr.SlotIndex := 0;
                lambdaScope[adr] := closureValue;

                // Populate the actual parameters.
                for i := 0 to High(ArgValues) do
                begin
                    adr.SlotIndex := params[i].Address.SlotIndex;
                    lambdaScope[adr] := ArgValues[i];
                end;

                // Use the injected factory to create the visitor for the lambda's body.
                bodyVisitor := visitorFactory(lambdaScope);

                Result := Node.Body.Accept(bodyVisitor);
            end
        );

    Result := closureValue;
end;

function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
    calleeValue: TDataValue;
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;
    case Length(argNodes) of
        0: Result := (calleeValue.AsMethod)([]);
        1: Result := (calleeValue.AsMethod)([argNodes[0].Accept(Self)]);
        2: Result := (calleeValue.AsMethod)([argNodes[0].Accept(Self), argNodes[1].Accept(Self)]);
        3: Result := (calleeValue.AsMethod)([argNodes[0].Accept(Self), argNodes[1].Accept(Self), argNodes[2].Accept(Self)]);
        4:
            Result :=
                (calleeValue.AsMethod)
                    ([argNodes[0].Accept(Self), argNodes[1].Accept(Self), argNodes[2].Accept(Self), argNodes[3].Accept(Self)]);
    else
        var argValues: TArray<TDataValue>;
        SetLength(argValues, Length(argNodes));
        for var i := 0 to High(argNodes) do
            argValues[i] := argNodes[i].Accept(Self);

        Result := (calleeValue.AsMethod)(argValues);
    end;
end;

function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
var
    itemValue, lookbackValue, seriesVar: TDataValue;
    lookback: Int64;
begin
    seriesVar := FScope[Node.Series.Address];
    itemValue := Node.Value.Accept(Self);
    lookback := -1;

    if Assigned(Node.Lookback) then
    begin
        lookbackValue := Node.Lookback.Accept(Self);
        if (lookbackValue.Kind <> vkScalar) or not (lookbackValue.AsScalar.Kind in [skInteger, skInt64]) then
            raise EArgumentException.Create('Lookback parameter must be an integer.');

        if lookbackValue.AsScalar.Kind = skInteger then
            lookback := lookbackValue.AsScalar.Value.AsInteger
        else
            lookback := lookbackValue.AsScalar.Value.AsInt64;
    end;

    case seriesVar.Kind of
        vkSeries:
        begin
            if (itemValue.Kind <> vkScalar) then
                raise EArgumentException.Create('Can only add scalar values to a TScalarSeries.');

            with seriesVar.AsSeries.Value do
            begin
                if (itemValue.AsScalar.Kind <> Kind) then
                    raise EArgumentException
                        .CreateFmt('Type mismatch: Cannot add %s to a series of %s.', [itemValue.AsScalar.Kind.ToString, Kind.ToString]);
                Items.Add(itemValue.AsScalar.Value, lookback);
            end;
        end;
        vkRecordSeries:
        begin
            if (itemValue.Kind <> vkRecord) then
                raise EArgumentException.Create('Can only add record values to a TScalarRecordSeries.');

            with seriesVar.AsRecordSeries.Value do
            begin
                Add(itemValue.AsRecord.Value, 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
    Result := Node.Value.Accept(Self);
    FScope[Node.Identifier.Address] := Result;
end;

function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
begin
    Result := 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);
        var scalarSeries := TScalarSeries.Create(scalarKind, Default(TSeries<TScalarValue>));
        Result := TDataValue.FromSeries(scalarSeries);
    end;
end;

function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
    Result := FScope[Node.Address];
end;

function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
var
    baseValue, indexValue: TDataValue;
    index: Int64;
    indexScalar: TScalar;
begin
    baseValue := Node.Base.Accept(Self);
    indexValue := Node.Index.Accept(Self);

    if (indexValue.Kind <> vkScalar) 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;

    case baseValue.Kind of
        vkSeries:
        begin
            with baseValue.AsSeries.Value do
            begin
                if (index < 0) or (index >= Items.TotalCount) then
                    raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, Items.TotalCount]);
                Result := TScalar.Create(Kind, Items[Integer(index)]);
            end;
        end;
        vkRecordSeries:
        begin
            var series := baseValue.AsRecordSeries.Value;
            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]);
            var recordValue := series.Items[Integer(index)];
            Result := TDataValue.FromRecord(recordValue);
        end;
        vkMemberSeries:
        begin
            var memberSeries := baseValue.AsMemberSeries.Value;
            if (index < 0) or (index >= memberSeries.Count) then
                raise EArgumentException
                    .CreateFmt('Index %d is out of bounds for member series with %d elements.', [index, memberSeries.Count]);
            Result := memberSeries.Items[Integer(index)];
        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;
    memberName: string;
begin
    baseValue := Node.Base.Accept(Self);
    memberName := Node.Member.Name;

    case baseValue.Kind of
        vkSeries:
        begin
            with baseValue.AsSeries.Value do
            begin
                if SameText(memberName, 'Count') then
                    Result := TScalar.FromInt64(Items.Count)
                else if SameText(memberName, 'TotalCount') then
                    Result := TScalar.FromInt64(Items.TotalCount)
                else if SameText(memberName, 'Kind') then
                    Result := Kind.ToString
                else
                    raise EArgumentException.CreateFmt('Member "%s" not found on TScalarSeries.', [memberName]);
            end;
        end;
        vkRecordSeries: Result := TDataValue.FromMemberSeries(baseValue.AsRecordSeries.Value.CreateMemberSeries(memberName));
        vkRecord: Result := baseValue.AsRecord.Value.Items[memberName];
    else
        raise EArgumentException.Create('Member access operator `.` is not supported for this value type.');
    end;
end;

function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
    if Assigned(Node.Initializer) then
        Result := Node.Initializer.Accept(Self);

    FScope[Node.Identifier.Address] := Result;
end;

function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
var
    leftValue, rightValue: TDataValue;
begin
    leftValue := Node.Left.Accept(Self);
    rightValue := Node.Right.Accept(Self);

    if (leftValue.Kind <> vkScalar) or (rightValue.Kind <> vkScalar) then
        raise ENotSupportedException.Create('Binary operations are only supported for scalar types.');

    var res: TScalar;
    if not TScalar.TryBinaryOperation(Node.Operator, leftValue.AsScalar, rightValue.AsScalar, res) then
        raise ENotSupportedException.Create(
            'Binary operation not supported for scalar types '
                + leftValue.AsScalar.Kind.ToString
                + ' and '
                + rightValue.AsScalar.Kind.ToString
                + ' .');
    Result := res;
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);
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.Address];

    case seriesValue.Kind of
        vkSeries: len := seriesValue.AsSeries.Value.Items.Count;
        vkRecordSeries: len := seriesValue.AsRecordSeries.Value.Count;
        vkMemberSeries: len := seriesValue.AsMemberSeries.Value.Count;
    else
        raise EArgumentException.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TDataValueKind), Ord(seriesValue.Kind))]);
    end;

    Result := TScalar.FromInt64(len);
end;

end.