Generic Visitors
This commit is contained in:
Michael Schimmel
@@ -28,18 +28,23 @@ type
|
||||
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 VisitCondExpression(const Node: ICondExpressionNode): IAstNode; override; // Replaces Ternary
|
||||
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;
|
||||
strict private
|
||||
// Typed Handlers (IAstNode signature)
|
||||
function VisitBlockExpression(const Node: IAstNode): IAstNode;
|
||||
function VisitIfExpression(const Node: IAstNode): IAstNode;
|
||||
function VisitCondExpression(const Node: IAstNode): IAstNode;
|
||||
function VisitLambdaExpression(const Node: IAstNode): IAstNode;
|
||||
function VisitRecurNode(const Node: IAstNode): IAstNode;
|
||||
function VisitMacroExpansionNode(const Node: IAstNode): IAstNode;
|
||||
function VisitFunctionCall(const Node: IAstNode): IAstNode;
|
||||
|
||||
protected
|
||||
procedure SetupHandlers; override;
|
||||
|
||||
// Intercept dispatch to manage the TCO Stack state
|
||||
function Accept(const Node: IAstNode): IAstNode; override;
|
||||
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
@@ -65,6 +70,19 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TAstTCO.SetupHandlers;
|
||||
begin
|
||||
inherited SetupHandlers; // Defaults
|
||||
|
||||
Register(akBlockExpression, VisitBlockExpression);
|
||||
Register(akIfExpression, VisitIfExpression);
|
||||
Register(akCondExpression, VisitCondExpression);
|
||||
Register(akLambdaExpression, VisitLambdaExpression);
|
||||
Register(akRecur, VisitRecurNode);
|
||||
Register(akMacroExpansion, VisitMacroExpansionNode);
|
||||
Register(akFunctionCall, VisitFunctionCall);
|
||||
end;
|
||||
|
||||
class function TAstTCO.Optimize(const RootNode: IAstNode): IAstNode;
|
||||
begin
|
||||
var optimizer := TAstTCO.Create as IAstTCO;
|
||||
@@ -81,22 +99,22 @@ end;
|
||||
function TAstTCO.Accept(const Node: IAstNode): IAstNode;
|
||||
begin
|
||||
if (not Assigned(Node)) then
|
||||
begin
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
exit(nil);
|
||||
|
||||
// Push current context state before visiting children
|
||||
FIsTailStack.Push(FNextIsTail);
|
||||
try
|
||||
// Call inherited Accept
|
||||
// Dispatch to handler (which will call VisitXyz)
|
||||
Result := inherited Accept(Node);
|
||||
finally
|
||||
// Restore context state
|
||||
FNextIsTail := FIsTailStack.Pop;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
|
||||
function TAstTCO.VisitBlockExpression(const Node: IAstNode): IAstNode;
|
||||
var
|
||||
B: IBlockExpressionNode;
|
||||
isContextTail: Boolean;
|
||||
newExprs: TArray<IAstNode>;
|
||||
exprsList: IExpressionList;
|
||||
@@ -104,8 +122,9 @@ var
|
||||
item, newItem: IAstNode;
|
||||
hasChanged: Boolean;
|
||||
begin
|
||||
B := Node.AsBlockExpression;
|
||||
isContextTail := FIsTailStack.Peek;
|
||||
exprsList := Node.Expressions;
|
||||
exprsList := B.Expressions;
|
||||
|
||||
SetLength(newExprs, exprsList.Count);
|
||||
hasChanged := False;
|
||||
@@ -129,39 +148,36 @@ begin
|
||||
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;
|
||||
Result := TAst.Block(Node.Identity, TExpressionList.Create(newExprs, B.Expressions.Identity), B.StaticType);
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitIfExpression(const Node: IIfExpressionNode): IAstNode;
|
||||
function TAstTCO.VisitIfExpression(const Node: IAstNode): IAstNode;
|
||||
var
|
||||
I: IIfExpressionNode;
|
||||
isContextTail: Boolean;
|
||||
newCond, newThen, newElse: IAstNode;
|
||||
begin
|
||||
I := Node.AsIfExpression;
|
||||
isContextTail := FIsTailStack.Peek;
|
||||
|
||||
// Condition is never in tail position
|
||||
FNextIsTail := False;
|
||||
newCond := Accept(Node.Condition);
|
||||
newCond := Accept(I.Condition);
|
||||
|
||||
// Then/Else branches ARE in tail position if the IfExpr is
|
||||
FNextIsTail := isContextTail;
|
||||
newThen := Accept(Node.ThenBranch);
|
||||
newElse := Accept(Node.ElseBranch);
|
||||
newThen := Accept(I.ThenBranch);
|
||||
newElse := Accept(I.ElseBranch);
|
||||
|
||||
if (newCond = Node.Condition) and (newThen = Node.ThenBranch) and (newElse = Node.ElseBranch) then
|
||||
if (newCond = I.Condition) and (newThen = I.ThenBranch) and (newElse = I.ElseBranch) then
|
||||
Result := Node
|
||||
else
|
||||
// CoW: Reuse Identity
|
||||
Result := TAst.IfExpr(Node.Identity, newCond, newThen, newElse, Node.StaticType);
|
||||
Result := TAst.IfExpr(Node.Identity, newCond, newThen, newElse, I.StaticType);
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitCondExpression(const Node: ICondExpressionNode): IAstNode;
|
||||
function TAstTCO.VisitCondExpression(const Node: IAstNode): IAstNode;
|
||||
var
|
||||
C: ICondExpressionNode;
|
||||
isContextTail: Boolean;
|
||||
hasChanged: Boolean;
|
||||
i: Integer;
|
||||
@@ -169,143 +185,133 @@ var
|
||||
newElse: IAstNode;
|
||||
newCond, newBranch: IAstNode;
|
||||
begin
|
||||
C := Node.AsCondExpression;
|
||||
isContextTail := FIsTailStack.Peek;
|
||||
hasChanged := False;
|
||||
SetLength(newPairs, Length(Node.Pairs));
|
||||
SetLength(newPairs, Length(C.Pairs));
|
||||
|
||||
for i := 0 to High(Node.Pairs) do
|
||||
for i := 0 to High(C.Pairs) do
|
||||
begin
|
||||
// 1. Condition is never in tail position
|
||||
FNextIsTail := False;
|
||||
newCond := Accept(Node.Pairs[i].Condition);
|
||||
newCond := Accept(C.Pairs[i].Condition);
|
||||
|
||||
// 2. Branch IS in tail position (if CondExpr is)
|
||||
FNextIsTail := isContextTail;
|
||||
newBranch := Accept(Node.Pairs[i].Branch);
|
||||
newBranch := Accept(C.Pairs[i].Branch);
|
||||
|
||||
newPairs[i] := TCondPair.Create(newCond, newBranch);
|
||||
|
||||
if (newCond <> Node.Pairs[i].Condition) or (newBranch <> Node.Pairs[i].Branch) then
|
||||
if (newCond <> C.Pairs[i].Condition) or (newBranch <> C.Pairs[i].Branch) then
|
||||
hasChanged := True;
|
||||
end;
|
||||
|
||||
// 3. Else Branch IS in tail position
|
||||
FNextIsTail := isContextTail;
|
||||
newElse := Accept(Node.ElseBranch);
|
||||
newElse := Accept(C.ElseBranch);
|
||||
|
||||
if newElse <> Node.ElseBranch then
|
||||
if newElse <> C.ElseBranch then
|
||||
hasChanged := True;
|
||||
|
||||
if not hasChanged then
|
||||
Result := Node
|
||||
else
|
||||
Result := TAst.CondExpr(Node.Identity, newPairs, newElse, Node.StaticType);
|
||||
Result := TAst.CondExpr(Node.Identity, newPairs, newElse, C.StaticType);
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
|
||||
function TAstTCO.VisitLambdaExpression(const Node: IAstNode): IAstNode;
|
||||
var
|
||||
L: ILambdaExpressionNode;
|
||||
newParams: IParameterList;
|
||||
newBody: IAstNode;
|
||||
begin
|
||||
L := Node.AsLambdaExpression;
|
||||
// Parameters are not in tail position
|
||||
FNextIsTail := False;
|
||||
// Visit list node to handle potential transformations in children
|
||||
newParams := Accept(Node.Parameters).AsParameterList;
|
||||
newParams := Accept(L.Parameters).AsParameterList;
|
||||
|
||||
// The body of a lambda is *always* a tail position (relative to the lambda execution)
|
||||
FNextIsTail := True;
|
||||
newBody := Accept(Node.Body);
|
||||
newBody := Accept(L.Body);
|
||||
|
||||
if (newParams = Node.Parameters) and (newBody = Node.Body) then
|
||||
if (newParams = L.Parameters) and (newBody = L.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
|
||||
L.Layout,
|
||||
L.Descriptor,
|
||||
L.Upvalues,
|
||||
L.HasNestedLambdas,
|
||||
L.IsPure,
|
||||
L.StaticType
|
||||
);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitRecurNode(const Node: IRecurNode): IAstNode;
|
||||
function TAstTCO.VisitRecurNode(const Node: IAstNode): IAstNode;
|
||||
var
|
||||
R: IRecurNode;
|
||||
newArgsList: IArgumentList;
|
||||
begin
|
||||
R := Node.AsRecur;
|
||||
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;
|
||||
newArgsList := Accept(R.Arguments).AsArgumentList;
|
||||
|
||||
if newArgsList = Node.Arguments then
|
||||
if newArgsList = R.Arguments then
|
||||
Result := Node
|
||||
else
|
||||
// CoW: Reuse Identity. Factory expects IArgumentList.
|
||||
Result := TAst.Recur(Node.Identity, newArgsList, Node.StaticType);
|
||||
Result := TAst.Recur(Node.Identity, newArgsList, R.StaticType);
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitMacroExpansionNode(const Node: IMacroExpansionNode): IAstNode;
|
||||
function TAstTCO.VisitMacroExpansionNode(const Node: IAstNode): IAstNode;
|
||||
var
|
||||
M: IMacroExpansionNode;
|
||||
newBody: IAstNode;
|
||||
begin
|
||||
M := Node.AsMacroExpansion;
|
||||
// Propagate tail call status to the expanded body
|
||||
FNextIsTail := FIsTailStack.Peek;
|
||||
newBody := Accept(Node.ExpandedBody);
|
||||
newBody := Accept(M.ExpandedBody);
|
||||
|
||||
if newBody = Node.ExpandedBody then
|
||||
if newBody = M.ExpandedBody then
|
||||
Result := Node
|
||||
else
|
||||
// CoW: Reuse Identity
|
||||
Result := TAst.MacroExpansionNode(Node.Identity, Node.CallNode, newBody);
|
||||
Result := TAst.MacroExpansionNode(Node.Identity, M.CallNode, newBody);
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
|
||||
function TAstTCO.VisitFunctionCall(const Node: IAstNode): IAstNode;
|
||||
var
|
||||
C: IFunctionCallNode;
|
||||
isTailCall: Boolean;
|
||||
newCallee: IAstNode;
|
||||
newArgsList: IArgumentList;
|
||||
begin
|
||||
C := Node.AsFunctionCall;
|
||||
isTailCall := FIsTailStack.Peek;
|
||||
|
||||
// Callee/Arguments are not in tail position
|
||||
FNextIsTail := False;
|
||||
|
||||
newCallee := Accept(Node.Callee);
|
||||
newCallee := Accept(C.Callee);
|
||||
newArgsList := Accept(C.Arguments).AsArgumentList;
|
||||
|
||||
// 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
|
||||
if (newCallee = C.Callee) and (newArgsList = C.Arguments) and (isTailCall = C.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
|
||||
);
|
||||
// Use factory to create new node with TCO status
|
||||
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgsList, C.StaticType, isTailCall, C.StaticTarget, C.IsTargetPure);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user