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

Fixed closure upvalue scoping

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-30 17:25:28 +02:00
parent 1ac605ee57
commit 1c1bd4cdca
6 changed files with 365 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Scope.pas
+105 -78
View File
@@ -29,6 +29,8 @@ type
{$endregion}
procedure Define(const Name: string; const Value: TDataValue);
// Defines a variable at a given address and stores it directly in a shared cell (boxing).
procedure DefineBoxed(const Address: TResolvedAddress; const Value: TDataValue);
function Dump: string;
procedure Clear;
function Capture(const Address: TResolvedAddress): IValueCell;
@@ -67,10 +69,12 @@ type
implementation
uses
System.Generics.Defaults;
System.Generics.Defaults,
System.SyncObjs;
type
TExecutionScope = class(TInterfacedObject, IExecutionScope)
private
type
TValueCell = class(TInterfacedObject, IValueCell)
private
@@ -81,21 +85,15 @@ type
constructor Create(const AValue: TDataValue);
end;
// Corrected TValueRef: Holds a stable reference to the scope and address, not the raw array.
TValueRef = class(TInterfacedObject, IValueCell)
private
FScope: IExecutionScope;
FAddress: TResolvedAddress;
function GetValue: TDataValue;
procedure SetValue(const AValue: TDataValue);
public
constructor Create(const AScope: IExecutionScope; const AAddress: TResolvedAddress);
TScopeItem = record
Value: TDataValue;
IsBoxed: Boolean;
end;
private
FParent: IExecutionScope;
FDescriptor: IScopeDescriptor;
FValues: TArray<TDataValue>;
FValues: TArray<TScopeItem>;
FCapturedUpvalues: TArray<IValueCell>;
FNames: TDictionary<string, Integer>;
FNameStrings: TList<string>;
@@ -114,6 +112,7 @@ type
procedure Clear;
function Dump: string;
procedure Define(const Name: string; const Value: TDataValue);
procedure DefineBoxed(const Address: TResolvedAddress; const Value: TDataValue);
function Capture(const Address: TResolvedAddress): IValueCell;
function CreateDescriptor: IScopeDescriptor;
property Names: TDictionary<string, Integer> read FNames;
@@ -158,27 +157,6 @@ begin
FValue := AValue;
end;
{ TExecutionScope.TValueRef }
constructor TExecutionScope.TValueRef.Create(const AScope: IExecutionScope; const AAddress: TResolvedAddress);
begin
inherited Create;
FScope := AScope;
FAddress := AAddress;
end;
function TExecutionScope.TValueRef.GetValue: TDataValue;
begin
// Delegate the call to the scope, which correctly handles parent traversal.
Result := FScope[FAddress];
end;
procedure TExecutionScope.TValueRef.SetValue(const AValue: TDataValue);
begin
// Delegate the call to the scope.
FScope[FAddress] := AValue;
end;
{ TExecutionScope }
constructor TExecutionScope.Create(
@@ -192,7 +170,7 @@ begin
FDescriptor := ADescriptor;
FValues := [];
FCapturedUpvalues := ACapturedUpvalues; // Store upvalues
FCapturedUpvalues := ACapturedUpvalues;
if FParent is TExecutionScope then
begin
@@ -232,26 +210,49 @@ begin
end;
function TExecutionScope.Capture(const Address: TResolvedAddress): IValueCell;
var
targetScope: TExecutionScope;
i: Integer;
begin
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.'
);
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)), 'Invalid upvalue index.');
Result := FCapturedUpvalues[Address.SlotIndex];
end;
akLocalOrParent:
begin
// Corrected Implementation: Create a TValueRef that holds the current scope
// and the full address. The scope's indexer will handle the parent traversal correctly
// and is robust against array reallocations.
Result := TValueRef.Create(Self, Address);
targetScope := Self;
for i := 1 to Address.ScopeDepth do
begin
targetScope := targetScope.Parent as TExecutionScope;
Assert(Assigned(targetScope), 'Invalid scope depth during capture.');
end;
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), 'Invalid slot index during capture.');
// The check-and-update for JIT-boxing must be atomic.
TMonitor.Enter(targetScope);
try
var item := targetScope.FValues[Address.SlotIndex];
if item.IsBoxed then
begin
// The variable is already boxed, so just return its cell.
Result := item.Value.AsIntf<IValueCell>;
end
else
begin
// This is an unboxed variable. Box it "just-in-time" and update the scope.
Result := TValueCell.Create(item.Value);
targetScope.FValues[Address.SlotIndex].Value := TDataValue.FromIntf<IValueCell>(Result);
targetScope.FValues[Address.SlotIndex].IsBoxed := True;
end;
finally
TMonitor.Exit(targetScope);
end;
end;
else
raise EInvalidOpException.Create('Cannot get value for an unresolved address.');
raise EInvalidOpException.Create('Cannot capture an unresolved address.');
end;
end;
@@ -266,26 +267,41 @@ var
index: Integer;
begin
NeedNameToIndex;
id := GetNameID(Name);
if FNameToIndex.ContainsKey(id) then
raise Exception.CreateFmt('Variable "%s" is already defined in this scope.', [Name]);
index := Length(FValues);
SetLength(FValues, index + 1);
FValues[index] := Value;
FValues[index].Value := Value;
FValues[index].IsBoxed := False;
FNameToIndex.Add(id, index);
end;
procedure TExecutionScope.DefineBoxed(const Address: TResolvedAddress; const Value: TDataValue);
var
targetScope: TExecutionScope;
i: Integer;
begin
// This method is only for local variables (ScopeDepth=0).
Assert(Address.ScopeDepth = 0, 'DefineBoxed can only be used on the current scope.');
targetScope := Self;
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), 'Invalid slot index during DefineBoxed.');
targetScope.FValues[Address.SlotIndex].Value := TDataValue.FromIntf<IValueCell>(TValueCell.Create(Value));
targetScope.FValues[Address.SlotIndex].IsBoxed := True;
end;
procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
var
pair: TPair<Integer, Integer>;
indentStr: string;
indentStr, boxedStr: string;
sortedPairs: TArray<TPair<Integer, Integer>>;
item: TScopeItem;
val: TDataValue;
begin
NeedNameToIndex;
indentStr := ''.PadLeft(AIndent);
if FNameToIndex.Count > 0 then
begin
@@ -297,13 +313,23 @@ begin
);
for pair in sortedPairs do
// Access the value inside the cell for printing.
ABuilder.AppendLine(indentStr + Format(' [%d] %s: %s', [pair.Value, FNameStrings[pair.Key], FValues[pair.Value].ToString]));
begin
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;
end
else
begin
ABuilder.AppendLine(indentStr + ' (empty)');
end;
if Assigned(FParent) then
begin
@@ -333,15 +359,14 @@ begin
end;
function TExecutionScope.GetValues(const Address: TResolvedAddress): TDataValue;
var
item: TScopeItem;
begin
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.'
);
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)), 'Invalid upvalue index.');
Result := FCapturedUpvalues[Address.SlotIndex].Value;
end;
akLocalOrParent:
@@ -350,13 +375,15 @@ begin
for var i := 1 to Address.ScopeDepth do
begin
targetScope := targetScope.Parent as TExecutionScope;
Assert(Assigned(targetScope), 'Invalid scope depth during value retrieval.');
Assert(Assigned(targetScope), 'Invalid scope depth for GetValues.');
end;
Assert(
(Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)),
'Invalid scope index during value retrieval.'
);
Result := targetScope.FValues[Address.SlotIndex];
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), 'Invalid slot index for GetValues.');
item := targetScope.FValues[Address.SlotIndex];
if item.IsBoxed then
Result := (item.Value.AsIntf<IValueCell>).Value
else
Result := item.Value;
end;
else
raise EInvalidOpException.Create('Cannot get value for an unresolved address.');
@@ -386,38 +413,41 @@ begin
end;
procedure TExecutionScope.SetValues(const Address: TResolvedAddress; const Value: TDataValue);
var
targetScope: TExecutionScope;
i: Integer;
begin
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.'
);
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)), 'Invalid upvalue index.');
FCapturedUpvalues[Address.SlotIndex].Value := Value;
end;
akLocalOrParent:
begin
var targetScope := Self;
for var i := 1 to Address.ScopeDepth do
targetScope := Self;
for i := 1 to Address.ScopeDepth do
begin
targetScope := targetScope.Parent as TExecutionScope;
Assert(Assigned(targetScope), 'Invalid scope depth during value retrieval.');
Assert(Assigned(targetScope), 'Invalid scope depth for SetValues.');
end;
Assert(
(Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)),
'Invalid scope index during value retrieval.'
);
targetScope.FValues[Address.SlotIndex] := Value;
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), 'Invalid slot index for SetValues.');
// Use a reference/pointer to modify the array element in place
var pItem: ^TScopeItem := @targetScope.FValues[Address.SlotIndex];
if pItem.IsBoxed then
(pItem.Value.AsIntf<IValueCell>).Value := Value
else
pItem.Value := Value;
end;
else
raise EInvalidOpException.Create('Cannot get value for an unresolved address.');
raise EInvalidOpException.Create('Cannot set value for an unresolved address.');
end;
end;
{ TScopeDescriptor }
// ... (Implementation unchanged and correct) ...
constructor TScopeDescriptor.Create(const AParent: IScopeDescriptor);
begin
inherited Create;
@@ -445,7 +475,6 @@ end;
function TScopeDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope;
begin
// Creates a runtime scope instance based on this descriptor's layout.
Result := TExecutionScope.Create(Parent, Self, nil);
end;
@@ -491,8 +520,6 @@ end;
procedure TScopeDescriptor.PopulateFromScope(Scope: TExecutionScope);
begin
// This method is likely used to create a descriptor from an existing, dynamically populated scope.
// Note: This relies on internal details of TExecutionScope (NameToIndex, NameStrings).
for var pair in Scope.NameToIndex do
begin
var name := Scope.NameStrings[pair.Key];