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;

        function Bind(const Node: IAstNode; out Layout: IScopeLayout): 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_RaisesException(const Name: string);

        [Test]
        procedure Test_UnresolvedIdentifier_RaisesException;

        [Test]
        [IgnoreMemoryLeaks]
        procedure Test_RedefinitionInSameScope_RaisesException;
    end;

implementation

uses
    Myc.Data.Value;

{ TTestAstBinder }

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

function TTestAstBinder.Bind(const Node: IAstNode; out Layout: IScopeLayout): IAstNode;
begin
    Result := TAstBinder.Bind(FRootLayout, Node, Layout);
end;

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

// ... (Previous tests for Basic Scope, Parameters, Upvalues remain identical to previous post)

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

procedure TTestAstBinder.Test_Initializer_CanSeeOuterScope_ButNotSelf;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    block: IBlockExpressionNode;
    decl: IVariableDeclarationNode;
    initIdent: IIdentifierNode;
begin
    // (do
    //   (def a 10)
    //   (def b a)  <-- CHANGED: 'b' initializes from 'a'.
    //                  'def a a' is forbidden in same scope (no shadowing).
    // )
    root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(10)), TAst.VarDecl(TAst.Identifier('b'), TAst.Identifier('a'))]);

    bound := Bind(root, layout);
    block := bound.AsBlockExpression;

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

    // 'a' is Slot 0. 'b' is Slot 1.
    // The initializer 'a' must point to Slot 0.

    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_RaisesException;
var
    root: IAstNode;
    layout: IScopeLayout;
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))]);

    Assert.WillRaise(procedure begin Bind(root, layout); end, Exception, 'Binder must forbid redefinition in the same scope.');
end;

// ... (Rest of validation tests remain identical)

// ------------------------------------------------------------------------------------------------
// Boilerplate for the rest of the tests (copying here for completeness of the unit block)
// ------------------------------------------------------------------------------------------------

procedure TTestAstBinder.Test_DefineAndResolve_LocalVariable;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    block: IBlockExpressionNode;
    ident: IIdentifierNode;
begin
    root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(42)), TAst.Identifier('a')]);
    bound := Bind(root, layout);
    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;
begin
    // This is technically shadowing across *nested* scopes (Lambda vs Outer Block).
    // If you forbid this too, this test needs to fail. Currently assuming strictly "Same Scope" check.
    root :=
        TAst.Block([TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(1)), TAst.LambdaExpr([TAst.Identifier('x')], TAst.Identifier('x'))]);
    bound := Bind(root, layout);
    block := bound.AsBlockExpression;
    innerLambda := block.Expressions[1].AsLambdaExpression;
    innerUsage := innerLambda.Body.AsIdentifier;
    Assert.AreEqual<Integer>(1, innerUsage.Address.SlotIndex); // Parameter x
end;

procedure TTestAstBinder.Test_ScopeIsolation_SiblingScopesCannotSeeEachOther;
var
    root: IAstNode;
    layout: IScopeLayout;
begin
    root := TAst.Block([TAst.LambdaExpr([], TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(1))), TAst.Identifier('a')]);
    Assert.WillRaise(procedure begin Bind(root, layout); end);
end;

procedure TTestAstBinder.Test_LambdaParameters_AreBoundToSlotsStartingAtOne;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    lambda: ILambdaExpressionNode;
begin
    root := TAst.LambdaExpr([TAst.Identifier('p1')], TAst.Nop);
    bound := Unwrap(Bind(root, layout));
    lambda := bound.AsLambdaExpression;
    Assert.AreEqual<Integer>(1, lambda.Parameters[0].Address.SlotIndex);
end;

procedure TTestAstBinder.Test_MultipleParameters_AreBoundCorrectly;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    lambda: ILambdaExpressionNode;
begin
    root := TAst.LambdaExpr([TAst.Identifier('a'), TAst.Identifier('b')], TAst.Nop);
    bound := Unwrap(Bind(root, layout));
    lambda := bound.AsLambdaExpression;
    Assert.AreEqual<Integer>(1, lambda.Parameters[0].Address.SlotIndex);
    Assert.AreEqual<Integer>(2, lambda.Parameters[1].Address.SlotIndex);
end;

procedure TTestAstBinder.Test_Capture_ImmediateParent;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    block: IBlockExpressionNode;
    lambda: ILambdaExpressionNode;
    bodyIdent: IIdentifierNode;
begin
    root := TAst.Block([TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(99)), TAst.LambdaExpr([], TAst.Identifier('x'))]);
    bound := Bind(root, layout);
    block := bound.AsBlockExpression;
    lambda := block.Expressions[1].AsLambdaExpression;
    bodyIdent := lambda.Body.AsIdentifier;
    Assert.AreEqual<TAddressKind>(akUpvalue, bodyIdent.Address.Kind);
    Assert.AreEqual<Integer>(0, bodyIdent.Address.SlotIndex);
end;

procedure TTestAstBinder.Test_Capture_GrandParent_PropagatesThroughIntermediateScope;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    outerBlock: IBlockExpressionNode;
    midLambda, innerLambda: ILambdaExpressionNode;
begin
    root :=
        TAst.Block(
            [TAst.VarDecl(TAst.Identifier('top'), TAst.Constant(100)), TAst.LambdaExpr([], TAst.LambdaExpr([], TAst.Identifier('top')))]
        );
    bound := Bind(root, layout);
    outerBlock := bound.AsBlockExpression;
    midLambda := outerBlock.Expressions[1].AsLambdaExpression;
    innerLambda := midLambda.Body.AsLambdaExpression;
    Assert.AreEqual<TAddressKind>(akUpvalue, innerLambda.Body.AsIdentifier.Address.Kind);
end;

procedure TTestAstBinder.Test_Self_IsImplicitlyDefinedInLambda;
var
    root, bound: IAstNode;
    layout: IScopeLayout;
    lambda: ILambdaExpressionNode;
begin
    root := TAst.LambdaExpr([], TAst.Identifier('<self>'));
    bound := Unwrap(Bind(root, layout));
    lambda := bound.AsLambdaExpression;
    Assert.AreEqual<Integer>(0, lambda.Body.AsIdentifier.Address.SlotIndex);
end;

procedure TTestAstBinder.Test_IdentifierValidation_ValidNames(const Name: string);
var
    root: IAstNode;
    layout: IScopeLayout;
begin
    root := TAst.VarDecl(TAst.Identifier(Name), nil);
    Assert.WillNotRaise(procedure begin Bind(root, layout); end);
end;

procedure TTestAstBinder.Test_IdentifierValidation_InvalidNames_RaisesException(const Name: string);
var
    root: IAstNode;
    layout: IScopeLayout;
begin
    root := TAst.VarDecl(TAst.Identifier(Name), nil);
    Assert.WillRaise(procedure begin Bind(root, layout); end);
end;

procedure TTestAstBinder.Test_UnresolvedIdentifier_RaisesException;
var
    root: IAstNode;
    layout: IScopeLayout;
begin
    root := TAst.Identifier('z');
    Assert.WillRaise(procedure begin Bind(root, layout); end);
end;

end.