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

Binder refactoring - extracted macro expander

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-01 13:36:10 +01:00
parent 6ab51816d1
commit 4687ecb9ca
7 changed files with 394 additions and 249 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
@@ -22,7 +22,8 @@ uses
Myc.Ast.Script in '..\Src\AST\Myc.Ast.Script.pas',
Myc.Ast.Types in '..\Src\AST\Myc.Ast.Types.pas',
Myc.Data.Keyword in '..\Src\Data\Myc.Data.Keyword.pas',
Myc.Ast.Binding.Nodes in '..\Src\AST\Myc.Ast.Binding.Nodes.pas';
Myc.Ast.Binding.Nodes in '..\Src\AST\Myc.Ast.Binding.Nodes.pas',
Myc.Ast.MacroExpander in '..\Src\AST\Myc.Ast.MacroExpander.pas';
{$R *.res}
ASTPlayground/ASTPlayground.dproj
+1
View File
@@ -153,6 +153,7 @@
<DCCReference Include="..\Src\AST\Myc.Ast.Types.pas"/>
<DCCReference Include="..\Src\Data\Myc.Data.Keyword.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Binding.Nodes.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.MacroExpander.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
ASTPlayground/MainForm.pas
+55 -30
View File
@@ -38,11 +38,12 @@ uses
Myc.Ast.Debugger,
Myc.Fmx.AstEditor.Node,
Myc.Fmx.AstEditor.Workspace,
Myc.Ast.MacroExpander,
FMX.DialogService,
FMX.ListView.Types,
FMX.ListView.Appearances,
FMX.ListView.Adapters.Base,
FMX.ListView; // Added for platform-independent dialogs
FMX.ListView;
type
// A test record
@@ -208,25 +209,31 @@ end;
function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
var
binder: IAstBinder;
boundAst: IAstNode;
descriptor: IScopeDescriptor;
descriptor: IScopeDescriptor; // This is the final (binder) descriptor
evalScope: IExecutionScope;
visitor: IEvaluatorVisitor;
macroDescriptor: IScopeDescriptor; // This is the macro-pass descriptor
expandedAst: IAstNode;
begin
// The new, streamlined pipeline: The binder handles macro expansion internally.
FCurrUnboundAst := ANode;
// Step 1: Create a binder, passing the evaluator factory for compile-time evaluations.
binder := TAstBinder.Create(AParentScope, CreateEvaluator);
// Step 1: Expand macros (Phase 1)
// The expander uses the parent scope to find macros and the factory to eval unquotes.
expandedAst := TMacroExpander.ExpandMacros(AParentScope, ANode, macroDescriptor, CreateEvaluator);
boundAst := binder.Execute(ANode, descriptor);
// Step 2: Bind names and types (Phase 2)
// The binder runs on the *expanded* AST. It uses the same parent scope.
// It no longer needs the factory.
boundAst := TAstBinder.Bind(AParentScope, expandedAst, descriptor);
// Store the final bound AST for visualization and debugging.
FCurrAst := boundAst;
FCurrDesc := descriptor;
// Step 2: Create the final scope and evaluator for runtime execution.
// Step 3: Create the final scope and evaluator for runtime execution.
// The runtime scope is created from the *binder's* descriptor, using the parent scope.
evalScope := descriptor.CreateScope(AParentScope);
visitor := CreateEvaluator(evalScope);
Result := visitor.Execute(boundAst);
@@ -243,9 +250,10 @@ begin
TAst.RegisterLibrary(
procedure(const Scope: IExecutionScope)
var
smaAst, boundSmaAst: IAstNode;
binder: IAstBinder;
smaAst, boundSmaAst, expandedAst: IAstNode;
// binder: IAstBinder; // <-- REMOVED
smaDescriptor: IScopeDescriptor;
macroDescriptor: IScopeDescriptor;
smaScope: IExecutionScope;
smaVisitor: IEvaluatorVisitor;
begin
@@ -300,8 +308,10 @@ begin
)
);
binder := TAstBinder.Create(Scope, CreateEvaluator);
boundSmaAst := binder.Execute(smaAst, smaDescriptor);
// Phase 1: Expand
expandedAst := TMacroExpander.ExpandMacros(Scope, smaAst, macroDescriptor, CreateEvaluator);
// Phase 2: Bind
boundSmaAst := TAstBinder.Bind(Scope, expandedAst, smaDescriptor);
smaScope := smaDescriptor.CreateScope(Scope);
smaVisitor := CreateEvaluator(smaScope);
@@ -310,8 +320,10 @@ begin
'print',
TDataValue(
function(const Args: TArray<TDataValue>): TDataValue
var
str: TStringBuilder;
begin
var str := TStringBuilder.Create;
str := TStringBuilder.Create;
try
for var i := 0 to High(Args) do
begin
@@ -531,6 +543,8 @@ var
jsonString: string;
jsonObj: TJSONObject;
converter: IJsonAstConverter;
macroDescriptor: IScopeDescriptor;
expandedAst: IAstNode;
begin
Memo1.Lines.BeginUpdate;
try
@@ -550,9 +564,13 @@ begin
raise EJSONParseException.Create('Invalid JSON format.');
try
var binder := TAstBinder.Create(FGScope, CreateEvaluator);
var unboundAst := converter.Deserialize(jsonObj);
FCurrAst := binder.Execute(unboundAst, FCurrDesc);
// Phase 1: Expand
expandedAst := TMacroExpander.ExpandMacros(FGScope, unboundAst, macroDescriptor, CreateEvaluator);
// Phase 2: Bind
FCurrAst := TAstBinder.Bind(FGScope, expandedAst, FCurrDesc);
Memo1.Lines.Add('AST deserialized successfully from JSON.');
Memo1.Lines.Add('You can now visualize it (Middle Mouse Click) or pretty-print it.');
finally
@@ -607,8 +625,8 @@ end;
procedure TForm1.DumpButtonClick(Sender: TObject);
var
binder: IAstBinder;
boundNode: IAstNode;
macroDescriptor: IScopeDescriptor;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- AST Dump ---');
@@ -619,9 +637,9 @@ begin
exit;
end;
// Re-bind the current AST against the global scope to ensure up-to-date binding info for the dump.
binder := TAstBinder.Create(FGScope, CreateEvaluator);
boundNode := binder.Execute(FCurrAst, FCurrDesc);
// Re-expand and re-bind the *unbound* AST (FCurrUnboundAst)
var expandedAst := TMacroExpander.ExpandMacros(FGScope, FCurrUnboundAst, macroDescriptor, CreateEvaluator);
boundNode := TAstBinder.Bind(FGScope, expandedAst, FCurrDesc);
TAstDumper.Dump(boundNode, Memo1.Lines);
end;
@@ -632,7 +650,7 @@ var
sw: TStopwatch;
fibScope: IExecutionScope;
visitor: IEvaluatorVisitor;
binder: IAstBinder;
macroDescriptor: IScopeDescriptor;
begin
fibAst :=
TAst.Block(
@@ -662,9 +680,11 @@ begin
]
);
binder := TAstBinder.Create(FGScope, CreateEvaluator);
// Phase 1: Expand
var expandedAst := TMacroExpander.ExpandMacros(FGScope, fibAst, macroDescriptor, CreateEvaluator);
// Phase 2: Bind
var desc: IScopeDescriptor;
boundFibAst := binder.Execute(fibAst, desc);
boundFibAst := TAstBinder.Bind(FGScope, expandedAst, desc);
fibScope := desc.CreateScope(FGScope);
visitor := CreateEvaluator(fibScope);
@@ -900,9 +920,8 @@ var
scope: IExecutionScope;
values: TArray<TScalar.TValue>;
recordValue: TScalarRecord;
binder: IAstBinder;
setupAst, boundSetupAst, callAst, boundCallAst: IAstNode;
setupDescriptor, callDescriptor: IScopeDescriptor;
setupDescriptor, callDescriptor, macroDescriptor: IScopeDescriptor;
seriesAddress: TResolvedSymbol; // Use TResolvedSymbol
begin
Memo1.Lines.Clear;
@@ -958,8 +977,10 @@ begin
);
// 1. Bind and execute the setup script.
binder := TAstBinder.Create(FGScope, CreateEvaluator);
boundSetupAst := binder.Execute(setupAst, setupDescriptor);
// Phase 1
var expandedAst := TMacroExpander.ExpandMacros(FGScope, setupAst, macroDescriptor, CreateEvaluator);
// Phase 2
boundSetupAst := TAstBinder.Bind(FGScope, expandedAst, setupDescriptor);
scope := setupDescriptor.CreateScope(FGScope);
var setupVisitor := CreateEvaluator(scope);
@@ -971,8 +992,10 @@ begin
callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]);
// 3. Re-bind the call AST within the now-populated scope to resolve the new variable.
binder := TAstBinder.Create(scope, CreateEvaluator);
boundCallAst := binder.Execute(callAst, callDescriptor);
// Phase 1
var expandedAst2 := TMacroExpander.ExpandMacros(scope, callAst, macroDescriptor, CreateEvaluator);
// Phase 2
boundCallAst := TAstBinder.Bind(scope, expandedAst2, callDescriptor);
// 4. Get the address of 'current_series' from the new descriptor.
seriesAddress := callDescriptor.FindSymbol('current_series');
@@ -1077,8 +1100,8 @@ end;
procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject);
var
blk: IAstNode;
binder: IAstBinder;
visitor: IEvaluatorVisitor;
macroDescriptor: IScopeDescriptor;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Creating Trigger Blueprint ---');
@@ -1099,8 +1122,10 @@ begin
]
);
binder := TAstBinder.Create(FGScope, CreateEvaluator);
FCurrAst := binder.Execute(blk, FCurrDesc);
// Phase 1
var expandedAst := TMacroExpander.ExpandMacros(FGScope, blk, macroDescriptor, CreateEvaluator);
// Phase 2
FCurrAst := TAstBinder.Bind(FGScope, expandedAst, FCurrDesc);
FTriggerScope := FCurrDesc.CreateScope(FGScope);
visitor := CreateEvaluator(FTriggerScope);
Src/AST/Myc.Ast.Binding.pas
+7 -216
View File
@@ -22,25 +22,6 @@ type
TAstBinder = class; // Forward declaration
TEvaluateProc = reference to function(const Node: IAstNode): TDataValue;
// This visitor handles the expansion of a single macro body (` `...`).
TExpansionVisitor = class(TAstTransformer)
private
FEvaluate: TEvaluateProc;
FMacroScope: IExecutionScope;
function TransformAndSpliceNodes(const ANodes: TArray<IAstNode>): TArray<IAstNode>;
protected
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
public
constructor Create(const AMacroScope: IExecutionScope; const AEvaluate: TEvaluateProc);
class function Expand(const MacroScope: IExecutionScope; const RootNode: IAstNode; const AEvaluate: TEvaluateProc): IAstNode;
end;
TAstBinder = class(TAstTransformer, IAstBinder)
private
type
@@ -58,7 +39,6 @@ type
FIsTailStack: TStack<Boolean>;
FNextIsTail: Boolean;
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
FEvaluatorFactory: TEvaluatorFactory;
// Operator folding maps
FBinaryOperators: TDictionary<string, TScalar.TBinaryOp>;
FUnaryOperators: TDictionary<string, TScalar.TUnaryOp>;
@@ -93,15 +73,14 @@ type
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
public
constructor Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
constructor Create(const AInitialScope: IExecutionScope);
destructor Destroy; override;
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
class function Bind(
const InitialScope: IExecutionScope;
const RootNode: IAstNode;
out Descriptor: IScopeDescriptor;
const EvaluatorFactory: TEvaluatorFactory
out Descriptor: IScopeDescriptor
): IAstNode; static;
end;
@@ -120,129 +99,6 @@ type
function GetHashCode(const Value: TResolvedAddress): Integer; override;
end;
{ TExpansionVisitor }
constructor TExpansionVisitor.Create(const AMacroScope: IExecutionScope; const AEvaluate: TEvaluateProc);
begin
inherited Create;
FMacroScope := AMacroScope;
FEvaluate := AEvaluate;
end;
class function TExpansionVisitor.Expand(
const MacroScope: IExecutionScope;
const RootNode: IAstNode;
const AEvaluate: TEvaluateProc
): IAstNode;
begin
var expander := TExpansionVisitor.Create(MacroScope, AEvaluate) as IAstTransformer;
Result := expander.Execute(RootNode);
end;
function TExpansionVisitor.TransformAndSpliceNodes(const ANodes: TArray<IAstNode>): TArray<IAstNode>;
var
newList: TList<IAstNode>;
nodeToSplice: IAstNode;
begin
newList := TList<IAstNode>.Create;
try
for var node in ANodes do
begin
if (node is TUnquoteSplicingNode) then
begin
var spliceExpr := (node as TUnquoteSplicingNode).Expression;
var evaluatedSpliceValue := VisitUnquote(TAst.Unquote(spliceExpr));
if (not evaluatedSpliceValue.IsVoid) and (evaluatedSpliceValue.Kind = vkInterface) then
begin
nodeToSplice := evaluatedSpliceValue.AsIntf<IAstNode>;
if (nodeToSplice is TBlockExpressionNode) then
newList.AddRange((nodeToSplice as TBlockExpressionNode).Expressions)
else
raise Exception.Create('Expression inside unquote-splicing (`~@`) must be a list of nodes (a block).');
end
else
raise Exception.Create('Expression inside unquote-splicing (`~@`) must evaluate to a list of nodes (a block).');
end
else
begin
var transformedValue := node.Accept(self);
if not transformedValue.IsVoid then
newList.Add(transformedValue.AsIntf<IAstNode>);
end;
end;
Result := newList.ToArray;
finally
newList.Free;
end;
end;
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue;
var
value: TDataValue;
expr: IAstNode;
symbol: TResolvedSymbol;
begin
expr := Node.Expression;
if (expr is TIdentifierNode) then
begin
// Use new FindSymbol
symbol := FMacroScope.CreateDescriptor.FindSymbol((expr as TIdentifierNode).Name);
if (symbol.Address.Kind = akLocalOrParent) and (symbol.Address.ScopeDepth = 0) then
begin
// Use symbol.Address
var argValue := FMacroScope.Values[symbol.Address];
if argValue.Kind = vkInterface then
begin
Result := argValue;
exit;
end;
end;
end;
// externally evaluate the expression using the injected evaluator
value := FEvaluate(expr);
// Allow unquoting scalars (which now include keywords)
if value.Kind in [vkScalar, vkText, vkVoid] then
begin
Result := TDataValue.FromIntf<IAstNode>(TAst.Constant(value));
end
else
raise Exception.CreateFmt('Cannot unquote complex value of type %s at compile time.', [value.Kind.ToString]);
end;
function TExpansionVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
begin
raise Exception.Create('Unquote-splicing (`~@`) can only appear inside a list form (e.g., a function call or a `do` block).');
end;
function TExpansionVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
newArgs: TArray<IAstNode>;
transformedCallee: IAstNode;
begin
transformedCallee := Self.Accept(Node.Callee).AsIntf<IAstNode>;
newArgs := TransformAndSpliceNodes(Node.Arguments);
Result := TDataValue.FromIntf<IFunctionCallNode>(TAst.FunctionCall(transformedCallee, newArgs));
end;
function TExpansionVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
newExprs: TArray<IAstNode>;
begin
newExprs := TransformAndSpliceNodes(Node.Expressions);
Result := TDataValue.FromIntf<IBlockExpressionNode>(TAst.Block(newExprs));
end;
function TExpansionVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
begin
// Record literals do not support splicing.
// We just use the default TAstTransformer implementation which visits child values.
Result := inherited VisitRecordLiteral(Node);
end;
{ TResolvedAddressComparer }
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
begin
@@ -272,16 +128,14 @@ end;
{ TAstBinder }
constructor TAstBinder.Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
constructor TAstBinder.Create(const AInitialScope: IExecutionScope);
var
op: TScalar.TBinaryOp;
begin
inherited Create;
Assert(Assigned(AInitialScope));
Assert(Assigned(AEvaluatorFactory));
FInitialScope := AInitialScope;
FEvaluatorFactory := AEvaluatorFactory;
FCurrentDescriptor := AInitialScope.CreateDescriptor;
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(True);
FNestedLambdaCount := 0;
@@ -329,14 +183,9 @@ begin
end;
end;
class function TAstBinder.Bind(
const InitialScope: IExecutionScope;
const RootNode: IAstNode;
out Descriptor: IScopeDescriptor;
const EvaluatorFactory: TEvaluatorFactory
): IAstNode;
class function TAstBinder.Bind(const InitialScope: IExecutionScope; const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
var binder := TAstBinder.Create(InitialScope, EvaluatorFactory) as IAstBinder;
var binder := TAstBinder.Create(InitialScope) as IAstBinder;
Result := binder.Execute(RootNode, Descriptor);
end;
@@ -389,7 +238,6 @@ var
calleeIdentifier: TIdentifierNode;
binaryOp: TScalar.TBinaryOp;
unaryOp: TScalar.TUnaryOp;
macroDef: IMacroDefinitionNode;
left, right: IAstNode;
leftType, rightType, resultType: IStaticType;
boundCall: TBoundFunctionCallNode;
@@ -475,51 +323,6 @@ begin
exit;
end;
end;
// --- Macro Expansion ---
macroDef := FCurrentDescriptor.FindMacro(calleeIdentifier.Name);
if macroDef <> nil then
begin
var expansionScope := TAst.CreateScope(nil);
var params := macroDef.Parameters;
if Length(Node.Arguments) <> Length(params) then
raise Exception.CreateFmt(
'Macro %s expects %d arguments, but got %d',
[calleeIdentifier.Name, Length(params), Length(Node.Arguments)]);
for i := 0 to High(params) do
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
// expand
var expandedBody :=
TExpansionVisitor.Expand(
expansionScope,
macroDef.Body.Expression,
function(const Node: IAstNode): TDataValue
var
subDescriptor: IScopeDescriptor;
begin
// in place evaluator for expanded expressions
var tempInitScope := TScope.CreateScope(FInitialScope.Parent, FCurrentDescriptor, nil);
var boundSubAst := TAstBinder.Bind(tempInitScope, Node, subDescriptor, FEvaluatorFactory);
var evalScope := subDescriptor.CreateScope(tempInitScope);
var evaluator := FEvaluatorFactory(evalScope);
Result := evaluator.Execute(boundSubAst);
end
);
// bind expanded body
var boundExpandedBody := Self.Accept(expandedBody).AsIntf<IAstNode>;
// wrap in new expansion node
var macroNode := TMacroExpansionNode.Create(Node, boundExpandedBody) as IMacroExpansionNode;
// The type of the macro node is the type of its expanded body
(macroNode as TAstNode).StaticType := (boundExpandedBody as TAstNode).StaticType;
// done
exit(TDataValue.FromIntf<IMacroExpansionNode>(macroNode));
end;
end;
// --- Default: Bind as a standard function call ---
@@ -553,21 +356,9 @@ begin
end;
function TAstBinder.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
var
boundCallee: IAstNode;
boundArgs: TArray<IAstNode>;
boundExpandedBody: IAstNode;
boundOriginalCall: IFunctionCallNode;
newMacroNode: IMacroExpansionNode;
begin
boundCallee := Accept(Node.Callee).AsIntf<IAstNode>;
boundArgs := AcceptNodes<IAstNode>(Node.Arguments);
boundExpandedBody := Accept(Node.ExpandedBody).AsIntf<IAstNode>;
boundOriginalCall := TAst.FunctionCall(boundCallee, boundArgs);
newMacroNode := TMacroExpansionNode.Create(boundOriginalCall, boundExpandedBody);
// The type of the macro node is the type of its expanded body
Result := SetType(TDataValue.FromIntf<IMacroExpansionNode>(newMacroNode), (boundExpandedBody as TAstNode).StaticType);
// Macro expansion nodes should not exist by this stage.
raise Exception.Create('MacroExpansionNode is not expected in the binding pass.');
end;
procedure TAstBinder.ExitScope;
Src/AST/Myc.Ast.MacroExpander.pas
+325
View File
@@ -0,0 +1,325 @@
unit Myc.Ast.MacroExpander;
interface
uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Visitor,
Myc.Ast.Scope,
Myc.Ast.Types,
Myc.Ast,
Myc.Ast.Binding; // Required for TAstBinder.Bind
type
IAstMacroExpander = interface(IAstVisitor)
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
end;
// Callback type for compile-time evaluation of Unquote expressions
TEvaluateProc = reference to function(const Node: IAstNode): TDataValue;
// --- TExpansionVisitor (Moved from Binding) ---
// This visitor handles the expansion of a *single* macro body (` `...).
TExpansionVisitor = class(TAstTransformer)
private
FEvaluate: TEvaluateProc;
FMacroScope: IExecutionScope;
function TransformAndSpliceNodes(const ANodes: TArray<IAstNode>): TArray<IAstNode>;
protected
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
public
constructor Create(const AMacroScope: IExecutionScope; const AEvaluate: TEvaluateProc);
class function Expand(const MacroScope: IExecutionScope; const RootNode: IAstNode; const AEvaluate: TEvaluateProc): IAstNode;
end;
// --- TMacroExpander (New main class for Phase 1) ---
// This transformer traverses the entire AST *before* the binder,
// to find and expand macros.
TMacroExpander = class(TAstTransformer, IAstMacroExpander)
private
FInitialScope: IExecutionScope;
FCurrentDescriptor: IScopeDescriptor;
FEvaluatorFactory: TEvaluatorFactory;
protected
function Accept(const Node: IAstNode): TDataValue; override;
// Finds macro definitions
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
// Finds and expands macro calls
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
public
constructor Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
class function ExpandMacros(
const InitialScope: IExecutionScope;
const RootNode: IAstNode;
out Descriptor: IScopeDescriptor;
const EvaluatorFactory: TEvaluatorFactory
): IAstNode; static;
end;
implementation
uses
System.Generics.Defaults,
Myc.Ast.Evaluator, // Required for TEvaluatorVisitor.Execute
Myc.Data.Keyword;
{ TExpansionVisitor }
constructor TExpansionVisitor.Create(const AMacroScope: IExecutionScope; const AEvaluate: TEvaluateProc);
begin
inherited Create;
FMacroScope := AMacroScope;
FEvaluate := AEvaluate;
end;
class function TExpansionVisitor.Expand(
const MacroScope: IExecutionScope;
const RootNode: IAstNode;
const AEvaluate: TEvaluateProc
): IAstNode;
begin
var expander := TExpansionVisitor.Create(MacroScope, AEvaluate) as IAstTransformer;
Result := expander.Execute(RootNode);
end;
function TExpansionVisitor.TransformAndSpliceNodes(const ANodes: TArray<IAstNode>): TArray<IAstNode>;
var
newList: TList<IAstNode>;
nodeToSplice: IAstNode;
begin
newList := TList<IAstNode>.Create;
try
for var node in ANodes do
begin
if (node is TUnquoteSplicingNode) then
begin
var spliceExpr := (node as TUnquoteSplicingNode).Expression;
// Evaluate the unquoted expression
var evaluatedSpliceValue := FEvaluate(spliceExpr);
if (not evaluatedSpliceValue.IsVoid) and (evaluatedSpliceValue.Kind = vkInterface) then
begin
nodeToSplice := evaluatedSpliceValue.AsIntf<IAstNode>;
if (nodeToSplice is TBlockExpressionNode) then
newList.AddRange((nodeToSplice as TBlockExpressionNode).Expressions)
else
// Allow splicing single nodes, not just blocks
newList.Add(nodeToSplice);
end
else if (not evaluatedSpliceValue.IsVoid) then
begin
// If the value is not an AST node (e.g. a scalar), wrap it in a constant
newList.Add(TAst.Constant(evaluatedSpliceValue));
end;
// else (if void, splice nothing)
end
else
begin
var transformedValue := node.Accept(self);
if not transformedValue.IsVoid then
newList.Add(transformedValue.AsIntf<IAstNode>);
end;
end;
Result := newList.ToArray;
finally
newList.Free;
end;
end;
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue;
var
value: TDataValue;
expr: IAstNode;
symbol: TResolvedSymbol;
begin
expr := Node.Expression;
// Check if we are unquoting a macro parameter (simple identifier)
if (expr is TIdentifierNode) then
begin
symbol := FMacroScope.CreateDescriptor.FindSymbol((expr as TIdentifierNode).Name);
if (symbol.Address.Kind = akLocalOrParent) and (symbol.Address.ScopeDepth = 0) then
begin
// It's a parameter. Return the TDataValue containing the AST node passed as argument.
var argValue := FMacroScope.Values[symbol.Address];
if argValue.Kind = vkInterface then
begin
Result := argValue;
exit;
end;
end;
end;
// If not a simple parameter, evaluate the expression at compile-time.
value := FEvaluate(expr);
// If the result is an AST node (e.g. from a helper function), return it directly.
if value.Kind = vkInterface then
begin
Result := value;
exit;
end;
// If the result is a scalar, text, or void, wrap it in a TConstantNode.
if value.Kind in [vkScalar, vkText, vkVoid] then
begin
Result := TDataValue.FromIntf<IAstNode>(TAst.Constant(value));
end
else
raise Exception.CreateFmt('Cannot unquote complex runtime value of type %s at compile time.', [value.Kind.ToString]);
end;
function TExpansionVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
begin
// This should be handled by the caller (VisitFunctionCall / VisitBlockExpression)
raise Exception.Create('Unquote-splicing (`~@`) can only appear inside a list form (e.g., a function call or a `do` block).');
end;
function TExpansionVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
newArgs: TArray<IAstNode>;
transformedCallee: IAstNode;
begin
transformedCallee := Self.Accept(Node.Callee).AsIntf<IAstNode>;
newArgs := TransformAndSpliceNodes(Node.Arguments);
Result := TDataValue.FromIntf<IFunctionCallNode>(TAst.FunctionCall(transformedCallee, newArgs));
end;
function TExpansionVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
newExprs: TArray<IAstNode>;
begin
newExprs := TransformAndSpliceNodes(Node.Expressions);
Result := TDataValue.FromIntf<IBlockExpressionNode>(TAst.Block(newExprs));
end;
function TExpansionVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
begin
// Record literals do not support splicing.
// We just use the default TAstTransformer implementation which visits child values.
Result := inherited VisitRecordLiteral(Node);
end;
{ TMacroExpander }
constructor TMacroExpander.Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
begin
inherited Create;
Assert(Assigned(AInitialScope));
Assert(Assigned(AEvaluatorFactory));
FInitialScope := AInitialScope;
FEvaluatorFactory := AEvaluatorFactory;
// Create the top-level descriptor for macros
FCurrentDescriptor := AInitialScope.CreateDescriptor;
end;
class function TMacroExpander.ExpandMacros(
const InitialScope: IExecutionScope;
const RootNode: IAstNode;
out Descriptor: IScopeDescriptor;
const EvaluatorFactory: TEvaluatorFactory
): IAstNode;
begin
var expander := TMacroExpander.Create(InitialScope, EvaluatorFactory) as IAstMacroExpander;
Result := expander.Execute(RootNode, Descriptor);
end;
function TMacroExpander.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
// This executes the transformation (Accept)
var transformedValue := Accept(RootNode);
if transformedValue.IsVoid then
Result := TAst.Block([])
else
Result := transformedValue.AsIntf<IAstNode>;
Descriptor := FCurrentDescriptor;
end;
function TMacroExpander.Accept(const Node: IAstNode): TDataValue;
begin
// Standard transformer Accept
if (not Assigned(Node)) or Done then
exit;
Result := Node.Accept(Self);
end;
function TMacroExpander.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
begin
// Register the macro in the current descriptor
FCurrentDescriptor.DefineMacro(Node.Name.Name, Node);
// Remove the (defmacro ...) node from the AST; it's compile-time only.
Result := TDataValue.Void;
end;
function TMacroExpander.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
calleeIdentifier: TIdentifierNode;
macroDef: IMacroDefinitionNode;
i: Integer;
begin
// Check if this is an identifier
if not (Node.Callee is TIdentifierNode) then
exit(inherited VisitFunctionCall(Node));
calleeIdentifier := Node.Callee as TIdentifierNode;
// Check if this identifier is a macro
macroDef := FCurrentDescriptor.FindMacro(calleeIdentifier.Name);
if macroDef = nil then
exit(inherited VisitFunctionCall(Node)); // Not a macro, let transformer continue
// --- It is a macro, expand it ---
// 1. Create the temporary scope for the macro parameters
var expansionScope := TAst.CreateScope(nil);
var params := macroDef.Parameters;
if Length(Node.Arguments) <> Length(params) then
raise Exception
.CreateFmt('Macro %s expects %d arguments, but got %d', [calleeIdentifier.Name, Length(params), Length(Node.Arguments)]);
// 2. Populate scope: Map parameter names to the *un-evaluated* AST nodes
for i := 0 to High(params) do
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
// 3. Create the evaluation callback (TEvaluateProc)
var evaluatorProc: TEvaluateProc;
evaluatorProc :=
function(const ANodeToEvaluate: IAstNode): TDataValue
var
subDescriptor: IScopeDescriptor;
begin
// This is the compile-time evaluation (Binder + Evaluator)
// It runs in the *current* context (FInitialScope + FCurrentDescriptor)
// not the expansionScope.
var tempInitScope := TScope.CreateScope(FInitialScope.Parent, FCurrentDescriptor, nil);
var boundSubAst := TAstBinder.Bind(tempInitScope, ANodeToEvaluate, subDescriptor);
var evalScope := subDescriptor.CreateScope(tempInitScope);
var evaluator := FEvaluatorFactory(evalScope);
Result := evaluator.Execute(boundSubAst);
end;
// 4. Expand the macro body using the TExpansionVisitor
var expandedBody := TExpansionVisitor.Expand(expansionScope, macroDef.Body.Expression, evaluatorProc);
// 5. Wrap the result in a MacroExpansionNode (for debugging/tracing)
var macroNode := TMacroExpansionNode.Create(Node, expandedBody);
// 6. IMPORTANT: Re-run the expander on the *new* AST fragment
// to handle macros that expand into other macros.
Result := Self.Accept(macroNode);
end;
end.
Src/AST/Myc.Ast.Visitor.pas
+3 -1
View File
@@ -267,7 +267,9 @@ end;
function TAstTransformer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
var identifier := Accept(Node.Identifier).AsIntf<IIdentifierNode>;
var initializer := Accept(Node.Initializer).AsIntf<IAstNode>;
var initializer: IAstNode := nil;
if Node.Initializer <> nil then
initializer := Accept(Node.Initializer).AsIntf<IAstNode>;
if (identifier = Node.Identifier) and (initializer = Node.Initializer) then
Result := TDataValue.FromIntf<IVariableDeclarationNode>(Node)
else