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

Generic Visitors

Browse Source
This commit is contained in:
Michael Schimmel
2026-01-03 19:14:18 +01:00
parent db74b83e11
commit 22674b962b
27 changed files with 3573 additions and 3547 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
@@ -42,7 +42,8 @@ uses
Myc.Data.Stream.Pipes in '..\Src\Data\Myc.Data.Stream.Pipes.pas',
Myc.Data.Stream in '..\Src\Data\Myc.Data.Stream.pas',
Myc.Fmx.AstEditor.Handlers.Pipes in '..\Src\AST\Myc.Fmx.AstEditor.Handlers.Pipes.pas',
Demo.Finance in '..\Test\Demo.Finance.pas';
Demo.Finance in '..\Test\Demo.Finance.pas',
Myc.Ast.Script.Print in '..\Src\AST\Myc.Ast.Script.Print.pas';
{$R *.res}
ASTPlayground/ASTPlayground.dproj
+1
View File
@@ -173,6 +173,7 @@
<DCCReference Include="..\Src\Data\Myc.Data.Stream.pas"/>
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Handlers.Pipes.pas"/>
<DCCReference Include="..\Test\Demo.Finance.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Script.Print.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
Src/AST/Myc.Ast.Analysis.Purity.pas
+185 -98
View File
@@ -7,58 +7,65 @@ uses
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Visitor,
Myc.Ast.Scope;
Myc.Ast.Scope,
Myc.Ast;
type
/// <summary>
/// Analyzes an AST to determine if it is referentially transparent and free of side effects.
/// </summary>
// Analyzes an AST to determine if it is referentially transparent and free of side effects.
TPurityAnalyzer = class(TAstVisitor<Boolean>)
protected
// Default behavior: Visit children. If all children return True, then True.
// However, we must explicitly define what is allowed.
function Accept(const Node: IAstNode): Boolean; override;
strict private
// --- Safe Leaves / Constructs ---
function VisitConstant(const Node: IConstantNode): Boolean; override;
function VisitKeyword(const Node: IKeywordNode): Boolean; override;
function VisitIfExpression(const Node: IIfExpressionNode): Boolean; override;
function VisitCondExpression(const Node: ICondExpressionNode): Boolean; override; // Replaces Ternary
function VisitBlockExpression(const Node: IBlockExpressionNode): Boolean; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): Boolean; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): Boolean; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): Boolean; override;
function VisitConstant(const Node: IAstNode): Boolean;
function VisitKeyword(const Node: IAstNode): Boolean;
function VisitIfExpression(const Node: IAstNode): Boolean;
function VisitCondExpression(const Node: IAstNode): Boolean;
function VisitBlockExpression(const Node: IAstNode): Boolean;
function VisitRecordLiteral(const Node: IAstNode): Boolean;
function VisitVariableDeclaration(const Node: IAstNode): Boolean;
function VisitSeriesLength(const Node: IAstNode): Boolean;
// --- List Visitors (New) ---
function VisitParameterList(const Node: IParameterList): Boolean; override;
function VisitArgumentList(const Node: IArgumentList): Boolean; override;
function VisitExpressionList(const Node: IExpressionList): Boolean; override;
function VisitRecordFieldList(const Node: IRecordFieldList): Boolean; override;
function VisitRecordField(const Node: IRecordFieldNode): Boolean; override;
// --- List Visitors (Aggregation Logic: All must be pure) ---
function VisitParameterList(const Node: IAstNode): Boolean;
function VisitArgumentList(const Node: IAstNode): Boolean;
function VisitExpressionList(const Node: IAstNode): Boolean;
function VisitRecordFieldList(const Node: IAstNode): Boolean;
function VisitRecordField(const Node: IAstNode): Boolean;
// --- Critical Checks ---
function VisitIdentifier(const Node: IIdentifierNode): Boolean; override;
function VisitFunctionCall(const Node: IFunctionCallNode): Boolean; override;
function VisitRecurNode(const Node: IRecurNode): Boolean; override;
function VisitIdentifier(const Node: IAstNode): Boolean;
function VisitFunctionCall(const Node: IAstNode): Boolean;
function VisitRecurNode(const Node: IAstNode): Boolean;
// --- Forbidden Constructs (Side Effects / Unsafe) ---
function VisitAssignment(const Node: IAssignmentNode): Boolean; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): Boolean; override;
function VisitAssignment(const Node: IAstNode): Boolean;
function VisitAddSeriesItem(const Node: IAstNode): Boolean;
// Allocation is considered pure in this context (it creates a new value, doesn't mutate existing world)
function VisitCreateSeries(const Node: ICreateSeriesNode): Boolean; override;
// Allocation is considered pure in this context
function VisitCreateSeries(const Node: IAstNode): Boolean;
function VisitIndexer(const Node: IIndexerNode): Boolean; override;
function VisitMemberAccess(const Node: IMemberAccessNode): Boolean; override;
function VisitIndexer(const Node: IAstNode): Boolean;
function VisitMemberAccess(const Node: IAstNode): Boolean;
// Ignored / Irrelevant for Runtime Purity (Compile-time constructs or Definitions)
function VisitLambdaExpression(const Node: ILambdaExpressionNode): Boolean; override;
function VisitMacroDefinition(const Node: IMacroDefinitionNode): Boolean; override;
function VisitQuasiquote(const Node: IQuasiquoteNode): Boolean; override;
function VisitUnquote(const Node: IUnquoteNode): Boolean; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): Boolean; override;
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): Boolean; override;
function VisitNop(const Node: INopNode): Boolean; override;
// Ignored / Irrelevant for Runtime Purity
function VisitLambdaExpression(const Node: IAstNode): Boolean;
function VisitMacroDefinition(const Node: IAstNode): Boolean;
function VisitQuasiquote(const Node: IAstNode): Boolean;
function VisitUnquote(const Node: IAstNode): Boolean;
function VisitUnquoteSplicing(const Node: IAstNode): Boolean;
function VisitMacroExpansionNode(const Node: IAstNode): Boolean;
function VisitNop(const Node: IAstNode): Boolean;
// Pipe Support (Structural Check)
function VisitPipeInput(const Node: IAstNode): Boolean;
function VisitPipeSelectorList(const Node: IAstNode): Boolean;
function VisitPipeInputList(const Node: IAstNode): Boolean;
function VisitPipe(const Node: IAstNode): Boolean;
// Helper to check if a node is pure (handling nil gracefully)
function IsNodePure(const Node: IAstNode): Boolean;
protected
procedure SetupHandlers; override;
public
class function IsPure(const RootNode: IAstNode): Boolean;
@@ -72,80 +79,125 @@ class function TPurityAnalyzer.IsPure(const RootNode: IAstNode): Boolean;
begin
var analyzer := TPurityAnalyzer.Create;
try
Result := analyzer.Accept(RootNode);
// Use the visitor's central dispatch method
Result := analyzer.Visit(RootNode);
finally
analyzer.Free;
end;
end;
function TPurityAnalyzer.Accept(const Node: IAstNode): Boolean;
function TPurityAnalyzer.IsNodePure(const Node: IAstNode): Boolean;
begin
// If a node is nil (e.g. optional else-branch), it's "nothing", which is pure.
if not Assigned(Node) then
exit(True);
// Dispatch to specific Visit method via generic base
Result := Node.Accept(Self).AsGeneric<Boolean>;
// Dispatch to registry
Result := Visit(Node);
end;
procedure TPurityAnalyzer.SetupHandlers;
begin
// Core
Register(akConstant, VisitConstant);
Register(akIdentifier, VisitIdentifier);
Register(akKeyword, VisitKeyword);
// Lists
Register(akParameterList, VisitParameterList);
Register(akArgumentList, VisitArgumentList);
Register(akExpressionList, VisitExpressionList);
Register(akRecordFieldList, VisitRecordFieldList);
Register(akRecordField, VisitRecordField);
// Structural
Register(akIfExpression, VisitIfExpression);
Register(akCondExpression, VisitCondExpression);
Register(akLambdaExpression, VisitLambdaExpression);
Register(akFunctionCall, VisitFunctionCall);
Register(akMacroExpansion, VisitMacroExpansionNode);
Register(akBlockExpression, VisitBlockExpression);
Register(akVariableDeclaration, VisitVariableDeclaration);
Register(akAssignment, VisitAssignment);
Register(akMacroDefinition, VisitMacroDefinition);
Register(akQuasiquote, VisitQuasiquote);
Register(akUnquote, VisitUnquote);
Register(akUnquoteSplicing, VisitUnquoteSplicing);
Register(akIndexer, VisitIndexer);
Register(akMemberAccess, VisitMemberAccess);
Register(akRecordLiteral, VisitRecordLiteral);
Register(akCreateSeries, VisitCreateSeries);
Register(akAddSeriesItem, VisitAddSeriesItem);
Register(akSeriesLength, VisitSeriesLength);
Register(akRecur, VisitRecurNode);
Register(akNop, VisitNop);
// Pipes
Register(akPipeInput, VisitPipeInput);
Register(akPipeSelectorList, VisitPipeSelectorList);
Register(akPipeInputList, VisitPipeInputList);
Register(akPipe, VisitPipe);
end;
// --- List Visitors ---
function TPurityAnalyzer.VisitParameterList(const Node: IParameterList): Boolean;
function TPurityAnalyzer.VisitParameterList(const Node: IAstNode): Boolean;
begin
// Declarations are pure
Result := True;
end;
function TPurityAnalyzer.VisitArgumentList(const Node: IArgumentList): Boolean;
function TPurityAnalyzer.VisitArgumentList(const Node: IAstNode): Boolean;
begin
for var item in Node do
if not Accept(item) then
for var item in Node.AsArgumentList do
if not IsNodePure(item) then
exit(False);
Result := True;
end;
function TPurityAnalyzer.VisitExpressionList(const Node: IExpressionList): Boolean;
function TPurityAnalyzer.VisitExpressionList(const Node: IAstNode): Boolean;
begin
for var item in Node do
if not Accept(item) then
for var item in Node.AsExpressionList do
if not IsNodePure(item) then
exit(False);
Result := True;
end;
function TPurityAnalyzer.VisitRecordFieldList(const Node: IRecordFieldList): Boolean;
function TPurityAnalyzer.VisitRecordFieldList(const Node: IAstNode): Boolean;
begin
for var item in Node do
if not Accept(item) then
for var item in Node.AsRecordFieldList do
if not IsNodePure(item) then
exit(False);
Result := True;
end;
function TPurityAnalyzer.VisitRecordField(const Node: IRecordFieldNode): Boolean;
function TPurityAnalyzer.VisitRecordField(const Node: IAstNode): Boolean;
begin
// Key is usually pure (Keyword), check Value
Result := Accept(Node.Key) and Accept(Node.Value);
var F := Node.AsRecordField;
Result := IsNodePure(F.Key) and IsNodePure(F.Value);
end;
// --- Safe Leaves ---
function TPurityAnalyzer.VisitConstant(const Node: IConstantNode): Boolean;
function TPurityAnalyzer.VisitConstant(const Node: IAstNode): Boolean;
begin
Result := True;
end;
function TPurityAnalyzer.VisitKeyword(const Node: IKeywordNode): Boolean;
function TPurityAnalyzer.VisitKeyword(const Node: IAstNode): Boolean;
begin
Result := True;
end;
function TPurityAnalyzer.VisitNop(const Node: INopNode): Boolean;
function TPurityAnalyzer.VisitNop(const Node: IAstNode): Boolean;
begin
Result := True;
end;
// --- Identifier: Only local variables are safe ---
function TPurityAnalyzer.VisitIdentifier(const Node: IIdentifierNode): Boolean;
function TPurityAnalyzer.VisitIdentifier(const Node: IAstNode): Boolean;
begin
// We only allow access to local variables (ScopeDepth = 0).
// Accessing Parent/Upvalues (ScopeDepth > 0) makes the function state-dependent (closure state),
@@ -153,82 +205,84 @@ begin
// unless we could prove the upvalue is constant (which we don't track yet).
// Note: Parameters are also ScopeDepth=0 in the Binder logic.
Result := (Node.Address.Kind = akLocalOrParent) and (Node.Address.ScopeDepth = 0);
var I := Node.AsIdentifier;
Result := (I.Address.Kind = akLocalOrParent) and (I.Address.ScopeDepth = 0);
end;
// --- Function Call: The Core Logic ---
function TPurityAnalyzer.VisitFunctionCall(const Node: IFunctionCallNode): Boolean;
function TPurityAnalyzer.VisitFunctionCall(const Node: IAstNode): Boolean;
begin
var C := Node.AsFunctionCall;
// 1. The target function MUST be marked as Pure (from RTL or previous inference).
if not Node.IsTargetPure then
if not C.IsTargetPure then
exit(False);
// 2. All arguments must be pure expressions.
// Delegate to ArgumentList visitor
Result := Accept(Node.Arguments);
Result := IsNodePure(C.Arguments);
end;
// --- Recursion ---
function TPurityAnalyzer.VisitRecurNode(const Node: IRecurNode): Boolean;
function TPurityAnalyzer.VisitRecurNode(const Node: IAstNode): Boolean;
begin
// 'recur' is just control flow. It is pure if its arguments are pure.
Result := Accept(Node.Arguments);
Result := IsNodePure(Node.AsRecur.Arguments);
end;
// --- Structures: Recursive Checks ---
function TPurityAnalyzer.VisitIfExpression(const Node: IIfExpressionNode): Boolean;
function TPurityAnalyzer.VisitIfExpression(const Node: IAstNode): Boolean;
begin
Result := Accept(Node.Condition) and Accept(Node.ThenBranch) and Accept(Node.ElseBranch);
var E := Node.AsIfExpression;
Result := IsNodePure(E.Condition) and IsNodePure(E.ThenBranch) and IsNodePure(E.ElseBranch);
end;
function TPurityAnalyzer.VisitCondExpression(const Node: ICondExpressionNode): Boolean;
var
pair: TCondPair;
function TPurityAnalyzer.VisitCondExpression(const Node: IAstNode): Boolean;
begin
var E := Node.AsCondExpression;
// All conditions and all branches must be pure
for pair in Node.Pairs do
for var pair in E.Pairs do
begin
if not (Accept(pair.Condition) and Accept(pair.Branch)) then
if not (IsNodePure(pair.Condition) and IsNodePure(pair.Branch)) then
Exit(False);
end;
// And the Else branch
Result := Accept(Node.ElseBranch);
Result := IsNodePure(E.ElseBranch);
end;
function TPurityAnalyzer.VisitBlockExpression(const Node: IBlockExpressionNode): Boolean;
function TPurityAnalyzer.VisitBlockExpression(const Node: IAstNode): Boolean;
begin
// Delegate to ExpressionList
Result := Accept(Node.Expressions);
Result := IsNodePure(Node.AsBlockExpression.Expressions);
end;
function TPurityAnalyzer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): Boolean;
function TPurityAnalyzer.VisitVariableDeclaration(const Node: IAstNode): Boolean;
begin
// 'def x = ...' is locally pure if the initializer is pure.
// It mutates the local scope (stack), but that is contained within the function execution.
Result := Accept(Node.Initializer);
Result := IsNodePure(Node.AsVariableDeclaration.Initializer);
end;
function TPurityAnalyzer.VisitRecordLiteral(const Node: IRecordLiteralNode): Boolean;
function TPurityAnalyzer.VisitRecordLiteral(const Node: IAstNode): Boolean;
begin
// Delegate to RecordFieldList
Result := Accept(Node.Fields);
Result := IsNodePure(Node.AsRecordLiteral.Fields);
end;
function TPurityAnalyzer.VisitIndexer(const Node: IIndexerNode): Boolean;
function TPurityAnalyzer.VisitIndexer(const Node: IAstNode): Boolean;
begin
// Reading from a structure is pure if the indices/base are pure.
Result := Accept(Node.Base) and Accept(Node.Index);
var I := Node.AsIndexer;
Result := IsNodePure(I.Base) and IsNodePure(I.Index);
end;
function TPurityAnalyzer.VisitMemberAccess(const Node: IMemberAccessNode): Boolean;
function TPurityAnalyzer.VisitMemberAccess(const Node: IAstNode): Boolean;
begin
Result := Accept(Node.Base);
Result := IsNodePure(Node.AsMemberAccess.Base);
end;
function TPurityAnalyzer.VisitSeriesLength(const Node: ISeriesLengthNode): Boolean;
function TPurityAnalyzer.VisitSeriesLength(const Node: IAstNode): Boolean;
begin
// Querying length is pure.
// The series identifier check happens in VisitIdentifier.
@@ -237,19 +291,19 @@ end;
// --- Forbidden (Impure) ---
function TPurityAnalyzer.VisitAssignment(const Node: IAssignmentNode): Boolean;
function TPurityAnalyzer.VisitAssignment(const Node: IAstNode): Boolean;
begin
// Mutation of variables is defined as impure.
Result := False;
end;
function TPurityAnalyzer.VisitAddSeriesItem(const Node: IAddSeriesItemNode): Boolean;
function TPurityAnalyzer.VisitAddSeriesItem(const Node: IAstNode): Boolean;
begin
// Mutation of a series (side effect).
Result := False;
end;
function TPurityAnalyzer.VisitCreateSeries(const Node: ICreateSeriesNode): Boolean;
function TPurityAnalyzer.VisitCreateSeries(const Node: IAstNode): Boolean;
begin
// Creating a NEW object is considered pure in this context,
// as it does not mutate existing global state.
@@ -258,37 +312,70 @@ end;
// --- Irrelevant / Nested (Definitions are pure, execution logic checked separately) ---
function TPurityAnalyzer.VisitLambdaExpression(const Node: ILambdaExpressionNode): Boolean;
function TPurityAnalyzer.VisitLambdaExpression(const Node: IAstNode): Boolean;
begin
// Defining a function is a pure operation.
// Whether the function itself is pure when executed is determined when *that* function is compiled.
Result := True;
end;
function TPurityAnalyzer.VisitMacroDefinition(const Node: IMacroDefinitionNode): Boolean;
function TPurityAnalyzer.VisitMacroDefinition(const Node: IAstNode): Boolean;
begin
Result := True; // Compile-time construct
end;
function TPurityAnalyzer.VisitQuasiquote(const Node: IQuasiquoteNode): Boolean;
function TPurityAnalyzer.VisitQuasiquote(const Node: IAstNode): Boolean;
begin
Result := True; // Structural construction
end;
function TPurityAnalyzer.VisitUnquote(const Node: IUnquoteNode): Boolean;
function TPurityAnalyzer.VisitUnquote(const Node: IAstNode): Boolean;
begin
Result := Accept(Node.Expression);
Result := IsNodePure(Node.AsUnquote.Expression);
end;
function TPurityAnalyzer.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): Boolean;
function TPurityAnalyzer.VisitUnquoteSplicing(const Node: IAstNode): Boolean;
begin
Result := Accept(Node.Expression);
Result := IsNodePure(Node.AsUnquoteSplicing.Expression);
end;
function TPurityAnalyzer.VisitMacroExpansionNode(const Node: IMacroExpansionNode): Boolean;
function TPurityAnalyzer.VisitMacroExpansionNode(const Node: IAstNode): Boolean;
begin
// We analyze the already expanded body.
Result := Accept(Node.ExpandedBody);
Result := IsNodePure(Node.AsMacroExpansion.ExpandedBody);
end;
// --- Pipe Support ---
function TPurityAnalyzer.VisitPipeInput(const Node: IAstNode): Boolean;
begin
var P := Node.AsPipeInput;
// Input node itself is declarative.
// But we check its parts just in case.
Result := IsNodePure(P.StreamSource) and IsNodePure(P.Selectors);
end;
function TPurityAnalyzer.VisitPipeSelectorList(const Node: IAstNode): Boolean;
begin
for var item in Node.AsPipeSelectorList do
if not IsNodePure(item) then
exit(False);
Result := True;
end;
function TPurityAnalyzer.VisitPipeInputList(const Node: IAstNode): Boolean;
begin
for var item in Node.AsPipeInputList do
if not IsNodePure(item) then
exit(False);
Result := True;
end;
function TPurityAnalyzer.VisitPipe(const Node: IAstNode): Boolean;
begin
var P := Node.AsPipe;
// A pipe is pure if its input definitions are pure AND its transformation lambda is pure.
Result := IsNodePure(P.Inputs) and IsNodePure(P.Transformation);
end;
end.
Src/AST/Myc.Ast.Compiler.Binder.Upvalues.pas
+36 -14
View File
@@ -40,11 +40,16 @@ type
FCurrentScope: TAnalysisScope;
procedure MarkDeclarationForBoxing(const AName: string);
strict private
// Analysis Handlers (IAstNode signature)
function VisitLambdaExpression(const Node: IAstNode): IAstNode;
function VisitIdentifier(const Node: IAstNode): IAstNode;
function VisitVariableDeclaration(const Node: IAstNode): IAstNode;
protected
// Overridden Visit methods to perform analysis during traversal.
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
procedure SetupHandlers; override;
public
constructor Create;
destructor Destroy; override;
@@ -126,6 +131,16 @@ begin
inherited Destroy;
end;
procedure TUpvalueAnalyzer.SetupHandlers;
begin
inherited SetupHandlers; // Load default transformer logic
// Override specific handlers for analysis
Register(akLambdaExpression, VisitLambdaExpression);
Register(akIdentifier, VisitIdentifier);
Register(akVariableDeclaration, VisitVariableDeclaration);
end;
function TUpvalueAnalyzer.Execute(const ARootNode: IAstNode): IAstNode;
begin
Result := Accept(ARootNode);
@@ -167,32 +182,35 @@ begin
end;
end;
function TUpvalueAnalyzer.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
function TUpvalueAnalyzer.VisitIdentifier(const Node: IAstNode): IAstNode;
begin
// Check if this identifier refers to a variable from an outer scope
MarkDeclarationForBoxing(Node.Name);
MarkDeclarationForBoxing(Node.AsIdentifier.Name);
// Return original node (Analysis pass only)
Result := Node;
end;
function TUpvalueAnalyzer.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
function TUpvalueAnalyzer.VisitLambdaExpression(const Node: IAstNode): IAstNode;
var
L: ILambdaExpressionNode;
i: Integer;
begin
L := Node.AsLambdaExpression;
// 1. Enter new analysis scope
FCurrentScope := TAnalysisScope.Create(FCurrentScope);
try
// 2. Register parameters (they mask outer variables)
// We pass 'nil' as the node because we currently don't box parameters,
// but we must ensure Resolve() finds them so we don't accidentally box a shadowed variable.
for i := 0 to Node.Parameters.Count - 1 do
for i := 0 to L.Parameters.Count - 1 do
begin
FCurrentScope.Define(Node.Parameters[i].Name, nil);
FCurrentScope.Define(L.Parameters[i].Name, nil);
end;
// 3. Visit Body
Accept(Node.Body); // Recursive call
Accept(L.Body); // Recursive call
// Rebuild if needed (default CoW behavior)
Result := Node;
@@ -204,15 +222,19 @@ begin
end;
end;
function TUpvalueAnalyzer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
function TUpvalueAnalyzer.VisitVariableDeclaration(const Node: IAstNode): IAstNode;
var
V: IVariableDeclarationNode;
begin
V := Node.AsVariableDeclaration;
// 1. Visit initializer first (it executes in the CURRENT scope)
if Assigned(Node.Initializer) then
Accept(Node.Initializer);
if Assigned(V.Initializer) then
Accept(V.Initializer);
// 2. Define the variable in the CURRENT scope
// Store the Node reference so we can add it to FBoxedDeclarations if captured.
FCurrentScope.Define(Node.Target.AsIdentifier.Name, Node);
FCurrentScope.Define(V.Target.AsIdentifier.Name, V);
Result := Node;
end;
Src/AST/Myc.Ast.Compiler.Binder.pas
+67 -54
View File
@@ -46,16 +46,16 @@ type
function ResolveSymbol(const Name: string; out Address: TResolvedAddress): Boolean;
function CaptureUpvalue(const PhysicalAddress: TResolvedAddress): Integer;
protected
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
function VisitAssignment(const Node: IAssignmentNode): IAstNode; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
strict private
// Specific Handlers (IAstNode signature)
function VisitIdentifier(const Node: IAstNode): IAstNode;
function VisitVariableDeclaration(const Node: IAstNode): IAstNode;
function VisitAssignment(const Node: IAstNode): IAstNode;
function VisitLambdaExpression(const Node: IAstNode): IAstNode;
function VisitFunctionCall(const Node: IAstNode): IAstNode;
function VisitConstant(const Node: IConstantNode): IAstNode; override;
function VisitKeyword(const Node: IKeywordNode): IAstNode; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode; override;
protected
procedure SetupHandlers; override;
public
constructor Create(
@@ -114,7 +114,7 @@ constructor TAstBinder.Create(
const ALog: ICompilerLog
);
begin
inherited Create;
inherited Create; // Calls SetupHandlers
FCurrentBuilder := TScope.CreateBuilder(AParentLayout);
FUpvalueStack := TObjectStack<TUpvalueMap>.Create(True);
FUpvalueStack.Push(TUpvalueMap.Create(TResolvedAddressComparer.Create));
@@ -133,6 +133,18 @@ begin
inherited;
end;
procedure TAstBinder.SetupHandlers;
begin
inherited SetupHandlers; // Loads default transformers (Identity, Lists, etc.)
// Override specific binding logic
Register(akIdentifier, VisitIdentifier);
Register(akVariableDeclaration, VisitVariableDeclaration);
Register(akAssignment, VisitAssignment);
Register(akLambdaExpression, VisitLambdaExpression);
Register(akFunctionCall, VisitFunctionCall);
end;
class function TAstBinder.Bind(
const ParentLayout: IScopeLayout;
const RootNode: IAstNode;
@@ -148,6 +160,7 @@ end;
function TAstBinder.Execute(const RootNode: IAstNode; out Layout: IScopeLayout): IAstNode;
begin
// Pre-pass to find captured variables
FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode);
Result := Accept(RootNode);
@@ -212,35 +225,22 @@ begin
end;
end;
function TAstBinder.VisitConstant(const Node: IConstantNode): IAstNode;
begin
Result := Node;
end;
function TAstBinder.VisitKeyword(const Node: IKeywordNode): IAstNode;
begin
Result := Node;
end;
function TAstBinder.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode;
begin
Result := Node;
end;
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
function TAstBinder.VisitIdentifier(const Node: IAstNode): IAstNode;
var
I: IIdentifierNode;
physAddr: TResolvedAddress;
upvalueIndex: Integer;
identity: INamedIdentity;
begin
identity := Node.Identity.AsNamed;
I := Node.AsIdentifier;
identity := I.Identity.AsNamed;
if Node.Address.Kind = akUnresolved then
if I.Address.Kind = akUnresolved then
begin
if not ResolveSymbol(Node.Name, physAddr) then
if not ResolveSymbol(I.Name, physAddr) then
begin
if Assigned(FLog) then
FLog.AddError(Format('Undefined identifier: "%s"', [Node.Name]), Node);
FLog.AddError(Format('Undefined identifier: "%s"', [I.Name]), Node);
Result := Node;
Exit;
end;
@@ -257,8 +257,9 @@ begin
Result := Node;
end;
function TAstBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
function TAstBinder.VisitVariableDeclaration(const Node: IAstNode): IAstNode;
var
V: IVariableDeclarationNode;
slot: Integer;
addr: TResolvedAddress;
newInit: IAstNode;
@@ -267,7 +268,8 @@ var
identifier: IIdentifierNode;
identIdentity: INamedIdentity;
begin
identifier := Node.Target.AsIdentifier;
V := Node.AsVariableDeclaration;
identifier := V.Target.AsIdentifier;
identIdentity := identifier.Identity.AsNamed;
if not IsValidIdentifier(identifier.Name) then
@@ -281,8 +283,8 @@ begin
if Assigned(FLog) then
FLog.AddError(Format('Variable "%s" is already defined in this scope.', [identifier.Name]), Node);
if Assigned(Node.Initializer) then
Accept(Node.Initializer);
if Assigned(V.Initializer) then
Accept(V.Initializer);
Result := Node;
Exit;
@@ -291,38 +293,42 @@ begin
slot := FCurrentBuilder.Define(identifier.Name);
addr := TResolvedAddress.Create(akLocalOrParent, 0, slot);
if Assigned(Node.Initializer) then
newInit := Accept(Node.Initializer)
if Assigned(V.Initializer) then
newInit := Accept(V.Initializer)
else
newInit := nil;
newIdent := TAst.Identifier(identIdentity, addr, TTypes.Unknown);
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(V);
Result := TAst.VarDecl(Node.Identity, newIdent, newInit, TTypes.Unknown, isBoxed);
if Assigned(FFunctionRegistry) and (newInit <> nil) and (newInit.Kind = akLambdaExpression) then
FFunctionRegistry.Register(addr, newInit.AsLambdaExpression);
end;
function TAstBinder.VisitAssignment(const Node: IAssignmentNode): IAstNode;
function TAstBinder.VisitAssignment(const Node: IAstNode): IAstNode;
var
A: IAssignmentNode;
newIdent: IAstNode;
newValue: IAstNode;
begin
newIdent := Accept(Node.Target);
newValue := Accept(Node.Value);
A := Node.AsAssignment;
// Manually accept children because we need the results for registry logic
newIdent := Accept(A.Target);
newValue := Accept(A.Value);
Result := TAst.Assign(Node.Identity, newIdent, newValue, TTypes.Unknown);
if Assigned(FFunctionRegistry) and (newValue <> nil) and (newValue.Kind = akLambdaExpression) then
begin
if newIdent.AsIdentifier.Address.Kind = akLocalOrParent then
if (newIdent.Kind = akIdentifier) and (newIdent.AsIdentifier.Address.Kind = akLocalOrParent) then
FFunctionRegistry.Register(newIdent.AsIdentifier.Address, newValue.AsLambdaExpression);
end;
end;
function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
function TAstBinder.VisitLambdaExpression(const Node: IAstNode): IAstNode;
var
L: ILambdaExpressionNode;
parentBuilder: IScopeBuilder;
paramType: IStaticType;
newParams: TArray<IIdentifierNode>;
@@ -338,6 +344,7 @@ var
paramIdentity: INamedIdentity;
paramList: IParameterList;
begin
L := Node.AsLambdaExpression;
startCount := FLambdaCounter;
Inc(FLambdaCounter);
@@ -350,11 +357,11 @@ begin
try
FCurrentBuilder.Define('<self>');
SetLength(newParams, Node.Parameters.Count);
SetLength(newParams, L.Parameters.Count);
for i := 0 to Node.Parameters.Count - 1 do
for i := 0 to L.Parameters.Count - 1 do
begin
var paramNode := Node.Parameters[i];
var paramNode := L.Parameters[i];
var paramName := paramNode.Name;
paramIdentity := paramNode.Identity.AsNamed;
@@ -379,7 +386,7 @@ begin
newParams[i] := TAst.Identifier(paramIdentity, addr, paramType);
end;
newBody := Accept(Node.Body);
newBody := Accept(L.Body);
finalLayout := FCurrentBuilder.Build;
sortedPairs := capturedMap.ToArray;
@@ -408,28 +415,34 @@ begin
end;
hasNested := FLambdaCounter > (startCount + 1);
paramList := TParameterList.Create(newParams, L.Parameters.Identity);
paramList := TParameterList.Create(newParams, Node.Parameters.Identity);
Result := TAst.LambdaExpr(Node.Identity, paramList, newBody, finalLayout, nil, upvaluesList, hasNested, Node.IsPure);
Result := TAst.LambdaExpr(Node.Identity, paramList, newBody, finalLayout, nil, upvaluesList, hasNested, L.IsPure);
end;
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
function TAstBinder.VisitFunctionCall(const Node: IAstNode): IAstNode;
var
C: IFunctionCallNode;
begin
if Node.Callee.Kind = akKeyword then
C := Node.AsFunctionCall;
// 1. Keyword as Function Logic
if C.Callee.Kind = akKeyword then
begin
if Node.Arguments.Count <> 1 then
if C.Arguments.Count <> 1 then
begin
if Assigned(FLog) then
FLog.AddError(Format('Keyword access :%s requires exactly one argument.', [Node.Callee.AsKeyword.Value.Name]), Node);
FLog.AddError(Format('Keyword access :%s requires exactly one argument.', [C.Callee.AsKeyword.Value.Name]), Node);
end
else
begin
var memberAccess := TAst.MemberAccess(Node.Identity, Accept(Node.Arguments[0]), Node.Callee.AsKeyword);
var memberAccess := TAst.MemberAccess(Node.Identity, Accept(C.Arguments[0]), C.Callee.AsKeyword);
Result := memberAccess;
exit;
end;
end;
// 2. Delegate to standard AST transformation (recurse on callee and args)
// This reuses logic from TAstTransformer!
Result := inherited VisitFunctionCall(Node);
end;
Src/AST/Myc.Ast.Compiler.Macros.pas
+128 -134
View File
@@ -15,42 +15,39 @@ uses
Myc.Ast;
type
// Exception specific to macro expansion errors
EMacroException = class(EAstException);
IAstMacroExpander = interface(IAstVisitor)
function Execute(const RootNode: IAstNode): IAstNode;
end;
// Callback used by TMacroExpander to request full compilation and execution of macro arguments.
TMacroEvaluatorProc = reference to function(const Scope: IExecutionScope; const Node: IAstNode): TDataValue;
// Handles the expansion of the macro body template (Quasiquotes/Unquotes).
// Handles body expansion (Template instantiation)
TExpansionVisitor = class(TAstTransformer)
private
strict private
FMacroEvaluator: TMacroEvaluatorProc;
FMacroScope: IExecutionScope;
FRenameMap: TDictionary<string, string>;
class var
FGensymCounter: Int64;
// Helper to handle unquote-splicing (~@) within lists.
// Takes a source list (e.g., Arguments) and returns a flattened array for the new node.
function TransformAndSpliceNodes(const ANodes: INodeList<IAstNode>): TArray<IAstNode>;
function Gensym(const ABaseName: string): string;
// Custom Logic Handlers (IAstNode signature)
function VisitUnquote(const Node: IAstNode): IAstNode;
function VisitUnquoteSplicing(const Node: IAstNode): IAstNode;
function VisitFunctionCall(const Node: IAstNode): IAstNode;
function VisitBlockExpression(const Node: IAstNode): IAstNode;
function VisitRecordLiteral(const Node: IAstNode): IAstNode;
function VisitVariableDeclaration(const Node: IAstNode): IAstNode;
function VisitLambdaExpression(const Node: IAstNode): IAstNode;
function VisitIdentifier(const Node: IAstNode): IAstNode;
protected
function VisitUnquote(const Node: IUnquoteNode): IAstNode; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode; override;
procedure SetupHandlers; override;
// We override these container visits to handle Splicing manually,
// bypassing the standard 1:1 list visitor.
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
public
constructor Create(const AMacroScope: IExecutionScope; const AMacroEvaluator: TMacroEvaluatorProc);
destructor Destroy; override;
@@ -72,9 +69,9 @@ type
property Parent: IMacroRegistry read GetParent;
end;
// Handles the expansion of macro calls within the AST.
// Handles macro calls in AST
TMacroExpander = class(TAstTransformer, IAstMacroExpander)
private
strict private
FInitialScope: IExecutionScope;
FCurrentMacroRegistry: IMacroRegistry;
FMacroEvaluator: TMacroEvaluatorProc;
@@ -82,16 +79,16 @@ type
procedure EnterMacroScope;
procedure ExitMacroScope;
function VisitMacroDefinition(const Node: IAstNode): IAstNode;
function VisitFunctionCall(const Node: IAstNode): IAstNode;
function VisitQuasiquote(const Node: IAstNode): IAstNode;
function VisitUnquote(const Node: IAstNode): IAstNode;
function VisitUnquoteSplicing(const Node: IAstNode): IAstNode;
function VisitBlockExpression(const Node: IAstNode): IAstNode;
function VisitLambdaExpression(const Node: IAstNode): IAstNode;
protected
function VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode; override;
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
function VisitQuasiquote(const Node: IQuasiquoteNode): IAstNode; override;
function VisitUnquote(const Node: IUnquoteNode): IAstNode; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
procedure SetupHandlers; override;
public
constructor Create(
@@ -111,7 +108,6 @@ type
): IAstNode; static;
end;
// Implementation of the macro registry interface defined in Myc.Ast.Environment.
TMacroRegistry = class(TInterfacedObject, IMacroRegistry)
private
FParent: IMacroRegistry;
@@ -148,6 +144,22 @@ begin
inherited;
end;
procedure TExpansionVisitor.SetupHandlers;
begin
inherited SetupHandlers; // Defaults
// Register custom handlers
Register(akUnquote, VisitUnquote);
Register(akUnquoteSplicing, VisitUnquoteSplicing);
Register(akFunctionCall, VisitFunctionCall);
Register(akBlockExpression, VisitBlockExpression);
Register(akRecordLiteral, VisitRecordLiteral);
Register(akVariableDeclaration, VisitVariableDeclaration);
Register(akLambdaExpression, VisitLambdaExpression);
Register(akIdentifier, VisitIdentifier);
end;
function TExpansionVisitor.Gensym(const ABaseName: string): string;
begin
if not FRenameMap.TryGetValue(ABaseName, Result) then
@@ -189,7 +201,6 @@ begin
begin
var spliceExpr := node.AsUnquoteSplicing.Expression;
var evaluatedSpliceValue: TDataValue;
try
evaluatedSpliceValue := FMacroEvaluator(FMacroScope, spliceExpr);
except
@@ -202,36 +213,20 @@ begin
if (not evaluatedSpliceValue.IsVoid) and (evaluatedSpliceValue.Kind = vkInterface) then
begin
nodeToSplice := evaluatedSpliceValue.AsIntf<IAstNode>;
// Splicing implies the value must be a list-like AST structure (Block or just a List Node)
// If the evaluated value is an IArgumentList, IExpressionList etc., we flatten it.
if nodeToSplice.Kind = akExpressionList then
begin
for var subItem in nodeToSplice.AsExpressionList do
newList.Add(subItem);
end
newList.Add(subItem)
else if nodeToSplice.Kind = akArgumentList then
begin
for var subItem in nodeToSplice.AsArgumentList do
newList.Add(subItem);
end
newList.Add(subItem)
else if nodeToSplice.Kind = akBlockExpression then
begin
// Splice content of block
for var subItem in nodeToSplice.AsBlockExpression.Expressions do
newList.Add(subItem);
end
newList.Add(subItem)
else
begin
// Treat as single item
newList.Add(nodeToSplice);
end;
end
else if (not evaluatedSpliceValue.IsVoid) then
begin
// Use Splice Node Identity for the new Constant
newList.Add(TAst.Constant(evaluatedSpliceValue, node.Identity.Location));
end;
end
else
begin
@@ -246,76 +241,69 @@ begin
end;
end;
function TExpansionVisitor.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
function TExpansionVisitor.VisitIdentifier(const Node: IAstNode): IAstNode;
var
I: IIdentifierNode;
newName: string;
begin
// Apply hygienic renaming
if FRenameMap.TryGetValue(Node.Name, newName) then
I := Node.AsIdentifier;
if FRenameMap.TryGetValue(I.Name, newName) then
begin
// Create new Identifier with new Name but preserve Location from original Node
Result := TAst.Identifier(newName, Node.Identity.Location);
Result := TAst.Identifier(newName, I.Identity.Location);
exit;
end;
Result := Node;
end;
function TExpansionVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
function TExpansionVisitor.VisitVariableDeclaration(const Node: IAstNode): IAstNode;
var
V: IVariableDeclarationNode;
newTarget, newInit: IAstNode;
newName: string;
begin
newInit := Accept(Node.Initializer);
if Node.Target.Kind = akIdentifier then
V := Node.AsVariableDeclaration;
newInit := Accept(V.Initializer);
if V.Target.Kind = akIdentifier then
begin
newName := Gensym(Node.Target.AsIdentifier.Name);
// Use location from original target
newTarget := TAst.Identifier(newName, Node.Target.Identity.Location);
newName := Gensym(V.Target.AsIdentifier.Name);
newTarget := TAst.Identifier(newName, V.Target.Identity.Location);
end
else
begin
newTarget := Accept(Node.Target);
end;
newTarget := Accept(V.Target);
Result := TAst.VarDecl(Node.Identity, newTarget, newInit, TTypes.Unknown, False);
end;
function TExpansionVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
function TExpansionVisitor.VisitLambdaExpression(const Node: IAstNode): IAstNode;
var
L: ILambdaExpressionNode;
newParams: TArray<IIdentifierNode>;
newBody: IAstNode;
newName: string;
i: Integer;
paramList: IParameterList;
begin
SetLength(newParams, Node.Parameters.Count);
for i := 0 to Node.Parameters.Count - 1 do
L := Node.AsLambdaExpression;
SetLength(newParams, L.Parameters.Count);
for i := 0 to L.Parameters.Count - 1 do
begin
var param := Node.Parameters[i];
var param := L.Parameters[i];
newName := Gensym(param.Name);
// Use location from original param
newParams[i] := TAst.Identifier(newName, param.Identity.Location);
end;
newBody := Accept(Node.Body);
// Rebuild: Wrap array in TParameterList with original Identity
paramList := TParameterList.Create(newParams, Node.Parameters.Identity);
// Use transformation overload
Result := TAst.LambdaExpr(Node.Identity, paramList, newBody);
newBody := Accept(L.Body);
Result := TAst.LambdaExpr(Node.Identity, TParameterList.Create(newParams, L.Parameters.Identity), newBody);
end;
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): IAstNode;
function TExpansionVisitor.VisitUnquote(const Node: IAstNode): IAstNode;
var
U: IUnquoteNode;
value: TDataValue;
expr: IAstNode;
addr: TResolvedAddress;
begin
expr := Node.Expression;
// Optimization: If unquote refers to a local macro variable directly, try to get it.
U := Node.AsUnquote;
expr := U.Expression;
if expr.Kind = akIdentifier then
begin
addr := FMacroScope.Resolve(expr.AsIdentifier.Name);
@@ -323,10 +311,7 @@ begin
begin
var argValue := FMacroScope.Values[addr];
if argValue.Kind = vkInterface then
begin
Result := argValue.AsIntf<IAstNode>;
exit;
end;
exit(argValue.AsIntf<IAstNode>);
end;
end;
@@ -340,57 +325,45 @@ begin
end;
if value.Kind = vkInterface then
begin
Result := value.AsIntf<IAstNode>;
exit;
end;
exit(value.AsIntf<IAstNode>);
if value.Kind in [vkScalar, vkText, vkVoid] then
// Create Constant node, inheriting location from the Unquote node
Result := TAst.Constant(value, Node.Identity.Location)
else
raise EMacroException.CreateFmt('Cannot unquote complex runtime value of type %s at compile time.', [value.Kind.ToString]);
end;
function TExpansionVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode;
function TExpansionVisitor.VisitUnquoteSplicing(const Node: IAstNode): IAstNode;
begin
raise EMacroException.Create('Unquote-splicing (`~@`) can only appear inside a list form.');
end;
function TExpansionVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
function TExpansionVisitor.VisitFunctionCall(const Node: IAstNode): IAstNode;
var
C: IFunctionCallNode;
newArgs: TArray<IAstNode>;
transformedCallee: IAstNode;
argList: IArgumentList;
begin
transformedCallee := Self.Accept(Node.Callee);
// Use splicing aware transformation for arguments (returns TArray)
newArgs := TransformAndSpliceNodes(Node.Arguments);
// Wrap in List container to use Transformation overload
argList := TArgumentList.Create(newArgs, Node.Arguments.Identity);
Result := TAst.FunctionCall(Node.Identity, transformedCallee, argList);
C := Node.AsFunctionCall;
transformedCallee := Self.Accept(C.Callee);
newArgs := TransformAndSpliceNodes(C.Arguments);
Result := TAst.FunctionCall(Node.Identity, transformedCallee, TArgumentList.Create(newArgs, C.Arguments.Identity));
end;
function TExpansionVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
function TExpansionVisitor.VisitBlockExpression(const Node: IAstNode): IAstNode;
var
B: IBlockExpressionNode;
newExprs: TArray<IAstNode>;
exprList: IExpressionList;
begin
// Use splicing aware transformation for block expressions
newExprs := TransformAndSpliceNodes(Node.Expressions);
// Wrap in List
exprList := TExpressionList.Create(newExprs, Node.Expressions.Identity);
Result := TAst.Block(Node.Identity, exprList);
B := Node.AsBlockExpression;
newExprs := TransformAndSpliceNodes(B.Expressions);
Result := TAst.Block(Node.Identity, TExpressionList.Create(newExprs, B.Expressions.Identity));
end;
function TExpansionVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode;
function TExpansionVisitor.VisitRecordLiteral(const Node: IAstNode): IAstNode;
begin
// For now, standard transformation for records (no splicing key-values yet)
// Delegate to standard transformer to process fields recursively
// This calls inherited VisitRecordLiteral(IAstNode)
Result := inherited VisitRecordLiteral(Node);
end;
@@ -413,6 +386,21 @@ begin
inherited Destroy;
end;
procedure TMacroExpander.SetupHandlers;
begin
inherited SetupHandlers; // Defaults
Register(akMacroDefinition, VisitMacroDefinition);
Register(akFunctionCall, VisitFunctionCall);
Register(akQuasiquote, VisitQuasiquote);
Register(akUnquote, VisitUnquote);
Register(akUnquoteSplicing, VisitUnquoteSplicing);
// Wrappers for scope management
Register(akBlockExpression, VisitBlockExpression);
Register(akLambdaExpression, VisitLambdaExpression);
end;
procedure TMacroExpander.EnterMacroScope;
begin
FCurrentMacroRegistry := FCurrentMacroRegistry.CreateChildRegistry;
@@ -441,75 +429,81 @@ begin
Result := TAst.Block([], nil);
end;
function TMacroExpander.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
function TMacroExpander.VisitBlockExpression(const Node: IAstNode): IAstNode;
begin
EnterMacroScope;
try
// Delegate to standard recursive transform
Result := inherited VisitBlockExpression(Node);
finally
ExitMacroScope;
end;
end;
function TMacroExpander.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
function TMacroExpander.VisitLambdaExpression(const Node: IAstNode): IAstNode;
begin
EnterMacroScope;
try
// Delegate to standard recursive transform
Result := inherited VisitLambdaExpression(Node);
finally
ExitMacroScope;
end;
end;
function TMacroExpander.VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode;
function TMacroExpander.VisitMacroDefinition(const Node: IAstNode): IAstNode;
begin
FCurrentMacroRegistry.Define(Node);
FCurrentMacroRegistry.Define(Node.AsMacroDefinition);
Result := Node;
end;
function TMacroExpander.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
function TMacroExpander.VisitFunctionCall(const Node: IAstNode): IAstNode;
var
C: IFunctionCallNode;
calleeIdentifier: IIdentifierNode;
macroDef: IMacroDefinitionNode;
i: Integer;
begin
if Node.Callee.Kind <> akIdentifier then
exit(inherited VisitFunctionCall(Node));
calleeIdentifier := Node.Callee.AsIdentifier;
C := Node.AsFunctionCall;
if C.Callee.Kind = akIdentifier then
begin
calleeIdentifier := C.Callee.AsIdentifier;
macroDef := FCurrentMacroRegistry.Find(calleeIdentifier.Name);
if macroDef = nil then
exit(inherited VisitFunctionCall(Node));
if macroDef <> nil then
begin
var expansionScope := TScope.CreateScope(FInitialScope, nil, nil);
var params := macroDef.Parameters;
if Node.Arguments.Count <> params.Count then
if C.Arguments.Count <> params.Count then
raise EMacroException.CreateFmt('Macro %s expects %d arguments.', [calleeIdentifier.Name, params.Count]);
for i := 0 to params.Count - 1 do
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(C.Arguments[i]));
var expandedBody := TExpansionVisitor.Expand(expansionScope, macroDef.Body.AsQuasiquote.Expression, FMacroEvaluator);
// The MacroExpansionNode wraps the expansion, preserving the original call's identity (Source Location)
// for better error reporting.
var macroNode := TAst.MacroExpansionNode(Node.Identity, Node, expandedBody);
var macroNode := TAst.MacroExpansionNode(Node.Identity, C, expandedBody);
Result := Self.Accept(macroNode);
exit;
end;
end;
// Standard recursion for non-macro calls
Result := inherited VisitFunctionCall(Node);
end;
function TMacroExpander.VisitQuasiquote(const Node: IQuasiquoteNode): IAstNode;
function TMacroExpander.VisitQuasiquote(const Node: IAstNode): IAstNode;
begin
Result := Node;
end;
function TMacroExpander.VisitUnquote(const Node: IUnquoteNode): IAstNode;
function TMacroExpander.VisitUnquote(const Node: IAstNode): IAstNode;
begin
raise EMacroException.Create('Unquote (`~`) can only be used inside a quasiquote.');
end;
function TMacroExpander.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode;
function TMacroExpander.VisitUnquoteSplicing(const Node: IAstNode): IAstNode;
begin
raise EMacroException.Create('Unquote-splicing (`~@`) can only be used inside a quasiquote.');
end;
Src/AST/Myc.Ast.Compiler.Specializer.pas
+34 -28
View File
@@ -16,7 +16,7 @@ uses
Myc.Ast.Compiler.Binder;
type
// Exception specific to specialization errors (e.g. internal compilation failures)
// Exception specific to specialization errors
ESpecializerException = class(EAstException);
IAstSpecializer = interface(IAstVisitor)
@@ -29,7 +29,7 @@ type
public
Address: TResolvedAddress;
ArgTypes: TArray<IStaticType>;
Func: TDataValue.TFunc;
Func: TDataValue.TFunc; // Usually nil in key, but part of structure if needed
constructor Create(const AAddress: TResolvedAddress; const AArgTypes: TArray<IStaticType>);
end;
@@ -39,10 +39,9 @@ type
end;
// This transformer runs *after* TypeChecker.
// It specializes all statically resolvable function calls (RTL and user-defined)
// by replacing them with nodes that have a direct StaticTarget.
// It propagates Purity information but does NOT perform Constant Folding yet.
// It specializes all statically resolvable function calls.
TStaticSpecializer = class(TAstTransformer, IAstSpecializer)
public
type
TCompileFunc = reference to function(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction;
private
@@ -52,8 +51,12 @@ type
function GetStaticRtlFunction(const AName: string; const AArgTypes: TArray<IStaticType>): TSpecializedMethod;
strict private
// Specialization Handler (IAstNode signature)
function VisitFunctionCall(const Node: IAstNode): IAstNode;
protected
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
procedure SetupHandlers; override;
public
constructor Create(
@@ -89,13 +92,19 @@ begin
raise ESpecializerException.Create('MonomorphCache cannot be nil.');
if not Assigned(AFunctionRegistry) then
raise ESpecializerException.Create('FunctionRegistry cannot be nil.');
// CompileFunc can be nil if no recursion is supported, but usually required.
FMonomorphCache := AMonomorphCache;
FFunctionRegistry := AFunctionRegistry;
FCompileFunc := ACompileFunc;
end;
procedure TStaticSpecializer.SetupHandlers;
begin
inherited SetupHandlers; // Load default transformations
// Override FunctionCall logic
Register(akFunctionCall, VisitFunctionCall);
end;
class function TStaticSpecializer.Specialize(
const RootNode: IAstNode;
const AMonomorphCache: IMonomorphCache;
@@ -119,8 +128,10 @@ begin
Result := TRtlRegistry.GetStaticSpecialization(AName, AArgTypes);
end;
function TStaticSpecializer.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
function TStaticSpecializer.VisitFunctionCall(const Node: IAstNode): IAstNode;
var
C: IFunctionCallNode;
newCall: IFunctionCallNode;
newCallee: IAstNode;
newArgsList: IArgumentList;
i: Integer;
@@ -132,18 +143,18 @@ var
specializedMethod: TSpecializedMethod;
funcDef: IFunctionDefinition;
begin
// 1. Specialize children first (bottom-up)
newCallee := Accept(Node.Callee);
// Arguments are now visited as a List, returning an IArgumentList
newArgsList := Accept(Node.Arguments).AsArgumentList;
C := Node.AsFunctionCall;
// 1. Specialize children first (bottom-up) by calling inherited
// inherited VisitFunctionCall returns an IAstNode (which is a new IFunctionCallNode if changed)
newCall := inherited VisitFunctionCall(Node).AsFunctionCall;
newCallee := newCall.Callee;
newArgsList := newCall.Arguments;
// 2. Check if this call is a candidate for specialization
if newCallee.Kind <> akIdentifier then
begin
if (newCallee = Node.Callee) and (newArgsList = Node.Arguments) then
Result := Node
else
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgsList, Node.StaticType, Node.IsTailCall, nil);
Result := newCall;
exit;
end;
@@ -165,10 +176,7 @@ begin
if not allTypesKnown then
begin
if (newCallee = Node.Callee) and (newArgsList = Node.Arguments) then
Result := Node
else
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgsList, Node.StaticType, Node.IsTailCall, nil);
Result := newCall;
exit;
end;
@@ -186,7 +194,7 @@ begin
newCallee,
newArgsList,
specializedMethod.ReturnType,
Node.IsTailCall,
C.IsTailCall,
specializedMethod.Target,
specializedMethod.IsPure
);
@@ -206,7 +214,7 @@ begin
newCallee,
newArgsList,
specializedMethod.ReturnType,
Node.IsTailCall,
C.IsTailCall,
specializedMethod.Target,
specializedMethod.IsPure
);
@@ -224,7 +232,7 @@ begin
var lambdaDef := funcDef.AsLambdaExpression;
if (Length(lambdaDef.Upvalues) > 0) or (lambdaDef.HasNestedLambdas) then
begin
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgsList, Node.StaticType, Node.IsTailCall, nil);
Result := newCall;
exit;
end;
end;
@@ -245,15 +253,12 @@ begin
FMonomorphCache.Add(key, specializedMethod);
// 6c. Return the new node
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgsList, returnType, Node.IsTailCall, compiled.Func, compiled.IsPure);
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgsList, returnType, C.IsTailCall, compiled.Func, compiled.IsPure);
exit;
end;
// 7. Fallback: Not RTL, Not User-Code -> Dynamic
if (newCallee = Node.Callee) and (newArgsList = Node.Arguments) then
Result := Node
else
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgsList, Node.StaticType, Node.IsTailCall, nil);
Result := newCall;
end;
{ TMonoCacheKey }
@@ -262,6 +267,7 @@ constructor TMonoCacheKey.Create(const AAddress: TResolvedAddress; const AArgTyp
begin
Address := AAddress;
ArgTypes := AArgTypes;
Func := nil;
end;
end.
Src/AST/Myc.Ast.Compiler.TCO.pas
+89 -83
View File
@@ -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.
Src/AST/Myc.Ast.Compiler.TypeChecker.pas
+183 -151
View File
@@ -52,28 +52,31 @@ type
function PrepareBaseType(const BaseNode: IAstNode; out IsOptional: Boolean): IStaticType;
function ApplyOptionality(const AType: IStaticType; IsOptional: Boolean): IStaticType;
protected
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
function VisitAssignment(const Node: IAssignmentNode): IAstNode; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
function VisitIfExpression(const Node: IIfExpressionNode): IAstNode; override;
function VisitMemberAccess(const Node: IMemberAccessNode): IAstNode; override;
function VisitIndexer(const Node: IIndexerNode): IAstNode; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode; override;
function VisitRecurNode(const Node: IRecurNode): IAstNode; override;
function VisitNop(const Node: INopNode): IAstNode; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; override;
function VisitConstant(const Node: IConstantNode): IAstNode; override;
function VisitKeyword(const Node: IKeywordNode): IAstNode; override;
strict private
// Typed Handlers (non-virtual, IAstNode signature)
function VisitIdentifier(const Node: IAstNode): IAstNode;
function VisitVariableDeclaration(const Node: IAstNode): IAstNode;
function VisitAssignment(const Node: IAstNode): IAstNode;
function VisitLambdaExpression(const Node: IAstNode): IAstNode;
function VisitFunctionCall(const Node: IAstNode): IAstNode;
function VisitBlockExpression(const Node: IAstNode): IAstNode;
function VisitIfExpression(const Node: IAstNode): IAstNode;
function VisitMemberAccess(const Node: IAstNode): IAstNode;
function VisitIndexer(const Node: IAstNode): IAstNode;
function VisitCreateSeries(const Node: IAstNode): IAstNode;
function VisitSeriesLength(const Node: IAstNode): IAstNode;
function VisitRecurNode(const Node: IAstNode): IAstNode;
function VisitNop(const Node: IAstNode): IAstNode;
function VisitRecordLiteral(const Node: IAstNode): IAstNode;
function VisitConstant(const Node: IAstNode): IAstNode;
function VisitKeyword(const Node: IAstNode): IAstNode;
// Pipe Support
function VisitPipeInput(const Node: IPipeInputNode): IAstNode; override;
function VisitPipe(const Node: IPipeNode): IAstNode; override;
function VisitPipeInput(const Node: IAstNode): IAstNode;
function VisitPipe(const Node: IAstNode): IAstNode;
protected
procedure SetupHandlers; override;
public
constructor Create(const RootLayout: IScopeLayout; const RootScope: IExecutionScope; const ALog: ICompilerLog);
@@ -215,6 +218,32 @@ begin
inherited;
end;
procedure TTypeChecker.SetupHandlers;
begin
inherited SetupHandlers; // Load Defaults
Register(akIdentifier, VisitIdentifier);
Register(akVariableDeclaration, VisitVariableDeclaration);
Register(akAssignment, VisitAssignment);
Register(akLambdaExpression, VisitLambdaExpression);
Register(akFunctionCall, VisitFunctionCall);
Register(akBlockExpression, VisitBlockExpression);
Register(akIfExpression, VisitIfExpression);
Register(akMemberAccess, VisitMemberAccess);
Register(akIndexer, VisitIndexer);
Register(akCreateSeries, VisitCreateSeries);
Register(akSeriesLength, VisitSeriesLength);
Register(akRecur, VisitRecurNode);
Register(akNop, VisitNop);
Register(akRecordLiteral, VisitRecordLiteral);
Register(akConstant, VisitConstant);
Register(akKeyword, VisitKeyword);
// Pipe Support
Register(akPipeInput, VisitPipeInput);
Register(akPipe, VisitPipe);
end;
class function TTypeChecker.CheckTypes(
const RootNode: IAstNode;
const Layout: IScopeLayout;
@@ -261,24 +290,27 @@ end;
// --- Visits ---
function TTypeChecker.VisitConstant(const Node: IConstantNode): IAstNode;
function TTypeChecker.VisitConstant(const Node: IAstNode): IAstNode;
begin
// Base implementation already returns Node, but here we explicitly confirm identity for clarity
Result := Node;
end;
function TTypeChecker.VisitKeyword(const Node: IAstNode): IAstNode;
begin
Result := Node;
end;
function TTypeChecker.VisitKeyword(const Node: IKeywordNode): IAstNode;
begin
Result := Node;
end;
function TTypeChecker.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
function TTypeChecker.VisitIdentifier(const Node: IAstNode): IAstNode;
var
I: IIdentifierNode;
typ: IStaticType;
adr: TResolvedAddress;
identity: INamedIdentity;
begin
adr := Node.Address;
identity := Node.Identity.AsNamed;
I := Node.AsIdentifier;
adr := I.Address;
identity := I.Identity.AsNamed;
if adr.Kind = akUnresolved then
begin
@@ -290,40 +322,45 @@ begin
Result := TAst.Identifier(identity, adr, typ);
end;
function TTypeChecker.VisitRecurNode(const Node: IRecurNode): IAstNode;
function TTypeChecker.VisitRecurNode(const Node: IAstNode): IAstNode;
var
newArgs: TArray<IAstNode>;
i: Integer;
R: IRecurNode;
args: IArgumentList;
begin
SetLength(newArgs, Node.Arguments.Count);
for i := 0 to Node.Arguments.Count - 1 do
newArgs[i] := Accept(Node.Arguments[i]);
R := Node.AsRecur;
// Use inherited to transform arguments, then reconstruct with type Void
// Note: inherited VisitRecurNode returns IAstNode which is a RecurNode.
// We can call Accept on arguments list directly to avoid intermediate node creation if desired,
// but relying on inherited logic keeps it consistent.
var argList := TArgumentList.Create(newArgs, Node.Arguments.Identity);
Result := TAst.Recur(Node.Identity, argList, TTypes.Void);
// Efficient approach: Accept the arguments list directly (it's a child).
args := Accept(R.Arguments).AsArgumentList;
Result := TAst.Recur(Node.Identity, args, TTypes.Void);
end;
function TTypeChecker.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
function TTypeChecker.VisitVariableDeclaration(const Node: IAstNode): IAstNode;
var
V: IVariableDeclarationNode;
initType: IStaticType;
newInitializer, newIdent: IAstNode;
adr: TResolvedAddress;
identNode: IIdentifierNode;
begin
identNode := Node.Target.AsIdentifier;
V := Node.AsVariableDeclaration;
identNode := V.Target.AsIdentifier;
adr := identNode.Address;
initType := TTypes.Unknown;
if adr.Kind = akUnresolved then
begin
if Assigned(Node.Initializer) then
Accept(Node.Initializer);
if Assigned(V.Initializer) then
Accept(V.Initializer);
Result := Node;
Exit;
end;
if Assigned(Node.Initializer) then
newInitializer := Accept(Node.Initializer)
if Assigned(V.Initializer) then
newInitializer := Accept(V.Initializer)
else
newInitializer := nil;
@@ -334,29 +371,31 @@ begin
FCurrentContext.SetType(adr.SlotIndex, initType);
newIdent := TAst.Identifier(identNode.Identity.AsNamed, adr, initType);
Result := TAst.VarDecl(Node.Identity, newIdent, newInitializer, initType, Node.IsBoxed);
Result := TAst.VarDecl(Node.Identity, newIdent, newInitializer, initType, V.IsBoxed);
end;
function TTypeChecker.VisitAssignment(const Node: IAssignmentNode): IAstNode;
function TTypeChecker.VisitAssignment(const Node: IAstNode): IAstNode;
var
A: IAssignmentNode;
targetType, sourceType: IStaticType;
newIdent, newValue: IAstNode;
adr: TResolvedAddress;
identNode: IIdentifierNode;
begin
identNode := Node.Target.AsIdentifier;
newIdent := Accept(Node.Target);
A := Node.AsAssignment;
identNode := A.Target.AsIdentifier;
newIdent := Accept(A.Target);
targetType := newIdent.AsTypedNode.StaticType;
adr := identNode.Address;
if adr.Kind = akUnresolved then
begin
Accept(Node.Value);
Accept(A.Value);
Result := Node;
Exit;
end;
newValue := Accept(Node.Value);
newValue := Accept(A.Value);
sourceType := newValue.AsTypedNode.StaticType;
if (targetType.Kind <> stUnknown) and (sourceType.Kind <> stUnknown) then
@@ -378,27 +417,28 @@ begin
Result := TAst.Assign(Node.Identity, newIdent, newValue, targetType);
end;
function TTypeChecker.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
function TTypeChecker.VisitBlockExpression(const Node: IAstNode): IAstNode;
var
newBlock: IBlockExpressionNode;
blockType: IStaticType;
newExprs: TArray<IAstNode>;
i: Integer;
exprs: IExpressionList;
begin
SetLength(newExprs, Node.Expressions.Count);
for i := 0 to Node.Expressions.Count - 1 do
newExprs[i] := Accept(Node.Expressions[i]);
// Inherited logic transforms all expressions in the list
newBlock := inherited VisitBlockExpression(Node).AsBlockExpression;
exprs := newBlock.Expressions;
if Length(newExprs) > 0 then
blockType := newExprs[High(newExprs)].AsTypedNode.StaticType
if exprs.Count > 0 then
blockType := exprs[exprs.Count - 1].AsTypedNode.StaticType
else
blockType := TTypes.Void;
var exprList := TExpressionList.Create(newExprs, Node.Expressions.Identity);
Result := TAst.Block(Node.Identity, exprList, blockType);
// Return new block with calculated type
Result := TAst.Block(Node.Identity, exprs, blockType);
end;
function TTypeChecker.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
function TTypeChecker.VisitLambdaExpression(const Node: IAstNode): IAstNode;
var
L: ILambdaExpressionNode;
newParams: TArray<IIdentifierNode>;
newBody: IAstNode;
bodyType, methodType: IStaticType;
@@ -409,8 +449,10 @@ var
paramIdent: IIdentifierNode;
injectedType: IStaticType;
begin
L := Node.AsLambdaExpression;
// 1. Resolve Upvalue Types
var upvalueAddrs := Node.Upvalues;
var upvalueAddrs := L.Upvalues;
SetLength(upvalueTypes, Length(upvalueAddrs));
for i := 0 to High(upvalueAddrs) do
@@ -425,14 +467,14 @@ begin
end;
// 2. Enter New Scope
FCurrentContext := TTypeContext.Create(FCurrentContext, Node.Layout, upvalueTypes, nil);
FCurrentContext := TTypeContext.Create(FCurrentContext, L.Layout, upvalueTypes, nil);
try
SetLength(newParams, Node.Parameters.Count);
SetLength(paramTypes, Node.Parameters.Count);
SetLength(newParams, L.Parameters.Count);
SetLength(paramTypes, L.Parameters.Count);
for i := 0 to Node.Parameters.Count - 1 do
for i := 0 to L.Parameters.Count - 1 do
begin
paramIdent := Node.Parameters[i];
paramIdent := L.Parameters[i];
// Check if there is already a type assigned (e.g. injected by Pipe Visitor)
injectedType := paramIdent.AsTypedNode.StaticType;
@@ -448,52 +490,45 @@ begin
newParams[i] := TAst.Identifier(paramIdent.Identity.AsNamed, paramIdent.Address, paramTypes[i]);
end;
newBody := Accept(Node.Body);
newBody := Accept(L.Body);
bodyType := newBody.AsTypedNode.StaticType;
methodType := TTypes.CreateMethod(paramTypes, bodyType);
finalDescriptor := TScope.CreateDescriptor(Node.Layout, FCurrentContext.Types);
finalDescriptor := TScope.CreateDescriptor(L.Layout, FCurrentContext.Types);
finally
var temp := FCurrentContext;
FCurrentContext := FCurrentContext.FParent;
temp.Free;
end;
var paramList := TParameterList.Create(newParams, Node.Parameters.Identity);
var paramList := TParameterList.Create(newParams, L.Parameters.Identity);
Result :=
TAst.LambdaExpr(
Node.Identity,
paramList,
newBody,
Node.Layout,
finalDescriptor,
Node.Upvalues,
Node.HasNestedLambdas,
Node.IsPure,
methodType
);
TAst.LambdaExpr(Node.Identity, paramList, newBody, L.Layout, finalDescriptor, L.Upvalues, L.HasNestedLambdas, L.IsPure, methodType);
end;
function TTypeChecker.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
function TTypeChecker.VisitFunctionCall(const Node: IAstNode): IAstNode;
var
newCall: IFunctionCallNode;
calleeType, retType: IStaticType;
i, j: Integer;
newCallee: IAstNode;
newArgs: TArray<IAstNode>;
argTypes: TArray<IStaticType>;
hasUnknownArgs: Boolean;
bestSig: IMethodSignature;
match: Boolean;
begin
newCallee := Accept(Node.Callee);
SetLength(newArgs, Node.Arguments.Count);
SetLength(argTypes, Node.Arguments.Count);
// Use inherited to visit Callee and Arguments first
newCall := inherited VisitFunctionCall(Node).AsFunctionCall;
// Now analyze types on the transformed children
var newCallee := newCall.Callee;
var newArgs := newCall.Arguments;
SetLength(argTypes, newArgs.Count);
hasUnknownArgs := False;
for i := 0 to Node.Arguments.Count - 1 do
for i := 0 to newArgs.Count - 1 do
begin
newArgs[i] := Accept(Node.Arguments[i]);
argTypes[i] := newArgs[i].AsTypedNode.StaticType;
if argTypes[i].Kind = stUnknown then
hasUnknownArgs := True;
@@ -535,36 +570,35 @@ begin
if Assigned(FLog) then
FLog.AddError(Format('Cannot invoke type %s as a function.', [calleeType.ToString]), Node);
var argList := TArgumentList.Create(newArgs, Node.Arguments.Identity);
Result := TAst.FunctionCall(Node.Identity, newCallee, argList, retType, Node.IsTailCall, nil, False);
// Return new node with Types
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgs, retType, newCall.IsTailCall, nil, False);
end;
function TTypeChecker.VisitIfExpression(const Node: IIfExpressionNode): IAstNode;
function TTypeChecker.VisitIfExpression(const Node: IAstNode): IAstNode;
var
newCond, newThen, newElse: IAstNode;
newIf: IIfExpressionNode;
resType: IStaticType;
begin
newCond := Accept(Node.Condition);
newThen := Accept(Node.ThenBranch);
newElse := Accept(Node.ElseBranch);
newIf := inherited VisitIfExpression(Node).AsIfExpression;
// Simple promotion logic
if (newElse <> nil) then
resType := TTypeRules.Promote(newThen.AsTypedNode.StaticType, newElse.AsTypedNode.StaticType)
if (newIf.ElseBranch <> nil) then
resType := TTypeRules.Promote(newIf.ThenBranch.AsTypedNode.StaticType, newIf.ElseBranch.AsTypedNode.StaticType)
else
resType := TTypes.MakeOptional(newThen.AsTypedNode.StaticType);
resType := TTypes.MakeOptional(newIf.ThenBranch.AsTypedNode.StaticType);
Result := TAst.IfExpr(Node.Identity, newCond, newThen, newElse, resType);
Result := TAst.IfExpr(Node.Identity, newIf.Condition, newIf.ThenBranch, newIf.ElseBranch, resType);
end;
function TTypeChecker.VisitIndexer(const Node: IIndexerNode): IAstNode;
function TTypeChecker.VisitIndexer(const Node: IAstNode): IAstNode;
var
I: IIndexerNode;
newBase, newIndex: IAstNode;
baseType, elemType: IStaticType;
isOpt: Boolean;
begin
newBase := Accept(Node.Base);
newIndex := Accept(Node.Index);
I := Node.AsIndexer;
newBase := Accept(I.Base);
newIndex := Accept(I.Index);
baseType := PrepareBaseType(newBase, isOpt);
elemType := TTypes.Unknown;
@@ -577,20 +611,22 @@ begin
Result := TAst.Indexer(Node.Identity, newBase, newIndex, elemType);
end;
function TTypeChecker.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode;
function TTypeChecker.VisitMemberAccess(const Node: IAstNode): IAstNode;
var
M: IMemberAccessNode;
newBase: IAstNode;
baseType, resType: IStaticType;
idx: Integer;
isOpt: Boolean;
begin
newBase := Accept(Node.Base);
M := Node.AsMemberAccess;
newBase := Accept(M.Base);
baseType := PrepareBaseType(newBase, isOpt);
resType := TTypes.Unknown;
if (baseType.Kind = stRecord) or (baseType.Kind = stRecordSeries) then
begin
idx := baseType.Definition.IndexOf(Node.Member.Value);
idx := baseType.Definition.IndexOf(M.Member.Value);
if idx >= 0 then
begin
var fieldType := TTypes.FromScalarKind(baseType.Definition.Items[idx].Value);
@@ -604,45 +640,40 @@ begin
end;
resType := ApplyOptionality(resType, isOpt);
Result := TAst.MemberAccess(Node.Identity, newBase, Node.Member, resType);
Result := TAst.MemberAccess(Node.Identity, newBase, M.Member, resType);
end;
function TTypeChecker.VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode;
function TTypeChecker.VisitRecordLiteral(const Node: IAstNode): IAstNode;
var
R: IRecordLiteralNode;
i: Integer;
newFields: TArray<IRecordFieldNode>;
fieldTypes: TArray<TPair<IKeyword, IStaticType>>;
scalarFieldTypes: TArray<TPair<IKeyword, TScalar.TKind>>;
isScalar: Boolean;
valType: IStaticType;
key: IKeyword;
visitedValue: IAstNode;
newFieldList: IRecordFieldList;
begin
SetLength(newFields, Node.Fields.Count);
SetLength(fieldTypes, Node.Fields.Count);
SetLength(scalarFieldTypes, Node.Fields.Count);
R := Node.AsRecordLiteral;
// Transform fields using inherited recursion
newFieldList := inherited VisitRecordFieldList(R.Fields).AsRecordFieldList;
// Now analyze the transformed fields
var count := newFieldList.Count;
SetLength(fieldTypes, count);
SetLength(scalarFieldTypes, count);
isScalar := True;
for i := 0 to Node.Fields.Count - 1 do
for i := 0 to count - 1 do
begin
var oldField := Node.Fields[i];
visitedValue := Accept(oldField.Value);
// Keys are guaranteed to be keywords by parser
key := oldField.Key.Value;
// Recreate the field node with the typed value
newFields[i] := TAst.RecordField(oldField.Identity, oldField.Key, visitedValue);
// Analyze Type
valType := visitedValue.AsTypedNode.StaticType;
var field := newFieldList[i];
key := field.Key.Value;
valType := field.Value.AsTypedNode.StaticType;
// Check if strict scalar (no optionals allowed in packed ScalarRecord)
if (valType.Kind in [stOrdinal, stFloat, stBoolean, stDateTime, stKeyword]) and (not valType.IsOptional) then
begin
var kind: TScalar.TKind;
// Map StaticType Kind to Scalar Kind
case valType.Kind of
stOrdinal: kind := TScalar.TKind.Ordinal;
stFloat: kind := TScalar.TKind.Float;
@@ -650,7 +681,7 @@ begin
stDateTime: kind := TScalar.TKind.DateTime;
stKeyword: kind := TScalar.TKind.Keyword;
else
kind := TScalar.TKind.Ordinal; // Should not happen given check above
kind := TScalar.TKind.Ordinal;
end;
scalarFieldTypes[i] := TPair<IKeyword, TScalar.TKind>.Create(key, kind);
end
@@ -667,7 +698,7 @@ begin
var genericDef: IGenericRecordDefinition := nil;
var resultType: IStaticType;
if isScalar and (Length(newFields) > 0) then
if isScalar and (count > 0) then
begin
scalarDef := TKeywordMappingRegistry<TScalar.TKind>.Intern(scalarFieldTypes);
resultType := TTypes.CreateRecord(scalarDef);
@@ -678,16 +709,17 @@ begin
resultType := TTypes.CreateGenericRecord(genericDef);
end;
newFieldList := TRecordFieldList.Create(newFields, Node.Fields.Identity);
Result := TAst.RecordLiteral(Node.Identity, newFieldList, scalarDef, genericDef, resultType);
end;
function TTypeChecker.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode;
function TTypeChecker.VisitCreateSeries(const Node: IAstNode): IAstNode;
var
C: ICreateSeriesNode;
elemType: IStaticType;
def: string;
begin
def := Node.Definition;
C := Node.AsCreateSeries;
def := C.Definition;
// Simple heuristic for type
if def.StartsWith('[') then
elemType := TTypes.CreateRecord(nil) // Placeholder, normally parses JSON
@@ -697,12 +729,12 @@ begin
Result := TAst.CreateSeries(Node.Identity.AsDefinition, TTypes.CreateSeries(elemType));
end;
function TTypeChecker.VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode;
function TTypeChecker.VisitSeriesLength(const Node: IAstNode): IAstNode;
begin
Result := TAst.SeriesLength(Node.Identity, Accept(Node.Series).AsIdentifier, TTypes.Ordinal);
Result := TAst.SeriesLength(Node.Identity, Accept(Node.AsSeriesLength.Series).AsIdentifier, TTypes.Ordinal);
end;
function TTypeChecker.VisitNop(const Node: INopNode): IAstNode;
function TTypeChecker.VisitNop(const Node: IAstNode): IAstNode;
begin
Result := TAst.Nop(Node.Identity, TTypes.Void);
end;
@@ -711,14 +743,15 @@ end;
// PIPE IMPLEMENTATION (Type Checking)
// =============================================================================
function TTypeChecker.VisitPipeInput(const Node: IPipeInputNode): IAstNode;
function TTypeChecker.VisitPipeInput(const Node: IAstNode): IAstNode;
var
P: IPipeInputNode;
newSource: IIdentifierNode;
sourceType: IStaticType;
newSelectors: TArray<IKeywordNode>;
i: Integer;
begin
newSource := Accept(Node.StreamSource).AsIdentifier;
P := Node.AsPipeInput;
// Transform source identifier (resolves type)
newSource := Accept(P.StreamSource).AsIdentifier;
sourceType := newSource.AsTypedNode.StaticType;
// 1. Verify Source is a Series-compatible type
@@ -736,7 +769,7 @@ begin
begin
// 2. Verify Selectors exist in Record Definition
var def := sourceType.Definition;
for var sel in Node.Selectors do
for var sel in P.Selectors do
begin
if def.IndexOf(sel.Value) < 0 then
begin
@@ -747,16 +780,13 @@ begin
end;
end;
// Reconstruct list simply to pass through
SetLength(newSelectors, Node.Selectors.Count);
for i := 0 to Node.Selectors.Count - 1 do
newSelectors[i] := Node.Selectors[i];
Result := TAst.PipeInput(newSource, TAst.PipeSelectorList(newSelectors, Node.Selectors.Identity.Location), Node.Identity.Location);
// Reuse selectors (they are just keywords, no type checking needed)
Result := TAst.PipeInput(newSource, P.Selectors, Node.Identity.Location);
end;
function TTypeChecker.VisitPipe(const Node: IPipeNode): IAstNode;
function TTypeChecker.VisitPipe(const Node: IAstNode): IAstNode;
var
P: IPipeNode;
i, k: Integer;
inputNode: IPipeInputNode;
newInputs: TArray<IPipeInputNode>;
@@ -766,13 +796,15 @@ var
newParams: TArray<IIdentifierNode>;
inferredType: IStaticType;
begin
SetLength(newInputs, Node.Inputs.Count);
P := Node.AsPipe;
SetLength(newInputs, P.Inputs.Count);
paramTypes := TList<IStaticType>.Create;
try
// 1. Visit Inputs and collect types for Lambda parameters
for i := 0 to Node.Inputs.Count - 1 do
for i := 0 to P.Inputs.Count - 1 do
begin
inputNode := Accept(Node.Inputs[i]).AsPipeInput;
// Recurse on inputs to resolve their sources
inputNode := Accept(P.Inputs[i]).AsPipeInput;
newInputs[i] := inputNode;
streamType := inputNode.StreamSource.AsTypedNode.StaticType;
@@ -803,7 +835,7 @@ begin
end;
// 2. Prepare Lambda with Inferred Types
lambda := Node.Transformation;
lambda := P.Transformation;
if lambda.Parameters.Count <> paramTypes.Count then
begin
@@ -871,7 +903,7 @@ begin
pipeType := TTypes.Unknown;
end;
Result := TAst.Pipe(Node.Identity, TPipeInputList.Create(newInputs, Node.Inputs.Identity), typedLambda, pipeType);
Result := TAst.Pipe(Node.Identity, TPipeInputList.Create(newInputs, P.Inputs.Identity), typedLambda, pipeType);
finally
paramTypes.Free;
end;
Src/AST/Myc.Ast.Debugger.pas
+104 -284
View File
@@ -11,6 +11,7 @@ uses
Myc.Ast.Nodes,
Myc.Ast.Scope,
Myc.Ast,
Myc.Ast.Visitor,
Myc.Ast.Evaluator;
type
@@ -19,41 +20,25 @@ type
FLog: TStrings;
FIndentLevel: Integer;
FShowScope: Boolean;
procedure Indent;
procedure Unindent;
procedure AppendLine(const S: string);
procedure ShowScope;
function GetNodeLogInfo(const Node: IAstNode): string;
protected
// Overridden to provide the debug-specific visitor factory for nested calls (Lambdas).
function CreateVisitorFactory: TEvaluatorFactory; override;
// Central Interceptor for all node types
function Visit(const Node: IAstNode): TDataValue; override;
// Specific overrides for enhanced logging/state observation
function VisitVariableDeclaration(const N: IVariableDeclarationNode): TDataValue; override;
function VisitAssignment(const N: IAssignmentNode): TDataValue; override;
function VisitFunctionCall(const N: IFunctionCallNode): TDataValue; override;
function VisitLambdaExpression(const N: ILambdaExpressionNode): TDataValue; override;
public
constructor Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0);
// The logging overrides for Visit... methods
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
function VisitConstant(const Node: IConstantNode): TDataValue; override;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitKeyword(const Node: IKeywordNode): TDataValue; override;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
function VisitCondExpression(const Node: ICondExpressionNode): TDataValue; override; // Replaces Ternary
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
function VisitNop(const Node: INopNode): TDataValue; override;
// Pipe Support
function VisitPipeInput(const Node: IPipeInputNode): TDataValue; override;
function VisitPipeSelectorList(const Node: IPipeSelectorList): TDataValue; override;
function VisitPipeInputList(const Node: IPipeInputList): TDataValue; override;
function VisitPipe(const Node: IPipeNode): TDataValue; override;
end;
implementation
@@ -64,26 +49,21 @@ uses
{ TDebugEvaluatorVisitor }
constructor TDebugEvaluatorVisitor.Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0);
constructor TDebugEvaluatorVisitor.Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer);
begin
inherited Create(AScope);
Assert(Assigned(ALog));
FLog := ALog;
FIndentLevel := AInitialIndent;
FShowScope := AShowScope;
if FShowScope and (AInitialIndent = 0) then
ShowScope;
end;
function TDebugEvaluatorVisitor.CreateVisitorFactory: TEvaluatorFactory;
begin
// Return a closure that creates a new Debug visitor, ensuring the debug context (Log, Indent) is passed down.
// This is used by TEvaluatorVisitor.VisitLambdaExpression when executing the closure body.
// Capture current state
var currentLog := FLog;
var currentShowScope := FShowScope;
var currentIndent := FIndentLevel; // Pass current indent as base for new frame
var currentIndent := FIndentLevel;
Result :=
function(const AScope: IExecutionScope): IEvaluatorVisitor
begin
@@ -91,14 +71,98 @@ begin
end;
end;
procedure TDebugEvaluatorVisitor.Indent;
function TDebugEvaluatorVisitor.Visit(const Node: IAstNode): TDataValue;
var
info: string;
begin
inc(FIndentLevel);
info := GetNodeLogInfo(Node);
if info <> '' then
begin
AppendLine(info + ' {');
Indent;
end;
try
// Dispatch to inherited logic (which will call our specialized VisitXyz overrides)
Result := inherited Visit(Node);
finally
if info <> '' then
begin
Unindent;
var resStr :=
if Result.IsVoid then '(void)'
else Result.ToString;
AppendLine('} -> ' + resStr);
end;
end;
end;
// --- Enhanced Observation Overrides ---
function TDebugEvaluatorVisitor.VisitVariableDeclaration(const N: IVariableDeclarationNode): TDataValue;
begin
Result := inherited VisitVariableDeclaration(N);
if FShowScope then
ShowScope;
end;
function TDebugEvaluatorVisitor.VisitAssignment(const N: IAssignmentNode): TDataValue;
begin
Result := inherited VisitAssignment(N);
if FShowScope then
ShowScope;
end;
function TDebugEvaluatorVisitor.VisitFunctionCall(const N: IFunctionCallNode): TDataValue;
begin
// Log target purity if statically known
if Assigned(N.StaticTarget) and N.IsTargetPure then
AppendLine('[Pure Static Call]');
Result := inherited VisitFunctionCall(N);
end;
function TDebugEvaluatorVisitor.VisitLambdaExpression(const N: ILambdaExpressionNode): TDataValue;
begin
if Length(N.Upvalues) > 0 then
AppendLine(Format('[Capturing %d upvalues]', [Length(N.Upvalues)]));
Result := inherited VisitLambdaExpression(N);
end;
// --- Internal Helpers ---
function TDebugEvaluatorVisitor.GetNodeLogInfo(const Node: IAstNode): string;
begin
case Node.Kind of
akFunctionCall:
begin
var c := Node.AsFunctionCall;
var mode :=
if Assigned(c.StaticTarget) then 'STATIC'
else 'DYNAMIC';
Result := Format('Call (%s, Tail=%s)', [mode, c.IsTailCall.ToString(TUseBoolStrs.True)]);
end;
akIdentifier: Result := 'ID:' + Node.AsIdentifier.Name;
akVariableDeclaration: Result := 'DEF:' + Node.AsVariableDeclaration.Target.AsIdentifier.Name;
akAssignment: Result := 'ASSIGN:' + Node.AsAssignment.Target.AsIdentifier.Name;
akIfExpression: Result := 'IF';
akCondExpression: Result := 'COND';
akRecur: Result := 'RECUR';
akBlockExpression: Result := 'BLOCK';
akLambdaExpression: Result := 'FN';
akRecordLiteral: Result := 'RECORD';
akPipe: Result := 'PIPE';
else
Result := ''; // Silence leaf nodes like Constants and Keywords to reduce noise
end;
end;
procedure TDebugEvaluatorVisitor.Indent;
begin
Inc(FIndentLevel);
end;
procedure TDebugEvaluatorVisitor.Unindent;
begin
dec(FIndentLevel);
Dec(FIndentLevel);
end;
procedure TDebugEvaluatorVisitor.AppendLine(const S: string);
@@ -114,255 +178,11 @@ end;
procedure TDebugEvaluatorVisitor.ShowScope;
var
scopeDump: TArray<string>;
line: string;
begin
if FShowScope then
begin
AppendLine('-- Scope --');
// Scope.Dump logic has been updated in Myc.Ast.Scope to handle new architecture
scopeDump := Scope.Dump.Split([sLineBreak]);
for line in scopeDump do
begin
AppendLine(line);
end;
AppendLine('-----------');
end;
end;
// --- Visit Overrides ---
function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
mode: string;
begin
if Assigned(Node.StaticTarget) then
mode := 'STATIC'
else
mode := 'DYNAMIC';
AppendLine(Format('FunctionCall (%s, Tail=%s) {', [mode, Node.IsTailCall.ToString(TUseBoolStrs.True)]));
Indent;
try
// ShowScope is called in Constructor of new Visitor (via CreateVisitorFactory) for the body,
// but for arguments evaluation here in the current scope, we might want to see it.
ShowScope;
Result := inherited VisitFunctionCall(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
AppendLine('AddSeriesItem {');
Indent;
try
Result := inherited VisitAddSeriesItem(Node);
finally
Unindent;
end;
AppendLine('} -> (void)');
end;
function TDebugEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
AppendLine(Format('Assignment to "%s" {', [Node.Target.AsIdentifier.Name]));
Indent;
try
Result := inherited VisitAssignment(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
begin
Result := inherited VisitConstant(Node);
AppendLine(Format('Constant (%s)', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitKeyword(const Node: IKeywordNode): TDataValue;
begin
Result := inherited VisitKeyword(Node);
AppendLine(Format('Keyword (%s)', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
AppendLine('CreateSeries {');
Indent;
try
Result := inherited VisitCreateSeries(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
Result := inherited VisitIdentifier(Node);
AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
AppendLine('IfExpr {');
Indent;
try
Result := inherited VisitIfExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
AppendLine('Indexer {');
Indent;
try
Result := inherited VisitIndexer(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
AppendLine(Format('MemberAccess (Member: %s) {', [Node.Member.Value.Name]));
Indent;
try
Result := inherited VisitMemberAccess(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
begin
AppendLine('RecordLiteral {');
Indent;
try
Result := inherited VisitRecordLiteral(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitCondExpression(const Node: ICondExpressionNode): TDataValue;
begin
AppendLine(Format('CondExpr (%d pairs) {', [Length(Node.Pairs)]));
Indent;
try
// We just call inherited, which does the logic.
// We don't log every branch check here to avoid spamming output,
// but the recursive evaluation of conditions will show up in the log naturally.
Result := inherited VisitCondExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
begin
AppendLine('Block {');
Indent;
try
// Delegates to VisitExpressionList via inherited
Result := inherited VisitBlockExpression(Node);
// Scope might have changed after block execution if vars were defined
ShowScope;
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
AppendLine(Format('VarDecl %s :=', [Node.Target.AsIdentifier.Name]));
Indent;
try
Result := inherited VisitVariableDeclaration(Node);
finally
Unindent;
end;
end;
function TDebugEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
AppendLine('SeriesLength {');
Indent;
try
Result := inherited VisitSeriesLength(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitNop(const Node: INopNode): TDataValue;
begin
AppendLine('Nop (void)');
Result := TDataValue.Void;
end;
// --- Pipe Support ---
function TDebugEvaluatorVisitor.VisitPipe(const Node: IPipeNode): TDataValue;
begin
AppendLine('Pipe {');
Indent;
try
Result := inherited VisitPipe(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitPipeInput(const Node: IPipeInputNode): TDataValue;
begin
AppendLine(Format('PipeInput (Source: %s) {', [Node.StreamSource.Name]));
Indent;
try
Result := inherited VisitPipeInput(Node);
finally
Unindent;
end;
AppendLine('}');
end;
function TDebugEvaluatorVisitor.VisitPipeSelectorList(const Node: IPipeSelectorList): TDataValue;
begin
AppendLine('Selectors [');
Indent;
try
Result := inherited VisitPipeSelectorList(Node);
finally
Unindent;
end;
AppendLine(']');
end;
function TDebugEvaluatorVisitor.VisitPipeInputList(const Node: IPipeInputList): TDataValue;
begin
AppendLine('Inputs [');
Indent;
try
Result := inherited VisitPipeInputList(Node);
finally
Unindent;
end;
AppendLine(']');
AppendLine(' [Scope State]');
for line in Scope.Dump.Split([sLineBreak]) do
AppendLine(' ' + line);
end;
end.
Src/AST/Myc.Ast.Dumper.pas
+306 -230
View File
@@ -29,38 +29,47 @@ type
procedure LogFmt(const Fmt: string; const Args: array of const; const Node: IAstNode = nil); overload;
function FormatAddress(const Addr: TResolvedAddress): string;
protected
function VisitConstant(const Node: IConstantNode): TVoid; override;
function VisitIdentifier(const Node: IIdentifierNode): TVoid; override;
function VisitKeyword(const Node: IKeywordNode): TVoid; override;
function VisitIfExpression(const Node: IIfExpressionNode): TVoid; override;
function VisitCondExpression(const Node: ICondExpressionNode): TVoid; override; // Replaced Ternary
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TVoid; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TVoid; override;
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TVoid; override;
function VisitRecurNode(const Node: IRecurNode): TVoid; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TVoid; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TVoid; override;
function VisitAssignment(const Node: IAssignmentNode): TVoid; override;
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TVoid; override;
function VisitQuasiquote(const Node: IQuasiquoteNode): TVoid; override;
function VisitUnquote(const Node: IUnquoteNode): TVoid; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TVoid; override;
function VisitIndexer(const Node: IIndexerNode): TVoid; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TVoid; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): TVoid; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TVoid; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TVoid; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TVoid; override;
function VisitNop(const Node: INopNode): TVoid; override;
strict private
// Internal visit helpers with strict IAstNode signature
function VisitConstant(const Node: IAstNode): TVoid;
function VisitIdentifier(const Node: IAstNode): TVoid;
function VisitKeyword(const Node: IAstNode): TVoid;
function VisitIfExpression(const Node: IAstNode): TVoid;
function VisitCondExpression(const Node: IAstNode): TVoid;
function VisitLambdaExpression(const Node: IAstNode): TVoid;
function VisitFunctionCall(const Node: IAstNode): TVoid;
function VisitMacroExpansionNode(const Node: IAstNode): TVoid;
function VisitRecurNode(const Node: IAstNode): TVoid;
function VisitBlockExpression(const Node: IAstNode): TVoid;
function VisitVariableDeclaration(const Node: IAstNode): TVoid;
function VisitAssignment(const Node: IAstNode): TVoid;
function VisitMacroDefinition(const Node: IAstNode): TVoid;
function VisitQuasiquote(const Node: IAstNode): TVoid;
function VisitUnquote(const Node: IAstNode): TVoid;
function VisitUnquoteSplicing(const Node: IAstNode): TVoid;
function VisitIndexer(const Node: IAstNode): TVoid;
function VisitMemberAccess(const Node: IAstNode): TVoid;
function VisitRecordLiteral(const Node: IAstNode): TVoid;
function VisitCreateSeries(const Node: IAstNode): TVoid;
function VisitAddSeriesItem(const Node: IAstNode): TVoid;
function VisitSeriesLength(const Node: IAstNode): TVoid;
function VisitNop(const Node: IAstNode): TVoid;
// List Visitors are handled implicitly by parent node iteration in Dumper,
// but we implement them empty/default to satisfy the abstract base class if called directly.
function VisitParameterList(const Node: IParameterList): TVoid; override;
function VisitArgumentList(const Node: IArgumentList): TVoid; override;
function VisitExpressionList(const Node: IExpressionList): TVoid; override;
function VisitRecordFieldList(const Node: IRecordFieldList): TVoid; override;
function VisitRecordField(const Node: IRecordFieldNode): TVoid; override;
// List Visitors
function VisitParameterList(const Node: IAstNode): TVoid;
function VisitArgumentList(const Node: IAstNode): TVoid;
function VisitExpressionList(const Node: IAstNode): TVoid;
function VisitRecordFieldList(const Node: IAstNode): TVoid;
function VisitRecordField(const Node: IAstNode): TVoid;
// Pipe Visitors
function VisitPipeInput(const Node: IAstNode): TVoid;
function VisitPipeSelectorList(const Node: IAstNode): TVoid;
function VisitPipeInputList(const Node: IAstNode): TVoid;
function VisitPipe(const Node: IAstNode): TVoid;
protected
procedure SetupHandlers; override;
public
constructor Create(const AOutput: TStrings);
@@ -81,7 +90,9 @@ var
dumper: TAstDumper;
begin
if (not Assigned(Output)) or (not Assigned(RootNode)) then
begin
exit;
end;
Output.Clear;
dumper := TAstDumper.Create(Output);
@@ -99,10 +110,51 @@ begin
FIndent := 0;
end;
procedure TAstDumper.SetupHandlers;
begin
Register(akConstant, VisitConstant);
Register(akIdentifier, VisitIdentifier);
Register(akKeyword, VisitKeyword);
Register(akParameterList, VisitParameterList);
Register(akArgumentList, VisitArgumentList);
Register(akExpressionList, VisitExpressionList);
Register(akRecordFieldList, VisitRecordFieldList);
Register(akRecordField, VisitRecordField);
Register(akIfExpression, VisitIfExpression);
Register(akCondExpression, VisitCondExpression);
Register(akLambdaExpression, VisitLambdaExpression);
Register(akFunctionCall, VisitFunctionCall);
Register(akMacroExpansion, VisitMacroExpansionNode);
Register(akBlockExpression, VisitBlockExpression);
Register(akVariableDeclaration, VisitVariableDeclaration);
Register(akAssignment, VisitAssignment);
Register(akMacroDefinition, VisitMacroDefinition);
Register(akQuasiquote, VisitQuasiquote);
Register(akUnquote, VisitUnquote);
Register(akUnquoteSplicing, VisitUnquoteSplicing);
Register(akIndexer, VisitIndexer);
Register(akMemberAccess, VisitMemberAccess);
Register(akRecordLiteral, VisitRecordLiteral);
Register(akCreateSeries, VisitCreateSeries);
Register(akAddSeriesItem, VisitAddSeriesItem);
Register(akSeriesLength, VisitSeriesLength);
Register(akRecur, VisitRecurNode);
Register(akNop, VisitNop);
Register(akPipeInput, VisitPipeInput);
Register(akPipeSelectorList, VisitPipeSelectorList);
Register(akPipeInputList, VisitPipeInputList);
Register(akPipe, VisitPipe);
end;
procedure TAstDumper.Execute(const RootNode: IAstNode);
begin
if Assigned(RootNode) then
RootNode.Accept(Self);
begin
Visit(RootNode);
end;
end;
procedure TAstDumper.Indent;
@@ -115,26 +167,28 @@ begin
dec(FIndent, 2);
end;
procedure TAstDumper.Log(const Text: string; const Node: IAstNode = nil);
procedure TAstDumper.Log(const Text: string; const Node: IAstNode);
var
typeStr: string;
typedNode: IAstTypedNode;
staticType: IStaticType;
begin
typeStr := '';
if Assigned(Node) and Node.IsTyped then
begin
typedNode := Node.AsTypedNode;
staticType := typedNode.StaticType;
staticType := Node.AsTypedNode.StaticType;
if Assigned(staticType) then
typeStr := Format(' <Type: %s>', [staticType.ToString])
begin
typeStr := Format(' <Type: %s>', [staticType.ToString]);
end
else
begin
typeStr := ' <Type: nil>';
end;
end;
FOutput.Add(StringOfChar(' ', FIndent) + Text + typeStr);
end;
procedure TAstDumper.LogFmt(const Fmt: string; const Args: array of const; const Node: IAstNode = nil);
procedure TAstDumper.LogFmt(const Fmt: string; const Args: array of const; const Node: IAstNode);
begin
Log(Format(Fmt, Args), Node);
end;
@@ -150,402 +204,424 @@ begin
end;
end;
function TAstDumper.VisitConstant(const Node: IConstantNode): TVoid;
function TAstDumper.VisitConstant(const Node: IAstNode): TVoid;
begin
LogFmt('Constant: %s', [Node.Value.ToString], Node);
LogFmt('Constant: %s', [Node.AsConstant.Value.ToString], Node);
end;
function TAstDumper.VisitIdentifier(const Node: IIdentifierNode): TVoid;
function TAstDumper.VisitIdentifier(const Node: IAstNode): TVoid;
var
adr: TResolvedAddress;
I: IIdentifierNode;
begin
adr := Node.Address;
if adr.Kind <> akUnresolved then
LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress(adr)], Node)
I := Node.AsIdentifier;
if I.Address.Kind <> akUnresolved then
begin
LogFmt('Identifier: %s -> %s', [I.Name, FormatAddress(I.Address)], Node);
end
else
LogFmt('Identifier: %s (unbound)', [Node.Name], Node);
begin
LogFmt('Identifier: %s (unbound)', [I.Name], Node);
end;
end;
function TAstDumper.VisitKeyword(const Node: IKeywordNode): TVoid;
function TAstDumper.VisitKeyword(const Node: IAstNode): TVoid;
begin
LogFmt('Keyword: :%s', [Node.Value.Name], Node);
LogFmt('Keyword: :%s', [Node.AsKeyword.Value.Name], Node);
end;
function TAstDumper.VisitIfExpression(const Node: IIfExpressionNode): TVoid;
function TAstDumper.VisitIfExpression(const Node: IAstNode): TVoid;
var
E: IIfExpressionNode;
begin
E := Node.AsIfExpression;
Log('IfExpression', Node);
Indent;
Log('Condition:');
Node.Condition.Accept(Self);
Visit(E.Condition);
Log('Then:');
Node.ThenBranch.Accept(Self);
if Assigned(Node.ElseBranch) then
Visit(E.ThenBranch);
if Assigned(E.ElseBranch) then
begin
Log('Else:');
Node.ElseBranch.Accept(Self);
Visit(E.ElseBranch);
end;
Unindent;
end;
function TAstDumper.VisitCondExpression(const Node: ICondExpressionNode): TVoid;
function TAstDumper.VisitCondExpression(const Node: IAstNode): TVoid;
var
E: ICondExpressionNode;
i: Integer;
begin
LogFmt('CondExpression (%d pairs)', [Length(Node.Pairs)], Node);
E := Node.AsCondExpression;
LogFmt('CondExpression (%d pairs)', [Length(E.Pairs)], Node);
Indent;
for i := 0 to High(Node.Pairs) do
for i := 0 to High(E.Pairs) do
begin
LogFmt('Pair %d:', [i]);
Indent;
Log('Condition:');
Node.Pairs[i].Condition.Accept(Self);
Visit(E.Pairs[i].Condition);
Log('Branch:');
Node.Pairs[i].Branch.Accept(Self);
Visit(E.Pairs[i].Branch);
Unindent;
end;
Log('Else:');
Node.ElseBranch.Accept(Self);
Visit(E.ElseBranch);
Unindent;
end;
function TAstDumper.VisitLambdaExpression(const Node: ILambdaExpressionNode): TVoid;
function TAstDumper.VisitLambdaExpression(const Node: IAstNode): TVoid;
var
upvalueAddr: TResolvedAddress;
E: ILambdaExpressionNode;
addr: TResolvedAddress;
symbols: TArray<string>;
layout: IScopeLayout;
slot: Integer;
typ: IStaticType;
begin
E := Node.AsLambdaExpression;
LogFmt(
'LambdaExpression (HasNested: %s, IsPure: %s)',
[Node.HasNestedLambdas.ToString(TUseBoolStrs.True), BoolToStr(Node.IsPure, True)],
[E.HasNestedLambdas.ToString(TUseBoolStrs.True), E.IsPure.ToString(TUseBoolStrs.True)],
Node
);
Indent;
// 1. Layout & Symbols
if Assigned(Node.Layout) then
if Assigned(E.Layout) then
begin
LogFmt('Scope: Layout Slots=%d', [Node.Layout.SlotCount]);
if Assigned(Node.Descriptor) then
LogFmt('Scope: Layout Slots=%d', [E.Layout.SlotCount]);
if Assigned(E.Descriptor) then
begin
Log('Symbol Table:');
Indent;
layout := Node.Layout;
layout := E.Layout;
symbols := layout.GetSymbols;
TArray.Sort<string>(symbols);
for var name in symbols do
begin
slot := layout.FindSlot(name);
typ := Node.Descriptor.GetSymbolType(slot);
typ := E.Descriptor.GetSymbolType(slot);
LogFmt('"%s" -> Slot %d (Type: %s)', [name, slot, typ.ToString]);
end;
Unindent;
end;
end
else
Log('Scope: No Layout (Raw)');
end;
// 3. Parameters
Log('Parameters:');
Indent;
// Iterate over IParameterList
for var param in Node.Parameters do
param.Accept(Self);
Visit(E.Parameters);
Unindent;
// 4. Upvalues
if Length(Node.Upvalues) > 0 then
if Length(E.Upvalues) > 0 then
begin
LogFmt('Captured Upvalues (%d):', [Length(Node.Upvalues)]);
LogFmt('Captured Upvalues (%d):', [Length(E.Upvalues)]);
Indent;
for upvalueAddr in Node.Upvalues do
Log(FormatAddress(upvalueAddr));
for addr in E.Upvalues do
begin
Log(FormatAddress(addr));
end;
Unindent;
end;
// 5. Body
Log('Body:');
Node.Body.Accept(Self);
Visit(E.Body);
Unindent;
end;
function TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode): TVoid;
function TAstDumper.VisitFunctionCall(const Node: IAstNode): TVoid;
var
arg: IAstNode;
staticStatus: string;
sigStr: string;
C: IFunctionCallNode;
argTypes: TArray<string>;
i: Integer;
begin
sigStr := '';
// Note: Node.Arguments is IArgumentList now.
if Assigned(Node.StaticTarget) then
begin
staticStatus := 'Assigned';
SetLength(argTypes, Node.Arguments.Count);
for i := 0 to Node.Arguments.Count - 1 do
begin
if Node.Arguments[i].IsTyped then
argTypes[i] := Node.Arguments[i].AsTypedNode.StaticType.ToString
else
argTypes[i] := 'Untyped';
end;
sigStr := Format(' <ResolvedSig: Method(%s): %s>', [string.Join(', ', argTypes), Node.StaticType.ToString]);
end
else
staticStatus := 'nil';
C := Node.AsFunctionCall;
LogFmt(
'FunctionCall (IsTailCall: %s, StaticTarget: %s%s, IsTargetPure: %s)',
[Node.IsTailCall.ToString(TUseBoolStrs.True), staticStatus, sigStr, BoolToStr(Node.IsTargetPure, True)],
'FunctionCall (IsTailCall: %s, StaticTarget: %s, IsTargetPure: %s)',
[
C.IsTailCall.ToString(TUseBoolStrs.True),
Assigned(C.StaticTarget).ToString(TUseBoolStrs.True),
C.IsTargetPure.ToString(TUseBoolStrs.True)
],
Node
);
if Assigned(C.StaticTarget) then
begin
Indent;
SetLength(argTypes, C.Arguments.Count);
for i := 0 to C.Arguments.Count - 1 do
begin
if C.Arguments[i].IsTyped then
argTypes[i] := C.Arguments[i].AsTypedNode.StaticType.ToString
else
argTypes[i] := 'Untyped';
end;
LogFmt('ResolvedSig: Method(%s): %s', [string.Join(', ', argTypes), C.StaticType.ToString]);
Unindent;
end;
Indent;
Log('Callee:');
Node.Callee.Accept(Self);
LogFmt('Arguments (%d):', [Node.Arguments.Count]);
Indent;
// Iterate over IArgumentList
for arg in Node.Arguments do
arg.Accept(Self);
Unindent;
Visit(C.Callee);
LogFmt('Arguments (%d):', [C.Arguments.Count]);
Visit(C.Arguments);
Unindent;
end;
function TAstDumper.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TVoid;
function TAstDumper.VisitMacroExpansionNode(const Node: IAstNode): TVoid;
var
arg: IAstNode;
M: IMacroExpansionNode;
begin
M := Node.AsMacroExpansion;
Log('MacroExpansion', Node);
Indent;
Log('Original Call:');
Indent;
Log('Callee:');
Node.CallNode.Callee.Accept(Self);
LogFmt('Arguments (%d):', [Node.CallNode.Arguments.Count]);
Indent;
for arg in Node.CallNode.Arguments do
arg.Accept(Self);
Unindent;
Unindent;
Visit(M.CallNode);
Log('Expanded Body:');
Indent;
Node.ExpandedBody.Accept(Self);
Unindent;
Visit(M.ExpandedBody);
Unindent;
end;
function TAstDumper.VisitRecurNode(const Node: IRecurNode): TVoid;
var
arg: IAstNode;
function TAstDumper.VisitRecurNode(const Node: IAstNode): TVoid;
begin
Log('Recur', Node);
Indent;
LogFmt('Arguments (%d):', [Node.Arguments.Count]);
Indent;
for arg in Node.Arguments do
arg.Accept(Self);
Unindent;
Visit(Node.AsRecur.Arguments);
Unindent;
end;
function TAstDumper.VisitBlockExpression(const Node: IBlockExpressionNode): TVoid;
var
expr: IAstNode;
function TAstDumper.VisitBlockExpression(const Node: IAstNode): TVoid;
begin
Log('BlockExpression', Node);
Indent;
for expr in Node.Expressions do
expr.Accept(Self);
Visit(Node.AsBlockExpression.Expressions);
Unindent;
end;
function TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TVoid;
function TAstDumper.VisitVariableDeclaration(const Node: IAstNode): TVoid;
var
V: IVariableDeclarationNode;
begin
LogFmt('VariableDeclaration (IsBoxed: %s)', [Node.IsBoxed.ToString(TUseBoolStrs.True)], Node);
V := Node.AsVariableDeclaration;
LogFmt('VariableDeclaration (IsBoxed: %s)', [V.IsBoxed.ToString(TUseBoolStrs.True)], Node);
Indent;
Node.Target.Accept(Self);
if Assigned(Node.Initializer) then
Visit(V.Target);
if Assigned(V.Initializer) then
begin
Log('Initializer:');
Node.Initializer.Accept(Self);
Visit(V.Initializer);
end;
Unindent;
end;
function TAstDumper.VisitAssignment(const Node: IAssignmentNode): TVoid;
function TAstDumper.VisitAssignment(const Node: IAstNode): TVoid;
var
A: IAssignmentNode;
begin
A := Node.AsAssignment;
Log('Assignment', Node);
Indent;
Node.Target.Accept(Self);
Visit(A.Target);
Log('Value:');
Node.Value.Accept(Self);
Visit(A.Value);
Unindent;
end;
function TAstDumper.VisitMacroDefinition(const Node: IMacroDefinitionNode): TVoid;
function TAstDumper.VisitMacroDefinition(const Node: IAstNode): TVoid;
var
M: IMacroDefinitionNode;
begin
M := Node.AsMacroDefinition;
Log('MacroDefinition', Node);
Indent;
Log('Name:');
Indent;
Node.Name.Accept(Self);
Unindent;
Visit(M.Name);
Log('Parameters:');
Indent;
for var param in Node.Parameters do
param.Accept(Self);
Unindent;
Visit(M.Parameters);
Log('Body:');
Indent;
Node.Body.Accept(Self);
Unindent;
Visit(M.Body);
Unindent;
end;
function TAstDumper.VisitQuasiquote(const Node: IQuasiquoteNode): TVoid;
function TAstDumper.VisitQuasiquote(const Node: IAstNode): TVoid;
begin
Log('Quasiquote', Node);
Indent;
Node.Expression.Accept(Self);
Visit(Node.AsQuasiquote.Expression);
Unindent;
end;
function TAstDumper.VisitUnquote(const Node: IUnquoteNode): TVoid;
function TAstDumper.VisitUnquote(const Node: IAstNode): TVoid;
begin
Log('Unquote', Node);
Indent;
Node.Expression.Accept(Self);
Visit(Node.AsUnquote.Expression);
Unindent;
end;
function TAstDumper.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TVoid;
function TAstDumper.VisitUnquoteSplicing(const Node: IAstNode): TVoid;
begin
Log('UnquoteSplicing', Node);
Indent;
Node.Expression.Accept(Self);
Visit(Node.AsUnquoteSplicing.Expression);
Unindent;
end;
function TAstDumper.VisitIndexer(const Node: IIndexerNode): TVoid;
function TAstDumper.VisitIndexer(const Node: IAstNode): TVoid;
var
I: IIndexerNode;
begin
I := Node.AsIndexer;
Log('Indexer', Node);
Indent;
Log('Base:');
Node.Base.Accept(Self);
Visit(I.Base);
Log('Index:');
Node.Index.Accept(Self);
Visit(I.Index);
Unindent;
end;
function TAstDumper.VisitMemberAccess(const Node: IMemberAccessNode): TVoid;
function TAstDumper.VisitMemberAccess(const Node: IAstNode): TVoid;
var
M: IMemberAccessNode;
begin
M := Node.AsMemberAccess;
Log('MemberAccess', Node);
Indent;
Log('Base:');
Node.Base.Accept(Self);
Visit(M.Base);
Log('Member:');
Node.Member.Accept(Self);
Visit(M.Member);
Unindent;
end;
function TAstDumper.VisitRecordLiteral(const Node: IRecordLiteralNode): TVoid;
function TAstDumper.VisitRecordLiteral(const Node: IAstNode): TVoid;
var
field: IRecordFieldNode;
R: IRecordLiteralNode;
begin
LogFmt('RecordLiteral (%d fields)', [Node.Fields.Count], Node);
R := Node.AsRecordLiteral;
LogFmt('RecordLiteral (%d fields)', [R.Fields.Count], Node);
Indent;
// Iterate over IRecordFieldList
for field in Node.Fields do
begin
LogFmt('Field :%s', [field.Key.Value.Name]);
Indent;
field.Value.Accept(Self);
Unindent;
end;
Visit(R.Fields);
Unindent;
end;
function TAstDumper.VisitCreateSeries(const Node: ICreateSeriesNode): TVoid;
function TAstDumper.VisitCreateSeries(const Node: IAstNode): TVoid;
begin
LogFmt('CreateSeries: %s', [Node.Definition], Node);
LogFmt('CreateSeries: %s', [Node.AsCreateSeries.Definition], Node);
end;
function TAstDumper.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TVoid;
function TAstDumper.VisitAddSeriesItem(const Node: IAstNode): TVoid;
var
A: IAddSeriesItemNode;
begin
A := Node.AsAddSeriesItem;
Log('AddSeriesItem', Node);
Indent;
Log('Series:');
Node.Series.Accept(Self);
Visit(A.Series);
Log('Value:');
Node.Value.Accept(Self);
if Assigned(Node.Lookback) then
Visit(A.Value);
if Assigned(A.Lookback) then
begin
Log('Lookback:');
Node.Lookback.Accept(Self);
Visit(A.Lookback);
end;
Unindent;
end;
function TAstDumper.VisitSeriesLength(const Node: ISeriesLengthNode): TVoid;
function TAstDumper.VisitSeriesLength(const Node: IAstNode): TVoid;
begin
Log('SeriesLength', Node);
Indent;
Log('Series:');
Node.Series.Accept(Self);
Visit(Node.AsSeriesLength.Series);
Unindent;
end;
function TAstDumper.VisitNop(const Node: INopNode): TVoid;
function TAstDumper.VisitNop(const Node: IAstNode): TVoid;
begin
Log('Nop', Node);
end;
// --- List Visitors Implementation ---
{ List Visitors }
function TAstDumper.VisitParameterList(const Node: IParameterList): TVoid;
function TAstDumper.VisitParameterList(const Node: IAstNode): TVoid;
begin
// Usually handled by Parent Node iteration (Lambda),
// but if visited directly:
for var item in Node do
item.Accept(Self);
for var item in Node.AsParameterList do
Visit(item);
end;
function TAstDumper.VisitArgumentList(const Node: IArgumentList): TVoid;
function TAstDumper.VisitArgumentList(const Node: IAstNode): TVoid;
begin
for var item in Node do
item.Accept(Self);
end;
function TAstDumper.VisitExpressionList(const Node: IExpressionList): TVoid;
begin
for var item in Node do
item.Accept(Self);
end;
function TAstDumper.VisitRecordFieldList(const Node: IRecordFieldList): TVoid;
begin
for var item in Node do
item.Accept(Self);
end;
function TAstDumper.VisitRecordField(const Node: IRecordFieldNode): TVoid;
begin
// If visited directly (e.g. inside a list)
LogFmt('Field :%s', [Node.Key.Value.Name]);
Indent;
Node.Value.Accept(Self);
for var item in Node.AsArgumentList do
Visit(item);
Unindent;
end;
function TAstDumper.VisitExpressionList(const Node: IAstNode): TVoid;
begin
for var item in Node.AsExpressionList do
Visit(item);
end;
function TAstDumper.VisitRecordFieldList(const Node: IAstNode): TVoid;
begin
for var item in Node.AsRecordFieldList do
Visit(item);
end;
function TAstDumper.VisitRecordField(const Node: IAstNode): TVoid;
var
F: IRecordFieldNode;
begin
F := Node.AsRecordField;
LogFmt('Field :%s', [F.Key.Value.Name]);
Indent;
Visit(F.Value);
Unindent;
end;
{ Pipe Visitors }
function TAstDumper.VisitPipeInput(const Node: IAstNode): TVoid;
var
P: IPipeInputNode;
begin
P := Node.AsPipeInput;
Log('PipeInput', Node);
Indent;
Log('Source:');
Visit(P.StreamSource);
Log('Selectors:');
Visit(P.Selectors);
Unindent;
end;
function TAstDumper.VisitPipeSelectorList(const Node: IAstNode): TVoid;
begin
for var item in Node.AsPipeSelectorList do
Visit(item);
end;
function TAstDumper.VisitPipeInputList(const Node: IAstNode): TVoid;
begin
for var item in Node.AsPipeInputList do
Visit(item);
end;
function TAstDumper.VisitPipe(const Node: IAstNode): TVoid;
var
P: IPipeNode;
begin
P := Node.AsPipe;
Log('Pipe', Node);
Indent;
Log('Inputs:');
Visit(P.Inputs);
Log('Transformation:');
Visit(P.Transformation);
Unindent;
end;
Src/AST/Myc.Ast.Evaluator.pas
+306 -530
View File
File diff suppressed because it is too large Load Diff
Src/AST/Myc.Ast.JSON.pas
+542 -479
View File
File diff suppressed because it is too large Load Diff
Src/AST/Myc.Ast.Nodes.pas
+4
View File
@@ -1715,6 +1715,10 @@ constructor TLambdaExpressionNode.Create(
);
begin
inherited Create(AStaticType, AIdentity);
Assert(Assigned(AParameters));
Assert(Assigned(ABody));
FParameters := AParameters;
FBody := ABody;
FLayout := ALayout;
Src/AST/Myc.Ast.Refactoring.Remove.pas
+179 -196
View File
@@ -13,47 +13,39 @@ uses
type
// Removes a specific node from the AST.
// - If the node is part of a list, it is removed from the list.
// - If the node is a mandatory child of a structure (e.g. If-Condition),
// it is replaced by a Nop node to maintain tree integrity.
TAstNodeRemover = class(TAstTransformer)
private
FTarget: IAstNode;
FRemoved: Boolean;
// Generic helper to filter nil items from lists during transformation
function FilterList<T: IAstNode>(const Source: INodeList<T>): TArray<T>;
// Helper to ensure a mandatory slot is never nil (replaces with Nop)
function EnsureNode(const Node: IAstNode; const ContextNode: IAstNode): IAstNode;
strict private
// List Containers (Filter Logic)
function VisitBlockExpression(const Node: IAstNode): IAstNode;
function VisitExpressionList(const Node: IAstNode): IAstNode;
function VisitArgumentList(const Node: IAstNode): IAstNode;
function VisitParameterList(const Node: IAstNode): IAstNode;
function VisitRecordFieldList(const Node: IAstNode): IAstNode;
// Structural Nodes (Replace Logic)
function VisitIfExpression(const Node: IAstNode): IAstNode;
function VisitCondExpression(const Node: IAstNode): IAstNode;
function VisitAssignment(const Node: IAstNode): IAstNode;
function VisitVariableDeclaration(const Node: IAstNode): IAstNode;
function VisitLambdaExpression(const Node: IAstNode): IAstNode;
function VisitFunctionCall(const Node: IAstNode): IAstNode;
function VisitIndexer(const Node: IAstNode): IAstNode;
function VisitMemberAccess(const Node: IAstNode): IAstNode;
function VisitAddSeriesItem(const Node: IAstNode): IAstNode;
protected
procedure SetupHandlers; override;
function Accept(const Node: IAstNode): IAstNode; override;
// --- List Containers (Filter Logic) ---
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
function VisitExpressionList(const Node: IExpressionList): IAstNode; override;
function VisitArgumentList(const Node: IArgumentList): IAstNode; override;
function VisitParameterList(const Node: IParameterList): IAstNode; override;
function VisitRecordFieldList(const Node: IRecordFieldList): IAstNode; override;
// --- Structural Nodes (Replace Logic) ---
function VisitIfExpression(const Node: IIfExpressionNode): IAstNode; override;
function VisitCondExpression(const Node: ICondExpressionNode): IAstNode; override; // Replaces Ternary
function VisitAssignment(const Node: IAssignmentNode): IAstNode; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
function VisitIndexer(const Node: IIndexerNode): IAstNode; override;
function VisitMemberAccess(const Node: IMemberAccessNode): IAstNode; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode; override;
public
constructor Create(const ATarget: IAstNode);
// Tries to remove TargetNode from RootNode.
// Returns True if the node was found and removed/replaced.
// If successful, NewRootNode contains the modified AST.
// If not found, NewRootNode returns the original RootNode.
class function TryRemove(const RootNode, TargetNode: IAstNode; out NewRootNode: IAstNode): Boolean; static;
end;
@@ -68,14 +60,35 @@ begin
FRemoved := False;
end;
procedure TAstNodeRemover.SetupHandlers;
begin
inherited SetupHandlers; // Defaults
// Filter Logic
Register(akBlockExpression, VisitBlockExpression);
Register(akExpressionList, VisitExpressionList);
Register(akArgumentList, VisitArgumentList);
Register(akParameterList, VisitParameterList);
Register(akRecordFieldList, VisitRecordFieldList);
// Replace Logic
Register(akIfExpression, VisitIfExpression);
Register(akCondExpression, VisitCondExpression);
Register(akAssignment, VisitAssignment);
Register(akVariableDeclaration, VisitVariableDeclaration);
Register(akLambdaExpression, VisitLambdaExpression);
Register(akFunctionCall, VisitFunctionCall);
Register(akIndexer, VisitIndexer);
Register(akMemberAccess, VisitMemberAccess);
Register(akAddSeriesItem, VisitAddSeriesItem);
end;
class function TAstNodeRemover.TryRemove(const RootNode, TargetNode: IAstNode; out NewRootNode: IAstNode): Boolean;
var
Remover: TAstNodeRemover;
begin
// Edge case: Removing the root itself
if (RootNode = TargetNode) then
begin
// We replace the root with a Nop, as we cannot return 'nil' for a valid AST root expectation usually
NewRootNode := TAst.Nop(RootNode.Identity);
Result := True;
Exit;
@@ -87,15 +100,9 @@ begin
Result := Remover.FRemoved;
if not Result then
begin
// If nothing was removed, return the original node to ensure reference stability
NewRootNode := RootNode;
end
NewRootNode := RootNode
else if (NewRootNode = nil) then
begin
// Safety fallback: if traversal somehow resulted in nil (should be caught by EnsureNode logic usually)
NewRootNode := TAst.Nop(RootNode.Identity);
end;
finally
Remover.Free;
end;
@@ -103,14 +110,11 @@ end;
function TAstNodeRemover.Accept(const Node: IAstNode): IAstNode;
begin
// If we matched the target, flag it as removed and return nil.
// The parent visitor is responsible for handling the nil result (Filter or Replace).
if Node = FTarget then
begin
FRemoved := True;
Exit(nil);
end;
Result := inherited Accept(Node);
end;
@@ -119,7 +123,6 @@ begin
if Assigned(Node) then
Result := Node
else
// Mandatory child was deleted -> Replace with Nop using parent's identity location
Result := TAst.Nop(ContextNode.Identity);
end;
@@ -136,9 +139,6 @@ begin
begin
item := Source[i];
transformed := Accept(item);
// If transformed is not nil, keep it.
// If it is nil, it was the target, so we skip (delete) it.
if Assigned(transformed) then
list.Add(T(transformed));
end;
@@ -152,107 +152,114 @@ end;
// List Visitors (Filtering)
// -----------------------------------------------------------------------------
function TAstNodeRemover.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
function TAstNodeRemover.VisitBlockExpression(const Node: IAstNode): IAstNode;
var
B: IBlockExpressionNode;
newExprs: TArray<IAstNode>;
newList: IExpressionList;
changed: Boolean;
i: Integer;
begin
newExprs := FilterList<IAstNode>(Node.Expressions);
B := Node.AsBlockExpression;
newExprs := FilterList<IAstNode>(B.Expressions);
// If counts differ, something was removed
if Length(newExprs) = Node.Expressions.Count then
if Length(newExprs) = B.Expressions.Count then
begin
// If not marked as removed, we assume no change in this branch
if not FRemoved then
Exit(Node);
// Deep check for replacement
var changed := False;
for var i := 0 to High(newExprs) do
if newExprs[i] <> Node.Expressions[i] then
changed := False;
for i := 0 to High(newExprs) do
if newExprs[i] <> B.Expressions[i] then
changed := True;
if not changed then
Exit(Node);
end;
newList := TExpressionList.Create(newExprs, Node.Expressions.Identity);
Result := TAst.Block(Node.Identity, newList, Node.StaticType);
newList := TExpressionList.Create(newExprs, B.Expressions.Identity);
Result := TAst.Block(Node.Identity, newList, B.StaticType);
end;
function TAstNodeRemover.VisitExpressionList(const Node: IExpressionList): IAstNode;
function TAstNodeRemover.VisitExpressionList(const Node: IAstNode): IAstNode;
var
L: IExpressionList;
newExprs: TArray<IAstNode>;
changed: Boolean;
i: Integer;
begin
newExprs := FilterList<IAstNode>(Node);
if Length(newExprs) = Node.Count then
L := Node.AsExpressionList;
newExprs := FilterList<IAstNode>(L);
if Length(newExprs) = L.Count then
begin
var changed := False;
for var i := 0 to High(newExprs) do
if newExprs[i] <> Node[i] then
changed := False;
for i := 0 to High(newExprs) do
if newExprs[i] <> L[i] then
changed := True;
if not changed then
Exit(Node);
end;
Result := TExpressionList.Create(newExprs, Node.Identity);
end;
function TAstNodeRemover.VisitArgumentList(const Node: IArgumentList): IAstNode;
function TAstNodeRemover.VisitArgumentList(const Node: IAstNode): IAstNode;
var
L: IArgumentList;
newArgs: TArray<IAstNode>;
changed: Boolean;
i: Integer;
begin
newArgs := FilterList<IAstNode>(Node);
if Length(newArgs) = Node.Count then
L := Node.AsArgumentList;
newArgs := FilterList<IAstNode>(L);
if Length(newArgs) = L.Count then
begin
var changed := False;
for var i := 0 to High(newArgs) do
if newArgs[i] <> Node[i] then
changed := False;
for i := 0 to High(newArgs) do
if newArgs[i] <> L[i] then
changed := True;
if not changed then
Exit(Node);
end;
Result := TArgumentList.Create(newArgs, Node.Identity);
end;
function TAstNodeRemover.VisitParameterList(const Node: IParameterList): IAstNode;
function TAstNodeRemover.VisitParameterList(const Node: IAstNode): IAstNode;
var
L: IParameterList;
newParams: TArray<IIdentifierNode>;
changed: Boolean;
i: Integer;
begin
newParams := FilterList<IIdentifierNode>(Node);
if Length(newParams) = Node.Count then
L := Node.AsParameterList;
newParams := FilterList<IIdentifierNode>(L);
if Length(newParams) = L.Count then
begin
var changed := False;
for var i := 0 to High(newParams) do
if newParams[i] <> Node[i] then
changed := False;
for i := 0 to High(newParams) do
if newParams[i] <> L[i] then
changed := True;
if not changed then
Exit(Node);
end;
Result := TParameterList.Create(newParams, Node.Identity);
end;
function TAstNodeRemover.VisitRecordFieldList(const Node: IRecordFieldList): IAstNode;
function TAstNodeRemover.VisitRecordFieldList(const Node: IAstNode): IAstNode;
var
L: IRecordFieldList;
newFields: TArray<IRecordFieldNode>;
changed: Boolean;
i: Integer;
begin
newFields := FilterList<IRecordFieldNode>(Node);
if Length(newFields) = Node.Count then
L := Node.AsRecordFieldList;
newFields := FilterList<IRecordFieldNode>(L);
if Length(newFields) = L.Count then
begin
var changed := False;
for var i := 0 to High(newFields) do
if newFields[i] <> Node[i] then
changed := False;
for i := 0 to High(newFields) do
if newFields[i] <> L[i] then
changed := True;
if not changed then
Exit(Node);
end;
Result := TRecordFieldList.Create(newFields, Node.Identity);
end;
@@ -260,190 +267,166 @@ end;
// Structural Visitors (Replacement with Nop/Void)
// -----------------------------------------------------------------------------
function TAstNodeRemover.VisitIfExpression(const Node: IIfExpressionNode): IAstNode;
function TAstNodeRemover.VisitIfExpression(const Node: IAstNode): IAstNode;
var
E: IIfExpressionNode;
newCond, newThen, newElse: IAstNode;
begin
newCond := Accept(Node.Condition);
newThen := Accept(Node.ThenBranch);
newElse := Accept(Node.ElseBranch);
E := Node.AsIfExpression;
newCond := EnsureNode(Accept(E.Condition), Node);
newThen := EnsureNode(Accept(E.ThenBranch), Node);
newElse := Accept(E.ElseBranch); // Optional
// If condition or Then-branch is deleted, replace with Nop
newCond := EnsureNode(newCond, Node);
newThen := EnsureNode(newThen, Node);
// Else branch is optional
if (newCond = Node.Condition) and (newThen = Node.ThenBranch) and (newElse = Node.ElseBranch) then
if (newCond = E.Condition) and (newThen = E.ThenBranch) and (newElse = E.ElseBranch) then
Exit(Node);
Result := TAst.IfExpr(Node.Identity, newCond, newThen, newElse, Node.StaticType);
Result := TAst.IfExpr(Node.Identity, newCond, newThen, newElse, E.StaticType);
end;
function TAstNodeRemover.VisitCondExpression(const Node: ICondExpressionNode): IAstNode;
function TAstNodeRemover.VisitCondExpression(const Node: IAstNode): IAstNode;
var
E: ICondExpressionNode;
i: Integer;
newPairs: TArray<TCondPair>;
newElse: IAstNode;
newCond, newBranch: IAstNode;
hasChanged: Boolean;
begin
SetLength(newPairs, Length(Node.Pairs));
E := Node.AsCondExpression;
SetLength(newPairs, Length(E.Pairs));
hasChanged := False;
for i := 0 to High(Node.Pairs) do
for i := 0 to High(E.Pairs) do
begin
// Ensure mandatory children exist (replace with Nop if removed)
newCond := EnsureNode(Accept(Node.Pairs[i].Condition), Node);
newBranch := EnsureNode(Accept(Node.Pairs[i].Branch), Node);
newCond := EnsureNode(Accept(E.Pairs[i].Condition), Node);
newBranch := EnsureNode(Accept(E.Pairs[i].Branch), Node);
newPairs[i] := TCondPair.Create(newCond, newBranch);
if (newCond <> Node.Pairs[i].Condition) or (newBranch <> Node.Pairs[i].Branch) then
if (newCond <> E.Pairs[i].Condition) or (newBranch <> E.Pairs[i].Branch) then
hasChanged := True;
end;
// Else branch is effectively mandatory in the structure, even if it's Nop/Void
newElse := EnsureNode(Accept(Node.ElseBranch), Node);
if newElse <> Node.ElseBranch then
newElse := EnsureNode(Accept(E.ElseBranch), Node);
if newElse <> E.ElseBranch then
hasChanged := True;
if not hasChanged then
Exit(Node);
Result := TAst.CondExpr(Node.Identity, newPairs, newElse, Node.StaticType);
Result := TAst.CondExpr(Node.Identity, newPairs, newElse, E.StaticType);
end;
function TAstNodeRemover.VisitAssignment(const Node: IAssignmentNode): IAstNode;
function TAstNodeRemover.VisitAssignment(const Node: IAstNode): IAstNode;
var
A: IAssignmentNode;
newTarget, newValue: IAstNode;
begin
newTarget := EnsureNode(Accept(Node.Target), Node);
newValue := EnsureNode(Accept(Node.Value), Node);
if (newTarget = Node.Target) and (newValue = Node.Value) then
A := Node.AsAssignment;
newTarget := EnsureNode(Accept(A.Target), Node);
newValue := EnsureNode(Accept(A.Value), Node);
if (newTarget = A.Target) and (newValue = A.Value) then
Exit(Node);
Result := TAst.Assign(Node.Identity, newTarget, newValue, Node.StaticType);
Result := TAst.Assign(Node.Identity, newTarget, newValue, A.StaticType);
end;
function TAstNodeRemover.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
function TAstNodeRemover.VisitVariableDeclaration(const Node: IAstNode): IAstNode;
var
V: IVariableDeclarationNode;
newTarget, newInit: IAstNode;
begin
newTarget := EnsureNode(Accept(Node.Target), Node);
newInit := Accept(Node.Initializer); // Initializer is optional
if (newTarget = Node.Target) and (newInit = Node.Initializer) then
V := Node.AsVariableDeclaration;
newTarget := EnsureNode(Accept(V.Target), Node);
newInit := Accept(V.Initializer);
if (newTarget = V.Target) and (newInit = V.Initializer) then
Exit(Node);
Result := TAst.VarDecl(Node.Identity, newTarget, newInit, Node.StaticType, Node.IsBoxed);
Result := TAst.VarDecl(Node.Identity, newTarget, newInit, V.StaticType, V.IsBoxed);
end;
function TAstNodeRemover.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
function TAstNodeRemover.VisitLambdaExpression(const Node: IAstNode): IAstNode;
var
newParams: IAstNode;
newBody: IAstNode;
L: ILambdaExpressionNode;
newParams, newBody: IAstNode;
begin
newParams := Accept(Node.Parameters);
// If the parameter list itself was the target, we replace it with an empty list
L := Node.AsLambdaExpression;
newParams := Accept(L.Parameters);
if newParams = nil then
newParams := TParameterList.Create([], Node.Parameters.Identity);
newParams := TParameterList.Create([], L.Parameters.Identity);
newBody := EnsureNode(Accept(L.Body), Node);
newBody := EnsureNode(Accept(Node.Body), Node);
if (newParams = Node.Parameters) and (newBody = Node.Body) then
if (newParams = L.Parameters) and (newBody = L.Body) then
Exit(Node);
Result :=
TAst.LambdaExpr(
Node.Identity,
newParams.AsParameterList,
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;
function TAstNodeRemover.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
function TAstNodeRemover.VisitFunctionCall(const Node: IAstNode): IAstNode;
var
newCallee: IAstNode;
newArgs: IAstNode;
C: IFunctionCallNode;
newCallee, newArgs: IAstNode;
begin
newCallee := EnsureNode(Accept(Node.Callee), Node);
newArgs := Accept(Node.Arguments);
C := Node.AsFunctionCall;
newCallee := EnsureNode(Accept(C.Callee), Node);
newArgs := Accept(C.Arguments);
if newArgs = nil then
newArgs := TArgumentList.Create([], Node.Arguments.Identity);
newArgs := TArgumentList.Create([], C.Arguments.Identity);
if (newCallee = Node.Callee) and (newArgs = Node.Arguments) then
if (newCallee = C.Callee) and (newArgs = C.Arguments) then
Exit(Node);
Result :=
TAst.FunctionCall(
Node.Identity,
newCallee,
newArgs.AsArgumentList,
Node.StaticType,
Node.IsTailCall,
Node.StaticTarget,
Node.IsTargetPure
);
TAst.FunctionCall(Node.Identity, newCallee, newArgs.AsArgumentList, C.StaticType, C.IsTailCall, C.StaticTarget, C.IsTargetPure);
end;
function TAstNodeRemover.VisitIndexer(const Node: IIndexerNode): IAstNode;
function TAstNodeRemover.VisitIndexer(const Node: IAstNode): IAstNode;
var
I: IIndexerNode;
newBase, newIndex: IAstNode;
begin
newBase := EnsureNode(Accept(Node.Base), Node);
newIndex := EnsureNode(Accept(Node.Index), Node);
if (newBase = Node.Base) and (newIndex = Node.Index) then
I := Node.AsIndexer;
newBase := EnsureNode(Accept(I.Base), Node);
newIndex := EnsureNode(Accept(I.Index), Node);
if (newBase = I.Base) and (newIndex = I.Index) then
Exit(Node);
Result := TAst.Indexer(Node.Identity, newBase, newIndex, Node.StaticType);
Result := TAst.Indexer(Node.Identity, newBase, newIndex, I.StaticType);
end;
function TAstNodeRemover.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode;
function TAstNodeRemover.VisitMemberAccess(const Node: IAstNode): IAstNode;
var
newBase: IAstNode;
newMember: IAstNode;
M: IMemberAccessNode;
newBase, newMember: IAstNode;
begin
newBase := EnsureNode(Accept(Node.Base), Node);
newMember := Accept(Node.Member);
M := Node.AsMemberAccess;
newBase := EnsureNode(Accept(M.Base), Node);
newMember := Accept(M.Member);
if newMember = nil then
begin
// If member name is deleted, the access is invalid. Replace whole node with Nop.
Exit(TAst.Nop(Node.Identity));
end;
Exit(TAst.Nop(Node.Identity)); // Member missing -> invalid access
if (newBase = Node.Base) and (newMember = Node.Member) then
if (newBase = M.Base) and (newMember = M.Member) then
Exit(Node);
Result := TAst.MemberAccess(Node.Identity, newBase, newMember.AsKeyword, Node.StaticType);
Result := TAst.MemberAccess(Node.Identity, newBase, newMember.AsKeyword, M.StaticType);
end;
function TAstNodeRemover.VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode;
function TAstNodeRemover.VisitAddSeriesItem(const Node: IAstNode): IAstNode;
var
newSeries: IAstNode;
newValue: IAstNode;
newLookback: IAstNode;
A: IAddSeriesItemNode;
newSeries, newValue, newLookback: IAstNode;
begin
newSeries := Accept(Node.Series);
A := Node.AsAddSeriesItem;
newSeries := Accept(A.Series);
if newSeries = nil then
Exit(TAst.Nop(Node.Identity)); // Cannot exist without series identifier
Exit(TAst.Nop(Node.Identity));
newValue := EnsureNode(Accept(A.Value), Node);
newLookback := Accept(A.Lookback);
newValue := EnsureNode(Accept(Node.Value), Node);
newLookback := Accept(Node.Lookback); // Optional
if (newSeries = Node.Series) and (newValue = Node.Value) and (newLookback = Node.Lookback) then
if (newSeries = A.Series) and (newValue = A.Value) and (newLookback = A.Lookback) then
Exit(Node);
Result := TAst.AddSeriesItem(Node.Identity, newSeries.AsIdentifier, newValue, newLookback, Node.StaticType);
Result := TAst.AddSeriesItem(Node.Identity, newSeries.AsIdentifier, newValue, newLookback, A.StaticType);
end;
end.
Src/AST/Myc.Ast.Script.Print.pas
+537
View File
@@ -0,0 +1,537 @@
unit Myc.Ast.Script.Print;
interface
uses
System.SysUtils,
System.Classes,
Myc.Data.Value,
Myc.Data.Scalar,
Myc.Ast.Nodes,
Myc.Ast.Visitor,
Myc.Ast;
type
TPrettyPrintVisitor = class(TAstVisitor)
strict private
FBuilder: TStringBuilder;
FIndentLevel: Integer;
procedure Indent;
procedure Unindent;
procedure Append(const S: string);
procedure NewLine;
// Handlers now strictly accept IAstNode
function VisitConstant(const N: IAstNode): TVoid;
function VisitIdentifier(const N: IAstNode): TVoid;
function VisitKeyword(const N: IAstNode): TVoid;
function VisitParameterList(const N: IAstNode): TVoid;
function VisitArgumentList(const N: IAstNode): TVoid;
function VisitExpressionList(const N: IAstNode): TVoid;
function VisitRecordFieldList(const N: IAstNode): TVoid;
function VisitRecordField(const N: IAstNode): TVoid;
function VisitIfExpression(const N: IAstNode): TVoid;
function VisitCondExpression(const N: IAstNode): TVoid;
function VisitLambdaExpression(const N: IAstNode): TVoid;
function VisitMacroDefinition(const N: IAstNode): TVoid;
function VisitQuasiquote(const N: IAstNode): TVoid;
function VisitUnquote(const N: IAstNode): TVoid;
function VisitUnquoteSplicing(const N: IAstNode): TVoid;
function VisitFunctionCall(const N: IAstNode): TVoid;
function VisitMacroExpansionNode(const N: IAstNode): TVoid;
function VisitBlockExpression(const N: IAstNode): TVoid;
function VisitVariableDeclaration(const N: IAstNode): TVoid;
function VisitAssignment(const N: IAstNode): TVoid;
function VisitIndexer(const N: IAstNode): TVoid;
function VisitMemberAccess(const N: IAstNode): TVoid;
function VisitRecordLiteral(const N: IAstNode): TVoid;
function VisitCreateSeries(const N: IAstNode): TVoid;
function VisitAddSeriesItem(const N: IAstNode): TVoid;
function VisitSeriesLength(const N: IAstNode): TVoid;
function VisitRecurNode(const N: IAstNode): TVoid;
function VisitNop(const N: IAstNode): TVoid;
function VisitPipeInput(const N: IAstNode): TVoid;
function VisitPipeSelectorList(const N: IAstNode): TVoid;
function VisitPipeInputList(const N: IAstNode): TVoid;
function VisitPipe(const N: IAstNode): TVoid;
protected
procedure SetupHandlers; override;
public
constructor Create;
destructor Destroy; override;
function GetResult: string;
procedure Execute(const RootNode: IAstNode);
end;
implementation
{ TPrettyPrintVisitor }
constructor TPrettyPrintVisitor.Create;
begin
inherited Create;
FBuilder := TStringBuilder.Create;
FIndentLevel := 0;
end;
destructor TPrettyPrintVisitor.Destroy;
begin
FBuilder.Free;
inherited;
end;
procedure TPrettyPrintVisitor.SetupHandlers;
begin
Register(akConstant, VisitConstant);
Register(akIdentifier, VisitIdentifier);
Register(akKeyword, VisitKeyword);
Register(akParameterList, VisitParameterList);
Register(akArgumentList, VisitArgumentList);
Register(akExpressionList, VisitExpressionList);
Register(akRecordFieldList, VisitRecordFieldList);
Register(akRecordField, VisitRecordField);
Register(akIfExpression, VisitIfExpression);
Register(akCondExpression, VisitCondExpression);
Register(akLambdaExpression, VisitLambdaExpression);
Register(akFunctionCall, VisitFunctionCall);
Register(akMacroExpansion, VisitMacroExpansionNode);
Register(akBlockExpression, VisitBlockExpression);
Register(akVariableDeclaration, VisitVariableDeclaration);
Register(akAssignment, VisitAssignment);
Register(akMacroDefinition, VisitMacroDefinition);
Register(akQuasiquote, VisitQuasiquote);
Register(akUnquote, VisitUnquote);
Register(akUnquoteSplicing, VisitUnquoteSplicing);
Register(akIndexer, VisitIndexer);
Register(akMemberAccess, VisitMemberAccess);
Register(akRecordLiteral, VisitRecordLiteral);
Register(akCreateSeries, VisitCreateSeries);
Register(akAddSeriesItem, VisitAddSeriesItem);
Register(akSeriesLength, VisitSeriesLength);
Register(akRecur, VisitRecurNode);
Register(akNop, VisitNop);
Register(akPipeInput, VisitPipeInput);
Register(akPipeSelectorList, VisitPipeSelectorList);
Register(akPipeInputList, VisitPipeInputList);
Register(akPipe, VisitPipe);
end;
function TPrettyPrintVisitor.GetResult: string;
begin
Result := FBuilder.ToString;
end;
procedure TPrettyPrintVisitor.Execute(const RootNode: IAstNode);
begin
if Assigned(RootNode) then
Visit(RootNode);
end;
procedure TPrettyPrintVisitor.Indent;
begin
Inc(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.Unindent;
begin
Dec(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.Append(const S: string);
begin
FBuilder.Append(S);
end;
procedure TPrettyPrintVisitor.NewLine;
begin
FBuilder.AppendLine;
FBuilder.Append(''.PadLeft(FIndentLevel));
end;
// --- Implementations (Clean & Typed) ---
function TPrettyPrintVisitor.VisitPipeInput(const N: IAstNode): TVoid;
var
P: IPipeInputNode;
begin
P := N.AsPipeInput;
Visit(P.StreamSource);
Append(' ');
Visit(P.Selectors);
end;
function TPrettyPrintVisitor.VisitPipeSelectorList(const N: IAstNode): TVoid;
var
L: IPipeSelectorList;
i: Integer;
begin
L := N.AsPipeSelectorList;
Append('[');
for i := 0 to L.Count - 1 do
begin
if i > 0 then
Append(' ');
Visit(L[i]);
end;
Append(']');
end;
function TPrettyPrintVisitor.VisitPipeInputList(const N: IAstNode): TVoid;
var
L: IPipeInputList;
i: Integer;
begin
L := N.AsPipeInputList;
Append('[');
for i := 0 to L.Count - 1 do
begin
if i > 0 then
Append(' ');
Visit(L[i]);
end;
Append(']');
end;
function TPrettyPrintVisitor.VisitPipe(const N: IAstNode): TVoid;
var
P: IPipeNode;
begin
P := N.AsPipe;
Append('(pipe ');
Visit(P.Inputs);
Indent;
NewLine;
Visit(P.Transformation);
Unindent;
NewLine;
Append(')');
end;
function TPrettyPrintVisitor.VisitConstant(const N: IAstNode): TVoid;
var
C: IConstantNode;
begin
C := N.AsConstant;
if C.Value.Kind = vkText then
Append('"' + C.Value.AsText + '"')
else
Append(C.Value.ToString);
end;
function TPrettyPrintVisitor.VisitIdentifier(const N: IAstNode): TVoid;
begin
Append(N.AsIdentifier.Name);
end;
function TPrettyPrintVisitor.VisitKeyword(const N: IAstNode): TVoid;
begin
Append(':' + N.AsKeyword.Value.Name);
end;
function TPrettyPrintVisitor.VisitNop(const N: IAstNode): TVoid;
begin
Append('...');
end;
function TPrettyPrintVisitor.VisitParameterList(const N: IAstNode): TVoid;
var
L: IParameterList;
i: Integer;
begin
L := N.AsParameterList;
Append('[');
for i := 0 to L.Count - 1 do
begin
if i > 0 then
Append(' ');
Visit(L[i]);
end;
Append(']');
end;
function TPrettyPrintVisitor.VisitArgumentList(const N: IAstNode): TVoid;
var
L: IArgumentList;
i: Integer;
begin
L := N.AsArgumentList;
for i := 0 to L.Count - 1 do
begin
Append(' ');
Visit(L[i]);
end;
end;
function TPrettyPrintVisitor.VisitExpressionList(const N: IAstNode): TVoid;
var
L: IExpressionList;
item: IAstNode;
begin
L := N.AsExpressionList;
Indent;
for item in L do
begin
NewLine;
Visit(item);
end;
Unindent;
NewLine;
end;
function TPrettyPrintVisitor.VisitRecordFieldList(const N: IAstNode): TVoid;
var
L: IRecordFieldList;
item: IRecordFieldNode;
begin
L := N.AsRecordFieldList;
Indent;
for item in L do
begin
NewLine;
Visit(item);
end;
Unindent;
NewLine;
end;
function TPrettyPrintVisitor.VisitRecordField(const N: IAstNode): TVoid;
var
F: IRecordFieldNode;
begin
F := N.AsRecordField;
Visit(F.Key);
Append(' ');
Visit(F.Value);
end;
function TPrettyPrintVisitor.VisitIfExpression(const N: IAstNode): TVoid;
var
E: IIfExpressionNode;
begin
E := N.AsIfExpression;
Append('(if ');
Visit(E.Condition);
Indent;
NewLine;
Visit(E.ThenBranch);
if Assigned(E.ElseBranch) then
begin
NewLine;
Visit(E.ElseBranch);
end;
Unindent;
NewLine;
Append(')');
end;
function TPrettyPrintVisitor.VisitCondExpression(const N: IAstNode): TVoid;
var
E: ICondExpressionNode;
begin
E := N.AsCondExpression;
Append('(?');
Indent;
for var pair in E.Pairs do
begin
NewLine;
Visit(pair.Condition);
Append(' ');
Visit(pair.Branch);
end;
NewLine;
Visit(E.ElseBranch);
Unindent;
NewLine;
Append(')');
end;
function TPrettyPrintVisitor.VisitLambdaExpression(const N: IAstNode): TVoid;
var
E: ILambdaExpressionNode;
begin
E := N.AsLambdaExpression;
Append('(fn ');
Visit(E.Parameters);
Indent;
NewLine;
Visit(E.Body);
Unindent;
NewLine;
Append(')');
end;
function TPrettyPrintVisitor.VisitMacroDefinition(const N: IAstNode): TVoid;
var
M: IMacroDefinitionNode;
begin
M := N.AsMacroDefinition;
Append('(defmacro ');
Visit(M.Name);
Append(' ');
Visit(M.Parameters);
Indent;
NewLine;
Visit(M.Body);
Unindent;
NewLine;
Append(')');
end;
function TPrettyPrintVisitor.VisitQuasiquote(const N: IAstNode): TVoid;
begin
Append('`');
Visit(N.AsQuasiquote.Expression);
end;
function TPrettyPrintVisitor.VisitUnquote(const N: IAstNode): TVoid;
begin
Append('~');
Visit(N.AsUnquote.Expression);
end;
function TPrettyPrintVisitor.VisitUnquoteSplicing(const N: IAstNode): TVoid;
begin
Append('~@');
Visit(N.AsUnquoteSplicing.Expression);
end;
function TPrettyPrintVisitor.VisitFunctionCall(const N: IAstNode): TVoid;
var
C: IFunctionCallNode;
begin
C := N.AsFunctionCall;
if (C.Callee.Kind = akIdentifier) and (C.Callee.AsIdentifier.Name = 'quote') and (C.Arguments.Count = 1) then
begin
Append('''');
Visit(C.Arguments[0]);
exit;
end;
Append('(');
Visit(C.Callee);
Visit(C.Arguments);
Append(')');
end;
function TPrettyPrintVisitor.VisitMacroExpansionNode(const N: IAstNode): TVoid;
begin
Visit(N.AsMacroExpansion.CallNode);
end;
function TPrettyPrintVisitor.VisitRecurNode(const N: IAstNode): TVoid;
begin
Append('(recur');
Visit(N.AsRecur.Arguments);
Append(')');
end;
function TPrettyPrintVisitor.VisitBlockExpression(const N: IAstNode): TVoid;
begin
Append('(do');
Visit(N.AsBlockExpression.Expressions);
Append(')');
end;
function TPrettyPrintVisitor.VisitVariableDeclaration(const N: IAstNode): TVoid;
var
V: IVariableDeclarationNode;
begin
V := N.AsVariableDeclaration;
Append('(def ');
Visit(V.Target);
if Assigned(V.Initializer) then
begin
Append(' ');
Visit(V.Initializer);
end;
Append(')');
end;
function TPrettyPrintVisitor.VisitAssignment(const N: IAstNode): TVoid;
var
A: IAssignmentNode;
begin
A := N.AsAssignment;
Append('(assign ');
Visit(A.Target);
Append(' ');
Visit(A.Value);
Append(')');
end;
function TPrettyPrintVisitor.VisitIndexer(const N: IAstNode): TVoid;
var
I: IIndexerNode;
begin
I := N.AsIndexer;
Append('(get ');
Visit(I.Base);
Append(' ');
Visit(I.Index);
Append(')');
end;
function TPrettyPrintVisitor.VisitMemberAccess(const N: IAstNode): TVoid;
var
M: IMemberAccessNode;
begin
M := N.AsMemberAccess;
Append('(.');
Visit(M.Member);
Append(' ');
Visit(M.Base);
Append(')');
end;
function TPrettyPrintVisitor.VisitRecordLiteral(const N: IAstNode): TVoid;
var
R: IRecordLiteralNode;
begin
R := N.AsRecordLiteral;
if R.Fields.Count = 0 then
begin
Append('{}');
exit;
end;
Append('{');
Visit(R.Fields);
Append('}');
end;
function TPrettyPrintVisitor.VisitCreateSeries(const N: IAstNode): TVoid;
begin
Append(Format('(new-series "%s")', [N.AsCreateSeries.Definition]));
end;
function TPrettyPrintVisitor.VisitAddSeriesItem(const N: IAstNode): TVoid;
var
A: IAddSeriesItemNode;
begin
A := N.AsAddSeriesItem;
Append('(add-item ');
Visit(A.Series);
Append(' ');
Visit(A.Value);
if Assigned(A.Lookback) then
begin
Append(' ');
Visit(A.Lookback);
end;
Append(')');
end;
function TPrettyPrintVisitor.VisitSeriesLength(const N: IAstNode): TVoid;
begin
Append('(count ');
Visit(N.AsSeriesLength.Series);
Append(')');
end;
end.
Src/AST/Myc.Ast.Script.pas
+2 -408
View File
@@ -6,7 +6,8 @@ uses
System.SysUtils,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Visitor;
Myc.Ast.Visitor,
Myc.Ast.Script.Print;
type
EParserException = class(EAstException)
@@ -116,57 +117,6 @@ type
function Parse: IAstNode;
end;
TPrettyPrintVisitor = class(TAstVisitor)
private
FBuilder: TStringBuilder;
FIndentLevel: Integer;
procedure Indent;
procedure Unindent;
procedure Append(const S: string);
procedure NewLine;
public
constructor Create;
destructor Destroy; override;
function GetResult: string;
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TVoid; override;
function VisitIdentifier(const Node: IIdentifierNode): TVoid; override;
function VisitKeyword(const Node: IKeywordNode): TVoid; override;
function VisitParameterList(const Node: IParameterList): TVoid; override;
function VisitArgumentList(const Node: IArgumentList): TVoid; override;
function VisitExpressionList(const Node: IExpressionList): TVoid; override;
function VisitRecordFieldList(const Node: IRecordFieldList): TVoid; override;
function VisitRecordField(const Node: IRecordFieldNode): TVoid; override;
function VisitIfExpression(const Node: IIfExpressionNode): TVoid; override;
function VisitCondExpression(const Node: ICondExpressionNode): TVoid; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TVoid; override;
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TVoid; override;
function VisitQuasiquote(const Node: IQuasiquoteNode): TVoid; override;
function VisitUnquote(const Node: IUnquoteNode): TVoid; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TVoid; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TVoid; override;
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TVoid; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TVoid; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TVoid; override;
function VisitAssignment(const Node: IAssignmentNode): TVoid; override;
function VisitIndexer(const Node: IIndexerNode): TVoid; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TVoid; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): TVoid; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TVoid; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TVoid; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TVoid; override;
function VisitRecurNode(const Node: IRecurNode): TVoid; override;
function VisitNop(const Node: INopNode): TVoid; override;
function VisitPipeInput(const Node: IPipeInputNode): TVoid; override;
function VisitPipeSelectorList(const Node: IPipeSelectorList): TVoid; override;
function VisitPipeInputList(const Node: IPipeInputList): TVoid; override;
function VisitPipe(const Node: IPipeNode): TVoid; override;
end;
{ TTokenKindHelper }
function TTokenKindHelper.ToString: String;
begin
@@ -812,362 +762,6 @@ begin
Result := expr.Node;
end;
{ TPrettyPrintVisitor }
constructor TPrettyPrintVisitor.Create;
begin
inherited Create;
FBuilder := TStringBuilder.Create;
FIndentLevel := 0;
end;
destructor TPrettyPrintVisitor.Destroy;
begin
FBuilder.Free;
inherited;
end;
function TPrettyPrintVisitor.GetResult: string;
begin
Result := FBuilder.ToString;
end;
procedure TPrettyPrintVisitor.Indent;
begin
Inc(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.Unindent;
begin
Dec(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.Append(const S: string);
begin
FBuilder.Append(S);
end;
procedure TPrettyPrintVisitor.NewLine;
begin
FBuilder.AppendLine;
FBuilder.Append(''.PadLeft(FIndentLevel));
end;
function TPrettyPrintVisitor.Execute(const RootNode: IAstNode): TDataValue;
begin
if Assigned(RootNode) then
RootNode.Accept(Self);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitPipeInput(const Node: IPipeInputNode): TVoid;
begin
Node.StreamSource.Accept(Self);
Append(' ');
// Printer Logic for Vector syntax
Node.Selectors.Accept(Self); // Selectors is IPipeSelectorList which is visited as list
end;
function TPrettyPrintVisitor.VisitPipeSelectorList(const Node: IPipeSelectorList): TVoid;
begin
Append('[');
for var i := 0 to Node.Count - 1 do
begin
if i > 0 then
Append(' ');
Node[i].Accept(Self);
end;
Append(']');
end;
function TPrettyPrintVisitor.VisitPipeInputList(const Node: IPipeInputList): TVoid;
begin
Append('[');
for var i := 0 to Node.Count - 1 do
begin
if i > 0 then
Append(' ');
Node[i].Accept(Self);
end;
Append(']');
end;
function TPrettyPrintVisitor.VisitPipe(const Node: IPipeNode): TVoid;
begin
Append('(pipe ');
Node.Inputs.Accept(Self);
Indent;
NewLine;
Node.Transformation.Accept(Self);
Unindent;
NewLine;
Append(')');
end;
function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TVoid;
begin
if Node.Value.Kind = vkText then
Append('"' + Node.Value.AsText + '"')
else
Append(Node.Value.ToString);
end;
function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): TVoid;
begin
Append(Node.Name);
end;
function TPrettyPrintVisitor.VisitKeyword(const Node: IKeywordNode): TVoid;
begin
Append(':' + Node.Value.Name);
end;
function TPrettyPrintVisitor.VisitNop(const Node: INopNode): TVoid;
begin
Append('...');
end;
function TPrettyPrintVisitor.VisitParameterList(const Node: IParameterList): TVoid;
begin
Append('[');
for var i := 0 to Node.Count - 1 do
begin
if i > 0 then
Append(' ');
Node[i].Accept(Self);
end;
Append(']');
end;
function TPrettyPrintVisitor.VisitArgumentList(const Node: IArgumentList): TVoid;
begin
for var i := 0 to Node.Count - 1 do
begin
Append(' ');
Node[i].Accept(Self);
end;
end;
function TPrettyPrintVisitor.VisitExpressionList(const Node: IExpressionList): TVoid;
begin
Indent;
for var item in Node do
begin
NewLine;
item.Accept(Self);
end;
Unindent;
NewLine;
end;
function TPrettyPrintVisitor.VisitRecordFieldList(const Node: IRecordFieldList): TVoid;
begin
Indent;
for var item in Node do
begin
NewLine;
item.Accept(Self);
end;
Unindent;
NewLine;
end;
function TPrettyPrintVisitor.VisitRecordField(const Node: IRecordFieldNode): TVoid;
begin
Node.Key.Accept(Self);
Append(' ');
Node.Value.Accept(Self);
end;
function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): TVoid;
begin
Append('(if ');
Node.Condition.Accept(Self);
Indent;
NewLine;
Node.ThenBranch.Accept(Self);
if Assigned(Node.ElseBranch) then
begin
NewLine;
Node.ElseBranch.Accept(Self);
end;
Unindent;
NewLine;
Append(')');
end;
function TPrettyPrintVisitor.VisitCondExpression(const Node: ICondExpressionNode): TVoid;
begin
Append('(?');
Indent;
for var pair in Node.Pairs do
begin
NewLine;
pair.Condition.Accept(Self);
Append(' ');
pair.Branch.Accept(Self);
end;
NewLine;
Node.ElseBranch.Accept(Self);
Unindent;
NewLine;
Append(')');
end;
function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TVoid;
begin
Append('(fn ');
Node.Parameters.Accept(Self);
Indent;
NewLine;
Node.Body.Accept(Self);
Unindent;
NewLine;
Append(')');
end;
function TPrettyPrintVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode): TVoid;
begin
Append('(defmacro ');
Node.Name.Accept(Self);
Append(' ');
Node.Parameters.Accept(Self);
Indent;
NewLine;
Node.Body.Accept(Self);
Unindent;
NewLine;
Append(')');
end;
function TPrettyPrintVisitor.VisitQuasiquote(const Node: IQuasiquoteNode): TVoid;
begin
Append('`');
Node.Expression.Accept(Self);
end;
function TPrettyPrintVisitor.VisitUnquote(const Node: IUnquoteNode): TVoid;
begin
Append('~');
Node.Expression.Accept(Self);
end;
function TPrettyPrintVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TVoid;
begin
Append('~@');
Node.Expression.Accept(Self);
end;
function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TVoid;
begin
if (Node.Callee.Kind = akIdentifier) and (Node.Callee.AsIdentifier.Name = 'quote') and (Node.Arguments.Count = 1) then
begin
Append('''');
Node.Arguments[0].Accept(Self);
exit;
end;
Append('(');
Node.Callee.Accept(Self);
Node.Arguments.Accept(Self);
Append(')');
end;
function TPrettyPrintVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TVoid;
begin
VisitFunctionCall(Node.CallNode);
end;
function TPrettyPrintVisitor.VisitRecurNode(const Node: IRecurNode): TVoid;
begin
Append('(recur');
Node.Arguments.Accept(Self);
Append(')');
end;
function TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TVoid;
begin
Append('(do');
Node.Expressions.Accept(Self);
Append(')');
end;
function TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TVoid;
begin
Append('(def ');
Node.Target.Accept(Self);
if Assigned(Node.Initializer) then
begin
Append(' ');
Node.Initializer.Accept(Self);
end;
Append(')');
end;
function TPrettyPrintVisitor.VisitAssignment(const Node: IAssignmentNode): TVoid;
begin
Append('(assign ');
Node.Target.Accept(Self);
Append(' ');
Node.Value.Accept(Self);
Append(')');
end;
function TPrettyPrintVisitor.VisitIndexer(const Node: IIndexerNode): TVoid;
begin
Append('(get ');
Node.Base.Accept(Self);
Append(' ');
Node.Index.Accept(Self);
Append(')');
end;
function TPrettyPrintVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TVoid;
begin
Append('(.');
Node.Member.Accept(Self);
Append(' ');
Node.Base.Accept(Self);
Append(')');
end;
function TPrettyPrintVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): TVoid;
begin
if Node.Fields.Count = 0 then
begin
Append('{}');
exit;
end;
Append('{');
Node.Fields.Accept(Self);
Append('}');
end;
function TPrettyPrintVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TVoid;
begin
Append(Format('(new-series "%s")', [Node.Definition]));
end;
function TPrettyPrintVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TVoid;
begin
Append('(add-item ');
Node.Series.Accept(Self);
Append(' ');
Node.Value.Accept(Self);
if Assigned(Node.Lookback) then
begin
Append(' ');
Node.Lookback.Accept(Self);
end;
Append(')');
end;
function TPrettyPrintVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TVoid;
begin
Append('(count ');
Node.Series.Accept(Self);
Append(')');
end;
{ TAstScript }
class function TAstScript.Parse(const ASource: string): IAstNode;
Src/AST/Myc.Ast.Visitor.pas
+630 -692
View File
File diff suppressed because it is too large Load Diff
Src/AST/Myc.Fmx.AstEditor.Visualizer.pas
+186 -120
View File
@@ -15,10 +15,11 @@ uses
type
// Implementation of the Factory/Visitor for the Virtual Tree
// Uses TAstVisitor<TAstViewNode> which now uses closures for dispatch.
TAstVisualizer = class(TAstVisitor<TAstViewNode>, IAstVisualizer)
private
FExprDepth: Integer;
FParentNode: TVisualNode; // Changed from TControl
FParentNode: TVisualNode;
FWorkspace: TWorkspace;
function CallAccept(const Node: IAstNode): TAstViewNode;
@@ -29,49 +30,58 @@ type
function GetWorkspace: TWorkspace;
protected
// --- Visitor Implementations ---
function VisitConstant(const Node: IConstantNode): TAstViewNode; override;
function VisitIdentifier(const Node: IIdentifierNode): TAstViewNode; override;
function VisitKeyword(const Node: IKeywordNode): TAstViewNode; override;
// Setup registry using closures
procedure SetupHandlers; override;
// --- Visitor Implementations (Strict IAstNode signature) ---
function VisitConstant(const Node: IAstNode): TAstViewNode;
function VisitIdentifier(const Node: IAstNode): TAstViewNode;
function VisitKeyword(const Node: IAstNode): TAstViewNode;
// Lists
function VisitParameterList(const Node: IParameterList): TAstViewNode; override;
function VisitArgumentList(const Node: IArgumentList): TAstViewNode; override;
function VisitExpressionList(const Node: IExpressionList): TAstViewNode; override;
function VisitRecordFieldList(const Node: IRecordFieldList): TAstViewNode; override;
function VisitRecordField(const Node: IRecordFieldNode): TAstViewNode; override;
function VisitParameterList(const Node: IAstNode): TAstViewNode;
function VisitArgumentList(const Node: IAstNode): TAstViewNode;
function VisitExpressionList(const Node: IAstNode): TAstViewNode;
function VisitRecordFieldList(const Node: IAstNode): TAstViewNode;
function VisitRecordField(const Node: IAstNode): TAstViewNode;
// Control Flow
function VisitIfExpression(const Node: IIfExpressionNode): TAstViewNode; override;
function VisitCondExpression(const Node: ICondExpressionNode): TAstViewNode; override; // Replaces Ternary
function VisitBlockExpression(const Node: IBlockExpressionNode): TAstViewNode; override;
function VisitRecurNode(const Node: IRecurNode): TAstViewNode; override;
function VisitNop(const Node: INopNode): TAstViewNode; override;
function VisitIfExpression(const Node: IAstNode): TAstViewNode;
function VisitCondExpression(const Node: IAstNode): TAstViewNode;
function VisitBlockExpression(const Node: IAstNode): TAstViewNode;
function VisitRecurNode(const Node: IAstNode): TAstViewNode;
function VisitNop(const Node: IAstNode): TAstViewNode;
// Functions
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstViewNode; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TAstViewNode; override;
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TAstViewNode; override;
function VisitLambdaExpression(const Node: IAstNode): TAstViewNode;
function VisitFunctionCall(const Node: IAstNode): TAstViewNode;
function VisitMacroExpansionNode(const Node: IAstNode): TAstViewNode;
// Declarations
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstViewNode; override;
function VisitAssignment(const Node: IAssignmentNode): TAstViewNode; override;
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TAstViewNode; override;
function VisitVariableDeclaration(const Node: IAstNode): TAstViewNode;
function VisitAssignment(const Node: IAstNode): TAstViewNode;
function VisitMacroDefinition(const Node: IAstNode): TAstViewNode;
// Metaprogramming
function VisitQuasiquote(const Node: IQuasiquoteNode): TAstViewNode; override;
function VisitUnquote(const Node: IUnquoteNode): TAstViewNode; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TAstViewNode; override;
function VisitQuasiquote(const Node: IAstNode): TAstViewNode;
function VisitUnquote(const Node: IAstNode): TAstViewNode;
function VisitUnquoteSplicing(const Node: IAstNode): TAstViewNode;
// Data Access
function VisitIndexer(const Node: IIndexerNode): TAstViewNode; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TAstViewNode; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): TAstViewNode; override;
function VisitIndexer(const Node: IAstNode): TAstViewNode;
function VisitMemberAccess(const Node: IAstNode): TAstViewNode;
function VisitRecordLiteral(const Node: IAstNode): TAstViewNode;
// Series
function VisitCreateSeries(const Node: ICreateSeriesNode): TAstViewNode; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstViewNode; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstViewNode; override;
function VisitCreateSeries(const Node: IAstNode): TAstViewNode;
function VisitAddSeriesItem(const Node: IAstNode): TAstViewNode;
function VisitSeriesLength(const Node: IAstNode): TAstViewNode;
// Pipes
function VisitPipeInput(const Node: IAstNode): TAstViewNode;
function VisitPipeSelectorList(const Node: IAstNode): TAstViewNode;
function VisitPipeInputList(const Node: IAstNode): TAstViewNode;
function VisitPipe(const Node: IAstNode): TAstViewNode;
public
constructor Create(AWorkspace: TWorkspace; AParentNode: TVisualNode; AExprDepth: Integer);
@@ -87,42 +97,23 @@ type
implementation
uses
System.StrUtils,
Myc.Fmx.AstEditor.Handlers,
Myc.Fmx.AstEditor.Handlers.Data,
Myc.Fmx.AstEditor.Handlers.Control,
Myc.Fmx.AstEditor.Handlers.Primitives,
Myc.Fmx.AstEditor.Handlers.Lists;
// Helper to identify standard operators
function IsStandardOperator(const Name: string): Boolean;
begin
// You can extend this list based on your RTL
Result :=
(Name = '+')
or (Name = '-')
or (Name = '*')
or (Name = '/')
or (Name = 'div')
or (Name = 'mod')
or (Name = '=')
or (Name = '<>')
or (Name = '<')
or (Name = '>')
or (Name = '<=')
or (Name = '>=')
or (Name = 'and')
or (Name = 'or')
or (Name = 'xor')
or (Name = 'not')
or (Name = 'shl')
or (Name = 'shr');
Result := MatchStr(Name, ['+', '-', '*', '/', 'div', 'mod', '=', '<>', '<', '>', '<=', '>=', 'and', 'or', 'xor', 'not', 'shl', 'shr']);
end;
{ TAstVisualizer }
constructor TAstVisualizer.Create(AWorkspace: TWorkspace; AParentNode: TVisualNode; AExprDepth: Integer);
begin
inherited Create;
inherited Create; // Calls SetupHandlers
FWorkspace := AWorkspace;
FParentNode := AParentNode;
FExprDepth := AExprDepth;
@@ -133,6 +124,59 @@ begin
inherited;
end;
procedure TAstVisualizer.SetupHandlers;
begin
// Core Primitives
Register(akConstant, VisitConstant);
Register(akIdentifier, VisitIdentifier);
Register(akKeyword, VisitKeyword);
Register(akNop, VisitNop);
// Lists
Register(akParameterList, VisitParameterList);
Register(akArgumentList, VisitArgumentList);
Register(akExpressionList, VisitExpressionList);
Register(akRecordFieldList, VisitRecordFieldList);
Register(akRecordField, VisitRecordField);
// Control Flow
Register(akIfExpression, VisitIfExpression);
Register(akCondExpression, VisitCondExpression);
Register(akBlockExpression, VisitBlockExpression);
Register(akRecur, VisitRecurNode);
// Functions
Register(akLambdaExpression, VisitLambdaExpression);
Register(akFunctionCall, VisitFunctionCall);
Register(akMacroExpansion, VisitMacroExpansionNode);
// Declarations
Register(akVariableDeclaration, VisitVariableDeclaration);
Register(akAssignment, VisitAssignment);
Register(akMacroDefinition, VisitMacroDefinition);
// Metaprogramming
Register(akQuasiquote, VisitQuasiquote);
Register(akUnquote, VisitUnquote);
Register(akUnquoteSplicing, VisitUnquoteSplicing);
// Data Access
Register(akIndexer, VisitIndexer);
Register(akMemberAccess, VisitMemberAccess);
Register(akRecordLiteral, VisitRecordLiteral);
// Series
Register(akCreateSeries, VisitCreateSeries);
Register(akAddSeriesItem, VisitAddSeriesItem);
Register(akSeriesLength, VisitSeriesLength);
// Pipes
Register(akPipeInput, VisitPipeInput);
Register(akPipeSelectorList, VisitPipeSelectorList);
Register(akPipeInputList, VisitPipeInputList);
Register(akPipe, VisitPipe);
end;
function TAstVisualizer.CallAccept(const Node: IAstNode): TAstViewNode;
var
dataValue: TDataValue;
@@ -140,10 +184,9 @@ begin
if not Assigned(Node) then
exit(nil);
// Dynamic dispatch via Visitor pattern
dataValue := Node.Accept(Self);
if dataValue.Kind = TDataValueKind.vkGeneric then
if dataValue.Kind = vkGeneric then
Result := dataValue.AsGeneric<TAstViewNode>
else
Result := nil;
@@ -169,180 +212,203 @@ begin
Result := FWorkspace;
end;
// --- Visitor Implementation Helpers ---
// --- Visitor Implementations (Cast-heavy for efficiency) ---
function TAstVisualizer.VisitConstant(const Node: IConstantNode): TAstViewNode;
function TAstVisualizer.VisitConstant(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TConstantNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TConstantNodeHandler.Create(Node.AsConstant));
end;
function TAstVisualizer.VisitIdentifier(const Node: IIdentifierNode): TAstViewNode;
function TAstVisualizer.VisitIdentifier(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TIdentifierNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TIdentifierNodeHandler.Create(Node.AsIdentifier));
end;
function TAstVisualizer.VisitKeyword(const Node: IKeywordNode): TAstViewNode;
function TAstVisualizer.VisitKeyword(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TKeywordNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TKeywordNodeHandler.Create(Node.AsKeyword));
end;
function TAstVisualizer.VisitNop(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TNopNodeHandler.Create(Node.AsNop));
end;
// Lists
function TAstVisualizer.VisitParameterList(const Node: IParameterList): TAstViewNode;
function TAstVisualizer.VisitParameterList(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TParameterListHandler.Create(Node));
Result := TAstViewNode.Create(Self, TParameterListHandler.Create(Node.AsParameterList));
end;
function TAstVisualizer.VisitArgumentList(const Node: IArgumentList): TAstViewNode;
function TAstVisualizer.VisitArgumentList(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TArgumentListHandler.Create(Node));
Result := TAstViewNode.Create(Self, TArgumentListHandler.Create(Node.AsArgumentList));
end;
function TAstVisualizer.VisitExpressionList(const Node: IExpressionList): TAstViewNode;
function TAstVisualizer.VisitExpressionList(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TExpressionListHandler.Create(Node));
Result := TAstViewNode.Create(Self, TExpressionListHandler.Create(Node.AsExpressionList));
end;
function TAstVisualizer.VisitRecordFieldList(const Node: IRecordFieldList): TAstViewNode;
function TAstVisualizer.VisitRecordFieldList(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TRecordFieldListHandler.Create(Node));
Result := TAstViewNode.Create(Self, TRecordFieldListHandler.Create(Node.AsRecordFieldList));
end;
function TAstVisualizer.VisitRecordField(const Node: IRecordFieldNode): TAstViewNode;
function TAstVisualizer.VisitRecordField(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TRecordFieldHandler.Create(Node));
Result := TAstViewNode.Create(Self, TRecordFieldHandler.Create(Node.AsRecordField));
end;
// Control Flow
function TAstVisualizer.VisitBlockExpression(const Node: IBlockExpressionNode): TAstViewNode;
function TAstVisualizer.VisitBlockExpression(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TBlockExpressionNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TBlockExpressionNodeHandler.Create(Node.AsBlockExpression));
end;
function TAstVisualizer.VisitIfExpression(const Node: IIfExpressionNode): TAstViewNode;
function TAstVisualizer.VisitIfExpression(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TIfExpressionNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TIfExpressionNodeHandler.Create(Node.AsIfExpression));
end;
function TAstVisualizer.VisitCondExpression(const Node: ICondExpressionNode): TAstViewNode;
function TAstVisualizer.VisitCondExpression(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TCondExpressionNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TCondExpressionNodeHandler.Create(Node.AsCondExpression));
end;
function TAstVisualizer.VisitRecurNode(const Node: IRecurNode): TAstViewNode;
function TAstVisualizer.VisitRecurNode(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TRecurNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitNop(const Node: INopNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TNopNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TRecurNodeHandler.Create(Node.AsRecur));
end;
// Functions
function TAstVisualizer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstViewNode;
function TAstVisualizer.VisitLambdaExpression(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TLambdaExpressionNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TLambdaExpressionNodeHandler.Create(Node.AsLambdaExpression));
end;
function TAstVisualizer.VisitFunctionCall(const Node: IFunctionCallNode): TAstViewNode;
function TAstVisualizer.VisitFunctionCall(const Node: IAstNode): TAstViewNode;
var
C: IFunctionCallNode;
calleeName: string;
isOp: Boolean;
begin
C := Node.AsFunctionCall;
isOp := False;
// Check if callee is a simple identifier or keyword that matches an operator
if Node.Callee.Kind = akIdentifier then
if C.Callee.Kind = akIdentifier then
begin
calleeName := Node.Callee.AsIdentifier.Name;
calleeName := C.Callee.AsIdentifier.Name;
isOp := IsStandardOperator(calleeName);
end
else if Node.Callee.Kind = akKeyword then
else if C.Callee.Kind = akKeyword then
begin
calleeName := Node.Callee.AsKeyword.Value.Name;
calleeName := C.Callee.AsKeyword.Value.Name;
isOp := IsStandardOperator(calleeName);
end;
if isOp then
Result := TAstViewNode.Create(Self, TOperatorCallHandler.Create(Node))
Result := TAstViewNode.Create(Self, TOperatorCallHandler.Create(C))
else
Result := TAstViewNode.Create(Self, TFunctionCallNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TFunctionCallNodeHandler.Create(C));
end;
function TAstVisualizer.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TAstViewNode;
function TAstVisualizer.VisitMacroExpansionNode(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TMacroExpansionNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TMacroExpansionNodeHandler.Create(Node.AsMacroExpansion));
end;
// Declarations
function TAstVisualizer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstViewNode;
function TAstVisualizer.VisitVariableDeclaration(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TVariableDeclarationNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TVariableDeclarationNodeHandler.Create(Node.AsVariableDeclaration));
end;
function TAstVisualizer.VisitAssignment(const Node: IAssignmentNode): TAstViewNode;
function TAstVisualizer.VisitAssignment(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TAssignmentNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TAssignmentNodeHandler.Create(Node.AsAssignment));
end;
function TAstVisualizer.VisitMacroDefinition(const Node: IMacroDefinitionNode): TAstViewNode;
function TAstVisualizer.VisitMacroDefinition(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TMacroDefinitionNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TMacroDefinitionNodeHandler.Create(Node.AsMacroDefinition));
end;
// Metaprogramming
function TAstVisualizer.VisitQuasiquote(const Node: IQuasiquoteNode): TAstViewNode;
function TAstVisualizer.VisitQuasiquote(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TQuasiquoteNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TQuasiquoteNodeHandler.Create(Node.AsQuasiquote));
end;
function TAstVisualizer.VisitUnquote(const Node: IUnquoteNode): TAstViewNode;
function TAstVisualizer.VisitUnquote(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TUnquoteNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TUnquoteNodeHandler.Create(Node.AsUnquote));
end;
function TAstVisualizer.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TAstViewNode;
function TAstVisualizer.VisitUnquoteSplicing(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TUnquoteSplicingNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TUnquoteSplicingNodeHandler.Create(Node.AsUnquoteSplicing));
end;
// Data Access
function TAstVisualizer.VisitIndexer(const Node: IIndexerNode): TAstViewNode;
function TAstVisualizer.VisitIndexer(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TIndexerNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TIndexerNodeHandler.Create(Node.AsIndexer));
end;
function TAstVisualizer.VisitMemberAccess(const Node: IMemberAccessNode): TAstViewNode;
function TAstVisualizer.VisitMemberAccess(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TMemberAccessNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TMemberAccessNodeHandler.Create(Node.AsMemberAccess));
end;
function TAstVisualizer.VisitRecordLiteral(const Node: IRecordLiteralNode): TAstViewNode;
function TAstVisualizer.VisitRecordLiteral(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TRecordLiteralNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TRecordLiteralNodeHandler.Create(Node.AsRecordLiteral));
end;
// Series
function TAstVisualizer.VisitCreateSeries(const Node: ICreateSeriesNode): TAstViewNode;
function TAstVisualizer.VisitCreateSeries(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TCreateSeriesNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TCreateSeriesNodeHandler.Create(Node.AsCreateSeries));
end;
function TAstVisualizer.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstViewNode;
function TAstVisualizer.VisitAddSeriesItem(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TAddSeriesItemNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TAddSeriesItemNodeHandler.Create(Node.AsAddSeriesItem));
end;
function TAstVisualizer.VisitSeriesLength(const Node: ISeriesLengthNode): TAstViewNode;
function TAstVisualizer.VisitSeriesLength(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TSeriesLengthNodeHandler.Create(Node));
Result := TAstViewNode.Create(Self, TSeriesLengthNodeHandler.Create(Node.AsSeriesLength));
end;
// Pipes (Fallback to Nop/Placeholder visualization until specific handlers are implemented)
function TAstVisualizer.VisitPipeInput(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TNopNodeHandler.Create(Node.AsNop));
end;
function TAstVisualizer.VisitPipeSelectorList(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TNopNodeHandler.Create(Node.AsNop));
end;
function TAstVisualizer.VisitPipeInputList(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TNopNodeHandler.Create(Node.AsNop));
end;
function TAstVisualizer.VisitPipe(const Node: IAstNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TNopNodeHandler.Create(Node.AsNop));
end;
end.
Src/AST/Myc.Fmx.AstEditor.Workspace.pas
+1
View File
@@ -93,6 +93,7 @@ type
implementation
uses
System.Generics.Collections,
Myc.Fmx.AstEditor.Node;
{ TWorkspace }
Src/Data/Myc.Data.Keyword.pas
+3
View File
@@ -110,6 +110,9 @@ type
implementation
uses
Winapi.Windows;
{ TKeywordRegistry.TKeyword }
constructor TKeywordRegistry.TKeyword.Create(const AName: string; AIdx: Integer);
Src/Data/Myc.Data.Stream.pas
+3
View File
@@ -103,6 +103,9 @@ type
implementation
uses
Winapi.Windows;
constructor TStreamSignal.Create(AKind: TSignalKind; ACycleID: Int64);
begin
FKind := AKind;
Src/Myc.Trade.Broker.pas
+3
View File
@@ -37,6 +37,9 @@ procedure RegisterBroker(const Scope: IExecutionScope);
implementation
uses
Myc.Data.Scalar;
type
TMockBroker = class(TInterfacedObject, IMycBroker)
strict private
Test/AST/Test.Myc.Ast.Compiler.Macros.pas
+1 -2
View File
@@ -16,6 +16,7 @@ uses
type
[TestFixture]
[IgnoreMemoryLeaks]
TMacroTests = class
private
FEnv: TAstEnvironment;
@@ -37,7 +38,6 @@ type
// --- Basic Functionality ---
[Test]
[IgnoreMemoryLeaks]
[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')]
@@ -46,7 +46,6 @@ type
// --- Quasiquoting & Unquoting ---
[Test]
[IgnoreMemoryLeaks]
procedure Test_Quasiquote_Literal;
[Test]
Test/AST/Test.Myc.Ast.NullPropagation.pas
+1 -3
View File
@@ -14,6 +14,7 @@ uses
type
[TestFixture]
[IgnoreMemoryLeaks]
TTestNullPropagation = class
private
FEnv: TAstEnvironment;
@@ -26,15 +27,12 @@ type
[Test]
[TestCase('ValidRecord', 'true,10')]
[TestCase('VoidRecord', 'false,0')]
[IgnoreMemoryLeaks]
procedure TestMemberAccessPropagation(const Condition: Boolean; const ExpectedVal: Int64);
[Test]
[IgnoreMemoryLeaks]
procedure TestNestedPropagation;
[Test]
[IgnoreMemoryLeaks]
procedure TestIndexerPropagation;
[Test]
Test/AST/Test.Myc.Ast.RTL.TypeRegistry.pas
+1 -1
View File
@@ -447,7 +447,7 @@ begin
var root := TAstScript.Parse(script);
Assert.WillRaise(procedure begin FEnv.Run(root); end, EEvaluatorException, 'Boom!');
Assert.WillRaise(procedure begin FEnv.Run(root); end);
end;
procedure TTestRtlTypeRegistry.Test_ReturnNilInterface;