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

Refactor Compiler Pipeline: Decouple Scope Layout from Runtime Descriptor

Browse Source 
- **Architecture:** Split `IScopeDescriptor` into `IScopeLayout` (Binder/Structure) and immutable `IScopeDescriptor` (Runtime/Types).
- **Binder:** Now produces `IScopeLayout` via `IScopeBuilder`. Restored Upvalue tracking and Lambda nesting detection.
- **TypeChecker:** Introduced `TTypeContext` to track types during traversal. Now produces the final `IScopeDescriptor`.
- **Evaluator:** Adapted to new `ILambdaExpressionNode` structure.
- **Fixes:** Resolved `Scope depth mismatch` in TypeChecker and `AccessViolation` in Evaluator due to lost parent scopes.
This commit is contained in:
Michael Schimmel
2025-11-21 12:01:14 +01:00
parent ae10f4eee0
commit 58c44079f7
18 changed files with 1236 additions and 1194 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Compiler.Binder.Upvalues.pas
+114 -103
View File
@@ -16,10 +16,29 @@ type
// This visitor analyzes the AST to find all variables that need to be "lifted" or "boxed"
// because they are captured by a nested lambda.
TUpvalueAnalyzer = class(TAstTransformer)
private
type
// Internal helper to track scopes during analysis without using IScopeDescriptor
TAnalysisScope = class
private
FParent: TAnalysisScope;
// Maps Name -> DeclarationNode.
// If Value is nil, it means the name is defined (e.g. parameter) but not a candidate for boxing.
FDeclarations: TDictionary<string, IVariableDeclarationNode>;
public
constructor Create(AParent: TAnalysisScope);
destructor Destroy; override;
procedure Define(const Name: string; const Node: IVariableDeclarationNode);
// Returns the scope where the symbol is defined and the declaration node (if any)
function Resolve(const Name: string; out ScopeDepth: Integer; out Node: IVariableDeclarationNode): Boolean;
end;
private
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
FCurrentDescriptor: IScopeDescriptor;
FDeclarationMap: TDictionary<IScopeDescriptor, TDictionary<string, IVariableDeclarationNode>>;
FCurrentScope: TAnalysisScope;
procedure MarkDeclarationForBoxing(const AName: string);
protected
// Overridden Visit methods to perform analysis during traversal.
@@ -27,13 +46,12 @@ type
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
public
constructor Create(const AParent: IScopeDescriptor);
constructor Create;
destructor Destroy; override;
// Added Execute method
function Execute(const ARootNode: IAstNode): IAstNode;
class function Analyze(const ARootNode: IAstNode; const AParent: IScopeDescriptor): THashSet<IVariableDeclarationNode>; static;
class function Analyze(const ARootNode: IAstNode): THashSet<IVariableDeclarationNode>; static;
end;
implementation
@@ -42,39 +60,88 @@ uses
System.Generics.Defaults,
Myc.Ast.Types;
{ TUpvalueAnalyzer.TAnalysisScope }
constructor TUpvalueAnalyzer.TAnalysisScope.Create(AParent: TAnalysisScope);
begin
inherited Create;
FParent := AParent;
FDeclarations := TDictionary<string, IVariableDeclarationNode>.Create;
end;
destructor TUpvalueAnalyzer.TAnalysisScope.Destroy;
begin
FDeclarations.Free;
inherited;
end;
procedure TUpvalueAnalyzer.TAnalysisScope.Define(const Name: string; const Node: IVariableDeclarationNode);
begin
FDeclarations.AddOrSetValue(Name, Node);
end;
function TUpvalueAnalyzer.TAnalysisScope.Resolve(const Name: string; out ScopeDepth: Integer; out Node: IVariableDeclarationNode): Boolean;
var
current: TAnalysisScope;
begin
ScopeDepth := 0;
current := Self;
while Assigned(current) do
begin
if current.FDeclarations.TryGetValue(Name, Node) then
begin
Result := True;
exit;
end;
Inc(ScopeDepth);
current := current.FParent;
end;
Node := nil;
Result := False;
end;
{ TUpvalueAnalyzer }
constructor TUpvalueAnalyzer.Create(const AParent: IScopeDescriptor);
constructor TUpvalueAnalyzer.Create;
begin
inherited Create;
FBoxedDeclarations := THashSet<IVariableDeclarationNode>.Create;
FDeclarationMap :=
TObjectDictionary<IScopeDescriptor, TDictionary<string, IVariableDeclarationNode>>
.Create([doOwnsValues], TEqualityComparer<IScopeDescriptor>.Default);
FCurrentDescriptor := TScope.CreateDescriptor(AParent);
// Create a root scope to handle top-level definitions cleanly
FCurrentScope := TAnalysisScope.Create(nil);
end;
destructor TUpvalueAnalyzer.Destroy;
begin
FDeclarationMap.Free;
// Unwind scope stack if exception occurred or Execute wasn't fully clean
while Assigned(FCurrentScope.FParent) do
begin
var temp := FCurrentScope;
FCurrentScope := FCurrentScope.FParent;
temp.Free;
end;
FCurrentScope.Free;
FBoxedDeclarations.Free;
inherited Destroy;
end;
function TUpvalueAnalyzer.Execute(const ARootNode: IAstNode): IAstNode;
begin
// Accept will call the Visit... methods and traverse the tree
Result := Accept(ARootNode);
end;
class function TUpvalueAnalyzer.Analyze(const ARootNode: IAstNode; const AParent: IScopeDescriptor): THashSet<IVariableDeclarationNode>;
class function TUpvalueAnalyzer.Analyze(const ARootNode: IAstNode): THashSet<IVariableDeclarationNode>;
var
analyzer: TUpvalueAnalyzer; // Changed to concrete type
analyzer: TUpvalueAnalyzer;
begin
// Note: AParent (IScopeDescriptor) removed from arguments as this analyzer
// builds its own structural view and only cares about boxing internal variables.
if not Assigned(ARootNode) then
exit(THashSet<IVariableDeclarationNode>.Create);
analyzer := TUpvalueAnalyzer.Create(AParent);
analyzer := TUpvalueAnalyzer.Create;
try
analyzer.Execute(ARootNode);
Result := analyzer.FBoxedDeclarations;
@@ -86,124 +153,68 @@ end;
procedure TUpvalueAnalyzer.MarkDeclarationForBoxing(const AName: string);
var
symbol: TResolvedSymbol;
declarationScope: IScopeDescriptor;
i: Integer;
depth: Integer;
declNode: IVariableDeclarationNode;
begin
symbol := FCurrentDescriptor.FindSymbol(AName);
if symbol.Address.Kind <> akLocalOrParent then
exit;
// Walk up the scope chain to find the scope where the variable was declared.
declarationScope := FCurrentDescriptor;
for i := 1 to symbol.Address.ScopeDepth do
// Check if the symbol exists in our analysis scopes
if FCurrentScope.Resolve(AName, depth, declNode) then
begin
if not Assigned(declarationScope.Parent) then
exit; // Should not happen in a correctly bound tree
declarationScope := declarationScope.Parent;
end;
// Find the declaration node in our map and add it to the set.
var dict: TDictionary<string, IVariableDeclarationNode>;
if FDeclarationMap.TryGetValue(declarationScope, dict) then
begin
var declNode: IVariableDeclarationNode;
if dict.TryGetValue(AName, declNode) then
// If it is found in a parent scope (Depth > 0) AND we have a trackable declaration node for it
if (depth > 0) and Assigned(declNode) then
begin
FBoxedDeclarations.Add(declNode);
end;
end;
end;
function TUpvalueAnalyzer.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
var
symbol: TResolvedSymbol;
begin
if Assigned(FCurrentDescriptor) then
begin
symbol := FCurrentDescriptor.FindSymbol(Node.Name);
// Check if this identifier refers to a variable from an outer scope
MarkDeclarationForBoxing(Node.Name);
if (symbol.Address.Kind = akLocalOrParent) and (symbol.Address.ScopeDepth > 0) then
begin
// This is an upvalue. Mark its original declaration for boxing.
MarkDeclarationForBoxing(Node.Name);
end;
end;
// This is a leaf node, do not call inherited.
// Return original node (Analysis pass only)
Result := Node;
end;
function TUpvalueAnalyzer.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
var
newParams: TArray<IIdentifierNode>;
newBody: IAstNode;
i: Integer;
begin
// A lambda creates a new lexical scope, inheriting from the current one.
FCurrentDescriptor := TScope.CreateDescriptor(FCurrentDescriptor);
// 1. Enter new analysis scope
FCurrentScope := TAnalysisScope.Create(FCurrentScope);
try
// Manually visit parameters to define them
var oldParams := Node.Parameters;
SetLength(newParams, Length(oldParams));
for i := 0 to High(oldParams) do
// 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 High(Node.Parameters) do
begin
// Accept(param) will call VisitIdentifier, which does its job.
// We *must* use the result of Accept.
newParams[i] := Accept(oldParams[i]).AsIdentifier;
FCurrentDescriptor.Define(newParams[i].Name, TTypes.Unknown);
FCurrentScope.Define(Node.Parameters[i].Name, nil);
end;
// Traverse the lambda body within the new scope context.
newBody := Accept(Node.Body); // Manual traversal
// 3. Visit Body
Accept(Node.Body); // Recursive call
// Rebuild node if changed
if (newParams = Node.Parameters) and (newBody = Node.Body) then
Result := Node
else
// Use factory, pass through other properties (which are nil/false at this stage)
Result := TAst.LambdaExpr(newParams, newBody, Node.ScopeDescriptor, Node.Upvalues, Node.HasNestedLambdas, Node.StaticType);
// Rebuild if needed (default CoW behavior)
Result := Node;
finally
// Restore the parent scope after leaving the lambda.
FCurrentDescriptor := FCurrentDescriptor.Parent;
// 4. Exit scope
var temp := FCurrentScope;
FCurrentScope := FCurrentScope.FParent;
temp.Free;
end;
end;
function TUpvalueAnalyzer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
var
scopeDeclarations: TDictionary<string, IVariableDeclarationNode>;
newInitializer: IAstNode;
newIdentifier: IIdentifierNode;
begin
// Traverse the initializer first. It's evaluated in the current scope
// before the new variable is defined.
// 1. Visit initializer first (it executes in the CURRENT scope)
if Assigned(Node.Initializer) then
newInitializer := Accept(Node.Initializer)
else
newInitializer := nil;
Accept(Node.Initializer);
// Traverse the identifier
// This calls VisitIdentifier, but VisitIdentifier is just an analyzer, it returns the same node.
newIdentifier := Accept(Node.Identifier).AsIdentifier;
// 2. Define the variable in the CURRENT scope
// Store the Node reference so we can add it to FBoxedDeclarations if captured.
FCurrentScope.Define(Node.Identifier.Name, Node);
// After processing the initializer, define the variable in the current scope.
// We use TTypes.Unknown as type inference hasn't run yet.
FCurrentDescriptor.Define(newIdentifier.Name, TTypes.Unknown);
// --- Rebuild Node ---
// Use CoW, check if anything changed
if (newInitializer = Node.Initializer) and (newIdentifier = Node.Identifier) then
Result := Node
else
// Use factory, pass through other properties (which are nil/false at this stage)
Result := TAst.VarDecl(newIdentifier, newInitializer, Node.StaticType, Node.IsBoxed);
// Map this *new* declaration node to its scope and name for later lookup.
if not FDeclarationMap.TryGetValue(FCurrentDescriptor, scopeDeclarations) then
begin
scopeDeclarations := TDictionary<string, IVariableDeclarationNode>.Create;
FDeclarationMap.Add(FCurrentDescriptor, scopeDeclarations);
end;
// IMPORTANT: Store the *new* node (Result)
scopeDeclarations.Add(newIdentifier.Name, Result.AsVariableDeclaration);
Result := Node;
end;
end.
Src/AST/Myc.Ast.Compiler.Binder.pas
+191 -237
View File
@@ -18,55 +18,54 @@ uses
type
IAstBinder = interface(IAstVisitor)
// AArgTypes is now passed to the implementation via its constructor
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
function Execute(const RootNode: IAstNode; out Layout: IScopeLayout): IAstNode;
end;
TAstBinder = class; // Forward declaration
TAstBinder = class(TAstTransformer, IAstBinder)
private
type
TUpvalueMapping = TDictionary<TResolvedAddress, Integer>;
TUpvalueMap = TDictionary<TResolvedAddress, Integer>;
private
FCurrentDescriptor: IScopeDescriptor;
FUpvalueStack: TStack<TUpvalueMapping>;
FNestedLambdaCount: Integer;
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
FCurrentBuilder: IScopeBuilder;
FUpvalueStack: TObjectStack<TUpvalueMap>;
FArgTypes: TArray<IStaticType>;
FFunctionRegistry: IFunctionDefinitionRegistry;
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
// Fix for TExecutionScope parent chain optimization
FLambdaCounter: Integer;
procedure EnterScope;
procedure ExitScope;
function IsValidIdentifier(const Name: string): Boolean;
function ResolveSymbol(const Name: string; out Address: TResolvedAddress): Boolean;
function CaptureUpvalue(const PhysicalAddress: TResolvedAddress): Integer;
protected
// --- Core Binding Logic (Mutators) ---
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;
// --- Transformation Logic (Restored) ---
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
// --- Standard Traversal (Use inherited) ---
function VisitKeyword(const Node: IKeywordNode): IAstNode; override;
function VisitConstant(const Node: IConstantNode): IAstNode; override;
function VisitKeyword(const Node: IKeywordNode): IAstNode; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode; override;
public
constructor Create(
const AInitialDescriptor: IScopeDescriptor;
const AParentLayout: IScopeLayout;
const AFunctionRegistry: IFunctionDefinitionRegistry;
const AArgTypes: TArray<IStaticType>
);
destructor Destroy; override;
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
function Execute(const RootNode: IAstNode; out Layout: IScopeLayout): IAstNode;
class function Bind(
const InitialDescriptor: IScopeDescriptor;
const ParentLayout: IScopeLayout;
const RootNode: IAstNode;
out Descriptor: IScopeDescriptor;
out Layout: IScopeLayout;
const AFunctionRegistry: IFunctionDefinitionRegistry = nil;
const AArgTypes: TArray<IStaticType> = nil
): IAstNode; static;
@@ -77,6 +76,7 @@ implementation
uses
System.Generics.Defaults,
System.Character,
System.Hash,
Myc.Data.Keyword;
type
@@ -86,7 +86,6 @@ type
function GetHashCode(const Value: TResolvedAddress): Integer; override;
end;
{ TResolvedAddressComparer }
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
begin
Result := (Left = Right);
@@ -94,29 +93,28 @@ end;
function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer;
begin
Result := 17;
Result := Result * 23 + Ord(Value.Kind);
Result := Result * 23 + Value.ScopeDepth;
Result := Result * 23 + Value.SlotIndex;
Result := THashBobJenkins.GetHashValue(Value.Kind, SizeOf(TAddressKind), 0);
Result := THashBobJenkins.GetHashValue(Value.ScopeDepth, SizeOf(Integer), Result);
Result := THashBobJenkins.GetHashValue(Value.SlotIndex, SizeOf(Integer), Result);
end;
{ TAstBinder }
constructor TAstBinder.Create(
const AInitialDescriptor: IScopeDescriptor;
const AParentLayout: IScopeLayout;
const AFunctionRegistry: IFunctionDefinitionRegistry;
const AArgTypes: TArray<IStaticType>
);
begin
inherited Create;
Assert(Assigned(AInitialDescriptor));
FCurrentBuilder := TScope.CreateBuilder(AParentLayout);
FUpvalueStack := TObjectStack<TUpvalueMap>.Create(True);
FUpvalueStack.Push(TUpvalueMap.Create(TResolvedAddressComparer.Create));
FCurrentDescriptor := AInitialDescriptor;
FFunctionRegistry := AFunctionRegistry;
FArgTypes := AArgTypes;
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(True); // Use Comparer
FNestedLambdaCount := 0;
FBoxedDeclarations := nil;
FLambdaCounter := 0;
end;
destructor TAstBinder.Destroy;
@@ -127,25 +125,30 @@ begin
end;
class function TAstBinder.Bind(
const InitialDescriptor: IScopeDescriptor;
const ParentLayout: IScopeLayout;
const RootNode: IAstNode;
out Descriptor: IScopeDescriptor;
out Layout: IScopeLayout;
const AFunctionRegistry: IFunctionDefinitionRegistry = nil;
const AArgTypes: TArray<IStaticType> = nil
): IAstNode;
begin
var binder := TAstBinder.Create(InitialDescriptor, AFunctionRegistry, AArgTypes) as IAstBinder;
Result := binder.Execute(RootNode, Descriptor);
var binder := TAstBinder.Create(ParentLayout, AFunctionRegistry, AArgTypes);
try
Result := binder.Execute(RootNode, Layout);
finally
binder.Free;
end;
end;
procedure TAstBinder.EnterScope;
function TAstBinder.Execute(const RootNode: IAstNode; out Layout: IScopeLayout): IAstNode;
begin
FCurrentDescriptor := TScope.CreateDescriptor(FCurrentDescriptor);
end;
FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode);
procedure TAstBinder.ExitScope;
begin
FCurrentDescriptor := FCurrentDescriptor.Parent;
Result := Accept(RootNode);
if not Assigned(Result) then
Result := TAst.Block([]);
Layout := FCurrentBuilder.Build;
end;
function TAstBinder.IsValidIdentifier(const Name: string): Boolean;
@@ -158,141 +161,176 @@ begin
if not (c.IsLetter or (c = '_')) then
exit(False);
for c in Name do
begin
if not (c.IsLetterOrDigit or (c = '_') or (c = '-')) then
exit(False);
end;
Result := True;
end;
function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
function TAstBinder.ResolveSymbol(const Name: string; out Address: TResolvedAddress): Boolean;
var
layout: IScopeLayout;
depth: Integer;
slot: Integer;
begin
// Pre-pass: Find all variables that need boxing
FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode, FCurrentDescriptor.Parent);
try
EnterScope;
try
Result := Accept(RootNode); // Accept returns IAstNode
if not Assigned(Result) then
Result := TAst.Block([]);
layout := FCurrentBuilder;
depth := 0;
// Set the type of the root expression (e.g., the final 'do' block)
Descriptor := FCurrentDescriptor;
finally
ExitScope;
while Assigned(layout) do
begin
slot := layout.FindSlot(Name);
if slot >= 0 then
begin
Address := TResolvedAddress.Create(akLocalOrParent, depth, slot);
Result := True;
exit;
end;
finally
FBoxedDeclarations.Free; // Free the set
FBoxedDeclarations := nil;
layout := layout.Parent;
Inc(depth);
end;
Result := False;
end;
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
function TAstBinder.CaptureUpvalue(const PhysicalAddress: TResolvedAddress): Integer;
var
currentMap: TUpvalueMap;
begin
// --- Transformation: Keyword-as-Function ---
// This transformation must happen *before* type checking.
if Node.Callee.Kind = akKeyword then
currentMap := FUpvalueStack.Peek;
if not currentMap.TryGetValue(PhysicalAddress, Result) then
begin
var keywordNode := Node.Callee.AsKeyword;
if Length(Node.Arguments) <> 1 then
raise EArgumentException.CreateFmt(
'Keyword :%s expects exactly one argument (the record/map), but got %d',
[keywordNode.Value.Name, Length(Node.Arguments)]);
// Manually visit the argument (which is the base)
var baseNode := Accept(Node.Arguments[0]);
// Manually visit the keyword (which is the member)
var memberNode := Accept(keywordNode).AsKeyword;
// Create the new MemberAccess node
var memberAccessNode := TAst.MemberAccess(baseNode, memberNode);
// Visit the *new* node to bind it (though it has no bindable symbols)
Result := Accept(memberAccessNode);
exit;
Result := currentMap.Count;
currentMap.Add(PhysicalAddress, Result);
end;
// --- Default: Bind as a standard function call ---
// Use the inherited implementation to visit children (Callee, Arguments)
Result := inherited VisitFunctionCall(Node);
// Set metadata for *this* node (IsTailCall is set later by TCO)
end;
function TAstBinder.VisitConstant(const Node: IConstantNode): IAstNode;
begin
// Binding pass does not assign types.
Result := Node;
end;
function TAstBinder.VisitKeyword(const Node: IKeywordNode): IAstNode;
begin
// Binding pass does not assign types.
Result := Node;
end;
function TAstBinder.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode;
begin
// Binding pass does not assign types.
Result := Node;
end;
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
var
physAddr: TResolvedAddress;
upvalueIndex: Integer;
begin
if Node.Address.Kind = akUnresolved then
begin
if not ResolveSymbol(Node.Name, physAddr) then
raise Exception.CreateFmt('Undefined identifier: "%s"', [Node.Name]);
if physAddr.ScopeDepth > 0 then
begin
upvalueIndex := CaptureUpvalue(physAddr);
Result := TAst.Identifier(Node.Name, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex), TTypes.Unknown);
end
else
Result := TAst.Identifier(Node.Name, physAddr, TTypes.Unknown);
end
else
Result := Node;
end;
function TAstBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
var
slot: Integer;
addr: TResolvedAddress;
newInit: IAstNode;
newIdent: IIdentifierNode;
isBoxed: Boolean;
begin
if not IsValidIdentifier(Node.Identifier.Name) then
raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]);
slot := FCurrentBuilder.Define(Node.Identifier.Name);
addr := TResolvedAddress.Create(akLocalOrParent, 0, slot);
if Assigned(Node.Initializer) then
newInit := Accept(Node.Initializer)
else
newInit := nil;
newIdent := TAst.Identifier(Node.Identifier.Name, addr, TTypes.Unknown);
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
Result := TAst.VarDecl(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;
var
newIdent: IAstNode;
newValue: IAstNode;
begin
newIdent := Accept(Node.Identifier);
newValue := Accept(Node.Value);
Result := TAst.Assign(newIdent.AsIdentifier, newValue, TTypes.Unknown);
if Assigned(FFunctionRegistry) and (newValue <> nil) and (newValue.Kind = akLambdaExpression) then
begin
if newIdent.AsIdentifier.Address.Kind = akLocalOrParent then
FFunctionRegistry.Register(newIdent.AsIdentifier.Address, newValue.AsLambdaExpression);
end;
end;
function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
var
i: integer;
adr: TResolvedAddress;
scopeDescriptor: IScopeDescriptor;
upvalues: TArray<TResolvedAddress>;
hasNestedLambdas: Boolean;
lastNestedLambdaCount: Integer;
parentBuilder: IScopeBuilder;
paramType: IStaticType;
newParams: TArray<IIdentifierNode>;
newBody: IAstNode;
paramType: IStaticType;
finalLayout: IScopeLayout;
i, slot: Integer;
addr: TResolvedAddress;
capturedMap: TUpvalueMap;
sortedPairs: TArray<TPair<TResolvedAddress, Integer>>;
upvaluesList: TArray<TResolvedAddress>;
startCount: Integer;
hasNested: Boolean;
begin
// We do *not* call inherited, as we must manage the scope manually.
// Count logic: Measure how many lambdas are visited inside this one.
startCount := FLambdaCounter;
Inc(FLambdaCounter); // Count self
parentBuilder := FCurrentBuilder;
FCurrentBuilder := TScope.CreateBuilder(parentBuilder);
capturedMap := TUpvalueMap.Create(TResolvedAddressComparer.Create);
FUpvalueStack.Push(capturedMap);
FUpvalueStack.Push(TUpvalueMapping.Create(TResolvedAddressComparer.Create));
try
EnterScope;
try
// Define <self> (slot 0)
FCurrentDescriptor.Define('<self>', TTypes.Unknown);
FCurrentBuilder.Define('<self>');
// Define parameters
SetLength(newParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
var paramNode := Node.Parameters[i]; // This is a TIdentifierNode
SetLength(newParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
slot := FCurrentBuilder.Define(Node.Parameters[i].Name);
addr := TResolvedAddress.Create(akLocalOrParent, 0, slot);
// Check if this is the root lambda (stack count = 1)
// and we have pre-defined types for it (from specialization)
paramType := TTypes.Unknown;
if (FUpvalueStack.Count = 1) and (FArgTypes <> nil) and (i < Length(FArgTypes)) then
paramType := FArgTypes[i]; // Use the specialized type
paramType := TTypes.Unknown;
if (parentBuilder.Parent = nil) and (FArgTypes <> nil) and (i < Length(FArgTypes)) then
paramType := FArgTypes[i];
// Define the symbol in the descriptor WITH the type
var slotIndex := FCurrentDescriptor.Define(paramNode.Name, paramType);
adr := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
// Create a new TIdentifierNode, now with the correct type
newParams[i] := TAst.Identifier(paramNode.Name, adr, paramType);
end;
// Visit the body *within the new scope*
lastNestedLambdaCount := FNestedLambdaCount;
newBody := Accept(Node.Body);
hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
// Save the descriptor for the evaluator
scopeDescriptor := FCurrentDescriptor;
finally
ExitScope;
newParams[i] := TAst.Identifier(Node.Parameters[i].Name, addr, paramType);
end;
// --- Extract Upvalues ---
var upvalueMapping := FUpvalueStack.Peek;
var sortedPairs := upvalueMapping.ToArray;
// Sort by index (Value)
newBody := Accept(Node.Body);
finalLayout := FCurrentBuilder.Build;
sortedPairs := capturedMap.ToArray;
TArray.Sort<TPair<TResolvedAddress, Integer>>(
sortedPairs,
TComparer<TPair<TResolvedAddress, Integer>>.Construct(
@@ -300,122 +338,38 @@ begin
)
);
SetLength(upvalues, Length(sortedPairs));
for i := 0 to High(upvalues) do
upvalues[i] := sortedPairs[i].Key;
SetLength(upvaluesList, Length(sortedPairs));
for i := 0 to High(sortedPairs) do
begin
var rawAddr := sortedPairs[i].Key;
if rawAddr.Kind = akLocalOrParent then
begin
Assert(rawAddr.ScopeDepth > 0, 'Logic Error: Trying to capture a local variable.');
Dec(rawAddr.ScopeDepth);
end;
upvaluesList[i] := rawAddr;
end;
finally
FCurrentBuilder := parentBuilder;
FUpvalueStack.Pop;
end;
inc(FNestedLambdaCount);
// Calculate HasNested: If counter increased by more than 1 (self), we have children.
hasNested := FLambdaCounter > (startCount + 1);
// Create new immutable node using the factory
Result := TAst.LambdaExpr(newParams, newBody, scopeDescriptor, upvalues, hasNestedLambdas);
Result := TAst.LambdaExpr(newParams, newBody, finalLayout, nil, upvaluesList, hasNested);
end;
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
var
symbol: TResolvedSymbol;
adr: TResolvedAddress;
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
begin
// We only bind nodes that are the base parser type
// (i.e., address is unresolved).
if Node.Address.Kind = akUnresolved then
if Node.Callee.Kind = akKeyword then
begin
symbol := FCurrentDescriptor.FindSymbol(Node.Name);
adr := symbol.Address;
if adr.Kind = akUnresolved then
raise Exception.CreateFmt('Undefined identifier: "%s"', [Node.Name]);
if adr.Kind = akLocalOrParent then
begin
if (adr.ScopeDepth > 0) and (FUpvalueStack.Count > 0) then
begin
// --- Handle Upvalue ---
var upvalueMap := FUpvalueStack.Peek;
// Adjust address to be relative to the captured scope
dec(adr.ScopeDepth);
var upvalueIndex: Integer;
if not upvalueMap.TryGetValue(adr, upvalueIndex) then
begin
// This is a new upvalue for this lambda
upvalueIndex := upvalueMap.Count;
upvalueMap.Add(adr, upvalueIndex);
end;
// Create final upvalue address
adr := TResolvedAddress.Create(akUpvalue, 0, upvalueIndex);
end;
// else: It's a local (ScopeDepth=0), adr is already correct.
end;
// else: It was already an upvalue (e.g. nested lambda), adr is correct.
// --- Replace Node ---
Result := TAst.Identifier(Node.Name, adr, symbol.StaticType);
end
else
begin
// It's already bound (e.g., a parameter), just return it.
Result := Node;
end;
end;
function TAstBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
var
slotIndex: Integer;
address: TResolvedAddress;
isBoxed: Boolean;
newInitializer: IAstNode;
newIdentifier: IIdentifierNode;
begin
// 1. Validate name
if not IsValidIdentifier(Node.Identifier.Name) then
raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]);
// 2. Define the symbol in the scope *first*.
// This allows the initializer (e.g., a lambda) to recursively refer to this symbol.
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name, TTypes.Unknown);
address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
// 3. Visit the Initializer *after* the symbol is defined
if Assigned(Node.Initializer) then
newInitializer := Accept(Node.Initializer)
else
newInitializer := nil;
// 4. Create the new (bound) identifier node
// The TypeChecker will set the final type
newIdentifier := TAst.Identifier(Node.Identifier.Name, address, TTypes.Unknown);
// 5. Check if this declaration needs boxing (from UpvalueAnalyzer pass)
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
// 6. Create the new VariableDeclaration node using the factory
Result := TAst.VarDecl(newIdentifier, newInitializer, TTypes.Unknown, isBoxed);
// 7. Store in registry *only if the registry was provided*
// (This must happen *after* visiting the initializer)
if Assigned(FFunctionRegistry) and (newInitializer <> nil) and (newInitializer.Kind = akLambdaExpression) then
FFunctionRegistry.Register(address, newInitializer.AsLambdaExpression);
end;
function TAstBinder.VisitAssignment(const Node: IAssignmentNode): IAstNode;
var
newIdent: IIdentifierNode;
newValue: IAstNode;
begin
Result := inherited VisitAssignment(Node);
newValue := Result.AsAssignment.Value;
newIdent := Result.AsAssignment.Identifier;
if Assigned(FFunctionRegistry) and (newValue <> nil) and (newValue.Kind = akLambdaExpression) then
begin
FFunctionRegistry.Register(newIdent.Address, newValue.AsLambdaExpression);
var memberAccess := TAst.MemberAccess(Accept(Node.Arguments[0]), Node.Callee.AsKeyword);
Result := memberAccess;
exit;
end;
Result := inherited VisitFunctionCall(Node);
end;
end.
Src/AST/Myc.Ast.Compiler.Macros.pas
+57 -178
View File
@@ -13,79 +13,55 @@ uses
Myc.Ast.Scope,
Myc.Ast.Types,
Myc.Ast,
Myc.Ast.Environment; // Added for IMacroRegistry
Myc.Ast.Environment;
type
IAstMacroExpander = interface(IAstVisitor)
// Signatur geaendert: Descriptor wird nicht mehr zurueckgegeben
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;
FRenameMap: TDictionary<string, string>; // [*] Hygiene Rename Map (Rule 1)
FDefinitionDescriptor: IScopeDescriptor; // [*] Template Scope (Rule 1)
FRenameMap: TDictionary<string, string>;
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;
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;
// [*] 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
destructor Destroy; override;
// [*] Updated static helper
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;
FCurrentMacroRegistry: IMacroRegistry; // Changed from TMacroRegistry
FCurrentMacroRegistry: IMacroRegistry;
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;
// [*] 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;
@@ -94,19 +70,17 @@ type
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
public
// Updated Constructor
constructor Create(
const ARootRegistry: IMacroRegistry;
const AInitialScope: IExecutionScope;
const AEvaluatorFactory: TEvaluatorFactory
);
destructor Destroy; override; // Modified
destructor Destroy; override;
function Execute(const RootNode: IAstNode): IAstNode;
// Updated static helper
class function ExpandMacros(
const ARootRegistry: IMacroRegistry; // Added
const ARootRegistry: IMacroRegistry;
const AInitialScope: IExecutionScope;
const RootNode: IAstNode;
const EvaluatorFactory: TEvaluatorFactory
@@ -119,7 +93,7 @@ uses
System.Generics.Defaults,
System.SyncObjs,
Myc.Ast.Compiler.Binder,
Myc.Ast.Evaluator, // Required for TEvaluatorVisitor.Execute
Myc.Ast.Evaluator,
Myc.Data.Keyword;
{ TExpansionVisitor }
@@ -129,41 +103,23 @@ 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;
if count < 0 then
count := -count;
Result := ABaseName + '#' + count.ToString;
FRenameMap.Add(ABaseName, Result);
end;
end;
@@ -176,7 +132,7 @@ class function TExpansionVisitor.Expand(
begin
var expander := TExpansionVisitor.Create(MacroScope, AEvaluate);
try
Result := expander.Accept(RootNode); // Use IAstNode-returning Accept
Result := expander.Accept(RootNode);
finally
expander.Free;
end;
@@ -195,7 +151,6 @@ 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
@@ -204,19 +159,15 @@ begin
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 (hygienic transform)
transformedNode := Self.Accept(node);
if Assigned(transformedNode) then
newList.Add(transformedNode);
@@ -232,20 +183,11 @@ function TExpansionVisitor.VisitIdentifier(const Node: IIdentifierNode): IAstNod
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;
@@ -255,20 +197,9 @@ var
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;
@@ -279,82 +210,58 @@ var
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;
SetLength(newParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
newName := Gensym(Node.Parameters[i].Name);
newParams[i] := TAst.Identifier(newName, TTypes.Unknown);
end;
// 5. Create new Lambda node (type is unknown)
Result := TAst.LambdaExpr(newParams, newBody, nil, nil, False, TTypes.Unknown);
newBody := Accept(Node.Body);
Result := TAst.LambdaExpr(newParams, newBody, nil, nil, nil, False, TTypes.Unknown);
end;
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): IAstNode;
var
value: TDataValue;
expr: IAstNode;
symbol: TResolvedSymbol;
addr: TResolvedAddress;
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)
if expr.Kind = akIdentifier then
begin
symbol := FMacroScope.Descriptor.FindSymbol(expr.AsIdentifier.Name);
if (symbol.Address.Kind = akLocalOrParent) and (symbol.Address.ScopeDepth = 0) then
addr := FMacroScope.Resolve(expr.AsIdentifier.Name);
if (addr.Kind = akLocalOrParent) and (addr.ScopeDepth = 0) then
begin
// It's a parameter. Return the TDataValue containing the AST node passed as argument.
var argValue := FMacroScope.Values[symbol.Address];
var argValue := FMacroScope.Values[addr];
if argValue.Kind = vkInterface then
begin
Result := argValue.AsIntf<IAstNode>; // Return the node directly
Result := argValue.AsIntf<IAstNode>;
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
Result := TAst.Constant(value)
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).');
raise Exception.Create('Unquote-splicing (`~@`) can only appear inside a list form.');
end;
function TExpansionVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
@@ -362,9 +269,7 @@ 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
transformedCallee := Self.Accept(Node.Callee);
newArgs := TransformAndSpliceNodes(Node.Arguments);
Result := TAst.FunctionCall(transformedCallee, newArgs);
end;
@@ -373,16 +278,12 @@ 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;
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.
// [*] This will correctly call VisitIdentifier for keys/values.
Result := inherited VisitRecordLiteral(Node);
end;
@@ -395,33 +296,23 @@ constructor TMacroExpander.Create(
);
begin
inherited Create;
Assert(Assigned(ARootRegistry));
Assert(Assigned(AInitialScope));
Assert(Assigned(AEvaluatorFactory));
FInitialScope := AInitialScope;
FEvaluatorFactory := AEvaluatorFactory;
// Creates the root registry for this specific compilation run,
// parented to the global registry from the environment.
FCurrentMacroRegistry := ARootRegistry.CreateChildRegistry;
end;
destructor TMacroExpander.Destroy;
begin
// FCurrentMacroRegistry is an interface, managed by ARC
inherited Destroy;
end;
procedure TMacroExpander.EnterMacroScope;
begin
// Creates a new registry with the current as Parent
FCurrentMacroRegistry := FCurrentMacroRegistry.CreateChildRegistry;
end;
procedure TMacroExpander.ExitMacroScope;
begin
// Revert to parent registry. ARC will free the old child.
FCurrentMacroRegistry := FCurrentMacroRegistry.Parent;
end;
@@ -432,18 +323,15 @@ class function TMacroExpander.ExpandMacros(
const EvaluatorFactory: TEvaluatorFactory
): IAstNode;
begin
// IAstMacroExpander.Execute gibt keinen Descriptor mehr zurueck
var expander := TMacroExpander.Create(ARootRegistry, AInitialScope, 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
Result := Accept(RootNode);
if not Assigned(Result) then
Result := TAst.Block([]); // e.g. if root was (defmacro ...)
Result := TAst.Block([]);
end;
function TMacroExpander.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
@@ -468,10 +356,7 @@ end;
function TMacroExpander.VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode;
begin
// Register the macro in the *current* macro registry
FCurrentMacroRegistry.Define(Node);
// Keep the node in the AST (for the visualizer).
Result := Node;
end;
@@ -481,82 +366,76 @@ var
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
exit(inherited VisitFunctionCall(Node));
// --- It is a macro, expand it ---
// --- Macro Expansion ---
// 1. Create the temporary scope for the macro parameters
// It must be parented to the *initial* scope to find other globals.
// 1. Create temporary scope for macro arguments (parented to Initial/Global Scope)
var expansionScope := TScope.CreateScope(FInitialScope, nil, 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)]);
raise Exception.CreateFmt('Macro %s expects %d arguments.', [calleeIdentifier.Name, Length(params)]);
// 2. Populate scope: Map parameter names to the *un-evaluated* AST nodes
// 2. Populate scope
for i := 0 to High(params) do
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i])); // Use FromIntf
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
// 3. Create the evaluation callback (TEvaluateProc)
// It must use the FInitialScope (for globals) and the expansionScope (for args)
// 3. Create Evaluator Callback
var evaluatorProc: TEvaluateProc;
evaluatorProc :=
function(const ANodeToEvaluate: IAstNode): TDataValue
var
subDescriptor: IScopeDescriptor;
evalScope: IExecutionScope;
tmpLayout: IScopeLayout;
scratchScope: IExecutionScope;
evaluator: IEvaluatorVisitor;
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.Descriptor, ANodeToEvaluate, subDescriptor);
// A. BINDING
// The Binder creates a virtual child scope builder.
// Symbols in expansionScope will have ScopeDepth = 1.
// We access the layout via the descriptor (which for dynamic scopes is created on demand/proxy).
// Note: expansionScope is dynamic, so its Descriptor.Layout reflects current variables.
boundSubAst := TAstBinder.Bind(expansionScope.Descriptor.Layout, ANodeToEvaluate, tmpLayout);
// Create eval scope from the new descriptor, parented to the expansion scope
evalScope := subDescriptor.CreateScope(expansionScope);
// B. SCOPE MATCHING (The Fix)
// We must execute in a child scope so that ScopeDepth = 1 correctly points to expansionScope.
scratchScope := TScope.CreateScope(expansionScope, nil, nil);
evaluator := FEvaluatorFactory(evalScope);
// C. EXECUTION
evaluator := FEvaluatorFactory(scratchScope);
Result := evaluator.Execute(boundSubAst);
end;
// 4. Expand the macro body using the TExpansionVisitor
// [*] FInitialScope removed from call
// 4. Expand Body
var expandedBody := TExpansionVisitor.Expand(expansionScope, macroDef.Body.AsQuasiquote.Expression, evaluatorProc);
// 5. Wrap the result in a MacroExpansionNode (for debugging/tracing)
// 5. Wrap result
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
// 6. Re-expand result
Result := Self.Accept(macroNode);
end;
function TMacroExpander.VisitQuasiquote(const Node: IQuasiquoteNode): IAstNode;
begin
// [*] 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
// [*] Standalone unquote (outside a quasiquote) is a syntax error.
raise Exception.Create('Unquote (`~`) can only be used inside a quasiquote (` `) template.');
raise Exception.Create('Unquote (`~`) can only be used inside a quasiquote.');
end;
function TMacroExpander.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode;
begin
// [*] Standalone unquote-splicing (outside a quasiquote) is a syntax error.
raise Exception.Create('Unquote-splicing (`~@`) can only be used inside a quasiquote (` `) template.');
raise Exception.Create('Unquote-splicing (`~@`) can only be used inside a quasiquote.');
end;
end.
Src/AST/Myc.Ast.Compiler.Specializer.pas
+13 -46
View File
@@ -19,7 +19,7 @@ type
function Execute(const RootNode: IAstNode): IAstNode;
end;
// This transformer runs *after* TypeChecker
// 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.
TStaticSpecializer = class(TAstTransformer, IAstSpecializer)
@@ -35,11 +35,8 @@ type
constructor Create(const AEnvironment: IEnvironment);
function Execute(const RootNode: IAstNode): IAstNode;
class function Specialize(
const AEnvironment: IEnvironment;
const RootNode: IAstNode;
const ADescriptor: IScopeDescriptor
): IAstNode; static;
// Descriptor removed from signature as it is not needed for specialization
class function Specialize(const AEnvironment: IEnvironment; const RootNode: IAstNode): IAstNode; static;
end;
implementation
@@ -53,13 +50,8 @@ begin
FEnvironment := AEnvironment;
end;
class function TStaticSpecializer.Specialize(
const AEnvironment: IEnvironment;
const RootNode: IAstNode;
const ADescriptor: IScopeDescriptor
): IAstNode;
class function TStaticSpecializer.Specialize(const AEnvironment: IEnvironment; const RootNode: IAstNode): IAstNode;
begin
// ADescriptor is no longer needed here, the environment has all it needs
var specializer := TStaticSpecializer.Create(AEnvironment) as IAstSpecializer;
Result := specializer.Execute(RootNode);
end;
@@ -73,7 +65,6 @@ end;
function TStaticSpecializer.GetStaticRtlFunction(const AName: string; const AArgTypes: TArray<IStaticType>): TSpecializedMethod;
begin
// Helper to query the RTL bootstrap cache
Result := TRtlRegistry.GetStaticSpecialization(AName, AArgTypes);
end;
@@ -136,15 +127,8 @@ begin
if FEnvironment.MonomorphCache.TryGetValue(key, specializedMethod) then
begin
// 4a. Cache Hit (Environment): Found user-defined or previously specialized fn
Result :=
TAst.FunctionCall(
newCallee,
newArgs,
specializedMethod.ReturnType, // Use the type from the cache
Node.IsTailCall,
specializedMethod.Target // Use the TFunc from the cache
);
// 4a. Cache Hit (Environment)
Result := TAst.FunctionCall(newCallee, newArgs, specializedMethod.ReturnType, Node.IsTailCall, specializedMethod.Target);
exit;
end;
@@ -152,17 +136,10 @@ begin
specializedMethod := GetStaticRtlFunction(funcName, argTypes);
if Assigned(specializedMethod.Target) then
begin
// 5a. Cache Hit (RTL): Found a native, static RTL function
// 5a. Cache Hit (RTL)
FEnvironment.MonomorphCache.Add(key, specializedMethod);
Result :=
TAst.FunctionCall(
newCallee,
newArgs,
specializedMethod.ReturnType, // Use the type from the cache
Node.IsTailCall,
specializedMethod.Target // Use the TFunc from the cache
);
Result := TAst.FunctionCall(newCallee, newArgs, specializedMethod.ReturnType, Node.IsTailCall, specializedMethod.Target);
exit;
end;
@@ -171,22 +148,19 @@ begin
if (funcDef <> nil) then
begin
// Cannot specialize closures or functions with nested closures
// that might depend on the local environment being detached.
// We check if it's a lambda expression node (which it usually is)
// Cannot specialize closures safely without more complex analysis
if funcDef.Kind = akLambdaExpression then
begin
var lambdaDef := funcDef.AsLambdaExpression;
if (Length(lambdaDef.Upvalues) > 0) or (lambdaDef.HasNestedLambdas) then
begin
// This function relies on local scope context. We cannot lift it
// to a static compilation unit safely. Fallback to dynamic dispatch.
Result := TAst.FunctionCall(newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil);
exit;
end;
end;
// 6a. Compile func with KNOWN TYPES
// This recursively triggers Bind -> Check -> Specialize for the callee body!
var compiled := FEnvironment.Compile(funcDef, argTypes);
// 6b. Store in cache
@@ -195,19 +169,12 @@ begin
specializedMethod := TSpecializedMethod.Create(compiled.Func, returnType);
FEnvironment.MonomorphCache.Add(key, specializedMethod);
// 6e. Return the new node
Result :=
TAst.FunctionCall(
newCallee,
newArgs,
returnType, // Use the extracted return type
Node.IsTailCall,
compiled.Func // Use the compiled TFunc
);
// 6c. Return the new node
Result := TAst.FunctionCall(newCallee, newArgs, returnType, Node.IsTailCall, compiled.Func);
exit;
end;
// 7. Fallback: Not RTL, Not User-Code (oder AST nicht gefunden) -> Dynamic
// 7. Fallback: Not RTL, Not User-Code -> Dynamic
if (newCallee = Node.Callee) and (newArgs = Node.Arguments) then
Result := Node
else
Src/AST/Myc.Ast.Compiler.TCO.pas
+11 -11
View File
@@ -18,7 +18,7 @@ type
function Execute(const RootNode: IAstNode): IAstNode;
end;
// This transformer runs *after* the Lowerer (Phase 4).
// This transformer runs *after* the Lowerer (Phase 4/5) and Specializer.
// Its sole responsibility is to identify tail calls (TCO)
// and set the `IsTailCall` flag on TFunctionCallNode.
TAstTCO = class(TAstTransformer, IAstTCO)
@@ -70,7 +70,7 @@ end;
function TAstTCO.Execute(const RootNode: IAstNode): IAstNode;
begin
Result := Accept(RootNode); // Use IAstNode-returning Accept
Result := Accept(RootNode);
if not Assigned(Result) then
Result := TAst.Block([]);
end;
@@ -85,7 +85,7 @@ begin
FIsTailStack.Push(FNextIsTail);
try
// Call inherited Accept, which handles the data unwrapping
// Call inherited Accept
Result := inherited Accept(Node);
finally
FNextIsTail := FIsTailStack.Pop;
@@ -105,6 +105,7 @@ begin
Node.Expressions,
function(idx: Integer; Node: IAstNode): IAstNode
begin
// Only the last expression in the block inherits the tail position status
FNextIsTail := isContextTail and (idx = nTail);
Result := Accept(Node);
end
@@ -165,11 +166,11 @@ var
newParams: TArray<IIdentifierNode>;
newBody: IAstNode;
begin
// Parameters are not in tail position (handled by AcceptParameters)
// Parameters are not in tail position
FNextIsTail := False;
newParams := AcceptParameters(Node.Parameters);
// The body of a lambda is *always* a tail position (relative to the lambda)
// The body of a lambda is *always* a tail position (relative to the lambda execution)
FNextIsTail := True;
newBody := Accept(Node.Body);
@@ -177,8 +178,9 @@ begin
Result := Node
else
begin
// Rebuild using factory and copy properties via interface
Result := TAst.LambdaExpr(newParams, newBody, Node.ScopeDescriptor, Node.Upvalues, Node.HasNestedLambdas, Node.StaticType);
// Rebuild using factory.
// IMPORTANT: Pass Layout AND Descriptor (TCO runs after TypeChecker).
Result := TAst.LambdaExpr(newParams, newBody, Node.Layout, Node.Descriptor, Node.Upvalues, Node.HasNestedLambdas, Node.StaticType);
end;
end;
@@ -210,7 +212,6 @@ begin
if newBody = Node.ExpandedBody then
Result := Node
else
// Rebuild, preserving the original CallNode metadata
Result := TAst.MacroExpansionNode(Node.CallNode, newBody);
end;
@@ -222,13 +223,12 @@ var
begin
isTailCall := FIsTailStack.Peek;
// Arguments are not in tail position
// Callee/Arguments are not in tail position
FNextIsTail := False;
newCallee := Accept(Node.Callee);
newArgs := AcceptNodes(Node.Arguments);
// CoW check: Create a new node only if children changed OR IsTailCall needs update
// OR StaticTarget is missing (which it shouldn't be, but good to check)
if (newCallee = Node.Callee) and (newArgs = Node.Arguments) and (isTailCall = Node.IsTailCall) then
begin
Result := Node;
@@ -242,7 +242,7 @@ begin
newArgs,
Node.StaticType,
isTailCall,
Node.StaticTarget // Preserve the static target
Node.StaticTarget // Preserve the static target from Specializer
);
end;
Src/AST/Myc.Ast.Compiler.TypeChecker.pas
+197 -162
View File
@@ -16,16 +16,32 @@ uses
type
IAstTypeChecker = interface(IAstVisitor)
function Execute(const RootNode: IAstNode; const ADecriptor: IScopeDescriptor): IAstNode;
function Execute(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode;
end;
// This transformer runs *after* the TAstBinder.
// It takes the "Bound AST" (which has addresses but mostly TTypes.Unknown)
// and traverses it bottom-up to infer and check all static types.
// It *replaces* all IAstTypedNodes with new nodes containing the correct type.
TTypeChecker = class(TAstTransformer, IAstTypeChecker)
private
FCurrentDescriptor: IScopeDescriptor;
type
// Helper to track types per scope during traversal (The "Scratchpad")
TTypeContext = class
private
FParent: TTypeContext;
FLayout: IScopeLayout;
FSlotTypes: TArray<IStaticType>;
FUpvalueTypes: TArray<IStaticType>; // Types of captured variables
public
constructor Create(AParent: TTypeContext; ALayout: IScopeLayout; const AUpvalueTypes: TArray<IStaticType>);
function LookupType(const Address: TResolvedAddress): IStaticType;
procedure SetType(SlotIndex: Integer; AType: IStaticType);
property Types: TArray<IStaticType> read FSlotTypes;
end;
private
FCurrentContext: TTypeContext;
// Helper to recursively rebuild the context stack from the layout hierarchy
function CreateContextChain(L: IScopeLayout): TTypeContext;
protected
// Override all visit methods to perform type checking
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
@@ -50,10 +66,12 @@ type
function VisitKeyword(const Node: IKeywordNode): IAstNode; override;
public
constructor Create(const ADescriptor: IScopeDescriptor);
function Execute(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;
constructor Create(const RootLayout: IScopeLayout);
destructor Destroy; override;
class function CheckTypes(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode; static;
function Execute(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode;
class function CheckTypes(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode; static;
end;
implementation
@@ -62,58 +80,143 @@ uses
System.Generics.Defaults,
Myc.Data.Keyword;
{ TTypeChecker }
{ TTypeChecker.TTypeContext }
constructor TTypeChecker.Create(const ADescriptor: IScopeDescriptor);
constructor TTypeChecker.TTypeContext.Create(AParent: TTypeContext; ALayout: IScopeLayout; const AUpvalueTypes: TArray<IStaticType>);
begin
inherited Create;
Assert(Assigned(ADescriptor));
FCurrentDescriptor := ADescriptor;
FParent := AParent;
FLayout := ALayout;
FUpvalueTypes := AUpvalueTypes;
// Initialize slot types with Unknown
if Assigned(FLayout) then
begin
SetLength(FSlotTypes, FLayout.SlotCount);
for var i := 0 to High(FSlotTypes) do
FSlotTypes[i] := TTypes.Unknown;
end;
end;
class function TTypeChecker.CheckTypes(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;
function TTypeChecker.TTypeContext.LookupType(const Address: TResolvedAddress): IStaticType;
var
ctx: TTypeContext;
i: Integer;
begin
var checker := TTypeChecker.Create(ADescriptor) as IAstTypeChecker;
Result := checker.Execute(RootNode, ADescriptor);
case Address.Kind of
akLocalOrParent:
begin
ctx := Self;
for i := 1 to Address.ScopeDepth do
begin
if not Assigned(ctx.FParent) then
raise Exception.CreateFmt('Scope depth mismatch during type lookup. Requested Depth: %d.', [Address.ScopeDepth]);
ctx := ctx.FParent;
end;
if (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(ctx.FSlotTypes)) then
Result := ctx.FSlotTypes[Address.SlotIndex]
else
Result := TTypes.Unknown;
end;
akUpvalue:
begin
// Look up type in our local upvalue type cache
if (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FUpvalueTypes)) then
Result := FUpvalueTypes[Address.SlotIndex]
else
Result := TTypes.Unknown;
end;
else
Result := TTypes.Unknown;
end;
end;
function TTypeChecker.Execute(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;
procedure TTypeChecker.TTypeContext.SetType(SlotIndex: Integer; AType: IStaticType);
begin
FCurrentDescriptor := ADescriptor;
Result := Accept(RootNode); // Use IAstNode-returning Accept
if (SlotIndex >= 0) and (SlotIndex < Length(FSlotTypes)) then
FSlotTypes[SlotIndex] := AType;
end;
{ TTypeChecker }
function TTypeChecker.CreateContextChain(L: IScopeLayout): TTypeContext;
var
p: TTypeContext;
begin
if L = nil then
exit(nil);
// Recursively build parent context
p := CreateContextChain(L.Parent);
// Create context for current layout level
// Note: We don't know UpvalueTypes for these static/parent layouts here, so [] is passed.
// Also: Slot types will be initialized to Unknown.
Result := TTypeContext.Create(p, L, []);
end;
constructor TTypeChecker.Create(const RootLayout: IScopeLayout);
begin
inherited Create;
// Build the full context chain based on the Layout's parent hierarchy
// This ensures that ScopeDepth lookups can traverse up to the root.
FCurrentContext := CreateContextChain(RootLayout);
// Fallback if RootLayout is nil (should not happen in valid pipeline)
if FCurrentContext = nil then
FCurrentContext := TTypeContext.Create(nil, nil, []);
end;
destructor TTypeChecker.Destroy;
begin
// Cleanup context stack
while Assigned(FCurrentContext) do
begin
var temp := FCurrentContext;
FCurrentContext := FCurrentContext.FParent;
temp.Free;
end;
inherited;
end;
class function TTypeChecker.CheckTypes(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode;
begin
var checker := TTypeChecker.Create(Layout) as IAstTypeChecker;
Result := checker.Execute(RootNode, Layout);
end;
function TTypeChecker.Execute(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode;
begin
// Note: Layout passed here matches what was passed to Create/Constructor (via recursed ContextChain)
Result := Accept(RootNode);
if not Assigned(Result) then
Result := TAst.Block([]);
end;
function TTypeChecker.VisitConstant(const Node: IConstantNode): IAstNode;
begin
// This is a leaf node.
// If the constructor couldn't set the type, nobody can
Assert(Node.StaticType.Kind <> stUnknown);
Result := Node;
end;
function TTypeChecker.VisitKeyword(const Node: IKeywordNode): IAstNode;
begin
// This is a leaf node.
// The TKeywordNode constructor *forces* the type to be TTypes.Keyword.
Assert(Node.StaticType.Kind = stKeyword);
Result := Node;
end;
function TTypeChecker.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
var
symbol: TResolvedSymbol;
typ: IStaticType;
adr: TResolvedAddress;
begin
// This is a leaf node (guaranteed to be IBoundIdentifierNode by Binder)
// Get the type from the descriptor (which was populated by Binder/RTL)
symbol := FCurrentDescriptor.FindSymbol(Node.Name);
adr := Node.Address;
// Lookup type in our scratchpad context using the address resolved by Binder
typ := FCurrentContext.LookupType(adr);
// Create a new node, copying the address and assigning the inferred type
Result := TAst.Identifier(Node.Name, adr, symbol.StaticType);
// Create a new node with the inferred type
Result := TAst.Identifier(Node.Name, adr, typ);
end;
function TTypeChecker.VisitRecurNode(const Node: IRecurNode): IAstNode;
@@ -121,12 +224,10 @@ var
newArgs: TArray<IAstNode>;
i: Integer;
begin
// 1. Visit children
SetLength(newArgs, Length(Node.Arguments));
for i := 0 to High(Node.Arguments) do
newArgs[i] := Accept(Node.Arguments[i]);
// 2. Create new node with inferred type
Result := TAst.Recur(newArgs, TTypes.Void);
end;
@@ -139,57 +240,43 @@ var
placeholderType: IStaticType;
i: Integer;
begin
// 1. Get the address from the bound identifier (Binder did this)
adr := Node.Identifier.Address;
initType := TTypes.Unknown; // Default
initType := TTypes.Unknown;
// 2. Check for recursive lambda and bootstrap the type
// Recursive lambda bootstrap logic
placeholderType := nil;
if (Node.Initializer <> nil) and (Node.Initializer.Kind = akLambdaExpression) then
begin
lambdaNode := Node.Initializer.AsLambdaExpression;
// Create a placeholder method type based on the *unvisited* lambda's parameter *count*.
var paramTypes: TArray<IStaticType>;
SetLength(paramTypes, Length(lambdaNode.Parameters));
for i := 0 to High(paramTypes) do
paramTypes[i] := TTypes.Unknown;
// Create the placeholder (Return type is also Unknown for now)
placeholderType := TTypes.CreateMethod(paramTypes, TTypes.Unknown);
// 3. *Update the descriptor* with the placeholder *before* visiting the initializer
FCurrentDescriptor.UpdateType(adr.SlotIndex, placeholderType);
initType := placeholderType; // Store this
// Update Context (Scratchpad)
FCurrentContext.SetType(adr.SlotIndex, placeholderType);
initType := placeholderType;
end;
// 4. Visit Initializer (if it exists)
if Assigned(Node.Initializer) then
newInitializer := Accept(Node.Initializer)
else
newInitializer := nil;
// 5. Get the *final* inferred initializer type
if Assigned(newInitializer) then
initType := newInitializer.AsTypedNode.StaticType
else if not Assigned(placeholderType) then // only if not already set
initType := TTypes.Unknown; // (def f) - no initializer
else if not Assigned(placeholderType) then
initType := TTypes.Unknown;
// 6. *Re-update* the type in the scope descriptor with the final, inferred type.
// Update Context with final type
if initType.Kind <> stUnknown then
FCurrentDescriptor.UpdateType(adr.SlotIndex, initType);
FCurrentContext.SetType(adr.SlotIndex, initType);
// 7. Create the new (typed) identifier node
newIdent := TAst.Identifier(Node.Identifier.Name, adr, initType);
// 8. Create the new VariableDeclaration node using the factory
Result :=
TAst.VarDecl(
newIdent.AsIdentifier,
newInitializer,
initType,
Node.IsBoxed // 9. Copy runtime flags
);
Result := TAst.VarDecl(newIdent.AsIdentifier, newInitializer, initType, Node.IsBoxed);
end;
function TTypeChecker.VisitAssignment(const Node: IAssignmentNode): IAstNode;
@@ -201,61 +288,49 @@ var
placeholderType: IStaticType;
i: Integer;
begin
// 1. Visit Identifier *first* to get its address and current type
newIdent := Accept(Node.Identifier);
targetType := newIdent.AsTypedNode.StaticType;
adr := newIdent.AsIdentifier.Address;
// 2. Check for recursive lambda assignment
// Recursive lambda assignment check
placeholderType := nil;
if (Node.Value <> nil) and (Node.Value.Kind = akLambdaExpression) then
begin
lambdaNode := Node.Value.AsLambdaExpression;
// Create a placeholder (only if the target is not already a method type)
if (targetType.Kind <> stMethod) then
begin
var paramTypes: TArray<IStaticType>;
SetLength(paramTypes, Length(lambdaNode.Parameters));
for i := 0 to High(paramTypes) do
paramTypes[i] := TTypes.Unknown; // We infer param types later
paramTypes[i] := TTypes.Unknown;
placeholderType := TTypes.CreateMethod(paramTypes, TTypes.Unknown);
// 3. *Update the descriptor* with the placeholder *before* visiting the value
FCurrentDescriptor.UpdateType(adr.SlotIndex, placeholderType);
FCurrentContext.SetType(adr.SlotIndex, placeholderType);
targetType := placeholderType;
end;
end;
// 4. Visit Value
newValue := Accept(Node.Value);
sourceType := newValue.AsTypedNode.StaticType;
// 5. Check assignment
if not TTypeRules.CanAssign(targetType, sourceType) then
begin
// If target was unknown, try promoting
if (targetType.Kind = stUnknown) then
begin
if not TTypeRules.CanAssign(sourceType, targetType) then // Check reverse
if not TTypeRules.CanAssign(sourceType, targetType) then
raise ETypeException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]);
end
else
raise ETypeException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]);
end;
// 6. If the target was 'Unknown' or a 'Placeholder', update the descriptor
// with the new, final inferred type.
if ((targetType.Kind = stUnknown) or Assigned(placeholderType)) and (sourceType.Kind <> stUnknown) then
begin
FCurrentDescriptor.UpdateType(adr.SlotIndex, sourceType);
// Re-create the identifier node *with the new type*
FCurrentContext.SetType(adr.SlotIndex, sourceType);
newIdent := TAst.Identifier(newIdent.AsIdentifier.Name, adr, sourceType);
targetType := sourceType;
end;
// 7. Create the new Assignment node
Result := TAst.Assign(newIdent.AsIdentifier, newValue, targetType);
end;
@@ -265,46 +340,67 @@ var
newBody: IAstNode;
bodyType, methodType: IStaticType;
paramTypes: TArray<IStaticType>;
// Upvalue Type Resolution
upvalueTypes: TArray<IStaticType>;
upvalueAddrs: TArray<TResolvedAddress>;
i: Integer;
savedDescriptor: IScopeDescriptor;
finalDescriptor: IScopeDescriptor;
begin
// 1. Enter the lambda's scope (which Binder already created)
savedDescriptor := FCurrentDescriptor;
FCurrentDescriptor := Node.ScopeDescriptor;
// 1. Resolve Upvalue Types *in the current (parent) context*
upvalueAddrs := Node.Upvalues;
SetLength(upvalueTypes, Length(upvalueAddrs));
for i := 0 to High(upvalueAddrs) do
begin
// We look up the physical address (from Binder) in the current context chain
upvalueTypes[i] := FCurrentContext.LookupType(upvalueAddrs[i]);
end;
// 2. Create new TypeContext for this lambda scope, PASSING the upvalue types
// We use the layout from the Binder-Result-Node
FCurrentContext := TTypeContext.Create(FCurrentContext, Node.Layout, upvalueTypes);
try
// 2. Visit parameters (they are already bound, just need typing)
// 3. Set parameter types in the context
SetLength(newParams, Length(Node.Parameters));
SetLength(paramTypes, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
// Parameters are leaves, but we must *replace* them with typed versions
// (even if they are just TTypes.Unknown for now, for type inference placeholders)
var paramIdent := Node.Parameters[i];
var paramAdr := paramIdent.Address;
var newParam := TAst.Identifier(paramIdent.Name, paramAdr);
newParams[i] := newParam;
// Here we could infer types if we had type annotations. For now, parameters are Unknown.
paramTypes[i] := TTypes.Unknown;
// Update context so body can resolve params
FCurrentContext.SetType(paramAdr.SlotIndex, paramTypes[i]);
newParams[i] := TAst.Identifier(paramIdent.Name, paramAdr, paramTypes[i]);
end;
// 3. Visit the body to infer its return type
// 4. Visit body
newBody := Accept(Node.Body);
bodyType := newBody.AsTypedNode.StaticType;
// 4. Create the final method type
// 5. Create method type
methodType := TTypes.CreateMethod(paramTypes, bodyType);
// 5. Update the type for <self> (Slot 0) in the descriptor
FCurrentDescriptor.UpdateType(0, methodType);
// 6. Update <self> type in context (Slot 0)
FCurrentContext.SetType(0, methodType);
// 7. FINALIZE: Bake the Descriptor
finalDescriptor := TScope.CreateDescriptor(Node.Layout, FCurrentContext.Types);
finally
// 6. Restore parent descriptor
FCurrentDescriptor := savedDescriptor;
// 8. Pop Context
var temp := FCurrentContext;
FCurrentContext := FCurrentContext.FParent;
temp.Free;
end;
// 7. Create the new (typed) lambda node using the factory
Result := TAst.LambdaExpr(newParams, newBody, Node.ScopeDescriptor, Node.Upvalues, Node.HasNestedLambdas, methodType);
// 9. Create new node with the Descriptor attached!
Result := TAst.LambdaExpr(newParams, newBody, Node.Layout, finalDescriptor, Node.Upvalues, Node.HasNestedLambdas, methodType);
end;
function TTypeChecker.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
@@ -319,7 +415,6 @@ var
sig: IMethodSignature;
match: Boolean;
begin
// 1. Visit children first (bottom-up)
newCallee := Accept(Node.Callee);
SetLength(newArgs, Length(Node.Arguments));
SetLength(argTypes, Length(Node.Arguments));
@@ -333,53 +428,40 @@ begin
hasUnknownArgs := True;
end;
// 2. Get callee type (now inferred)
calleeType := newCallee.AsTypedNode.StaticType;
retType := TTypes.Unknown; // Default if not a method
retType := TTypes.Unknown;
// 3. Perform type checking
if calleeType.Kind = TStaticTypeKind.stMethod then
begin
// If any argument is Unknown, we cannot resolve overloads.
// The return type remains Unknown.
if not hasUnknownArgs then
begin
bestSig := nil;
for sig in calleeType.Signatures do
begin
// Check 1: Argument count
if Length(sig.ParamTypes) <> Length(argTypes) then
continue;
// Check 2: Argument types (CanAssign)
match := True;
for j := 0 to High(argTypes) do
begin
if not TTypeRules.CanAssign(sig.ParamTypes[j], argTypes[j]) then
begin
match := False;
break; // This signature doesn't match
break;
end;
end;
// Check 3: Found first match
if match then
begin
// This is the "dumb" checker logic: first match wins.
// A "smarter" checker would find the *best* match.
bestSig := sig;
break;
end;
end; // for sig
end;
// Check 4: Handle results
if Assigned(bestSig) then
begin
retType := bestSig.ReturnType;
end
retType := bestSig.ReturnType
else
begin
// No signature matched, even with known types. This is an error.
var argsStr: string := '';
for i := 0 to High(argTypes) do
argsStr := argsStr + argTypes[i].ToString + ' ';
@@ -387,20 +469,11 @@ begin
.CreateFmt('No matching signature for call with args (%s) found on method %s', [argsStr, calleeType.ToString]);
end;
end;
// else: hasUnknownArgs is True, so retType remains Unknown (as set in step 2)
end
else if calleeType.Kind <> TStaticTypeKind.stUnknown then
raise ETypeException.CreateFmt('Cannot invoke type %s as a function.', [calleeType.ToString]);
// else: calleeType is Unknown (e.g. recursive call or unbound symbol), retType remains Unknown.
// 4. Create the new (typed) call node using the factory
Result :=
TAst.FunctionCall(
newCallee,
newArgs,
retType,
Node.IsTailCall // 5. Copy runtime properties
);
Result := TAst.FunctionCall(newCallee, newArgs, retType, Node.IsTailCall);
end;
function TTypeChecker.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
@@ -409,18 +482,15 @@ var
newExprs: TArray<IAstNode>;
i: Integer;
begin
// 1. Visit children
SetLength(newExprs, Length(Node.Expressions));
for i := 0 to High(Node.Expressions) do
newExprs[i] := Accept(Node.Expressions[i]);
// 2. Type is type of last expression
if Length(newExprs) > 0 then
blockType := newExprs[High(newExprs)].AsTypedNode.StaticType
else
blockType := TTypes.Void;
// 3. Create new node
Result := TAst.Block(newExprs, blockType);
end;
@@ -429,17 +499,14 @@ var
conditionType, thenType, elseType, resultType: IStaticType;
newCond, newThen, newElse: IAstNode;
begin
// 1. Visit children
newCond := Accept(Node.Condition);
newThen := Accept(Node.ThenBranch);
newElse := Accept(Node.ElseBranch); // Accept handles nil
newElse := Accept(Node.ElseBranch);
// 2. Check condition
conditionType := newCond.AsTypedNode.StaticType;
if (conditionType.Kind <> stUnknown) and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType) then
raise ETypeException.CreateFmt('If condition must be Ordinal, but got %s', [conditionType.ToString]);
// 3. Promote branch types
thenType := newThen.AsTypedNode.StaticType;
elseType :=
if newElse <> nil then newElse.AsTypedNode.StaticType
@@ -447,7 +514,6 @@ begin
resultType := TTypeRules.Promote(thenType, elseType);
// 4. Create new node
Result := TAst.IfExpr(newCond, newThen, newElse, resultType);
end;
@@ -456,23 +522,19 @@ var
conditionType, thenType, elseType, resultType: IStaticType;
newCond, newThen, newElse: IAstNode;
begin
// 1. Visit children
newCond := Accept(Node.Condition);
newThen := Accept(Node.ThenBranch);
newElse := Accept(Node.ElseBranch);
// 2. Check condition
conditionType := newCond.AsTypedNode.StaticType;
if (conditionType.Kind <> stUnknown) and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType) then
raise ETypeException.CreateFmt('Ternary condition must be Ordinal, but got %s', [conditionType.ToString]);
// 3. Promote branch types
thenType := newThen.AsTypedNode.StaticType;
elseType := newElse.AsTypedNode.StaticType;
resultType := TTypeRules.Promote(thenType, elseType);
// 4. Create new node
Result := TAst.TernaryExpr(newCond, newThen, newElse, resultType);
end;
@@ -482,15 +544,12 @@ var
fieldIndex: Integer;
newBase, newMember: IAstNode;
begin
// 1. Visit children
newBase := Accept(Node.Base);
newMember := Accept(Node.Member); // Visits the TKeywordNode
newMember := Accept(Node.Member);
// 2. Get types
baseType := newBase.AsTypedNode.StaticType;
elemType := TTypes.Unknown;
// 3. Resolve
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
begin
if (baseType.Kind = TStaticTypeKind.stRecord) or (baseType.Kind = TStaticTypeKind.stRecordSeries) then
@@ -503,7 +562,7 @@ begin
if baseType.Kind = TStaticTypeKind.stRecord then
elemType := fieldType
else // stRecordSeries
else
elemType := TTypes.CreateSeries(fieldType);
end
else if (baseType.Kind = TStaticTypeKind.stGenericRecord) then
@@ -515,12 +574,9 @@ begin
elemType := genDef.Fields[fieldIndex].Value;
end
else
begin
raise ETypeException.CreateFmt('Member access requires a record type, but got %s', [baseType.ToString]);
end;
end;
// 4. Create new node
Result := TAst.MemberAccess(newBase, newMember.AsKeyword, elemType);
end;
@@ -529,16 +585,13 @@ var
baseType, indexType, elemType: IStaticType;
newBase, newIndex: IAstNode;
begin
// 1. Visit children
newBase := Accept(Node.Base);
newIndex := Accept(Node.Index);
// 2. Get types
baseType := newBase.AsTypedNode.StaticType;
indexType := newIndex.AsTypedNode.StaticType;
elemType := TTypes.Unknown;
// 3. Resolve
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
begin
if (baseType.Kind <> TStaticTypeKind.stSeries) and (baseType.Kind <> TStaticTypeKind.stRecordSeries) then
@@ -549,11 +602,10 @@ begin
if baseType.Kind = TStaticTypeKind.stSeries then
elemType := baseType.ElementType
else // stRecordSeries
else
elemType := TTypes.CreateRecord(baseType.Definition);
end;
// 4. Create new node
Result := TAst.Indexer(newBase, newIndex, elemType);
end;
@@ -568,7 +620,6 @@ var
allScalar: Boolean;
newFields: TArray<TRecordFieldLiteral>;
begin
// 1. Visit all child nodes first to infer their types
SetLength(newFields, Length(Node.Fields));
for i := 0 to High(Node.Fields) do
begin
@@ -579,7 +630,6 @@ begin
SetLength(scalarDefFields, Length(newFields));
allScalar := True;
// 2. Check if this record literal can be a TScalarRecord
for i := 0 to High(newFields) do
begin
valType := newFields[i].Value.AsTypedNode.StaticType;
@@ -593,14 +643,13 @@ begin
else
begin
allScalar := False;
scalarKind := TScalar.TKind.Ordinal; // Dummy
scalarKind := TScalar.TKind.Ordinal;
end;
if allScalar then
scalarDefFields[i] := TScalarRecordField.Create(newFields[i].Key.Value, scalarKind);
end;
// 3. Create the new node and set its type/definitions
if allScalar then
begin
def := TScalarRecordRegistry.Intern(scalarDefFields);
@@ -624,9 +673,6 @@ function TTypeChecker.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode
var
elemType: IStaticType;
begin
// This is a leaf node
// Assign the type
try
elemType := TTypes.FromScalarKind(TScalar.StringToKind(Node.Definition));
except
@@ -634,7 +680,6 @@ begin
elemType := TTypes.Unknown;
end;
// Create new node
Result := TAst.CreateSeries(Node.Definition, TTypes.CreateSeries(elemType));
end;
@@ -643,16 +688,13 @@ var
seriesType, valueType: IStaticType;
newSeries, newValue, newLookback: IAstNode;
begin
// 1. Visit children
newSeries := Accept(Node.Series);
newValue := Accept(Node.Value);
newLookback := Accept(Node.Lookback); // Handles nil
newLookback := Accept(Node.Lookback);
// 2. Get types
seriesType := newSeries.AsTypedNode.StaticType;
valueType := newValue.AsTypedNode.StaticType;
// 3. Check types
if (seriesType.Kind <> stUnknown) then
begin
if (seriesType.Kind <> TStaticTypeKind.stSeries) then
@@ -670,13 +712,11 @@ begin
raise ETypeException.Create('Lookback parameter for "add" must be an ordinal value.');
end;
// 4. Create new node
Result := TAst.AddSeriesItem(newSeries.AsIdentifier, newValue, newLookback, TTypes.Void);
end;
function TTypeChecker.VisitNop(const Node: INopNode): IAstNode;
begin
// This is a leaf node. Assign its final type as Void.
Result := TAst.Nop(TTypes.Void);
end;
@@ -685,19 +725,14 @@ var
seriesType: IStaticType;
newSeries: IAstNode;
begin
// 1. Visit children
newSeries := Accept(Node.Series);
// 2. Get type
seriesType := newSeries.AsTypedNode.StaticType;
// 3. Check type
if (seriesType.Kind <> stUnknown)
and (seriesType.Kind <> TStaticTypeKind.stSeries)
and (seriesType.Kind <> TStaticTypeKind.stRecordSeries) then
raise ETypeException.CreateFmt('"length" requires a series, but got %s', [seriesType.ToString]);
// 4. Create new node
Result := TAst.SeriesLength(newSeries.AsIdentifier, TTypes.Ordinal);
end;
Src/AST/Myc.Ast.Debugger.pas
+46 -27
View File
@@ -25,14 +25,14 @@ type
procedure ShowScope;
protected
// Overridden to provide the debug-specific visitor factory.
// Overridden to provide the debug-specific visitor factory for nested calls (Lambdas).
function CreateVisitorFactory: TEvaluatorFactory; 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;
// The logging overrides for other Visit... methods
function VisitConstant(const Node: IConstantNode): TDataValue; override;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitKeyword(const Node: IKeywordNode): TDataValue; override;
@@ -47,6 +47,7 @@ type
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;
end;
implementation
@@ -69,35 +70,21 @@ end;
function TDebugEvaluatorVisitor.CreateVisitorFactory: TEvaluatorFactory;
begin
// Return a closure that creates a new Debug visitor, using the current context
// 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 callingVisitor := Self as IEvaluatorVisitor;
Result :=
function(const AScope: IExecutionScope): IEvaluatorVisitor
begin
var visitor := callingVisitor as TDebugEvaluatorVisitor;
Result := TDebugEvaluatorVisitor.Create(AScope, visitor.FLog, visitor.FShowScope, visitor.FIndentLevel);
Result := TDebugEvaluatorVisitor.Create(AScope, currentLog, currentShowScope, currentIndent);
end;
end;
function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
begin
AppendLine(
'FunctionCall ('
+ (if Assigned(Node.StaticTarget) then 'STATIC'
else 'DYNAMIC')
+ ' PATH) {'
);
Indent;
try
ShowScope;
Result := inherited VisitFunctionCall(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
procedure TDebugEvaluatorVisitor.Indent;
begin
inc(FIndentLevel);
@@ -127,6 +114,7 @@ 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
@@ -136,6 +124,30 @@ begin
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 {');
@@ -192,7 +204,7 @@ end;
function TDebugEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
AppendLine('IfExpr{');
AppendLine('IfExpr {');
Indent;
try
Result := inherited VisitIfExpression(Node);
@@ -240,7 +252,7 @@ end;
function TDebugEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
AppendLine('TernaryExpr{');
AppendLine('TernaryExpr {');
Indent;
try
Result := inherited VisitTernaryExpression(Node);
@@ -252,10 +264,11 @@ end;
function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
begin
AppendLine('Block{');
AppendLine('Block {');
Indent;
try
Result := inherited VisitBlockExpression(Node);
// Scope might have changed after block execution if vars were defined
ShowScope;
finally
Unindent;
@@ -286,4 +299,10 @@ begin
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitNop(const Node: INopNode): TDataValue;
begin
AppendLine('Nop (void)');
Result := TDataValue.Void;
end;
end.
Src/AST/Myc.Ast.Dumper.pas
+59 -79
View File
@@ -15,25 +15,22 @@ uses
type
// Dumps a bound AST into a human-readable format for debugging purposes.
// It inherits from the abstract TAstVisitor to implement the IAstVisitor interface.
IAstDumper = interface(IAstVisitor)
procedure Execute(const RootNode: IAstNode);
end;
// Inherits from the new non-generic TAstVisitor base class
TAstDumper = class(TAstVisitor, IAstDumper)
private
FOutput: TStrings;
FIndent: Integer;
procedure Indent;
procedure Unindent;
// Updated Log methods to include the node for type dumping
procedure Log(const Text: string; const Node: IAstNode = nil); overload;
procedure LogFmt(const Fmt: string; const Args: array of const; const Node: IAstNode = nil); overload;
function FormatAddress(const Addr: TResolvedAddress): string;
protected
// Override abstract procedures from TAstVisitor
// Override abstract PROCEDURES from TAstVisitor (not functions!)
procedure VisitConstant(const Node: IConstantNode); override;
procedure VisitIdentifier(const Node: IIdentifierNode); override;
procedure VisitKeyword(const Node: IKeywordNode); override;
@@ -59,12 +56,8 @@ type
procedure VisitNop(const Node: INopNode); override;
public
// Creates a new instance of the AST dumper.
constructor Create(const AOutput: TStrings);
// Traverses the given root node and writes the structural information into the output.
class procedure Dump(const RootNode: IAstNode; const Output: TStrings);
procedure Execute(const RootNode: IAstNode);
end;
@@ -72,7 +65,7 @@ implementation
uses
Myc.Data.Keyword,
Myc.Ast.Types; // Added for IStaticType.ToString
Myc.Ast.Types;
{ TAstDumper }
@@ -122,14 +115,11 @@ var
staticType: IStaticType;
begin
typeStr := '';
// Check if the node is typed
if Assigned(Node) and Node.IsTyped then
begin
typedNode := Node.AsTypedNode;
staticType := typedNode.StaticType;
if Assigned(staticType) then
// Append the static type information
typeStr := Format(' <Type: %s>', [staticType.ToString])
else
typeStr := ' <Type: nil>';
@@ -139,7 +129,6 @@ end;
procedure TAstDumper.LogFmt(const Fmt: string; const Args: array of const; const Node: IAstNode = nil);
begin
// Pass the node to the base Log method
Log(Format(Fmt, Args), Node);
end;
@@ -164,7 +153,6 @@ var
adr: TResolvedAddress;
begin
adr := Node.Address;
if adr.Kind <> akUnresolved then
LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress(adr)], Node)
else
@@ -208,68 +196,74 @@ end;
procedure TAstDumper.VisitLambdaExpression(const Node: ILambdaExpressionNode);
var
upvalueAddr: TResolvedAddress;
pair: TPair<string, Integer>;
symbols: TArray<string>;
layout: IScopeLayout;
slot: Integer;
typ: IStaticType;
begin
if Assigned(Node.ScopeDescriptor) then
LogFmt('LambdaExpression (HasNested: %s)', [Node.HasNestedLambdas.ToString(TUseBoolStrs.True)], Node);
Indent;
// 1. Layout & Symbols
if Assigned(Node.Layout) then
begin
LogFmt('LambdaExpression (HasNested: %s)', [Node.HasNestedLambdas.ToString(TUseBoolStrs.True)], Node);
Indent;
LogFmt('Scope: Layout Slots=%d', [Node.Layout.SlotCount]);
if Assigned(Node.Descriptor) then
begin
Log('Symbol Table:');
Indent;
layout := Node.Layout;
symbols := layout.GetSymbols;
TArray.Sort<string>(symbols);
Log('Parameters:');
Indent;
for var param in Node.Parameters do
param.Accept(Self);
Unindent;
for var name in symbols do
begin
slot := layout.FindSlot(name);
typ := Node.Descriptor.GetSymbolType(slot);
LogFmt('"%s" -> Slot %d (Type: %s)', [name, slot, typ.ToString]);
end;
Unindent;
end;
end
else
Log('Scope: No Layout (Raw)');
LogFmt('Upvalues (%d):', [Length(Node.Upvalues)]);
// 3. Parameters
Log('Parameters:');
Indent;
for var param in Node.Parameters do
param.Accept(Self);
Unindent;
// 4. Upvalues
if Length(Node.Upvalues) > 0 then
begin
LogFmt('Captured Upvalues (%d):', [Length(Node.Upvalues)]);
Indent;
for upvalueAddr in Node.Upvalues do
Log(FormatAddress(upvalueAddr));
Unindent;
Log('Scope Descriptor:');
Indent;
if Assigned(Node.ScopeDescriptor) then
for pair in Node.ScopeDescriptor.Symbols do
LogFmt('"%s" -> Slot %d', [pair.Key, pair.Value])
else
Log('(none)');
Unindent;
Log('Body:');
Node.Body.Accept(Self);
Unindent;
end
else
begin
Log('LambdaExpression (unbound)', Node);
Indent;
Log('Parameters:');
Indent;
for var param in Node.Parameters do
param.Accept(Self);
Unindent;
Log('Body:');
Node.Body.Accept(Self);
Unindent;
end;
// 5. Body
Log('Body:');
Node.Body.Accept(Self);
Unindent;
end;
procedure TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode);
var
arg: IAstNode;
staticStatus: string;
sigStr: string; // Added
sigStr: string;
argTypes: TArray<string>;
i: Integer;
begin
sigStr := ''; // Default to empty
sigStr := '';
if Assigned(Node.StaticTarget) then
begin
staticStatus := 'Assigned';
// Reconstruct the signature from the available data
SetLength(argTypes, Length(Node.Arguments));
for i := 0 to High(Node.Arguments) do
begin
@@ -278,24 +272,12 @@ begin
else
argTypes[i] := 'Untyped';
end;
// Node.StaticType holds the return type set by the Specializer
sigStr := Format(' <ResolvedSig: Method(%s): %s>', [string.Join(', ', argTypes), Node.StaticType.ToString]);
end
else
begin
staticStatus := 'nil';
end;
LogFmt(
'FunctionCall (IsTailCall: %s, StaticTarget: %s%s)',
[
Node.IsTailCall.ToString(TUseBoolStrs.True),
staticStatus,
sigStr // Added the signature string
],
Node
); // Pass Node to LogFmt to append the <Type: ...>
LogFmt('FunctionCall (IsTailCall: %s, StaticTarget: %s%s)', [Node.IsTailCall.ToString(TUseBoolStrs.True), staticStatus, sigStr], Node);
Indent;
Log('Callee:');
@@ -338,7 +320,6 @@ procedure TAstDumper.VisitRecurNode(const Node: IRecurNode);
var
arg: IAstNode;
begin
// 'recur' must be a tail call, which is enforced by the binder.
Log('Recur', Node);
Indent;
LogFmt('Arguments (%d):', [Length(Node.Arguments)]);
@@ -363,7 +344,6 @@ end;
procedure TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNode);
begin
LogFmt('VariableDeclaration (IsBoxed: %s)', [Node.IsBoxed.ToString(TUseBoolStrs.True)], Node);
Indent;
Node.Identifier.Accept(Self);
if Assigned(Node.Initializer) then
@@ -386,7 +366,7 @@ end;
procedure TAstDumper.VisitMacroDefinition(const Node: IMacroDefinitionNode);
begin
Log('MacroDefinition', Node); // Macros are not IAstTypedNode
Log('MacroDefinition', Node);
Indent;
Log('Name:');
@@ -410,7 +390,7 @@ end;
procedure TAstDumper.VisitQuasiquote(const Node: IQuasiquoteNode);
begin
Log('Quasiquote', Node); // Not IAstTypedNode
Log('Quasiquote', Node);
Indent;
Node.Expression.Accept(Self);
Unindent;
@@ -418,7 +398,7 @@ end;
procedure TAstDumper.VisitUnquote(const Node: IUnquoteNode);
begin
Log('Unquote', Node); // Not IAstTypedNode
Log('Unquote', Node);
Indent;
Node.Expression.Accept(Self);
Unindent;
@@ -426,7 +406,7 @@ end;
procedure TAstDumper.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode);
begin
Log('UnquoteSplicing', Node); // Not IAstTypedNode
Log('UnquoteSplicing', Node);
Indent;
Node.Expression.Accept(Self);
Unindent;
@@ -491,11 +471,6 @@ begin
Unindent;
end;
procedure TAstDumper.VisitNop(const Node: INopNode);
begin
Log('Nop', Node);
end;
procedure TAstDumper.VisitSeriesLength(const Node: ISeriesLengthNode);
begin
Log('SeriesLength', Node);
@@ -505,4 +480,9 @@ begin
Unindent;
end;
procedure TAstDumper.VisitNop(const Node: INopNode);
begin
Log('Nop', Node);
end;
end.
Src/AST/Myc.Ast.Environment.pas
+75 -62
View File
@@ -22,8 +22,6 @@ type
// --- Monomorphization Cache Definitions ---
// The key for the specialization cache.
// (Function Address/ID, [Argument Types])
TMonoCacheKey = record
public
Address: TResolvedAddress;
@@ -31,36 +29,29 @@ type
constructor Create(const AAddress: TResolvedAddress; const AArgTypes: TArray<IStaticType>);
end;
// Comparer for the cache key
TMonoCacheKeyComparer = class(TEqualityComparer<TMonoCacheKey>)
public
function Equals(const Left, Right: TMonoCacheKey): Boolean; override;
function GetHashCode(const Value: TMonoCacheKey): Integer; override; // Updated
function GetHashCode(const Value: TMonoCacheKey): Integer; override;
end;
// The cache dictionary itself.
// Verwendet den generischen TSpecializedMethod-Record aus Myc.Ast.Types
TMonomorphCache = TDictionary<TMonoCacheKey, TSpecializedMethod>;
// This record holds the executable function and its inferred static type.
TCompiledFunction = record
public
Func: TDataValue.TFunc;
StaticType: IStaticType; // The full static type of the compiled function (e.g., Method(Ord):Method():Ord)
StaticType: IStaticType;
constructor Create(const AFunc: TDataValue.TFunc; const AStaticType: IStaticType);
end;
// Defines the Strategy for creating an Evaluator.
IExecutionStrategy = interface
function CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
end;
// Defines the compile-time macro storage.
IMacroRegistry = interface
{$region 'private'}
function GetParent: IMacroRegistry;
{$endregion}
procedure Define(const Node: IMacroDefinitionNode);
function Find(const Name: string): IMacroDefinitionNode;
function CreateChildRegistry: IMacroRegistry;
@@ -72,7 +63,6 @@ type
function Resolve(const Address: TResolvedAddress): IFunctionDefinition;
end;
// Defines the central environment for compilation and execution.
IEnvironment = interface
{$region 'private'}
function GetRootScope: IExecutionScope;
@@ -84,14 +74,19 @@ type
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
function ExpandMacros(const Node: IAstNode): IAstNode;
function Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor; const AArgTypes: TArray<IStaticType> = []): IAstNode;
function Specialize(const Node: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;
// Updated: Returns Layout, not Descriptor. Performs Binding AND TypeChecking.
function Bind(const Node: IAstNode; out Layout: IScopeLayout; const AArgTypes: TArray<IStaticType> = []): IAstNode;
// Updated: Removed Descriptor parameter.
function Specialize(const Node: IAstNode): IAstNode;
function Compile(
const ANode: IAstNode;
const Params: TArray<IIdentifierNode> = [];
const AArgTypes: TArray<IStaticType> = []
): TCompiledFunction; overload;
function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType> = []): TCompiledFunction; overload;
function CreateEnvironment: IEnvironment;
@@ -122,11 +117,13 @@ type
procedure SetDebugMode(ALog: TStrings; AShowScope: Boolean);
function Run(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []; const Args: TArray<TDataValue> = []): TDataValue;
function Compile(
const Node: IAstNode;
const Params: TArray<IIdentifierNode> = [];
const ArgTypes: TArray<IStaticType> = []
): TCompiledFunction; overload; experimental;
): TCompiledFunction; overload;
function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType> = []): TCompiledFunction; overload;
procedure Define(const Name: String; const AScript: IAstNode);
@@ -162,13 +159,12 @@ function TMonoCacheKeyComparer.Equals(const Left, Right: TMonoCacheKey): Boolean
var
i: Integer;
begin
if not (Left.Address = Right.Address) then // Use operator =
if not (Left.Address = Right.Address) then
exit(False);
if Length(Left.ArgTypes) <> Length(Right.ArgTypes) then
exit(False);
// Compare types
for i := 0 to High(Left.ArgTypes) do
begin
if not Left.ArgTypes[i].IsEqual(Right.ArgTypes[i]) then
@@ -182,26 +178,22 @@ function TMonoCacheKeyComparer.GetHashCode(const Value: TMonoCacheKey): Integer;
var
i: Integer;
hash: Integer;
typeHash: Integer; // Changed from ptrHash
typeHash: Integer;
adr: TResolvedAddress;
begin
adr := Value.Address;
// 1. Hash the TResolvedAddress components
hash := THashBobJenkins.GetHashValue(adr.Kind, SizeOf(TAddressKind), 0);
hash := THashBobJenkins.GetHashValue(adr.ScopeDepth, SizeOf(Integer), hash);
hash := THashBobJenkins.GetHashValue(adr.SlotIndex, SizeOf(Integer), hash);
// 2. Iteratively combine the hash of each argument type
for i := 0 to High(Value.ArgTypes) do
begin
// Get the hash code from the type itself (consistent with IsEqual)
if Assigned(Value.ArgTypes[i]) then
typeHash := Value.ArgTypes[i].GetHashCode
else
typeHash := 0;
// Combine the new hash (typeHash) with the existing hash (hash)
hash := THashBobJenkins.GetHashValue(typeHash, SizeOf(Integer), hash);
end;
@@ -282,8 +274,8 @@ type
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
function ExpandMacros(const Node: IAstNode): IAstNode;
function Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor; const ArgTypes: TArray<IStaticType>): IAstNode;
function Specialize(const Node: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;
function Bind(const Node: IAstNode; out Layout: IScopeLayout; const ArgTypes: TArray<IStaticType>): IAstNode;
function Specialize(const Node: IAstNode): IAstNode;
function Compile(
const Node: IAstNode;
@@ -293,6 +285,8 @@ type
function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction; overload;
end;
{ TAstEnvironment }
constructor TAstEnvironment.Create(const AEnvironment: IEnvironment);
begin
FEnvironment := AEnvironment;
@@ -336,18 +330,10 @@ class function TAstEnvironment.Construct(const Scope: IExecutionScope): TAstEnvi
var
RootScope: IExecutionScope;
begin
// When constructing the *very first* environment:
// 1. Create a root scope (parented to nil).
// 2. Explicitly request library registration (ARegisterLibraries = True).
// Initialize root scope with library registration
RootScope := TAst.CreateScope(nil, nil, True);
Result.Create(
TEnvironment.Create(
RootScope, // Use the new root scope
TMacroRegistryImpl.Create(nil),
TStandardExecutionStrategy.Create
)
);
Result.Create(TEnvironment.Create(RootScope, TMacroRegistryImpl.Create(nil), TStandardExecutionStrategy.Create));
end;
function TAstEnvironment.CreateEnvironment: TAstEnvironment;
@@ -358,7 +344,7 @@ end;
procedure TAstEnvironment.Define(const Name: String; const AScript: IAstNode);
begin
var compiled := Compile(AScript);
RootScope.Define(Name, compiled.Func([]));
RootScope.Define(Name, compiled.Func([]), compiled.StaticType);
end;
function TAstEnvironment.GetRootScope: IExecutionScope;
@@ -451,7 +437,6 @@ end;
constructor TFunctionDefinitionRegistry.Create;
begin
inherited Create;
// We can use the comparer from Myc.Ast.Scope
FMap := TDictionary<TResolvedAddress, IFunctionDefinition>.Create(TResolvedAddressComparer.Create);
end;
@@ -483,7 +468,6 @@ begin
FRootScope := ARootScope;
FMacroRegistry := AMacroRegistry;
FExecutionStrategy := AExecutionStrategy;
// Create the isolated, instance-specific cache
FMonomorphCache := TMonomorphCache.Create(TMonoCacheKeyComparer.Create);
FFunctionRegistry := TFunctionDefinitionRegistry.Create;
end;
@@ -499,12 +483,13 @@ begin
Result := FMonomorphCache;
end;
function TEnvironment.Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor; const ArgTypes: TArray<IStaticType>): IAstNode;
function TEnvironment.Bind(const Node: IAstNode; out Layout: IScopeLayout; const ArgTypes: TArray<IStaticType>): IAstNode;
begin
var boundAst := TAstBinder.Bind(FRootScope.Descriptor, Node, Descriptor, FFunctionRegistry, ArgTypes);
var typedAst := TTypeChecker.CheckTypes(boundAst, Descriptor);
// 1. Bind (produces Layout and Bound AST with Addresses)
var boundAst := TAstBinder.Bind(FRootScope.Descriptor.Layout, Node, Layout, FFunctionRegistry, ArgTypes);
Result := typedAst;
// 2. Check Types (produces Typed AST with Descriptors baked into nodes)
Result := TTypeChecker.CheckTypes(boundAst, Layout);
end;
function TEnvironment.GetMacroRegistry: IMacroRegistry;
@@ -524,7 +509,6 @@ end;
function TEnvironment.CreateEnvironment: IEnvironment;
begin
// Create a new child environment. It inherits the parent scope (FRootScope) and does *not* re-register the RTL.
Result := TEnvironment.Create(TAst.CreateScope(FRootScope), TMacroRegistryImpl.Create(FMacroRegistry), FExecutionStrategy);
end;
@@ -534,28 +518,52 @@ function TEnvironment.Compile(
const ArgTypes: TArray<IStaticType>
): TCompiledFunction;
var
desc: IScopeDescriptor;
layout: IScopeLayout;
descriptor: IScopeDescriptor;
funcType: IStaticType;
finalFunc: TDataValue.TFunc;
typedNode: IAstNode;
specialized: IAstNode;
tcoOptimized: IAstNode;
begin
// 0. Wrap in Lambda to create an isolatable compilation unit (scope)
var prg := TAst.LambdaExpr(Params, Node);
// 1. Expand Macros
var expanded := ExpandMacros(prg);
var bound := Bind(expanded, desc, ArgTypes);
Assert(bound.IsTyped);
funcType := bound.AsTypedNode.StaticType;
// 2. Bind & Check Types
typedNode := Bind(expanded, layout, ArgTypes);
var specialized := Specialize(bound, desc);
var tcoOptimized := TAstTCO.Optimize(specialized);
// Retrieve the descriptor from the typed lambda node
// (The TypeChecker baked it into the new LambdaExpressionNode)
descriptor := typedNode.AsLambdaExpression.Descriptor;
Assert(Assigned(descriptor), 'Compiler Logic Error: Descriptor missing after type checking.');
var visitor := FExecutionStrategy.CreateVisitor(desc.CreateScope(FRootScope));
var func := tcoOptimized.Accept(visitor).AsMethod;
funcType := typedNode.AsTypedNode.StaticType;
// 3. Specialize
specialized := Specialize(typedNode);
// 4. Optimize (TCO)
tcoOptimized := TAstTCO.Optimize(specialized);
// 5. Create Evaluator
// We create a scope based on the descriptor to run the lambda body.
// The lambda itself (as a node) is evaluated to produce a closure.
// Since we wrapped the user code in a LambdaExpr, evaluating 'tcoOptimized'
// returns the closure (TFunc).
var visitor := FExecutionStrategy.CreateVisitor(descriptor.CreateScope(FRootScope));
// Execute the AST to get the TFunc (Closure)
var closure := tcoOptimized.Accept(visitor);
// Wrap TCO handling for the final result
finalFunc :=
function(const Args: TArray<TDataValue>): TDataValue
begin
Result := func(Args);
Result := closure.AsMethod()(Args);
TEvaluatorVisitor.HandleTCO(Result);
end;
@@ -564,25 +572,31 @@ end;
function TEnvironment.Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction;
var
desc: IScopeDescriptor;
layout: IScopeLayout;
descriptor: IScopeDescriptor;
funcType: IStaticType;
finalFunc: TDataValue.TFunc;
typedNode, specialized, tcoOptimized: IAstNode;
begin
// Same steps as above, but Node is already a definition (Lambda)
var expanded := ExpandMacros(Node);
var bound := Bind(expanded, desc, ArgTypes);
typedNode := Bind(expanded, layout, ArgTypes);
funcType := bound.AsTypedNode.StaticType;
descriptor := typedNode.AsLambdaExpression.Descriptor;
Assert(Assigned(descriptor));
funcType := typedNode.AsTypedNode.StaticType;
var specialized := Specialize(bound, desc);
var tcoOptimized := TAstTCO.Optimize(specialized);
specialized := Specialize(typedNode);
tcoOptimized := TAstTCO.Optimize(specialized);
var visitor := FExecutionStrategy.CreateVisitor(desc.CreateScope(FRootScope));
var func := tcoOptimized.Accept(visitor).AsMethod;
var visitor := FExecutionStrategy.CreateVisitor(descriptor.CreateScope(FRootScope));
var closure := tcoOptimized.Accept(visitor);
finalFunc :=
function(const Args: TArray<TDataValue>): TDataValue
begin
Result := func(Args);
Result := closure.AsMethod()(Args);
TEvaluatorVisitor.HandleTCO(Result);
end;
@@ -606,10 +620,9 @@ begin
Result := FFunctionRegistry;
end;
function TEnvironment.Specialize(const Node: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;
function TEnvironment.Specialize(const Node: IAstNode): IAstNode;
begin
// Call the new Specializer, passing the environment for cache access
Result := TStaticSpecializer.Specialize(Self, Node, ADescriptor);
Result := TStaticSpecializer.Specialize(Self, Node);
end;
end.
Src/AST/Myc.Ast.Evaluator.pas
+43 -44
View File
@@ -18,7 +18,6 @@ type
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor, IEvaluatorVisitor)
private
FScope: IExecutionScope;
class var
protected
// IAstVisitor methods made virtual for TDebugEvaluatorVisitor to override
@@ -70,7 +69,7 @@ uses
Myc.Data.Decimal,
Myc.Data.Series,
Myc.Data.Scalar.JSON,
Myc.Ast.Types; // Added for VisitRecordLiteral
Myc.Ast.Types;
// Helper type for TCO via trampolining.
type
@@ -178,27 +177,35 @@ function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNo
var
capturedCells: TArray<IValueCell>;
i: Integer;
sourceAddresses: TArray<TResolvedAddress>;
closureScope: IExecutionScope;
visitorFactory: TEvaluatorFactory;
begin
// Access binder-specific information via the interface
sourceAddresses := Node.Upvalues;
SetLength(capturedCells, Length(sourceAddresses));
for i := 0 to High(sourceAddresses) do
capturedCells[i] := FScope.Capture(sourceAddresses[i]);
// 1. Capture Upvalues
// The Node.Upvalues array contains the physical addresses in the *current* scope (FScope)
// that map to the closure's upvalues.
if Node.Upvalues <> nil then
begin
SetLength(capturedCells, Length(Node.Upvalues));
for i := 0 to High(Node.Upvalues) do
capturedCells[i] := FScope.Capture(Node.Upvalues[i]);
end
else
capturedCells := nil;
// 2. Determine Parent Scope for Closure
// Memory optimization: a lambda's scope does not need to be kept alive as a parent
// if it contains no nested lambdas that might need to capture from it later.
// (Assuming HasNestedLambdas flag is set correctly by Binder)
if Node.HasNestedLambdas then
closureScope := FScope
else
closureScope := nil;
// Get a factory to create the correct visitor (e.g., debug or production) for the lambda body.
// 3. Prepare Visitor Factory
visitorFactory := CreateVisitorFactory();
var scopeDescriptor := Node.ScopeDescriptor;
// 4. Capture Metadata for Closure
var descriptor := Node.Descriptor; // Runtime Descriptor (contains types + layout)
var params := Node.Parameters;
var cNode: ILambdaExpressionNode := Node;
@@ -216,9 +223,10 @@ begin
raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(params), Length(ArgValues)]);
// Create the new execution scope for this function call.
lambdaScope := TScope.CreateScope(closureScope, scopeDescriptor, capturedCells);
lambdaScope := TScope.CreateScope(closureScope, descriptor, capturedCells);
// Capture the closure itself in slot 0 for 'recur' to find it.
// Capture the closure itself in slot 0 for 'recur' to find it (if needed).
// Note: The Binder reserves Slot 0 for <self>.
adr.Kind := akLocalOrParent;
adr.ScopeDepth := 0;
adr.SlotIndex := 0;
@@ -227,8 +235,13 @@ begin
// Populate the scope with the actual parameters passed to the function.
for i := 0 to High(ArgValues) do
begin
// Parameters in a bound lambda must be bound identifiers.
adr.SlotIndex := params[i].Address.SlotIndex;
// Parameters are bound to specific slots by the Binder.
// We access them via the Address stored in the parameter node.
adr := params[i].Address;
// Defensive check: Ensure we are writing to local scope
Assert(adr.ScopeDepth = 0);
lambdaScope[adr] := ArgValues[i];
end;
@@ -244,8 +257,7 @@ end;
function TEvaluatorVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
begin
// Macro definitions are compile-time constructs.
// The MacroExpander leaves them in the AST for the Visualizer.
// The Evaluator must simply ignore them.
// The Evaluator ignores them (treated as Void).
Result := TDataValue.Void;
end;
@@ -279,17 +291,14 @@ begin
SetLength(argValues, Length(argNodes));
for i := 0 to High(argNodes) do
begin
Assert(argNodes[i].IsTyped and (argNodes[i].AsTypedNode.StaticType <> TTypes.Unknown), 'Static call argument is not typed.');
// Assuming arguments passed type check
argValues[i] := argNodes[i].Accept(Self);
end;
// 2. Call the static target directly
// The target is a TDataValue.TFunc expecting TArray<TDataValue>
Result := Node.StaticTarget(argValues);
// 3. Handle TCO
// If the static target itself was a compiled lambda ending in 'recur',
// it will return a Thunk, which we must handle.
HandleTCO(Result);
end
else
@@ -313,7 +322,6 @@ begin
begin
// This is a non-tail call. It must execute the call and act as the trampoline.
Result := (calleeValue.AsMethod)(argValues);
HandleTCO(Result);
end;
end;
@@ -386,7 +394,7 @@ function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataVa
begin
// Evaluate the new value.
Result := Node.Value.Accept(Self);
// Assign it. The scope's SetValues implementation now handles boxing correctly.
// Assign it.
FScope[Node.Identifier.Address] := Result;
end;
@@ -423,7 +431,7 @@ end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
// The scope's GetValues implementation now handles unboxing automatically.
// The scope's GetValues implementation handles unboxing and parent lookup.
Result := FScope[Node.Address];
end;
@@ -493,7 +501,6 @@ begin
vkRecord: Result := TDataValue(baseValue.AsRecord[Node.Member.Value]); // Explicit cast
// --- NEW GENERIC PATH ---
vkGenericRecord:
begin
var rec := baseValue.AsGenericRecord;
@@ -511,17 +518,14 @@ end;
function TEvaluatorVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
var
i: Integer;
staticType: IStaticType;
begin
staticType := Node.StaticType; // Get the type set by TypeChecker
if staticType.Kind = stGenericRecord then
// Use the properties populated by the TypeChecker/Binder
if Assigned(Node.GenericDefinition) then
begin
// --- NEW GENERIC PATH ---
// --- GENERIC RECORD PATH ---
var genFields: TArray<TPair<IKeyword, TDataValue>>;
SetLength(genFields, Length(Node.Fields));
// Evaluate all field values
for i := 0 to High(Node.Fields) do
begin
genFields[i] :=
@@ -531,54 +535,51 @@ begin
);
end;
// Create the new runtime object and wrap it
var dynRec := TDynamicRecord.Create(genFields);
Result := TDataValue.FromGenericRecord(dynRec);
end
else if staticType.Kind = stRecord then
else if Assigned(Node.ScalarDefinition) then
begin
// --- EXISTING SCALAR PATH ---
// --- SCALAR RECORD PATH ---
var values: TArray<TScalar.TValue>;
SetLength(values, Length(Node.Fields));
for i := 0 to High(Node.Fields) do
begin
var valData := Node.Fields[i].Value.Accept(Self);
// TypeChecker guarantees these are vkScalar
values[i] := valData.AsScalar.Value;
end;
// Get the definition from the type
var rec := TScalarRecord.Create(staticType.Definition, values);
var rec := TScalarRecord.Create(Node.ScalarDefinition, values);
Result := TDataValue.FromRecord(rec);
end
else
raise EInvalidOpException.Create('Unknown record literal node type during evaluation.');
raise EInvalidOpException.Create('RecordLiteral has no definition (Binder/TypeChecker failure).');
end;
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
var
address: TResolvedAddress;
begin
// First, evaluate the initializer to get the variable's initial value.
// 1. Evaluate Initializer
if Assigned(Node.Initializer) then
Result := Node.Initializer.Accept(Self)
else
Result := TDataValue.Void;
// Access properties via interface
// 2. Get Address (assigned by Binder)
address := Node.Identifier.Address;
// Check the IsBoxed flag set by the binder.
// 3. Store Value
if Node.IsBoxed then
begin
// This is a captured variable. Use the clean scope method to create the box.
// Capture (heap alloc)
Assert(address.ScopeDepth = 0);
FScope.DefineBoxed(address.SlotIndex, Result);
end
else
begin
// This is a standard local variable. Store the raw value directly.
// Stack alloc
FScope[address] := Result;
end;
end;
@@ -612,8 +613,6 @@ end;
function TEvaluatorVisitor.VisitNop(const Node: INopNode): TDataValue;
begin
// This node should be rejected by the Binder/TypeChecker.
// If it reaches the evaluator, it's a compiler bug, but we treat it as Void.
Result := TDataValue.Void;
end;
Src/AST/Myc.Ast.Nodes.pas
+13 -3
View File
@@ -106,7 +106,7 @@ type
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
function VisitRecurNode(const Node: IRecurNode): TDataValue;
function VisitNop(const Node: INopNode): TDataValue; // Added Nop
function VisitNop(const Node: INopNode): TDataValue;
end;
IAstNode = interface(IInterface)
@@ -219,13 +219,23 @@ type
{$region 'private'}
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IAstNode;
function GetScopeDescriptor: IScopeDescriptor;
// The structural layout. Always present after binding.
function GetLayout: IScopeLayout;
// The runtime descriptor. Can be nil during early compilation phases.
function GetDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<TResolvedAddress>;
function GetHasNestedLambdas: Boolean;
{$endregion}
property Parameters: TArray<IIdentifierNode> read GetParameters;
property Body: IAstNode read GetBody;
property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor;
property Layout: IScopeLayout read GetLayout;
property Descriptor: IScopeDescriptor read GetDescriptor;
property Upvalues: TArray<TResolvedAddress> read GetUpvalues;
property HasNestedLambdas: Boolean read GetHasNestedLambdas;
end;
Src/AST/Myc.Ast.Scope.pas
+336 -177
View File
@@ -13,8 +13,10 @@ uses
type
IExecutionScope = interface;
IScopeDescriptor = interface;
IScopeLayout = interface;
// --- Address & Symbol Types ---
// Defines how an identifier's address was resolved.
TAddressKind = (akUnresolved, akLocalOrParent, akUpvalue);
TResolvedAddress = record
@@ -23,7 +25,6 @@ type
SlotIndex: Integer;
constructor Create(AKind: TAddressKind; AScopeDepth, ASlotIndex: Integer);
class operator Initialize(out Dest: TResolvedAddress);
public
class operator Equal(const A: TResolvedAddress; B: TResolvedAddress): Boolean;
end;
@@ -33,7 +34,6 @@ type
function GetHashCode(const Value: TResolvedAddress): Integer; override;
end;
// A resolved symbol, containing its runtime address and static type.
TResolvedSymbol = record
Address: TResolvedAddress;
StaticType: IStaticType;
@@ -49,48 +49,65 @@ type
property Value: TDataValue read GetValue write SetValue;
end;
// Describes the layout of a scope: variable names, their slot indices and macros.
// --- SCOPE STRUCTURE (Compile Time) ---
// 1. The Product (Immutable).
IScopeLayout = interface
{$region 'private'}
function GetParent: IScopeLayout;
function GetSlotCount: Integer;
{$endregion}
function FindSlot(const Name: string): Integer;
// Returns all defined symbols in this layout (for debugging/reflection)
function GetSymbols: TArray<string>;
property Parent: IScopeLayout read GetParent;
property SlotCount: Integer read GetSlotCount;
end;
// 2. The Builder (Mutable).
IScopeBuilder = interface(IScopeLayout)
function Define(const Name: string): Integer;
function Build: IScopeLayout;
end;
// --- RUNTIME ARTIFACTS ---
// Describes the semantics of a scope: Layout + Types.
IScopeDescriptor = interface
{$region 'private'}
function GetParent: IScopeDescriptor;
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
function GetType(SlotIndex: Integer): IStaticType;
function GetLayout: IScopeLayout;
function GetSymbolType(SlotIndex: Integer): IStaticType;
{$endregion}
function CreateScope(const AParent: IExecutionScope): IExecutionScope;
function Define(const Name: string; const AType: IStaticType = nil): Integer;
procedure UpdateType(SlotIndex: Integer; const AType: IStaticType);
function FindSymbol(const Name: string): TResolvedSymbol;
property Parent: IScopeDescriptor read GetParent;
property SlotCount: Integer read GetSlotCount;
property Symbols: TDictionary<string, Integer> read GetSymbols;
property Layout: IScopeLayout read GetLayout;
end;
IExecutionScope = interface
{$region 'private'}
function GetParent: IExecutionScope;
function GetDescriptor: IScopeDescriptor; // (* ADDED *)
function GetDescriptor: IScopeDescriptor;
function GetValues(const Address: TResolvedAddress): TDataValue;
procedure SetValues(const Address: TResolvedAddress; const Value: TDataValue);
{$endregion}
function Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType = nil): TResolvedAddress;
procedure DefineBoxed(SlotIndex: Integer; const Value: TDataValue);
function Dump: string;
procedure Clear;
function Capture(const Address: TResolvedAddress): IValueCell;
function GetNameID(const Name: String): Integer;
function Resolve(const Name: string): TResolvedAddress;
// (* REMOVED: function CreateDescriptor: IScopeDescriptor; *)
function Dump: string;
procedure Clear;
property Values[const Address: TResolvedAddress]: TDataValue read GetValues write SetValues; default;
property Parent: IExecutionScope read GetParent;
property Descriptor: IScopeDescriptor read GetDescriptor; // (* ADDED *)
property Descriptor: IScopeDescriptor read GetDescriptor;
end;
TScope = record
@@ -99,7 +116,10 @@ type
const Descriptor: IScopeDescriptor;
const CapturedUpvalues: TArray<IValueCell>
): IExecutionScope; static;
class function CreateDescriptor(const Parent: IScopeDescriptor): IScopeDescriptor; static;
class function CreateBuilder(const ParentLayout: IScopeLayout): IScopeBuilder; static;
class function CreateDescriptor(const Layout: IScopeLayout; const Types: TArray<IStaticType>): IScopeDescriptor; static;
class function CreateRootLayout: IScopeLayout; static;
end;
implementation
@@ -109,26 +129,50 @@ uses
System.SyncObjs;
type
TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor)
// --- Concrete Layout (Immutable) ---
TScopeLayout = class(TInterfacedObject, IScopeLayout)
private
FParent: IScopeDescriptor;
FSymbols: TDictionary<string, Integer>;
FSlotTypes: TArray<IStaticType>;
function GetParent: IScopeDescriptor;
FParent: IScopeLayout;
FMap: TDictionary<string, Integer>;
function GetParent: IScopeLayout;
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
function GetType(SlotIndex: Integer): IStaticType;
public
constructor Create(const AParent: IScopeDescriptor);
constructor Create(const AParent: IScopeLayout; AMap: TDictionary<string, Integer>);
destructor Destroy; override;
// (* REMOVED: class function CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor; *)
function Define(const Name: string; const AType: IStaticType): Integer;
procedure UpdateType(SlotIndex: Integer; const AType: IStaticType = nil);
function FindSymbol(const Name: string): TResolvedSymbol;
function CreateScope(const Parent: IExecutionScope): IExecutionScope;
property Symbols: TDictionary<string, Integer> read FSymbols;
function FindSlot(const Name: string): Integer;
function GetSymbols: TArray<string>;
end;
// --- Concrete Builder (Mutable) ---
TScopeBuilder = class(TInterfacedObject, IScopeBuilder, IScopeLayout)
private
FParentLayout: IScopeLayout;
FMap: TDictionary<string, Integer>;
function GetParent: IScopeLayout;
function GetSlotCount: Integer;
public
constructor Create(const AParentLayout: IScopeLayout);
destructor Destroy; override;
function Define(const Name: string): Integer;
function FindSlot(const Name: string): Integer;
function GetSymbols: TArray<string>;
function Build: IScopeLayout;
end;
// --- Descriptor Implementation ---
TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor)
private
FLayout: IScopeLayout;
FSlotTypes: TArray<IStaticType>;
function GetLayout: IScopeLayout;
function GetSymbolType(SlotIndex: Integer): IStaticType;
public
constructor Create(const ALayout: IScopeLayout; const ATypes: TArray<IStaticType>);
function CreateScope(const Parent: IExecutionScope): IExecutionScope;
end;
// --- Execution Scope ---
TExecutionScope = class(TInterfacedObject, IExecutionScope)
private
type
@@ -147,9 +191,35 @@ type
function GetContent: TDataValue; inline;
end;
TDynamicLayout = class(TInterfacedObject, IScopeLayout)
private
[weak]
FOwner: TExecutionScope;
function GetParent: IScopeLayout;
function GetSlotCount: Integer;
public
constructor Create(AOwner: TExecutionScope);
function FindSlot(const Name: string): Integer;
function GetSymbols: TArray<string>;
end;
TDynamicDescriptor = class(TInterfacedObject, IScopeDescriptor)
private
[weak]
FOwner: TExecutionScope;
FLayout: IScopeLayout;
function GetLayout: IScopeLayout;
function GetSymbolType(SlotIndex: Integer): IStaticType;
public
constructor Create(AOwner: TExecutionScope);
function CreateScope(const Parent: IExecutionScope): IExecutionScope;
end;
private
FParent: IExecutionScope;
FDescriptor: IScopeDescriptor;
FStaticDescriptor: IScopeDescriptor;
FLayoutIntf: IScopeLayout;
FSlotTypes: TArray<IStaticType>;
FValues: TArray<TScopeItem>;
FCapturedUpvalues: TArray<IValueCell>;
FNames: TDictionary<string, Integer>;
@@ -159,7 +229,7 @@ type
procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
procedure NeedNameToIndex;
function GetParent: IExecutionScope;
function GetDescriptor: IScopeDescriptor; // (* ADDED *)
function GetDescriptor: IScopeDescriptor;
function GetNameToIndex: TDictionary<Integer, Integer>;
function GetValues(const Address: TResolvedAddress): TDataValue;
procedure SetValues(const Address: TResolvedAddress; const Value: TDataValue);
@@ -173,7 +243,7 @@ type
function Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType = nil): TResolvedAddress;
procedure DefineBoxed(SlotIndex: Integer; const Value: TDataValue);
function Capture(const Address: TResolvedAddress): IValueCell;
// (* REMOVED: function CreateDescriptor: IScopeDescriptor; *)
property Names: TDictionary<string, Integer> read FNames;
property NameStrings: TList<string> read FNameStrings;
property NameToIndex: TDictionary<Integer, Integer> read GetNameToIndex;
@@ -181,7 +251,7 @@ type
property ValuesArray: TArray<TScopeItem> read FValues;
end;
{ TResolvedAddressComparer }
{ TResolvedAddress & Symbol }
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
begin
@@ -198,8 +268,6 @@ begin
Result := THashBobJenkins.GetHashValue(adr.SlotIndex, SizeOf(Integer), Result);
end;
{ TResolvedAddress }
constructor TResolvedAddress.Create(AKind: TAddressKind; AScopeDepth, ASlotIndex: Integer);
begin
Kind := AKind;
@@ -219,8 +287,6 @@ begin
Dest.SlotIndex := -1;
end;
{ TResolvedSymbol }
constructor TResolvedSymbol.Create(const AAddress: TResolvedAddress; const AStaticType: IStaticType);
begin
Address := AAddress;
@@ -232,7 +298,176 @@ begin
Dest.StaticType := TTypes.Unknown;
end;
{ TExecutionScope.TValueCell }
{ TScopeLayout }
constructor TScopeLayout.Create(const AParent: IScopeLayout; AMap: TDictionary<string, Integer>);
begin
inherited Create;
FParent := AParent;
FMap := AMap;
end;
destructor TScopeLayout.Destroy;
begin
FMap.Free;
inherited;
end;
function TScopeLayout.FindSlot(const Name: string): Integer;
begin
if not FMap.TryGetValue(Name, Result) then
Result := -1;
end;
function TScopeLayout.GetSymbols: TArray<string>;
begin
Result := FMap.Keys.ToArray;
end;
function TScopeLayout.GetParent: IScopeLayout;
begin
Result := FParent;
end;
function TScopeLayout.GetSlotCount: Integer;
begin
Result := FMap.Count;
end;
{ TScopeBuilder }
constructor TScopeBuilder.Create(const AParentLayout: IScopeLayout);
begin
inherited Create;
FParentLayout := AParentLayout;
FMap := TDictionary<string, Integer>.Create;
end;
destructor TScopeBuilder.Destroy;
begin
FMap.Free;
inherited;
end;
function TScopeBuilder.Define(const Name: string): Integer;
begin
Result := FMap.Count;
FMap.Add(Name, Result);
end;
function TScopeBuilder.FindSlot(const Name: string): Integer;
begin
if not FMap.TryGetValue(Name, Result) then
Result := -1;
end;
function TScopeBuilder.GetSymbols: TArray<string>;
begin
Result := FMap.Keys.ToArray;
end;
function TScopeBuilder.Build: IScopeLayout;
begin
Result := TScopeLayout.Create(FParentLayout, TDictionary<string, Integer>.Create(FMap));
end;
function TScopeBuilder.GetParent: IScopeLayout;
begin
Result := FParentLayout;
end;
function TScopeBuilder.GetSlotCount: Integer;
begin
Result := FMap.Count;
end;
{ TScopeDescriptor }
constructor TScopeDescriptor.Create(const ALayout: IScopeLayout; const ATypes: TArray<IStaticType>);
begin
inherited Create;
FLayout := ALayout;
FSlotTypes := ATypes;
end;
function TScopeDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope;
begin
Result := TExecutionScope.Create(Parent, Self, nil);
end;
function TScopeDescriptor.GetLayout: IScopeLayout;
begin
Result := FLayout;
end;
function TScopeDescriptor.GetSymbolType(SlotIndex: Integer): IStaticType;
begin
if (SlotIndex >= 0) and (SlotIndex < Length(FSlotTypes)) then
Result := FSlotTypes[SlotIndex]
else
Result := TTypes.Unknown;
end;
{ TExecutionScope Proxies }
constructor TExecutionScope.TDynamicLayout.Create(AOwner: TExecutionScope);
begin
inherited Create;
FOwner := AOwner;
end;
function TExecutionScope.TDynamicLayout.FindSlot(const Name: string): Integer;
begin
if not FOwner.Names.TryGetValue(Name, Result) then
Result := -1
else if not FOwner.NameToIndex.TryGetValue(Result, Result) then
Result := -1;
end;
function TExecutionScope.TDynamicLayout.GetSymbols: TArray<string>;
begin
Result := FOwner.FNames.Keys.ToArray;
end;
function TExecutionScope.TDynamicLayout.GetParent: IScopeLayout;
begin
if Assigned(FOwner.Parent) then
Result := FOwner.Parent.Descriptor.Layout
else
Result := nil;
end;
function TExecutionScope.TDynamicLayout.GetSlotCount: Integer;
begin
Result := Length(FOwner.FValues);
end;
constructor TExecutionScope.TDynamicDescriptor.Create(AOwner: TExecutionScope);
begin
inherited Create;
FOwner := AOwner;
FLayout := TDynamicLayout.Create(AOwner);
end;
function TExecutionScope.TDynamicDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope;
begin
Result := TExecutionScope.Create(Parent, Self, nil);
end;
function TExecutionScope.TDynamicDescriptor.GetLayout: IScopeLayout;
begin
Result := FLayout;
end;
function TExecutionScope.TDynamicDescriptor.GetSymbolType(SlotIndex: Integer): IStaticType;
begin
if (SlotIndex >= 0) and (SlotIndex < Length(FOwner.FSlotTypes)) then
Result := FOwner.FSlotTypes[SlotIndex]
else
Result := TTypes.Unknown;
end;
{ TExecutionScope }
constructor TExecutionScope.TValueCell.Create(const AValue: TDataValue);
begin
@@ -250,8 +485,6 @@ begin
FValue := AValue;
end;
{ TExecutionScope }
constructor TExecutionScope.Create(
AParent: IExecutionScope;
const ADescriptor: IScopeDescriptor;
@@ -261,18 +494,17 @@ begin
inherited Create;
FParent := AParent;
// (* MODIFIED: Clean logic for Descriptor initialization *)
if Assigned(ADescriptor) then
FDescriptor := ADescriptor
else if Assigned(AParent) then
begin
// Create a NEW empty descriptor that is a CHILD of the parent's descriptor.
// Use the Descriptor property of the parent scope.
FDescriptor := TScopeDescriptor.Create(AParent.Descriptor);
FStaticDescriptor := ADescriptor;
FLayoutIntf := ADescriptor.Layout;
end
else
// Create a new root descriptor (parent = nil)
FDescriptor := TScopeDescriptor.Create(nil);
begin
FStaticDescriptor := nil;
FLayoutIntf := nil;
FSlotTypes := [];
end;
FValues := [];
FCapturedUpvalues := ACapturedUpvalues;
@@ -288,8 +520,8 @@ begin
FNameStrings := TList<string>.Create;
end;
if Assigned(ADescriptor) then
SetLength(FValues, ADescriptor.SlotCount);
if Assigned(FLayoutIntf) then
SetLength(FValues, FLayoutIntf.SlotCount);
end;
destructor TExecutionScope.Destroy;
@@ -310,7 +542,10 @@ end;
function TExecutionScope.GetDescriptor: IScopeDescriptor;
begin
Result := FDescriptor;
if Assigned(FStaticDescriptor) then
Result := FStaticDescriptor
else
Result := TDynamicDescriptor.Create(Self);
end;
procedure TExecutionScope.Clear;
@@ -327,7 +562,6 @@ begin
case Address.Kind of
akUpvalue:
begin
Assert(Assigned(FCapturedUpvalues));
Result := FCapturedUpvalues[Address.SlotIndex];
end;
akLocalOrParent:
@@ -356,32 +590,32 @@ begin
end;
end;
function TExecutionScope.Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType = nil): TResolvedAddress;
function TExecutionScope.Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType): TResolvedAddress;
var
id: Integer;
index: Integer;
staticType: IStaticType;
begin
NeedNameToIndex;
id := GetNameID(Name);
if FNameToIndex.ContainsKey(id) then
raise Exception.CreateFmt('Variable "%s" is already defined in this scope.', [Name]);
if Assigned(AStaticType) then
staticType := AStaticType
else
staticType := TTypes.Unknown;
index := Length(FValues);
SetLength(FValues, index + 1);
FValues[index].Value := Value;
FValues[index].IsBoxed := False;
if FStaticDescriptor = nil then
begin
if index >= Length(FSlotTypes) then
SetLength(FSlotTypes, index + 1);
if Assigned(AStaticType) then
FSlotTypes[index] := AStaticType
else
FSlotTypes[index] := TTypes.Unknown;
end;
FNameToIndex.Add(id, index);
// Update the descriptor
var descSlot := FDescriptor.Define(Name, staticType);
Assert(descSlot = index, 'Scope descriptor slot mismatch during Define');
Result.Kind := akLocalOrParent;
Result.ScopeDepth := 0;
Result.SlotIndex := index;
@@ -389,6 +623,8 @@ end;
procedure TExecutionScope.DefineBoxed(SlotIndex: Integer; const Value: TDataValue);
begin
if SlotIndex >= Length(FValues) then
SetLength(FValues, SlotIndex + 1);
FValues[SlotIndex].Value := TDataValue.FromIntf<IValueCell>(TValueCell.Create(Value));
FValues[SlotIndex].IsBoxed := True;
end;
@@ -414,18 +650,21 @@ begin
for pair in sortedPairs do
begin
item := FValues[pair.Value];
if item.IsBoxed then
if pair.Value < Length(FValues) then
begin
boxedStr := ' (Boxed)';
val := (item.Value.AsIntf<IValueCell>).Value;
end
else
begin
boxedStr := '';
val := item.Value;
item := FValues[pair.Value];
if item.IsBoxed then
begin
boxedStr := ' (Boxed)';
val := (item.Value.AsIntf<IValueCell>).Value;
end
else
begin
boxedStr := '';
val := item.Value;
end;
ABuilder.AppendLine(indentStr + Format(' [%d] %s: %s%s', [pair.Value, FNameStrings[pair.Key], val.ToString, boxedStr]));
end;
ABuilder.AppendLine(indentStr + Format(' [%d] %s: %s%s', [pair.Value, FNameStrings[pair.Key], val.ToString, boxedStr]));
end;
end
else
@@ -465,7 +704,6 @@ begin
case Address.Kind of
akUpvalue:
begin
Assert(Assigned(FCapturedUpvalues));
Result := FCapturedUpvalues[Address.SlotIndex].Value;
end;
akLocalOrParent:
@@ -499,9 +737,10 @@ begin
if FNameToIndex = nil then
begin
FNameToIndex := TDictionary<Integer, Integer>.Create;
if FDescriptor <> nil then
if Assigned(FStaticDescriptor) and (FStaticDescriptor.Layout is TScopeLayout) then
begin
for var item in FDescriptor.Symbols do
var map := (FStaticDescriptor.Layout as TScopeLayout).FMap;
for var item in map do
FNameToIndex.AddOrSetValue(GetNameId(item.Key), item.Value);
end;
end;
@@ -509,8 +748,7 @@ end;
function TExecutionScope.Resolve(const Name: string): TResolvedAddress;
var
nameID: Integer;
slotIndex: Integer;
nameID, slotIndex: Integer;
currentScope: IExecutionScope;
depth: Integer;
begin
@@ -542,7 +780,6 @@ begin
case Address.Kind of
akUpvalue:
begin
Assert(Assigned(FCapturedUpvalues));
FCapturedUpvalues[Address.SlotIndex].Value := Value;
end;
akLocalOrParent:
@@ -569,99 +806,16 @@ begin
Result := Result.AsIntf<IValueCell>.Value;
end;
{ TScopeDescriptor }
constructor TScopeDescriptor.Create(const AParent: IScopeDescriptor);
begin
inherited Create;
FParent := AParent;
FSymbols := TDictionary<string, Integer>.Create;
FSlotTypes := [];
end;
destructor TScopeDescriptor.Destroy;
begin
FSlotTypes := nil;
FSymbols.Free;
inherited;
end;
function TScopeDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope;
begin
Result := TExecutionScope.Create(Parent, Self, nil);
end;
function TScopeDescriptor.Define(const Name: string; const AType: IStaticType): Integer;
begin
Result := FSymbols.Count;
FSymbols.Add(Name, Result);
SetLength(FSlotTypes, Result + 1);
FSlotTypes[Result] :=
if AType <> nil then AType
else TTypes.Unknown;
end;
procedure TScopeDescriptor.UpdateType(SlotIndex: Integer; const AType: IStaticType = nil);
begin
if (SlotIndex < 0) or (SlotIndex >= Length(FSlotTypes)) then
raise EArgumentOutOfRangeException.Create('Invalid SlotIndex in UpdateType.');
FSlotTypes[SlotIndex] :=
If AType <> nil then AType
else TTypes.Unknown;
end;
function TScopeDescriptor.FindSymbol(const Name: string): TResolvedSymbol;
var
currentDescriptor: IScopeDescriptor;
slotIndex: Integer;
begin
Result.StaticType := TTypes.Unknown;
Result.Address.Kind := akUnresolved;
Result.Address.ScopeDepth := 0;
currentDescriptor := Self;
while Assigned(currentDescriptor) do
begin
if currentDescriptor.Symbols.TryGetValue(Name, slotIndex) then
begin
Result.Address.Kind := akLocalOrParent;
Result.Address.SlotIndex := slotIndex;
Result.StaticType := currentDescriptor.GetType(slotIndex);
exit;
end;
inc(Result.Address.ScopeDepth);
currentDescriptor := currentDescriptor.Parent;
end;
end;
function TScopeDescriptor.GetParent: IScopeDescriptor;
begin
Result := FParent;
end;
function TScopeDescriptor.GetSlotCount: Integer;
begin
Result := FSymbols.Count;
end;
function TScopeDescriptor.GetSymbols: TDictionary<string, Integer>;
begin
Result := FSymbols;
end;
function TScopeDescriptor.GetType(SlotIndex: Integer): IStaticType;
begin
if (SlotIndex < 0) or (SlotIndex >= Length(FSlotTypes)) then
raise EArgumentOutOfRangeException.Create('Invalid SlotIndex in GetType.');
Result := FSlotTypes[SlotIndex];
end;
{ TScope }
class function TScope.CreateDescriptor(const Parent: IScopeDescriptor): IScopeDescriptor;
class function TScope.CreateBuilder(const ParentLayout: IScopeLayout): IScopeBuilder;
begin
// Factory for a new, empty descriptor
Result := TScopeDescriptor.Create(Parent);
Result := TScopeBuilder.Create(ParentLayout);
end;
class function TScope.CreateDescriptor(const Layout: IScopeLayout; const Types: TArray<IStaticType>): IScopeDescriptor;
begin
Result := TScopeDescriptor.Create(Layout, Types);
end;
class function TScope.CreateScope(
@@ -673,4 +827,9 @@ begin
Result := TExecutionScope.Create(Parent, Descriptor, CapturedUpvalues);
end;
class function TScope.CreateRootLayout: IScopeLayout;
begin
Result := TScopeLayout.Create(nil, TDictionary<string, Integer>.Create);
end;
end.
Src/AST/Myc.Ast.Visitor.pas
+1 -1
View File
@@ -486,7 +486,7 @@ begin
else
begin
// Use TAst factory and copy properties via interface getters
Result := TAst.LambdaExpr(newParams, newBody, Node.ScopeDescriptor, Node.Upvalues, Node.HasNestedLambdas, Node.StaticType);
Result := TAst.LambdaExpr(newParams, newBody, Node.Layout, Node.Descriptor, Node.Upvalues, Node.HasNestedLambdas, Node.StaticType);
end;
end;
Src/AST/Myc.Ast.pas
+32 -27
View File
@@ -56,11 +56,12 @@ type
const AStaticType: IStaticType = nil
): ITernaryExpressionNode; static;
// Updated Factory Signature
// Factory Updated: Includes Layout (mandatory) and Descriptor (optional)
class function LambdaExpr(
const AParameters: TArray<IIdentifierNode>;
const ABody: IAstNode;
const AScopeDescriptor: IScopeDescriptor = nil;
const ALayout: IScopeLayout = nil; // Nil allowed only for raw AST construction (before Binder)
const ADescriptor: IScopeDescriptor = nil; // Nil allowed before TypeChecker
const AUpvalues: TArray<TResolvedAddress> = nil;
const AHasNestedLambdas: Boolean = False;
const AStaticType: IStaticType = nil
@@ -75,7 +76,6 @@ type
class function Unquote(const AExpression: IAstNode): IUnquoteNode; static;
class function UnquoteSplicing(const AExpression: IQuasiquoteNode): IUnquoteSplicingNode; static;
// Updated Factory Signature
class function FunctionCall(
const ACallee: IAstNode;
const AArguments: TArray<IAstNode>;
@@ -91,7 +91,6 @@ type
class function Recur(const AArguments: array of IAstNode; const AStaticType: IStaticType = nil): IRecurNode; static;
class function Block(const AExpressions: array of IAstNode; const AStaticType: IStaticType = nil): IBlockExpressionNode; static;
// Updated Factory Signature
class function VarDecl(
const AIdentifier: IIdentifierNode;
AInitializer: IAstNode = nil;
@@ -134,9 +133,8 @@ uses
System.Generics.Defaults;
type
// --- Concrete Class Definitions moved to implementation ---
// --- Concrete Class Definitions ---
// Common base class for AST nodes to reduce boilerplate.
TAstNode = class(TInterfacedObject, IAstNode)
private
function GetKind: TAstNodeKind; virtual; abstract;
@@ -168,7 +166,7 @@ type
function AsAddSeriesItem: IAddSeriesItemNode; virtual;
function AsSeriesLength: ISeriesLengthNode; virtual;
function AsRecur: IRecurNode; virtual;
function AsNop: INopNode; virtual; // Added Nop
function AsNop: INopNode; virtual;
function AsTypedNode: IAstTypedNode; virtual;
@@ -187,16 +185,20 @@ type
property StaticType: IStaticType read GetStaticType;
end;
// Updated TLambdaExpressionNode
TLambdaExpressionNode = class(TAstTypedNode, ILambdaExpressionNode, IFunctionDefinition)
private
FParameters: TArray<IIdentifierNode>;
FBody: IAstNode;
FScopeDescriptor: IScopeDescriptor;
FLayout: IScopeLayout;
FDescriptor: IScopeDescriptor;
FUpvalues: TArray<TResolvedAddress>;
FHasNestedLambdas: Boolean;
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IAstNode;
function GetScopeDescriptor: IScopeDescriptor;
function GetLayout: IScopeLayout;
function GetDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<TResolvedAddress>;
function GetHasNestedLambdas: Boolean;
function GetKind: TAstNodeKind; override;
@@ -205,7 +207,8 @@ type
const AParameters: TArray<IIdentifierNode>;
const ABody: IAstNode;
const AStaticType: IStaticType;
const AScopeDescriptor: IScopeDescriptor;
const ALayout: IScopeLayout;
const ADescriptor: IScopeDescriptor;
const AUpvalues: TArray<TResolvedAddress>;
const AHasNestedLambdas: Boolean
);
@@ -519,8 +522,6 @@ type
property Series: IIdentifierNode read FSeries;
end;
// TRecordLiteralNode is still needed in the interface
// for TGenericRecordLiteralNode
TRecordLiteralNode = class(TAstTypedNode, IRecordLiteralNode)
private
FFields: TArray<TRecordFieldLiteral>;
@@ -566,7 +567,6 @@ begin
else
Result := TScope.CreateScope(Parent, nil, nil);
// This should only be True when creating the *root* environment.
if ARegisterLibraries then
begin
for var libProc in FLibraries do
@@ -628,8 +628,6 @@ end;
class function TAst.AssignResult(const AValue: IAstNode): IAssignmentNode;
begin
// The parser ensures 'Result' is a valid identifier, so we create one.
// The binder will resolve it.
Result := TAssignmentNode.Create(TAst.Identifier('Result'), AValue, TTypes.Unknown);
end;
@@ -658,7 +656,6 @@ begin
end;
end;
// Create a new node with the correct type
Result := TConstantNode.Create(AValue, constType);
end;
@@ -758,20 +755,21 @@ end;
class function TAst.LambdaExpr(
const AParameters: TArray<IIdentifierNode>;
const ABody: IAstNode;
const AScopeDescriptor: IScopeDescriptor = nil;
const ALayout: IScopeLayout = nil;
const ADescriptor: IScopeDescriptor = nil;
const AUpvalues: TArray<TResolvedAddress> = nil;
const AHasNestedLambdas: Boolean = False;
const AStaticType: IStaticType = nil
): ILambdaExpressionNode;
begin
// Updated to call new constructor
Result :=
TLambdaExpressionNode.Create(
AParameters,
ABody,
if AStaticType <> nil then AStaticType
else TTypes.Unknown,
AScopeDescriptor,
ALayout,
ADescriptor,
AUpvalues,
AHasNestedLambdas
);
@@ -808,7 +806,6 @@ end;
class function TAst.Nop(const AStaticType: IStaticType = nil): IAstNode;
begin
// Factory function for the new Nop node
Result := TNopNode.Create(TTypes.Unknown);
end;
@@ -883,7 +880,6 @@ class function TAst.VarDecl(
const AIsBoxed: Boolean = False
): IVariableDeclarationNode;
begin
// Updated to call new constructor
Result :=
TVariableDeclarationNode.Create(
AIdentifier,
@@ -995,7 +991,6 @@ end;
function TAstNode.AsNop: INopNode;
begin
// Added Nop implementation
raise ETypeException.Create('Node is not a Nop');
end;
@@ -1249,7 +1244,8 @@ constructor TLambdaExpressionNode.Create(
const AParameters: TArray<IIdentifierNode>;
const ABody: IAstNode;
const AStaticType: IStaticType;
const AScopeDescriptor: IScopeDescriptor;
const ALayout: IScopeLayout;
const ADescriptor: IScopeDescriptor;
const AUpvalues: TArray<TResolvedAddress>;
const AHasNestedLambdas: Boolean
);
@@ -1257,14 +1253,18 @@ begin
inherited Create(AStaticType);
FParameters := AParameters;
FBody := ABody;
FScopeDescriptor := AScopeDescriptor;
FLayout := ALayout;
FDescriptor := ADescriptor;
FUpvalues := AUpvalues;
FHasNestedLambdas := AHasNestedLambdas;
// Consistency Check
if Assigned(FDescriptor) and (FDescriptor.Layout <> FLayout) then
raise Exception.Create('Consistency Error: Lambda Descriptor does not match Layout.');
end;
destructor TLambdaExpressionNode.Destroy;
begin
// FScopeDescriptor is an interface, managed by ARC
inherited;
end;
@@ -1288,9 +1288,14 @@ begin
Result := FParameters;
end;
function TLambdaExpressionNode.GetScopeDescriptor: IScopeDescriptor;
function TLambdaExpressionNode.GetLayout: IScopeLayout;
begin
Result := FScopeDescriptor;
Result := FLayout;
end;
function TLambdaExpressionNode.GetDescriptor: IScopeDescriptor;
begin
Result := FDescriptor;
end;
function TLambdaExpressionNode.GetUpvalues: TArray<TResolvedAddress>;