unit Test.Myc.Ast.Compiler.Binder;

interface

uses
    DUnitX.TestFramework,
    System.SysUtils,
    System.Generics.Collections,
    Myc.Ast,
    Myc.Ast.Nodes,
    Myc.Ast.Scope,
    Myc.Ast.Compiler.Binder,
    Myc.Ast.Types;

type
    [TestFixture]
    TTestAstBinder = class
    private
        FRootLayout: IScopeLayout;

        // Updated Bind helper: Returns log to allow assertions on errors
        function Bind(const Node: IAstNode; out Layout: IScopeLayout; out Log: ICompilerLog): IAstNode;
        function Unwrap(const Node: IAstNode): IAstNode;
    public
        [Setup]
        procedure Setup;

        // --- Basic Scope & Definitions ---

        [Test]
        [IgnoreMemoryLeaks]
        procedure Test_DefineAndResolve_LocalVariable;

        [Test]
        procedure Test_Shadowing_InnerScopeHidesOuter;

        [Test]
        [IgnoreMemoryLeaks]
        procedure Test_ScopeIsolation_SiblingScopesCannotSeeEachOther;

        [Test]
        [IgnoreMemoryLeaks]
        procedure Test_Initializer_CanSeeOuterScope_ButNotSelf;

        // --- Parameters ---

        [Test]
        procedure Test_LambdaParameters_AreBoundToSlotsStartingAtOne;

        [Test]
        procedure Test_MultipleParameters_AreBoundCorrectly;

        // --- Upvalues / Closures ---

        [Test]
        procedure Test_Capture_ImmediateParent;

        [Test]
        procedure Test_Capture_GrandParent_PropagatesThroughIntermediateScope;

        [Test]
        procedure Test_Self_IsImplicitlyDefinedInLambda;

        // --- Corner Cases & Validation ---

        [TestCase('Valid_Simple', 'x')]
        [TestCase('Valid_Kebab', 'my-var')]
        [TestCase('Valid_Snake', 'my_var')]
        [TestCase('Valid_Numbered', 'var1')]
        [TestCase('Valid_Hygienic', 'var#1')]
        procedure Test_IdentifierValidation_ValidNames(const Name: string);

        [TestCase('Invalid_StartDigit', '1var')]
        [TestCase('Invalid_Symbol', 'var$name')]
        [TestCase('Invalid_DotStart', '.var')]
        procedure Test_IdentifierValidation_InvalidNames_LogsError(const Name: string);

        [Test]
        procedure Test_UnresolvedIdentifier_LogsError;

        [Test]
        [IgnoreMemoryLeaks]
        procedure Test_RedefinitionInSameScope_LogsError;
    end;

implementation

uses
    Myc.Data.Value;

{ TTestAstBinder }

procedure TTestAstBinder.Setup;
begin
    FRootLayout := TScope.CreateRootLayout;
end;

function TTestAstBinder.Bind(const Node: IAstNode; out Layout: IScopeLayout; out Log: ICompilerLog): IAstNode;
begin
    Log := TCompilerLog.Create;
    // TAstBinder.Bind now takes Log instead of raising exceptions
    Result := TAstBinder.Bind(FRootLayout, Node, Layout, Log);
end;

function TTestAstBinder.Unwrap(const Node: IAstNode): IAstNode;
begin
    if (Node.Kind = akBlockExpression) and (Node.AsBlockExpression.Expressions.Count = 1) then
        Result := Node.AsBlockExpression.Expressions[0]
    else
        Result := Node;
end;

// ------------------------------------------------------------------------------------------------
// Fixed Test: Initializer Visibility
// ------------------------------------------------------------------------------------------------

procedure TTestAstBinder.Test_Initializer_CanSeeOuterScope_ButNotSelf;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    block: IBlockExpressionNode;
    decl: IVariableDeclarationNode;
    initIdent: IIdentifierNode;
    log: ICompilerLog;
begin
    // (do (def a 10) (def b a))
    root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(10)), TAst.VarDecl(TAst.Identifier('b'), TAst.Identifier('a'))]);

    bound := Bind(root, layout, log);
    Assert.IsFalse(log.HasErrors, 'Binding should succeed without errors.');

    block := bound.AsBlockExpression;

    // Check definition of 'b'
    decl := block.Expressions[1].AsVariableDeclaration;
    initIdent := decl.Initializer.AsIdentifier;

    // 'a' is Slot 0. 'b' is Slot 1.
    Assert.AreEqual<Integer>(0, initIdent.Address.SlotIndex, 'Initializer should resolve to "a" (Slot 0).');
    Assert.AreEqual<Integer>(1, decl.Target.AsIdentifier.Address.SlotIndex, 'Target "b" should be at Slot 1.');
end;

// ------------------------------------------------------------------------------------------------
// Rule Verification: No Redefinition
// ------------------------------------------------------------------------------------------------

procedure TTestAstBinder.Test_RedefinitionInSameScope_LogsError;
var
    root: IAstNode;
    layout: IScopeLayout;
    log: ICompilerLog;
begin
    // (do (def a 1) (def a 2)) - Forbidden!
    root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(1)), TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(2))]);

    Bind(root, layout, log);

    Assert.IsTrue(log.HasErrors, 'Binder must log error for redefinition.');
    Assert.AreEqual('Variable "a" is already defined in this scope.', log.GetEntries[0].Message);
end;

// ------------------------------------------------------------------------------------------------
// Basic Scope & Definitions
// ------------------------------------------------------------------------------------------------

procedure TTestAstBinder.Test_DefineAndResolve_LocalVariable;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    block: IBlockExpressionNode;
    ident: IIdentifierNode;
    log: ICompilerLog;
begin
    root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(42)), TAst.Identifier('a')]);
    bound := Bind(root, layout, log);

    Assert.IsFalse(log.HasErrors);

    block := bound.AsBlockExpression;
    ident := block.Expressions[1].AsIdentifier;
    Assert.AreEqual<TAddressKind>(akLocalOrParent, ident.Address.Kind);
    Assert.AreEqual<Integer>(0, ident.Address.ScopeDepth);
    Assert.AreEqual<Integer>(0, ident.Address.SlotIndex);
end;

procedure TTestAstBinder.Test_Shadowing_InnerScopeHidesOuter;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    block: IBlockExpressionNode;
    innerLambda: ILambdaExpressionNode;
    innerUsage: IIdentifierNode;
    log: ICompilerLog;
begin
    root :=
        TAst.Block([TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(1)), TAst.LambdaExpr([TAst.Identifier('x')], TAst.Identifier('x'))]);
    bound := Bind(root, layout, log);

    Assert.IsFalse(log.HasErrors);

    block := bound.AsBlockExpression;
    innerLambda := block.Expressions[1].AsLambdaExpression;
    innerUsage := innerLambda.Body.AsIdentifier;
    Assert.AreEqual<Integer>(1, innerUsage.Address.SlotIndex); // Parameter x (Slot 1 because <self> is Slot 0)
end;

procedure TTestAstBinder.Test_ScopeIsolation_SiblingScopesCannotSeeEachOther;
var
    root: IAstNode;
    layout: IScopeLayout;
    log: ICompilerLog;
begin
    // (do (fn [] (def a 1)) a) -> 'a' is inside lambda, not visible outside
    root := TAst.Block([TAst.LambdaExpr([], TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(1))), TAst.Identifier('a')]);

    Bind(root, layout, log);

    Assert.IsTrue(log.HasErrors, 'Sibling scope access should fail.');
    Assert.IsTrue(log.GetEntries[0].Message.Contains('Undefined identifier'), 'Expected undefined identifier error.');
end;

// ------------------------------------------------------------------------------------------------
// Parameters
// ------------------------------------------------------------------------------------------------

procedure TTestAstBinder.Test_LambdaParameters_AreBoundToSlotsStartingAtOne;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    lambda: ILambdaExpressionNode;
    log: ICompilerLog;
begin
    root := TAst.LambdaExpr([TAst.Identifier('p1')], TAst.Nop);
    bound := Unwrap(Bind(root, layout, log));

    Assert.IsFalse(log.HasErrors);

    lambda := bound.AsLambdaExpression;
    // Access parameter list via index
    Assert.AreEqual<Integer>(1, lambda.Parameters[0].Address.SlotIndex); // Slot 0 is reserved for <self>
end;

procedure TTestAstBinder.Test_MultipleParameters_AreBoundCorrectly;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    lambda: ILambdaExpressionNode;
    log: ICompilerLog;
begin
    root := TAst.LambdaExpr([TAst.Identifier('a'), TAst.Identifier('b')], TAst.Nop);
    bound := Unwrap(Bind(root, layout, log));

    Assert.IsFalse(log.HasErrors);

    lambda := bound.AsLambdaExpression;
    Assert.AreEqual<Integer>(1, lambda.Parameters[0].Address.SlotIndex);
    Assert.AreEqual<Integer>(2, lambda.Parameters[1].Address.SlotIndex);
end;

// ------------------------------------------------------------------------------------------------
// Upvalues / Closures
// ------------------------------------------------------------------------------------------------

procedure TTestAstBinder.Test_Capture_ImmediateParent;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    block: IBlockExpressionNode;
    lambda: ILambdaExpressionNode;
    bodyIdent: IIdentifierNode;
    log: ICompilerLog;
begin
    root := TAst.Block([TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(99)), TAst.LambdaExpr([], TAst.Identifier('x'))]);
    bound := Bind(root, layout, log);

    Assert.IsFalse(log.HasErrors);

    block := bound.AsBlockExpression;
    lambda := block.Expressions[1].AsLambdaExpression;
    bodyIdent := lambda.Body.AsIdentifier;

    // Inside the lambda, 'x' is accessed via an Upvalue
    Assert.AreEqual<TAddressKind>(akUpvalue, bodyIdent.Address.Kind);
    Assert.AreEqual<Integer>(0, bodyIdent.Address.SlotIndex); // First captured value
end;

procedure TTestAstBinder.Test_Capture_GrandParent_PropagatesThroughIntermediateScope;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    outerBlock: IBlockExpressionNode;
    midLambda, innerLambda: ILambdaExpressionNode;
    log: ICompilerLog;
begin
    root :=
        TAst.Block(
            [TAst.VarDecl(TAst.Identifier('top'), TAst.Constant(100)), TAst.LambdaExpr([], TAst.LambdaExpr([], TAst.Identifier('top')))]
        );
    bound := Bind(root, layout, log);

    Assert.IsFalse(log.HasErrors);

    outerBlock := bound.AsBlockExpression;
    midLambda := outerBlock.Expressions[1].AsLambdaExpression;
    innerLambda := midLambda.Body.AsLambdaExpression;

    // Inner lambda accesses 'top' via upvalue
    Assert.AreEqual<TAddressKind>(akUpvalue, innerLambda.Body.AsIdentifier.Address.Kind);
end;

procedure TTestAstBinder.Test_Self_IsImplicitlyDefinedInLambda;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    lambda: ILambdaExpressionNode;
    log: ICompilerLog;
begin
    root := TAst.LambdaExpr([], TAst.Identifier('<self>'));
    bound := Unwrap(Bind(root, layout, log));

    Assert.IsFalse(log.HasErrors);

    lambda := bound.AsLambdaExpression;
    // <self> is always at Slot 0 (Local)
    Assert.AreEqual<TAddressKind>(akLocalOrParent, lambda.Body.AsIdentifier.Address.Kind);
    Assert.AreEqual<Integer>(0, lambda.Body.AsIdentifier.Address.SlotIndex);
end;

// ------------------------------------------------------------------------------------------------
// Validation Tests
// ------------------------------------------------------------------------------------------------

procedure TTestAstBinder.Test_IdentifierValidation_ValidNames(const Name: string);
var
    root: IAstNode;
    layout: IScopeLayout;
    log: ICompilerLog;
begin
    root := TAst.VarDecl(TAst.Identifier(Name), nil);
    Bind(root, layout, log);
    Assert.IsFalse(log.HasErrors, 'Valid name should not produce errors.');
end;

procedure TTestAstBinder.Test_IdentifierValidation_InvalidNames_LogsError(const Name: string);
var
    root: IAstNode;
    layout: IScopeLayout;
    log: ICompilerLog;
begin
    root := TAst.VarDecl(TAst.Identifier(Name), nil);
    Bind(root, layout, log);

    Assert.IsTrue(log.HasErrors, 'Invalid name should produce error.');
    Assert.IsTrue(log.GetEntries[0].Message.Contains('Invalid identifier name'));
end;

procedure TTestAstBinder.Test_UnresolvedIdentifier_LogsError;
var
    root: IAstNode;
    layout: IScopeLayout;
    log: ICompilerLog;
begin
    root := TAst.Identifier('z');
    Bind(root, layout, log);

    Assert.IsTrue(log.HasErrors, 'Unresolved identifier should produce error.');
    Assert.IsTrue(log.GetEntries[0].Message.Contains('Undefined identifier'));
end;

end.
