Binder refactoring - extracted TCO - WIP

This commit is contained in:
Michael Schimmel
2025-11-01 15:44:56 +01:00
parent 915deb4dc0
commit 8f29212cba
6 changed files with 228 additions and 151 deletions
File diff suppressed because one or more lines are too long
+2 -1
View File
@@ -25,7 +25,8 @@ uses
Myc.Ast.Binding.Nodes in '..\Src\AST\Myc.Ast.Binding.Nodes.pas',
Myc.Ast.MacroExpander in '..\Src\AST\Myc.Ast.MacroExpander.pas',
Myc.Ast.TypeChecker in '..\Src\AST\Myc.Ast.TypeChecker.pas',
Myc.Ast.Lowering in '..\Src\AST\Myc.Ast.Lowering.pas';
Myc.Ast.Lowering in '..\Src\AST\Myc.Ast.Lowering.pas',
Myc.Ast.Compiler.TCO in '..\Src\AST\Myc.Ast.Compiler.TCO.pas';
{$R *.res}
+1
View File
@@ -156,6 +156,7 @@
<DCCReference Include="..\Src\AST\Myc.Ast.MacroExpander.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.TypeChecker.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Lowering.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Compiler.TCO.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
+6 -2
View File
@@ -41,6 +41,7 @@ uses
Myc.Ast.MacroExpander,
Myc.Ast.TypeChecker,
Myc.Ast.Lowering,
Myc.Ast.Compiler.TCO,
FMX.DialogService,
FMX.ListView.Types,
FMX.ListView.Appearances,
@@ -214,7 +215,7 @@ end;
function TForm1.CompileAst(const ANode: IAstNode; const AParentScope: IExecutionScope; out ADescriptor: IScopeDescriptor): IAstNode;
var
macroDescriptor: IScopeDescriptor;
expandedAst, boundAst, typedAst: IAstNode;
expandedAst, boundAst, typedAst, loweredAst: IAstNode;
begin
// Step 1: Expand macros (Phase 1)
expandedAst := TMacroExpander.ExpandMacros(AParentScope, ANode, macroDescriptor, CreateEvaluator);
@@ -226,7 +227,10 @@ begin
typedAst := TTypeChecker.CheckTypes(boundAst, ADescriptor);
// Step 4: Lowering / Canonicalization (Phase 4)
Result := TAstLowerer.Lower(typedAst);
loweredAst := TAstLowerer.Lower(typedAst);
// Step 5: Tail Call Optimization (Phase 5)
Result := TAstTCO.Optimize(loweredAst);
end;
function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
+209
View File
@@ -0,0 +1,209 @@
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,
Myc.Ast.Binding.Nodes;
type
IAstTCO = interface(IAstVisitor)
function Execute(const RootNode: IAstNode): IAstNode;
end;
// This transformer runs *after* the Lowerer (Phase 4).
// Its sole responsibility is to identify tail calls (TCO)
// and set the `IsTailCall` flag on TBoundFunctionCallNode.
TAstTCO = class(TAstTransformer, IAstTCO)
private
FIsTailStack: TStack<Boolean>;
FNextIsTail: Boolean;
protected
function Accept(const Node: IAstNode): TDataValue; override;
// Overrides for TCO propagation
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override;
// The core TCO logic
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; 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
var transformedValue := Accept(RootNode);
if transformedValue.IsVoid then
Result := TAst.Block([])
else
Result := transformedValue.AsIntf<IAstNode>;
end;
function TAstTCO.Accept(const Node: IAstNode): TDataValue;
begin
if (not Assigned(Node)) or Done then
exit;
FIsTailStack.Push(FNextIsTail);
try
Result := inherited Accept(Node);
finally
FNextIsTail := FIsTailStack.Pop;
end;
end;
function TAstTCO.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
i: Integer;
isContextTail: Boolean;
begin
isContextTail := FIsTailStack.Peek;
for i := 0 to High(Node.Expressions) do
begin
// Only the last expression in a block is in tail position
FNextIsTail := isContextTail and (i = High(Node.Expressions));
Accept(Node.Expressions[i]);
end;
Result := TDataValue.FromIntf<IBlockExpressionNode>(Node);
end;
function TAstTCO.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
var
isContextTail: Boolean;
begin
isContextTail := FIsTailStack.Peek;
// Condition is never in tail position
FNextIsTail := False;
Accept(Node.Condition);
// Then/Else branches ARE in tail position if the IfExpr is
FNextIsTail := isContextTail;
Accept(Node.ThenBranch);
if Assigned(Node.ElseBranch) then
Accept(Node.ElseBranch);
Result := TDataValue.FromIntf<IIfExpressionNode>(Node);
end;
function TAstTCO.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
var
isContextTail: Boolean;
begin
isContextTail := FIsTailStack.Peek;
// Condition is never in tail position
FNextIsTail := False;
Accept(Node.Condition);
// Then/Else branches ARE in tail position if the TernaryExpr is
FNextIsTail := isContextTail;
Accept(Node.ThenBranch);
Accept(Node.ElseBranch);
Result := TDataValue.FromIntf<ITernaryExpressionNode>(Node);
end;
function TAstTCO.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
begin
// Parameters are never in tail position
FNextIsTail := False;
AcceptNodes<IIdentifierNode>(Node.Parameters);
// The body of a lambda is *always* a tail position (relative to the lambda)
FNextIsTail := True;
Accept(Node.Body);
Result := TDataValue.FromIntf<ILambdaExpressionNode>(Node);
end;
function TAstTCO.VisitRecurNode(const Node: IRecurNode): TDataValue;
begin
if not FIsTailStack.Peek then
raise Exception.Create('''recur'' can only be used in a tail position.');
// Arguments are not in tail position
FNextIsTail := False;
AcceptNodes<IAstNode>(Node.Arguments);
Result := TDataValue.FromIntf<IRecurNode>(Node);
end;
function TAstTCO.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
begin
// Propagate tail call status to the expanded body
FNextIsTail := FIsTailStack.Peek;
Accept(Node.ExpandedBody);
// Also visit the original call nodes, though they are not in tail pos
FNextIsTail := False;
Accept(Node.Callee);
AcceptNodes<IAstNode>(Node.Arguments);
Result := TDataValue.FromIntf<IMacroExpansionNode>(Node);
end;
function TAstTCO.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
callee: IAstNode;
args: TArray<IAstNode>;
isTailCall: Boolean;
begin
isTailCall := FIsTailStack.Peek;
// Arguments are not in tail position
FNextIsTail := False;
callee := Accept(Node.Callee).AsIntf<IAstNode>;
args := AcceptNodes<IAstNode>(Node.Arguments);
// If TCO status changed, we MUST rebuild the node.
var boundNode := (Node as TBoundFunctionCallNode);
if (boundNode.IsTailCall <> isTailCall) or (callee <> Node.Callee) or (args <> Node.Arguments) then
begin
var newBoundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
(newBoundCall as TAstNode).StaticType := (Node as TAstNode).StaticType;
Result := TDataValue.FromIntf<IFunctionCallNode>(newBoundCall);
end
else
Result := TDataValue.FromIntf<IFunctionCallNode>(Node); // No change
end;
end.
+9 -147
View File
@@ -20,27 +20,17 @@ type
function Execute(const RootNode: IAstNode): IAstNode;
end;
// This transformer runs *last* (after TypeChecker).
// This transformer runs *after* TypeChecker (Phase 3).
// It "lowers" the AST by rewriting complex nodes into simpler ones
// that the evaluator can understand (e.g., operator folding).
// It also performs Tail Call Optimization (TCO) identification.
TAstLowerer = class(TAstTransformer, IAstLowerer)
private
FBinaryOperators: TDictionary<string, TScalar.TBinaryOp>;
FUnaryOperators: TDictionary<string, TScalar.TUnaryOp>;
FIsTailStack: TStack<Boolean>;
FNextIsTail: Boolean;
function SetType(const Node: IAstNode; const AType: IStaticType): IAstNode;
protected
function Accept(const Node: IAstNode): TDataValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
// Override to find nodes to lower
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override;
public
constructor Create;
destructor Destroy; override;
@@ -63,10 +53,6 @@ var
begin
inherited Create;
// TCO state
FIsTailStack := TStack<Boolean>.Create;
FNextIsTail := True; // The root expression is in tail position
// Operator folding maps
FBinaryOperators := TDictionary<string, TScalar.TBinaryOp>.Create;
for op := Low(TScalar.TBinaryOp) to High(TScalar.TBinaryOp) do
@@ -74,11 +60,11 @@ begin
FUnaryOperators := TDictionary<string, TScalar.TUnaryOp>.Create;
FUnaryOperators.Add('not', TScalar.TUnaryOp.Not);
// Note: '-' is handled as a special case in VisitFunctionCall
end;
destructor TAstLowerer.Destroy;
begin
FIsTailStack.Free;
FUnaryOperators.Free;
FBinaryOperators.Free;
inherited;
@@ -97,7 +83,9 @@ begin
Result := TAst.Block([])
else
Result := transformedValue.AsIntf<IAstNode>;
(Result as TAstNode).StaticType := (Result as TAstNode).StaticType;
if Assigned(Result) then
(Result as TAstNode).StaticType := (Result as TAstNode).StaticType;
end;
function TAstLowerer.SetType(const Node: IAstNode; const AType: IStaticType): IAstNode;
@@ -106,126 +94,18 @@ begin
Result := Node;
end;
function TAstLowerer.Accept(const Node: IAstNode): TDataValue;
begin
// Added for TCO
if (not Assigned(Node)) or Done then
exit;
FIsTailStack.Push(FNextIsTail);
try
Result := inherited Accept(Node);
finally
FNextIsTail := FIsTailStack.Pop;
end;
end;
function TAstLowerer.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
begin
// This node is just a wrapper. We must propagate the TCO context
// to the expanded body.
// We don't need to rebuild the node, as the evaluator just executes the body.
Accept(Node.Callee);
AcceptNodes<IAstNode>(Node.Arguments);
// Propagate tail call status to the expanded body
FNextIsTail := FIsTailStack.Peek;
Result := Accept(Node.ExpandedBody);
end;
function TAstLowerer.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
i: Integer;
isContextTail: Boolean;
begin
isContextTail := FIsTailStack.Peek;
for i := 0 to High(Node.Expressions) do
begin
// Only the last expression in a block is in tail position
FNextIsTail := isContextTail and (i = High(Node.Expressions));
Accept(Node.Expressions[i]);
end;
Result := TDataValue.FromIntf<IBlockExpressionNode>(Node);
end;
function TAstLowerer.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
var
isContextTail: Boolean;
begin
isContextTail := FIsTailStack.Peek;
// Condition is never in tail position
FNextIsTail := False;
Accept(Node.Condition);
// Then/Else branches ARE in tail position if the IfExpr is
FNextIsTail := isContextTail;
Accept(Node.ThenBranch);
if Assigned(Node.ElseBranch) then
Accept(Node.ElseBranch);
Result := TDataValue.FromIntf<IIfExpressionNode>(Node);
end;
function TAstLowerer.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
var
isContextTail: Boolean;
begin
isContextTail := FIsTailStack.Peek;
// Condition is never in tail position
FNextIsTail := False;
Accept(Node.Condition);
// Then/Else branches ARE in tail position if the TernaryExpr is
FNextIsTail := isContextTail;
Accept(Node.ThenBranch);
Accept(Node.ElseBranch);
Result := TDataValue.FromIntf<ITernaryExpressionNode>(Node);
end;
function TAstLowerer.VisitRecurNode(const Node: IRecurNode): TDataValue;
begin
if not FIsTailStack.Peek then
raise Exception.Create('''recur'' can only be used in a tail position.');
// Arguments are not in tail position
FNextIsTail := False;
AcceptNodes<IAstNode>(Node.Arguments);
Result := TDataValue.FromIntf<IRecurNode>(Node);
end;
function TAstLowerer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
begin
// Parameters are never in tail position
FNextIsTail := False;
AcceptNodes<IIdentifierNode>(Node.Parameters);
// The body of a lambda is *always* a tail position (relative to the lambda)
FNextIsTail := True;
Accept(Node.Body);
// We don't modify the node, just traverse for TCO
Result := TDataValue.FromIntf<ILambdaExpressionNode>(Node);
end;
function TAstLowerer.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
calleeIdentifier: TIdentifierNode;
binaryOp: TScalar.TBinaryOp;
unaryOp: TScalar.TUnaryOp;
left, right: IAstNode;
callee: IAstNode;
args: TArray<IAstNode>;
isTailCall: Boolean;
begin
// --- Transformation: Keyword-as-Function ---
// (This logic is correctly handled in TAstBinder)
if (Node.Callee is TKeywordNode) then
begin
// This node should have been transformed by the TAstBinder.
// If we see it here, it's an error, but we just traverse it.
exit(inherited VisitFunctionCall(Node));
end;
@@ -238,7 +118,6 @@ begin
begin
if FBinaryOperators.TryGetValue(calleeIdentifier.Name, binaryOp) then
begin
FNextIsTail := False; // Ops are not tail calls
left := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
right := Accept(Node.Arguments[1]).AsIntf<IAstNode>;
var binExpr := TAst.BinaryExpr(left, binaryOp, right);
@@ -251,7 +130,6 @@ begin
begin
if FUnaryOperators.TryGetValue(calleeIdentifier.Name, unaryOp) then
begin
FNextIsTail := False; // Ops are not tail calls
right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
var unExpr := TAst.UnaryExpr(unaryOp, right);
Result := TDataValue.FromIntf<IAstNode>(SetType(unExpr, (Node as TAstNode).StaticType));
@@ -260,7 +138,6 @@ begin
if (calleeIdentifier.Name = '-') then
begin
FNextIsTail := False; // Ops are not tail calls
right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
var unExpr := TAst.UnaryExpr(TScalar.TUnaryOp.Negate, right);
Result := TDataValue.FromIntf<IAstNode>(SetType(unExpr, (Node as TAstNode).StaticType));
@@ -269,23 +146,8 @@ begin
end;
end;
// --- Standard Function Call (TCO Check) ---
isTailCall := FIsTailStack.Peek;
// Arguments are not in tail position
FNextIsTail := False;
callee := Accept(Node.Callee).AsIntf<IAstNode>;
args := AcceptNodes<IAstNode>(Node.Arguments);
// If TCO status changed, we MUST rebuild the node.
var boundNode := (Node as TBoundFunctionCallNode);
if (boundNode.IsTailCall <> isTailCall) or (callee <> Node.Callee) or (args <> Node.Arguments) then
begin
var newBoundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
Result := TDataValue.FromIntf<IAstNode>(SetType(newBoundCall, (Node as TAstNode).StaticType));
end
else
Result := TDataValue.FromIntf<IAstNode>(Node); // No change
// If no rewrite matched, continue traversal
Result := inherited VisitFunctionCall(Node);
end;
end.