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

Macro hygiene

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-09 18:22:09 +01:00
parent d849f65f2d
commit 7aa406f27b
9 changed files with 418 additions and 95 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Compiler.Macros.pas
+157 -4
View File
@@ -30,7 +30,18 @@ type
private
FEvaluate: TEvaluateProc;
FMacroScope: IExecutionScope;
FRenameMap: TDictionary<string, string>; // [*] Hygiene Rename Map (Rule 1)
FDefinitionDescriptor: IScopeDescriptor; // [*] Template Scope (Rule 1)
class var
FGensymCounter: Int64;
function TransformAndSpliceNodes(const ANodes: TArray<IAstNode>): TArray<IAstNode>;
// [*] Gensym helper
function Gensym(const ABaseName: string): string;
// [*] Scope management for template
procedure EnterScope;
procedure ExitScope;
protected
// Override the new IAstNode-returning methods
function VisitUnquote(const Node: IUnquoteNode): IAstNode; override;
@@ -38,8 +49,19 @@ type
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; override;
// [*] Hygiene implementation (Rule 1)
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
// [*] Hygiene implementation (Rule 1, 2, 3)
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
public
// [*] Updated constructor
constructor Create(const AMacroScope: IExecutionScope; const AEvaluate: TEvaluateProc);
destructor Destroy; override; // [*] Added
// [*] Updated static helper
class function Expand(const MacroScope: IExecutionScope; const RootNode: IAstNode; const AEvaluate: TEvaluateProc): IAstNode;
end;
@@ -62,6 +84,8 @@ type
function VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode; override;
// Finds and expands macro calls
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
// [*] Do not traverse into quasiquotes (they are handled by TExpansionVisitor)
function VisitQuasiquote(const Node: IQuasiquoteNode): IAstNode; override;
function VisitUnquote(const Node: IUnquoteNode): IAstNode; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode; override;
@@ -93,6 +117,7 @@ implementation
uses
System.Generics.Defaults,
System.SyncObjs,
Myc.Ast.Compiler.Binder,
Myc.Ast.Evaluator, // Required for TEvaluatorVisitor.Execute
Myc.Data.Keyword;
@@ -104,6 +129,43 @@ begin
inherited Create;
FMacroScope := AMacroScope;
FEvaluate := AEvaluate;
// [*] Initialize hygiene tools
FRenameMap := TDictionary<string, string>.Create;
// Create a descriptor for the *template* scope, parented to nil.
// It only tracks template-internal definitions for shadowing.
FDefinitionDescriptor := TScope.CreateDescriptor(nil);
end;
destructor TExpansionVisitor.Destroy;
begin
FRenameMap.Free;
// FDefinitionDescriptor is an interface
inherited;
end;
procedure TExpansionVisitor.EnterScope;
begin
// [*] Create a new nested definition scope
FDefinitionDescriptor := TScope.CreateDescriptor(FDefinitionDescriptor);
end;
procedure TExpansionVisitor.ExitScope;
begin
// [*] Revert to parent definition scope
FDefinitionDescriptor := FDefinitionDescriptor.Parent;
end;
function TExpansionVisitor.Gensym(const ABaseName: string): string;
begin
if not FRenameMap.TryGetValue(ABaseName, Result) then
begin
var count := TInterlocked.Add(FGensymCounter, 1);
inc(count);
Result := ABaseName + '_' + count.ToString;
FRenameMap.Add(ABaseName, Result);
end;
end;
class function TExpansionVisitor.Expand(
@@ -154,7 +216,7 @@ begin
end
else
begin
// Use the IAstNode-returning Accept helper
// [*] Use the IAstNode-returning Accept helper (hygienic transform)
transformedNode := Self.Accept(node);
if Assigned(transformedNode) then
newList.Add(transformedNode);
@@ -166,12 +228,92 @@ begin
end;
end;
function TExpansionVisitor.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
var
newName: string;
begin
// [*] Hygiene Rule 1: Check for local rename
// Is this symbol defined *within the template* (and thus renamed)?
if FRenameMap.TryGetValue(Node.Name, newName) then
begin
// Yes, replace it with the hygienic name (e.g. 'start-time$1')
// We use TTypes.Unknown because the Binder/TypeChecker run *after* this.
Result := TAst.Identifier(newName, TTypes.Unknown);
exit;
end;
// [*] Hygiene Rule 2 & 3: Free Symbol (Hygienic 'print' or Unhygienic '*debug-mode*')
// No, it's a free symbol. Leave it as-is.
// The TAstBinder will resolve it later, either in the
// macro's definition scope (Rule 2) or the caller's scope (Rule 3).
Result := Node;
end;
function TExpansionVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
var
newName: string;
newIdent: IIdentifierNode;
newInit: IAstNode;
begin
// [*] Hygiene Rule 1: This is a definition within the template.
// 1. Visit initializer *before* defining the var
// (so initializer can't see the var it's defining)
newInit := Accept(Node.Initializer);
// 2. Generate hygienic name
newName := Gensym(Node.Identifier.Name);
FDefinitionDescriptor.Define(newName);
// 3. Create new identifier node (type is unknown)
newIdent := TAst.Identifier(newName, TTypes.Unknown);
// 4. Create new VarDecl node
Result := TAst.VarDecl(newIdent, newInit, TTypes.Unknown);
end;
function TExpansionVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
var
newParams: TArray<IIdentifierNode>;
newBody: IAstNode;
newName: string;
i: Integer;
begin
// [*] Hygiene Rule 1: Lambda parameters are definitions.
// 1. Enter a new definition scope for the template
EnterScope;
try
// 2. Rename parameters
SetLength(newParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
newName := Gensym(Node.Parameters[i].Name);
FDefinitionDescriptor.Define(newName);
newParams[i] := TAst.Identifier(newName, TTypes.Unknown);
end;
// 3. Visit body recursively in the new scope
newBody := Accept(Node.Body);
finally
// 4. Exit definition scope
ExitScope;
end;
// 5. Create new Lambda node (type is unknown)
Result := TAst.LambdaExpr(newParams, newBody, nil, nil, False, TTypes.Unknown);
end;
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): IAstNode;
var
value: TDataValue;
expr: IAstNode;
symbol: TResolvedSymbol;
begin
// [*] This node *stops* the hygienic transformation.
// It reverts to the previous compile-time evaluation logic.
expr := Node.Expression;
// Check if we are unquoting a macro parameter (simple identifier)
@@ -220,7 +362,9 @@ var
newArgs: TArray<IAstNode>;
transformedCallee: IAstNode;
begin
// [*] Callee must be transformed hygienically
transformedCallee := Self.Accept(Node.Callee); // Calls IAstNode helper
// [*] Arguments must be transformed and allow splicing
newArgs := TransformAndSpliceNodes(Node.Arguments);
Result := TAst.FunctionCall(transformedCallee, newArgs);
end;
@@ -229,6 +373,7 @@ function TExpansionVisitor.VisitBlockExpression(const Node: IBlockExpressionNode
var
newExprs: TArray<IAstNode>;
begin
// [*] Expressions must be transformed and allow splicing
newExprs := TransformAndSpliceNodes(Node.Expressions);
Result := TAst.Block(newExprs);
end;
@@ -237,6 +382,7 @@ function TExpansionVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): I
begin
// Record literals do not support splicing.
// We just use the default TAstTransformer implementation which visits child values.
// [*] This will correctly call VisitIdentifier for keys/values.
Result := inherited VisitRecordLiteral(Node);
end;
@@ -361,6 +507,7 @@ begin
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i])); // Use FromIntf
// 3. Create the evaluation callback (TEvaluateProc)
// It must use the FInitialScope (for globals) and the expansionScope (for args)
var evaluatorProc: TEvaluateProc;
evaluatorProc :=
function(const ANodeToEvaluate: IAstNode): TDataValue
@@ -371,6 +518,7 @@ begin
boundSubAst: IAstNode;
begin
// This is the compile-time evaluation (Binder + Evaluator)
// [*] It must bind against the *expansion* scope, not the initial scope
boundSubAst := TAstBinder.Bind(expansionScope.CreateDescriptor, ANodeToEvaluate, subDescriptor);
// Create eval scope from the new descriptor, parented to the expansion scope
@@ -381,6 +529,7 @@ begin
end;
// 4. Expand the macro body using the TExpansionVisitor
// [*] FInitialScope removed from call
var expandedBody := TExpansionVisitor.Expand(expansionScope, macroDef.Body.AsQuasiquote.Expression, evaluatorProc);
// 5. Wrap the result in a MacroExpansionNode (for debugging/tracing)
@@ -393,17 +542,21 @@ end;
function TMacroExpander.VisitQuasiquote(const Node: IQuasiquoteNode): IAstNode;
begin
Result := Accept(Node.Expression);
// [*] Do not traverse into nested quasiquotes.
// TExpansionVisitor handles them when (if) they are unquoted.
Result := Node;
end;
function TMacroExpander.VisitUnquote(const Node: IUnquoteNode): IAstNode;
begin
Result := Accept(Node.Expression);
// [*] Standalone unquote (outside a quasiquote) is a syntax error.
raise Exception.Create('Unquote (`~`) can only be used inside a quasiquote (` `) template.');
end;
function TMacroExpander.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode;
begin
Result := Accept(Node.Expression);
// [*] Standalone unquote-splicing (outside a quasiquote) is a syntax error.
raise Exception.Create('Unquote-splicing (`~@`) can only be used inside a quasiquote (` `) template.');
end;
end.
Src/AST/Myc.Ast.Environment.pas
+43 -33
View File
@@ -42,6 +42,10 @@ type
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
function ExpandMacros(const Node: IAstNode): IAstNode;
function Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
function Lower(const Node: IAstNode): IAstNode;
function Compile(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc;
function CreateEnvironment: IEnvironment;
@@ -73,6 +77,7 @@ type
procedure Define(const Name: String; const AScript: IAstNode);
property Environment: IEnvironment read FEnvironment;
property RootScope: IExecutionScope read GetRootScope;
property MacroRegistry: IMacroRegistry read GetMacroRegistry;
end;
@@ -140,8 +145,11 @@ type
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
function Compile(const ANode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; overload;
function Compile(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc; overload;
function ExpandMacros(const Node: IAstNode): IAstNode;
function Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
function Lower(const Node: IAstNode): IAstNode;
function Compile(const Node: IAstNode; const Params: TArray<IIdentifierNode>): TDataValue.TFunc;
end;
// --- Factory Implementations ---
@@ -299,6 +307,14 @@ begin
inherited Destroy;
end;
function TEnvironment.Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
var boundAst := TAstBinder.Bind(FRootScope.CreateDescriptor, Node, Descriptor);
var typedAst := TTypeChecker.CheckTypes(boundAst, Descriptor);
Result := typedAst;
end;
function TEnvironment.GetMacroRegistry: IMacroRegistry;
begin
Result := FMacroRegistry;
@@ -319,44 +335,21 @@ begin
Result := TEnvironment.Create(TScope.CreateScope(FRootScope, nil, nil), TMacroRegistryImpl.Create(FMacroRegistry), FExecutionStrategy);
end;
function TEnvironment.Compile(const ANode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
// Step 1: Expand macros
var cExecutionStrategy := FExecutionStrategy;
var expandedAst :=
TMacroExpander.ExpandMacros(
FMacroRegistry,
FRootScope,
ANode,
function(const Scope: IExecutionScope): IEvaluatorVisitor begin Result := cExecutionStrategy.CreateVisitor(Scope); end
);
// Step 2: Bind names
var boundAst := TAstBinder.Bind(FRootScope.CreateDescriptor, expandedAst, Descriptor);
// Step 3: Check types
var typedAst := TTypeChecker.CheckTypes(boundAst, Descriptor);
// Step 4: Lowering
var loweredAst := TAstLowerer.Lower(typedAst);
// Step 5: TCO
var compiledAst := TAstTCO.Optimize(loweredAst);
Result := compiledAst;
end;
function TEnvironment.Compile(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc;
function TEnvironment.Compile(const Node: IAstNode; const Params: TArray<IIdentifierNode>): TDataValue.TFunc;
var
desc: IScopeDescriptor;
begin
var prg := TAst.LambdaExpr(Params, ANode);
var prg := TAst.LambdaExpr(Params, Node);
var compiled := Compile(prg, desc);
var expanded := ExpandMacros(prg);
var bound := Bind(expanded, desc);
var lowered := Lower(bound);
var tcoOptimized := TAstTCO.Optimize(lowered);
var visitor := FExecutionStrategy.CreateVisitor(desc.CreateScope(FRootScope));
var func := compiled.Accept(visitor).AsMethod;
var func := tcoOptimized.Accept(visitor).AsMethod;
Result :=
function(const Args: TArray<TDataValue>): TDataValue
@@ -366,4 +359,21 @@ begin
end;
end;
function TEnvironment.ExpandMacros(const Node: IAstNode): IAstNode;
begin
var cExecutionStrategy := FExecutionStrategy;
Result :=
TMacroExpander.ExpandMacros(
FMacroRegistry,
FRootScope,
Node,
function(const Scope: IExecutionScope): IEvaluatorVisitor begin Result := cExecutionStrategy.CreateVisitor(Scope); end
);
end;
function TEnvironment.Lower(const Node: IAstNode): IAstNode;
begin
Result := TAstLowerer.Lower(Node);
end;
end.