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

Macro expander integrated in binder

Browse Source
This commit is contained in:
Michael Schimmel
2025-10-05 02:45:13 +02:00
parent 54bf350c70
commit 0d73a13051
6 changed files with 373 additions and 218 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Binding.pas
+127 -167
View File
@@ -6,6 +6,7 @@ uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Visitor,
@@ -21,15 +22,16 @@ type
TAstBinder = class; // Forward declaration
// This visitor handles the expansion of a single macro body (` `...`).
// It correctly distinguishes between syntactic unquoting and value unquoting.
TExpansionVisitor = class(TAstTransformer)
private
FBinder: TAstBinder;
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;
public
constructor Create(const ABinder: TAstBinder; const AMacroScope: IExecutionScope);
end;
@@ -53,7 +55,9 @@ type
FNextIsTail: Boolean;
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
FEvaluatorFactory: TEvaluatorFactory;
FMacros: TDictionary<string, IMacroDefinitionNode>;
// Operator folding maps
FBinaryOperators: TDictionary<string, TScalar.TBinaryOp>;
FUnaryOperators: TDictionary<string, TScalar.TUnaryOp>;
procedure EnterScope;
procedure ExitScope;
@@ -152,6 +156,44 @@ begin
FMacroScope := AMacroScope;
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;
@@ -160,82 +202,49 @@ var
begin
expr := Node.Expression;
// Check if the expression is a simple identifier that refers to a macro parameter.
if (expr is TIdentifierNode) then
begin
addr := FMacroScope.CreateDescriptor.FindSymbol((expr as TIdentifierNode).Name);
if (addr.Kind = akLocalOrParent) and (addr.ScopeDepth = 0) then
begin
// It's a macro parameter. Get its value, which is the AST passed as an argument.
var argValue := FMacroScope.Values[addr];
if argValue.Kind = vkInterface then
begin
// This is syntactic unquoting. Return the AST directly.
Result := argValue;
exit;
end;
end;
end;
// If it's not a parameter or the parameter doesn't hold an AST, it's value unquoting.
// Evaluate the expression at compile time using the binder's context.
value := FBinder.EvaluateAtCompileTime(expr);
// Convert the resulting value back into an AST node to splice it into the tree.
if value.Kind in [vkScalar, vkText, vkVoid] then
Result := TDataValue.FromIntf<IAstNode>(TAst.Constant(value))
else
// For now, other complex types are not supported for value unquoting.
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
// Similar to VisitUnquote, but we expect the result to be a list of nodes.
// We evaluate the inner expression. The result is a TDataValue.
// We don't do anything with it here; we just return it.
// The VisitFunctionCall override will check for this and perform the "splicing".
var value := VisitUnquote(TAst.Unquote(Node.Expression)).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IUnquoteSplicingNode>(TAst.UnquoteSplicing(value));
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: TList<IAstNode>;
transformedArg: IAstNode;
splicingNode: IUnquoteSplicingNode;
newArgs: TArray<IAstNode>;
transformedCallee: IAstNode;
begin
// This override handles splicing arguments (~@).
newArgs := TList<IAstNode>.Create;
try
for var arg in Node.Arguments do
begin
var transformedArgValue := Self.Accept(arg); // This might return an UnquoteSplicing node.
if transformedArgValue.IsVoid then
continue;
transformedCallee := Self.Accept(Node.Callee).AsIntf<IAstNode>;
newArgs := TransformAndSpliceNodes(Node.Arguments);
Result := TDataValue.FromIntf<IFunctionCallNode>(TAst.FunctionCall(transformedCallee, newArgs));
end;
transformedArg := transformedArgValue.AsIntf<IAstNode>;
if (transformedArg is TUnquoteSplicingNode) then
begin
splicingNode := transformedArg as TUnquoteSplicingNode;
// The inner expression should have been evaluated to an AST block
if (splicingNode.Expression is TBlockExpressionNode) then
newArgs.AddRange((splicingNode.Expression as TBlockExpressionNode).Expressions)
else
raise Exception.Create('Expression inside unquote-splicing (`~@`) must evaluate to a list of nodes (a block).');
end
else
begin
newArgs.Add(transformedArg);
end;
end;
var transformedCallee := Self.Accept(Node.Callee).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IFunctionCallNode>(TAst.FunctionCall(transformedCallee, newArgs.ToArray));
finally
newArgs.Free;
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;
{ TBoundIdentifierNode }
@@ -312,6 +321,8 @@ end;
{ TAstBinder }
constructor TAstBinder.Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
var
op: TScalar.TBinaryOp;
begin
inherited Create;
Assert(Assigned(AInitialScope));
@@ -325,15 +336,24 @@ begin
FIsTailStack := TStack<Boolean>.Create;
FNextIsTail := True;
FBoxedDeclarations := nil;
FMacros := TDictionary<string, IMacroDefinitionNode>.Create;
// Initialize operator folding maps
FBinaryOperators := TDictionary<string, TScalar.TBinaryOp>.Create;
for op := Low(TScalar.TBinaryOp) to High(TScalar.TBinaryOp) do
FBinaryOperators.Add(op.ToString, op);
FUnaryOperators := TDictionary<string, TScalar.TUnaryOp>.Create;
FUnaryOperators.Add('not', TScalar.TUnaryOp.Not);
// Note: '-' is handled as a special case in VisitFunctionCall
end;
destructor TAstBinder.Destroy;
begin
FUnaryOperators.Free;
FBinaryOperators.Free;
FIsTailStack.Free;
FUpvalueStack.Free;
FBoxedDeclarations.Free;
FMacros.Free;
inherited;
end;
@@ -364,20 +384,11 @@ var
evaluator: IEvaluatorVisitor;
tempInitScope: IExecutionScope;
begin
// Create a temporary scope that represents the binder's current lexical context.
tempInitScope := TScope.CreateScope(FInitialScope.Parent, FCurrentDescriptor, nil);
// 1. Bind the sub-tree in a new binder, using the current scope descriptor.
subBinder := TAstBinder.Create(tempInitScope, FEvaluatorFactory);
boundSubAst := subBinder.Execute(ANode, subDescriptor);
// 2. Create the execution scope for this specific evaluation.
evalScope := subDescriptor.CreateScope(tempInitScope);
// 3. Create the correct evaluator (Debug/Production) using the injected factory.
evaluator := FEvaluatorFactory(evalScope);
// 4. Execute and return the resulting value.
Result := evaluator.Execute(boundSubAst);
end;
@@ -388,15 +399,10 @@ begin
EnterScope;
try
var transformedValue := Accept(RootNode);
// Handle the case where the entire script was just declarations.
if transformedValue.IsVoid then
// Return a valid, empty AST.
Result := TAst.Block([])
else
// The script produced a valid, executable AST.
Result := transformedValue.AsIntf<IAstNode>;
Descriptor := FCurrentDescriptor;
finally
ExitScope;
@@ -408,101 +414,89 @@ end;
function TAstBinder.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
begin
// Register the macro for the current binder instance.
FMacros.AddOrSetValue(Node.Name.Name, Node);
// Return an empty block node. This is a valid "no-op" node
// that is simply ignored by the evaluator and safely handled by all visitors.
FCurrentDescriptor.DefineMacro(Node.Name.Name, Node);
Result := TDataValue.Void;
end;
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
macroDef: IMacroDefinitionNode;
calleeIdentifier: TIdentifierNode;
i: Integer;
expansionScope: IExecutionScope;
expander: TExpansionVisitor;
expandedBody: IAstNode;
isTailCall: Boolean;
callee: IAstNode;
args: TArray<IAstNode>;
boundCall: IFunctionCallNode;
binaryOp: TScalar.TBinaryOp;
unaryOp: TScalar.TUnaryOp;
macroDef: IMacroDefinitionNode;
begin
// First, check if this is a macro call.
// --- Optimization: Operator Folding ---
if (Node.Callee is TIdentifierNode) then
begin
calleeIdentifier := Node.Callee as TIdentifierNode;
if FMacros.TryGetValue(calleeIdentifier.Name, macroDef) then
// Try to fold binary operators
if FBinaryOperators.TryGetValue(calleeIdentifier.Name, binaryOp) then
begin
// It's a macro. Expand it now.
expansionScope := TAst.CreateScope(nil);
// Check for variadic macro parameter
var params := macroDef.Parameters;
var lastParamName := '';
if Length(params) > 0 then
lastParamName := params[High(params)].Name;
if (Length(params) > 1) and (lastParamName.StartsWith('&')) then
if Length(Node.Arguments) = 2 then
begin
var requiredArgs := Length(params) - 1;
if Length(Node.Arguments) < requiredArgs then
raise Exception.CreateFmt(
'Macro %s expects at least %d arguments, but got %d',
[calleeIdentifier.Name, requiredArgs, Length(Node.Arguments)]);
// Bind fixed arguments
for i := 0 to requiredArgs - 1 do
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
// Bind rest arguments as a list (AST block)
var restArgs: TArray<IAstNode>;
SetLength(restArgs, Length(Node.Arguments) - requiredArgs);
for i := 0 to High(restArgs) do
restArgs[i] := Node.Arguments[requiredArgs + i];
expansionScope.Define(lastParamName.Substring(1), TDataValue.FromIntf<IAstNode>(TAst.Block(restArgs)));
end
else
begin
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]));
FNextIsTail := False;
var left := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
var right := Accept(Node.Arguments[1]).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IAstNode>(TAst.BinaryExpr(left, binaryOp, right));
exit;
end;
end;
// Try to fold unary operators
if FUnaryOperators.TryGetValue(calleeIdentifier.Name, unaryOp) then
begin
if Length(Node.Arguments) = 1 then
begin
FNextIsTail := False;
var right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IAstNode>(TAst.UnaryExpr(unaryOp, right));
exit;
end;
end;
// Special case for negation '-'
if (calleeIdentifier.Name = '-') and (Length(Node.Arguments) = 1) then
begin
FNextIsTail := False;
var right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IAstNode>(TAst.UnaryExpr(TScalar.TUnaryOp.Negate, right));
exit;
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 var i := 0 to High(params) do
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
// A macro body MUST be a quasiquote.
if not (macroDef.Body is TQuasiquoteNode) then
raise Exception.CreateFmt('Macro body for "%s" must be a quasiquoted expression.', [calleeIdentifier.Name]);
// Use the dedicated expansion visitor to process the CONTENT of the macro body.
var quasiquoteBody := macroDef.Body as TQuasiquoteNode;
expander := TExpansionVisitor.Create(Self, expansionScope);
expandedBody := expander.Execute(quasiquoteBody.Expression);
// Bind the newly generated AST fragment.
var expander := TExpansionVisitor.Create(Self, expansionScope);
var expandedBody := expander.Execute(quasiquoteBody.Expression);
var boundExpandedBody := Self.Accept(expandedBody).AsIntf<IAstNode>;
// Wrap the result in a TMacroExpansionNode.
// The original 'Node' is passed to preserve the call site information for tools.
var macroNode := TMacroExpansionNode.Create(Node, boundExpandedBody);
Result := TDataValue.FromIntf<IMacroExpansionNode>(macroNode);
exit;
end;
end;
// It's a regular function call, proceed with normal binding.
isTailCall := FIsTailStack.Peek;
// --- Default: Bind as a standard function call ---
var isTailCall := FIsTailStack.Peek;
FNextIsTail := False;
callee := Accept(Node.Callee).AsIntf<IAstNode>;
args := TransformNodes<IAstNode>(Node.Arguments);
boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
var callee := Accept(Node.Callee).AsIntf<IAstNode>;
var args := TransformNodes<IAstNode>(Node.Arguments);
var boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
Result := TDataValue.FromIntf<IFunctionCallNode>(boundCall);
end;
@@ -513,22 +507,11 @@ var
boundExpandedBody: IAstNode;
boundOriginalCall: IFunctionCallNode;
begin
// This handles the case where a macro expansion node is injected into the
// tree before binding. The binder must recursively bind its contents.
// 1. Bind the components of the original call site.
boundCallee := Accept(Node.Callee).AsIntf<IAstNode>;
boundArgs := TransformNodes<IAstNode>(Node.Arguments);
// 2. Bind the expanded body.
boundExpandedBody := Accept(Node.ExpandedBody).AsIntf<IAstNode>;
// 3. Re-create the IFunctionCallNode part of the original call with bound children.
boundOriginalCall := TAst.FunctionCall(boundCallee, boundArgs);
// 4. Create a new TMacroExpansionNode that wraps the now-bound components.
var newMacroNode := TMacroExpansionNode.Create(boundOriginalCall, boundExpandedBody);
Result := TDataValue.FromIntf<IMacroExpansionNode>(newMacroNode);
end;
@@ -543,11 +526,9 @@ var
begin
if Name.IsEmpty then
exit(False);
c := Name[1];
if not (c.IsLetter or (c = '_')) then
exit(False);
for c in Name do
begin
if not (c.IsLetterOrDigit or (c = '_') or (c = '-')) then
@@ -583,7 +564,6 @@ begin
begin
FNextIsTail := isContextTail and (i = High(Node.Expressions));
transformedValue := Accept(Node.Expressions[i]);
// If a sub-expression (like a macro definition) returns a void value, skip it.
if not transformedValue.IsVoid then
exprList.Add(transformedValue.AsIntf<IAstNode>);
end;
@@ -592,7 +572,6 @@ begin
exprList.Free;
end;
// Avoid creating a new node if nothing changed.
if (Length(exprs) = Length(Node.Expressions)) then
begin
var same := True;
@@ -618,10 +597,8 @@ var
condition, thenBranch, elseBranch: IAstNode;
begin
isContextTail := FIsTailStack.Peek;
FNextIsTail := False;
condition := Accept(Node.Condition).AsIntf<IAstNode>;
FNextIsTail := isContextTail;
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
@@ -648,7 +625,6 @@ begin
EnterScope;
try
FCurrentDescriptor.Define('<self>');
SetLength(boundParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
@@ -659,10 +635,8 @@ begin
end;
lastNestedLambdaCount := FNestedLambdaCount;
FNextIsTail := True;
boundBody := Accept(Node.Body).AsIntf<IAstNode>;
hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
lambdaScope := FCurrentDescriptor;
finally
@@ -677,11 +651,9 @@ begin
function(const Left, Right: TPair<TResolvedAddress, Integer>): Integer begin Result := Left.Value - Right.Value; end
)
);
SetLength(upvalues, Length(sortedPairs));
for i := 0 to High(sortedPairs) do
upvalues[i] := sortedPairs[i].Key;
finally
FUpvalueStack.Pop;
end;
@@ -695,7 +667,6 @@ function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue;
begin
if not FIsTailStack.Peek then
raise Exception.Create('''recur'' can only be used in a tail position.');
FNextIsTail := False;
Result := inherited VisitRecurNode(Node);
end;
@@ -706,10 +677,8 @@ var
condition, thenBranch, elseBranch: IAstNode;
begin
isContextTail := FIsTailStack.Peek;
FNextIsTail := False;
condition := Accept(Node.Condition).AsIntf<IAstNode>;
FNextIsTail := isContextTail;
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
@@ -737,17 +706,13 @@ begin
if (adr.ScopeDepth > 0) and (FUpvalueStack.Count > 0) then
begin
var upvalue := FUpvalueStack.Peek;
// up to outer scope
dec(adr.ScopeDepth);
var upvalueIndex: Integer;
if not upvalue.Map.TryGetValue(adr, upvalueIndex) then
begin
upvalueIndex := upvalue.Map.Count;
upvalue.Map.Add(adr, upvalueIndex);
end;
boundNode := TBoundIdentifierNode.Create(Node, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex));
end
else
@@ -777,13 +742,8 @@ begin
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name);
address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
boundIdentifier := TBoundIdentifierNode.Create(Node.Identifier, address);
// Check if the analysis pass marked this declaration as being captured by a closure.
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
// Always create a bound declaration node, passing the IsBoxed flag.
boundDecl := TBoundVariableDeclarationNode.Create(boundIdentifier, initializer, isBoxed);
Result := TDataValue.FromIntf<IVariableDeclarationNode>(boundDecl);
end;