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
ASTPlayground/MainForm.pas
+3 -3
View File
@@ -164,12 +164,12 @@ begin
TAst.Identifier('n'),
TAst.BinaryExpr(
TAst.FunctionCall(
TAst.Identifier('fib'),
TAst.Identifier('Self'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]
),
boAdd,
TAst.FunctionCall(
TAst.Identifier('fib'),
TAst.Identifier('Self'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(2)))]
)
)
@@ -230,7 +230,7 @@ begin
TAst.Identifier('n'),
boMultiply,
TAst.FunctionCall(
TAst.Identifier('factorial'),
TAst.Identifier('Self'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]
)
)
Src/AST/Myc.Ast.Evaluator.pas
+51 -7
View File
@@ -88,19 +88,25 @@ type
// The signature for a native Delphi function callable from the script.
TNativeFunction = function(const Args: TArray<TAstValue>): TAstValue;
// Concrete implementation of the TAstValue.IClosure interface for script-defined functions.
TClosureValue = class(TInterfacedObject, TAstValue.IClosure)
private
FBody: IExpressionNode;
FClosureScope: IExecutionScope;
FLambdaNode: ILambdaExpressionNode;
FUpvalues: TArray<IValueCell>;
function GetBody: IExpressionNode;
function GetParameters: TArray<IIdentifierNode>;
function GetClosureScope: IExecutionScope;
function GetUpvalues: TArray<IValueCell>;
public
constructor Create(const ALambdaNode: ILambdaExpressionNode; const AClosureScope: IExecutionScope);
constructor Create(
const ALambdaNode: ILambdaExpressionNode;
const AClosureScope: IExecutionScope;
const AUpvalues: TArray<IValueCell>
);
property ClosureScope: IExecutionScope read GetClosureScope;
property LambdaNode: ILambdaExpressionNode read FLambdaNode;
property Upvalues: TArray<IValueCell> read FUpvalues;
end;
// Concrete implementation of TAstValue.IClosure for native Delphi functions.
@@ -110,6 +116,7 @@ type
function GetBody: IExpressionNode;
function GetParameters: TArray<IIdentifierNode>;
function GetClosureScope: IExecutionScope;
function GetUpvalues: TArray<IValueCell>;
public
constructor Create(const AMethod: TNativeFunction);
property Method: TNativeFunction read FMethod;
@@ -205,12 +212,17 @@ end;
{ TClosureValue }
constructor TClosureValue.Create(const ALambdaNode: ILambdaExpressionNode; const AClosureScope: IExecutionScope);
constructor TClosureValue.Create(
const ALambdaNode: ILambdaExpressionNode;
const AClosureScope: IExecutionScope;
const AUpvalues: TArray<IValueCell>
);
begin
inherited Create;
FLambdaNode := ALambdaNode;
FBody := ALambdaNode.Body;
FClosureScope := AClosureScope;
FUpvalues := AUpvalues; // Store the captured cells
end;
function TClosureValue.GetBody: IExpressionNode;
@@ -228,6 +240,11 @@ begin
Result := FLambdaNode.Parameters;
end;
function TClosureValue.GetUpvalues: TArray<IValueCell>;
begin
Result := FUpvalues;
end;
{ TNativeClosure }
constructor TNativeClosure.Create(const AMethod: TNativeFunction);
@@ -251,6 +268,10 @@ begin
Result := nil;
end;
function TNativeClosure.GetUpvalues: TArray<IValueCell>;
begin
end;
{ TEvaluatorVisitor }
constructor TEvaluatorVisitor.Create(const AScope: IExecutionScope);
@@ -475,8 +496,27 @@ begin
end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
var
capturedCells: TArray<IValueCell>;
i: Integer;
sourceAddr: TResolvedAddress;
sourceAddresses: TArray<TResolvedAddress>;
begin
Result := TAstValue.FromClosure(TClosureValue.Create(Node, FScope));
// The binder has identified the upvalues. Capture the cells from the current scope
// using the original source addresses provided by the binder.
sourceAddresses := Node.UpvalueSourceAddresses;
SetLength(capturedCells, Length(sourceAddresses));
for i := 0 to High(sourceAddresses) do
begin
sourceAddr := sourceAddresses[i];
// The binder gives the depth relative to the lambda's
// inner scope. The evaluator is in the outer scope, so we adjust the
// depth by -1 to find the cell in the current context.
dec(sourceAddr.ScopeDepth);
capturedCells[i] := FScope.GetCell(sourceAddr);
end;
Result := TAstValue.FromClosure(TClosureValue.Create(Node, FScope, capturedCells));
end;
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue;
@@ -510,17 +550,21 @@ begin
if not Assigned(descriptor) then
raise EParserError.Create('Lambda has no scope descriptor. Did the binder run?');
var callScope := descriptor.CreateScope(closure.ClosureScope);
// Create the execution scope for the call, providing the captured upvalues.
var callScope := TExecutionScope.Create(closure.ClosureScope, descriptor, (closure as TClosureValue).Upvalues) as IExecutionScope;
var adr: TResolvedAddress;
adr.Kind := akLocalOrParent;
adr.ScopeDepth := 0;
// Slot 0 is 'Self'.
adr.SlotIndex := 0;
callScope[adr] := calleeValue;
callScope.Values[adr] := calleeValue;
for i := 0 to Node.Arguments.Count - 1 do
begin
adr.SlotIndex := closure.Parameters[i].Address.SlotIndex;
callScope[adr] := Node.Arguments[i].Accept(Self);
callScope.Values[adr] := Node.Arguments[i].Accept(Self);
end;
Result := closure.Body.Accept(CreateVisitorForScope(callScope));
Src/AST/Myc.Ast.Nodes.pas
+23
View File
@@ -46,6 +46,7 @@ type
ISeriesLengthNode = interface;
IExecutionScope = interface;
IScopeDescriptor = interface;
IValueCell = interface;
// --- Concrete Type Definitions ---
@@ -56,10 +57,12 @@ type
function GetBody: IExpressionNode;
function GetClosureScope: IExecutionScope;
function GetParameters: TArray<IIdentifierNode>;
function GetUpvalues: TArray<IValueCell>;
{$endregion}
property Body: IExpressionNode read GetBody;
property ClosureScope: IExecutionScope read GetClosureScope;
property Parameters: TArray<IIdentifierNode> read GetParameters;
property Upvalues: TArray<IValueCell> read GetUpvalues;
end;
TVal<T> = class(TInterfacedObject)
@@ -96,7 +99,21 @@ type
property Kind: TAstValueKind read GetKind;
end;
// A managed, reference-counted cell that holds a TAstValue,
// allowing it to be shared by reference between scopes (for closures).
IValueCell = interface
{$region 'private'}
function GetValue: TAstValue;
procedure SetValue(const AValue: TAstValue);
{$endregion}
property Value: TAstValue read GetValue write SetValue;
end;
// Defines how an identifier's address was resolved.
TAddressKind = (akUnresolved, akLocalOrParent, akUpvalue);
TResolvedAddress = record
Kind: TAddressKind;
ScopeDepth: Integer;
SlotIndex: Integer;
end;
@@ -106,12 +123,14 @@ type
function GetParent: IExecutionScope;
function GetValues(const Address: TResolvedAddress): TAstValue;
procedure SetValues(const Address: TResolvedAddress; const Value: TAstValue);
function GetCell(const Address: TResolvedAddress): IValueCell;
{$endregion}
procedure Define(const Name: string; const Value: TAstValue);
function Dump: string;
procedure Clear;
property Cell[const Address: TResolvedAddress]: IValueCell read GetCell;
property Values[const Address: TResolvedAddress]: TAstValue read GetValues write SetValues; default;
property Parent: IExecutionScope read GetParent;
@@ -222,10 +241,14 @@ type
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IExpressionNode;
function GetScopeDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<IIdentifierNode>;
function GetUpvalueSourceAddresses: TArray<TResolvedAddress>;
{$endregion}
property Parameters: TArray<IIdentifierNode> read GetParameters;
property Body: IExpressionNode read GetBody;
property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor;
property Upvalues: TArray<IIdentifierNode> read GetUpvalues;
property UpvalueSourceAddresses: TArray<TResolvedAddress> read GetUpvalueSourceAddresses;
end;
IFunctionCallNode = interface(IExpressionNode)
Src/AST/Myc.Ast.Scope.pas
+124 -27
View File
@@ -12,21 +12,28 @@ type
TExecutionScope = class(TInterfacedObject, IExecutionScope)
private
FParent: IExecutionScope;
FValues: TArray<TAstValue>;
FValues: TArray<IValueCell>;
// Stores references to the value cells captured by a closure.
FCapturedUpvalues: TArray<IValueCell>;
FNameToIndex: TDictionary<string, Integer>;
procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
function GetValues(const Address: TResolvedAddress): TAstValue;
procedure SetValues(const Address: TResolvedAddress; const Value: TAstValue);
function GetParent: IExecutionScope;
function GetCell(const Address: TResolvedAddress): IValueCell;
public
constructor Create(AParent: IExecutionScope = nil; const ADescriptor: IScopeDescriptor = nil);
constructor Create(
AParent: IExecutionScope = nil;
const ADescriptor: IScopeDescriptor = nil;
const ACapturedUpvalues: TArray<IValueCell> = nil
);
destructor Destroy; override;
procedure Clear;
function Dump: string;
procedure Define(const Name: string; const Value: TAstValue);
property NameToIndex: TDictionary<string, Integer> read FNameToIndex;
property Parent: IExecutionScope read FParent;
property Values: TArray<TAstValue> read FValues;
property Values: TArray<IValueCell> read FValues;
end;
implementation
@@ -34,19 +41,54 @@ implementation
uses
System.Generics.Defaults;
type
TValueCell = class(TInterfacedObject, IValueCell)
private
FValue: TAstValue;
function GetValue: TAstValue;
procedure SetValue(const AValue: TAstValue);
end;
{ TValueCell }
function TValueCell.GetValue: TAstValue;
begin
Result := FValue;
end;
procedure TValueCell.SetValue(const AValue: TAstValue);
begin
FValue := AValue;
end;
{ TExecutionScope }
constructor TExecutionScope.Create(AParent: IExecutionScope = nil; const ADescriptor: IScopeDescriptor = nil);
{ TExecutionScope }
constructor TExecutionScope.Create(
AParent: IExecutionScope;
const ADescriptor: IScopeDescriptor;
const ACapturedUpvalues: TArray<IValueCell>
);
var
slotCount: Integer;
i: Integer;
begin
inherited Create;
FParent := AParent;
FValues := [];
FNameToIndex := TDictionary<string, Integer>.Create;
FCapturedUpvalues := ACapturedUpvalues; // Store upvalues
if ADescriptor <> nil then
begin
for var item in ADescriptor.Symbols do
FNameToIndex.AddOrSetValue(item.Key, item.Value);
SetLength(FValues, ADescriptor.SlotCount);
slotCount := ADescriptor.SlotCount;
SetLength(FValues, slotCount);
for i := 0 to slotCount - 1 do
FValues[i] := TValueCell.Create as IValueCell;
end;
end;
@@ -56,6 +98,26 @@ begin
inherited Destroy;
end;
function TExecutionScope.GetCell(const Address: TResolvedAddress): IValueCell;
var
targetScope: TExecutionScope;
i: Integer;
begin
// Cells can only be retrieved from local/parent scopes.
if Address.Kind <> akLocalOrParent then
raise EInvalidOpException.Create('Cannot get a cell for a non-local address.');
targetScope := Self;
for i := 1 to Address.ScopeDepth do
begin
targetScope := targetScope.Parent as TExecutionScope;
Assert(Assigned(targetScope), 'Invalid scope depth during cell retrieval.');
end;
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), 'Invalid scope index during cell retrieval.');
Result := targetScope.FValues[Address.SlotIndex];
end;
function TExecutionScope.GetParent: IExecutionScope;
begin
Result := FParent;
@@ -76,7 +138,8 @@ begin
index := Length(FValues);
SetLength(FValues, index + 1);
FValues[index] := Value;
FValues[index] := TValueCell.Create as IValueCell;
FValues[index].Value := Value;
FNameToIndex.Add(Name, index);
end;
@@ -97,7 +160,8 @@ begin
);
for pair in sortedPairs do
ABuilder.AppendLine(indentStr + Format(' [%d] %s: %s', [pair.Value, pair.Key, FValues[pair.Value].ToString]));
// Access the value inside the cell for printing.
ABuilder.AppendLine(indentStr + Format(' [%d] %s: %s', [pair.Value, pair.Key, FValues[pair.Value].Value.ToString]));
end
else
begin
@@ -130,16 +194,33 @@ var
targetScope: TExecutionScope;
i: Integer;
begin
targetScope := Self;
for i := 0 to Address.ScopeDepth - 1 do
begin
targetScope := targetScope.Parent as TExecutionScope;
Assert(Assigned(targetScope), 'Invalid scope depth during value retrieval.');
case Address.Kind of
akUpvalue:
begin
Assert(Assigned(FCapturedUpvalues), 'Attempt to access an upvalue in a scope with no closure context.');
Assert(
(Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)),
'Invalid upvalue index during value retrieval.'
);
Result := FCapturedUpvalues[Address.SlotIndex].Value;
end;
akLocalOrParent:
begin
targetScope := Self;
for i := 1 to Address.ScopeDepth do
begin
targetScope := targetScope.Parent as TExecutionScope;
Assert(Assigned(targetScope), 'Invalid scope depth during value retrieval.');
end;
Assert(
(Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.Values)),
'Invalid scope index during value retrieval.'
);
Result := targetScope.Values[Address.SlotIndex].Value;
end;
else
raise EInvalidOpException.Create('Cannot get value for an unresolved address.');
end;
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.Values)), 'Invalid scope index during value retrieval.');
Result := targetScope.Values[Address.SlotIndex];
end;
procedure TExecutionScope.SetValues(const Address: TResolvedAddress; const Value: TAstValue);
@@ -147,18 +228,34 @@ var
targetScope: IExecutionScope;
i: Integer;
begin
targetScope := Self;
for i := 1 to Address.ScopeDepth do
begin
if Assigned(targetScope) then
targetScope := targetScope.Parent
else
raise EInvalidOpException.Create('Invalid scope depth during assignment.');
end;
case Address.Kind of
akUpvalue:
begin
Assert(Assigned(FCapturedUpvalues), 'Attempt to access an upvalue in a scope with no closure context.');
Assert(
(Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)),
'Invalid upvalue index during value assignment.'
);
FCapturedUpvalues[Address.SlotIndex].Value := Value;
end;
akLocalOrParent:
begin
targetScope := Self;
for i := 0 to Address.ScopeDepth - 1 do
begin
if Assigned(targetScope) then
targetScope := targetScope.Parent
else
raise EInvalidOpException.Create('Invalid scope depth during assignment.');
end;
if Address.SlotIndex >= Length((targetScope as TExecutionScope).FValues) then
raise EInvalidOpException.Create('Invalid scope index during assignment.');
(targetScope as TExecutionScope).FValues[Address.SlotIndex] := Value;
if Address.SlotIndex >= Length((targetScope as TExecutionScope).Values) then
raise EInvalidOpException.Create('Invalid scope index during assignment.');
(targetScope as TExecutionScope).Values[Address.SlotIndex].Value := Value;
end;
else
raise EInvalidOpException.Create('Cannot set value for an unresolved address.');
end;
end;
end.
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 }