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
        // Haupt-Dispatch-Methode
        function Visit(const Node: IAstNode): TDataValue; virtual;
        function CreateVisitorFactory: TEvaluatorFactory; virtual;

        // Besuchermethoden
        function VisitConstant(const N: IConstantNode): TDataValue; virtual;
        function VisitIdentifier(const N: IIdentifierNode): TDataValue; virtual;
        function VisitKeyword(const N: IKeywordNode): TDataValue; virtual;
        function VisitTuple(const N: ITupleNode): 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 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 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.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);
        akTuple: Result := VisitTuple(Node.AsTuple);
        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);
        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);
        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.VisitTuple(const N: ITupleNode): TDataValue;
var
    elements: TArray<TDataValue>;
    i: Integer;
    astElements: TArray<IAstNode>;
begin
    astElements := N.Elements;
    SetLength(elements, Length(astElements));
    for i := 0 to High(astElements) do
        elements[i] := Visit(astElements[i]);

    // Uses the implicit operator: TArray<TDataValue> -> TDataValue (vkTuple)
    Result := elements;
end;

function TEvaluatorVisitor.VisitLambdaExpression(const N: ILambdaExpressionNode): TDataValue;
var
    capturedCells: TArray<IValueCell>;
    i: Integer;
    closureScope: IExecutionScope;
    visitorFactory: TEvaluatorFactory;
    paramsElements: TArray<IAstNode>;
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;
    paramsElements := N.Parameters.Elements;

    var [unsafe] closure: TDataValue.TFunc;
    closure :=
        function(const ArgValues: TArray<TDataValue>): TDataValue
        var
            lambdaScope: IExecutionScope;
            bodyVisitor: IAstVisitor;
            k: Integer;
        begin
            if (Length(ArgValues) <> Length(paramsElements)) 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 High(paramsElements) do
            begin
                // Parameters are guaranteed to be Identifiers by the Binder
                var paramNode := paramsElements[k].AsIdentifier;
                lambdaScope[paramNode.Address] := ArgValues[k];
            end;

            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;
    argsElements: TArray<IAstNode>;
begin
    argsElements := N.Arguments.Elements;
    SetLength(argValues, Length(argsElements));
    for i := 0 to High(argsElements) do
        argValues[i] := Visit(argsElements[i]);

    if Assigned(N.StaticTarget) then
    begin
        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');

        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;
    argsElements: TArray<IAstNode>;
begin
    argsElements := N.Arguments.Elements;
    SetLength(argValues, Length(argsElements));
    for i := 0 to High(argsElements) do
        argValues[i] := Visit(argsElements[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;
var
    exprs: TArray<IAstNode>;
    i: Integer;
begin
    exprs := N.Expressions.Elements;
    Result := TDataValue.Void;
    for i := 0 to High(exprs) do
        Result := Visit(exprs[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: TDataValue;
begin
    base := Visit(N.Base);
    if base.IsVoid then
        exit(TDataValue.Void);

    case base.Kind of
        vkSeries:
        begin
            var idx := Visit(N.Index);
            var i: Integer := idx.AsScalar.Value.AsInt64;
            var series := base.AsSeries;
            if (i < 0) or (i >= series.Count) then
                raise EEvaluatorException.CreateFmt('Series index %d out of bounds (series contains %d items).', [i, series.Count]);
            Result := base.AsSeries[i];
        end;
        vkRecordSeries:
        begin
            var rs := base.AsRecordSeries;

            if N.Index.Kind = akKeyword then
            begin
                Result := rs.Fields[TKeywordRegistry.GetKeyword(Visit(N.Index).AsScalar.Value.AsInt64)];
            end
            else
            begin
                var idx := Visit(N.Index);
                var i: Integer := idx.AsScalar.Value.AsInt64;
                var vals: TArray<TScalar.TValue>;
                SetLength(vals, rs.Def.Count);
                for var k := 0 to rs.Def.Count - 1 do
                begin
                    var series := rs.Fields[rs.Def.Keywords[k]];
                    if (i < 0) or (i >= series.Count) then
                        raise EEvaluatorException.CreateFmt(
                            'Record index %d out of bounds (series <%s> contains %d items).',
                            [i, rs.Keywords[k].Name, series.Count]);
                    vals[k] := series[i].Value;
                end;
                Result := TScalarRecord.Create(rs.Def, vals);
            end;
        end;
        vkTuple:
        begin
            var idx := Visit(N.Index);
            var i: Integer := idx.AsScalar.Value.AsInt64;
            var tpl := base.AsTuple;
            if (i < 0) or (i >= tpl.Count) then
                raise EEvaluatorException.Create('Tuple index out of bounds');
            Result := tpl.Items[i];
        end;
    else
        raise EEvaluatorException.Create('Indexer error');
    end;
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 := base.AsRecordSeries.Fields[N.Member.Value];
        vkScalarRecord: Result := base.AsScalarRecord.Fields[N.Member.Value];
        vkRecord: Result := base.AsRecord.Fields[N.Member.Value];
        //        vkStream: Result := base.AsStream.Def.Fields[N.Member.Value];
    else
        raise EEvaluatorException.Create('Member error');
    end;
end;

function TEvaluatorVisitor.VisitRecordLiteral(const N: IRecordLiteralNode): TDataValue;
var
    i: Integer;
    fieldsElements: TArray<IAstNode>;
begin
    fieldsElements := N.Fields.Elements;
    if Assigned(N.ScalarDefinition) then
    begin
        var vals: TArray<TScalar.TValue>;
        SetLength(vals, Length(fieldsElements));
        for i := 0 to High(fieldsElements) do
        begin
            var field := fieldsElements[i].AsRecordField;
            vals[i] := Visit(field.Value).AsScalar.Value;
        end;
        Result := TScalarRecord.Create(N.ScalarDefinition, vals);
    end
    else
    begin
        var fields: TArray<TPair<IKeyword, TDataValue>>;
        SetLength(fields, Length(fieldsElements));
        for i := 0 to High(fieldsElements) do
        begin
            var field := fieldsElements[i].AsRecordField;
            fields[i] := TPair<IKeyword, TDataValue>.Create(field.Key.Value, Visit(field.Value));
        end;
        Result := TGenericRecord<TDataValue>.Create(fields);
    end;
end;

function TEvaluatorVisitor.VisitCreateSeries(const N: ICreateSeriesNode): TDataValue;
var
    defNode: IAstNode;
    kind: TScalar.TKind;
    fields: TArray<TPair<IKeyword, TScalar.TKind>>;
    i: Integer;
    tupleElements: TArray<IAstNode>;
    entry: TArray<IAstNode>;
    k: IKeyword;
    t: TScalar.TKind;
begin
    // 1. If TypeChecker ran, we have the Definition ready (Fast Path)
    if Assigned(N.RecordDefinition) then
        Exit(TScalarRecordSeries.Create(N.RecordDefinition));

    defNode := N.DefinitionNode;

    // 2. Simple Series (Keyword) e.g. (new-series :Float)
    if defNode.Kind = akKeyword then
    begin
        kind := TScalar.StringToKind(defNode.AsKeyword.Value.Name);
        Exit(TScalarSeries.Create(kind));
    end;

    // 3. Record Series (Tuple of [Key Type]) - Dynamic Parsing Fallback
    // e.g. (new-series [[:Price :Float] [:Vol :Ordinal]])
    if defNode.Kind = akTuple then
    begin
        tupleElements := defNode.AsTuple.Elements;
        SetLength(fields, Length(tupleElements));

        for i := 0 to High(tupleElements) do
        begin
            // Each element MUST be a tuple of 2 elements [Key, Type]
            if tupleElements[i].Kind <> akTuple then
                raise EEvaluatorException.Create('Invalid record definition: Expected vector [Key Type].');

            entry := tupleElements[i].AsTuple.Elements;
            if Length(entry) <> 2 then
                raise EEvaluatorException.Create('Invalid record definition entry: Expected 2 elements.');

            if (entry[0].Kind <> akKeyword) or (entry[1].Kind <> akKeyword) then
                raise EEvaluatorException.Create('Invalid record definition: Key and Type must be keywords.');

            k := entry[0].AsKeyword.Value;
            t := TScalar.StringToKind(entry[1].AsKeyword.Value.Name);
            fields[i] := TPair<IKeyword, TScalar.TKind>.Create(k, t);
        end;

        var def := TKeywordMappingRegistry<TScalar.TKind>.Intern(fields);
        Exit(TScalarRecordSeries.Create(def));
    end;

    raise EEvaluatorException.Create('Invalid CreateSeries definition node.');
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;

    var series := FScope[N.Series.Address];

    case series.Kind of
        vkSeries: raise EEvaluatorException.Create(N.Series.Name + ' is read-only. Use a record series instead.');
        vkRecordSeries:
        begin
            var rec := Visit(N.Value);
            case rec.Kind of
                vkScalarRecord: series.AsRecordSeries.Add(rec.AsScalarRecord, lb);
                vkRecord:
                begin
                    // Type inference didn't manage to infer static record type.
                    var r := rec.AsRecord;
                    var vals: TArray<TScalar.TValue>;
                    SetLength(vals, r.Count);
                    for var i := 0 to r.Count - 1 do
                    begin
                        if r[i].Kind <> vkScalar then
                            raise EEvaluatorException.Create('Scalar record expected.');
                        vals[i] := r[i].AsScalar.Value;
                    end;
                    series.AsRecordSeries.Add(vals);
                end
            else
                raise EEvaluatorException.Create('Adding ' + rec.Kind.ToString + ' to record series not allowed.');
            end;
        end
    else
        raise EEvaluatorException.Create('Record series expected.');
    end;

    Result := TDataValue.Void;
end;

function TEvaluatorVisitor.VisitPipe(const N: IPipeNode): TDataValue;
var
    i: Integer;
    sources: TArray<IStream>;
    config: TPipeConfig;
    inputVal: TDataValue;
    lambdaFunc: TDataValue.TFunc;

    inputsElements: TArray<IAstNode>;
    entryTuple: ITupleNode;
    entryElements: TArray<IAstNode>;
    sourceId: IIdentifierNode;
    selectorsElements: TArray<IAstNode>;
begin
    inputsElements := N.Inputs.Elements;

    SetLength(sources, Length(inputsElements));
    SetLength(config, Length(inputsElements));

    for i := 0 to High(inputsElements) do
    begin
        // Unpack: [Source, [Selectors]]
        // Note: Structure is guaranteed by TypeChecker
        entryTuple := inputsElements[i].AsTuple;
        entryElements := entryTuple.Elements;

        sourceId := entryElements[0].AsIdentifier;
        selectorsElements := entryElements[1].AsTuple.Elements;

        // Resolve Source Stream from Scope
        // The Binder has already linked sourceId to its variable address
        inputVal := FScope[sourceId.Address];

        if (inputVal.Kind <> vkStream) then
            raise EEvaluatorException.Create(Format('Variable "%s" is not a Stream.', [sourceId.Name]));

        sources[i] := inputVal.AsStream;
        var srcDef := sources[i].Def;

        // Build Selectors Config
        SetLength(config[i], Length(selectorsElements));
        for var k := 0 to High(selectorsElements) do
        begin
            var key := selectorsElements[k].AsKeyword.Value;
            var idx := srcDef.IndexOf(key);
            // Index check already done in TypeChecker, but good for safety
            if idx < 0 then
                raise EEvaluatorException.Create(Format('Field :%s not found in stream.', [key.Name]));

            config[i][k] := TScalarRecordField.Create(key, srcDef[idx]);
        end;
    end;

    // Compile the transformation function
    lambdaFunc := Visit(N.Transformation).AsMethod();

    var outputDef: IScalarRecordDefinition;

    case N.StaticType.Kind of
        stVoid:
            // This is an endpoint. The lambda returns nothing. So we produce "nothing".
            outputDef := TScalarRecord.TRegistry.Empty;
        stRecord, stRecordSeries:
            // Allow both stRecord and stRecordSeries (as TypeChecker correctly assigns stRecordSeries for Pipe nodes)
            outputDef := N.StaticType.AsRecord.Definition;
    else
        raise EEvaluatorException.Create('Pipe requires Type Checking to determine output structure (RecordDefinition).');
    end;

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

            res := lambdaFunc(args);

            if res.IsVoid then
                exit(False);

            var rec := res.AsScalarRecord;
            for k := 0 to rec.Count - 1 do
                R[k] := rec.Items[k].Value;

            Result := True;
        end;

    //TODO Lookback not evaluated in script!
    Result := TPipeStream.Create(config, outputDef, sources, pipeAdapter, 1000, 1);
end;

end.