Michael Schimmel
451 lines
16 KiB
ObjectPascal
451 lines
16 KiB
ObjectPascal
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;
|
|
|
|
type
|
|
IAstMacroExpander = interface(IAstVisitor)
|
|
// Signatur geändert: Descriptor wird nicht mehr zurückgegeben
|
|
function Execute(const RootNode: IAstNode): 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
|
|
// Override the new IAstNode-returning methods
|
|
function VisitUnquote(const Node: IUnquoteNode): IAstNode; override;
|
|
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode; override;
|
|
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
|
|
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
|
|
function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; 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)
|
|
type
|
|
TMacroRegistry = class
|
|
private
|
|
FParent: TMacroRegistry;
|
|
FMacros: TDictionary<string, IMacroDefinitionNode>;
|
|
public
|
|
constructor Create(AParent: TMacroRegistry);
|
|
destructor Destroy; override;
|
|
procedure Define(const Name: string; const Node: IMacroDefinitionNode);
|
|
function Find(const Name: string): IMacroDefinitionNode;
|
|
end;
|
|
|
|
private
|
|
FInitialScope: IExecutionScope;
|
|
|
|
// Ersetzt FCurrentDescriptor
|
|
FCurrentMacroRegistry: TMacroRegistry;
|
|
|
|
FEvaluatorFactory: TEvaluatorFactory;
|
|
|
|
procedure EnterMacroScope;
|
|
procedure ExitMacroScope;
|
|
|
|
protected
|
|
// Finds macro definitions
|
|
function VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode; override;
|
|
// Finds and expands macro calls
|
|
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;
|
|
|
|
// NEU: Überschrieben für lexikalisches Makro-Scoping
|
|
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
|
|
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
|
|
|
|
public
|
|
constructor Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
|
|
destructor Destroy; override;
|
|
|
|
// Signatur geändert
|
|
function Execute(const RootNode: IAstNode): IAstNode;
|
|
|
|
class function ExpandMacros(
|
|
const InitialScope: IExecutionScope;
|
|
const RootNode: IAstNode;
|
|
const EvaluatorFactory: TEvaluatorFactory
|
|
): IAstNode; static;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.Generics.Defaults,
|
|
Myc.Ast.Binding, // Required for TAstBinder.Bind
|
|
Myc.Ast.Evaluator, // Required for TEvaluatorVisitor.Execute
|
|
Myc.Data.Keyword;
|
|
|
|
{ TMacroRegistry }
|
|
|
|
constructor TMacroExpander.TMacroRegistry.Create(AParent: TMacroRegistry);
|
|
begin
|
|
inherited Create;
|
|
FParent := AParent;
|
|
FMacros := TDictionary<string, IMacroDefinitionNode>.Create;
|
|
end;
|
|
|
|
destructor TMacroExpander.TMacroRegistry.Destroy;
|
|
begin
|
|
FMacros.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TMacroExpander.TMacroRegistry.Define(const Name: string; const Node: IMacroDefinitionNode);
|
|
begin
|
|
FMacros.AddOrSetValue(Name, Node);
|
|
end;
|
|
|
|
function TMacroExpander.TMacroRegistry.Find(const Name: string): IMacroDefinitionNode;
|
|
var
|
|
current: TMacroRegistry;
|
|
begin
|
|
current := Self;
|
|
while Assigned(current) do
|
|
begin
|
|
if current.FMacros.TryGetValue(Name, Result) then
|
|
exit;
|
|
current := current.FParent;
|
|
end;
|
|
Result := nil;
|
|
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);
|
|
try
|
|
Result := expander.Accept(RootNode); // Use IAstNode-returning Accept
|
|
finally
|
|
expander.Free;
|
|
end;
|
|
end;
|
|
|
|
function TExpansionVisitor.TransformAndSpliceNodes(const ANodes: TArray<IAstNode>): TArray<IAstNode>;
|
|
var
|
|
newList: TList<IAstNode>;
|
|
nodeToSplice: IAstNode;
|
|
transformedNode: IAstNode;
|
|
begin
|
|
newList := TList<IAstNode>.Create;
|
|
try
|
|
for var node in ANodes do
|
|
begin
|
|
if node.Kind = akUnquoteSplicing then
|
|
begin
|
|
var spliceExpr := node.AsUnquoteSplicing.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.Kind = akBlockExpression then
|
|
newList.AddRange(nodeToSplice.AsBlockExpression.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
|
|
// Use the IAstNode-returning Accept helper
|
|
transformedNode := Self.Accept(node);
|
|
if Assigned(transformedNode) then
|
|
newList.Add(transformedNode);
|
|
end;
|
|
end;
|
|
Result := newList.ToArray;
|
|
finally
|
|
newList.Free;
|
|
end;
|
|
end;
|
|
|
|
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): IAstNode;
|
|
var
|
|
value: TDataValue;
|
|
expr: IAstNode;
|
|
symbol: TResolvedSymbol;
|
|
begin
|
|
expr := Node.Expression;
|
|
|
|
// Check if we are unquoting a macro parameter (simple identifier)
|
|
if expr.Kind = akIdentifier then
|
|
begin
|
|
symbol := FMacroScope.CreateDescriptor.FindSymbol(expr.AsIdentifier.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.AsIntf<IAstNode>; // Return the node directly
|
|
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.AsIntf<IAstNode>;
|
|
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 := 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): IAstNode;
|
|
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): IAstNode;
|
|
var
|
|
newArgs: TArray<IAstNode>;
|
|
transformedCallee: IAstNode;
|
|
begin
|
|
transformedCallee := Self.Accept(Node.Callee); // Calls IAstNode helper
|
|
newArgs := TransformAndSpliceNodes(Node.Arguments);
|
|
Result := TAst.FunctionCall(transformedCallee, newArgs);
|
|
end;
|
|
|
|
function TExpansionVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
|
|
var
|
|
newExprs: TArray<IAstNode>;
|
|
begin
|
|
newExprs := TransformAndSpliceNodes(Node.Expressions);
|
|
Result := TAst.Block(newExprs);
|
|
end;
|
|
|
|
function TExpansionVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode;
|
|
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;
|
|
|
|
// Erzeugt die Root-Registry für Makros
|
|
FCurrentMacroRegistry := TMacroRegistry.Create(nil);
|
|
end;
|
|
|
|
destructor TMacroExpander.Destroy;
|
|
begin
|
|
FCurrentMacroRegistry.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TMacroExpander.EnterMacroScope;
|
|
begin
|
|
// Erstellt eine neue Registry mit der aktuellen als Parent
|
|
FCurrentMacroRegistry := TMacroRegistry.Create(FCurrentMacroRegistry);
|
|
end;
|
|
|
|
procedure TMacroExpander.ExitMacroScope;
|
|
var
|
|
oldRegistry: TMacroRegistry;
|
|
begin
|
|
oldRegistry := FCurrentMacroRegistry;
|
|
FCurrentMacroRegistry := oldRegistry.FParent;
|
|
oldRegistry.Free;
|
|
end;
|
|
|
|
class function TMacroExpander.ExpandMacros(
|
|
const InitialScope: IExecutionScope;
|
|
const RootNode: IAstNode;
|
|
const EvaluatorFactory: TEvaluatorFactory
|
|
): IAstNode;
|
|
begin
|
|
// IAstMacroExpander.Execute gibt keinen Descriptor mehr zurück
|
|
var expander := TMacroExpander.Create(InitialScope, EvaluatorFactory) as IAstMacroExpander;
|
|
Result := expander.Execute(RootNode);
|
|
end;
|
|
|
|
function TMacroExpander.Execute(const RootNode: IAstNode): IAstNode;
|
|
begin
|
|
// This executes the transformation (Accept)
|
|
Result := Accept(RootNode); // Calls the IAstNode-returning helper
|
|
|
|
if not Assigned(Result) then
|
|
Result := TAst.Block([]); // e.g. if root was (defmacro ...)
|
|
|
|
// Descriptor := FCurrentDescriptor; // Entfernt
|
|
end;
|
|
|
|
function TMacroExpander.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
|
|
begin
|
|
// Ein 'do'-Block eröffnet einen neuen Scope für Makros
|
|
EnterMacroScope;
|
|
try
|
|
Result := inherited VisitBlockExpression(Node);
|
|
finally
|
|
ExitMacroScope;
|
|
end;
|
|
end;
|
|
|
|
function TMacroExpander.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
|
|
begin
|
|
// Eine 'fn' eröffnet einen neuen Scope für Makros
|
|
EnterMacroScope;
|
|
try
|
|
Result := inherited VisitLambdaExpression(Node);
|
|
finally
|
|
ExitMacroScope;
|
|
end;
|
|
end;
|
|
|
|
function TMacroExpander.VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode;
|
|
begin
|
|
// Register the macro in the *current* macro registry
|
|
FCurrentMacroRegistry.Define(Node.Name.Name, Node);
|
|
|
|
// Keep the node in the AST (for the visualizer).
|
|
Result := Node;
|
|
end;
|
|
|
|
function TMacroExpander.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
|
|
var
|
|
calleeIdentifier: IIdentifierNode;
|
|
macroDef: IMacroDefinitionNode;
|
|
i: Integer;
|
|
begin
|
|
// Check if this is an identifier
|
|
if Node.Callee.Kind <> akIdentifier then
|
|
exit(inherited VisitFunctionCall(Node));
|
|
|
|
calleeIdentifier := Node.Callee.AsIdentifier;
|
|
|
|
// Check if this identifier is a macro in the current registry
|
|
macroDef := FCurrentMacroRegistry.Find(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
|
|
// It must be parented to the *initial* scope to find other macros/globals.
|
|
var expansionScope := TAst.CreateScope(FInitialScope);
|
|
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])); // Use FromIntf
|
|
|
|
// 3. Create the evaluation callback (TEvaluateProc)
|
|
var evaluatorProc: TEvaluateProc;
|
|
evaluatorProc :=
|
|
function(const ANodeToEvaluate: IAstNode): TDataValue
|
|
var
|
|
subDescriptor: IScopeDescriptor;
|
|
evalScope: IExecutionScope;
|
|
evaluator: IEvaluatorVisitor;
|
|
boundSubAst: IAstNode;
|
|
begin
|
|
// This is the compile-time evaluation (Binder + Evaluator)
|
|
// Es wird der 'expansionScope' verwendet, der die AST-Argumente enthält
|
|
boundSubAst := TAstBinder.Bind(expansionScope, ANodeToEvaluate, subDescriptor);
|
|
|
|
// Create eval scope from the new descriptor, parented to the expansion scope
|
|
evalScope := subDescriptor.CreateScope(expansionScope);
|
|
|
|
evaluator := FEvaluatorFactory(evalScope);
|
|
Result := evaluator.Execute(boundSubAst);
|
|
end;
|
|
|
|
// 4. Expand the macro body using the TExpansionVisitor
|
|
var expandedBody := TExpansionVisitor.Expand(expansionScope, macroDef.Body.AsQuasiquote.Expression, evaluatorProc);
|
|
|
|
// 5. Wrap the result in a MacroExpansionNode (for debugging/tracing)
|
|
var macroNode := TAst.MacroExpansionNode(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); // Calls the IAstNode helper, returns IAstNode
|
|
end;
|
|
|
|
function TMacroExpander.VisitQuasiquote(const Node: IQuasiquoteNode): IAstNode;
|
|
begin
|
|
Result := Accept(Node.Expression);
|
|
end;
|
|
|
|
function TMacroExpander.VisitUnquote(const Node: IUnquoteNode): IAstNode;
|
|
begin
|
|
Result := Accept(Node.Expression);
|
|
end;
|
|
|
|
function TMacroExpander.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode;
|
|
begin
|
|
Result := Accept(Node.Expression);
|
|
end;
|
|
|
|
end.
|