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

Closure upvalues

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-04 23:59:33 +02:00
parent 4a8075fecf
commit aa3c218f44
5 changed files with 351 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.pas
+150 -19
View File
@@ -6,6 +6,7 @@ uses
System.Classes,
System.SysUtils,
System.Generics.Collections,
System.Generics.Defaults,
Myc.Data.Scalar,
Myc.Ast.Nodes,
Myc.Ast.Scope;
@@ -121,9 +122,7 @@ type
public
constructor Create(AName: string);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
property IsResolved: Boolean read GetIsResolved;
property Name: string read FName;
property Address: TResolvedAddress read GetAddress;
end;
@@ -187,14 +186,20 @@ type
private
FParameters: TArray<IIdentifierNode>;
FBody: IExpressionNode;
FScopeDescriptor: IScopeDescriptor; // Backing field for the new property
FScopeDescriptor: IScopeDescriptor;
FUpvalues: TArray<IIdentifierNode>;
FUpvalueSourceAddresses: TArray<TResolvedAddress>;
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IExpressionNode;
function GetScopeDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<IIdentifierNode>;
function GetUpvalueSourceAddresses: TArray<TResolvedAddress>;
public
constructor Create(const AParameters: TArray<IIdentifierNode>; const ABody: IExpressionNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
procedure SetUpvalueData(const AUpvalues: TArray<IIdentifierNode>; const ASourceAddresses: TArray<TResolvedAddress>);
property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor;
property Upvalues: TArray<IIdentifierNode> read GetUpvalues;
end;
{ TFunctionCallNode }
@@ -303,21 +308,46 @@ type
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
public
function Equals(const Left, Right: TResolvedAddress): Boolean; override;
function GetHashCode(const Value: TResolvedAddress): Integer; override;
end;
// --- Binder Implementation ---
TBinder = class(TAstTraverser)
private
FCurrentDescriptor: IScopeDescriptor;
FUpvalueMapStack: TStack<TDictionary<TResolvedAddress, Integer>>;
FUpvalueNodesStack: TStack<TList<IIdentifierNode>>;
procedure EnterScope;
procedure ExitScope;
public
constructor Create(const AInitialScope: IExecutionScope);
destructor Destroy; override;
function VisitIdentifier(const Node: IIdentifierNode): TAstValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; override;
property CurrentDescriptor: IScopeDescriptor read FCurrentDescriptor;
end;
{ TResolvedAddressComparer }
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
begin
Result := (Left.Kind = Right.Kind) and (Left.ScopeDepth = Right.ScopeDepth) and (Left.SlotIndex = Right.SlotIndex);
end;
function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer;
begin
// Simple combining hash function
Result := 17;
Result := Result * 23 + Ord(Value.Kind);
Result := Result * 23 + Value.ScopeDepth;
Result := Result * 23 + Value.SlotIndex;
end;
{ TScopeDescriptor }
constructor TScopeDescriptor.Create(AParent: IScopeDescriptor);
@@ -406,6 +436,8 @@ constructor TIdentifierNode.Create(AName: string);
begin
inherited Create;
FName := AName;
// Default to unresolved.
FResolvedAddress.Kind := akUnresolved;
FResolvedAddress.ScopeDepth := -1;
FResolvedAddress.SlotIndex := -1;
end;
@@ -417,7 +449,8 @@ end;
function TIdentifierNode.GetIsResolved: Boolean;
begin
Result := FResolvedAddress.ScopeDepth >= 0;
// An identifier is resolved if its kind is not unresolved anymore.
Result := FResolvedAddress.Kind <> akUnresolved;
end;
function TIdentifierNode.GetName: string;
@@ -429,7 +462,6 @@ function TIdentifierNode.GetAddress: TResolvedAddress;
begin
if not IsResolved then
raise EInvalidOpException.Create('Identifier not bound');
Result := FResolvedAddress;
end;
@@ -555,6 +587,19 @@ begin
FBody := ABody;
FParameters := AParameters;
FScopeDescriptor := nil;
FUpvalues := [];
FUpvalueSourceAddresses := []; // Initialize new field
end;
function TLambdaExpressionNode.GetUpvalueSourceAddresses: TArray<TResolvedAddress>;
begin
Result := FUpvalueSourceAddresses;
end;
procedure TLambdaExpressionNode.SetUpvalueData(const AUpvalues: TArray<IIdentifierNode>; const ASourceAddresses: TArray<TResolvedAddress>);
begin
FUpvalues := AUpvalues;
FUpvalueSourceAddresses := ASourceAddresses;
end;
function TLambdaExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue;
@@ -577,6 +622,11 @@ begin
Result := FScopeDescriptor;
end;
function TLambdaExpressionNode.GetUpvalues: TArray<IIdentifierNode>;
begin
Result := FUpvalues;
end;
{ TFunctionCallNode }
constructor TFunctionCallNode.Create(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode);
@@ -807,6 +857,21 @@ constructor TBinder.Create(const AInitialScope: IExecutionScope);
begin
inherited Create;
FCurrentDescriptor := TAst.CreateDescriptor(AInitialScope);
FUpvalueMapStack := TStack<TDictionary<TResolvedAddress, Integer>>.Create;
FUpvalueNodesStack := TStack<TList<IIdentifierNode>>.Create;
end;
destructor TBinder.Destroy;
begin
while FUpvalueMapStack.Count > 0 do
FUpvalueMapStack.Pop.Free;
FUpvalueMapStack.Free;
while FUpvalueNodesStack.Count > 0 do
FUpvalueNodesStack.Pop.Free;
FUpvalueNodesStack.Free;
inherited;
end;
procedure TBinder.EnterScope;
@@ -821,17 +886,45 @@ end;
function TBinder.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
var
index, depth: Integer;
originalDepth, originalIndex: Integer;
identNode: TIdentifierNode;
upvalueMap: TDictionary<TResolvedAddress, Integer>;
upvalueNodes: TList<IIdentifierNode>;
originalAddress: TResolvedAddress;
upvalueIndex: Integer;
begin
identNode := Node as TIdentifierNode;
if identNode.IsResolved then
Exit;
if (FCurrentDescriptor as TScopeDescriptor).FindSymbol(identNode.Name, index, depth) then
if (FCurrentDescriptor as TScopeDescriptor).FindSymbol(identNode.Name, originalIndex, originalDepth) then
begin
identNode.FResolvedAddress.ScopeDepth := depth;
identNode.FResolvedAddress.SlotIndex := index;
if (originalDepth > 0) and (FUpvalueMapStack.Count > 0) then
begin
upvalueMap := FUpvalueMapStack.Peek;
upvalueNodes := FUpvalueNodesStack.Peek;
originalAddress.Kind := akLocalOrParent;
originalAddress.ScopeDepth := originalDepth;
originalAddress.SlotIndex := originalIndex;
if not upvalueMap.TryGetValue(originalAddress, upvalueIndex) then
begin
upvalueIndex := upvalueNodes.Count;
upvalueMap.Add(originalAddress, upvalueIndex);
upvalueNodes.Add(identNode);
end;
identNode.FResolvedAddress.Kind := akUpvalue;
identNode.FResolvedAddress.SlotIndex := upvalueIndex;
identNode.FResolvedAddress.ScopeDepth := 0;
end
else
begin
identNode.FResolvedAddress.Kind := akLocalOrParent;
identNode.FResolvedAddress.ScopeDepth := originalDepth;
identNode.FResolvedAddress.SlotIndex := originalIndex;
end;
end
else
raise Exception.CreateFmt('Undefined identifier: "%s"', [identNode.Name]);
@@ -840,27 +933,65 @@ end;
function TBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
var
param: IIdentifierNode;
upvalueMap: TDictionary<TResolvedAddress, Integer>;
upvalueNodes: TList<IIdentifierNode>;
sourceAddresses: TArray<TResolvedAddress>;
sortedPairs: TArray<TPair<TResolvedAddress, Integer>>;
begin
EnterScope;
FUpvalueMapStack.Push(TDictionary<TResolvedAddress, Integer>.Create(TResolvedAddressComparer.Default));
FUpvalueNodesStack.Push(TList<IIdentifierNode>.Create);
try
(FCurrentDescriptor as TScopeDescriptor).Define('Self');
EnterScope;
try
(FCurrentDescriptor as TScopeDescriptor).Define('Self');
for param in Node.Parameters do
(FCurrentDescriptor as TScopeDescriptor).Define(param.Name);
for param in Node.Parameters do
(FCurrentDescriptor as TScopeDescriptor).Define(param.Name);
inherited VisitLambdaExpression(Node);
inherited VisitLambdaExpression(Node);
// Annotate the lambda node with the completed scope descriptor.
(Node as TLambdaExpressionNode).FScopeDescriptor := FCurrentDescriptor;
(Node as TLambdaExpressionNode).FScopeDescriptor := FCurrentDescriptor;
finally
ExitScope;
end;
finally
ExitScope;
upvalueMap := FUpvalueMapStack.Pop;
upvalueNodes := FUpvalueNodesStack.Pop;
// The map's keys are the source addresses, and values are the indices.
// We need to sort by index to get the addresses in the correct order.
sortedPairs := upvalueMap.ToArray;
TArray.Sort<TPair<TResolvedAddress, Integer>>(
sortedPairs,
TComparer<TPair<TResolvedAddress, Integer>>.Construct(
function(const Left, Right: TPair<TResolvedAddress, Integer>): Integer begin Result := Left.Value - Right.Value; end
)
);
SetLength(sourceAddresses, Length(sortedPairs));
for var i := 0 to High(sortedPairs) do
sourceAddresses[i] := sortedPairs[i].Key;
(Node as TLambdaExpressionNode).SetUpvalueData(upvalueNodes.ToArray, sourceAddresses);
upvalueMap.Free;
upvalueNodes.Free;
end;
end;
function TBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
var
slotIndex: Integer;
identNode: TIdentifierNode;
begin
(FCurrentDescriptor as TScopeDescriptor).Define(Node.Identifier.Name);
inherited;
identNode := Node.Identifier as TIdentifierNode;
Node.Initializer.Accept(Self);
slotIndex := (FCurrentDescriptor as TScopeDescriptor).Define(Node.Identifier.Name);
identNode.FResolvedAddress.Kind := akLocalOrParent;
identNode.FResolvedAddress.ScopeDepth := 0;
identNode.FResolvedAddress.SlotIndex := slotIndex;
end;
{ TAst }