Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Binder refactoring - extracted lowering

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-01 14:56:38 +01:00
parent 734b7b1d5e
commit 915deb4dc0
7 changed files with 319 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/ASTPlayground.delphilsp.json
+1 -1
View File
File diff suppressed because one or more lines are too long
ASTPlayground/ASTPlayground.dpr
+2 -1
View File
@@ -24,7 +24,8 @@ uses
Myc.Data.Keyword in '..\Src\Data\Myc.Data.Keyword.pas',
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.TypeChecker in '..\Src\AST\Myc.Ast.TypeChecker.pas',
Myc.Ast.Lowering in '..\Src\AST\Myc.Ast.Lowering.pas';
{$R *.res}
ASTPlayground/ASTPlayground.dproj
+1
View File
@@ -155,6 +155,7 @@
<DCCReference Include="..\Src\AST\Myc.Ast.Binding.Nodes.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.MacroExpander.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.TypeChecker.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Lowering.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
ASTPlayground/MainForm.pas
+15 -13
View File
@@ -38,13 +38,14 @@ uses
Myc.Ast.Debugger,
Myc.Fmx.AstEditor.Node,
Myc.Fmx.AstEditor.Workspace,
Myc.Ast.MacroExpander,
Myc.Ast.TypeChecker,
Myc.Ast.Lowering,
FMX.DialogService,
FMX.ListView.Types,
FMX.ListView.Appearances,
FMX.ListView.Adapters.Base,
FMX.ListView, // Added for platform-independent dialogs
Myc.Ast.MacroExpander,
Myc.Ast.TypeChecker;
FMX.ListView;
type
// A test record
@@ -121,7 +122,7 @@ type
FScriptUpdate: Boolean;
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
function CreateEvaluator(const Scope: IExecutionScope): IEvaluatorVisitor;
// Helper function to encapsulate the 3-stage compilation pipeline
// Helper function to encapsulate the compilation pipeline
function CompileAst(const ANode: IAstNode; const AParentScope: IExecutionScope; out ADescriptor: IScopeDescriptor): IAstNode;
// Helper function to encapsulate the Compile -> Evaluate pattern
function ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
@@ -213,18 +214,19 @@ end;
function TForm1.CompileAst(const ANode: IAstNode; const AParentScope: IExecutionScope; out ADescriptor: IScopeDescriptor): IAstNode;
var
macroDescriptor: IScopeDescriptor;
expandedAst, boundAst: IAstNode;
expandedAst, boundAst, typedAst: IAstNode;
begin
// Step 1: Expand macros (Phase 1)
expandedAst := TMacroExpander.ExpandMacros(AParentScope, ANode, macroDescriptor, CreateEvaluator);
// Step 2: Bind names and addresses (Phase 2)
// The binder uses the parent scope, but produces the final descriptor
boundAst := TAstBinder.Bind(AParentScope, expandedAst, ADescriptor);
// Step 3: Check and infer types (Phase 3)
// The type checker runs on the bound AST and the final descriptor
Result := TTypeChecker.CheckTypes(boundAst, ADescriptor);
typedAst := TTypeChecker.CheckTypes(boundAst, ADescriptor);
// Step 4: Lowering / Canonicalization (Phase 4)
Result := TAstLowerer.Lower(typedAst);
end;
function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
@@ -232,21 +234,21 @@ var
descriptor: IScopeDescriptor;
evalScope: IExecutionScope;
visitor: IEvaluatorVisitor;
typedAst: IAstNode;
compiledAst: IAstNode;
begin
FCurrUnboundAst := ANode;
// Call the new helper function for the 3-stage pipeline
typedAst := CompileAst(ANode, AParentScope, descriptor);
// Call the helper function for the full 4-stage pipeline
compiledAst := CompileAst(ANode, AParentScope, descriptor);
// Store the final bound AST for visualization and debugging.
FCurrAst := typedAst;
FCurrAst := compiledAst; // <-- Store the fully compiled AST
FCurrDesc := descriptor;
// Create the final scope and evaluator for runtime execution.
evalScope := descriptor.CreateScope(AParentScope);
visitor := CreateEvaluator(evalScope);
Result := visitor.Execute(typedAst);
Result := visitor.Execute(compiledAst);
end;
procedure TForm1.FormCreate(Sender: TObject);
Src/AST/Myc.Ast.Binding.pas
+8 -87
View File
@@ -31,8 +31,6 @@ type
FCurrentDescriptor: IScopeDescriptor;
FUpvalueStack: TStack<TUpvalueMapping>;
FNestedLambdaCount: Integer;
FIsTailStack: TStack<Boolean>;
FNextIsTail: Boolean;
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
procedure EnterScope;
@@ -41,7 +39,6 @@ type
function SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue; overload;
protected
function Accept(const Node: IAstNode): TDataValue; override;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitKeyword(const Node: IKeywordNode): TDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
@@ -65,7 +62,7 @@ type
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
public
constructor Create(const AInitialScope: IExecutionScope); // Signature changed
constructor Create(const AInitialScope: IExecutionScope);
destructor Destroy; override;
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
@@ -116,14 +113,11 @@ begin
FCurrentDescriptor := AInitialScope.CreateDescriptor;
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(True);
FNestedLambdaCount := 0;
FIsTailStack := TStack<Boolean>.Create;
FNextIsTail := True;
FBoxedDeclarations := nil;
end;
destructor TAstBinder.Destroy;
begin
FIsTailStack.Free;
FUpvalueStack.Free;
FBoxedDeclarations.Free;
inherited;
@@ -136,19 +130,6 @@ begin
Result := NodeData;
end;
function TAstBinder.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;
class function TAstBinder.Bind(const InitialScope: IExecutionScope; const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
var binder := TAstBinder.Create(InitialScope) as IAstBinder;
@@ -184,7 +165,6 @@ end;
function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
// Pre-pass: Find all variables that need boxing.
FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode, FCurrentDescriptor.Parent);
try
EnterScope;
@@ -195,28 +175,22 @@ begin
else
Result := transformedValue.AsIntf<IAstNode>;
// The binder no longer knows the root type.
// It sets Unknown, and the TypeChecker will find the true type.
(Result as TAstNode).StaticType := TTypes.Unknown;
Descriptor := FCurrentDescriptor;
finally
ExitScope;
end;
finally
// The binder owns the hash set, which will be freed in the destructor.
end;
end;
function TAstBinder.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
begin
// This node should have been consumed by the MacroExpander.
raise Exception.Create('TMyAstBinder: MacroDefinition node encountered.');
end;
function TAstBinder.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
begin
// This node is just a wrapper for debugging/tracing.
// We bind its contents (the expanded body).
Result := Accept(Node.ExpandedBody);
end;
@@ -235,24 +209,21 @@ begin
'Keyword :%s expects exactly one argument (the record/map), but got %d',
[keywordNode.Value.Name, Length(Node.Arguments)]);
FNextIsTail := False;
var baseNode := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
var memberAccessNode := TAst.MemberAccess(baseNode, keywordNode);
// Re-bind the synthetic node by calling Accept (which dispatches to VisitMemberAccess)
Result := Accept(memberAccessNode);
exit;
end;
// --- Default: Bind as a standard function call ---
var isTailCall := FIsTailStack.Peek;
FNextIsTail := False;
callee := Accept(Node.Callee).AsIntf<IAstNode>;
args := AcceptNodes<IAstNode>(Node.Arguments);
boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
// Create the node, always marking IsTailCall as false.
// The Lowerer (Phase 4) will set this flag correctly.
boundCall := TBoundFunctionCallNode.Create(Node, callee, args, False);
// Set type to Unknown. The TypeChecker will infer it.
Result := SetType(TDataValue.FromIntf<IFunctionCallNode>(boundCall), TTypes.Unknown);
end;
@@ -261,14 +232,9 @@ var
boundIdentifier, boundValue: IAstNode;
boundNode: IAssignmentNode;
begin
FNextIsTail := False;
// Bind children
boundIdentifier := Accept(Node.Identifier).AsIntf<IAstNode>;
boundValue := Accept(Node.Value).AsIntf<IAstNode>;
boundNode := TAst.Assign(boundIdentifier as TBoundIdentifierNode, boundValue);
// Set type to Unknown. The TypeChecker will infer it from the identifier.
Result := SetType(TDataValue.FromIntf<IAssignmentNode>(boundNode), TTypes.Unknown);
end;
@@ -277,10 +243,8 @@ var
left, right: IAstNode;
boundNode: IBinaryExpressionNode;
begin
FNextIsTail := False;
left := Accept(Node.Left).AsIntf<IAstNode>;
right := Accept(Node.Right).AsIntf<IAstNode>;
boundNode := TAst.BinaryExpr(left, Node.Operator, right);
Result := SetType(TDataValue.FromIntf<IBinaryExpressionNode>(boundNode), TTypes.Unknown);
end;
@@ -289,17 +253,14 @@ function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDat
var
exprs: TArray<IAstNode>;
i: Integer;
isContextTail: Boolean;
transformedValue: TDataValue;
exprList: TList<IAstNode>;
boundNode: IBlockExpressionNode;
begin
isContextTail := FIsTailStack.Peek;
exprList := TList<IAstNode>.Create;
try
for i := 0 to High(Node.Expressions) do
begin
FNextIsTail := isContextTail and (i = High(Node.Expressions));
transformedValue := Accept(Node.Expressions[i]);
if not transformedValue.IsVoid then
exprList.Add(transformedValue.AsIntf<IAstNode>);
@@ -309,7 +270,6 @@ begin
exprList.Free;
end;
// Check if the node was modified (e.g. by macro removal)
if (Length(exprs) = Length(Node.Expressions)) then
begin
var same := True;
@@ -320,20 +280,18 @@ begin
break;
end;
if same then
boundNode := Node // Use original node
boundNode := Node
else
boundNode := TAst.Block(exprs); // Create new node
boundNode := TAst.Block(exprs);
end
else
boundNode := TAst.Block(exprs); // Create new node
boundNode := TAst.Block(exprs);
// Type of the block is Unknown; TypeChecker will set it.
Result := SetType(TDataValue.FromIntf<IBlockExpressionNode>(boundNode), TTypes.Unknown);
end;
function TAstBinder.VisitConstant(const Node: IConstantNode): TDataValue;
begin
// Binder can set the literal type
case Node.Value.Kind of
TDataValueKind.vkScalar:
Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.FromScalarKind(Node.Value.AsScalar.Kind));
@@ -346,7 +304,6 @@ end;
function TAstBinder.VisitKeyword(const Node: IKeywordNode): TDataValue;
begin
// Binder can set the literal type
Result := SetType(TDataValue.FromIntf<IKeywordNode>(Node), TTypes.Keyword);
end;
@@ -354,12 +311,10 @@ function TAstBinder.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue
var
elemType: IStaticType;
begin
// Binder can set the literal type
try
elemType := TTypes.FromScalarKind(TScalar.StringToKind(Node.Definition));
except
on E: Exception do
// Error, but set to Unknown for now. TypeChecker can re-validate.
elemType := TTypes.Unknown;
end;
Result := SetType(TDataValue.FromIntf<ICreateSeriesNode>(Node), TTypes.CreateSeries(elemType));
@@ -388,14 +343,10 @@ end;
function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
var
isContextTail: Boolean;
condition, thenBranch, elseBranch: IAstNode;
boundNode: IIfExpressionNode;
begin
isContextTail := FIsTailStack.Peek;
FNextIsTail := False;
condition := Accept(Node.Condition).AsIntf<IAstNode>;
FNextIsTail := isContextTail; // Propagate tail position
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
if Assigned(Node.ElseBranch) then
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>
@@ -417,7 +368,6 @@ var
begin
baseNode := Accept(Node.Base).AsIntf<IAstNode>;
indexNode := Accept(Node.Index).AsIntf<IAstNode>;
boundNode := TAst.Indexer(baseNode, indexNode);
Result := SetType(TDataValue.FromIntf<IIndexerNode>(boundNode), TTypes.Unknown);
end;
@@ -428,7 +378,6 @@ var
boundNode: IMemberAccessNode;
begin
baseNode := Accept(Node.Base).AsIntf<IAstNode>;
boundNode := TAst.MemberAccess(baseNode, Node.Member);
Result := SetType(TDataValue.FromIntf<IMemberAccessNode>(boundNode), TTypes.Unknown);
end;
@@ -441,15 +390,12 @@ var
valType: IStaticType;
allScalar: Boolean;
begin
FNextIsTail := False;
SetLength(boundFields, Length(Node.Fields));
allScalar := True;
for i := 0 to High(Node.Fields) do
begin
valNode := Accept(Node.Fields[i].Value).AsIntf<IAstNode>;
// We peek at the *literal* type. If it's not a scalar literal,
// we *assume* it *could* be generic. The TypeChecker will verify.
valType := (valNode as TAstNode).StaticType;
if not (valType.Kind in [stOrdinal, stFloat, stKeyword, stUnknown]) then
@@ -458,8 +404,6 @@ begin
boundFields[i] := TRecordFieldLiteral.Create(Node.Fields[i].Key, valNode);
end;
// Create the appropriate bound node, but without the definition.
// The TypeChecker will populate the definition.
if allScalar then
begin
var boundNode := TBoundRecordLiteralNode.Create(boundFields, nil);
@@ -487,7 +431,6 @@ begin
try
EnterScope;
try
// Define placeholder for <self>
FCurrentDescriptor.Define('<self>', TTypes.Unknown);
SetLength(boundParams, Length(Node.Parameters));
@@ -501,7 +444,6 @@ begin
end;
lastNestedLambdaCount := FNestedLambdaCount;
FNextIsTail := True; // The body of a lambda is a tail position
boundBody := Accept(Node.Body).AsIntf<IAstNode>;
hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
lambdaScope := FCurrentDescriptor;
@@ -509,7 +451,6 @@ begin
ExitScope;
end;
// Upvalue mapping extraction remains the same
var upvalueMapping := FUpvalueStack.Peek;
var sortedPairs := upvalueMapping.ToArray;
TArray.Sort<TPair<TResolvedAddress, Integer>>(
@@ -527,31 +468,21 @@ begin
inc(FNestedLambdaCount);
boundLambda := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas);
// Set type to Unknown. The TypeChecker will infer it.
Result := SetType(TDataValue.FromIntf<ILambdaExpressionNode>(boundLambda), TTypes.Unknown);
end;
function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue;
begin
if not FIsTailStack.Peek then
raise Exception.Create('''recur'' can only be used in a tail position.');
FNextIsTail := False;
var boundNode := TAst.Recur(AcceptNodes<IAstNode>(Node.Arguments));
Result := SetType(TDataValue.FromIntf<IRecurNode>(boundNode), TTypes.Void);
end;
function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
var
isContextTail: Boolean;
condition, thenBranch, elseBranch: IAstNode;
boundNode: ITernaryExpressionNode;
begin
isContextTail := FIsTailStack.Peek;
FNextIsTail := False;
condition := Accept(Node.Condition).AsIntf<IAstNode>;
FNextIsTail := isContextTail; // Propagate tail position
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
@@ -568,9 +499,7 @@ var
right: IAstNode;
boundNode: IUnaryExpressionNode;
begin
FNextIsTail := False;
right := Accept(Node.Right).AsIntf<IAstNode>;
boundNode := TAst.UnaryExpr(Node.Operator, right);
Result := SetType(TDataValue.FromIntf<IUnaryExpressionNode>(boundNode), TTypes.Unknown);
end;
@@ -590,7 +519,7 @@ begin
begin
// Handle Upvalue
var upvalue := FUpvalueStack.Peek;
dec(adr.ScopeDepth); // Adjust address to be relative to the lambda's parent
dec(adr.ScopeDepth);
var upvalueIndex: Integer;
if not upvalue.TryGetValue(adr, upvalueIndex) then
begin
@@ -603,8 +532,6 @@ begin
// Handle LocalOrParent
boundNode := TBoundIdentifierNode.Create(Node, adr);
// Set the type *known at this stage*. The TypeChecker will update it
// for definitions (e.g. in VarDecl).
Result := SetType(TDataValue.FromIntf<IIdentifierNode>(boundNode), symbol.StaticType);
end
else
@@ -623,15 +550,10 @@ begin
if not IsValidIdentifier(Node.Identifier.Name) then
raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]);
FNextIsTail := False;
initializer := nil;
if Node.Initializer <> nil then
begin
initializer := Accept(Node.Initializer).AsIntf<IAstNode>;
end;
// Define the variable with TTypes.Unknown.
// The TypeChecker will update this in its pass.
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name, TTypes.Unknown);
address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
boundIdentifier := TBoundIdentifierNode.Create(Node.Identifier, address);
@@ -640,7 +562,6 @@ begin
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
boundDecl := TBoundVariableDeclarationNode.Create(boundIdentifier, initializer, isBoxed);
// The declaration itself has the type of its initializer (which is currently Unknown)
Result := SetType(TDataValue.FromIntf<IVariableDeclarationNode>(boundDecl), TTypes.Unknown);
end;
Src/AST/Myc.Ast.Lowering.pas
+291
View File
@@ -0,0 +1,291 @@
unit Myc.Ast.Lowering;
interface
uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Visitor,
Myc.Ast.Scope,
Myc.Ast.Types,
Myc.Ast,
Myc.Ast.Binding.Nodes;
type
IAstLowerer = interface(IAstVisitor)
function Execute(const RootNode: IAstNode): IAstNode;
end;
// This transformer runs *last* (after TypeChecker).
// 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;
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;
function Execute(const RootNode: IAstNode): IAstNode;
class function Lower(const RootNode: IAstNode): IAstNode; static;
end;
implementation
uses
System.Generics.Defaults,
Myc.Data.Keyword;
{ TAstLowerer }
constructor TAstLowerer.Create;
var
op: TScalar.TBinaryOp;
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
FBinaryOperators.Add(op.ToString, op);
FUnaryOperators := TDictionary<string, TScalar.TUnaryOp>.Create;
FUnaryOperators.Add('not', TScalar.TUnaryOp.Not);
end;
destructor TAstLowerer.Destroy;
begin
FIsTailStack.Free;
FUnaryOperators.Free;
FBinaryOperators.Free;
inherited;
end;
class function TAstLowerer.Lower(const RootNode: IAstNode): IAstNode;
begin
var lowerer := TAstLowerer.Create as IAstLowerer;
Result := lowerer.Execute(RootNode);
end;
function TAstLowerer.Execute(const RootNode: IAstNode): IAstNode;
begin
var transformedValue := Accept(RootNode);
if transformedValue.IsVoid then
Result := TAst.Block([])
else
Result := transformedValue.AsIntf<IAstNode>;
(Result as TAstNode).StaticType := (Result as TAstNode).StaticType;
end;
function TAstLowerer.SetType(const Node: IAstNode; const AType: IStaticType): IAstNode;
begin
(Node as TAstNode).StaticType := AType;
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 ---
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;
// --- Optimization: Operator Folding ---
if (Node.Callee is TIdentifierNode) then
begin
calleeIdentifier := Node.Callee as TIdentifierNode;
if (Length(Node.Arguments) = 2) then
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);
Result := TDataValue.FromIntf<IAstNode>(SetType(binExpr, (Node as TAstNode).StaticType));
exit;
end;
end;
if (Length(Node.Arguments) = 1) then
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));
exit;
end;
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));
exit;
end;
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
end;
end.
Src/AST/Myc.Ast.TypeChecker.pas
+1 -1
View File
@@ -27,7 +27,7 @@ type
TTypeChecker = class(TAstTransformer, IAstTypeChecker)
private
FCurrentDescriptor: IScopeDescriptor;
function SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue; overload;
function SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue;
protected
// Override all visit methods to perform type checking
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;