MycLib/Src/AST/Myc.Ast.Compiler.TCO.pas

unit Myc.Ast.Compiler.TCO;

interface

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

type
    // Exception specific to optimization/TCO errors
    EOptimizerException = class(EAstException);

    IAstTCO = interface(IAstVisitor)
        function Execute(const RootNode: IAstNode): IAstNode;
    end;

    // This transformer runs *after* the Lowerer (Phase 4/5) and Specializer.
    // Its sole responsibility is to identify tail calls (TCO)
    // and set the `IsTailCall` flag on TFunctionCallNode.
    TAstTCO = class(TAstTransformer, IAstTCO)
    private
        FIsTailStack: TStack<Boolean>;
        FNextIsTail: Boolean;
    protected
        function Accept(const Node: IAstNode): IAstNode; override;
        // Overrides for TCO propagation
        function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
        function VisitIfExpression(const Node: IIfExpressionNode): IAstNode; override;
        function VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode; override;
        function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
        function VisitRecurNode(const Node: IRecurNode): IAstNode; override;
        function VisitMacroExpansionNode(const Node: IMacroExpansionNode): IAstNode; override;

        // The core TCO logic
        function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
    public
        constructor Create;
        destructor Destroy; override;
        function Execute(const RootNode: IAstNode): IAstNode;

        class function Optimize(const RootNode: IAstNode): IAstNode; static;
    end;

implementation

{ TAstTCO }

constructor TAstTCO.Create;
begin
    inherited Create;
    FIsTailStack := TStack<Boolean>.Create;
    FNextIsTail := True; // The root expression is in tail position
end;

destructor TAstTCO.Destroy;
begin
    FIsTailStack.Free;
    inherited;
end;

class function TAstTCO.Optimize(const RootNode: IAstNode): IAstNode;
begin
    var optimizer := TAstTCO.Create as IAstTCO;
    Result := optimizer.Execute(RootNode);
end;

function TAstTCO.Execute(const RootNode: IAstNode): IAstNode;
begin
    Result := Accept(RootNode);
    if not Assigned(Result) then
        Result := TAst.Block([], nil);
end;

function TAstTCO.Accept(const Node: IAstNode): IAstNode;
begin
    if (not Assigned(Node)) then
    begin
        Result := nil;
        exit;
    end;

    FIsTailStack.Push(FNextIsTail);
    try
        // Call inherited Accept
        Result := inherited Accept(Node);
    finally
        FNextIsTail := FIsTailStack.Pop;
    end;
end;

function TAstTCO.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
var
    isContextTail: Boolean;
    newExprs: TArray<IAstNode>;
    exprsList: IExpressionList;
    i: Integer;
    item, newItem: IAstNode;
    hasChanged: Boolean;
begin
    isContextTail := FIsTailStack.Peek;
    exprsList := Node.Expressions;

    SetLength(newExprs, exprsList.Count);
    hasChanged := False;

    var nTail := exprsList.Count - 1;

    for i := 0 to nTail do
    begin
        item := exprsList[i];

        // Only the last expression in the block inherits the tail position status
        FNextIsTail := isContextTail and (i = nTail);

        newItem := Accept(item);
        newExprs[i] := newItem;

        if item <> newItem then
            hasChanged := True;
    end;

    if not hasChanged then
        Result := Node
    else
    begin
        // Wrap array in List container
        var newList := TExpressionList.Create(newExprs, Node.Expressions.Identity);
        // CoW: Reuse Identity
        Result := TAst.Block(Node.Identity, newList, Node.StaticType);
    end;
end;

function TAstTCO.VisitIfExpression(const Node: IIfExpressionNode): IAstNode;
var
    isContextTail: Boolean;
    newCond, newThen, newElse: IAstNode;
begin
    isContextTail := FIsTailStack.Peek;

    // Condition is never in tail position
    FNextIsTail := False;
    newCond := Accept(Node.Condition);

    // Then/Else branches ARE in tail position if the IfExpr is
    FNextIsTail := isContextTail;
    newThen := Accept(Node.ThenBranch);
    newElse := Accept(Node.ElseBranch);

    if (newCond = Node.Condition) and (newThen = Node.ThenBranch) and (newElse = Node.ElseBranch) then
        Result := Node
    else
        // CoW: Reuse Identity
        Result := TAst.IfExpr(Node.Identity, newCond, newThen, newElse, Node.StaticType);
end;

function TAstTCO.VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode;
var
    isContextTail: Boolean;
    newCond, newThen, newElse: IAstNode;
begin
    isContextTail := FIsTailStack.Peek;

    // Condition is never in tail position
    FNextIsTail := False;
    newCond := Accept(Node.Condition);

    // Then/Else branches ARE in tail position if the TernaryExpr is
    FNextIsTail := isContextTail;
    newThen := Accept(Node.ThenBranch);
    newElse := Accept(Node.ElseBranch);

    if (newCond = Node.Condition) and (newThen = Node.ThenBranch) and (newElse = Node.ElseBranch) then
        Result := Node
    else
        // CoW: Reuse Identity
        Result := TAst.TernaryExpr(Node.Identity, newCond, newThen, newElse, Node.StaticType);
end;

function TAstTCO.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
var
    newParams: IParameterList;
    newBody: IAstNode;
begin
    // Parameters are not in tail position
    FNextIsTail := False;
    // Visit list node to handle potential transformations in children
    newParams := Accept(Node.Parameters).AsParameterList;

    // The body of a lambda is *always* a tail position (relative to the lambda execution)
    FNextIsTail := True;
    newBody := Accept(Node.Body);

    if (newParams = Node.Parameters) and (newBody = Node.Body) then
        Result := Node
    else
    begin
        // Rebuild using factory.
        // CoW: Reuse Identity. Factory expects IParameterList now.
        Result :=
            TAst.LambdaExpr(
                Node.Identity,
                newParams,
                newBody,
                Node.Layout,
                Node.Descriptor,
                Node.Upvalues,
                Node.HasNestedLambdas,
                Node.IsPure,
                Node.StaticType
            );
    end;
end;

function TAstTCO.VisitRecurNode(const Node: IRecurNode): IAstNode;
var
    newArgsList: IArgumentList;
begin
    if not FIsTailStack.Peek then
        raise EOptimizerException.Create('''recur'' can only be used in a tail position.');

    // Arguments are not in tail position
    FNextIsTail := False;
    // Visit the list node. Accept() ensures children are visited via TAstTransformer.VisitArgumentList
    newArgsList := Accept(Node.Arguments).AsArgumentList;

    if newArgsList = Node.Arguments then
        Result := Node
    else
        // CoW: Reuse Identity. Factory expects IArgumentList.
        Result := TAst.Recur(Node.Identity, newArgsList, Node.StaticType);
end;

function TAstTCO.VisitMacroExpansionNode(const Node: IMacroExpansionNode): IAstNode;
var
    newBody: IAstNode;
begin
    // Propagate tail call status to the expanded body
    FNextIsTail := FIsTailStack.Peek;
    newBody := Accept(Node.ExpandedBody);

    if newBody = Node.ExpandedBody then
        Result := Node
    else
        // CoW: Reuse Identity
        Result := TAst.MacroExpansionNode(Node.Identity, Node.CallNode, newBody);
end;

function TAstTCO.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
var
    isTailCall: Boolean;
    newCallee: IAstNode;
    newArgsList: IArgumentList;
begin
    isTailCall := FIsTailStack.Peek;

    // Callee/Arguments are not in tail position
    FNextIsTail := False;

    newCallee := Accept(Node.Callee);

    // Visit the arguments list
    newArgsList := Accept(Node.Arguments).AsArgumentList;

    // CoW check: Create a new node only if children changed OR IsTailCall needs update
    if (newCallee = Node.Callee) and (newArgsList = Node.Arguments) and (isTailCall = Node.IsTailCall) then
    begin
        Result := Node;
        exit;
    end;

    // Use factory to create new node, passing the *new* TCO status
    // CoW: Reuse Identity. Factory expects IArgumentList.
    Result :=
        TAst.FunctionCall(
            Node.Identity,
            newCallee,
            newArgsList,
            Node.StaticType,
            isTailCall,
            Node.StaticTarget, // Preserve the static target from Specializer
            Node.IsTargetPure // Preserve purity flag
        );
end;

end.