unit Myc.Ast.Binding;

interface

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

type
    IAstBinder = interface(IAstVisitor)
        function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
    end;

    TAstBinder = class; // Forward declaration

    TAstBinder = class(TAstTransformer, IAstBinder)
    private
        type
            TUpvalueMapping = TDictionary<TResolvedAddress, Integer>;
    private
        FInitialScope: IExecutionScope;
        FCurrentDescriptor: IScopeDescriptor;
        FUpvalueStack: TStack<TUpvalueMapping>;
        FNestedLambdaCount: Integer;
        FBoxedDeclarations: THashSet<IVariableDeclarationNode>;

        procedure EnterScope;
        procedure ExitScope;
        function IsValidIdentifier(const Name: string): Boolean;
        function SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue; overload;

    protected
        function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
        function VisitKeyword(const Node: IKeywordNode): TDataValue; override;
        function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
        function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
        function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
        function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
        function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
        function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override;
        function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
        function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
        function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
        function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
        function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
        function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
        function VisitConstant(const Node: IConstantNode): TDataValue; override;
        function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
        function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
        function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
        function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
        function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
        function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;

    public
        constructor Create(const AInitialScope: IExecutionScope);
        destructor Destroy; override;
        function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;

        class function Bind(
            const InitialScope: IExecutionScope;
            const RootNode: IAstNode;
            out Descriptor: IScopeDescriptor
        ): IAstNode; static;
    end;

implementation

uses
    System.Generics.Defaults,
    System.Character,
    Myc.Data.Keyword,
    Myc.Ast.Binding.Nodes;

type
    TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
    public
        function Equals(const Left, Right: TResolvedAddress): Boolean; override;
        function GetHashCode(const Value: TResolvedAddress): Integer; override;
    end;

{ TResolvedAddressComparer }
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
begin
    Result := (Left = Right);
end;

function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer;
begin
    Result := 17;
    Result := Result * 23 + Ord(Value.Kind);
    Result := Result * 23 + Value.ScopeDepth;
    Result := Result * 23 + Value.SlotIndex;
end;

{ TAstBinder }

constructor TAstBinder.Create(const AInitialScope: IExecutionScope);
begin
    inherited Create;
    Assert(Assigned(AInitialScope));

    FInitialScope := AInitialScope;
    FCurrentDescriptor := AInitialScope.CreateDescriptor;
    FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(True);
    FNestedLambdaCount := 0;
    FBoxedDeclarations := nil;
end;

destructor TAstBinder.Destroy;
begin
    FUpvalueStack.Free;
    FBoxedDeclarations.Free;
    inherited;
end;

function TAstBinder.SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue;
begin
    if (not NodeData.IsVoid) and (NodeData.Kind = vkInterface) then
        (NodeData.AsIntf<IAstNode> as TAstNode).StaticType := AType;
    Result := NodeData;
end;

class function TAstBinder.Bind(const InitialScope: IExecutionScope; const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
    var binder := TAstBinder.Create(InitialScope) as IAstBinder;
    Result := binder.Execute(RootNode, Descriptor);
end;

procedure TAstBinder.EnterScope;
begin
    FCurrentDescriptor := TScope.CreateDescriptor(FCurrentDescriptor);
end;

procedure TAstBinder.ExitScope;
begin
    FCurrentDescriptor := FCurrentDescriptor.Parent;
end;

function TAstBinder.IsValidIdentifier(const Name: string): Boolean;
var
    c: Char;
begin
    if Name.IsEmpty then
        exit(False);
    c := Name[1];
    if not (c.IsLetter or (c = '_')) then
        exit(False);
    for c in Name do
    begin
        if not (c.IsLetterOrDigit or (c = '_') or (c = '-')) then
            exit(False);
    end;
    Result := True;
end;

function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
    FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode, FCurrentDescriptor.Parent);
    try
        EnterScope;
        try
            var transformedValue := Accept(RootNode);
            if transformedValue.IsVoid then
                Result := TAst.Block([])
            else
                Result := transformedValue.AsIntf<IAstNode>;

            (Result as TAstNode).StaticType := TTypes.Unknown;
            Descriptor := FCurrentDescriptor;
        finally
            ExitScope;
        end;
    finally
    end;
end;

function TAstBinder.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
begin
    raise Exception.Create('TMyAstBinder: MacroDefinition node encountered.');
end;

function TAstBinder.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
begin
    Result := Accept(Node.ExpandedBody);
end;

function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
    boundCall: TBoundFunctionCallNode;
    callee: IAstNode;
    args: TArray<IAstNode>;
begin
    // --- Transformation: Keyword-as-Function ---
    if (Node.Callee is TKeywordNode) then
    begin
        var keywordNode := (Node.Callee as TKeywordNode);
        if Length(Node.Arguments) <> 1 then
            raise ETypeException.CreateFmt(
                'Keyword :%s expects exactly one argument (the record/map), but got %d',
                [keywordNode.Value.Name, Length(Node.Arguments)]);

        var baseNode := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
        var memberAccessNode := TAst.MemberAccess(baseNode, keywordNode);

        Result := Accept(memberAccessNode);
        exit;
    end;

    // --- Default: Bind as a standard function call ---
    callee := Accept(Node.Callee).AsIntf<IAstNode>;
    args := AcceptNodes<IAstNode>(Node.Arguments);

    // Create the node, always marking IsTailCall as false.
    // The Lowerer (Phase 4) will set this flag correctly.
    boundCall := TBoundFunctionCallNode.Create(Node, callee, args, False);

    Result := SetType(TDataValue.FromIntf<IFunctionCallNode>(boundCall), TTypes.Unknown);
end;

function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue;
var
    boundIdentifier, boundValue: IAstNode;
    boundNode: IAssignmentNode;
begin
    boundIdentifier := Accept(Node.Identifier).AsIntf<IAstNode>;
    boundValue := Accept(Node.Value).AsIntf<IAstNode>;
    boundNode := TAst.Assign(boundIdentifier as TBoundIdentifierNode, boundValue);
    Result := SetType(TDataValue.FromIntf<IAssignmentNode>(boundNode), TTypes.Unknown);
end;

function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
var
    left, right: IAstNode;
    boundNode: IBinaryExpressionNode;
begin
    left := Accept(Node.Left).AsIntf<IAstNode>;
    right := Accept(Node.Right).AsIntf<IAstNode>;
    boundNode := TAst.BinaryExpr(left, Node.Operator, right);
    Result := SetType(TDataValue.FromIntf<IBinaryExpressionNode>(boundNode), TTypes.Unknown);
end;

function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
    exprs: TArray<IAstNode>;
    i: Integer;
    transformedValue: TDataValue;
    exprList: TList<IAstNode>;
    boundNode: IBlockExpressionNode;
begin
    exprList := TList<IAstNode>.Create;
    try
        for i := 0 to High(Node.Expressions) do
        begin
            transformedValue := Accept(Node.Expressions[i]);
            if not transformedValue.IsVoid then
                exprList.Add(transformedValue.AsIntf<IAstNode>);
        end;
        exprs := exprList.ToArray;
    finally
        exprList.Free;
    end;

    if (Length(exprs) = Length(Node.Expressions)) then
    begin
        var same := True;
        for i := 0 to High(exprs) do
            if exprs[i] <> Node.Expressions[i] then
            begin
                same := False;
                break;
            end;
        if same then
            boundNode := Node
        else
            boundNode := TAst.Block(exprs);
    end
    else
        boundNode := TAst.Block(exprs);

    Result := SetType(TDataValue.FromIntf<IBlockExpressionNode>(boundNode), TTypes.Unknown);
end;

function TAstBinder.VisitConstant(const Node: IConstantNode): TDataValue;
begin
    case Node.Value.Kind of
        TDataValueKind.vkScalar:
            Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.FromScalarKind(Node.Value.AsScalar.Kind));
        TDataValueKind.vkText: Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Text);
        TDataValueKind.vkVoid: Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Void);
    else
        Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Unknown);
    end;
end;

function TAstBinder.VisitKeyword(const Node: IKeywordNode): TDataValue;
begin
    Result := SetType(TDataValue.FromIntf<IKeywordNode>(Node), TTypes.Keyword);
end;

function TAstBinder.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
var
    elemType: IStaticType;
begin
    try
        elemType := TTypes.FromScalarKind(TScalar.StringToKind(Node.Definition));
    except
        on E: Exception do
            elemType := TTypes.Unknown;
    end;
    Result := SetType(TDataValue.FromIntf<ICreateSeriesNode>(Node), TTypes.CreateSeries(elemType));
end;

function TAstBinder.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
var
    seriesNode, valueNode, lookbackNode: IAstNode;
begin
    seriesNode := Accept(Node.Series).AsIntf<IAstNode>;
    valueNode := Accept(Node.Value).AsIntf<IAstNode>;
    if Node.Lookback <> nil then
        lookbackNode := Accept(Node.Lookback).AsIntf<IAstNode>
    else
        lookbackNode := nil;

    var boundNode := TAst.AddSeriesItem(seriesNode as TIdentifierNode, valueNode, lookbackNode);
    Result := SetType(TDataValue.FromIntf<IAddSeriesItemNode>(boundNode), TTypes.Void);
end;

function TAstBinder.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
    Accept(Node.Series);
    Result := SetType(TDataValue.FromIntf<ISeriesLengthNode>(Node), TTypes.Ordinal);
end;

function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
var
    condition, thenBranch, elseBranch: IAstNode;
    boundNode: IIfExpressionNode;
begin
    condition := Accept(Node.Condition).AsIntf<IAstNode>;
    thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
    if Assigned(Node.ElseBranch) then
        elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>
    else
        elseBranch := nil;

    if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
        boundNode := TAst.IfExpr(condition, thenBranch, elseBranch)
    else
        boundNode := Node;

    Result := SetType(TDataValue.FromIntf<IIfExpressionNode>(boundNode), TTypes.Unknown);
end;

function TAstBinder.VisitIndexer(const Node: IIndexerNode): TDataValue;
var
    baseNode, indexNode: IAstNode;
    boundNode: IIndexerNode;
begin
    baseNode := Accept(Node.Base).AsIntf<IAstNode>;
    indexNode := Accept(Node.Index).AsIntf<IAstNode>;
    boundNode := TAst.Indexer(baseNode, indexNode);
    Result := SetType(TDataValue.FromIntf<IIndexerNode>(boundNode), TTypes.Unknown);
end;

function TAstBinder.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
var
    baseNode: IAstNode;
    boundNode: IMemberAccessNode;
begin
    baseNode := Accept(Node.Base).AsIntf<IAstNode>;
    boundNode := TAst.MemberAccess(baseNode, Node.Member);
    Result := SetType(TDataValue.FromIntf<IMemberAccessNode>(boundNode), TTypes.Unknown);
end;

function TAstBinder.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
var
    i: Integer;
    boundFields: TArray<TRecordFieldLiteral>;
    valNode: IAstNode;
    valType: IStaticType;
    allScalar: Boolean;
begin
    SetLength(boundFields, Length(Node.Fields));
    allScalar := True;

    for i := 0 to High(Node.Fields) do
    begin
        valNode := Accept(Node.Fields[i].Value).AsIntf<IAstNode>;
        valType := (valNode as TAstNode).StaticType;

        if not (valType.Kind in [stOrdinal, stFloat, stKeyword, stUnknown]) then
            allScalar := False;

        boundFields[i] := TRecordFieldLiteral.Create(Node.Fields[i].Key, valNode);
    end;

    if allScalar then
    begin
        var boundNode := TBoundRecordLiteralNode.Create(boundFields, nil);
        Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(boundNode), TTypes.Unknown);
    end
    else
    begin
        var genBoundNode := TBoundGenericRecordLiteralNode.Create(boundFields, nil);
        Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(genBoundNode), TTypes.Unknown);
    end;
end;

function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
    i: integer;
    boundParams: TArray<IIdentifierNode>;
    boundBody: IAstNode;
    lambdaScope: IScopeDescriptor;
    upvalues: TArray<TResolvedAddress>;
    hasNestedLambdas: Boolean;
    lastNestedLambdaCount: Integer;
    boundLambda: ILambdaExpressionNode;
begin
    FUpvalueStack.Push(TUpvalueMapping.Create(TResolvedAddressComparer.Create));
    try
        EnterScope;
        try
            FCurrentDescriptor.Define('<self>', TTypes.Unknown);

            SetLength(boundParams, Length(Node.Parameters));
            for i := 0 to High(Node.Parameters) do
            begin
                var paramNode := Node.Parameters[i];
                var slotIndex := FCurrentDescriptor.Define(paramNode.Name, TTypes.Unknown);
                var address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
                boundParams[i] := TBoundIdentifierNode.Create(paramNode, address);
                (boundParams[i] as TAstNode).StaticType := TTypes.Unknown;
            end;

            lastNestedLambdaCount := FNestedLambdaCount;
            boundBody := Accept(Node.Body).AsIntf<IAstNode>;
            hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
            lambdaScope := FCurrentDescriptor;
        finally
            ExitScope;
        end;

        var upvalueMapping := FUpvalueStack.Peek;
        var sortedPairs := upvalueMapping.ToArray;
        TArray.Sort<TPair<TResolvedAddress, Integer>>(
            sortedPairs,
            TComparer<TPair<TResolvedAddress, Integer>>.Construct(
                function(const Left, Right: TPair<TResolvedAddress, Integer>): Integer begin Result := Left.Value - Right.Value; end
            )
        );
        SetLength(upvalues, Length(sortedPairs));
        for i := 0 to High(sortedPairs) do
            upvalues[i] := sortedPairs[i].Key;
    finally
        FUpvalueStack.Pop;
    end;

    inc(FNestedLambdaCount);
    boundLambda := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas);
    Result := SetType(TDataValue.FromIntf<ILambdaExpressionNode>(boundLambda), TTypes.Unknown);
end;

function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue;
begin
    var boundNode := TAst.Recur(AcceptNodes<IAstNode>(Node.Arguments));
    Result := SetType(TDataValue.FromIntf<IRecurNode>(boundNode), TTypes.Void);
end;

function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
var
    condition, thenBranch, elseBranch: IAstNode;
    boundNode: ITernaryExpressionNode;
begin
    condition := Accept(Node.Condition).AsIntf<IAstNode>;
    thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
    elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;

    if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
        boundNode := TAst.TernaryExpr(condition, thenBranch, elseBranch)
    else
        boundNode := Node;

    Result := SetType(TDataValue.FromIntf<ITernaryExpressionNode>(boundNode), TTypes.Unknown);
end;

function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
var
    right: IAstNode;
    boundNode: IUnaryExpressionNode;
begin
    right := Accept(Node.Right).AsIntf<IAstNode>;
    boundNode := TAst.UnaryExpr(Node.Operator, right);
    Result := SetType(TDataValue.FromIntf<IUnaryExpressionNode>(boundNode), TTypes.Unknown);
end;

function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
var
    symbol: TResolvedSymbol;
    boundNode: IIdentifierNode;
    adr: TResolvedAddress;
begin
    symbol := FCurrentDescriptor.FindSymbol(Node.Name);
    adr := symbol.Address;

    if adr.Kind = akLocalOrParent then
    begin
        if (adr.ScopeDepth > 0) and (FUpvalueStack.Count > 0) then
        begin
            // Handle Upvalue
            var upvalue := FUpvalueStack.Peek;
            dec(adr.ScopeDepth);
            var upvalueIndex: Integer;
            if not upvalue.TryGetValue(adr, upvalueIndex) then
            begin
                upvalueIndex := upvalue.Count;
                upvalue.Add(adr, upvalueIndex);
            end;
            boundNode := TBoundIdentifierNode.Create(Node, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex));
        end
        else
            // Handle LocalOrParent
            boundNode := TBoundIdentifierNode.Create(Node, adr);

        Result := SetType(TDataValue.FromIntf<IIdentifierNode>(boundNode), symbol.StaticType);
    end
    else
        raise Exception.CreateFmt('Undefined identifier: "%s"', [Node.Name]);
end;

function TAstBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
var
    initializer: IAstNode;
    slotIndex: Integer;
    address: TResolvedAddress;
    boundIdentifier: IIdentifierNode;
    isBoxed: Boolean;
    boundDecl: IVariableDeclarationNode;
begin
    if not IsValidIdentifier(Node.Identifier.Name) then
        raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]);

    initializer := nil;
    if Node.Initializer <> nil then
        initializer := Accept(Node.Initializer).AsIntf<IAstNode>;

    slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name, TTypes.Unknown);
    address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
    boundIdentifier := TBoundIdentifierNode.Create(Node.Identifier, address);
    (boundIdentifier as TAstNode).StaticType := TTypes.Unknown;

    isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
    boundDecl := TBoundVariableDeclarationNode.Create(boundIdentifier, initializer, isBoxed);

    Result := SetType(TDataValue.FromIntf<IVariableDeclarationNode>(boundDecl), TTypes.Unknown);
end;

end.