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

unit Myc.Ast.Evaluator;

interface

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

type
    EEvaluatorException = class(EAstException);
    TEvaluatorFactory = reference to function(const AScope: IExecutionScope): IEvaluatorVisitor;

    TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor, IEvaluatorVisitor)
    private
        FScope: IExecutionScope;
    protected
        function Visit(const Node: IAstNode): TDataValue; virtual;
        function CreateVisitorFactory: TEvaluatorFactory; virtual;

        // Nur noch die für die Ausführung relevanten Methoden
        function VisitConstant(const N: IConstantNode): TDataValue; virtual;
        function VisitIdentifier(const N: IIdentifierNode): TDataValue; virtual;
        function VisitKeyword(const N: IKeywordNode): TDataValue; virtual;
        function VisitIfExpression(const N: IIfExpressionNode): TDataValue; virtual;
        function VisitCondExpression(const N: ICondExpressionNode): TDataValue; virtual;
        function VisitLambdaExpression(const N: ILambdaExpressionNode): TDataValue; virtual;
        function VisitFunctionCall(const N: IFunctionCallNode): TDataValue; virtual;
        function VisitBlockExpression(const N: IBlockExpressionNode): TDataValue; virtual;
        function VisitExpressionList(const N: IExpressionList): TDataValue; virtual;
        function VisitVariableDeclaration(const N: IVariableDeclarationNode): TDataValue; virtual;
        function VisitAssignment(const N: IAssignmentNode): TDataValue; virtual;
        function VisitIndexer(const N: IIndexerNode): TDataValue; virtual;
        function VisitMemberAccess(const N: IMemberAccessNode): TDataValue; virtual;
        function VisitRecordLiteral(const N: IRecordLiteralNode): TDataValue; virtual;
        function VisitCreateSeries(const N: ICreateSeriesNode): TDataValue; virtual;
        function VisitAddSeriesItem(const N: IAddSeriesItemNode): TDataValue; virtual;
        function VisitSeriesLength(const N: ISeriesLengthNode): TDataValue; virtual;
        function VisitRecurNode(const N: IRecurNode): TDataValue; virtual;
        function VisitPipe(const N: IPipeNode): TDataValue; virtual;

        function IsTruthy(const AValue: TDataValue): Boolean; inline;
    public
        constructor Create(const AScope: IExecutionScope);
        function Execute(const RootNode: IAstNode): TDataValue;
        class procedure HandleTCO(var ResultValue: TDataValue); static;
        property Scope: IExecutionScope read FScope;
    end;

implementation

uses
    System.TypInfo,
    System.Generics.Defaults,
    Myc.Data.Decimal,
    Myc.Data.Series,
    Myc.Data.Stream,
    Myc.Data.Stream.Pipes,
    Myc.Data.Scalar.JSON,
    Myc.Ast.Types;

type
    TThunk = record
        Callee: TDataValue;
        Args: TArray<TDataValue>;
        Recur: Boolean;
        constructor Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>; ARecur: Boolean);
    end;

constructor TThunk.Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>; ARecur: Boolean);
begin
    Callee := ACallee;
    Args := AArgs;
    Recur := ARecur;
end;

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

function TEvaluatorVisitor.Visit(const Node: IAstNode): TDataValue;
begin
    // Der Hot-Path: Direkter Dispatch ohne Umweg über ungenutzte Methoden.
    case Node.Kind of
        akConstant: Result := VisitConstant(Node.AsConstant);
        akIdentifier: Result := VisitIdentifier(Node.AsIdentifier);
        akKeyword: Result := VisitKeyword(Node.AsKeyword);
        akIfExpression: Result := VisitIfExpression(Node.AsIfExpression);
        akCondExpression: Result := VisitCondExpression(Node.AsCondExpression);
        akLambdaExpression: Result := VisitLambdaExpression(Node.AsLambdaExpression);
        akFunctionCall: Result := VisitFunctionCall(Node.AsFunctionCall);
        akBlockExpression: Result := VisitBlockExpression(Node.AsBlockExpression);
        akExpressionList: Result := VisitExpressionList(Node.AsExpressionList);
        akVariableDeclaration: Result := VisitVariableDeclaration(Node.AsVariableDeclaration);
        akAssignment: Result := VisitAssignment(Node.AsAssignment);
        akIndexer: Result := VisitIndexer(Node.AsIndexer);
        akMemberAccess: Result := VisitMemberAccess(Node.AsMemberAccess);
        akRecordLiteral: Result := VisitRecordLiteral(Node.AsRecordLiteral);
        akCreateSeries: Result := VisitCreateSeries(Node.AsCreateSeries);
        akAddSeriesItem: Result := VisitAddSeriesItem(Node.AsAddSeriesItem);
        akSeriesLength: Result := VisitSeriesLength(Node.AsSeriesLength);
        akRecur: Result := VisitRecurNode(Node.AsRecur);
        akPipe: Result := VisitPipe(Node.AsPipe);
        akMacroExpansion: Result := Visit(Node.AsMacroExpansion.ExpandedBody);
        akNop: Result := TDataValue.Void;
    else
        Result := TDataValue.Void;
    end;
end;

class procedure TEvaluatorVisitor.HandleTCO(var ResultValue: TDataValue);
begin
    while (ResultValue.Kind = vkGeneric) do
    begin
        var thunk := ResultValue.AsGeneric<TThunk>;
        var callee := thunk.Callee.AsMethod();
        ResultValue := callee(thunk.Args);
    end;
end;

function TEvaluatorVisitor.Execute(const RootNode: IAstNode): TDataValue;
begin
    if not Assigned(RootNode) then
        exit(TDataValue.Void);
    try
        Result := Visit(RootNode);
        HandleTCO(Result);
    except
        on E: EAstException do
            raise;
        on E: Exception do
            raise EEvaluatorException.Create('Runtime: ' + E.Message);
    end;
end;

function TEvaluatorVisitor.IsTruthy(const AValue: TDataValue): Boolean;
begin
    if (AValue.Kind <> vkScalar) then
        exit(false);
    case AValue.AsScalar.Kind of
        TScalar.TKind.Ordinal, TScalar.TKind.Keyword, TScalar.TKind.Boolean: Result := AValue.AsScalar.Value.AsInt64 <> 0;
        TScalar.TKind.Float, TScalar.TKind.DateTime: Result := AValue.AsScalar.Value.AsDouble <> 0.0;
    else
        Result := false;
    end;
end;

function TEvaluatorVisitor.CreateVisitorFactory: TEvaluatorFactory;
begin
    Result := function(const AScope: IExecutionScope): IEvaluatorVisitor begin Result := TEvaluatorVisitor.Create(AScope); end;
end;

function TEvaluatorVisitor.VisitConstant(const N: IConstantNode): TDataValue;
begin
    Result := N.Value;
end;

function TEvaluatorVisitor.VisitKeyword(const N: IKeywordNode): TDataValue;
begin
    Result := TDataValue(TScalar.FromKeyword(N.Value));
end;

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

function TEvaluatorVisitor.VisitLambdaExpression(const N: ILambdaExpressionNode): TDataValue;
var
    capturedCells: TArray<IValueCell>;
    i: Integer;
    closureScope: IExecutionScope;
    visitorFactory: TEvaluatorFactory;
begin
    if Length(N.Upvalues) > 0 then
    begin
        SetLength(capturedCells, Length(N.Upvalues));
        for i := 0 to High(N.Upvalues) do
            capturedCells[i] := FScope.Capture(N.Upvalues[i]);
    end
    else
        capturedCells := nil;

    closureScope :=
        if N.HasNestedLambdas then FScope
        else nil;
    visitorFactory := CreateVisitorFactory();

    var descriptor := N.Descriptor;
    var params := N.Parameters;

    var [unsafe] closure: TDataValue.TFunc;
    closure :=
        function(const ArgValues: TArray<TDataValue>): TDataValue
        var
            lambdaScope: IExecutionScope;
            bodyVisitor: IAstVisitor;
            k: Integer;
        begin
            if (Length(ArgValues) <> params.Count) then
                raise EEvaluatorException.Create('Arg mismatch');
            lambdaScope := TScope.CreateScope(closureScope, descriptor, capturedCells);

            // Self-reference for recursion (Slot 0)
            lambdaScope.SetValues(TResolvedAddress.Create(akLocalOrParent, 0, 0), TDataValue(closure));

            for k := 0 to params.Count - 1 do
                lambdaScope[params[k].Address] := ArgValues[k];

            bodyVisitor := visitorFactory(lambdaScope);
            Result := bodyVisitor.Visit(N.Body);
        end;
    Result := TDataValue(closure);
end;

function TEvaluatorVisitor.VisitFunctionCall(const N: IFunctionCallNode): TDataValue;
var
    calleeValue: TDataValue;
    argValues: TArray<TDataValue>;
    i: Integer;
begin
    if Assigned(N.StaticTarget) then
    begin
        SetLength(argValues, N.Arguments.Count);
        for i := 0 to N.Arguments.Count - 1 do
            argValues[i] := Visit(N.Arguments[i]);

        Result := N.StaticTarget(argValues);
        if not N.IsTailCall then
            HandleTCO(Result);
    end
    else
    begin
        calleeValue := Visit(N.Callee);
        if (calleeValue.Kind <> vkMethod) then
            raise EEvaluatorException.Create('Not a function');

        SetLength(argValues, N.Arguments.Count);
        for i := 0 to N.Arguments.Count - 1 do
            argValues[i] := Visit(N.Arguments[i]);

        if N.IsTailCall then
            Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues, false))
        else
        begin
            Result := (calleeValue.AsMethod)(argValues);
            HandleTCO(Result);
        end;
    end;
end;

function TEvaluatorVisitor.VisitRecurNode(const N: IRecurNode): TDataValue;
var
    argValues: TArray<TDataValue>;
    i: Integer;
begin
    SetLength(argValues, N.Arguments.Count);
    for i := 0 to N.Arguments.Count - 1 do
        argValues[i] := Visit(N.Arguments[i]);
    // The "self" function is always at Slot 0
    var callee := FScope[TResolvedAddress.Create(akLocalOrParent, 0, 0)];
    Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(callee, argValues, true));
end;

function TEvaluatorVisitor.VisitBlockExpression(const N: IBlockExpressionNode): TDataValue;
begin
    Result := Visit(N.Expressions);
end;

function TEvaluatorVisitor.VisitExpressionList(const N: IExpressionList): TDataValue;
var
    i: Integer;
begin
    Result := TDataValue.Void;
    for i := 0 to N.Count - 1 do
        Result := Visit(N[i]);
end;

function TEvaluatorVisitor.VisitIfExpression(const N: IIfExpressionNode): TDataValue;
begin
    if IsTruthy(Visit(N.Condition)) then
        Result := Visit(N.ThenBranch)
    else if Assigned(N.ElseBranch) then
        Result := Visit(N.ElseBranch)
    else
        Result := TDataValue.Void;
end;

function TEvaluatorVisitor.VisitCondExpression(const N: ICondExpressionNode): TDataValue;
var
    i: Integer;
begin
    for i := 0 to High(N.Pairs) do
        if IsTruthy(Visit(N.Pairs[i].Condition)) then
            exit(Visit(N.Pairs[i].Branch));
    Result := Visit(N.ElseBranch);
end;

function TEvaluatorVisitor.VisitVariableDeclaration(const N: IVariableDeclarationNode): TDataValue;
var
    ident: IIdentifierNode;
begin
    if Assigned(N.Initializer) then
        Result := Visit(N.Initializer)
    else
        Result := TDataValue.Void;

    ident := N.Target.AsIdentifier;
    if N.IsBoxed then
        FScope.DefineBoxed(ident.Address.SlotIndex, Result)
    else
        FScope[ident.Address] := Result;
end;

function TEvaluatorVisitor.VisitAssignment(const N: IAssignmentNode): TDataValue;
begin
    Result := Visit(N.Value);
    FScope[N.Target.AsIdentifier.Address] := Result;
end;

function TEvaluatorVisitor.VisitIndexer(const N: IIndexerNode): TDataValue;
var
    base, idx: TDataValue;
begin
    base := Visit(N.Base);
    if base.IsVoid then
        exit(TDataValue.Void);
    idx := Visit(N.Index);
    if (base.Kind = vkSeries) then
        Result := TDataValue(base.AsSeries.Items[Integer(idx.AsScalar.Value.AsInt64)])
    else if (base.Kind = vkRecordSeries) then
    begin
        var rs := base.AsRecordSeries;
        var vals: TArray<TScalar.TValue>;
        SetLength(vals, rs.Def.Count);
        var i64 := idx.AsScalar.Value.AsInt64;
        for var k := 0 to rs.Def.Count - 1 do
            vals[k] := rs.Fields[rs.Def.Items[k].Key].Items[Integer(i64)].Value;
        Result := TDataValue.FromScalarRecord(TScalarRecord.Create(rs.Def, vals));
    end
    else
        raise EEvaluatorException.Create('Indexer error');
end;

function TEvaluatorVisitor.VisitMemberAccess(const N: IMemberAccessNode): TDataValue;
var
    base: TDataValue;
begin
    base := Visit(N.Base);
    if base.IsVoid then
        exit(TDataValue.Void);
    case base.Kind of
        vkRecordSeries: Result := TDataValue.FromSeries(base.AsRecordSeries.Fields[N.Member.Value]);
        vkScalarRecord: Result := TDataValue(base.AsScalarRecord.Fields[N.Member.Value]);
        vkGenericRecord: Result := TDataValue(base.AsGenericRecord.Fields[N.Member.Value]);
        vkStream: Result := TDataValue.FromSeries(base.AsStream.Series.Fields[N.Member.Value]);
    else
        raise EEvaluatorException.Create('Member error');
    end;
end;

function TEvaluatorVisitor.VisitRecordLiteral(const N: IRecordLiteralNode): TDataValue;
var
    i: Integer;
begin
    if Assigned(N.ScalarDefinition) then
    begin
        var vals: TArray<TScalar.TValue>;
        SetLength(vals, N.Fields.Count);
        for i := 0 to N.Fields.Count - 1 do
            vals[i] := Visit(N.Fields[i].Value).AsScalar.Value;
        Result := TDataValue.FromScalarRecord(TScalarRecord.Create(N.ScalarDefinition, vals));
    end
    else
    begin
        var fields: TArray<TPair<IKeyword, TDataValue>>;
        SetLength(fields, N.Fields.Count);
        for i := 0 to N.Fields.Count - 1 do
            fields[i] := TPair<IKeyword, TDataValue>.Create(N.Fields[i].Key.Value, Visit(N.Fields[i].Value));
        Result := TDataValue.FromGenericRecord(TKeywordMapping<TDataValue>.Create(fields));
    end;
end;

function TEvaluatorVisitor.VisitCreateSeries(const N: ICreateSeriesNode): TDataValue;
begin
    if N.Definition.Trim.StartsWith('[') then
        Result := TDataValue.FromRecordSeries(TScalarRecordSeries.Create(TRttiAstHelper.JsonToRecordDefinition(N.Definition)))
    else
        Result := TDataValue.FromSeries(TScalarSeries.Create(TScalar.StringToKind(N.Definition)));
end;

function TEvaluatorVisitor.VisitAddSeriesItem(const N: IAddSeriesItemNode): TDataValue;
begin
    var lb: Int64 := -1;
    if Assigned(N.Lookback) then
        lb := Visit(N.Lookback).AsScalar.Value.AsInt64;
    FScope[N.Series.Address].AsRecordSeries.Add(Visit(N.Value).AsScalarRecord, lb);
    Result := TDataValue.Void;
end;

function TEvaluatorVisitor.VisitSeriesLength(const N: ISeriesLengthNode): TDataValue;
begin
    var s := FScope[N.Series.Address];
    var len :=
        if s.Kind = vkSeries then s.AsSeries.Count
        else s.AsRecordSeries.RecordCount;
    Result := TDataValue(TScalar.FromInt64(len));
end;

function TEvaluatorVisitor.VisitPipe(const N: IPipeNode): TDataValue;
var
    i: Integer;
    inputNode: IPipeInputNode;
    sources: TArray<IStream>;
    config: TPipeConfig;
    inputVal: TDataValue;
    sourceSeries: IScalarRecordSeries;
    lambdaFunc: TDataValue.TFunc;
begin
    SetLength(sources, N.Inputs.Count);
    SetLength(config, N.Inputs.Count);
    for i := 0 to N.Inputs.Count - 1 do
    begin
        inputNode := N.Inputs[i];
        inputVal := FScope[inputNode.StreamSource.Address];
        if (inputVal.Kind <> vkStream) then
            raise EEvaluatorException.Create('Stream expected');
        sources[i] := inputVal.AsStream;
        sourceSeries := sources[i].Series;
        var srcDef := sourceSeries.Def;
        var selectors := inputNode.Selectors;
        SetLength(config[i], selectors.Count);
        for var k := 0 to selectors.Count - 1 do
        begin
            var key := selectors[k].Value;
            var idx := srcDef.IndexOf(key);
            config[i][k] := TScalarRecordField.Create(key, srcDef.Items[idx].Value);
        end;
    end;
    lambdaFunc := Visit(N.Transformation).AsMethod();
    var outputDef := N.StaticType.Definition;
    var pipeAdapter: TPipeStream.TPipeLambda :=
        function(const S: array of ISeries; out R: array of TScalar.TValue): Boolean
        var
            args: TArray<TDataValue>;
            res: TDataValue;
            k: Integer;
        begin
            SetLength(args, Length(S));
            for k := 0 to High(S) do
                args[k] := S[k].Items[0];
            res := lambdaFunc(args);
            if res.IsVoid then
                exit(False);
            var rec := res.AsScalarRecord;
            for k := 0 to rec.Def.Count - 1 do
                R[k] := rec.Items[k].Value.Value;
            Result := True;
        end;
    Result := TDataValue.FromStream(TPipeStream.Create(config, outputDef, sources, pipeAdapter));
end;

end.