MycLib/Test/AST/Test.Myc.Ast.Compiler.Macros.pas

unit Test.Myc.Ast.Compiler.Macros;

interface

uses
    DUnitX.TestFramework,
    System.SysUtils,
    System.Classes,
    Myc.Ast,
    Myc.Ast.Nodes,
    Myc.Ast.Script,
    Myc.Ast.Environment,
    Myc.Data.Value,
    Myc.Data.Scalar,
    Myc.Ast.Compiler.Macros;

type
    [TestFixture]
    [IgnoreMemoryLeaks]
    TMacroTests = class
    private
        FEnv: TAstEnvironment;

        function Run(const Script: string): TDataValue;

        // Returns the raw AST root node after expansion
        function ExpandToNode(const Script: string): IAstNode;

        // Helper to recursively find the first variable declaration in an AST subtree
        function FindFirstVarName(const Node: IAstNode): string;

    public
        [Setup]
        procedure Setup;
        [TearDown]
        procedure TearDown;

        // --- Basic Functionality ---

        [Test]
        [TestCase('Identity', '(defmacro id [x] `~x), (id 42), 42')]
        [TestCase('Constant', '(defmacro c [] `100), (c), 100')]
        [TestCase('SimpleAdd', '(defmacro add [a b] `(+ ~a ~b)), (add 10 20), 30')]
        procedure Test_Basic_Expansion(const MacroDef, Call, ExpectedResult: string);

        // --- Quasiquoting & Unquoting ---

        [Test]
        procedure Test_Quasiquote_Literal;

        [Test]
        procedure Test_Unquote_Complex_Expression;

        // --- Hygiene (The Critical Checks) ---

        [Test]
        procedure Test_Hygiene_GlobalSymbol_Preserved;

        [Test]
        procedure Test_Hygiene_LocalVariable_Renamed;

        [Test]
        procedure Test_Hygiene_Parameter_Renamed;

        // --- Corner Cases & Errors ---

        [Test]
        procedure Test_Error_Unquote_Outside_Quasiquote;

        [Test]
        procedure Test_Macro_Argument_Count_Mismatch;
    end;

implementation

{ TMacroTests }

procedure TMacroTests.Setup;
begin
    FEnv := TAstEnvironment.Construct(nil);
end;

procedure TMacroTests.TearDown;
begin
    FEnv := Default(TAstEnvironment);
end;

function TMacroTests.Run(const Script: string): TDataValue;
var
    node: IAstNode;
begin
    node := TAstScript.Parse(Script);
    Result := FEnv.Run(node);
end;

function TMacroTests.ExpandToNode(const Script: string): IAstNode;
var
    node: IAstNode;
begin
    node := TAstScript.Parse(Script);
    Result := FEnv.Environment.ExpandMacros(node);
end;

function TMacroTests.FindFirstVarName(const Node: IAstNode): string;
var
    block: IBlockExpressionNode;
    child: IAstNode;
begin
    Result := '';

    if not Assigned(Node) then
        Exit;

    // Direct match
    if Node.Kind = akVariableDeclaration then
        Exit(Node.AsVariableDeclaration.Target.AsIdentifier.Name);

    // Recursive search in Blocks
    if Node.Kind = akBlockExpression then
    begin
        block := Node.AsBlockExpression;
        for child in block.Expressions do
        begin
            Result := FindFirstVarName(child);
            if Result <> '' then
                Exit;
        end;
    end;

    // Recursive search in MacroExpansion wrapper
    if Node.Kind = akMacroExpansion then
    begin
        Result := FindFirstVarName(Node.AsMacroExpansion.ExpandedBody);
        if Result <> '' then
            Exit;
    end;
end;

procedure TMacroTests.Test_Basic_Expansion(const MacroDef, Call, ExpectedResult: string);
var
    script: string;
    res: TDataValue;
begin
    script := Format('(do %s %s)', [MacroDef, Call]);
    res := Run(script);
    Assert.AreEqual(Trim(ExpectedResult), res.ToString);
end;

procedure TMacroTests.Test_Quasiquote_Literal;
var
    script: string;
    res: TDataValue;
begin
    // We execute this to verify it returns a valid AST structure (represented as TDataValue)
    // Since we can't easily inspect TDataValue(IAstNode) without casting in the test,
    // we just ensure it runs without error and returns something that is NOT void.
    script :=
        '''
        (do
          (def print (fn [msg] msg))
          (defmacro get-code [] `(print "hello"))
          (get-code))
        ''';

    res := Run(script);
    Assert.IsTrue(res.Kind = vkText, 'Quasiquote expansion should return a value');
end;

procedure TMacroTests.Test_Unquote_Complex_Expression;
var
    script: string;
    res: TDataValue;
begin
    script := '(do ' + '  (defmacro calc [op a b] `(~op ~a ~b)) ' + '  (calc + 5 (* 2 3)))';

    res := Run(script);
    Assert.AreEqual(Int64(11), res.AsScalar.Value.AsInt64);
end;

procedure TMacroTests.Test_Hygiene_GlobalSymbol_Preserved;
var
    script: string;
    res: TDataValue;
begin
    // '+' is global. It MUST NOT be renamed.
    script := '(do ' + '  (defmacro inc [x] `(+ ~x 1)) ' + '  (inc 41))';

    try
        res := Run(script);
        Assert.AreEqual(Int64(42), res.AsScalar.Value.AsInt64);
    except
        on E: Exception do
            Assert.Fail('Hygiene check failed. Global symbol likely renamed. Error: ' + E.Message);
    end;
end;

procedure TMacroTests.Test_Hygiene_LocalVariable_Renamed;
var
    script: string;
    expandedNode: IAstNode;
    varName: string;
begin
    // Local variables defined in a macro MUST be renamed.
    script := '(do ' + '  (defmacro define-x [] `(do (def x 99) x)) ' + '  (define-x))';

    // 1. Run first to ensure code validity (Execution logic)
    var res := Run(script);
    Assert.AreEqual(Int64(99), res.AsScalar.Value.AsInt64, 'Execution failed');

    // 2. Inspect AST Object Graph (Structural logic)
    expandedNode := ExpandToNode(script);

    // We search the AST for the VariableDeclaration of "x"
    varName := FindFirstVarName(expandedNode);

    Assert.IsNotEmpty(varName, 'Variable declaration not found in AST');
    Assert.AreNotEqual('x', varName, 'Hygiene Failure: Variable "x" was NOT renamed.');
    Assert.IsTrue(varName.StartsWith('x#'), Format('Variable should be renamed to x#... but was "%s"', [varName]));
end;

procedure TMacroTests.Test_Hygiene_Parameter_Renamed;
var
    script: string;
    res: TDataValue;
begin
    // 'temp' inside macro should be renamed to 'temp#1' to not clash with global 'temp'.
    script :=
        '''
        (do
          (defmacro swap-bad [a b]
            `(do (def temp ~a) (assign ~a ~b) (assign ~b temp)))
          (def temp 10)
          (def other 20)
          (swap-bad temp other) ; Call with 'temp' passed as 'a'
          temp) ; Should hold the swapped value (20)
        ''';

    res := Run(script);
    Assert.AreEqual(Int64(20), res.AsScalar.Value.AsInt64);
end;

procedure TMacroTests.Test_Error_Unquote_Outside_Quasiquote;
begin
    Assert.WillRaise(procedure begin Run('(print ~1)'); end, EMacroException, 'Unquote outside quasiquote should raise exception');
end;

procedure TMacroTests.Test_Macro_Argument_Count_Mismatch;
begin
    Assert.WillRaise(procedure begin Run('(do (defmacro two [a b] `(+ ~a ~b)) (two 1))'); end, EMacroException);
end;

end.